add viewBox to svg
This commit is contained in:
parent
5ad7aeddc6
commit
64245228d0
1 changed files with 7 additions and 2 deletions
|
@ -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")
|
||||
|
|
Loading…
Add table
Reference in a new issue