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