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

generate inline svg for lántas text

Browse source
This commit is contained in:
Rhiannon Morris 2024-11-28 01:32:27 +01:00
parent 64245228d0
commit 6c9d04489c
9 changed files with 83 additions and 101 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

43
langfilter/Glosses.hs
View file

@ -14,18 +14,17 @@ import qualified Data.Text as Text
import Data.Data (toConstr) import Data.Data (toConstr)
glosses :: Vars => Block -> IO [Block] glosses :: Vars => Block -> [Block]
glosses = \case glosses = \case
Div (i, cs, _) blocks | "glosses" `elem` cs -> do Div (i, cs, _) blocks | "glosses" `elem` cs ->
tables <- traverse glossTable blocks let tables = map glossTable blocks in
pure $ [RawBlock (Format "html") $ "<figure" <> id <> classes <> ">"] ++
[RawBlock (Format "html") $ "<figure" <> id <> classes <> ">"] ++ catMaybes tables ++
catMaybes tables ++ [RawBlock (Format "html") "</figure>"]
[RawBlock (Format "html") "</figure>"]
where where
id = if i == "" then "" else " id=\"" <> i <> "\"" id = if i == "" then "" else " id=\"" <> i <> "\""
classes = " class=\"" <> Text.unwords cs <> "\"" classes = " class=\"" <> Text.unwords cs <> "\""
b -> pure [b] b -> [b]
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 =
@ -33,28 +32,28 @@ pattern PGloss l p g w t =
pattern PNGloss l b n g w t = pattern PNGloss l b n g w t =
BulletList [[Plain l], [Plain b], [Plain n], [Plain g], [Plain w], [Plain t]] BulletList [[Plain l], [Plain b], [Plain n], [Plain g], [Plain w], [Plain t]]
glossTable :: Vars => Block -> IO (Maybe Block) glossTable :: Vars => Block -> Maybe Block
glossTable = \case glossTable = \case
Gloss l s g t -> Just <$> make l Nothing 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) Nothing s g t PGloss l p s g t -> Just $ make l (Just p) Nothing s g t
PNGloss l b n s g t -> Just <$> make l (Just b) (Just n) s g t PNGloss l b n s g t -> Just $ make l (Just b) (Just n) s g t
HorizontalRule -> pure Nothing HorizontalRule -> Nothing
BulletList xs | let ℓ = length xs, ℓ < 4 || ℓ > 6 -> BulletList xs | let ℓ = length xs, ℓ < 4 || ℓ > 6 ->
fail $ "found list of length " ++ show ℓ ++ fail $ "found list of length " ++ show ℓ ++
" in gloss section (missing `---`?)" " in gloss section (missing `---`?)"
b -> fail $ "found unexpected " ++ show (toConstr b) ++ " in gloss section" b -> fail $ "found unexpected " ++ show (toConstr b) ++ " in gloss section"
where where
make l b n s g t = do make l b n s g t =
let ℓ = length $ splitInlines s let ℓ = length $ splitInlines s
let colspecs = replicate ℓ (AlignDefault, ColWidthDefault) colspecs = replicate ℓ (AlignDefault, ColWidthDefault)
let l' = cell1 ℓ $ underlines $ noHash l l' = cell1 ℓ $ underlines $ noHash l
b' = cell1 ℓ <$> b; n' = cell1 ℓ <$> n b' = cell1 ℓ <$> b; n' = cell1 ℓ <$> n
let ss = cells s; gs = cells g; t' = cell1 ℓ t 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 ℓ [makeItem $ splitItem' $ stripInlines l]
[Just $ cell1 ℓ [img] | img <- makeImage $ splitImage' $ stripInlines l] Nothing -> Nothing
Nothing -> pure Nothing in
pure $ Table ("", ["gloss"], []) (Caption Nothing []) colspecs 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]],

72
langfilter/LaantasImage.hs
View file

@ -1,10 +1,9 @@
module LaantasImage module LaantasImage
(Image (..), splitImage, splitImage', makeImage) (Item (..), splitItem, splitItem', makeItem)
where where
import Lang import Lang
import Text.Pandoc.Definition hiding (Image) import Text.Pandoc.Definition
import qualified Text.Pandoc.Definition as Pandoc
import Data.Bifunctor import Data.Bifunctor
import Data.Function import Data.Function
import Data.Maybe import Data.Maybe
@ -12,37 +11,34 @@ import Data.Map (Map)
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
import System.Environment import qualified Data.Text.Lazy as Lazy
import System.FilePath import qualified Laantas
import System.Process
data Image = data Item =
Image { Item {
text, title :: Text, text, title :: Text,
file :: FilePath,
size, stroke :: Double, size, stroke :: Double,
width :: Int, width :: Double,
color :: Text, color :: Text,
showText :: Bool showText :: Bool
} deriving (Eq, Show) } deriving (Eq, Show)
splitImage :: Vars => Text -> Maybe Image splitItem :: Vars => Text -> Maybe Item
splitImage (Text.uncons -> Just (c, txt)) splitItem (Text.uncons -> Just (c, txt))
| c == '!' = Just $ splitImage' txt | c == '!' = Just $ splitItem' txt
| c == '#' = Just $ (splitImage' txt) {showText = False} | c == '#' = Just $ (splitItem' txt) {showText = False}
splitImage _ = Nothing splitItem _ = Nothing
splitImage' :: Vars => Text -> Image splitItem' :: Vars => Text -> Item
splitImage' txt₀ = splitItem' txt₀ =
case imageOpts txt₀ of case imageOpts txt₀ of
Just (txt, opts) -> defaultImage txt ?defColor Just (txt, opts) -> defaultItem txt ?defColor
& withOpt opts "file" (\f i -> i {file = makeFile f})
& withOpt opts "size" (\s i -> i {size = readt s}) & withOpt opts "size" (\s i -> i {size = readt s})
& withOpt opts "stroke" (\k i -> i {stroke = readt k}) & withOpt opts "stroke" (\k i -> i {stroke = readt k})
& withOpt opts "width" (\w i -> i {width = readt w}) & withOpt opts "width" (\w i -> i {width = readt w})
& withOpt opts "color" (\c i -> i {color = c}) & withOpt opts "color" (\c i -> i {color = c})
Nothing -> defaultImage txt₀ ?defColor Nothing -> defaultItem txt₀ ?defColor
where readt x = read $ Text.unpack x where readt x = read $ Text.unpack x
withOpt :: Ord k => Map k v -> k -> (v -> a -> a) -> (a -> a) withOpt :: Ord k => Map k v -> k -> (v -> a -> a) -> (a -> a)
@ -51,14 +47,13 @@ withOpt m k f =
Just v -> f v Just v -> f v
Nothing -> id Nothing -> id
defaultImage :: Text -> Text -> Image defaultItem :: Text -> Text -> Item
defaultImage txt color = defaultItem txt color =
Image { Item {
text = Text.filter notPunc txt, text = Text.filter notPunc txt,
title = toTitle txt, title = toTitle txt,
file = makeFile txt, size = 2,
size = 20, stroke = 1.25,
stroke = 0.75,
width = 600, width = 600,
color = color, color = color,
showText = True showText = True
@ -84,27 +79,16 @@ splitOpts :: Text -> Map Text Text
splitOpts = Map.fromList . map splitOpt . Text.splitOn ";" where splitOpts = Map.fromList . map splitOpt . Text.splitOn ";" where
splitOpt txt = fromMaybe ("file", txt) $ split1 "=" txt splitOpt txt = fromMaybe ("file", txt) $ split1 "=" txt
makeFile :: Text -> FilePath
makeFile txt = map stripWeird (Text.unpack txt) <.> "svg"
where stripWeird c = if weirdUrl c then '_' else c
toTitle :: Text -> Text toTitle :: Text -> Text
toTitle = Text.filter \c -> c /= '\\' && c /= '#' toTitle = Text.filter \c -> c /= '\\' && c /= '#'
makeImage :: Image -> IO Inline makeItem :: Item -> Inline
makeImage (Image {..}) = do makeItem (Item {..}) =
exe <- getEnv "LAANTAS_SCRIPT" let env = Laantas.E {..}
parent <- dropFileName <$> getEnv "FILENAME" words = Laantas.split text in
dir <- getEnv "DIRNAME" RawInline "html" $ Lazy.toStrict $ Laantas.prettyText $
let fullFile = dir </> file Laantas.doGlyphsNoDoctype words env `Laantas.with`
let relFile = Text.pack $ makeRelative parent fullFile [Laantas.Class_ Laantas.<<- "scr"]
callProcess exe
["-S", show size, "-K", show stroke, "-W", show width,
"-C", Text.unpack color, "-t", Text.unpack text, "-o", fullFile]
pure $ Pandoc.Image ("", ["scr","laantas"], []) [] (relFile, title)
weirdUrl :: Char -> Bool
weirdUrl c = c `elem` ("#\\?&_/.·,{} " :: String)
notPunc :: Char -> Bool notPunc :: Char -> Bool
notPunc c = c `notElem` ("{}·" :: String) notPunc c = c `notElem` ("{}·" :: String)

15
langfilter/Main.hs
View file

@ -25,13 +25,14 @@ main = toJSONFilter filter where
defColor <- getDefColor m defColor <- getDefColor m
let ?lang = lang let ?lang = lang
let ?defColor = defColor let ?defColor = defColor
fmap (walk fixFigureClass . pure $
walk makeEbnf . walk fixFigureClass $
walk makeQuotes . walk makeEbnf $
walk (concatMap makeBlocks) . walk makeQuotes $
walk inlineLetterList) $ walk (concatMap makeBlocks) $
walkM spans =<< walk inlineLetterList $
walkM (fmap concat . traverse glosses) p walk spans $
walk (concat . map glosses) p
getDefColor :: Map Text MetaValue -> IO Text getDefColor :: Map Text MetaValue -> IO Text
getDefColor m = do getDefColor m = do

38
langfilter/Spans.hs
View file

@ -10,19 +10,19 @@ import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
spans :: Vars => Inline -> IO Inline spans :: Vars => Inline -> Inline
spans = \case spans = \case
Code attrs txt Code attrs txt
| Just ('\\', txt') <- Text.uncons txt -> pure $ Code attrs txt' | Just ('\\', txt') <- Text.uncons txt -> Code attrs txt'
| Just txt' <- enclosed "⫽" "⫽" txt -> pure $ ipaA txt' | Just txt' <- enclosed "⫽" "⫽" txt -> ipaA txt'
| Just txt' <- enclosed "//" "//" txt -> pure $ ipaA txt' | Just txt' <- enclosed "//" "//" txt -> ipaA txt'
| Just _ <- enclosed "/" "/" txt -> pure $ ipaB txt | Just _ <- enclosed "/" "/" txt -> ipaB txt
| Just _ <- enclosed "[" "]" txt -> pure $ ipaN txt | Just _ <- enclosed "[" "]" txt -> ipaN txt
| Just txt' <- enclosed "{" "}" txt -> lang txt' | Just txt' <- enclosed "{" "}" txt -> lang txt'
| Just txt' <- enclosed "!" "!" txt -> pure $ abbr txt' | Just txt' <- enclosed "!" "!" txt -> abbr txt'
| Just txt' <- enclosed "*" "*" txt -> pure $ mark txt' | Just txt' <- enclosed "*" "*" txt -> mark txt'
| Just txt' <- enclosed "@" "@" txt -> pure $ dfn txt' | Just txt' <- enclosed "@" "@" txt -> dfn txt'
i -> pure i i -> i
ipaA, ipaB, ipaN, abbr, mark :: Text -> Inline ipaA, ipaB, ipaN, abbr, mark :: Text -> Inline
ipaA = Span (cls ["ipa", "ipa-arch"]) . text' . surround "⫽" ipaA = Span (cls ["ipa", "ipa-arch"]) . text' . surround "⫽"
@ -38,20 +38,16 @@ surround s txt = s <> txt <> s
text' :: Text -> [Inline] text' :: Text -> [Inline]
text' = toList . text text' = toList . text
lang :: Vars => Text -> IO Inline lang :: Vars => Text -> Inline
lang = fmap (Span (cls ["lang"])) . lang' lang = Span (cls ["lang"]) . lang'
lang' :: Vars => Text -> IO [Inline] lang' :: Vars => Text -> [Inline]
lang' txt₀ = case ?lang of lang' txt₀ = case ?lang of
Just Lántas Just Lántas
| Just li@(Image {..}) <- splitImage txt₀ -> | Just li@(Item {..}) <- splitItem txt₀,
if showText then do let label = Span (cls ["text"]) $ underlines title ->
img <- makeImage li if showText then [makeItem li, label] else [makeItem li]
pure $ [img, Span (cls ["text"]) $ underlines title] _ -> underlines txt₀
else
pure <$> makeImage li
_ ->
pure $ underlines txt₀
notBrace :: Char -> Bool notBrace :: Char -> Bool
notBrace c = c /= '{' && c /= '}' notBrace c = c /= '{' && c /= '}'

3
langfilter/langfilter.cabal
View file

@ -40,4 +40,5 @@ executable langfilter
process ^>= 1.6.11.0, process ^>= 1.6.11.0,
pandoc-types ^>= 1.23, pandoc-types ^>= 1.23,
text ^>= 2.1, text ^>= 2.1,
pretty-show ^>= 1.10 pretty-show ^>= 1.10,
laantas-script

4
pages/laantas/examples.md
View file

@ -26,7 +26,7 @@ conlang: lántas
rumi ńgua. Mulin Laksimat Fuham čaubam bulla. Gimimli Guwanḿ ufatta tílju, rumi ńgua. Mulin Laksimat Fuham čaubam bulla. Gimimli Guwanḿ ufatta tílju,
ŕ šikkúƶłm kukkimat šutta rumin júli. Mulin Guwanḿ bahútlit amat Laksimat ŕ šikkúƶłm kukkimat šutta rumin júli. Mulin Guwanḿ bahútlit amat Laksimat
Fuham suam bulla. Fuham suam bulla.
| file = northwind ; size = 50 ; stroke = 2 | size = 3 ; stroke = 2
}` }`
::: :::
@ -173,7 +173,7 @@ You know, [this thing]:
Natta agamatta luƶ fasḿ pašulúmlin lapusum sidam tisu. Natta agamatta luƶ fasḿ pašulúmlin lapusum sidam tisu.
Luƶ fasmamin duguwalúm dansu. Luƶ fasmamin duguwalúm dansu.
Luli nakasnai nuabiam dansutul. Luli nakasnai nuabiam dansutul.
| file = nwwm ; size = 50 ; stroke = 2 | size = 3 ; stroke = 2
}` }`
::: :::

2
pages/laantas/index.md
View file

@ -5,7 +5,7 @@ conlang: lántas
... ...
:::splash :::splash
`{#lántas | size = 200 ; stroke = 7}` `{#lántas | size = 20 ; stroke = 10}`
::: :::
1. [Phonology](phono.html) 1. [Phonology](phono.html)

6
pages/laantas/writing.md
View file

@ -13,7 +13,7 @@ a syllabic consonant. As a quick example, here's the first sentence of
:::example :::example
`{!Ruakul naipa bahútlit aimlis Laksimat Fuhamkas Guwanḿ asumsas ba sua. `{!Ruakul naipa bahútlit aimlis Laksimat Fuhamkas Guwanḿ asumsas ba sua.
| file = northwind0 ; size = 60 ; stroke = 2 }` | size = 4 ; stroke = 2 }`
::: :::
# Vowels # Vowels
@ -125,8 +125,8 @@ Punctuation in Lántas is very simple. Phrases within a sentence can be separate
by a single circle, and sentences are ended by a double circle: by a single circle, and sentences are ended by a double circle:
:::letter-list :::letter-list
`{!ta, ta | file=comma}` `{!ta, ta}`
`{!ta. ta | file=fullstop}` `{!ta. ta}`
::: :::
Both have an equal amount of space either side, more for the second one, and if Both have an equal amount of space either side, more for the second one, and if

1
style/page.css
View file

@ -199,6 +199,7 @@ blockquote {
} }
.letter-list .scr { .letter-list .scr {
width: auto;
height: 3em; height: 3em;
margin-left: 0.5em; margin-left: 0.5em;
} }