diff --git a/CHANGES.markdown b/CHANGES.markdown --- a/CHANGES.markdown +++ b/CHANGES.markdown @@ -1,3 +1,28 @@ +1.0.2 (8 March 2014) +-------------------- + +* **New features** + + - Support for including hyperlinks. + +* **Dependency/version changes** + + - Allow `diagrams-core-1.1` and `diagrams-lib-1.1` + - Allow `lens-4.0` + +* **Bug fixes** + + + - Use `splitFills` to properly render certain diagrams with mixed + lines and filled loops. Previously, in certain situations loops that should + have been filled were not. ([#43](https://github.com/diagrams/diagrams-svg/issues/43)) + + - Don't emit last segment of a loop if it is linear. + + See [diagrams-cairo#38](http://github.com/diagrams/diagrams-cairo/issues/38). This wasn't actually causing any + observable problems in the SVG backend output, but this seems a + better/more robust way to do things in any case. + 1.0.1.3 (6 February 2014) ------------------------- diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright 2011-2013 diagrams-svg team: +Copyright 2011-2014 diagrams-svg team: Daniel Bergey Jan Bracker 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.0.1.3 +Version: 1.0.2 Synopsis: SVG backend for diagrams drawing EDSL. Homepage: http://projects.haskell.org/diagrams/ License: BSD3 @@ -12,7 +12,7 @@ Category: Graphics Build-type: Simple Cabal-version: >=1.10 -Tested-with: GHC == 7.4.2, GHC == 7.6.1 +Tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.1 Description: This package provides a modular backend for rendering diagrams created with the diagrams EDSL to SVG files. It uses @blaze-svg@ to be a fast, native @@ -49,15 +49,15 @@ , bytestring >= 0.9 && < 1.0 , vector-space >= 0.7 && < 0.9 , colour - , diagrams-core >= 1.0 && < 1.1 - , diagrams-lib >= 1.0.1 && < 1.1 + , diagrams-core >= 1.1 && < 1.2 + , diagrams-lib >= 1.1 && < 1.2 , monoid-extras >= 0.3 && < 0.4 , blaze-svg >= 0.3.3 , blaze-markup >= 0.5 && < 0.7 , split >= 0.1.2 && < 0.3 , time , containers >= 0.3 && < 0.6 - , lens >= 3.8 && < 4 + , lens >= 3.8 && < 4.1 , hashable >= 1.1 && < 1.3 if impl(ghc < 7.6) build-depends: ghc-prim 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 @@ -86,10 +86,10 @@ , renderSVG ) where + -- for testing import Data.Foldable (foldMap) import Data.Tree -import Diagrams.Core.Compile -- from base import Control.Monad.State @@ -105,6 +105,10 @@ -- from lens import Control.Lens hiding (transform, ( # )) +-- from diagrams-core +import Diagrams.Core.Compile +import Diagrams.Core.Types (Annotation (..)) + -- from diagrams-lib import Diagrams.Prelude hiding (view) import Diagrams.TwoD.Adjust (adjustDia2D) @@ -117,6 +121,7 @@ import Text.Blaze.Svg.Renderer.Utf8 (renderSvg) import Text.Blaze.Svg11 ((!)) import qualified Text.Blaze.Svg11 as S +import Text.Blaze.Svg11.Attributes (xlinkHref) -- from this package import qualified Graphics.Rendering.SVG as R @@ -128,12 +133,12 @@ type B = SVG -data SvgRenderState = SvgRenderState { _clipPathId :: Int, _ignoreFill :: Bool } +data SvgRenderState = SvgRenderState { _clipPathId :: Int } makeLenses ''SvgRenderState initialSvgRenderState :: SvgRenderState -initialSvgRenderState = SvgRenderState 0 False +initialSvgRenderState = SvgRenderState 0 -- | Monad to keep track of state when rendering an SVG. -- Currently just keeps a monotonically increasing counter @@ -168,16 +173,19 @@ -- 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 :: RTree SVG R2 Annotation -> Render SVG R2 +renderRTree (Node (RAnnot (Href uri)) ts) + = R $ do + let R r = foldMap renderRTree ts + svg <- r + return $ (S.a ! xlinkHref (S.toValue uri)) svg 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 + return $ (S.g ! R.renderStyles sty) clippedSvg renderRTree (Node (RFrozenTr tr) ts) = R $ do let R r = foldMap renderRTree ts @@ -207,14 +215,14 @@ Absolute -> (100,100) return $ R.svgHeader w h (opts^.svgDefinitions) $ svg - adjustDia c opts d = adjustDia2D _size setSvgSize c opts - (d # reflectY - # recommendFillColor - (transparent :: AlphaColour Double) - ) + adjustDia c opts d = adjustDia2D _size setSvgSize c opts (d # reflectY) where setSvgSize sz o = o { _size = sz } - renderData _ = renderRTree . toRTree + renderData _ = renderRTree + . Node (RStyle (mempty # recommendFillColor (transparent :: AlphaColour Double))) + . (:[]) + . splitFills + . toRTree getSize :: Options SVG R2 -> SizeSpec2D getSize (SVGOptions {_size = s}) = s @@ -301,11 +309,7 @@ render c = render c . pathFromTrail instance Renderable (Path R2) SVG where - 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) . op Path $ p) $ (ignoreFill .= True) - return (R.renderPath p) + render _ = R . return . R.renderPath instance Renderable Text SVG where render _ = R . return . R.renderText 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 @@ -63,11 +63,18 @@ makePath = mkPath $ mapM_ renderTrail (op Path trs) renderTrail :: Located (Trail R2) -> S.Path -renderTrail (viewLoc -> (unp2 -> (x,y), t)) = flip withLine t $ \l -> do - m x y - mapM_ renderSeg (lineSegments l) - if isLoop t then z else return () +renderTrail (viewLoc -> (unp2 -> (x,y), t)) = m x y >> withTrail renderLine renderLoop t + where + renderLine = mapM_ renderSeg . lineSegments + renderLoop lp = do + case loopSegments lp of + -- let 'z' handle the last segment if it is linear + (segs, Linear _) -> mapM_ renderSeg segs + -- otherwise we have to emit it explicitly + _ -> mapM_ renderSeg (lineSegments . cutLoop $ lp) + z + renderSeg :: Segment Closed R2 -> S.Path renderSeg (Linear (OffsetClosed (unr2 -> (x,0)))) = hr x renderSeg (Linear (OffsetClosed (unr2 -> (0,y)))) = vr y @@ -124,12 +131,10 @@ 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) $ +renderStyles :: Style v -> S.Attribute +renderStyles s = mconcat . map ($ s) $ [ renderLineColor - , if ignoreFill - then const (renderAttr A.fillOpacity (Just (0 :: Double))) - else renderFillColor + , renderFillColor , renderLineWidth , renderLineCap , renderLineJoin