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)
glosses :: Vars => Block -> IO [Block]
glosses :: Vars => Block -> [Block]
glosses = \case
Div (i, cs, _) blocks | "glosses" `elem` cs -> do
tables <- traverse glossTable blocks
pure $
[RawBlock (Format "html") $ "<figure" <> id <> classes <> ">"] ++
catMaybes tables ++
[RawBlock (Format "html") "</figure>"]
Div (i, cs, _) blocks | "glosses" `elem` cs ->
let tables = map glossTable blocks in
[RawBlock (Format "html") $ "<figure" <> id <> classes <> ">"] ++
catMaybes tables ++
[RawBlock (Format "html") "</figure>"]
where
id = if i == "" then "" else " id=\"" <> i <> "\""
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 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 =
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
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
PNGloss l b n s g t -> Just <$> make l (Just b) (Just n) s g t
HorizontalRule -> pure Nothing
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
PNGloss l b n s g t -> Just $ make l (Just b) (Just n) s g t
HorizontalRule -> Nothing
BulletList xs | let ℓ = length xs, ℓ < 4 || ℓ > 6 ->
fail $ "found list of length " ++ show ℓ ++
" in gloss section (missing `---`?)"
b -> fail $ "found unexpected " ++ show (toConstr b) ++ " in gloss section"
where
make l b n s g t = do
make l b n s g t =
let ℓ = length $ splitInlines s
let colspecs = replicate ℓ (AlignDefault, ColWidthDefault)
let l' = cell1 ℓ $ underlines $ noHash l
colspecs = replicate ℓ (AlignDefault, ColWidthDefault)
l' = cell1 ℓ $ underlines $ noHash l
b' = cell1 ℓ <$> b; n' = cell1 ℓ <$> n
let ss = cells s; gs = cells g; t' = cell1 ℓ t
img <- case ?lang of
Just Lántas ->
[Just $ cell1 ℓ [img] | img <- makeImage $ splitImage' $ stripInlines l]
Nothing -> pure Nothing
pure $ Table ("", ["gloss"], []) (Caption Nothing []) colspecs
ss = cells s; gs = cells g; t' = cell1 ℓ t
img = case ?lang of
Just Lántas -> Just $ cell1 ℓ [makeItem $ splitItem' $ stripInlines l]
Nothing -> Nothing
in
Table ("", ["gloss"], []) (Caption Nothing []) colspecs
(TableHead mempty [])
[TableBody mempty (RowHeadColumns 0) [] $ concat
[[row ["gloss-scr", "scr"] [i] | Just i <- [img]],

72
langfilter/LaantasImage.hs
View file

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

15
langfilter/Main.hs
View file

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

38
langfilter/Spans.hs
View file

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

3
langfilter/langfilter.cabal
View file

@ -40,4 +40,5 @@ executable langfilter
process ^>= 1.6.11.0,
pandoc-types ^>= 1.23,
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,
ŕ šikkúƶłm kukkimat šutta rumin júli. Mulin Guwanḿ bahútlit amat Laksimat
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.
Luƶ fasmamin duguwalúm dansu.
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
`{#lántas | size = 200 ; stroke = 7}`
`{#lántas | size = 20 ; stroke = 10}`
:::
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
`{!Ruakul naipa bahútlit aimlis Laksimat Fuhamkas Guwanḿ asumsas ba sua.
| file = northwind0 ; size = 60 ; stroke = 2 }`
| size = 4 ; stroke = 2 }`
:::
# 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:
:::letter-list
`{!ta, ta | file=comma}`
`{!ta. ta | file=fullstop}`
`{!ta, ta}`
`{!ta. ta}`
:::
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 {
width: auto;
height: 3em;
margin-left: 0.5em;
}