lang/laantas-script/Glyphs.hs

509 lines
15 KiB
Haskell
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

{-# OPTIONS_GHC -Wno-missing-signatures -Wno-name-shadowing #-}
module Glyphs where
import qualified Data.Map as Map
import Svg hiding (shiftX, shiftY, shift)
import qualified Svg
data Glyph = G {path :: Segs, width :: Double}
charHeight', lineHeight', spaceWidth' :: Double
charHeight' = 13
lineHeight' = 15
spaceWidth' = 4
withSize :: (Double -> a) -> M a
withSize f = asks \E {size} -> f size
lineHeight :: M Double
lineHeight = withSize (* lineHeight')
spaceWidth :: M Double
spaceWidth = withSize (* spaceWidth')
margin :: M Double
margin = asks \E {stroke} -> stroke
data Segs = P [M Text] | Shift !Double !Double Segs | Segs :<>: Segs
instance Semigroup Segs where (<>) = (:<>:)
joinSegs :: Segs -> M Text
joinSegs (P ps) = fmap mconcat $ sequence ps
joinSegs (Shift dx dy segs) = do
E {size} <- ask
localS (Svg.shift (size * dx, size * dy)) $ joinSegs segs
joinSegs (ss1 :<>: ss2) = liftM2 (<>) (joinSegs ss1) (joinSegs ss2)
localS :: MonadState s m => (s -> s) -> m a -> m a
localS f m = do old <- get; modify f; res <- m; put old; pure res
shiftX, shiftY :: Double -> Segs -> Segs
shiftX dx = Shift dx 0
shiftY dy = Shift 0 dy
space :: M ()
space = do
swidth <- spaceWidth
modify \s@(S {x}) -> s {x = x + swidth}
glyphs :: Map.Map Text Glyph
glyphs = Map.fromList $
tGlyphs <> ðGlyphs <> sGlyphs
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)]
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}
= G {path = tðPath, width = 9}
tp = G {path = tpPath, width = 9}
tb = G {path = tbPath, width = 10}
ts = G {path = tsPath, width = 9}
= G {path = tšPath, width = 9}
tl = G {path = tlPath, width = 9}
tm = G {path = tmPath, width = 10}
tn = G {path = tnPath, width = 9}
tr = G {path = trPath, width = 7}
= G {path = tčPath, width = 9}
= G {path = tǧPath, width = 10}
tw = G {path = twPath, width = 10}
th = G {path = thPath, width = 12}
tf = G {path = tfPath, width = 10}
tj = G {path = tjPath, width = 5}
tPath = P [mA (1.5,0), lR (0,5), mA (0,0), lR (5,0), lR (0,5)]
tPart = P [mA (2,0), lR (0,5), mA (0,0), lR (,0)]
ttPath = P [mA (1,0), lR (0,5), mA (3,0), lR (0,5), mA (5,0), lR (0,5),
mA (0,0), lR (7,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)]
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
tšPath = tPart 4 <> shiftX 4 šPath
tlPath = tPart 5 <> shiftX 4 lPath
tmPath = tPart 4.5 <> shiftX 4 mPath
tnPath = tPart 6 <> shiftX 4 nPath
trPath = tPart 7 <> shiftX 4 rShort
tčPath = tPart 3 <> shiftX 3 čFlat
tǧPath = tPart 4 <> shiftX 5 ǧPath
twPath = tPart 6 <> shiftX 4 wPath
thPath = tPart 4 <> shiftX 4 hPath
tfPath = tPart 4 <> shiftX 4 fPath
tjPath = P [mA (2,0), lR (0,5), mA (0,0), lR (4,0), mA (0,-3),
lR (5,0), lR (0,8)]
k = G {path = kPath, width = 5}
kPath = P [mA (0,0), lR (0,5), sR (3,0) (5,-0.5), mA (5,-3), lR (0,8)]
kShortPart = P [mA (0,0), lR (0,5), sR (2.6,0) (4,-0.5)]
kShort = kShortPart <> P [mA (4,-3), lR (0,8)]
g :: Glyph
g = G {path = gPath, width = 5}
gPath, gShort :: Segs
gPath = kPath <> P [mA (2,-3), lR (3,0)]
gShort = kShort <> P [mA (1.5,-3), lR (2.5,0)]
d :: Glyph
d = G {path = dPath, width = 5}
dPath, dPart, dBase, dJoin, dFree, dLong :: Segs
dPath = dPart <> P [mA (5,-3), lR (0,8)]
dPart = dBase <> dJoin
dJoin = P [mA (2,5), cR (2,0) (3,-1) (3,-2)]
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)]
ð = þ
þ = 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}
þPath = dPath <> P [mA (1,-3), lR (4,0)]
ð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
p :: Glyph
p = G {path = pPath, width = 5}
pPath :: Segs
pPath = P [mA (1.5,-3), lR (0,8), sR (-1.5,-3) (-1.5,-5), lR (5,0), lR (0,5)]
b :: Glyph
b = G {path = bPath, width = 6}
bPath :: Segs
bPath = wPart <> P [mA (2,-3), lR (4,0), lR (0,8)]
sGlyphs = [("s",s), ("st",st), ("sk",sk), ("sg",sg), ("sd",sd), ("",),
("sp",sp), ("sb",sb), ("ss",ss), ("",), ("sl",sl), ("sm",sm),
("sn",sn), ("sr",sr), ("",), ("",), ("sw",sw), ("sh",sh),
("sf",sf), ("sj",sj), ("s0",s)]
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}
= G {path = sðPath, width = 9}
sp = G {path = spPath, width = 10}
sb = G {path = sbPath, width = 10}
ss = G {path = ssPath, width = 10}
= G {path = sšPath, width = 10}
sl = G {path = slPath, width = 10}
sm = G {path = smPath, width = 11}
sn = G {path = snPath, width = 10}
sr = G {path = srPath, width = 9}
= G {path = sčPath, width = 9}
= G {path = sǧPath, width = 10}
sw = G {path = swPath, width = 10}
sh = G {path = shPath, width = 13}
sf = G {path = sfPath, width = 10}
sj = G {path = sjPath, width = 6}
s0 = G {path = s0Path, width = 5}
sPath = sPartLine <> P [mA (5,0), lR (0,5)]
sPart = P [mA (0, 0), lR (0, 3.5), aR 1.5 1.5 0 Small CCW (3,0), lR (0,-3.5)]
sPartLine = sPart <> P [mA (3,0), lR (2,0)]
stPath = sPartLine <> shiftX 4 tPath
skPath = sPartLine <> shiftX 5 kShort
sgPath = sPartLine <> shiftX 5 gShort
sdPath = sPart <> shiftX 4 dPath <> P [mA (3,0), lR (1,0)]
sðPath = sPart <> shiftX 4 ðPath <> P [mA (3,0), lR (1,0)]
spPath = sPart <> shiftX 5 pPath <> P [mA (3,0), lR (0,3.5)]
sbPath = sPart <> shiftX 4 bPath <> P [mA (3,0), lR (0,-3), lR (3.5,0)]
ssPath = sPartLine <> shiftX 5 sPath
sšPath = sPartLine <> shiftX 5 šPath
slPath = sPart <> shiftX 5 lPath <> P [mA (3,0), lR (3,0)]
smPath = sPart <> shiftX 5 mPath <> P [mA (3,0), lR (2.5,0)]
snPath = sPart <> shiftX 5 nPath <> P [mA (3,0), lR (4,0)]
srPath = sPart <> shiftX 4 rShort <> P [mA (3,0), lR (4,0)]
sčPath = sPart <> shiftX 3 čFlat
sǧPath = sPart <> shiftX 4 ǧPath
swPath = sPart <> shiftX 4 wPath <> P [mA (3,0), lR (3.5,0)]
shPath = sPart <> shiftX 5 hPath
sfPath = sPart <> shiftX 4 fPath
sjPath = P [mA (0,0), lR (0,3.5), aR 1.5 1.5 0 Small CCW (3,0), lR (0,-1.5),
mA (3,0), lR (3,0), lR (0,5), mA (3,2), lR (3,0)]
s0Path = sPath <> P [mA (0.5,7), lR (4,0)]
š = G {path = šPath, width = 5}
šPath = sPath <> šLine
šLine = P [mA (1,-1.5), lR (2,0)]
l :: Glyph
l = G {path = lPath, width = 5}
lPath, lPart, lBase, lPartFlat, lBaseFlat, lFree, lLong :: Segs
lPath = lPart <> P [mA (4,4.5), lR (1,-0.7), mA (5,0), lR (0,5)]
lBase = P [mA (4,0.5), cR (-2.25,-0.75) (-2.55,-0.5) (-2.75,-0.5),
aR 1.25 1.25 0 Small CCW (0,2.5), lR (2,0), mR (-2,0),
aR 1.25 1.25 0 Small CCW (0,2.5), lR (0.75,0)]
lPart = lBase <> dJoin
lPartFlat = lBaseFlat <> shiftX 1 dJoin
lBaseFlat = P [mA (4,0), lR (-2.75,0),
aR 1.25 1.25 0 Small CCW (0,2.5), lR (2,0), mR (-2,0),
aR 1.25 1.25 0 Small CCW (0,2.5), lR (2,0)]
lFree = P [mA (4,0.5), cR (-2.25,-0.75) (-2.55,-0.5) (-2.75,-0.5),
aR 1.25 1.25 0 Small CCW (0,2.5), lR (2,0), mR (-2,0),
aR 1.25 1.25 0 Small CCW (0,2.5),
cR (0.2,0.25) (2.25,0) (2.75,-0.5)]
lLong = lBase <> P [mA (2,5), lR (2,0)] <> shiftX 1.5 dJoin
m :: Glyph
m = G {path = mPath, width = 6}
mPath, mPart, mLong :: Segs
mPath = mPart <> P [mA (6,0), lR (0,5)]
mPart = P [mA (0.5,0), cR (-0.25,0.2) (-0.5,2.25) (-0.5,3.5),
aR 1.5 1.5 0 Small CCW (3,0),
lR (0,-2), mR (0,2),
aR 1.5 1.5 0 Small CCW (3,0)]
mLong = P [mA (0.5,0), cR (-0.25,0.2) (-0.5,2.25) (-0.5,3.5),
aR 1.5 1.5 0 Small CCW (1.5,1.5),
lR (0,-2), mR (0,2),
aR 1.5 1.5 0 Small CCW (1.5,1.5),
cR (2,0) (2,-1) (2,-2)]
n :: Glyph
n = G {path = nPath, width = 5}
nt = G {path = ntPath, width = 10}
nPath, nPart, nPart', nLong :: Segs
nPath = nPart <> P [mA (5,0), lR (0,5)]
nPart = nPart' <> dJoin
nPart' = P [mA (3.5,1.5), cR (0,-1) (-0.5,-1.5) (-1,-1.5),
aR 2.5 2.5 0 Large CCW (0,5)]
nLong = nPart' <> P [mA (2.5,5), lR (1.5,0)] <> shiftX 1.5 dJoin
ntPath = nLong <> shiftX 5 tPath
r :: Glyph
r = G {path = rPath, width = 5}
rPath = rPart <> P [mA (5,-3), lR (0,8)]
rPart = P [mA (0,5), cR (3.5,0) (5,-1) (5,-2)]
rPartCursive = P [mA (0,3), cR (0,1) (1,2) (3,2), cR (1,0) (2,-1) (2,-2)]
rCursive = rPartCursive <> P [mA (5,-3), lR (0,8)]
rPartMid = P [mA (0,5), cR (1.25,0) (3.5,-1) (3.5,-2)]
rPartShort = P [mA (0,5), cR (1,0) (3,-1) (3,-2)]
rShort = rPartShort <> P [mA (3,-3), lR (0,8)]
č :: Glyph
č = G {path = čPath, width = 5}
čPath = čPart <> čJoin <> P [mA (5,0), lR (0,5)]
čPart = P [mA (0,0.5), cR (2.25,-0.75) (2.55,-0.5) (-2.75,-0.5)] <> čPart'
čPart' = P [aR 1.25 1.25 0 Small CW (0,2.5), lR (-2,0), mR (2,0),
aR 1.25 1.25 0 Small CW (0,2.5),
cR (-0.2,0.25) (-2.25,0) (-2.75,-0.5)] -- FIXME?
čJoin = P [mA (2.5,5), cR (1.5,0) (2.5,-0.5) (2.5,-1)]
čPartFlat = P [mA (0,0.5), lR (3.5,0)] <> čPart'
čFlat = čPartFlat <> shiftX 1 čJoin <> P [mA (6,0), lR (0,5)]
ǧ :: Glyph
ǧ = G {path = ǧPath, width = 5}
ǧPath, ǧPart :: Segs
ǧPath = ǧPart <> čJoin <> P [mA (5,-3), lR (0,8)]
ǧPart = P [mA (0,-2), cR (2.25,-0.75) (2.55,-0.5) (2.75,-0.5),
aR 1.25 1.25 0 Small CW (0,2.5),
lR (-2,0), mR (2,0),
aR 1.25 1.25 0 Small CW (0,2.5),
lR (-2,0), mR (2,0),
aR 1.25 1.25 0 Small CW (0,2.5),
cR (-0.2,0.25) (-2.25,0) (-2.75,-0.5)]
w :: Glyph
w = G {path = wPath, width = 6}
wPath, wPart :: Segs
wPath = wPart <> P [mA (6,0), lR (0,5)]
wPart = P $ circA 2.5 (2.5,2.5) <> [mA (2.5,0), lR (3.5,0)]
h :: Glyph
h = G {path = hPath, width = 8}
hPath, hPart :: Segs
hPath = hPart <> P [mA (5,-3), lR (3,0), lR (0,8)]
hPart = sPart <> P [mA (3,0), lR (1,0)] <> shiftX 4 sPart
f :: Glyph
f = G {path = fPath, width = 6}
fPath :: Segs
fPath = P [mA (3.5,2.5), lR (-1, 0), lR (0,2.5),
aR 2.5 2.5 0 Large CW (0,-5), lR (1,0),
aR 2.5 2.5 0 Small CW (2.5, 2.5), lR (0,2.5)]
j :: Glyph
j = G {path = jPath, width = 5}
jPath :: Segs
jPath = P [mA (0,0), lR (5,0), lR (0,5)]
a :: Glyph
a = G {path = aPath, width = 0}
aPath :: Segs
aPath = P [mA (0,0), lR (5,0)]
á :: Glyph
á = G {path = áPath, width = 3}
áPath :: Segs
áPath = P [mA (0,0), lR (5,0), mA (3,0), lR (5,0)]
i :: Glyph
i = j
í :: Glyph
í = G {path = íPath, width = 5}
íPath :: Segs
íPath = P [mA (0,0), lR (3,0), lR (0,5), mR (0,-5), lR (2,0), lR (0,5)]
u :: Glyph
u = G {path = uPath, width = 5}
uPath :: Segs
uPath = P $ circA 2.5 (2.5,2.5)
ú :: Glyph
ú = G {path = úPath, width = 6}
úPath :: Segs
úPath = P $ ellipseA 1.5 2.5 (1.5,2.5) <> ellipseA 1.5 2.5 (4.5,2.5)
ai :: Glyph
ai = G {path = aiPath, width = 5}
aiPath :: Segs
aiPath = P [mA (0,0), lR (0,5), mR (2,-5), lR (3,0), lR (0,5),
mA (2.5,7), lR (2,0)]
au :: Glyph
au = G {path = auPath, width = 5}
auPath :: Segs
auPath = P $
[mA (0,0), lR (0,5)] <> ellipseA 1.5 2.5 (3.5,2.5) <> [mA (2.5,7), lR (2,0)]
ia :: Glyph
ia = G {path = iaPath, width = 5}
iaPath :: Segs
iaPath = P [mA (0,0), lR (3,0), lR (0,5), mA (5,0), lR (0,5)]
ua :: Glyph
ua = G {path = uaPath, width = 5}
uaPath :: Segs
uaPath = P $ ellipseA 1.5 2.5 (1.5,2.5) <> [mA (5,0), lR (0,5)]
ḿ :: Glyph
ḿ = G {path = ḿPath, width = 6}
ḿPath :: Segs
ḿPath = P [mA (0.5,0), cR (-0.25,0.2) (-0.5,2.25) (-0.5,3.5),
aR 1.5 1.5 0 Small CCW (3,0), lR (0,-2),
mA (5.5,0), cR (0.25,0.2) (0.5,2.25) (0.5,3.5),
aR 1.5 1.5 0 Small CW (-3,0)]
ń :: Glyph
ń = G {path = ńPath, width = 4}
ńPath :: Segs
ńPath = P [mA (3.5,1.5), cR (0,-1) (-0.5,-1.5) (-1,-1.5),
aR 2.5 2.5 0 Large CCW (0,5),
cR (0.5,0) (1,-0.5) (1,-1.5)]
ł :: Glyph
ł = G {path = łPath, width = 4}
łPath :: Segs
łPath = lFree
ŕ :: Glyph
ŕ = G {path = ŕPath, width = 5}
ŕPath :: Segs
ŕPath = rPart <> P [mA (5,0), lR (0,5)]
adot :: Point -> Segs
adot = P . circR 0.2
da, , di, , du, :: Segs
da = P [lR (0,5)]
= da <> adot (-3.5,-3) <> adot (2,0)
di = da <> P [cR (1,-2) (3,-3) (0,-3)]
= da <> P [cR (1,-2) (4,-3) (-4,-3)]
du = da <> P [lR (-4,0)]
= du <> P [mR (4,2), lR (-3,0)]
dai, dau, dia, dua :: Segs
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,0)
dua = du <> adot (-1,0) -- FIXME?
dḿ, , , :: Segs
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),
lR (0,-1), mR (0,1),
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),
aR 0.625 0.625 0 Small CCW (0,1.5),
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