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 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")
|
||||||
|
|
Loading…
Add table
Reference in a new issue