start lántas script writer
This commit is contained in:
parent
f6bf7b1f3d
commit
0dea4d358f
5 changed files with 766 additions and 1 deletions
|
|
@ -1 +1,8 @@
|
||||||
packages: ./langfilter
|
packages:
|
||||||
|
./langfilter,
|
||||||
|
./laantas-script
|
||||||
|
|
||||||
|
source-repository-package
|
||||||
|
type: git
|
||||||
|
location: https://git.rhiannon.website/rhi/svg-builder
|
||||||
|
tag: 6bda613b538b08e9947913382f3b94235ca92149
|
||||||
|
|
|
||||||
508
laantas-script/Glyphs.hs
Normal file
508
laantas-script/Glyphs.hs
Normal file
|
|
@ -0,0 +1,508 @@
|
||||||
|
{-# 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), ("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)]
|
||||||
|
|
||||||
|
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}
|
||||||
|
tp = G {path = tpPath, width = 9}
|
||||||
|
tb = G {path = tbPath, width = 10}
|
||||||
|
ts = G {path = tsPath, width = 9}
|
||||||
|
tš = 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}
|
||||||
|
tč = G {path = tčPath, width = 9}
|
||||||
|
tǧ = 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), ("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",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}
|
||||||
|
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}
|
||||||
|
sš = 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}
|
||||||
|
sč = G {path = sčPath, width = 9}
|
||||||
|
sǧ = 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, dá, di, dí, du, dú :: Segs
|
||||||
|
da = P [lR (0,5)]
|
||||||
|
dá = da <> adot (-3.5,-3) <> adot (2,0)
|
||||||
|
di = da <> P [cR (1,-2) (3,-3) (0,-3)]
|
||||||
|
dí = da <> P [cR (1,-2) (4,-3) (-4,-3)]
|
||||||
|
du = da <> P [lR (-4,0)]
|
||||||
|
dú = 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ḿ, dń, dł, 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)]
|
||||||
|
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),
|
||||||
|
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)]
|
||||||
|
dŕ = da <> Shift (-3) 5 rPartShort
|
||||||
113
laantas-script/Svg.hs
Normal file
113
laantas-script/Svg.hs
Normal file
|
|
@ -0,0 +1,113 @@
|
||||||
|
module Svg
|
||||||
|
(module Svg,
|
||||||
|
Text,
|
||||||
|
module Graphics.Svg,
|
||||||
|
module Control.Monad.Reader,
|
||||||
|
module Control.Monad.State)
|
||||||
|
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 Data.Text (Text)
|
||||||
|
|
||||||
|
|
||||||
|
data Env = E {width, size, stroke :: !Double}
|
||||||
|
data St = S {x, y, textWidth, textHeight' :: !Double}
|
||||||
|
-- nb textHeight' is one lineheight less than the actual height
|
||||||
|
-- unless ending with a 'newline'
|
||||||
|
|
||||||
|
type M = ReaderT Env (State St)
|
||||||
|
|
||||||
|
type Point = (Double, Double)
|
||||||
|
|
||||||
|
|
||||||
|
mA :: Point -> M Text
|
||||||
|
mA (x', y') =
|
||||||
|
ReaderT \E {size} -> gets \S {x, y} ->
|
||||||
|
Base.mA (x + x' * size) (y + y' * size)
|
||||||
|
|
||||||
|
mR :: Point -> M Text
|
||||||
|
mR (x', y') = reader \E {size} -> Base.mR (x' * size) (y' * size)
|
||||||
|
|
||||||
|
lA :: Point -> M Text
|
||||||
|
lA (x', y') =
|
||||||
|
ReaderT \E {size} -> gets \S {x, y} ->
|
||||||
|
Base.lA (x + x' * size) (y + y' * size)
|
||||||
|
|
||||||
|
lR :: Point -> M Text
|
||||||
|
lR (x', y') = reader \E {size} -> Base.lR (x' * size) (y' * size)
|
||||||
|
|
||||||
|
sA :: Point -> Point -> M Text
|
||||||
|
sA (x1, y1) (x2, y2) =
|
||||||
|
ReaderT \E {size} -> gets \S {x, y} ->
|
||||||
|
Base.sA (x + x1 * size) (y + y1 * size)
|
||||||
|
(x + x2 * size) (y + y2 * size)
|
||||||
|
|
||||||
|
sR :: Point -> Point -> M Text
|
||||||
|
sR (x1, y1) (x2, y2) =
|
||||||
|
reader \E {size} ->
|
||||||
|
Base.sR (x1 * size) (y1 * size) (x2 * size) (y2 * size)
|
||||||
|
|
||||||
|
cA :: Point -> Point -> Point -> M Text
|
||||||
|
cA (x1, y1) (x2, y2) (x3, y3) =
|
||||||
|
ReaderT \E {size} -> gets \S {x, y} ->
|
||||||
|
Base.cA (x + x1 * size) (y + y1 * size)
|
||||||
|
(x + x2 * size) (y + y2 * size)
|
||||||
|
(x + x3 * size) (y + y3 * size)
|
||||||
|
<> " " -- lmao
|
||||||
|
|
||||||
|
cR :: Point -> Point -> Point -> M Text
|
||||||
|
cR (x1, y1) (x2, y2) (x3, y3) =
|
||||||
|
reader \E {size} ->
|
||||||
|
Base.cR (x1 * size) (y1 * size)
|
||||||
|
(x2 * size) (y2 * size)
|
||||||
|
(x3 * size) (y3 * size)
|
||||||
|
<> " " -- lmao
|
||||||
|
|
||||||
|
|
||||||
|
data Arc = Large | Small
|
||||||
|
data Sweep = CW | CCW
|
||||||
|
|
||||||
|
arcToFlag :: Num a => Arc -> a
|
||||||
|
arcToFlag = \case Large -> 1; Small -> 0
|
||||||
|
|
||||||
|
sweepToFlag :: Num a => Sweep -> a
|
||||||
|
sweepToFlag = \case CW -> 1; CCW -> 0
|
||||||
|
|
||||||
|
aA :: Double -> Double -> Double -> Arc -> Sweep -> Point -> M Text
|
||||||
|
aA rx ry θ arc sweep (x', y') =
|
||||||
|
ReaderT \E {size} -> gets \S {x, y} ->
|
||||||
|
Base.aA (rx * size) (ry * size) θ (arcToFlag arc) (sweepToFlag sweep)
|
||||||
|
(x + x' * size) (y + y' * size)
|
||||||
|
|
||||||
|
aR :: Double -> Double -> Double -> Arc -> Sweep -> Point -> M Text
|
||||||
|
aR rx ry θ arc sweep (x', y') =
|
||||||
|
reader \E {size} ->
|
||||||
|
Base.aR (rx * size) (ry * size) θ (arcToFlag arc) (sweepToFlag sweep)
|
||||||
|
(x' * size) (y' * size)
|
||||||
|
|
||||||
|
ellipseX :: (Point -> M Text) -> Double -> Double -> Point -> [M Text]
|
||||||
|
ellipseX mX rx ry (x', y') =
|
||||||
|
[mX (x' - rx, y'), aR rx ry 0 Large CW (0,0.0001), pure z]
|
||||||
|
|
||||||
|
ellipseR, ellipseA :: Double -> Double -> Point -> [M Text]
|
||||||
|
ellipseR = ellipseX mR
|
||||||
|
ellipseA = ellipseX mA
|
||||||
|
|
||||||
|
circR :: Double -> Point -> [M Text]
|
||||||
|
circR r = ellipseR r r
|
||||||
|
|
||||||
|
circA :: Double -> Point -> [M Text]
|
||||||
|
circA r = ellipseA r r
|
||||||
|
|
||||||
|
|
||||||
|
shiftX :: Double -> St -> St
|
||||||
|
shiftX dx s@(S {x}) = s {x = x + dx}
|
||||||
|
|
||||||
|
shiftY :: Double -> St -> St
|
||||||
|
shiftY dy s@(S {y}) = s {y = y + dy}
|
||||||
|
|
||||||
|
shift :: (Double, Double) -> St -> St
|
||||||
|
shift (dx, dy) = shiftX dx . shiftY dy
|
||||||
33
laantas-script/laantas-script.cabal
Normal file
33
laantas-script/laantas-script.cabal
Normal file
|
|
@ -0,0 +1,33 @@
|
||||||
|
cabal-version: 2.2
|
||||||
|
name: laantas-script
|
||||||
|
version: 0.1.0
|
||||||
|
synopsis: write lántas script
|
||||||
|
license: AGPL-3.0-or-later
|
||||||
|
|
||||||
|
author: Rhiannon Morris <rhi@rhiannon.website>
|
||||||
|
maintainer: Rhiannon Morris <rhi@rhiannon.website>
|
||||||
|
|
||||||
|
executable laantas-script
|
||||||
|
hs-source-dirs: .
|
||||||
|
main-is: laantas-script.hs
|
||||||
|
other-modules:
|
||||||
|
Svg,
|
||||||
|
Glyphs
|
||||||
|
default-language: Haskell2010
|
||||||
|
default-extensions:
|
||||||
|
BlockArguments,
|
||||||
|
DisambiguateRecordFields,
|
||||||
|
DuplicateRecordFields,
|
||||||
|
LambdaCase,
|
||||||
|
NamedFieldPuns,
|
||||||
|
OverloadedStrings,
|
||||||
|
RecordWildCards
|
||||||
|
build-depends:
|
||||||
|
base ^>= 4.14.0.0,
|
||||||
|
containers ^>= 0.6.2.1,
|
||||||
|
mtl ^>= 2.2.2,
|
||||||
|
svg-builder ^>= 0.1.1,
|
||||||
|
optparse-applicative ^>= 0.16.0.0,
|
||||||
|
text ^>= 1.2.3.2
|
||||||
|
ghc-options:
|
||||||
|
-Wall -threaded -rtsopts -with-rtsopts=-N
|
||||||
104
laantas-script/laantas-script.hs
Normal file
104
laantas-script/laantas-script.hs
Normal file
|
|
@ -0,0 +1,104 @@
|
||||||
|
{-# OPTIONS_GHC -fdefer-typed-holes #-}
|
||||||
|
|
||||||
|
import Prelude hiding (Word)
|
||||||
|
import Svg
|
||||||
|
import Glyphs (Glyph (..), Segs)
|
||||||
|
import qualified Glyphs as G
|
||||||
|
import Options.Applicative
|
||||||
|
import qualified Data.Text as Text
|
||||||
|
import Data.Functor
|
||||||
|
import Numeric
|
||||||
|
import Data.List.NonEmpty (NonEmpty (..))
|
||||||
|
import Data.Semigroup (sconcat)
|
||||||
|
|
||||||
|
|
||||||
|
data Options =
|
||||||
|
Opts { width, size, stroke :: {-# UNPACK #-} !Double }
|
||||||
|
deriving Show
|
||||||
|
|
||||||
|
options :: IO Options
|
||||||
|
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)
|
||||||
|
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
|
||||||
|
|
||||||
|
toPx :: Double -> Text
|
||||||
|
toPx x = Text.pack (showFFloat (Just 4) x "px")
|
||||||
|
|
||||||
|
|
||||||
|
data TextSize = T {width, height :: !Double}
|
||||||
|
|
||||||
|
run :: M a -> Env -> (a, TextSize)
|
||||||
|
run m e@(E {size, stroke}) =
|
||||||
|
let (res, S {..}) = runState (runReaderT m e) s in
|
||||||
|
(res, T {width = textWidth + 2 * margin, height = textHeight'})
|
||||||
|
where
|
||||||
|
margin = stroke
|
||||||
|
ascHeight = size * 3
|
||||||
|
s = S {x = margin, y = margin + ascHeight, textWidth = 0, textHeight' = 0}
|
||||||
|
|
||||||
|
|
||||||
|
type EGlyph = (Glyph, [Segs])
|
||||||
|
type Word = [EGlyph]
|
||||||
|
|
||||||
|
doGlyphs :: [Word] -> Env -> Element
|
||||||
|
doGlyphs gs e = wrap $ run act e where
|
||||||
|
act = do
|
||||||
|
E {stroke} <- ask
|
||||||
|
let gattrs = [Stroke_ <<- "black", Stroke_width_ <<- toPx stroke,
|
||||||
|
Stroke_linecap_ <<- "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
|
||||||
|
|
||||||
|
|
||||||
|
eglyphWidth :: EGlyph -> M Double
|
||||||
|
eglyphWidth (G {width}, _) = G.withSize (* width)
|
||||||
|
|
||||||
|
wordWidth :: Word -> M Double
|
||||||
|
wordWidth = fmap sum . traverse eglyphWidth
|
||||||
|
|
||||||
|
placeWord :: Word -> M Element
|
||||||
|
placeWord w = do
|
||||||
|
wwidth <- wordWidth w
|
||||||
|
margin <- G.margin
|
||||||
|
S {x} <- get
|
||||||
|
E {width} <- ask
|
||||||
|
if x > margin && x + wwidth > width then
|
||||||
|
newline *> placeWord w
|
||||||
|
else do
|
||||||
|
mconcat <$> traverse placeGlyph w <* G.space
|
||||||
|
|
||||||
|
placeGlyph :: EGlyph -> M Element
|
||||||
|
placeGlyph (G {path = path1, width = w}, segss) = do
|
||||||
|
E {size} <- ask
|
||||||
|
S {x} <- get
|
||||||
|
gwidth <- G.withSize (* w)
|
||||||
|
path' <- G.joinSegs $ sconcat (path1 :| segss)
|
||||||
|
modify \s -> s {x = x + gwidth + size}
|
||||||
|
pure $ path_ [D_ <<- path']
|
||||||
|
|
||||||
|
newline :: M ()
|
||||||
|
newline = do
|
||||||
|
lh <- G.lineHeight
|
||||||
|
E {stroke = margin} <- ask
|
||||||
|
modify \s@(S {x, y, textWidth, textHeight'}) ->
|
||||||
|
s {x = margin, y = y + lh,
|
||||||
|
textWidth = textWidth `max` x,
|
||||||
|
textHeight' = textHeight' + lh}
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = do
|
||||||
|
Opts {..} <- options
|
||||||
|
let lántas = [(G.l, [G.dá]), (G.nt, [G.da]), (G.s0, [])]
|
||||||
|
let res = doGlyphs [lántas, lántas] (E {..})
|
||||||
|
writeFile "/home/niss/e.svg" $ show res
|
||||||
Loading…
Reference in a new issue