diff --git a/CHANGES.markdown b/CHANGES.markdown new file mode 100644 --- /dev/null +++ b/CHANGES.markdown @@ -0,0 +1,11 @@ +0.6: 11 December 2012 +--------------------- + +First "officially supported" release. + +Features still not implemented: + +- text alignment +- inline images + +As of this release everything else Should Work (tm). diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,11 @@ -Copyright Felipe Lessa 2011 +Copyright 2011-2012 diagrams-svg team: + + Deepak Jois + Felipe Lessa + Chris Mears + Michael Thompson + Ryan Yates + Brent Yorgey All rights reserved. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,86 @@ +[![Build Status](https://secure.travis-ci.org/diagrams/diagrams-svg.png)](http://travis-ci.org/diagrams/diagrams-svg) + +_diagrams-svg_ is a an SVG backend for [diagrams]. Diagrams is a powerful, +flexible, declarative domain-specific language for creating vector graphics, +using the [Haskell programming language][haskell]. + +[diagrams]: http://projects.haskell.org/diagrams/ +[haskell]: http://www.haskell.org/haskellwiki/Haskell + +_diagrams-svg_ is a work in progress, and some features are not implemented +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 +[hs-logo]: http://github.com/deepakjois/hs-logo + +# Installation + +``` +cabal update && cabal install diagrams-svg +``` + +# Usage + +A simple example that uses _diagrams-svg_ to draw a square. + +```haskell +import Diagrams.Prelude +import Diagrams.Backend.SVG.CmdLine + +b1 = square 20 # lw 0.002 + +main = defaultMain (pad 1.1 b1) +``` + +Save this to file named `Square.hs` and compile this program: + +``` +ghc --make Square.hs +``` + +This will generate an executable which, when run produces an SVG file. Run the +executable with the `--help` option to find out more about how to call it. + +``` +$ ./Square --help +Command-line diagram generation. + +Square [OPTIONS] + +Common flags: + -w --width=INT Desired width of the output image + -h --height=INT Desired height of the output image + -o --output=FILE Output file + -? --help Display help message + -V --version Print version information +``` + +You _must_ pass an output file name with a `.svg` extension to generate the SVG +file. + +``` +$ ./Square -o square.svg +``` + +The command above generates the SVG file: + +``` + + + + + + + + + +``` + +## Other Backends for Diagrams + +* [diagrams-cairo](http://github.com/diagrams/diagrams-cairo) +* [diagrams-postscript](https://github.com/fryguybob/diagrams-postscript) +* [diagrams-canvas](https://github.com/byorgey/diagrams-canvas/) + diff --git a/diagrams-svg.cabal b/diagrams-svg.cabal --- a/diagrams-svg.cabal +++ b/diagrams-svg.cabal @@ -1,47 +1,54 @@ Name: diagrams-svg -Version: 0.3.7 +Version: 0.6 Synopsis: SVG backend for diagrams drawing EDSL. Homepage: http://projects.haskell.org/diagrams/ License: BSD3 License-file: LICENSE +Extra-source-files: README.md, CHANGES.markdown Author: Felipe Lessa, Deepak Jois -Maintainer: deepak.jois@gmail.com +Maintainer: diagrams-discuss@googlegroups.com +Bug-reports: http://github.com/diagrams/diagrams-svg/issues Stability: Experimental Category: Graphics Build-type: Simple -Cabal-version: >=1.8 +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 : + More documentation: Github README : Source-repository head type: git - location: http://github.com/deepakjois/diagrams-svg + location: http://github.com/diagrams/diagrams-svg Library Exposed-modules: Diagrams.Backend.SVG Diagrams.Backend.SVG.CmdLine Other-modules: Graphics.Rendering.SVG Hs-source-dirs: src - Build-depends: base >= 4.3 && < 4.6 - , old-time >= 1.0 && < 1.2 - , process >= 1.0 && < 1.2 - , directory >= 1.0 && < 1.2 - , filepath >= 1.2 && < 1.4 - , mtl >= 1 && < 3.0 + Build-depends: base >= 4.3 && < 4.7 + , old-time + , process + , directory + , filepath + , mtl >= 1 && < 2.2 , bytestring >= 0.9 && < 1.0 , vector-space >= 0.7 && < 0.9 , colour - , diagrams-core >= 0.5.0.1 && < 0.6 - , diagrams-lib >= 0.5 && < 0.6 - , blaze-svg >= 0.3.3 - , cmdargs >= 0.6 && < 0.10 - , split >= 0.1.2 && < 0.2 + , diagrams-core >= 0.6 && < 0.7 + , diagrams-lib >= 0.6 && < 0.7 + , monoid-extras >= 0.2 && < 0.3 + , 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.6 + Build-depends: unix >= 2.4 && < 2.7 Ghc-options: -Wall + + Default-language: Haskell2010 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 @@ -23,13 +23,13 @@ import Diagrams.TwoD.Adjust (adjustDia2D) import Diagrams.TwoD.Text +-- from monoid-extras +import Data.Monoid.Split (Split(..)) + -- from blaze-svg import qualified Text.Blaze.Svg11 as S import Text.Blaze.Svg11 ((!)) --- from colour -import Data.Colour (transparent) - -- from this package import qualified Graphics.Rendering.SVG as R @@ -62,31 +62,39 @@ renderStyledGroup :: Style v -> (S.Svg -> S.Svg) renderStyledGroup s = S.g ! R.renderStyles s -renderSvgWithClipping :: S.Svg -- Input SVG - -> Style v -- Styles - -> Int -- Clip Path ID - -> S.Svg -- Resulting svg -renderSvgWithClipping svg s id_ = do - R.renderClip (getClip <$> getAttr s) id_ -- Clipping if any +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 instance Backend SVG R2 where data Render SVG R2 = R SvgRenderM type Result SVG R2 = S.Svg data Options SVG R2 = SVGOptions - { fileName :: String -- ^ the name of the file you want generated - , size :: SizeSpec2D -- ^ The requested size. + { size :: SizeSpec2D -- ^ The requested size. } - withStyle _ s _ (R r) = + -- 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 clipPathId_ <- gets clipPathId svg <- r - let styledSvg = renderStyledGroup s ! (R.renderClipPathId s clipPathId_) $ renderSvgWithClipping svg s clipPathId_ - return styledSvg + let styledSvg = renderStyledGroup s ! (R.renderClipPathId s clipPathId_) $ + renderSvgWithClipping svg s clipPathId_ t + -- This is where the frozen transformation is applied. + return (R.renderTransform t styledSvg) - doRender _ (SVGOptions _ sz) (R r) = + doRender _ (SVGOptions sz) (R r) = evalState svgOutput initialSvgRenderState where svgOutput = do @@ -98,10 +106,28 @@ Absolute -> (100,100) return $ R.svgHeader w h $ svg - adjustDia c opts d = adjustDia2D size setSvgSize c opts (d # reflectY - # fcA transparent - ) + adjustDia c opts d = adjustDia2D size setSvgSize c opts + (d # reflectY + # recommendFillColor + (transparent :: AlphaColour Double) + ) 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. + renderDia SVG opts d = + doRender SVG opts' . mconcat . map renderOne . prims $ d' + where (opts', d') = adjustDia SVG opts d + renderOne :: (Prim SVG R2, (Split (Transformation R2), Style R2)) + -> Render SVG R2 + renderOne (p, (M t, s)) + = withStyle SVG s mempty (render SVG (transform t p)) + + renderOne (p, (t1 :| t2, s)) + -- Here is the difference from the default + -- 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 . (:[]) 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 @@ -24,7 +24,6 @@ import Text.Blaze.Svg.Renderer.Utf8 (renderSvg) import qualified Data.ByteString.Lazy as BS -import Prelude hiding (catch) import Data.Maybe (fromMaybe) import Control.Monad (when) @@ -36,14 +35,28 @@ import System.IO (openFile, hClose, IOMode(..), hSetBuffering, BufferMode(..), stdout) import System.Exit (ExitCode(..)) -import System.Time (ClockTime, getClockTime) import Control.Concurrent (threadDelay) -import Control.Exception (catch, SomeException(..), bracket) +import qualified Control.Exception as Exc (catch, bracket) +import Control.Exception (SomeException(..)) #ifdef CMDLINELOOP import System.Posix.Process (executeFile) #endif + +# if MIN_VERSION_directory(1,2,0) +import Data.Time.Clock (UTCTime,getCurrentTime) +type ModuleTime = UTCTime +getModuleTime :: IO ModuleTime +getModuleTime = getCurrentTime +#else +import System.Time (ClockTime, getClockTime) +type ModuleTime = ClockTime +getModuleTime :: IO ModuleTime +getModuleTime = getClockTime +#endif + + data DiagramOpts = DiagramOpts { width :: Maybe Int , height :: Maybe Int @@ -122,7 +135,7 @@ (Just w, Just h) -> Dims (fromIntegral w) (fromIntegral h) - build = renderDia SVG (SVGOptions (output opts) sizeSpec) d + build = renderDia SVG (SVGOptions sizeSpec) d BS.writeFile (output opts) (renderSvg build) | otherwise -> putStrLn $ "Unknown file type: " ++ last ps @@ -145,7 +158,7 @@ Just d -> chooseRender opts d #ifdef CMDLINELOOP -waitForChange :: Maybe ClockTime -> DiagramOpts -> String -> [String] -> IO () +waitForChange :: Maybe ModuleTime -> DiagramOpts -> String -> [String] -> IO () waitForChange lastAttempt opts prog args = do hSetBuffering stdout NoBuffering go lastAttempt @@ -165,7 +178,7 @@ -- of this attempt. Otherwise (if nothing has changed since the -- last attempt), return @Nothing@. Also return a Bool saying -- whether a successful recompilation happened. -recompile :: Maybe ClockTime -> String -> Maybe String -> IO (Bool, Maybe ClockTime) +recompile :: Maybe ModuleTime -> String -> Maybe String -> IO (Bool, Maybe ModuleTime) recompile lastAttempt prog mSrc = do let errFile = prog ++ ".errors" srcFile = fromMaybe (prog ++ ".hs") mSrc @@ -174,7 +187,7 @@ if (srcT > binT) then do putStr "Recompiling..." - status <- bracket (openFile errFile WriteMode) hClose $ \h -> + status <- Exc.bracket (openFile errFile WriteMode) hClose $ \h -> waitForProcess =<< runProcess "ghc" ["--make", srcFile] Nothing Nothing Nothing Nothing (Just h) @@ -182,11 +195,11 @@ then putStrLn "" >> putStrLn (replicate 75 '-') >> readFile errFile >>= putStr else putStrLn "done." - curTime <- getClockTime + curTime <- getModuleTime return (status == ExitSuccess, Just curTime) else return (False, Nothing) - where getModTime f = catch (Just <$> getModificationTime f) + where getModTime f = Exc.catch (Just <$> getModificationTime f) (\(SomeException _) -> return Nothing) #endif 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 @@ -6,6 +6,7 @@ , renderClipPathId , renderText , renderStyles + , renderTransform ) where -- from base @@ -73,6 +74,11 @@ (unr2 -> (a1,a2)) = apply t unitX (unr2 -> (b1,b2)) = apply t unitY (unr2 -> (c1,c2)) = transl t + +-- 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) $