lots of langfilter stuff, mostly lántas script

langfilter/Glosses.hs

@@ -0,0 +1,72 @@
+module Glosses (glosses) where
+
+import Lang
+import LaantasImage
+import Spans
+
+import Text.Pandoc.Definition
+import Text.Pandoc.Builder
+import Text.Pandoc.Walk
+import Data.Maybe
+import Data.Text (Text)
+
+
+glosses :: Vars => Block -> IO [Block]
+glosses = \case
+  Div (_, cs, _) blocks | "glosses" `elem` cs -> do
+    tables <- traverse glossTable blocks
+    pure $
+      [RawBlock (Format "html") "<figure class=glosses>"] ++
+      catMaybes tables ++
+      [RawBlock (Format "html") "</figure>"]
+  b -> pure [b]
+
+pattern Gloss l g w t = BulletList [[Plain l], [Plain g], [Plain w], [Plain t]]
+pattern PGloss l p g w t =
+  BulletList [[Plain l], [Plain p], [Plain g], [Plain w], [Plain t]]
+
+glossTable :: Vars => Block -> IO (Maybe Block)
+glossTable = \case
+  Gloss  l   s g t -> Just <$> make l Nothing  s g t
+  PGloss l p s g t -> Just <$> make l (Just p) s g t
+  HorizontalRule   -> pure Nothing
+  b                -> error $ "found " ++ show b ++ " in gloss section"
+ where
+  make l p s g t = do
+    let n = length $ splitInlines s
+    let colspecs = replicate n (AlignDefault, ColWidthDefault)
+    let l' = cell1 n l; p' = cell1 n <$> p
+    let ss = cells s; gs = cells g; t' = cell1 n t
+    img <- case ?lang of
+      Just Lántas ->
+        [Just $ cell1 n [img] | img <- makeImage $ splitImage' $ stripInlines l]
+      Nothing     -> pure Nothing
+    pure $ Table ("", ["gloss"], []) (Caption Nothing []) colspecs
+      (TableHead mempty [])
+      [TableBody mempty (RowHeadColumns 0) [] $ concat
+        [[row ["gloss-scr", "scr"] [i] | Just i <- [img]],
+         [row ["gloss-lang", "lang"] [l']],
+         [row ["gloss-pron", "ipa"] [p] | Just p <- [p']],
+         [row ["gloss-split", "lang"] ss],
+         [row ["gloss-gloss"] gs],
+         [row ["gloss-trans"] [t']]]]
+      (TableFoot mempty [])
+  cell is = Cell mempty AlignDefault (RowSpan 1) (ColSpan 1) [Plain is]
+  cell1 n is = Cell mempty AlignDefault (RowSpan 1) (ColSpan n) [Plain is]
+  cells = map (cell . concatMap abbrs) . splitInlines
+  row c = Row ("", c, [])
+
+stripInlines :: [Inline] -> Text
+stripInlines = query \case
+  Str s -> s
+  Space -> " "
+  SoftBreak -> " "
+  LineBreak -> " "
+  _ -> ""
+
+splitInlines :: [Inline] -> [Inlines]
+splitInlines is = filter (not . null) $ go is where
+  go [] = []
+  go is =
+    let (is1, is') = break (== Space) is in
+    fromList is1 : splitInlines (dropWhile (== Space) is')