diff --git a/CHANGES.markdown b/CHANGES.markdown --- a/CHANGES.markdown +++ b/CHANGES.markdown @@ -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) ------------------------- diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,8 +1,12 @@ Copyright 2011-2013 diagrams-svg team: + Daniel Bergey + Jan Bracker + Daniil Frumin Deepak Jois Felipe Lessa Chris Mears + Jeffrey Rosenbluth Michael Sloan Michael Thompson Ryan Yates diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/diagrams-svg.cabal b/diagrams-svg.cabal --- a/diagrams-svg.cabal +++ b/diagrams-svg.cabal @@ -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 diff --git a/src/Diagrams/Backend/SVG.hs b/src/Diagrams/Backend/SVG.hs --- a/src/Diagrams/Backend/SVG.hs +++ b/src/Diagrams/Backend/SVG.hs @@ -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 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 diff --git a/src/Diagrams/Backend/SVG/CmdLine.hs b/src/Diagrams/Backend/SVG/CmdLine.hs --- a/src/Diagrams/Backend/SVG/CmdLine.hs +++ b/src/Diagrams/Backend/SVG/CmdLine.hs @@ -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 +-- . +-- ----------------------------------------------------------------------------- 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 diff --git a/src/Graphics/Rendering/SVG.hs b/src/Graphics/Rendering/SVG.hs --- a/src/Graphics/Rendering/SVG.hs +++ b/src/Graphics/Rendering/SVG.hs @@ -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