WIP: new improved lántas script #1

Closed
rhi wants to merge 13 commits from new-glyphs into main
6 changed files with 530 additions and 428 deletions

File diff suppressed because it is too large Load Diff

View File

@ -3,13 +3,23 @@ module GlyphsBase (module GlyphsBase, module Svg) where
import Svg hiding (shiftX, shiftY, shift, width, size) import Svg hiding (shiftX, shiftY, shift, width, size)
import qualified Svg import qualified Svg
import Data.List.NonEmpty (NonEmpty (..)) import Prelude hiding (Word)
import Data.Semigroup (sconcat) import Data.Foldable
import Numeric import Numeric
import Prelude hiding (Word) import Prelude hiding (Word)
data Glyph = G {path :: Segs, width :: Double} data Glyph = G {path :: Segs, size :: SizeInfo}
data SizeInfo = SI {
width :: Double, -- ^ total width
right :: Double, -- ^ attachment point for e.g. a
center :: Double -- ^ attachment point for e.g. á
}
simpleG :: Segs -> Double -> Glyph
simpleG path width =
G {path, size = SI {width, right = width, center = width/2}}
-- | base amounts -- | base amounts
charHeight', lineHeight', spaceWidth', gap' :: Double charHeight', lineHeight', spaceWidth', gap' :: Double
@ -74,23 +84,39 @@ run m e@(E {size}) =
textWidth = 0, textHeight = 0, firstOnLine = True} textWidth = 0, textHeight = 0, firstOnLine = True}
type EGlyph = (Glyph, [Segs]) type Word = [EGlyph]
type Word = [EGlyph]
type EGlyph = (Glyph, [Diacritic])
type Diacritic' a = SizeInfo -> (Segs, a)
type Diacritic = Diacritic' Double
simpleDia :: Segs -> Diacritic
simpleDia ss (SI {width}) = (ss, width)
doGlyphs :: [Word] -> Env -> Element doGlyphs :: [Word] -> Env -> Element
doGlyphs gs e = wrap $ run act e where doGlyphs gs e = wrap $ run act e where
act = do act = do
E {stroke, color} <- ask E {stroke, color} <- ask
let gattrs = [Stroke_ <<- color, Stroke_width_ <<- toPx stroke, let gattrs = [Stroke_ <<- color, Stroke_width_ <<- toPx stroke,
Stroke_linecap_ <<- "round", Fill_ <<- "none"] Stroke_linecap_ <<- "round", Stroke_linejoin_ <<- "round",
Fill_ <<- "none"]
g_ gattrs . mconcat <$> traverse placeWord gs <* newline g_ gattrs . mconcat <$> traverse placeWord gs <* newline
wrap (content, T {width, height}) = wrap (content, T {width, height}) =
let sattrs = [Height_ <<- toPx height, Width_ <<- toPx width] in let sattrs = [Height_ <<- toPx height, Width_ <<- toPx width] in
doctype <> svg11_ content `with` sattrs doctype <> svg11_ content `with` sattrs
liftDia :: Diacritic -> Diacritic' SizeInfo
liftDia f sz = let (x, w) = f sz in (x, sz {width = w} :: SizeInfo)
glyphWidth :: EGlyph -> M Double glyphWidth :: EGlyph -> M Double
glyphWidth (G {width}, _) = (+) <$> withSize (* width) <*> gap glyphWidth (G {size}, ss) =
let SI {width} = foldl (\x f -> snd $ liftDia f x) size ss in
(+) <$> withSize (* width) <*> gap
totalWidth :: Double -> M Double
totalWidth width = (+) <$> withSize (* width) <*> gap
wordWidth :: Word -> M Double wordWidth :: Word -> M Double
wordWidth = fmap sum . traverse glyphWidth wordWidth = fmap sum . traverse glyphWidth
@ -110,11 +136,17 @@ placeWord w = do
pure e pure e
placeGlyph :: EGlyph -> M Element placeGlyph :: EGlyph -> M Element
placeGlyph g@(G {path = path1}, segss) = do placeGlyph (G {path = path1, size}, dias) = do
gwidth <- glyphWidth g let (segs', width') = placeDias size dias
path' <- joinSegs $ sconcat (path1 :| segss) path <- joinSegs $ path1 <> segs'
modify \s@(S {x}) -> s {x = x + gwidth} width <- totalWidth width'
pure $ path_ [D_ <<- path'] modify \s@(S {x}) -> s {x = x + width}
pure $ path_ [D_ <<- path]
placeDias :: SizeInfo -> [Diacritic] -> (Segs, Double)
placeDias sz =
unlift . flip runState sz . fmap fold . traverse (state . liftDia)
where unlift (x, SI {width}) = (x, width)
newline :: M () newline :: M ()
newline = do newline = do

View File

@ -29,8 +29,8 @@ maxFrom name i = longestWith name \x -> Map.lookup x i
initial :: P Glyph initial :: P Glyph
initial = maxFrom "initial" initials initial = maxFrom "initial" initials
medial :: P Segs medial :: P [Diacritic]
medial = P [] <$ chunk "\\" <|> maxFrom "medial" medials medial = [] <$ chunk "\\" <|> maxFrom "medial" medials
final :: P Glyph final :: P Glyph
final = maxFrom "final" finals final = maxFrom "final" finals
@ -38,29 +38,29 @@ final = maxFrom "final" finals
ivowel :: P Glyph ivowel :: P Glyph
ivowel = maxFrom "vowel" vowels ivowel = maxFrom "vowel" vowels
word :: P [Piece] word :: P [EGlyph]
word = [is <> f <> concat p | is <- some initMed, f <- fin, p <- many punct] word = [is <> f <> concat p | is <- some initMed, f <- fin, p <- many punct]
where where
initMed = try $ initMed = try $
[(i, [m]) | i <- initial, m <- medial] <|> (,) <$> initial <*> medial <|>
[(v, []) | v <- ivowel] <|> [(v, []) | v <- ivowel] <|>
dash dash
fin = maybe [] (\x -> [(x, [])]) <$> optional final fin = maybe [] (\x -> [(x, [])]) <$> optional final
number :: P [Piece] number :: P [EGlyph]
number = some (digit <|> hash) where number = some (digit <|> hash) where
hash = (num, []) <$ chunk "#" hash = (num, []) <$ chunk "#"
digit = [(numbers ! Char.digitToInt i, []) | i <- digitChar] digit = [(numbers ! Char.digitToInt i, []) | i <- digitChar]
punct :: P [Piece] punct :: P [EGlyph]
punct = [[(p, [])] | p <- maxFrom "punctuation" punctuation] <* space punct = [[(p, [])] | p <- maxFrom "punctuation" punctuation] <* space
dash :: P Piece dash :: P EGlyph
dash = (wave, []) <$ chunk "" dash = (wave, []) <$ chunk ""
text :: P [[Piece]] text :: P [[EGlyph]]
text = space *> many (segment <* space) <* eof where text = space *> many (segment <* space) <* eof where
segment = punct <|> number <|> word segment = punct <|> number <|> word
split :: Text -> [[Piece]] split :: Text -> [[EGlyph]]
split = either (error . errorBundlePretty) id . parse text "" split = either (error . errorBundlePretty) id . parse text ""

View File

@ -9,7 +9,8 @@ where
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.State import Control.Monad.State
import qualified Graphics.Svg as Base import qualified Graphics.Svg as Base
import Graphics.Svg hiding (mA, mR, lA, lR, cA, cR, sA, sR, aA, aR) import Graphics.Svg
hiding (mA, mR, lA, lR, cA, cR, sA, sR, aA, aR, qA, qR, tA, tR)
import Data.Text (Text, pack) import Data.Text (Text, pack)
@ -66,6 +67,28 @@ cR (x1, y1) (x2, y2) (x3, y3) =
(x3 * size) (y3 * size) (x3 * size) (y3 * size)
<> " " -- lmao <> " " -- lmao
qA :: Point -> Point -> M Text
qA (x1, y1) (x2, y2) =
reader \E {size} ->
Base.qA (x1 * size) (y1 * size)
(x2 * size) (y2 * size)
qR :: Point -> Point -> M Text
qR (x1, y1) (x2, y2) =
reader \E {size} ->
Base.qR (x1 * size) (y1 * size)
(x2 * size) (y2 * size)
tA :: Point -> M Text
tA (x1, y1) =
reader \E {size} ->
Base.tA (x1 * size) (y1 * size)
tR :: Point -> M Text
tR (x1, y1) =
reader \E {size} ->
Base.tR (x1 * size) (y1 * size)
data Arc = Large | Small data Arc = Large | Small
data Sweep = CW | CCW data Sweep = CW | CCW

View File

@ -27,7 +27,8 @@ executable laantas-script
MultiWayIf, MultiWayIf,
NamedFieldPuns, NamedFieldPuns,
OverloadedStrings, OverloadedStrings,
RecordWildCards RecordWildCards,
ViewPatterns
build-depends: build-depends:
base ^>= 4.14.0.0, base ^>= 4.14.0.0,
containers ^>= 0.6.2.1, containers ^>= 0.6.2.1,

View File

@ -40,9 +40,9 @@ In other cases, vowels are attached to the letter for the previous consonant.
The basic consonant shapes are: The basic consonant shapes are:
:::letter-list :::letter-list
`{!t\}` `{!k\}` `{!g\}` `{!d\}` `{!ƶ\}` `{!p\}` `{!b\}` `{!ta}` `{!ka}` `{!ga}` `{!da}` `{!ƶa}` `{!pa}` `{!ba}`
`{!s\}` `{!š\}` `{!l\}` `{!m\}` `{!n\}` `{!č\}` `{!ǧ\}` `{!sa}` `{!ša}` `{!la}` `{!ma}` `{!na}` `{!ča}` `{!ǧa}`
`{!w\}` `{!h\}` `{!f\}` `{!j\}` `{!r\}` `{!wa}` `{!ha}` `{!fa}` `{!ja}` `{!ra}`
::: :::
Clusters are written with a single glyph called a 'conjunct'. These aren't Clusters are written with a single glyph called a 'conjunct'. These aren't
@ -61,54 +61,54 @@ surprising.
</nav> </nav>
::: {.letter-list #conj-t} ::: {.letter-list #conj-t}
`{!tt\}` `{!tk\}` `{!tg\}` `{!td\}` `{!tƶ\}` `{!tp\}` `{!tb\}` `{!ts\}` `{!tta}` `{!tka}` `{!tga}` `{!tda}` `{!tƶa}` `{!tpa}` `{!tba}` `{!tsa}`
`{!tš\}` `{!tl\}` `{!tm\}` `{!tn\}` `{!tr\}` `{!tč\}` `{!tǧ\}` `{!tw\}` `{!tla}` `{!tma}` `{!tna}` `{!tra}` `{!tča}` `{!tǧa}` `{!twa}` `{!tha}`
`{!th\}` `{!tf\}` `{!tj\}` `{!tfa}` `{!tja}`
::: :::
::: {.letter-list #conj-ƶ} ::: {.letter-list #conj-ƶ}
`{!ƶt\}` `{!ƶk\}` `{!ƶg\}` `{!ƶd\}` `{!ƶƶ\}` `{!ƶp\}` `{!ƶb\}` `{!ƶs\}` `{!ƶta}` `{!ƶka}` `{!ƶga}` `{!ƶda}` `{!ƶƶa}` `{!ƶpa}` `{!ƶba}` `{!ƶsa}`
`{!ƶš\}` `{!ƶl\}` `{!ƶm\}` `{!ƶn\}` `{!ƶr\}` `{!ƶč\}` `{!ƶǧ\}` `{!ƶw\}` `{!ƶla}` `{!ƶma}` `{!ƶna}` `{!ƶra}` `{!ƶča}` `{!ƶǧa}` `{!ƶwa}` `{!ƶha}`
`{!ƶh\}` `{!ƶf\}` `{!ƶj\}` `{!ƶfa}` `{!ƶja}`
::: :::
::: {.letter-list #conj-s} ::: {.letter-list #conj-s}
`{!st\}` `{!sk\}` `{!sg\}` `{!sd\}` `{!sƶ\}` `{!sp\}` `{!sb\}` `{!ss\}` `{!sta}` `{!ska}` `{!sga}` `{!sda}` `{!sƶa}` `{!spa}` `{!sba}` `{!ssa}`
`{!sš\}` `{!sl\}` `{!sm\}` `{!sn\}` `{!sr\}` `{!sč\}` `{!sǧ\}` `{!sw\}` `{!sla}` `{!sma}` `{!sna}` `{!sra}` `{!sča}` `{!sǧa}` `{!swa}` `{!sha}`
`{!sh\}` `{!sf\}` `{!sj\}` `{!šš\}` `{!sfa}` `{!sja}` `{!šša}`
::: :::
Conjuncts with `{!š\}` are the same as with `{!s\}`, but with the line above. In Conjuncts with `{!ša}` are the same as with `{!sa}`, but with the line above. In
the case of `{!šš\}` the lines join up. the case of `{!šša}` the lines join up.
::: {.letter-list #conj-l} ::: {.letter-list #conj-l}
`{!lt\}` `{!lk\}` `{!lg\}` `{!ld\}` `{!lƶ\}` `{!lp\}` `{!lb\}` `{!ls\}` `{!lta}` `{!lka}` `{!lga}` `{!lda}` `{!lƶa}` `{!lpa}` `{!lba}` `{!lsa}`
`{!lš\}` `{!ll\}` `{!lm\}` `{!ln\}` `{!lr\}` `{!lč\}` `{!lǧ\}` `{!lw\}` `{!lla}` `{!lma}` `{!lna}` `{!lra}` `{!lča}` `{!lǧa}` `{!lwa}` `{!lha}`
`{!lh\}` `{!lf\}` `{!lj\}` `{!lfa}` `{!lja}`
::: :::
::: {.letter-list #conj-m} ::: {.letter-list #conj-m}
`{!mt\}` `{!mk\}` `{!mg\}` `{!md\}` `{!mƶ\}` `{!mp\}` `{!mb\}` `{!ms\}` `{!mta}` `{!mka}` `{!mga}` `{!mda}` `{!mƶa}` `{!mpa}` `{!mba}` `{!msa}`
`{!mš\}` `{!ml\}` `{!mm\}` `{!mn\}` `{!mr\}` `{!mč\}` `{!mǧ\}` `{!mw\}` `{!mla}` `{!mma}` `{!mna}` `{!mra}` `{!mča}` `{!mǧa}` `{!mwa}` `{!mha}`
`{!mh\}` `{!mf\}` `{!mj\}` `{!mfa}` `{!mja}`
::: :::
::: {.letter-list #conj-n} ::: {.letter-list #conj-n}
`{!nt\}` `{!nk\}` `{!ng\}` `{!nd\}` `{!nƶ\}` `{!np\}` `{!nb\}` `{!ns\}` `{!nta}` `{!nka}` `{!nga}` `{!nda}` `{!nƶa}` `{!npa}` `{!nba}` `{!nsa}`
`{!nš\}` `{!nl\}` `{!nm\}` `{!nn\}` `{!nr\}` `{!nč\}` `{!nǧ\}` `{!nw\}` `{!nla}` `{!nma}` `{!nna}` `{!nra}` `{!nča}` `{!nǧa}` `{!nwa}` `{!nha}`
`{!nh\}` `{!nf\}` `{!nj\}` `{!nfa}` `{!nja}`
::: :::
::: {.letter-list #conj-r} ::: {.letter-list #conj-r}
`{!rt\}` `{!rk\}` `{!rg\}` `{!rd\}` `{!rƶ\}` `{!rp\}` `{!rb\}` `{!rs\}` `{!rta}` `{!rka}` `{!rga}` `{!rda}` `{!rƶa}` `{!rpa}` `{!rba}` `{!rsa}`
`{!rš\}` `{!rl\}` `{!rm\}` `{!rn\}` `{!rr\}` `{!rč\}` `{!rǧ\}` `{!rw\}` `{!rla}` `{!rma}` `{!rna}` `{!rra}` `{!rča}` `{!rǧa}` `{!rwa}` `{!rha}`
`{!rh\}` `{!rf\}` `{!rj\}` `{!rfa}` `{!rja}`
::: :::
::: {.letter-list #conj-o} ::: {.letter-list #conj-o}
`{!kk\}` `{!ks\}` `{!pp\}` `{!ps\}` `{!pj\}` `{!kka}` `{!ksa}` `{!ppa}` `{!psa}` `{!pja}`
`{!bj\}` `{!čs\}` `{!čč\}` `{!hh\}` `{!bja}` `{!čsa}` `{!čča}` `{!hha}`
`{!hn\}` `{!hm\}` `{!fn\}` `{!fm\}` `{!hna}` `{!hma}` `{!fna}` `{!fma}`
::: :::
If a word ends in a consnant, a horizontal line is drawn under it to specify If a word ends in a consnant, a horizontal line is drawn under it to specify