diagrams-svg 0.8.0.2 → 1.0
raw patch · 7 files changed
+261/−174 lines, 7 filesdep +containersdep +lensdep −cmdargsdep ~diagrams-coredep ~diagrams-lib
Dependencies added: containers, lens
Dependencies removed: cmdargs
Dependency ranges changed: diagrams-core, diagrams-lib
Files
- CHANGES.markdown +8/−0
- LICENSE +4/−0
- README.md +12/−9
- diagrams-svg.cabal +5/−4
- src/Diagrams/Backend/SVG.hs +74/−64
- src/Diagrams/Backend/SVG/CmdLine.hs +139/−85
- src/Graphics/Rendering/SVG.hs +19/−12
CHANGES.markdown view
@@ -1,3 +1,11 @@+1.0 (24 November 2013)+----------------------++ - Re-implement via new backend `RTree` interface, leading to+ smaller output files.+ - Use new command-line interface from `diagrams-lib`.+ - Export `B` as an alias for `SVG` token+ 0.8.0.2 (26 October 2013) -------------------------
LICENSE view
@@ -1,8 +1,12 @@ Copyright 2011-2013 diagrams-svg team: + Daniel Bergey <bergey@alum.mit.edu>+ Jan Bracker <jan.bracker@googlemail.com>+ Daniil Frumin <difrumin@gmail.com> Deepak Jois <deepak.jois@gmail.com> Felipe Lessa <felipe.lessa@gmail.com> Chris Mears <chris@cmears.id.au>+ Jeffrey Rosenbluth <Jeffrey.Rosenbluth@gmail.com> Michael Sloan <mgsloan@gmail.com> Michael Thompson <what_is_it_to_do_anything@yahoo.com> Ryan Yates <fryguybob@gmail.com>
README.md view
@@ -28,7 +28,7 @@ b1 = square 20 # lw 0.002 -main = defaultMain (pad 1.1 b1)+main = mainWith (pad 1.1 b1) ``` Save this to file named `Square.hs` and compile this program:@@ -42,16 +42,19 @@ ``` $ ./Square --help-Command-line diagram generation.+./Square -Square [OPTIONS]+Usage: ./Square [-w|--width WIDTH] [-h|--height HEIGHT] [-o|--output OUTPUT] [--loop] [-s|--src ARG] [-i|--interval INTERVAL]+ Command-line diagram generation. -Common flags:- -w --width=INT Desired width of the output image- -h --height=INT Desired height of the output image- -o --output=FILE Output file- -? --help Display help message- -V --version Print version information+Available options:+ -?,--help Show this help text+ -w,--width WIDTH Desired WIDTH of the output image+ -h,--height HEIGHT Desired HEIGHT of the output image+ -o,--output OUTPUT OUTPUT file+ -l,--loop Run in a self-recompiling loop+ -s,--src ARG Source file to watch+ -i,--interval INTERVAL When running in a loop, check for changes every INTERVAL seconds. ``` You _must_ pass an output file name with a `.svg` extension to generate the SVG
diagrams-svg.cabal view
@@ -1,5 +1,5 @@ Name: diagrams-svg-Version: 0.8.0.2+Version: 1.0 Synopsis: SVG backend for diagrams drawing EDSL. Homepage: http://projects.haskell.org/diagrams/ License: BSD3@@ -49,13 +49,14 @@ , bytestring >= 0.9 && < 1.0 , vector-space >= 0.7 && < 0.9 , colour- , diagrams-core >= 0.7 && < 0.8- , diagrams-lib >= 0.7.1 && < 0.8+ , diagrams-core >= 1.0 && < 1.1+ , diagrams-lib >= 1.0 && < 1.1 , monoid-extras >= 0.3 && < 0.4 , blaze-svg >= 0.3.3- , cmdargs >= 0.6 && < 0.11 , split >= 0.1.2 && < 0.3 , time+ , containers >= 0.3 && < 0.6+ , lens >= 3.8 && < 4 if !os(windows) cpp-options: -DCMDLINELOOP Build-depends: unix >= 2.4 && < 2.8
src/Diagrams/Backend/SVG.hs view
@@ -2,10 +2,11 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeSynonymInstances #-} ------------------------------------------------------------------------------+---------------------------------------------------------------------------- -- | -- Module : Diagrams.Backend.SVG -- Copyright : (c) 2011-2012 diagrams-svg team (see LICENSE)@@ -45,7 +46,7 @@ -- > data Options SVG R2 = SVGOptions -- > { size :: SizeSpec2D -- ^ The requested size. -- > , svgDefinitions :: Maybe S.Svg--- > -- ^ Custom definitions that will be added to the @defs@ +-- > -- ^ Custom definitions that will be added to the @defs@ -- > -- section of the output. -- > } --@@ -75,11 +76,17 @@ module Diagrams.Backend.SVG ( SVG(..) -- rendering token- , Options(..) -- for rendering options specific to SVG+ , B+ , Options(..), size, svgDefinitions -- for rendering options specific to SVG , renderSVG ) where +-- for testing+import Diagrams.Core.Compile+import Data.Tree+import Data.Foldable (foldMap)+ -- from base import Control.Monad.State import Data.Typeable@@ -87,15 +94,15 @@ -- from bytestring import qualified Data.ByteString.Lazy as BS +-- from lens+import Control.Lens hiding ((#), transform)+ -- from diagrams-lib-import Diagrams.Prelude+import Diagrams.Prelude hiding (view) import Diagrams.TwoD.Adjust (adjustDia2D)-import Diagrams.TwoD.Path (getClip)+import Diagrams.TwoD.Path (Clip(Clip)) import Diagrams.TwoD.Text --- from monoid-extras-import Data.Monoid.Split (Split (..))- -- from blaze-svg import Text.Blaze.Svg.Renderer.Utf8 (renderSvg) import Text.Blaze.Svg11 ((!))@@ -110,8 +117,12 @@ data SVG = SVG deriving (Show, Typeable) -data SvgRenderState = SvgRenderState { clipPathId :: Int, ignoreFill :: Bool }+type B = SVG +data SvgRenderState = SvgRenderState { _clipPathId :: Int, _ignoreFill :: Bool }++makeLenses ''SvgRenderState+ initialSvgRenderState :: SvgRenderState initialSvgRenderState = SvgRenderState 0 False @@ -120,12 +131,6 @@ -- for assiging a unique clip path ID. type SvgRenderM = State SvgRenderState S.Svg -incrementClipPath :: State SvgRenderState ()-incrementClipPath = modify (\st -> st { clipPathId = clipPathId st + 1 })--setIgnoreFill :: Bool -> State SvgRenderState ()-setIgnoreFill b = modify (\st -> st { ignoreFill = b })- instance Monoid (Render SVG R2) where mempty = R $ return mempty (R r1) `mappend` (R r2_) =@@ -134,95 +139,100 @@ svg2 <- r2_ return (svg1 `mappend` svg2) --- | Renders a <g> element with styles applied as attributes.-renderStyledGroup :: Bool -> Style v -> (S.Svg -> S.Svg)-renderStyledGroup ignFill s = S.g ! R.renderStyles ignFill s-+-- XXX comment me renderSvgWithClipping :: S.Svg -- ^ Input SVG -> Style v -- ^ Styles- -> Transformation R2 -- ^ Freeze transform -> SvgRenderM -- ^ Resulting svg-renderSvgWithClipping svg s t =- case (transform (inv t) <$> getClip <$> getAttr s) of+renderSvgWithClipping svg s =+ case (op Clip <$> getAttr s) of Nothing -> return $ svg Just paths -> renderClips paths where renderClips :: [Path R2] -> SvgRenderM renderClips [] = return $ svg renderClips (p:ps) = do- incrementClipPath- id_ <- gets clipPathId+ clipPathId += 1+ id_ <- use clipPathId R.renderClip p id_ <$> renderClips ps +-- | Convert an RTree to a renderable object. The unfrozen transforms have+-- been accumulated and are in the leaves of the RTree along with the Prims.+-- Frozen transformations have their own nodes and the styles have been+-- transfomed during the contruction of the RTree.+renderRTree :: RTree SVG R2 a -> Render SVG R2+renderRTree (Node (RPrim accTr p) _) = (render SVG (transform accTr p))+renderRTree (Node (RStyle sty) ts)+ = R $ do+ let R r = foldMap renderRTree ts+ ignoreFill .= False+ svg <- r+ ign <- use ignoreFill+ clippedSvg <- renderSvgWithClipping svg sty+ return $ (S.g ! R.renderStyles ign sty) clippedSvg+renderRTree (Node (RFrozenTr tr) ts)+ = R $ do+ let R r = foldMap renderRTree ts+ svg <- r+ return $ R.renderTransform tr svg+renderRTree (Node _ ts) = foldMap renderRTree ts+ instance Backend SVG R2 where data Render SVG R2 = R SvgRenderM type Result SVG R2 = S.Svg data Options SVG R2 = SVGOptions- { size :: SizeSpec2D -- ^ The requested size.- , svgDefinitions :: Maybe S.Svg- -- ^ Custom definitions that will be added to the @defs@ + { _size :: SizeSpec2D -- ^ The requested size.+ , _svgDefinitions :: Maybe S.Svg+ -- ^ Custom definitions that will be added to the @defs@ -- section of the output. } - -- | Here the SVG backend is different from the other backends. We- -- give a different definition of renderDia, where only the- -- non-frozen transformation is applied to the primitives before- -- they are passed to render. This means that withStyle is- -- responsible for applying the frozen transformation to the- -- primitives.- withStyle _ s t (R r) =- R $ do- setIgnoreFill False- svg <- r- ign <- gets ignoreFill- clippedSvg <- renderSvgWithClipping svg s t- let styledSvg = renderStyledGroup ign s clippedSvg- -- This is where the frozen transformation is applied.- return (R.renderTransform t styledSvg)- doRender _ opts (R r) = evalState svgOutput initialSvgRenderState where svgOutput = do svg <- r- let (w,h) = case size opts of+ let (w,h) = case opts^.size of Width w' -> (w',w') Height h' -> (h',h') Dims w' h' -> (w',h') Absolute -> (100,100)- return $ R.svgHeader w h (svgDefinitions opts) $ svg+ return $ R.svgHeader w h (opts^.svgDefinitions) $ svg - adjustDia c opts d = adjustDia2D size setSvgSize c opts+ adjustDia c opts d = adjustDia2D _size setSvgSize c opts (d # reflectY # recommendFillColor (transparent :: AlphaColour Double) )- where setSvgSize sz o = o { size = sz }+ where setSvgSize sz o = o { _size = sz } - -- | This implementation of renderDia is the same as the default one,- -- except that it only applies the non-frozen transformation to the- -- primitives before passing them to render.- renderDia SVG opts d =- doRender SVG opts' . mconcat . map renderOne . prims $ d'- where (opts', d') = adjustDia SVG opts d- renderOne :: (Prim SVG R2, (Split (Transformation R2), Style R2))- -> Render SVG R2- renderOne (p, (M t, s))- = withStyle SVG s mempty (render SVG (transform t p))+ renderData _ = renderRTree . toRTree - renderOne (p, (t1 :| t2, s))- -- Here is the difference from the default- -- implementation: "t2" instead of "t1 <> t2".- = withStyle SVG s t1 (render SVG (transform t2 p))+getSize :: Options SVG R2 -> SizeSpec2D+getSize (SVGOptions {_size = s}) = s +setSize :: Options SVG R2 -> SizeSpec2D -> Options SVG R2+setSize o s = o {_size = s}++size :: Lens' (Options SVG R2) SizeSpec2D+size = lens getSize setSize++getSVGDefs :: Options SVG R2 -> Maybe S.Svg+getSVGDefs (SVGOptions {_svgDefinitions = d}) = d++setSVGDefs :: Options SVG R2 -> Maybe S.Svg -> Options SVG R2+setSVGDefs o d = o {_svgDefinitions = d}++svgDefinitions :: Lens' (Options SVG R2) (Maybe S.Svg)+svgDefinitions = lens getSVGDefs setSVGDefs+ instance Show (Options SVG R2) where show opts = concat $ [ "SVGOptions { " , "size = "- , show $ size opts+ , show $ opts^.size , " , " , "svgDefinitions = "- , case svgDefinitions opts of+ , case opts^.svgDefinitions of Nothing -> "Nothing" Just svg -> "Just " ++ StringSvg.renderSvg svg , " }"@@ -238,7 +248,7 @@ render _ p = R $ do -- Don't fill lines. diagrams-lib separates out lines and loops -- for us, so if we see one line, they are all lines.- when (any (isLine . unLoc) . pathTrails $ p) $ setIgnoreFill True+ when (any (isLine . unLoc) . op Path $ p) $ (ignoreFill .= True) return (R.renderPath p) instance Renderable Text SVG where
src/Diagrams/Backend/SVG/CmdLine.hs view
@@ -1,8 +1,12 @@-{-# LANGUAGE DeriveDataTypeable, CPP #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Diagrams.Backend.SVG.CmdLine--- Copyright : (c) 2011 Diagrams team (see LICENSE)+-- Copyright : (c) 2013 Diagrams team (see LICENSE) -- License : BSD-style (see LICENSE) -- Maintainer : diagrams-discuss@googlegroups.com --@@ -15,42 +19,69 @@ -- * 'multiMain' is like 'defaultMain' but allows for a list of -- diagrams from which the user can choose one to render. --+-- * 'mainWith' is a generic form that does all of the above but with+-- a slightly scarier type. See "Diagrams.Backend.CmdLine". This+-- form can also take a function type that has a subtable final result+-- (any of arguments to the above types) and 'Parseable' arguments.+-- -- If you want to generate diagrams programmatically---/i.e./ if you -- want to do anything more complex than what the below functions -- provide---you have several options. ----- * A simple but somewhat inflexible approach is to wrap up--- 'defaultMain' (or 'multiMain') in a call to--- 'System.Environment.withArgs'.+-- * Use a function with 'mainWith'. This may require making+-- 'Parseable' instances for custom argument types. --+-- * Make a new 'Mainable' instance. This may require a newtype+-- wrapper on your diagram type to avoid the existing instances.+-- This gives you more control over argument parsing, intervening+-- steps, and diagram creation.+--+-- * Build option records and pass them along with a diagram to 'mainRender'+-- from "Diagrams.Backend.CmdLine".+-- -- * You can use 'Diagrams.Backend.SVG.renderSVG' to render a diagram -- to a file directly; see "Diagrams.Backend.SVG". -- -- * A more flexible approach is to directly call 'renderDia'; see -- "Diagrams.Backend.SVG" for more information.-+--+-- For a tutorial on command-line diagram creation see+-- <http://projects.haskell.org/diagrams/doc/cmdline.html>.+-- ----------------------------------------------------------------------------- module Diagrams.Backend.SVG.CmdLine- ( defaultMain+ ( + -- * General form of @main@+ -- $mainwith++ mainWith++ -- * Supported forms of @main@++ , defaultMain , multiMain + -- * Backend tokens+ , SVG+ , B ) where import Diagrams.Prelude hiding (width, height, interval) import Diagrams.Backend.SVG+import Diagrams.Backend.CmdLine -import System.Console.CmdArgs.Implicit hiding (args)+import Control.Lens import Text.Blaze.Svg.Renderer.Utf8 (renderSvg) import qualified Data.ByteString.Lazy as BS -import Data.Maybe (fromMaybe)-import Control.Monad (when) import Data.List.Split -import System.Environment (getArgs, getProgName)+#ifdef CMDLINELOOP+import Data.Maybe (fromMaybe)+import Control.Monad (when) import System.Directory (getModificationTime) import System.Process (runProcess, waitForProcess) import System.IO (openFile, hClose, IOMode(..),@@ -60,9 +91,8 @@ import qualified Control.Exception as Exc (catch, bracket) import Control.Exception (SomeException(..)) -#ifdef CMDLINELOOP+import System.Environment (getProgName,getArgs) import System.Posix.Process (executeFile)-#endif # if MIN_VERSION_directory(1,2,0)@@ -76,51 +106,30 @@ getModuleTime :: IO ModuleTime getModuleTime = getClockTime #endif---data DiagramOpts = DiagramOpts- { width :: Maybe Int- , height :: Maybe Int- , output :: FilePath- , selection :: Maybe String-#ifdef CMDLINELOOP- , loop :: Bool- , src :: Maybe String- , interval :: Int #endif- }- deriving (Show, Data, Typeable) -diagramOpts :: String -> Bool -> DiagramOpts-diagramOpts prog sel = DiagramOpts- { width = def- &= typ "INT"- &= help "Desired width of the output image"+-- $mainwith+-- The 'mainWith' method unifies all of the other forms of @main@ and is+-- now the recommended way to build a command-line diagrams program. It+-- works as a direct replacement for 'defaultMain' or 'multiMain' as well+-- as allowing more general arguments. For example, given a function that+-- produces a diagram when given an @Int@ and a @'Colour' Double@, 'mainWith'+-- will produce a program that looks for additional number and color arguments.+--+-- > ... definitions ...+-- > f :: Int -> Colour Double -> Diagram SVG R2+-- > f i c = ...+-- >+-- > main = mainWith f+--+-- We can run this program as follows:+--+-- > $ ghc --make MyDiagram+-- > +-- > # output image.svg built by `f 20 red`+-- > $ ./MyDiagram -o image.svg -w 200 20 red - , height = def- &= typ "INT"- &= help "Desired height of the output image" - , output = def- &= typFile- &= help "Output file"-- , selection = def- &= help "Name of the diagram to render"- &= (if sel then typ "NAME" else ignore)-#ifdef CMDLINELOOP- , loop = False- &= help "Run in a self-recompiling loop"- , src = def- &= typFile- &= help "Source file to watch"- , interval = 1 &= typ "SECONDS"- &= help "When running in a loop, check for changes every n seconds."-#endif- }- &= summary "Command-line diagram generation."- &= program prog- -- | This is the simplest way to render diagrams, and is intended to -- be used like so: --@@ -133,23 +142,55 @@ -- and so on, and renders @myDiagram@ with the specified options. -- -- Pass @--help@ to the generated executable to see all available--- options.+-- options. Currently it looks something like+--+-- @+-- ./Program+--+-- Usage: ./Program [-w|--width WIDTH] [-h|--height HEIGHT] [-o|--output OUTPUT] [--loop] [-s|--src ARG] [-i|--interval INTERVAL]+-- Command-line diagram generation.+--+-- Available options:+-- -?,--help Show this help text+-- -w,--width WIDTH Desired WIDTH of the output image+-- -h,--height HEIGHT Desired HEIGHT of the output image+-- -o,--output OUTPUT OUTPUT file+-- -l,--loop Run in a self-recompiling loop+-- -s,--src ARG Source file to watch+-- -i,--interval INTERVAL When running in a loop, check for changes every INTERVAL seconds.+-- @+--+-- For example, a common scenario is+--+-- @+-- $ ghc --make MyDiagram+--+-- # output image.svg with a width of 400pt (and auto-determined height)+-- $ ./MyDiagram -o image.svg -w 400+-- @+ defaultMain :: Diagram SVG R2 -> IO ()-defaultMain d = do- prog <- getProgName- args <- getArgs- opts <- cmdArgs (diagramOpts prog False)- chooseRender opts d+defaultMain = mainWith++instance Mainable (Diagram SVG R2) where #ifdef CMDLINELOOP- when (loop opts) (waitForChange Nothing opts prog args)+ type MainOpts (Diagram SVG R2) = (DiagramOpts, DiagramLoopOpts)++ mainRender (opts,loopOpts) d = do+ chooseRender opts d+ when (loopOpts^.loop) (waitForChange Nothing loopOpts)+#else+ type MainOpts (Diagram SVG R2) = DiagramOpts++ mainRender opts d = chooseRender opts d #endif chooseRender :: DiagramOpts -> Diagram SVG R2 -> IO () chooseRender opts d =- case splitOn "." (output opts) of+ case splitOn "." (opts^.output) of [""] -> putStrLn "No output file given." ps | last ps `elem` ["svg"] -> do- let sizeSpec = case (width opts, height opts) of+ let sizeSpec = case (opts^.width, opts^.height) of (Nothing, Nothing) -> Absolute (Just w, Nothing) -> Width (fromIntegral w) (Nothing, Just h) -> Height (fromIntegral h)@@ -157,39 +198,52 @@ (fromIntegral h) build = renderDia SVG (SVGOptions sizeSpec Nothing) d- BS.writeFile (output opts) (renderSvg build)+ BS.writeFile (opts^.output) (renderSvg build) | otherwise -> putStrLn $ "Unknown file type: " ++ last ps - -- | @multiMain@ is like 'defaultMain', except instead of a single -- diagram it takes a list of diagrams paired with names as input.--- The generated executable then takes an argument specifying the--- name of the diagram that should be rendered. This is a--- convenient way to create an executable that can render many--- different diagrams without modifying the source code in between--- each one.+-- The generated executable then takes a @--selection@ option+-- specifying the name of the diagram that should be rendered. The+-- list of available diagrams may also be printed by passing the+-- option @--list@.+--+-- Example usage:+--+-- @+-- $ ghc --make MultiTest+-- [1 of 1] Compiling Main ( MultiTest.hs, MultiTest.o )+-- Linking MultiTest ...+-- $ ./MultiTest --list+-- Available diagrams:+-- foo bar+-- $ ./MultiTest --selection bar -o Bar.eps -w 200+-- @+ multiMain :: [(String, Diagram SVG R2)] -> IO ()-multiMain ds = do- prog <- getProgName- opts <- cmdArgs (diagramOpts prog True)- case selection opts of- Nothing -> putStrLn "No diagram selected."- Just sel -> case lookup sel ds of- Nothing -> putStrLn $ "Unknown diagram: " ++ sel- Just d -> chooseRender opts d+multiMain = mainWith +instance Mainable [(String,Diagram SVG R2)] where+ type MainOpts [(String,Diagram SVG R2)] + = (MainOpts (Diagram SVG R2), DiagramMultiOpts)++ mainRender = defaultMultiMainRender++ #ifdef CMDLINELOOP-waitForChange :: Maybe ModuleTime -> DiagramOpts -> String -> [String] -> IO ()-waitForChange lastAttempt opts prog args = do+waitForChange :: Maybe ModuleTime -> DiagramLoopOpts -> IO ()+waitForChange lastAttempt opts = do+ prog <- getProgName+ args <- getArgs hSetBuffering stdout NoBuffering- go lastAttempt- where go lastAtt = do- threadDelay (1000000 * interval opts)+ go prog args lastAttempt+ where go prog args lastAtt = do+ threadDelay (1000000 * opts^.interval) -- putStrLn $ "Checking... (last attempt = " ++ show lastAttempt ++ ")"- (newBin, newAttempt) <- recompile lastAtt prog (src opts)+ (newBin, newAttempt) <- recompile lastAtt prog (opts^.src) if newBin then executeFile prog False args Nothing- else go $ getFirst (First newAttempt <> First lastAtt)+ else go prog args $ getFirst (First newAttempt <> First lastAtt) -- | @recompile t prog@ attempts to recompile @prog@, assuming the -- last attempt was made at time @t@. If @t@ is @Nothing@ assume
src/Graphics/Rendering/SVG.hs view
@@ -24,13 +24,17 @@ , renderStyles , renderTransform , renderMiterLimit+ , getMatrix ) where -- from base import Data.List (intercalate, intersperse) +-- from lens+import Control.Lens+ -- from diagrams-lib-import Diagrams.Prelude hiding (Attribute, Render, e, (<>))+import Diagrams.Prelude hiding (Attribute, Render, (<>)) import Diagrams.TwoD.Path (getFillRule) import Diagrams.TwoD.Text @@ -39,7 +43,7 @@ import qualified Text.Blaze.Svg11 as S import qualified Text.Blaze.Svg11.Attributes as A --- | @svgHeader w h defs s@: @w@ width, @h@ height, +-- | @svgHeader w h defs s@: @w@ width, @h@ height, -- @defs@ global definitions for defs sections, @s@ actual SVG content. svgHeader :: Double -> Double -> Maybe S.Svg -> S.Svg -> S.Svg svgHeader w h_ defines s = S.docTypeSvg@@ -47,16 +51,16 @@ ! A.width (S.toValue w) ! A.height (S.toValue h_) ! A.fontSize "1"- ! A.viewbox (S.toValue $ concat . intersperse " " $ map show ([0, 0, round w, round h_] :: [Int])) - $ do case defines of + ! A.viewbox (S.toValue $ concat . intersperse " " $ map show ([0, 0, round w, round h_] :: [Int]))+ $ do case defines of Nothing -> return () Just defs -> S.defs $ defs S.g $ s renderPath :: Path R2 -> S.Svg-renderPath (Path trs) = S.path ! A.d makePath+renderPath trs = S.path ! A.d makePath where- makePath = mkPath $ mapM_ renderTrail trs+ makePath = mkPath $ mapM_ renderTrail (op Path trs) renderTrail :: Located (Trail R2) -> S.Path renderTrail (viewLoc -> (unp2 -> (x,y), t)) = flip withLine t $ \l -> do@@ -74,8 +78,8 @@ = cr x0 y0 x1 y1 x2 y2 renderClip :: Path R2 -> Int -> S.Svg -> S.Svg-renderClip p id_ svg = do - S.g ! A.clipPath (S.toValue $ "url(#" ++ clipPathId id_ ++ ")") $ do +renderClip p id_ svg = do+ S.g ! A.clipPath (S.toValue $ "url(#" ++ clipPathId id_ ++ ")") $ do S.clippath ! A.id_ (S.toValue $ clipPathId id_) $ renderPath p svg where clipPathId i = "myClip" ++ show i@@ -92,7 +96,7 @@ vAlign = case tAlign of BaselineText -> "alphabetic" BoxAlignedText _ h -> case h of -- A mere approximation- h' | h' <= 0.25 -> "text-after-edge" + h' | h' <= 0.25 -> "text-after-edge" h' | h' >= 0.75 -> "text-before-edge" _ -> "middle" hAlign = case tAlign of@@ -114,8 +118,11 @@ -- | Apply a transformation to some already-rendered SVG. renderTransform :: Transformation R2 -> S.Svg -> S.Svg-renderTransform t svg = S.g svg ! (A.transform $ S.matrix a1 a2 b1 b2 c1 c2)- where (a1,a2,b1,b2,c1,c2) = getMatrix t+renderTransform t svg =+ if i then svg+ else S.g svg ! (A.transform $ S.matrix a1 a2 b1 b2 c1 c2)+ where (a1,a2,b1,b2,c1,c2) = getMatrix t+ i = (a1,a2,b1,b2,c1,c2) == (1,0,0,1,0,0) renderStyles :: Bool -> Style v -> S.Attribute renderStyles ignoreFill s = mconcat . map ($ s) $@@ -135,7 +142,7 @@ , renderFontFamily , renderMiterLimit ]- + renderMiterLimit :: Style v -> S.Attribute renderMiterLimit s = renderAttr A.strokeMiterlimit miterLimit where miterLimit = getLineMiterLimit <$> getAttr s