diagrams-svg 1.0.1.3 → 1.0.2
raw patch · 5 files changed
+67/−33 lines, 5 filesdep ~diagrams-coredep ~diagrams-libdep ~lens
Dependency ranges changed: diagrams-core, diagrams-lib, lens
Files
- CHANGES.markdown +25/−0
- LICENSE +1/−1
- diagrams-svg.cabal +5/−5
- src/Diagrams/Backend/SVG.hs +22/−18
- src/Graphics/Rendering/SVG.hs +14/−9
CHANGES.markdown view
@@ -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) -------------------------
LICENSE view
@@ -1,4 +1,4 @@-Copyright 2011-2013 diagrams-svg team:+Copyright 2011-2014 diagrams-svg team: Daniel Bergey <bergey@alum.mit.edu> Jan Bracker <jan.bracker@googlemail.com>
diagrams-svg.cabal view
@@ -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
src/Diagrams/Backend/SVG.hs view
@@ -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
src/Graphics/Rendering/SVG.hs view
@@ -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