diagrams-svg 0.6.0.1 → 0.7
raw patch · 7 files changed
+251/−93 lines, 7 filesdep ~basedep ~diagrams-coredep ~diagrams-libPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base, diagrams-core, diagrams-lib, monoid-extras, unix
API changes (from Hackage documentation)
- Diagrams.Backend.SVG: instance Renderable (Segment R2) SVG
+ Diagrams.Backend.SVG: instance Renderable (Segment Closed R2) SVG
+ Diagrams.Backend.SVG: instance Show (Options SVG R2)
+ Diagrams.Backend.SVG: renderSVG :: FilePath -> SizeSpec2D -> Diagram SVG R2 -> IO ()
+ Diagrams.Backend.SVG.CmdLine: data SVG
Files
- CHANGES.markdown +16/−0
- LICENSE +2/−1
- README.md +1/−1
- diagrams-svg.cabal +25/−14
- src/Diagrams/Backend/SVG.hs +137/−49
- src/Diagrams/Backend/SVG/CmdLine.hs +22/−1
- src/Graphics/Rendering/SVG.hs +48/−27
CHANGES.markdown view
@@ -1,3 +1,19 @@+0.7: 9 August 2013+------------------++* **New features**++ - New `renderToSVG` convenience function+ - Vastly improved Haddock documentation++* **New instances**++ - `Show` instance for `Options SVG R2`++* **Dependency/version changes**+ - allow `base-4.7` and `unix-2.7`+ - Upgrade to `monoid-extras-0.3`+ 0.6.0.1: 14 December 2012 -------------------------
LICENSE view
@@ -1,8 +1,9 @@-Copyright 2011-2012 diagrams-svg team:+Copyright 2011-2013 diagrams-svg team: Deepak Jois <deepak.jois@gmail.com> Felipe Lessa <felipe.lessa@gmail.com> Chris Mears <chris@cmears.id.au>+ Michael Sloan <mgsloan@gmail.com> Michael Thompson <what_is_it_to_do_anything@yahoo.com> Ryan Yates <fryguybob@gmail.com> Brent Yorgey <byorgey@cis.upenn.edu>
README.md view
@@ -11,7 +11,7 @@ yet. However, it is functional enough that [hs-logo] uses it. Check out the [issues page][issues] to get an idea of the features that are missing. -[issues]: https://github.com/deepakjois/diagrams-svg/issues+[issues]: https://github.com/diagrams/diagrams-svg/issues [hs-logo]: http://github.com/deepakjois/hs-logo # Installation
diagrams-svg.cabal view
@@ -1,5 +1,5 @@ Name: diagrams-svg-Version: 0.6.0.1+Version: 0.7 Synopsis: SVG backend for diagrams drawing EDSL. Homepage: http://projects.haskell.org/diagrams/ License: BSD3@@ -12,14 +12,25 @@ Category: Graphics Build-type: Simple Cabal-version: >=1.10-Tested-with: GHC == 7.0.4, GHC == 7.2.1, GHC == 7.4.2, GHC == 7.6.1-Description:- This package provides a modular backend for rendering diagrams- created with the diagrams EDSL using SVG. It uses- @blaze-svg@ to be a fast, pure-Haskell backend.- .- More documentation: Github README : <https://github.com/diagrams/diagrams-svg/blob/master/README.md>-+Tested-with: GHC == 7.4.2, GHC == 7.6.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+ Haskell backend, making it suitable for use on+ any platform.+ .+ The package provides the following modules:+ .+ * "Diagrams.Backend.SVG.CmdLine" - if you're+ just getting started with diagrams, begin here.+ .+ * "Diagrams.Backend.SVG" - look at this next.+ The general API for the SVG backend.+ .+ Additional documentation can be found in the+ README file distributed with the source tarball or+ viewable on GitHub:+ <https://github.com/diagrams/diagrams-svg/blob/master/README.md>. Source-repository head type: git location: http://github.com/diagrams/diagrams-svg@@ -29,7 +40,7 @@ Diagrams.Backend.SVG.CmdLine Other-modules: Graphics.Rendering.SVG Hs-source-dirs: src- Build-depends: base >= 4.3 && < 4.7+ Build-depends: base >= 4.3 && < 4.8 , old-time , process , directory@@ -38,16 +49,16 @@ , bytestring >= 0.9 && < 1.0 , vector-space >= 0.7 && < 0.9 , colour- , diagrams-core >= 0.6 && < 0.7- , diagrams-lib >= 0.6 && < 0.7- , monoid-extras >= 0.2 && < 0.3+ , diagrams-core >= 0.7 && < 0.8+ , diagrams-lib >= 0.7 && < 0.8+ , monoid-extras >= 0.3 && < 0.4 , blaze-svg >= 0.3.3 , cmdargs >= 0.6 && < 0.11 , split >= 0.1.2 && < 0.3 , time if !os(windows) cpp-options: -DCMDLINELOOP- Build-depends: unix >= 2.4 && < 2.7+ Build-depends: unix >= 2.4 && < 2.8 Ghc-options: -Wall
src/Diagrams/Backend/SVG.hs view
@@ -1,55 +1,127 @@-{-# LANGUAGE TypeFamilies- , MultiParamTypeClasses- , FlexibleInstances- , FlexibleContexts- , TypeSynonymInstances- , DeriveDataTypeable- #-}-{-|- The SVG backend.--}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-}++-----------------------------------------------------------------------------+-- |+-- Module : Diagrams.Backend.SVG+-- Copyright : (c) 2011-2012 diagrams-svg team (see LICENSE)+-- License : BSD-style (see LICENSE)+-- Maintainer : diagrams-discuss@googlegroups.com+--+-- A full-featured rendering backend for diagrams producing SVG files,+-- implemented natively in Haskell (making it easy to use on any+-- platform).+--+-- To invoke the SVG backend, you have three options.+--+-- * You can use the "Diagrams.Backend.SVG.CmdLine" module to create+-- standalone executables which output SVG images when invoked.+--+-- * You can use the 'renderSVG' function provided by this module,+-- which gives you more flexible programmatic control over when and+-- how images are output (making it easy to, for example, write a+-- single program that outputs multiple images, or one that outputs+-- images dynamically based on user input, and so on).+--+-- * For the most flexibility (/e.g./ if you want access to the+-- resulting SVG value directly in memory without writing it to+-- disk), you can manually invoke the 'renderDia' method from the+-- 'Diagrams.Core.Types.Backend' instance for @SVG@. In particular,+-- 'Diagrams.Core.Types.renderDia' has the generic type+--+-- > renderDia :: b -> Options b v -> QDiagram b v m -> Result b v+--+-- (omitting a few type class constraints). @b@ represents the+-- backend type, @v@ the vector space, and @m@ the type of monoidal+-- query annotations on the diagram. 'Options' and 'Result' are+-- associated data and type families, respectively, which yield the+-- type of option records and rendering results specific to any+-- particular backend. For @b ~ SVG@ and @v ~ R2@, we have+--+-- > data Options SVG R2 = SVGOptions+-- > { size :: SizeSpec2D -- ^ The requested size.+-- > }+--+-- @+-- data family Render SVG R2 = R 'SvgRenderM'+-- @+--+-- @+-- type family Result SVG R2 = 'Text.Blaze.Svg11.Svg'+-- @+--+-- So the type of 'renderDia' resolves to+--+-- @+-- renderDia :: SVG -> Options SVG R2 -> QDiagram SVG R2 m -> 'Text.Blaze.Svg11.Svg'+-- @+--+-- which you could call like @renderDia SVG (SVGOptions (Width 250))+-- myDiagram@. (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 simply use the type synonym @Diagram SVG+-- R2 = QDiagram SVG R2 Any@.) This returns an+-- 'Text.Blaze.Svg11.Svg' value, which you can, /e.g./ render to a+-- 'ByteString' using 'Text.Blaze.Svg.Renderer.Utf8.renderSvg'.+--+-----------------------------------------------------------------------------+ module Diagrams.Backend.SVG ( SVG(..) -- rendering token , Options(..) -- for rendering options specific to SVG++ , renderSVG ) where -- from base-import Data.Typeable-import Control.Monad.State+import Control.Monad.State+import Data.Typeable +-- from bytestring+import qualified Data.ByteString.Lazy as BS+ -- from diagrams-lib-import Diagrams.Prelude-import Diagrams.TwoD.Path (getClip)-import Diagrams.TwoD.Adjust (adjustDia2D)-import Diagrams.TwoD.Text+import Diagrams.Prelude+import Diagrams.TwoD.Adjust (adjustDia2D)+import Diagrams.TwoD.Path (getClip)+import Diagrams.TwoD.Text -- from monoid-extras-import Data.Monoid.Split (Split(..))+import Data.Monoid.Split (Split (..)) -- from blaze-svg-import qualified Text.Blaze.Svg11 as S-import Text.Blaze.Svg11 ((!))+import Text.Blaze.Svg.Renderer.Utf8 (renderSvg)+import Text.Blaze.Svg11 ((!))+import qualified Text.Blaze.Svg11 as S -- from this package-import qualified Graphics.Rendering.SVG as R+import qualified Graphics.Rendering.SVG as R +-- | @SVG@ is simply a token used to identify this rendering backend+-- (to aid type inference). data SVG = SVG deriving (Show, Typeable) --data SvgRenderState = SvgRenderState { clipPathId :: Int }+data SvgRenderState = SvgRenderState { clipPathId :: Int, ignoreFill :: Bool } initialSvgRenderState :: SvgRenderState-initialSvgRenderState = SvgRenderState 0+initialSvgRenderState = SvgRenderState 0 False --- Monad to keep track of state when rendering an SVG.--- Currently just keeps a monotonically increasing counter--- for assiging unique clip path ID+-- | 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 = State SvgRenderState S.Svg incrementClipPath :: State SvgRenderState ()-incrementClipPath = modify (\(SvgRenderState x) -> SvgRenderState (x + 1))+incrementClipPath = modify (\st -> st { clipPathId = clipPathId st + 1 }) +setIgnoreFill :: Bool -> State SvgRenderState ()+setIgnoreFill b = modify (\st -> st { ignoreFill = b })+ instance Monoid (Render SVG R2) where mempty = R $ return mempty (R r1) `mappend` (R r2_) =@@ -58,15 +130,15 @@ svg2 <- r2_ return (svg1 `mappend` svg2) --- renders a <g> element with styles applied as attributes.-renderStyledGroup :: Style v -> (S.Svg -> S.Svg)-renderStyledGroup s = S.g ! R.renderStyles s+-- | Renders a <g> element with styles applied as attributes.+renderStyledGroup :: Bool -> Style v -> (S.Svg -> S.Svg)+renderStyledGroup ignFill s = S.g ! R.renderStyles ignFill s -renderSvgWithClipping :: S.Svg -- Input SVG- -> Style v -- Styles- -> Int -- Clip Path ID- -> Transformation R2 -- Freeze transform- -> S.Svg -- Resulting svg+renderSvgWithClipping :: S.Svg -- ^ Input SVG+ -> Style v -- ^ Styles+ -> Int -- ^ Clip Path ID+ -> Transformation R2 -- ^ Freeze transform+ -> S.Svg -- ^ Resulting svg renderSvgWithClipping svg s id_ t = do R.renderClip (transform (inv t) <$> getClip <$> getAttr s) id_ -- Clipping if any svg -- The diagram@@ -77,19 +149,22 @@ data Options SVG R2 = SVGOptions { size :: SizeSpec2D -- ^ The requested size. }+ deriving Show - -- Here the SVG backend is different from the other backends. We- -- give a different definition of renderDia, where only the- -- non-frozen transformation is applied to the primitives before- -- they are passed to render. This means that withStyle is- -- responsible for applying the frozen transformation to the- -- primitives.+ -- | Here the SVG backend is different from the other backends. We+ -- give a different definition of renderDia, where only the+ -- non-frozen transformation is applied to the primitives before+ -- they are passed to render. This means that withStyle is+ -- responsible for applying the frozen transformation to the+ -- primitives. withStyle _ s t (R r) = R $ do incrementClipPath+ setIgnoreFill False clipPathId_ <- gets clipPathId svg <- r- let styledSvg = renderStyledGroup s ! (R.renderClipPathId s clipPathId_) $+ ign <- gets ignoreFill+ let styledSvg = renderStyledGroup ign s ! (R.renderClipPathId s clipPathId_) $ renderSvgWithClipping svg s clipPathId_ t -- This is where the frozen transformation is applied. return (R.renderTransform t styledSvg)@@ -113,9 +188,9 @@ ) where setSvgSize sz o = o { size = sz } - -- This implementation of renderDia is the same as the default one,- -- except that it only applies the non-frozen transformation to the- -- primitives before passing them to render.+ -- | This implementation of renderDia is the same as the default one,+ -- except that it only applies the non-frozen transformation to the+ -- primitives before passing them to render. renderDia SVG opts d = doRender SVG opts' . mconcat . map renderOne . prims $ d' where (opts', d') = adjustDia SVG opts d@@ -129,16 +204,29 @@ -- implementation: "t2" instead of "t1 <> t2". = withStyle SVG s t1 (render SVG (transform t2 p)) -instance Renderable (Segment R2) SVG where- render c = render c . flip Trail False . (:[])+instance Renderable (Segment Closed R2) SVG where+ render c = render c . (fromSegments :: [Segment Closed R2] -> Path R2) . (:[]) instance Renderable (Trail R2) SVG where- render c t = render c $ Path [(p2 (0,0), t)]+ render c = render c . pathFromTrail instance Renderable (Path R2) SVG where- render _ = R . return . R.renderPath+ 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) . pathTrails $ p) $ setIgnoreFill True+ return (R.renderPath p) instance Renderable Text SVG where render _ = R . return . R.renderText -- TODO: instance Renderable Image SVG where+++-- | Render a diagram as an SVG, writing to the specified output file+-- and using the requested size.+renderSVG :: FilePath -> SizeSpec2D -> Diagram SVG R2 -> IO ()+renderSVG outFile sizeSpec+ = BS.writeFile outFile+ . renderSvg+ . renderDia SVG (SVGOptions sizeSpec)
src/Diagrams/Backend/SVG/CmdLine.hs view
@@ -9,11 +9,33 @@ -- Convenient creation of command-line-driven executables for -- rendering diagrams using the SVG backend. --+-- * 'defaultMain' creates an executable which can render a single+-- diagram at various options.+--+-- * 'multiMain' is like 'defaultMain' but allows for a list of+-- diagrams from which the user can choose one to render.+--+-- If you want to generate diagrams programmatically---/i.e./ if you+-- want to do anything more complex than what the below functions+-- provide---you have several options.+--+-- * A simple but somewhat inflexible approach is to wrap up+-- 'defaultMain' (or 'multiMain') in a call to+-- 'System.Environment.withArgs'.+--+-- * You can use 'Diagrams.Backend.SVG.renderSVG' to render a diagram+-- to a file directly; see "Diagrams.Backend.SVG".+--+-- * A more flexible approach is to directly call 'renderDia'; see+-- "Diagrams.Backend.SVG" for more information.+ ----------------------------------------------------------------------------- module Diagrams.Backend.SVG.CmdLine ( defaultMain , multiMain++ , SVG ) where import Diagrams.Prelude hiding (width, height, interval)@@ -23,7 +45,6 @@ import Text.Blaze.Svg.Renderer.Utf8 (renderSvg) import qualified Data.ByteString.Lazy as BS- import Data.Maybe (fromMaybe) import Control.Monad (when)
src/Graphics/Rendering/SVG.hs view
@@ -1,4 +1,21 @@-{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving, ViewPatterns, OverloadedStrings, RankNTypes #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ViewPatterns #-}++-----------------------------------------------------------------------------+-- |+-- Module : Graphics.Rendering.SVG+-- Copyright : (c) 2011 diagrams-svg team (see LICENSE)+-- License : BSD-style (see LICENSE)+-- Maintainer : diagrams-discuss@googlegroups.com+--+-- Generic tools for generating SVG files.+--+-----------------------------------------------------------------------------+ module Graphics.Rendering.SVG ( svgHeader , renderPath@@ -10,15 +27,16 @@ ) where -- from base-import Data.List (intersperse, intercalate)+import Data.List (intercalate, intersperse) -- from diagrams-lib-import Diagrams.Prelude hiding (Render, Attribute, close, e, (<>))-import Diagrams.TwoD.Text-import Diagrams.TwoD.Path (getFillRule, getClip)+import Diagrams.Prelude hiding (Attribute, Render, e, (<>))+import Diagrams.TwoD.Path (getClip, getFillRule)+import Diagrams.TwoD.Text -import Text.Blaze.Svg11 ((!), mkPath, m, cr, hr, vr, lr, z)-import qualified Text.Blaze.Svg11 as S+-- from blaze-svg+import Text.Blaze.Svg11 (cr, hr, lr, m, mkPath, vr, z, (!))+import qualified Text.Blaze.Svg11 as S import qualified Text.Blaze.Svg11.Attributes as A svgHeader :: Double -> Double -> S.Svg -> S.Svg@@ -35,18 +53,20 @@ where makePath = mkPath $ mapM_ renderTrail trs -renderTrail :: (P2, Trail R2) -> S.Path-renderTrail (unp2 -> (x,y), Trail segs closed) = do+renderTrail :: Located (Trail R2) -> S.Path+renderTrail (viewLoc -> (unp2 -> (x,y), t)) = flip withLine t $ \l -> do m x y- mapM_ renderSeg segs- if closed then z else return ()--renderSeg :: Segment R2 -> S.Path-renderSeg (Linear (unr2 -> (x,0))) = hr x-renderSeg (Linear (unr2 -> (0,y))) = vr y-renderSeg (Linear (unr2 -> (x,y))) = lr x y-renderSeg (Cubic (unr2 -> (x0,y0)) (unr2 -> (x1,y1)) (unr2 -> (x2,y2))) = cr x0 y0 x1 y1 x2 y2+ mapM_ renderSeg (lineSegments l)+ if isLoop t then z else return () +renderSeg :: Segment Closed R2 -> S.Path+renderSeg (Linear (OffsetClosed (unr2 -> (x,0)))) = hr x+renderSeg (Linear (OffsetClosed (unr2 -> (0,y)))) = vr y+renderSeg (Linear (OffsetClosed (unr2 -> (x,y)))) = lr x y+renderSeg (Cubic (unr2 -> (x0,y0))+ (unr2 -> (x1,y1))+ (OffsetClosed (unr2 -> (x2,y2))))+ = cr x0 y0 x1 y1 x2 y2 renderClip :: Maybe [Path R2] -> Int -> S.Svg renderClip Nothing _ = mempty@@ -75,15 +95,17 @@ (unr2 -> (b1,b2)) = apply t unitY (unr2 -> (c1,c2)) = transl t --- Apply a transformation to some already-rendered SVG.+-- | Apply a transformation to some already-rendered SVG. renderTransform :: Transformation R2 -> S.Svg -> S.Svg renderTransform t svg = S.g svg ! (A.transform $ S.matrix a1 a2 b1 b2 c1 c2) where (a1,a2,b1,b2,c1,c2) = getMatrix t -renderStyles :: forall v. Style v -> S.Attribute-renderStyles s = mconcat . map ($ s) $+renderStyles :: Bool -> Style v -> S.Attribute+renderStyles ignoreFill s = mconcat . map ($ s) $ [ renderLineColor- , renderFillColor+ , if ignoreFill+ then const (renderAttr A.fillOpacity (Just (0 :: Double)))+ else renderFillColor , renderLineWidth , renderLineCap , renderLineJoin@@ -146,7 +168,7 @@ renderDashing :: Style v -> S.Attribute renderDashing s = (renderAttr A.strokeDasharray arr) `mappend`- (renderAttr A.strokeDashoffset offset)+ (renderAttr A.strokeDashoffset dOffset) where getDasharray (Dashing a _) = a getDashoffset :: Dashing -> Double@@ -154,7 +176,7 @@ dashArrayToStr = intercalate "," . map show dashing_ = getDashing <$> getAttr s arr = (dashArrayToStr . getDasharray) <$> dashing_- offset = getDashoffset <$> dashing_+ dOffset = getDashoffset <$> dashing_ renderFontSize :: Style v -> S.Attribute renderFontSize s = renderAttr A.fontSize fontSize_@@ -191,7 +213,7 @@ Nothing -> Nothing Just _ -> Just ("url(#myClip" ++ show id_ ++ ")") --- Render a style attribute if available, empty otherwise+-- | Render a style attribute if available, empty otherwise. renderAttr :: S.ToValue s => (S.AttributeValue -> S.Attribute) -> Maybe s -> S.Attribute@@ -208,9 +230,8 @@ , ")" ] where int d = show (round (d * 255) :: Int)- (r,g,b,_) = colorToRGBA c+ (r,g,b,_) = colorToSRGBA c colorToOpacity :: forall c . Color c => c -> Double colorToOpacity c = a- where (_,_,_,a) = colorToRGBA c-+ where (_,_,_,a) = colorToSRGBA c