From 292c5d5920ba5fa519f10301dffbe1ef0ea50bff Mon Sep 17 00:00:00 2001 From: Rhiannon Morris Date: Wed, 28 Apr 2021 12:29:21 +0200 Subject: [PATCH] =?UTF-8?q?l=C3=A1ntas=20script=20stuff?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- laantas-script/Glyphs.hs | 210 +++++++++++++++------------- laantas-script/GlyphsBase.hs | 7 +- laantas-script/Main.hs | 45 ++++-- laantas-script/Split.hs | 60 ++++++++ laantas-script/laantas-script.cabal | 9 +- 5 files changed, 217 insertions(+), 114 deletions(-) create mode 100644 laantas-script/Split.hs diff --git a/laantas-script/Glyphs.hs b/laantas-script/Glyphs.hs index a2e84ca..f0342d5 100644 --- a/laantas-script/Glyphs.hs +++ b/laantas-script/Glyphs.hs @@ -1,41 +1,54 @@ {-# OPTIONS_GHC -Wno-missing-signatures -Wno-name-shadowing #-} module Glyphs - (module GlyphsBase, - glyphs, mods) + (Glyph (..), Segs (..), Piece, doGlyphs, + 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 -glyphs = Map.fromList $ - tGlyphs <> kGlyphs <> ðGlyphs <> sGlyphs <> šGlyphs <> lGlyphs <> +type Piece = (Glyph, [Segs]) + +initials :: Map Text Glyph +initials = Map.fromList $ + tGlyphs <> kGlyphs <> ƶGlyphs <> sGlyphs <> šGlyphs <> lGlyphs <> mGlyphs <> nGlyphs <> rGlyphs <> pGlyphs <> bGlyphs <> - čGlyphs <> hGlyphs <> fGlyphs <> vGlyphs <> - [("g", g), ("d", d), ("ǧ", ǧ), ("w", w), ("j", j)] <> - numbers <> punctuation + čGlyphs <> hGlyphs <> fGlyphs <> + [("g", g), ("d", d), ("ǧ", ǧ), ("w", w), ("j", j)] +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 -mods = Map.fromList $ +medials :: Map Text Segs +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), - ("ðð",ðð), ("ðp",ðp), ("ðb",ðb), ("ðs",ðs), ("ðš",ðš), ("ðl",ðl), - ("ðm",ðm), ("ðn",ðn), ("ðr",ðr), ("ðč",ðč), ("ðǧ",ðǧ), ("ðw",ðw), - ("ðh",ðh), ("ðf",ðf), ("ðj",ðj), ("ð0", ð0)] +ƶ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)] -ð = þ -þ = G {path = þPath, width = 5} -ðt = G {path = ðtPath, width = 10} -ðk = G {path = ðkPath, width = 9} -ðg = G {path = ðgPath, width = 9} -ðd = G {path = ðdPath, width = 10} -ðð = G {path = ððPath, width = 10} -ðp = G {path = ðpPath, width = 10} -ðb = G {path = ðbPath, width = 11} -ðs = G {path = ðsPath, width = 10} -ðš = G {path = ðšPath, width = 10} -ðl = G {path = ðlPath, width = 10} -ðm = G {path = ðmPath, width = 11} -ðn = G {path = ðnPath, width = 10} -ðr = G {path = ðrPath, width = 10} -ðč = G {path = ðčPath, width = 10} -ðǧ = G {path = ðǧPath, width = 10} -ðw = G {path = ðwPath, width = 11} -ðh = G {path = ðhPath, width = 13} -ðf = G {path = ðfPath, width = 11} -ðj = G {path = ðjPath, width = 7} -ð0 = G {path = ð0Path, width = 3.5} +ƶ = G {path = ƶPath, width = 5} +ƶt = G {path = ƶtPath, width = 10} +ƶk = G {path = ƶkPath, width = 9} +ƶg = G {path = ƶgPath, width = 9} +ƶd = G {path = ƶdPath, width = 10} +ƶƶ = G {path = ƶƶPath, width = 10} +ƶp = G {path = ƶpPath, width = 10} +ƶb = G {path = ƶbPath, width = 11} +ƶs = G {path = ƶsPath, width = 10} +ƶš = G {path = ƶšPath, width = 10} +ƶl = G {path = ƶlPath, width = 10} +ƶm = G {path = ƶmPath, width = 11} +ƶn = G {path = ƶnPath, width = 10} +ƶr = G {path = ƶrPath, width = 10} +ƶč = G {path = ƶčPath, width = 10} +ƶǧ = G {path = ƶǧPath, width = 10} +ƶw = G {path = ƶwPath, width = 11} +ƶh = G {path = ƶhPath, width = 13} +ƶf = G {path = ƶfPath, width = 11} +ƶj = G {path = ƶjPath, width = 7} +ƶ0 = G {path = ƶ0Path, width = 3.5} -þPath = dPath <> P [mA (1,-3), lR (4,0), mA (5,5)] -ðPath = þPath -ðtPath = dLong <> shiftX 5 tPath -ðkPath = dPart <> shiftX 5 kShort -ðgPath = dPart <> shiftX 5 gShort -ðdPath = dFree <> shiftX 5 dPath <> P [mA (1,-2), lR (2,0)] -ððPath = dFree <> shiftX 5 ðPath -ðpPath = dFree <> shiftX 5 pPath -ðbPath = dPart <> shiftX 5 bPath -ðsPath = dPart <> shiftX 5 sPath -ðšPath = dPart <> shiftX 5 šPath -ðlPath = dPart <> shiftX 5 lPath -ðmPath = dPart <> shiftX 5 mPath -ðnPath = dPart <> shiftX 5 nPath -ðrPath = dPart <> shiftX 5 rCursive -ðčPath = dFree <> shiftX 5 čPath -ðǧPath = dFree <> shiftX 5 ǧPath -ðwPath = dPart <> shiftX 5 wPath -ðhPath = dPart <> shiftX 5 hPath -ðfPath = dFree <> shiftX 4 fPath -ðjPath = dFree <> shiftX 4 fPath -ð0Path = dFree <> P [mA (0,7), lR (3.5,0)] +ƶPath = dPath <> P [mA (1,-3), lR (4,0), mA (5,5)] +ƶtPath = dLong <> shiftX 5 tPath +ƶkPath = dPart <> shiftX 5 kShort +ƶgPath = dPart <> shiftX 5 gShort +ƶdPath = dFree <> shiftX 5 dPath <> P [mA (1,-2), lR (2,0)] +ƶƶPath = dFree <> shiftX 5 ƶPath +ƶpPath = dFree <> shiftX 5 pPath +ƶbPath = dPart <> shiftX 5 bPath +ƶsPath = dPart <> shiftX 5 sPath +ƶšPath = dPart <> shiftX 5 šPath +ƶlPath = dPart <> shiftX 5 lPath +ƶmPath = dPart <> shiftX 5 mPath +ƶnPath = dPart <> shiftX 5 nPath +ƶrPath = dPart <> shiftX 5 rCursive +ƶčPath = dFree <> shiftX 5 čPath +ƶǧPath = dFree <> shiftX 5 ǧPath +ƶwPath = dPart <> shiftX 5 wPath +ƶhPath = dPart <> shiftX 5 hPath +ƶfPath = dFree <> shiftX 4 fPath +ƶjPath = dFree <> shiftX 4 fPath +ƶ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} -eosPath = P $ circA 1 (4,1) <> circA 1 (4,4) +eos = G {path = eosPath, width = 2} +eosPath = P $ circA 1 (1,1) <> circA 1 (1,4) -eop = G {path = eopPath, width = 4} -eopPath = P $ circA 1 (2,2.5) +eop = G {path = eopPath, width = -2} +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] - [u, t, n2, G dFree 3, n4, n5, ł, ḿ, ń, f] +numbers = Map.fromList $ + 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 diff --git a/laantas-script/GlyphsBase.hs b/laantas-script/GlyphsBase.hs index 5405c09..1db48d3 100644 --- a/laantas-script/GlyphsBase.hs +++ b/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') diff --git a/laantas-script/Main.hs b/laantas-script/Main.hs index a609d7e..20ab404 100644 --- a/laantas-script/Main.hs +++ b/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 - <*> (dimOpt' 'S' "size" "text size" (Just 10) - <&> (/ G.lineHeight')) - <*> dimOpt' 'K' "stroke" "line thickness" (Just 2) + Opts <$> dimOpt 'W' "width" 1000 + <*> (dimOpt' 'S' "size" "text size" 60 <&> (/ lineHeight')) + <*> dimOpt' 'K' "stroke" "line thickness" 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 $ - [short s, long l, help $ n <> " in pixels", metavar "SIZE"] <> - maybe [] (\x -> [value x]) d + dimOpt' s l n d = option auto $ mconcat + [short s, long l, help $ n <> " in pixels", metavar "SIZE", value 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 = _ - let res = G.doGlyphs [lántas, lántas] (E {..}) - writeFile "/home/niss/e.svg" $ show res + txt <- split <$> if + | Just t <- text -> pure t + | 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 diff --git a/laantas-script/Split.hs b/laantas-script/Split.hs new file mode 100644 index 0000000..2330f24 --- /dev/null +++ b/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 "" diff --git a/laantas-script/laantas-script.cabal b/laantas-script/laantas-script.cabal index ced4948..c9c853a 100644 --- a/laantas-script/laantas-script.cabal +++ b/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