diagrams-svg 1.3.1.7 → 1.3.1.8
raw patch · 5 files changed
+62/−27 lines, 5 filesdep ~lucid-svg
Dependency ranges changed: lucid-svg
Files
- CHANGELOG.md +4/−0
- diagrams-svg.cabal +2/−2
- src/Diagrams/Backend/SVG.hs +44/−15
- src/Diagrams/Backend/SVG/CmdLine.hs +2/−2
- src/Graphics/Rendering/SVG.hs +10/−8
CHANGELOG.md view
@@ -1,3 +1,7 @@+## [v1.3.1.8](https://github.com/diagrams/diagrams-svg/tree/v1.3.1.8) (2015-11-14)++- allow `lucid-svg-0.6`+ ## [v1.3.1.7](https://github.com/diagrams/diagrams-svg/tree/v1.3.1.7) (2015-11-10) - allow `semigroups-0.18`
diagrams-svg.cabal view
@@ -1,5 +1,5 @@ Name: diagrams-svg-Version: 1.3.1.7+Version: 1.3.1.8 Synopsis: SVG backend for diagrams drawing EDSL. Homepage: http://projects.haskell.org/diagrams/ License: BSD3@@ -53,7 +53,7 @@ , diagrams-core >= 1.3 && < 1.4 , diagrams-lib >= 1.3 && < 1.4 , monoid-extras >= 0.3 && < 0.5- , lucid-svg >= 0.5 && < 0.6+ , lucid-svg >= 0.6 && < 0.7 , text >= 0.11 && < 1.3 , JuicyPixels >= 3.1.5 && < 3.3 , split >= 0.1.2 && < 0.3
src/Diagrams/Backend/SVG.hs view
@@ -6,7 +6,9 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NondecreasingIndentation #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -93,7 +95,8 @@ module Diagrams.Backend.SVG ( SVG(..) -- rendering token , B- , Options(..), sizeSpec, svgDefinitions, idPrefix -- for rendering options specific to SVG+ -- for rendering options specific to SVG+ , Options(..), sizeSpec, svgDefinitions, idPrefix, svgAttributes, generateDoctype , SVGFloat , renderSVG@@ -233,20 +236,26 @@ 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 :: Maybe SvgM+ { _size :: SizeSpec V2 n -- ^ The requested size.+ , _svgDefinitions :: Maybe SvgM -- ^ Custom definitions that will be added to the @defs@ -- section of the output.- , _idPrefix :: T.Text+ , _idPrefix :: T.Text+ , _svgAttributes :: [Attribute]+ -- ^ Attriubtes to apply to the entire svg element.+ , _generateDoctype :: Bool } + renderRTree :: SVG -> Options SVG V2 n -> RTree SVG V2 n Annotation -> Result SVG V2 n renderRTree _ opts rt = runRenderM (opts ^.idPrefix) svgOutput where svgOutput = do let R r = rtree (splitTextureFills rt) V2 w h = specToSize 100 (opts^.sizeSpec) svg <- r- return $ R.svgHeader w h (opts^.svgDefinitions) svg+ return $ R.svgHeader w h (opts^.svgDefinitions)+ (opts^.svgAttributes)+ (opts^.generateDoctype) svg adjustDia c opts d = adjustDia2D sizeSpec c opts (d # reflectY) @@ -275,6 +284,18 @@ idPrefix :: SVGFloat n => Lens' (Options SVG V2 n) T.Text idPrefix f opts = f (_idPrefix opts) <&> \i -> opts { _idPrefix = i } +-- | Lens onto the svgAttributes field of the svg options. This field+-- is provided to supply SVG attributes to the entire diagram.+svgAttributes :: SVGFloat n => Lens' (Options SVG V2 n) [Attribute]+svgAttributes f opts =+ f (_svgAttributes opts) <&> \ds -> opts { _svgAttributes = ds }++-- | Lens onto the generateDoctype field of the svg options. Set+-- to False if you don't want a doctype tag included in the output.+generateDoctype :: SVGFloat n => Lens' (Options SVG V2 n) Bool+generateDoctype f opts =+ f (_generateDoctype opts) <&> \ds -> opts { _generateDoctype = ds }+ -- paths --------------------------------------------------------------- attributedRender :: SVGFloat n => SvgM -> SvgRenderM n@@ -285,7 +306,9 @@ lineGradDefs <- lineTextureDefs sty fillGradDefs <- fillTextureDefs sty return $ do- defs_ $ fillGradDefs >> lineGradDefs+ let gDefs = fillGradDefs >> lineGradDefs+ defs <- gDefs+ unless (defs == mempty) (defs_ gDefs) g_ (R.renderStyles idFill idLine sty) clippedSvg instance SVGFloat n => Renderable (Path V2 n) SVG where@@ -300,11 +323,11 @@ -- | 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 Nothing (mkPrefix outFile))+renderSVG outFile spec = renderSVG' outFile (SVGOptions spec Nothing (mkPrefix outFile) [] True) -- | 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 Nothing (mkPrefix outFile))+renderPretty outFile spec = renderPretty' outFile (SVGOptions spec Nothing (mkPrefix outFile)[] True) -- Create a prefile using the basename of the output file. Only standard -- letters are considered.@@ -334,11 +357,11 @@ let pic t d = return $ image (DImage (ImageNative (Img t d)) (dynamicMap imageWidth dyn) (dynamicMap imageHeight dyn) mempty)- if pngHeader `SBS.isPrefixOf` raw then pic 'P' dat else do- if jpgHeader `SBS.isPrefixOf` raw then pic 'J' dat else do- case dyn of- (ImageYCbCr8 _) -> pic 'J' dat- _ -> pic 'P' =<< eIO (encodeDynamicPng dyn)+ if | pngHeader `SBS.isPrefixOf` raw -> pic 'P' dat+ | jpgHeader `SBS.isPrefixOf` raw -> pic 'J' dat+ | otherwise -> case dyn of+ (ImageYCbCr8 _) -> pic 'J' dat+ _ -> pic 'P' =<< eIO (encodeDynamicPng dyn) where pngHeader :: SBS.ByteString pngHeader = SBS.pack [137, 80, 78, 71, 13, 10, 26, 10] jpgHeader :: SBS.ByteString@@ -355,5 +378,11 @@ 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` ds- where ds = fmap renderBS defs+ hashWithSalt s (SVGOptions sz defs ia sa gd) =+ s `hashWithSalt`+ sz `hashWithSalt`+ ds `hashWithSalt`+ ia `hashWithSalt`+ sa `hashWithSalt`+ gd+ where ds = fmap renderBS defs
src/Diagrams/Backend/SVG/CmdLine.hs view
@@ -170,8 +170,8 @@ ps | last ps `elem` ["svg"] -> do let szSpec = fromIntegral <$> mkSizeSpec2D (opts^.width) (opts^.height) if isPretty pretty- then renderSVG (opts^.output) szSpec d- else renderPretty (opts^.output) szSpec d+ then renderPretty (opts^.output) szSpec d+ else renderSVG (opts^.output) szSpec d | otherwise -> putStrLn $ "Unknown file type: " ++ last ps -- | @multiMain@ is like 'defaultMain', except instead of a single
src/Graphics/Rendering/SVG.hs view
@@ -90,16 +90,18 @@ -- | @svgHeader w h defs s@: @w@ width, @h@ height, -- @defs@ global definitions for defs sections, @s@ actual SVG content.-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" ]+svgHeader :: SVGFloat n => n -> n -> Maybe SvgM -> [Attribute] -> Bool -> SvgM -> SvgM+svgHeader w h defines attributes genDoctype s = dt <> 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" ]+ ++ attributes ) where ds = fromMaybe mempty defines+ dt = if genDoctype then doctype_ else mempty renderPath :: SVGFloat n => Path V2 n -> SvgM renderPath trs = if makePath == T.empty then mempty else path_ [d_ makePath]