diagrams-svg 1.3 → 1.3.1
raw patch · 4 files changed
+55/−34 lines, 4 files
Files
- CHANGELOG.md +10/−0
- diagrams-svg.cabal +1/−1
- src/Diagrams/Backend/SVG.hs +38/−31
- src/Graphics/Rendering/SVG.hs +6/−2
CHANGELOG.md view
@@ -1,5 +1,15 @@ # Change Log +## [v1.3.1]() (2015-04-30)++**API Changes**++ - Type of `SVGOptions` changed. `_svgDefinitions :: Maybe SvgM`++**Internal Changes**++ - Use `ReaderT` for styles+ ## [v1.3](https://github.com/diagrams/diagrams-svg/tree/v1.3) (2015-04-19) [Full Changelog](https://github.com/diagrams/diagrams-svg/compare/v1.1.0.4...v1.1.0.5)
diagrams-svg.cabal view
@@ -1,5 +1,5 @@ Name: diagrams-svg-Version: 1.3+Version: 1.3.1 Synopsis: SVG backend for diagrams drawing EDSL. Homepage: http://projects.haskell.org/diagrams/ License: BSD3
src/Diagrams/Backend/SVG.hs view
@@ -58,7 +58,7 @@ -- -- > data Options SVG V2 n = SVGOptions -- > { _size :: SizeSpec V2 n -- ^ The requested size.--- > , _svgDefinitions :: [Attribute]+-- > , _svgDefinitions :: Maybe SvgM -- > -- ^ Custom definitions that will be added to the @defs@ -- > -- section of the output. -- > , _idPrefix :: T.Text@@ -79,7 +79,7 @@ -- @ -- -- which you could call like @renderDia SVG (SVGOptions (mkWidth 250)--- [] "") myDiagram@ (if you have the 'OverloadedStrings' extension+-- Nothing "") myDiagram@ (if you have the 'OverloadedStrings' extension -- enabled; otherwise you can use 'Text.pack ""'). (In some -- situations GHC may not be able to infer the type @m@, in which case -- you can use a type annotation to specify it; it may be useful to@@ -116,12 +116,13 @@ import System.FilePath -- from base+import Control.Monad.Reader import Control.Monad.State import Data.Char import Data.Typeable -- from hashable-import Data.Hashable (Hashable (..))+import Data.Hashable (Hashable (), hashWithSalt) -- from bytestring import qualified Data.ByteString as SBS@@ -135,7 +136,7 @@ import Diagrams.Core.Types (Annotation (..)) -- from diagrams-lib-import Diagrams.Prelude hiding (Attribute, size, view)+import Diagrams.Prelude hiding (Attribute, size, view, local) import Diagrams.TwoD.Adjust (adjustDia2D) import Diagrams.TwoD.Attributes (splitTextureFills) import Diagrams.TwoD.Path (Clip (Clip))@@ -158,25 +159,35 @@ type instance V SVG = V2 type instance N SVG = Double -data SvgRenderState n = SvgRenderState+data Environment n = Environment+ { _style :: Style V2 n+ , __pre :: T.Text+ }++makeLenses ''Environment++data SvgRenderState = SvgRenderState { _clipPathId :: Int , _fillGradId :: Int , _lineGradId :: Int- , _style :: Style V2 n- , __pre :: T.Text } makeLenses ''SvgRenderState +initialEnvironment :: SVGFloat n => T.Text -> Environment n+initialEnvironment = Environment (mempty # recommendFillColor transparent)+ -- Fill gradients ids are even, line gradient ids are odd.-initialSvgRenderState :: SVGFloat n => T.Text -> SvgRenderState n-initialSvgRenderState = SvgRenderState 0 0 1 (mempty # recommendFillColor transparent)+initialSvgRenderState :: SvgRenderState+initialSvgRenderState = SvgRenderState 0 0 1 --- | Monad to keep track of state when rendering an SVG.--- Currently just keeps a monotonically increasing counter--- for assiging a unique clip path ID.-type SvgRenderM n = State (SvgRenderState n) SvgM+-- | Monad to keep track of environment and state when rendering an SVG.+type SvgRenderM n = ReaderT (Environment n) (State SvgRenderState) SvgM +runRenderM :: SVGFloat n => T.Text -> SvgRenderM n -> SvgM+runRenderM o s = flip evalState initialSvgRenderState+ $ runReaderT s (initialEnvironment o)+ instance SVGFloat n => Monoid (Render SVG V2 n) where mempty = R $ return mempty R r1 `mappend` R r2_ = R $ do@@ -190,7 +201,7 @@ => T.Text -> SvgM -- ^ Input SVG -> Style V2 n -- ^ Styles- -> SvgRenderM n -- ^ Resulting svg+ -> SvgRenderM n -- ^ Resulting svg renderSvgWithClipping prefix svg s = case op Clip <$> getAttr s of@@ -219,17 +230,17 @@ return $ R.renderLineTextureDefs ident s instance SVGFloat n => Backend SVG V2 n where- data Render SVG V2 n = R (SvgRenderM n)- type Result SVG V2 n = SvgM- data Options SVG V2 n = SVGOptions+ newtype Render SVG V2 n = R (SvgRenderM n)+ type Result SVG V2 n = SvgM+ data Options SVG V2 n = SVGOptions { _size :: SizeSpec V2 n -- ^ The requested size.- , _svgDefinitions :: [Attribute]+ , _svgDefinitions :: Maybe SvgM -- ^ Custom definitions that will be added to the @defs@ -- section of the output. , _idPrefix :: T.Text } - renderRTree _ opts rt = evalState svgOutput (initialSvgRenderState $ opts ^.idPrefix)+ renderRTree _ opts rt = runRenderM (opts ^.idPrefix) svgOutput where svgOutput = do let R r = rtree (splitTextureFills rt)@@ -242,11 +253,7 @@ rtree :: SVGFloat n => RTree SVG V2 n Annotation -> Render SVG V2 n rtree (Node n rs) = case n of RPrim p -> render SVG p- RStyle sty' -> R $ do- -- mappend new state and retrieve old state- sty <- style <<<>= sty'- -- render contents and return state to old state- r <* (style .= sty)+ RStyle sty -> R $ local (over style (<> sty)) r RAnnot (OpacityGroup o) -> R $ g_ [opacity_ $ toText o] <$> r RAnnot (Href uri) -> R $ a_ [xlinkHref_ $ toText uri] <$> r _ -> R r@@ -258,7 +265,7 @@ sizeSpec f opts = f (_size opts) <&> \s -> opts { _size = s } -- | Lens onto the svg definitions of the svg options.-svgDefinitions :: SVGFloat n => Lens' (Options SVG V2 n) [Attribute]+svgDefinitions :: SVGFloat n => Lens' (Options SVG V2 n) (Maybe SvgM) svgDefinitions f opts = f (_svgDefinitions opts) <&> \ds -> opts { _svgDefinitions = ds } @@ -272,7 +279,8 @@ attributedRender :: SVGFloat n => SvgM -> SvgRenderM n attributedRender svg = do- SvgRenderState _idClip idFill idLine sty preT <- get+ SvgRenderState _idClip idFill idLine <- get+ Environment sty preT <- ask clippedSvg <- renderSvgWithClipping preT svg sty lineGradDefs <- lineTextureDefs sty fillGradDefs <- fillTextureDefs sty@@ -289,16 +297,14 @@ instance SVGFloat n => Renderable (DImage n Embedded) SVG where render _ = R . return . R.renderDImageEmb --- TODO: instance Renderable Image SVG where- -- | Render a diagram as an SVG, writing to the specified output file -- and using the requested size. renderSVG :: SVGFloat n => FilePath -> SizeSpec V2 n -> QDiagram SVG V2 n Any -> IO ()-renderSVG outFile spec = renderSVG' outFile (SVGOptions spec [] (mkPrefix outFile))+renderSVG outFile spec = renderSVG' outFile (SVGOptions spec Nothing (mkPrefix outFile)) -- | Render a diagram as a pretty printed SVG. renderPretty :: SVGFloat n => FilePath -> SizeSpec V2 n -> QDiagram SVG V2 n Any -> IO ()-renderPretty outFile spec = renderPretty' outFile (SVGOptions spec [] (mkPrefix outFile))+renderPretty outFile spec = renderPretty' outFile (SVGOptions spec Nothing (mkPrefix outFile)) -- Create a prefile using the basename of the output file. Only standard -- letters are considered.@@ -349,4 +355,5 @@ return $ R.renderDImage di $ R.dataUri mime d instance (Hashable n, SVGFloat n) => Hashable (Options SVG V2 n) where- hashWithSalt s (SVGOptions sz defs _) = s `hashWithSalt` sz `hashWithSalt` defs+ hashWithSalt s (SVGOptions sz defs _) = s `hashWithSalt` sz `hashWithSalt` ds+ where ds = fmap renderBS defs
src/Graphics/Rendering/SVG.hs view
@@ -42,6 +42,8 @@ #if __GLASGOW_HASKELL__ < 710 import Data.Foldable (foldMap) #endif++import Data.Maybe (fromMaybe) import Data.Monoid -- from diagrams-core@@ -84,14 +86,16 @@ -- | @svgHeader w h defs s@: @w@ width, @h@ height, -- @defs@ global definitions for defs sections, @s@ actual SVG content.-svgHeader :: SVGFloat n => n -> n -> [Attribute] -> SvgM -> SvgM-svgHeader w h defines s = doctype_ <> with (svg11_ (g_ defines s))+svgHeader :: SVGFloat n => n -> n -> Maybe SvgM -> SvgM -> SvgM+svgHeader w h defines s = doctype_ <> with (svg11_ (defs_ ds <> s)) [ width_ (toText w) , height_ (toText h) , font_size_ "1" , viewBox_ (pack . unwords $ map show ([0, 0, round w, round h] :: [Int])) , stroke_ "rgb(0,0,0)" , stroke_opacity_ "1" ]+ where+ ds = fromMaybe mempty defines renderPath :: SVGFloat n => Path V2 n -> SvgM renderPath trs = if makePath == T.empty then mempty else path_ [d_ makePath]