Make the subglyph api a bit nicer.

This commit is contained in:
David 2019-02-19 17:09:46 +01:00
commit 8e383c8990
3 changed files with 13 additions and 13 deletions

View file

@ -78,11 +78,11 @@ latex_color = proc () -> do
emit -< toHtml $ mkBackground "black" emit -< toHtml $ mkBackground "black"
emit -< toHtml $ translate (320/2) (180/2) $ withStrokeWidth (Num 0.2) $ emit -< toHtml $ translate (320/2) (180/2) $ withStrokeWidth (Num 0.2) $
withStrokeColor "white" $ withStrokeColor "white" $
withSubglyphs 0 1 (withFillColor "blue") $ withSubglyphs [0] (withFillColor "blue") $
withSubglyphs 1 2 (withFillColor "yellow") $ withSubglyphs [1] (withFillColor "yellow") $
withSubglyphs 2 3 (withFillColor "green") $ withSubglyphs [2] (withFillColor "green") $
withSubglyphs 3 4 (withFillColor "red") $ withSubglyphs [3] (withFillColor "red") $
withSubglyphs 4 5 (withFillColor "darkslategrey") $ withSubglyphs [4] (withFillColor "darkslategrey") $
svg svg
where where
svg = scale 10 $ center $ latex "\\LaTeX" svg = scale 10 $ center $ latex "\\LaTeX"

View file

@ -485,11 +485,11 @@ latex_color = proc () -> do
emit -< toHtml $ mkBackground "black" emit -< toHtml $ mkBackground "black"
emit -< toHtml $ translate (320/2) (180/2) $ withStrokeWidth (Num 0.2) $ emit -< toHtml $ translate (320/2) (180/2) $ withStrokeWidth (Num 0.2) $
withStrokeColor "white" $ withStrokeColor "white" $
withSubglyphs 0 1 (withFillColor "blue") $ withSubglyphs [0] (withFillColor "blue") $
withSubglyphs 1 2 (withFillColor "yellow") $ withSubglyphs [1] (withFillColor "yellow") $
withSubglyphs 2 3 (withFillColor "green") $ withSubglyphs [2] (withFillColor "green") $
withSubglyphs 3 4 (withFillColor "red") $ withSubglyphs [3] (withFillColor "red") $
withSubglyphs 4 5 (withFillColor "darkslategrey") $ withSubglyphs [4] (withFillColor "darkslategrey") $
svg svg
where where
svg = scale 10 $ center $ latex "\\LaTeX" svg = scale 10 $ center $ latex "\\LaTeX"

View file

@ -446,8 +446,8 @@ mkPathText str =
mkBackground :: String -> Tree mkBackground :: String -> Tree
mkBackground color = withFillColor color $ mkRect (Num 0, Num 0) (Percent 100) (Percent 100) mkBackground color = withFillColor color $ mkRect (Num 0, Num 0) (Percent 100) (Percent 100)
withSubglyphs :: Int -> Int -> (Tree -> Tree) -> Tree -> Tree withSubglyphs :: [Int] -> (Tree -> Tree) -> Tree -> Tree
withSubglyphs from to fn t = evalState (worker t) 0 withSubglyphs target fn t = evalState (worker t) 0
where where
worker :: Tree -> State Int Tree worker :: Tree -> State Int Tree
worker t = worker t =
@ -466,6 +466,6 @@ withSubglyphs from to fn t = evalState (worker t) 0
handleGlyph :: Tree -> State Int Tree handleGlyph :: Tree -> State Int Tree
handleGlyph t = do handleGlyph t = do
n <- get <* modify (+1) n <- get <* modify (+1)
if n >= from && n < to if n `elem` target
then return $ fn t then return $ fn t
else return t else return t