add viewBox to svg

This commit is contained in:
Rhiannon Morris 2024-11-28 01:30:13 +01:00
parent 5ad7aeddc6
commit 64245228d0

View file

@ -7,6 +7,7 @@ import Prelude hiding (Word)
import Data.Foldable
import Numeric
import Prelude hiding (Word)
import qualified Data.Text as Text
data Glyph = G {path :: Segs, size :: SizeInfo}
@ -103,8 +104,9 @@ doGlyphsNoDoctype gs e = wrap $ run act e where
Fill_ <<- "none"]
g_ gattrs . mconcat <$> traverse placeWord gs <* newline
wrap (content, T {width, height}) =
let sattrs = [Height_ <<- toPx height, Width_ <<- toPx width] in
svg11_ content `with` sattrs
let w = toPx width; h = toPx height
viewBox = Text.unwords ["0", "0", toNoDim width, toNoDim height] in
svg11_ content `with` [Width_ <<- w, Height_ <<- h, ViewBox_ <<- viewBox]
doGlyphs :: [Word] -> Env -> Element
doGlyphs gs e = doctype <> doGlyphsNoDoctype gs e
@ -161,5 +163,8 @@ newline = do
textHeight = textHeight + lh,
firstOnLine = True}
toNoDim :: Double -> Text
toNoDim x = pack (showFFloat (Just 4) x "")
toPx :: Double -> Text
toPx x = pack (showFFloat (Just 4) x "px")