rhi/lang
1
0
Fork 0
Code Issues 2 Pull requests Releases Wiki Activity

allow including a narrow pronunciation in glosses

Browse source
This commit is contained in:
Rhiannon Morris 2021-06-04 05:33:22 +02:00
parent c493595407
commit 5b016e10d5
1 changed files with 16 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
langfilter/Glosses.hs
View file

@ -29,35 +29,39 @@ glosses = \case
pattern Gloss l g w t = BulletList [[Plain l], [Plain g], [Plain w], [Plain t]] pattern Gloss l g w t = BulletList [[Plain l], [Plain g], [Plain w], [Plain t]]
pattern PGloss l p g w t = pattern PGloss l p g w t =
BulletList [[Plain l], [Plain p], [Plain g], [Plain w], [Plain t]] BulletList [[Plain l], [Plain p], [Plain g], [Plain w], [Plain t]]
pattern PNGloss l b n g w t =
BulletList [[Plain l], [Plain b], [Plain n], [Plain g], [Plain w], [Plain t]]
glossTable :: Vars => Block -> IO (Maybe Block) glossTable :: Vars => Block -> IO (Maybe Block)
glossTable = \case glossTable = \case
Gloss l s g t -> Just <$> make l Nothing s g t Gloss l s g t -> Just <$> make l Nothing Nothing s g t
PGloss l p s g t -> Just <$> make l (Just p) s g t PGloss l p s g t -> Just <$> make l (Just p) Nothing s g t
HorizontalRule -> pure Nothing PNGloss l b n s g t -> Just <$> make l (Just b) (Just n) s g t
b -> error $ "found " ++ show b ++ " in gloss section" HorizontalRule -> pure Nothing
b -> error $ "found " ++ show b ++ " in gloss section"
where where
make l p s g t = do make l b n s g t = do
let n = length $ splitInlines s let ℓ = length $ splitInlines s
let colspecs = replicate n (AlignDefault, ColWidthDefault) let colspecs = replicate ℓ (AlignDefault, ColWidthDefault)
let l' = cell1 n $ underlines l; p' = cell1 n <$> p let l' = cell1 ℓ $ underlines l; b' = cell1 ℓ <$> b; n' = cell1 ℓ <$> n
let ss = cells s; gs = cells g; t' = cell1 n t let ss = cells s; gs = cells g; t' = cell1 ℓ t
img <- case ?lang of img <- case ?lang of
Just Lántas -> Just Lántas ->
[Just $ cell1 n [img] | img <- makeImage $ splitImage' $ stripInlines l] [Just $ cell1 ℓ [img] | img <- makeImage $ splitImage' $ stripInlines l]
Nothing -> pure Nothing Nothing -> pure Nothing
pure $ Table ("", ["gloss"], []) (Caption Nothing []) colspecs pure $ Table ("", ["gloss"], []) (Caption Nothing []) colspecs
(TableHead mempty []) (TableHead mempty [])
[TableBody mempty (RowHeadColumns 0) [] $ concat [TableBody mempty (RowHeadColumns 0) [] $ concat
[[row ["gloss-scr", "scr"] [i] | Just i <- [img]], [[row ["gloss-scr", "scr"] [i] | Just i <- [img]],
[row ["gloss-lang", "lang"] [l']], [row ["gloss-lang", "lang"] [l']],
[row ["gloss-pron", "ipa"] [p] | Just p <- [p']], [row ["gloss-pron", "ipa"] [b] | Just b <- [b']],
[row ["gloss-pron", "ipa"] [n] | Just n <- [n']],
[row ["gloss-split", "lang"] ss], [row ["gloss-split", "lang"] ss],
[row ["gloss-gloss"] gs], [row ["gloss-gloss"] gs],
[row ["gloss-trans"] [t']]]] [row ["gloss-trans"] [t']]]]
(TableFoot mempty []) (TableFoot mempty [])
cell is = Cell mempty AlignDefault (RowSpan 1) (ColSpan 1) [Plain is] cell is = Cell mempty AlignDefault (RowSpan 1) (ColSpan 1) [Plain is]
cell1 n is = Cell mempty AlignDefault (RowSpan 1) (ColSpan n) [Plain is] cell1 ℓ is = Cell mempty AlignDefault (RowSpan 1) (ColSpan ℓ) [Plain is]
cells = map (cell . concatMap abbrs) . splitInlines cells = map (cell . concatMap abbrs) . splitInlines
row c = Row ("", c, []) row c = Row ("", c, [])