lántas script stuff

laantas-script/Glyphs.hs

@@ -1,41 +1,54 @@
 {-# OPTIONS_GHC -Wno-missing-signatures -Wno-name-shadowing #-}
 
 module Glyphs
-  (module GlyphsBase,
+  (Glyph (..), Segs (..), Piece, doGlyphs,
-   glyphs, mods)
+   withSize, size,
+   charHeight', lineHeight', spaceWidth', gap',
+   charHeight, lineHeight, spaceWidth, gap,
+
+   initials, finals, vowels, medials, num, numbers, punctuation)
 where
 
-import qualified Data.Map as Map
+import Data.Map (Map)
+import qualified Data.Map.Strict as Map
 import GlyphsBase
 
 
-glyphs :: Map.Map Text Glyph
+type Piece = (Glyph, [Segs])
-glyphs = Map.fromList $
+
-  tGlyphs <> kGlyphs <> ðGlyphs <> sGlyphs <> šGlyphs <> lGlyphs <>
+initials :: Map Text Glyph
+initials = Map.fromList $
+  tGlyphs <> kGlyphs <> ƶGlyphs <> sGlyphs <> šGlyphs <> lGlyphs <>
   mGlyphs <> nGlyphs <> rGlyphs <> pGlyphs <> bGlyphs <>
-  čGlyphs <> hGlyphs <> fGlyphs <> vGlyphs <>
+  čGlyphs <> hGlyphs <> fGlyphs <>
-  [("g", g), ("d", d), ("ǧ", ǧ), ("w", w), ("j", j)] <>
+  [("g", g), ("d", d), ("ǧ", ǧ), ("w", w), ("j", j)]
-  numbers <> punctuation
 
+finals :: Map Text Glyph
+finals = Map.fromList $
+  [("t",t0), ("ƶ", ƶ0), ("s",s0), ("š",š0), ("l",l0), ("m",m0),
+   ("n", n0), ("r", r0), ("f", f0)]
 
-mods :: Map.Map Text Segs
+medials :: Map Text Segs
-mods = Map.fromList $
+medials = Map.fromList $
   [("a", da), ("á", dá), ("i", di), ("í", dí), ("u", du), ("ú", dú),
    ("ai", dai), ("au", dau), ("ia", dia), ("ua", dua), ("ḿ", dḿ),
    ("ń", dń), ("ł", dł), ("ŕ", dŕ)]
 
+vowels :: Map Text Glyph
+vowels = Map.fromList vGlyphs
 
-tGlyphs = [("t",t), ("tt",tt), ("tk",tk), ("tg",tg), ("td",td), ("tð",tð),
+
+tGlyphs = [("t",t), ("tt",tt), ("tk",tk), ("tg",tg), ("td",td), ("tƶ",tƶ),
            ("tp",tp), ("tb",tb), ("ts",ts), ("tš",tš), ("tl",tl), ("tm",tm),
            ("tn",tn), ("tr",tr), ("tč",tč), ("tǧ",tǧ), ("tw",tw), ("th",th),
-           ("tf",tf), ("tj",tj), ("t0",t0)]
+           ("tf",tf), ("tj",tj)]
 
 t  = G {path = tPath, width = 5}
 tt = G {path = ttPath, width = 6}
 tk = G {path = tkPath, width = 9}
 tg = G {path = tgPath, width = 9}
 td = G {path = tdPath, width = 9}
-tð = G {path = tðPath, width = 9}
+tƶ = G {path = tƶPath, width = 9}
 tp = G {path = tpPath, width = 9}
 tb = G {path = tbPath, width = 10}
 ts = G {path = tsPath, width = 9}
@@ -59,7 +72,7 @@ ttPath = P [mA (1,0), lR (0,5), mA (3,0), lR (0,5), mA (5,0), lR (0,5),
 tkPath = tPart 5 <> shiftX 5 kShort
 tgPath = tPart 5 <> shiftX 5 gShort
 tdPath = tPart 4 <> shiftX 4 dPath
-tðPath = tdPath <> P [mA (6,-3), lR (3,0)]
+tƶPath = tdPath <> P [mA (6,-3), lR (3,0)]
 tpPath = P [mA (2,-3), lR (0,8), mA (0,-3), lR (5.5,0)] <> shiftX 4 pPath
 tbPath = tPart 6 <> shiftX 4 bPath
 tsPath = tPart 4 <> shiftX 4 sPath
@@ -106,56 +119,54 @@ dBase = P [mA (0,0), lR (3.5,0), cR (0,1.5) (-3.5,3.5) (-3.5,5), lR (2,0)]
 dFree = dBase <> P [mA (2,5), lR (1.5,0)]
 dLong = dFree <> shiftX 1.5 dJoin
 
-ðGlyphs = [("ð",ð), ("þ",þ), ("ðt",ðt), ("ðk",ðk), ("ðg",ðg), ("ðd",ðd),
+ƶGlyphs = [("ƶ",ƶ), ("ƶt",ƶt), ("ƶk",ƶk), ("ƶg",ƶg), ("ƶd",ƶd),
-           ("ðð",ðð), ("ðp",ðp), ("ðb",ðb), ("ðs",ðs), ("ðš",ðš), ("ðl",ðl),
+           ("ƶƶ",ƶƶ), ("ƶp",ƶp), ("ƶb",ƶb), ("ƶs",ƶs), ("ƶš",ƶš), ("ƶl",ƶl),
-           ("ðm",ðm), ("ðn",ðn), ("ðr",ðr), ("ðč",ðč), ("ðǧ",ðǧ), ("ðw",ðw),
+           ("ƶm",ƶm), ("ƶn",ƶn), ("ƶr",ƶr), ("ƶč",ƶč), ("ƶǧ",ƶǧ), ("ƶw",ƶw),
-           ("ðh",ðh), ("ðf",ðf), ("ðj",ðj), ("ð0", ð0)]
+           ("ƶh",ƶh), ("ƶf",ƶf), ("ƶj",ƶj)]
 
-ð = þ
+ƶ = G {path = ƶPath, width = 5}
-þ = G {path = þPath, width = 5}
+ƶt = G {path = ƶtPath, width = 10}
-ðt = G {path = ðtPath, width = 10}
+ƶk = G {path = ƶkPath, width = 9}
-ðk = G {path = ðkPath, width = 9}
+ƶg = G {path = ƶgPath, width = 9}
-ðg = G {path = ðgPath, width = 9}
+ƶd = G {path = ƶdPath, width = 10}
-ðd = G {path = ðdPath, width = 10}
+ƶƶ = G {path = ƶƶPath, width = 10}
-ðð = G {path = ððPath, width = 10}
+ƶp = G {path = ƶpPath, width = 10}
-ðp = G {path = ðpPath, width = 10}
+ƶb = G {path = ƶbPath, width = 11}
-ðb = G {path = ðbPath, width = 11}
+ƶs = G {path = ƶsPath, width = 10}
-ðs = G {path = ðsPath, width = 10}
+ƶš = G {path = ƶšPath, width = 10}
-ðš = G {path = ðšPath, width = 10}
+ƶl = G {path = ƶlPath, width = 10}
-ðl = G {path = ðlPath, width = 10}
+ƶm = G {path = ƶmPath, width = 11}
-ðm = G {path = ðmPath, width = 11}
+ƶn = G {path = ƶnPath, width = 10}
-ðn = G {path = ðnPath, width = 10}
+ƶr = G {path = ƶrPath, width = 10}
-ðr = G {path = ðrPath, width = 10}
+ƶč = G {path = ƶčPath, width = 10}
-ðč = G {path = ðčPath, width = 10}
+ƶǧ = G {path = ƶǧPath, width = 10}
-ðǧ = G {path = ðǧPath, width = 10}
+ƶw = G {path = ƶwPath, width = 11}
-ðw = G {path = ðwPath, width = 11}
+ƶh = G {path = ƶhPath, width = 13}
-ðh = G {path = ðhPath, width = 13}
+ƶf = G {path = ƶfPath, width = 11}
-ðf = G {path = ðfPath, width = 11}
+ƶj = G {path = ƶjPath, width = 7}
-ðj = G {path = ðjPath, width = 7}
+ƶ0 = G {path = ƶ0Path, width = 3.5}
-ð0 = G {path = ð0Path, width = 3.5}
 
-þPath = dPath <> P [mA (1,-3), lR (4,0), mA (5,5)]
+ƶPath = dPath <> P [mA (1,-3), lR (4,0), mA (5,5)]
-ðPath = þPath
+ƶtPath = dLong <> shiftX 5 tPath
-ðtPath = dLong <> shiftX 5 tPath
+ƶkPath = dPart <> shiftX 5 kShort
-ðkPath = dPart <> shiftX 5 kShort
+ƶgPath = dPart <> shiftX 5 gShort
-ðgPath = dPart <> shiftX 5 gShort
+ƶdPath = dFree <> shiftX 5 dPath <> P [mA (1,-2), lR (2,0)]
-ðdPath = dFree <> shiftX 5 dPath <> P [mA (1,-2), lR (2,0)]
+ƶƶPath = dFree <> shiftX 5 ƶPath
-ððPath = dFree <> shiftX 5 ðPath
+ƶpPath = dFree <> shiftX 5 pPath
-ðpPath = dFree <> shiftX 5 pPath
+ƶbPath = dPart <> shiftX 5 bPath
-ðbPath = dPart <> shiftX 5 bPath
+ƶsPath = dPart <> shiftX 5 sPath
-ðsPath = dPart <> shiftX 5 sPath
+ƶšPath = dPart <> shiftX 5 šPath
-ðšPath = dPart <> shiftX 5 šPath
+ƶlPath = dPart <> shiftX 5 lPath
-ðlPath = dPart <> shiftX 5 lPath
+ƶmPath = dPart <> shiftX 5 mPath
-ðmPath = dPart <> shiftX 5 mPath
+ƶnPath = dPart <> shiftX 5 nPath
-ðnPath = dPart <> shiftX 5 nPath
+ƶrPath = dPart <> shiftX 5 rCursive
-ðrPath = dPart <> shiftX 5 rCursive
+ƶčPath = dFree <> shiftX 5 čPath
-ðčPath = dFree <> shiftX 5 čPath
+ƶǧPath = dFree <> shiftX 5 ǧPath
-ðǧPath = dFree <> shiftX 5 ǧPath
+ƶwPath = dPart <> shiftX 5 wPath
-ðwPath = dPart <> shiftX 5 wPath
+ƶhPath = dPart <> shiftX 5 hPath
-ðhPath = dPart <> shiftX 5 hPath
+ƶfPath = dFree <> shiftX 4 fPath
-ðfPath = dFree <> shiftX 4 fPath
+ƶjPath = dFree <> shiftX 4 fPath
-ðjPath = dFree <> shiftX 4 fPath
+ƶ0Path = dFree <> P [mA (0,7), lR (3.5,0)]
-ð0Path = dFree <> P [mA (0,7), lR (3.5,0)]
 
 
 pGlyphs = [("p", p), ("pp", pp), ("ps", ps), ("pj", pj)]
@@ -182,17 +193,17 @@ bPath = wPart <> P [mA (2,-3), lR (4,0), lR (0,8)]
 bjPath = bPath <> P [mA (6,-3), lR (3,0), lR (0,8)]
 
 
-sGlyphs = [("s",s), ("st",st), ("sk",sk), ("sg",sg), ("sd",sd), ("sð",sð),
+sGlyphs = [("s",s), ("st",st), ("sk",sk), ("sg",sg), ("sd",sd), ("sƶ",sƶ),
            ("sp",sp), ("sb",sb), ("ss",ss), ("sš",sš), ("sl",sl), ("sm",sm),
            ("sn",sn), ("sr",sr), ("sč",sč), ("sǧ",sǧ), ("sw",sw), ("sh",sh),
-           ("sf",sf), ("sj",sj), ("s0",s0)]
+           ("sf",sf), ("sj",sj)]
 
 s = G {path = sPath, width = 5}
 st = G {path = stPath, width = 9}
 sk = G {path = skPath, width = 9}
 sg = G {path = sgPath, width = 9}
 sd = G {path = sdPath, width = 9}
-sð = G {path = sðPath, width = 9}
+sƶ = G {path = sƶPath, width = 9}
 sp = G {path = spPath, width = 10}
 sb = G {path = sbPath, width = 10}
 ss = G {path = ssPath, width = 10}
@@ -216,7 +227,7 @@ stPath = sPartLine <> shiftX 4 tPath
 skPath = sPartLine <> shiftX 5 kShort
 sgPath = sPartLine <> shiftX 5 gShort
 sdPath = sPart <> P [mA (3,0), lR (1,0)] <> shiftX 4 dPath
-sðPath = sPart <> P [mA (3,0), lR (1,0)] <> shiftX 4 ðPath
+sƶPath = sPart <> P [mA (3,0), lR (1,0)] <> shiftX 4 ƶPath
 spPath = sPart <> P [mA (3,0), lR (3.5,0)] <> shiftX 5 pPath
 sbPath = sPart <> shiftX 4 bPath <> P [mA (3,0), lR (0,-3), lR (3.5,0)]
 ssPath = sPartLine <> shiftX 5 sPath
@@ -235,10 +246,10 @@ sjPath = P [mA (0,0), lR (0,3.5), aR 1.5 1.5 0 Small CCW (3,0), lR (0,-1.5),
 s0Path = sPath <> P [mA (0.5,7), lR (4,0)]
 
 
-šGlyphs = [("š",š), ("št",št), ("šk",šk), ("šg",šg), ("šd",šd), ("šð",šð),
+šGlyphs = [("š",š), ("št",št), ("šk",šk), ("šg",šg), ("šd",šd), ("šƶ",šƶ),
            ("šp",šp), ("šb",šb), ("šs",šs), ("šš",šš), ("šl",šl), ("šm",šm),
            ("šn",šn), ("šr",šr), ("šč",šč), ("šǧ",šǧ), ("šw",šw), ("šh",šh),
-           ("šf",šf), ("šj",šj), ("š0",š0)]
+           ("šf",šf), ("šj",šj)]
 
 š = G {path = šPath, width = 5}
 šš = ss {path = ššPath}
@@ -248,7 +259,7 @@ s0Path = sPath <> P [mA (0.5,7), lR (4,0)]
 šk = s2š sk
 šg = s2š sg
 šd = s2š sd
-šð = s2š sð
+šƶ = s2š sƶ
 šs = s2š ss
 šl = s2š sl
 šm = s2š sm
@@ -270,17 +281,17 @@ s0Path = sPath <> P [mA (0.5,7), lR (4,0)]
 s2š g@(G {path}) = g {path = path <> šLine}
 
 
-lGlyphs = [("l",l), ("lt",lt), ("lk",lk), ("lg",lg), ("ld",ld), ("lð",lð),
+lGlyphs = [("l",l), ("lt",lt), ("lk",lk), ("lg",lg), ("ld",ld), ("lƶ",lƶ),
            ("lp",lp), ("lb",lb), ("ls",ls), ("lš",lš), ("lm",lm), ("ln",ln),
            ("lr",lr), ("lč",lč), ("lǧ",lǧ), ("lw",lw), ("lh",lh), ("lf",lf),
-           ("lj",lj), ("l0",l0)]
+           ("lj",lj)]
 
 l = G {path = lPath, width = 5}
 lt = G {path = ltPath, width = 10}
 lk = G {path = lkPath, width = 9}
 lg = G {path = lgPath, width = 9}
 ld = G {path = ldPath, width = 10}
-lð = G {path = lðPath, width = 10}
+lƶ = G {path = lƶPath, width = 10}
 lp = G {path = lpPath, width = 10}
 lb = G {path = lbPath, width = 11}
 ls = G {path = lsPath, width = 10}
@@ -314,7 +325,7 @@ ltPath = lLong <> shiftX 5 tPath
 lkPath = lPart <> shiftX 5 kShort
 lgPath = lPart <> shiftX 5 gShort
 ldPath = lFree <> shiftX 5 dPath
-lðPath = lFree <> shiftX 5 ðPath
+lƶPath = lFree <> shiftX 5 ƶPath
 lpPath = lFree <> shiftX 5 pPath
 lbPath = lPart <> shiftX 5 bPath
 lsPath = lPart <> shiftX 5 sPath
@@ -331,17 +342,17 @@ ljPath = lPartFlat <> P [mA (4,0), lR (2,0), lR (0,5)]
 l0Path = lFree <> P [mA (0.25,7), lR (3.5,0)]
 
 
-mGlyphs = [("m",m), ("mt",mt), ("mk",mk), ("mg",mg), ("md",md), ("mð",mð),
+mGlyphs = [("m",m), ("mt",mt), ("mk",mk), ("mg",mg), ("md",md), ("mƶ",mƶ),
            ("mp",mp), ("mb",mb), ("ms",ms), ("mš",mš), ("ml",ml), ("mm",mm),
            ("mn",mn), ("mr",mr), ("mč",mč), ("mǧ",mǧ), ("mw",mw), ("mh",mh),
-           ("mf",mf), ("mj",mj), ("m0",m0)]
+           ("mf",mf), ("mj",mj)]
 
 m = G {path = mPath, width = 6}
 mt = G {path = mtPath, width = 10}
 mk = G {path = mkPath, width = 10}
 mg = G {path = mgPath, width = 10}
 md = G {path = mdPath, width = 12}
-mð = G {path = mðPath, width = 12}
+mƶ = G {path = mƶPath, width = 12}
 mp = G {path = mpPath, width = 12}
 mb = G {path = mbPath, width = 12}
 ms = G {path = msPath, width = 11}
@@ -368,7 +379,7 @@ mtPath = mLong <> shiftX 5 tPath
 mkPath = mPart <> shiftX 6 kShort
 mgPath = mPart <> shiftX 6 gShort
 mdPath = ḿPath <> shiftX 7 dPath
-mðPath = ḿPath <> shiftX 7 ðPath
+mƶPath = ḿPath <> shiftX 7 ƶPath
 mpPath = ḿPath <> shiftX 7 pPath
 mbPath = mPart <> shiftX 6 bPath
 msPath = mPart <> shiftX 6 sPath
@@ -386,17 +397,17 @@ mjPath = ḿPath <> P [mA (5.5,0), lR (3.5,0), lR (0,5)]
 m0Path = ḿPath <> P [mA (0.5,7), lR (5,0)]
 
 
-nGlyphs = [("n", n), ("nt", nt), ("nk", nk), ("ng", ng), ("nd", nd), ("nð", nð),
+nGlyphs = [("n", n), ("nt", nt), ("nk", nk), ("ng", ng), ("nd", nd), ("nƶ", nƶ),
            ("np", np), ("nb", nb), ("ns", ns), ("nš", nš), ("nl", nl),
            ("nm", nm), ("nn", nn), ("nr", nr), ("nč", nč), ("nǧ", nǧ),
-           ("nw", nw), ("nh", nh), ("nf", nf), ("nj", nj), ("n0", n0)]
+           ("nw", nw), ("nh", nh), ("nf", nf), ("nj", nj)]
 
 n = G {path = nPath, width = 5}
 nt = G {path = ntPath, width = 10}
 nk = G {path = nkPath, width = 9}
 ng = G {path = ngPath, width = 9}
 nd = G {path = ndPath, width = 10}
-nð = G {path = nðPath, width = 10}
+nƶ = G {path = nƶPath, width = 10}
 np = G {path = npPath, width = 9.5}
 nb = G {path = nbPath, width = 11}
 ns = G {path = nsPath, width = 10}
@@ -424,7 +435,7 @@ ntPath = nLong <> shiftX 5 tPath
 nkPath = nFlat <> shiftX 5 kShort
 ngPath = nFlat <> shiftX 5 gShort
 ndPath = nFlat <> shiftX 5 dPath
-nðPath = nFlat <> shiftX 5 ðPath
+nƶPath = nFlat <> shiftX 5 ƶPath
 npPath = ńPath <> shiftX 4.5 pPath
 nbPath = nFlat <> P [mA (5,0), lR (2,0)] <> shiftX 5 bPath
 nsPath = nFlat <> shiftX 5 sPath
@@ -442,17 +453,17 @@ njPath = ńPath <> P [mA (1,-3), lR (4,0), lR (0,8)]
 n0Path = ńPath <> P [mA (0.5,7), lR (3,0)]
 
 
-rGlyphs = [("r", r), ("rt", rt), ("rk", rk), ("rg", rg), ("rd", rd), ("rð", rð),
+rGlyphs = [("r", r), ("rt", rt), ("rk", rk), ("rg", rg), ("rd", rd), ("rƶ", rƶ),
            ("rp", rp), ("rb", rb), ("rs", rs), ("rš", rš), ("rl", rl),
            ("rm", rm), ("rr", rr), ("rč", rč), ("rǧ", rǧ), ("rw", rw),
-           ("rh", rh), ("rf", rf), ("rj", rj), ("r0", r0)]
+           ("rh", rh), ("rf", rf), ("rj", rj)]
 
 r = G {path = rPath, width = 5}
 rt = G {path = rtPath, width = 7}
 rk = G {path = rkPath, width = 7}
 rg = G {path = rgPath, width = 7}
 rd = G {path = rdPath, width = 9.5}
-rð = G {path = rðPath, width = 9.5}
+rƶ = G {path = rƶPath, width = 9.5}
 rp = G {path = rpPath, width = 9.5}
 rb = G {path = rbPath, width = 10.5}
 rs = G {path = rsPath, width = 9.5}
@@ -479,7 +490,7 @@ rtPath = rPartMid <> shiftX 2 tPath
 rkPath = rPartShort <> shiftX 3 kShort
 rgPath = rPartShort <> shiftX 3 gShort
 rdPath = rMid <> shiftX 4.5 dPath
-rðPath = rMid <> shiftX 4.5 ðPath
+rƶPath = rMid <> shiftX 4.5 ƶPath
 rpPath = rMid <> shiftX 4.5 pPath
 rbPath = rMid <> shiftX 4.5 bPath
 rsPath = rMid <> shiftX 4.5 sPath
@@ -553,6 +564,7 @@ fGlyphs = [("f", f), ("fn", fn), ("fm", fm)]
 f = G {path = fPath, width = 6}
 fn = G {path = fnPath, width = 12}
 fm = G {path = fmPath, width = 12}
+f0 = G {path = f0Path, width = 6}
 
 fPath = fPart <> P [lR (0,2.5)]
 fPart = P [mA (3.5,2.5), lR (-1, 0), lR (0,2.5),
@@ -560,7 +572,7 @@ fPart = P [mA (3.5,2.5), lR (-1, 0), lR (0,2.5),
            aR 2.5 2.5 0 Small CW (2.5, 2.5)]
 fnPath = fPath <> shiftX 7 nPath
 fmPath = fPart <> P [lR (0,1)] <> mBump <> mBump' <> P [mA (12,0), lR (0,5)]
-
+f0Path = fPath <> P [mA (0.5,7), lR (5,0)]
 
 j = G {path = jPath, width = 5}
 
@@ -620,12 +632,12 @@ dú = du <> P [mR (4,-3), lR (-3,0)]
 dai = da <> P [mR (-4,-3), lR (2.5,0), lR (0,3)]
 dau = da <> P (circR 1 (-2,-2)) <> P [mR (-1,0), lR (2,0)]
 dia = di <> adot (-1.5,0)
-dua = du <> adot (2,-2) -- FIXME?
+dua = du <> adot (2,-2)
 
 dḿ = da <> P [mR (-4,-3), cR (-0.375,1.125) (-0.25,1.275) (-0.25,1.375),
-              aR 0.625 (-0.625) 0 Small CCW (1.5,0),
+              aR 0.625 0.625 0 Small CCW (1.5,0),
               lR (0,-1), mR (0,1),
-              aR 0.625 (-0.625) 0 Small CCW (1.5,0),
+              aR 0.625 0.625 0 Small CCW (1.5,0),
               cR (0.125,-0.1) (0,-1.125) (-0.25,-1.375)]
 dń = da <> P [mR (-3,-2.5), aR 1 1 0 Small CCW (0,2)]
 dł = da <> P [mR (-1.5,-3.5), cR (-1.125,-0.375) (-1.275,-0.25) (-1.375,-0.25),
@@ -633,20 +645,22 @@ dł = da <> P [mR (-1.5,-3.5), cR (-1.125,-0.375) (-1.275,-0.25) (-1.375,-0.25),
               lR (1,0), mR (-1,0),
               aR 0.625 0.625 0 Small CCW (0,1.5),
               cR (0.1,0.125) (1.125,0) (1.375,-0.25)]
-dŕ = da <> Shift (-3) 5 rPartShort
+dŕ = da <> P [mR (-3,0), cR (1,0) (3,-1) (3,-2)]
 
-punctuation = [(".", eos), (",", eop), ("#", num)]
+punctuation :: Map Text Glyph
+punctuation = Map.fromList
+  [(".", eos), ("?", eos), ("!", eos), (",", eop), (":", eop), (";", eop)]
 
-eos = G {path = eosPath, width = 8}
+eos = G {path = eosPath, width = 2}
-eosPath = P $ circA 1 (4,1) <> circA 1 (4,4)
+eosPath = P $ circA 1 (1,1) <> circA 1 (1,4)
 
-eop = G {path = eopPath, width = 4}
+eop = G {path = eopPath, width = -2}
-eopPath = P $ circA 1 (2,2.5)
+eopPath = P $ circA 1 (-1,2.5)
 
 num = G {path = P [mA (0,0), lR (0,5)], width = 0}
 
-numbers = zipWith (\n p -> (pack $ show n, p)) [0..9::Int]
+numbers = Map.fromList $
-  [u, t, n2, G dFree 3, n4, n5, ł, ḿ, ń, f]
+  zip [0..9::Int] [u, t, n2, G dFree 3, n4, n5, ł, ḿ, ń, f]
 n2 = G n2Path 5
 n2Path = P [mA (0,0), lR (0,5), sR (3,0) (5,-0.5), mA (5,0), lR (0,5)]
 n4 = G n4Path 5

laantas-script/GlyphsBase.hs

@@ -1,6 +1,6 @@
 module GlyphsBase (module GlyphsBase, module Svg) where
 
-import Svg hiding (shiftX, shiftY, shift, width)
+import Svg hiding (shiftX, shiftY, shift, width, size)
 import qualified Svg
 
 import Data.List.NonEmpty (NonEmpty (..))
@@ -11,6 +11,7 @@ import Prelude hiding (Word)
 
 data Glyph = G {path :: Segs, width :: Double}
 
+-- | base amounts
 charHeight', lineHeight', spaceWidth', gap' :: Double
 charHeight' = 13
 lineHeight' = 15
@@ -20,6 +21,10 @@ gap'        = 1.5
 withSize :: MonadReader Env m => (Double -> a) -> m a
 withSize f = asks \E {size} -> f size
 
+size :: MonadReader Env m => m Double
+size = withSize id
+
+-- | multiplied by size
 charHeight, lineHeight, spaceWidth, margin, gap :: MonadReader Env m => m Double
 charHeight = withSize (* charHeight')
 lineHeight = withSize (* lineHeight')

laantas-script/Main.hs

@@ -1,14 +1,21 @@
 {-# OPTIONS_GHC -fdefer-typed-holes #-}
 
-import Prelude hiding (Word)
+import Prelude hiding (getContents, readFile, writeFile, putStrLn)
 import Svg
-import qualified Glyphs as G
+import Glyphs (doGlyphs, lineHeight')
+import Split
 import Options.Applicative
 import Data.Functor
+import Data.Text.IO (readFile, getContents)
+import Data.Text.Lazy.IO (writeFile, putStrLn)
 
 
 data Options =
-  Opts { width, size, stroke :: {-# UNPACK #-} !Double }
+  Opts {
+    width, size, stroke :: {-# UNPACK #-} !Double,
+    inFile, outFile :: Maybe FilePath,
+    text   :: Maybe Text
+  }
   deriving Show
 
 options :: IO Options
@@ -16,18 +23,30 @@ options = execParser desc where
   desc = info (opts <**> helper) $
     fullDesc <> header "render lántas text as svg"
   opts =
-    Opts <$> dimOpt  'W' "width" Nothing
+    Opts <$> dimOpt  'W' "width" 1000
-         <*> (dimOpt' 'S' "size" "text size" (Just 10)
+         <*> (dimOpt' 'S' "size" "text size" 60 <&> (/ lineHeight'))
-               <&> (/ G.lineHeight'))
+         <*> dimOpt'  'K' "stroke" "line thickness" 2
-         <*> dimOpt'  'K' "stroke" "line thickness" (Just 2)
+         <*> filePath 'i' "input"
+         <*> filePath 'o' "output"
+         <*> text
   dimOpt s l d = dimOpt' s l l d
-  dimOpt' s l n d = option auto $ mconcat $
+  dimOpt' s l n d = option auto $ mconcat
-    [short s, long l, help $ n <> " in pixels", metavar "SIZE"] <>
+    [short s, long l, help $ n <> " in pixels", metavar "SIZE", value d]
-    maybe [] (\x -> [value x]) d
+  filePath s n = optional $ option str $ mconcat
+    [short s, long n, help $ n <> " file", metavar "FILE"]
+  text = optional $ option str $ mconcat
+    [short 't', long "text", help $ "use given text instead of a file",
+     metavar "TEXT"]
 
 main :: IO ()
 main = do
   Opts {..} <- options
-  let lántas = _
+  txt <- split <$> if
-  let res = G.doGlyphs [lántas, lántas] (E {..})
+    | Just t   <- text   -> pure t
-  writeFile "/home/niss/e.svg" $ show res
+    | Just "-" <- inFile -> getContents
+    | Just i   <- inFile -> readFile i
+    | otherwise          -> fail "no input given"
+  let res = prettyText $ doGlyphs txt (E {..})
+  case outFile of
+    Just o | o /= "-" -> writeFile o res
+    _                 -> putStrLn res

laantas-script/Split.hs

@@ -0,0 +1,60 @@
+{-# OPTIONS_GHC -fdefer-typed-holes #-}
+
+module Split (split) where
+
+import Glyphs
+import Data.Text (Text)
+import qualified Data.Text as Text
+import qualified Data.Char as Char
+import Data.Map (Map, (!))
+import qualified Data.Map.Strict as Map
+import Text.Megaparsec
+import Text.Megaparsec.Char
+import Data.Void
+
+
+type P = Parsec Void Text
+
+
+longestWith :: String -> (Text -> Maybe a) -> P a
+longestWith name p = try $ go . Text.singleton =<< anySingle where
+  go acc = case p acc of
+    Nothing -> fail $ "longestWith " <> name <> ": " <> show acc
+    Just x  -> try (do c <- anySingle; go $ Text.snoc acc c) <|> pure x
+
+maxFrom :: String -> Map Text a -> P a
+maxFrom name i = longestWith name \x -> Map.lookup x i
+
+initial :: P Glyph
+initial = maxFrom "initial" initials
+
+medial :: P Segs
+medial = maxFrom "medial" medials
+
+final :: P Glyph
+final = maxFrom "final" finals
+
+ivowel :: P Glyph
+ivowel = maxFrom "vowel" vowels
+
+word :: P [Piece]
+word = (<>) <$> some initMed <*> fin where
+  initMed = try $
+    [(i, ms) | i <- initial, ms <- some medial] <|>
+    [(v, []) | v <- ivowel]
+  fin = maybe [] (\x -> [(x, [])]) <$> optional final
+
+number :: P [Piece]
+number = [[h1] <> ns <> [h2] | h1 <- hash, ns <- some digit, h2 <- hash] where
+  hash = (num, []) <$ chunk "#"
+  digit = [(numbers ! Char.digitToInt i, []) | i <- digitChar]
+
+punct :: P [Piece]
+punct = [[(p, [])] | p <- maxFrom "punctuation" punctuation]
+
+text :: P [[Piece]]
+text = space *> many (segment <* space) <* eof where
+  segment = punct <|> number <|> word
+
+split :: Text -> [[Piece]]
+split = either (error . errorBundlePretty) id . parse text ""

laantas-script/laantas-script.cabal

@@ -13,14 +13,18 @@ executable laantas-script
   other-modules:
     Svg,
     Glyphs,
-    GlyphsBase
+    GlyphsBase,
+    Split
   default-language: Haskell2010
   default-extensions:
     BlockArguments,
     DisambiguateRecordFields,
     DuplicateRecordFields,
     FlexibleContexts,
+    GADTs,
     LambdaCase,
+    MonadComprehensions,
+    MultiWayIf,
     NamedFieldPuns,
     OverloadedStrings,
     RecordWildCards
@@ -30,6 +34,7 @@ executable laantas-script
     mtl ^>= 2.2.2,
     svg-builder ^>= 0.1.1,
     optparse-applicative ^>= 0.16.0.0,
-    text ^>= 1.2.3.2
+    text ^>= 1.2.3.2,
+    megaparsec ^>= 9.0.1
   ghc-options:
     -Wall -threaded -rtsopts -with-rtsopts=-N