laantas-script/GlyphsBase.hs

@@ -3,13 +3,23 @@ module GlyphsBase (module GlyphsBase, module Svg) where
 import Svg hiding (shiftX, shiftY, shift, width, size)
 import qualified Svg
 
-import Data.List.NonEmpty (NonEmpty (..))
-import Data.Semigroup (sconcat)
+import Prelude hiding (Word)
+import Data.Foldable
 import Numeric
 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
 charHeight', lineHeight', spaceWidth', gap' :: Double
@@ -74,23 +84,39 @@ run m e@(E {size}) =
            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 gs e = wrap $ run act e where
   act = do
     E {stroke, color} <- ask
     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
   wrap (content, T {width, height}) =
     let sattrs = [Height_ <<- toPx height, Width_ <<- toPx width] in
     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 (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 = fmap sum . traverse glyphWidth
@@ -110,11 +136,17 @@ placeWord w = do
   pure e
 
 placeGlyph :: EGlyph -> M Element
-placeGlyph g@(G {path = path1}, segss) = do
-  gwidth <- glyphWidth g
-  path' <- joinSegs $ sconcat (path1 :| segss)
-  modify \s@(S {x}) -> s {x = x + gwidth}
-  pure $ path_ [D_ <<- path']
+placeGlyph (G {path = path1, size}, dias) = do
+  let (segs', width') = placeDias size dias
+  path <- joinSegs $ path1 <> segs'
+  width <- totalWidth width'
+  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 = do

laantas-script/Split.hs

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

laantas-script/Svg.hs

@@ -9,7 +9,8 @@ where
 import Control.Monad.Reader
 import Control.Monad.State
 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)
 
 
@@ -66,6 +67,28 @@ cR (x1, y1) (x2, y2) (x3, y3) =
             (x3 * size) (y3 * size)
     <> " " -- 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 Sweep = CW | CCW

laantas-script/laantas-script.cabal

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

pages/laantas/writing.md

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