make diacritics width-aware
This commit is contained in:
parent
b3962582d1
commit
10d0b11570
3 changed files with 72 additions and 52 deletions
|
|
@ -1,7 +1,7 @@
|
|||
{-# OPTIONS_GHC -Wno-missing-signatures -Wno-name-shadowing #-}
|
||||
|
||||
module Glyphs
|
||||
(Glyph (..), Segs (..), Piece, doGlyphs,
|
||||
(Glyph (..), Diacritic, simpleDia, Segs (..), EGlyph, Word, doGlyphs,
|
||||
withSize,
|
||||
charHeight', lineHeight', spaceWidth', gap',
|
||||
charHeight, lineHeight, spaceWidth, gap,
|
||||
|
|
@ -9,13 +9,12 @@ module Glyphs
|
|||
initials, finals, vowels, medials, num, numbers, punctuation, wave)
|
||||
where
|
||||
|
||||
import Prelude hiding (Word)
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map.Strict as Map
|
||||
import GlyphsBase
|
||||
|
||||
|
||||
type Piece = (Glyph, [Segs])
|
||||
|
||||
initials :: Map Text Glyph
|
||||
initials = Map.fromList $
|
||||
tGlyphs <> kGlyphs <> ƶGlyphs <> sGlyphs <> šGlyphs <> lGlyphs <>
|
||||
|
|
@ -28,7 +27,7 @@ finals = Map.fromList $
|
|||
[("t",t0), ("ƶ", ƶ0), ("s",s0), ("š",š0), ("l",l0), ("m",m0),
|
||||
("n", n0), ("r", r0), ("f", f0)]
|
||||
|
||||
medials :: Map Text Segs
|
||||
medials :: Map Text [Diacritic]
|
||||
medials = Map.fromList $
|
||||
[("a", da), ("á", dá), ("i", di), ("í", dí), ("u", du), ("ú", dú),
|
||||
("ai", dai), ("au", dau), ("ia", dia), ("ua", dua), ("ḿ", dḿ),
|
||||
|
|
@ -658,38 +657,42 @@ uaPath = uNarrow <> shiftX 4.5 aPath
|
|||
|
||||
adot = P . circR 0.2
|
||||
|
||||
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,-3), lR (-3,0)]
|
||||
withWidth f w = (f w, w)
|
||||
sP = simpleDia . P
|
||||
|
||||
dai = da <> P [mR (-4,-3), lR (2.5,0), lR (0,3)]
|
||||
dau = da <> P [mR (-3,-3.5),
|
||||
-- dont move because letters like t have the join not quite at the edge
|
||||
da = [sP [lR (0,5)]]
|
||||
dá = da <> [withWidth \w -> P [mA (w/2-1,8), cR (0.75,-0.5) (1.25,0.5) (2,0)]]
|
||||
di = da <> [sP [cR (1,-2) (3,-3) (0,-3)]]
|
||||
dí = da <> [sP [cR (1,-2) (4,-3) (-4,-3)]]
|
||||
du = da <> [sP [lR (-4,0)]]
|
||||
dú = du <> [sP [mR (4,-3), lR (-3,0)]]
|
||||
|
||||
dai = da <> [sP [mR (-4,-3), lR (2.5,0), lR (0,3)]]
|
||||
dau = da <> [sP [mR (-3,-3.5),
|
||||
cR (-1.5,0.25) (-1.5,3.25) (0,3),
|
||||
cR (1.5,-0.25) (1.5,-3.25) (0,-3),
|
||||
cR (1,-0.25) (2,0.5) (3,0)]
|
||||
dia = di <> adot (-1.5,0)
|
||||
dua = du <> adot (2,-2)
|
||||
cR (1,-0.25) (2,0.5) (3,0)]]
|
||||
dia = di <> [withWidth \w -> adot (-w/2,0)]
|
||||
dua = du <> [withWidth \w -> P [mA (w/2,7)] <> adot (0,0)]
|
||||
|
||||
dḿ = da <> P [mR (-4,-3), cR (-0.375,1.125) (-0.25,1.275) (-0.25,1.375),
|
||||
dḿ = da <> [sP [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 (-2,-2.5),
|
||||
cR (0.125,-0.1) (0,-1.125) (-0.25,-1.375)]]
|
||||
dń = da <> [sP [mR (-2,-2.5),
|
||||
qR (0.25,-0.625) (-0.5,-0.5),
|
||||
cR (-1.5,0.25) (-1.5,2.75) (0,2.5),
|
||||
qR (0.375,-0.0625) (0.5,-0.3)]
|
||||
qR (0.375,-0.0625) (0.5,-0.3)]]
|
||||
dł = da <>
|
||||
P [mR (-2,-2.75),
|
||||
[sP [mR (-2,-2.75),
|
||||
cR (0.125,-0.125) (0,-0.375) (-0.625,-0.25),
|
||||
cR (-0.75,0.15) (-1,1.25) (0,1.25),
|
||||
lR (0.375,0), mR (-0.625,0),
|
||||
cR (-0.75,0.15) (-1,1.25) (0,1.25),
|
||||
qR (1,0) (1.125,-0.375)]
|
||||
dŕ = da <> P [mR (-3,0), cR (1,0) (3,-1) (3,-2)]
|
||||
qR (1,0) (1.125,-0.375)]]
|
||||
dŕ = da <> [sP [mR (-3,0), cR (1,0) (3,-1) (3,-2)]]
|
||||
|
||||
punctuation :: Map Text Glyph
|
||||
punctuation = Map.fromList
|
||||
|
|
|
|||
|
|
@ -3,8 +3,8 @@ module GlyphsBase (module GlyphsBase, module Svg) where
|
|||
import Svg hiding (shiftX, shiftY, shift, width, size)
|
||||
import qualified Svg
|
||||
|
||||
import Data.List.NonEmpty (NonEmpty (..))
|
||||
import Data.Semigroup (sconcat)
|
||||
import Prelude hiding (Word)
|
||||
import Data.Foldable
|
||||
import Numeric
|
||||
import Prelude hiding (Word)
|
||||
|
||||
|
|
@ -74,9 +74,15 @@ run m e@(E {size}) =
|
|||
textWidth = 0, textHeight = 0, firstOnLine = True}
|
||||
|
||||
|
||||
type EGlyph = (Glyph, [Segs])
|
||||
type Word = [EGlyph]
|
||||
|
||||
type EGlyph = (Glyph, [Diacritic])
|
||||
|
||||
type Diacritic = Double -> (Segs, Double)
|
||||
|
||||
simpleDia :: Segs -> Diacritic
|
||||
simpleDia ss w = (ss, w)
|
||||
|
||||
doGlyphs :: [Word] -> Env -> Element
|
||||
doGlyphs gs e = wrap $ run act e where
|
||||
act = do
|
||||
|
|
@ -91,7 +97,12 @@ doGlyphs gs e = wrap $ run act e where
|
|||
|
||||
|
||||
glyphWidth :: EGlyph -> M Double
|
||||
glyphWidth (G {width}, _) = (+) <$> withSize (* width) <*> gap
|
||||
glyphWidth (G {width}, ss) =
|
||||
let w = foldl (\x f -> snd $ f x) width ss in
|
||||
(+) <$> withSize (* w) <*> gap
|
||||
|
||||
totalWidth :: Double -> M Double
|
||||
totalWidth width = (+) <$> withSize (* width) <*> gap
|
||||
|
||||
wordWidth :: Word -> M Double
|
||||
wordWidth = fmap sum . traverse glyphWidth
|
||||
|
|
@ -111,11 +122,17 @@ placeWord w = do
|
|||
pure e
|
||||
|
||||
placeGlyph :: EGlyph -> M Element
|
||||
placeGlyph g@(G {path = path1}, segss) = do
|
||||
gwidth <- glyphWidth g
|
||||
path' <- joinSegs $ sconcat (path1 :| segss)
|
||||
modify \s@(S {x}) -> s {x = x + gwidth}
|
||||
pure $ path_ [D_ <<- path']
|
||||
placeGlyph (G {path = path1, width = width1}, dias) = do
|
||||
let (segs', width') = placeDia width1 dias
|
||||
path <- joinSegs $ path1 <> segs'
|
||||
width <- totalWidth width'
|
||||
modify \s@(S {x}) -> s {x = x + width}
|
||||
pure $ path_ [D_ <<- path]
|
||||
|
||||
placeDia :: Double -> [Diacritic] -> (Segs, Double)
|
||||
placeDia w dias =
|
||||
flip runState w $
|
||||
fold <$> traverse state dias
|
||||
|
||||
newline :: M ()
|
||||
newline = do
|
||||
|
|
|
|||
|
|
@ -29,8 +29,8 @@ maxFrom name i = longestWith name \x -> Map.lookup x i
|
|||
initial :: P Glyph
|
||||
initial = maxFrom "initial" initials
|
||||
|
||||
medial :: P Segs
|
||||
medial = P [] <$ chunk "\\" <|> maxFrom "medial" medials
|
||||
medial :: P [Diacritic]
|
||||
medial = [] <$ chunk "\\" <|> maxFrom "medial" medials
|
||||
|
||||
final :: P Glyph
|
||||
final = maxFrom "final" finals
|
||||
|
|
@ -38,29 +38,29 @@ final = maxFrom "final" finals
|
|||
ivowel :: P Glyph
|
||||
ivowel = maxFrom "vowel" vowels
|
||||
|
||||
word :: P [Piece]
|
||||
word :: P [EGlyph]
|
||||
word = [is <> f <> concat p | is <- some initMed, f <- fin, p <- many punct]
|
||||
where
|
||||
initMed = try $
|
||||
[(i, [m]) | i <- initial, m <- medial] <|>
|
||||
(,) <$> initial <*> medial <|>
|
||||
[(v, []) | v <- ivowel] <|>
|
||||
dash
|
||||
fin = maybe [] (\x -> [(x, [])]) <$> optional final
|
||||
|
||||
number :: P [Piece]
|
||||
number :: P [EGlyph]
|
||||
number = some (digit <|> hash) where
|
||||
hash = (num, []) <$ chunk "#"
|
||||
digit = [(numbers ! Char.digitToInt i, []) | i <- digitChar]
|
||||
|
||||
punct :: P [Piece]
|
||||
punct :: P [EGlyph]
|
||||
punct = [[(p, [])] | p <- maxFrom "punctuation" punctuation] <* space
|
||||
|
||||
dash :: P Piece
|
||||
dash :: P EGlyph
|
||||
dash = (wave, []) <$ chunk "–"
|
||||
|
||||
text :: P [[Piece]]
|
||||
text :: P [[EGlyph]]
|
||||
text = space *> many (segment <* space) <* eof where
|
||||
segment = punct <|> number <|> word
|
||||
|
||||
split :: Text -> [[Piece]]
|
||||
split :: Text -> [[EGlyph]]
|
||||
split = either (error . errorBundlePretty) id . parse text ""
|
||||
|
|
|
|||
Loading…
Reference in a new issue