diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,7 +1,3 @@ -## [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` 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: 1.3.1.8 +Version: 1.3.1.9 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.6 && < 0.7 + , lucid-svg >= 0.5 && < 0.7 , text >= 0.11 && < 1.3 , JuicyPixels >= 3.1.5 && < 3.3 , split >= 0.1.2 && < 0.3 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 @@ -6,9 +6,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE NondecreasingIndentation #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -95,8 +93,7 @@ module Diagrams.Backend.SVG ( SVG(..) -- rendering token , B - -- for rendering options specific to SVG - , Options(..), sizeSpec, svgDefinitions, idPrefix, svgAttributes, generateDoctype + , Options(..), sizeSpec, svgDefinitions, idPrefix -- for rendering options specific to SVG , SVGFloat , renderSVG @@ -236,26 +233,20 @@ 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 - , _svgAttributes :: [Attribute] - -- ^ Attriubtes to apply to the entire svg element. - , _generateDoctype :: Bool + , _idPrefix :: T.Text } - 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) - (opts^.svgAttributes) - (opts^.generateDoctype) svg + return $ R.svgHeader w h (opts^.svgDefinitions) svg adjustDia c opts d = adjustDia2D sizeSpec c opts (d # reflectY) @@ -284,18 +275,6 @@ 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 @@ -306,9 +285,7 @@ lineGradDefs <- lineTextureDefs sty fillGradDefs <- fillTextureDefs sty return $ do - let gDefs = fillGradDefs >> lineGradDefs - defs <- gDefs - unless (defs == mempty) (defs_ gDefs) + defs_ $ fillGradDefs >> lineGradDefs g_ (R.renderStyles idFill idLine sty) clippedSvg instance SVGFloat n => Renderable (Path V2 n) SVG where @@ -323,11 +300,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) [] True) +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 Nothing (mkPrefix outFile)[] True) +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. @@ -357,11 +334,11 @@ let pic t d = return $ image (DImage (ImageNative (Img t d)) (dynamicMap imageWidth dyn) (dynamicMap imageHeight dyn) mempty) - 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) + 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) where pngHeader :: SBS.ByteString pngHeader = SBS.pack [137, 80, 78, 71, 13, 10, 26, 10] jpgHeader :: SBS.ByteString @@ -378,11 +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 ia sa gd) = - s `hashWithSalt` - sz `hashWithSalt` - ds `hashWithSalt` - ia `hashWithSalt` - sa `hashWithSalt` - gd - where ds = fmap renderBS defs + hashWithSalt s (SVGOptions sz defs _) = s `hashWithSalt` sz `hashWithSalt` ds + where ds = fmap renderBS defs 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 @@ -170,8 +170,8 @@ ps | last ps `elem` ["svg"] -> do let szSpec = fromIntegral <$> mkSizeSpec2D (opts^.width) (opts^.height) if isPretty pretty - then renderPretty (opts^.output) szSpec d - else renderSVG (opts^.output) szSpec d + then renderSVG (opts^.output) szSpec d + else renderPretty (opts^.output) szSpec d | otherwise -> putStrLn $ "Unknown file type: " ++ last ps -- | @multiMain@ is like 'defaultMain', except instead of a single 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 @@ -90,18 +90,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 -> 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 ) +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 - 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]