add script to lántas pages

laantas-script/GlyphsBase.hs

@@ -21,9 +21,6 @@ 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')
@@ -34,7 +31,15 @@ gap = withSize (* gap')
 
 data Segs = P [M Text] | Shift !Double !Double Segs | Segs :<>: Segs
 
-instance Semigroup Segs where (<>) = (:<>:)
+instance Semigroup Segs where
+  P [] <> s    = s
+  s    <> P [] = s
+  P ss <> P ts = P $ ss <> ts
+  s    <> t    = s :<>: t
+
+instance Monoid Segs where
+  mempty = P []
+  mappend = (<>)
 
 joinSegs :: Segs -> M Text
 joinSegs (P ps) = fmap mconcat $ sequence ps
@@ -74,8 +79,8 @@ 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,
+    E {stroke, color} <- ask
+    let gattrs = [Stroke_ <<- color, Stroke_width_ <<- toPx stroke,
                   Stroke_linecap_ <<- "round", Fill_ <<- "none"]
     g_ gattrs . mconcat <$> traverse placeWord gs <* newline
   wrap (content, T {width, height}) =