WIP: new improved lántas script #1
6 changed files with 530 additions and 428 deletions
File diff suppressed because it is too large
Load diff
|
@ -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
|
||||||
|
|
|
@ -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 ""
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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,
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Add table
Reference in a new issue