lántas script stuff

This commit is contained in:
Rhiannon Morris 2021-04-28 12:29:21 +02:00
parent 13836bac8b
commit 292c5d5920
5 changed files with 217 additions and 114 deletions

View File

@ -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), ("á", ), ("i", di), ("í", ), ("u", du), ("ú", ),
("ai", dai), ("au", dau), ("ia", dia), ("ua", dua), ("ḿ", dḿ),
("ń", ), ("ł", ), ("ŕ", )]
vowels :: Map Text Glyph
vowels = Map.fromList vGlyphs
tGlyphs = [("t",t), ("tt",tt), ("tk",tk), ("tg",tg), ("td",td), ("",),
tGlyphs = [("t",t), ("tt",tt), ("tk",tk), ("tg",tg), ("td",td), ("",),
("tp",tp), ("tb",tb), ("ts",ts), ("",), ("tl",tl), ("tm",tm),
("tn",tn), ("tr",tr), ("",), ("",), ("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 = Path, width = 9}
tƶ = G {path = 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ð",),
sGlyphs = [("s",s), ("st",st), ("sk",sk), ("sg",sg), ("sd",sd), ("sƶ",),
("sp",sp), ("sb",sb), ("ss",ss), ("",), ("sl",sl), ("sm",sm),
("sn",sn), ("sr",sr), ("",), ("",), ("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 = Path, width = 9}
sƶ = G {path = 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š
šƶ = s2š
š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ð",),
lGlyphs = [("l",l), ("lt",lt), ("lk",lk), ("lg",lg), ("ld",ld), ("lƶ",),
("lp",lp), ("lb",lb), ("ls",ls), ("",), ("lm",lm), ("ln",ln),
("lr",lr), ("",), ("",), ("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 = Path, width = 10}
lƶ = G {path = 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ð",),
mGlyphs = [("m",m), ("mt",mt), ("mk",mk), ("mg",mg), ("md",md), ("mƶ",),
("mp",mp), ("mb",mb), ("ms",ms), ("",), ("ml",ml), ("mm",mm),
("mn",mn), ("mr",mr), ("",), ("",), ("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 = Path, width = 12}
mƶ = G {path = 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ð", ),
nGlyphs = [("n", n), ("nt", nt), ("nk", nk), ("ng", ng), ("nd", nd), ("nƶ", ),
("np", np), ("nb", nb), ("ns", ns), ("", ), ("nl", nl),
("nm", nm), ("nn", nn), ("nr", nr), ("", ), ("", ),
("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 = Path, width = 10}
nƶ = G {path = 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ð", ),
rGlyphs = [("r", r), ("rt", rt), ("rk", rk), ("rg", rg), ("rd", rd), ("rƶ", ),
("rp", rp), ("rb", rb), ("rs", rs), ("", ), ("rl", rl),
("rm", rm), ("rr", rr), ("", ), ("", ), ("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 = Path, width = 9.5}
rƶ = G {path = 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)]
= da <> P [mR (-3,-2.5), aR 1 1 0 Small CCW (0,2)]
= 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)]
= da <> Shift (-3) 5 rPartShort
= 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

View File

@ -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')

View File

@ -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

60
laantas-script/Split.hs Normal file
View File

@ -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 ""

View File

@ -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