packages feed

diagrams 0.2 → 0.2.1

raw patch · 10 files changed

+224/−69 lines, 10 filesdep ~basedep ~cairodep ~colour

Dependency ranges changed: base, cairo, colour, containers, mtl

Files

− CHANGELOG 
@@ -1,14 +0,0 @@-New in version 0.2:--  * rawCairo function for creating primitive diagrams from raw Cairo code-  * line join, cap, and dashing attributes-  * bouding box visualization functions for debugging-  * new padding and positioning combinators-  * PDF, PS, and SVG output-  * experimental tree layout-  * paths, polygons, bezier curves-  * create diagrams from text-  * render on top of arbitrary background images-  * depend on colour package instead of built-in colors-  * new examples: snellen, wordcloud, dragon-  * emptyPath and pathConcat
+ CHANGES view
@@ -0,0 +1,23 @@+Version 0.2.1: September 24, 2009++  * new shape primitive 'arc'+  * multi-page PS/PDF output (Ganesh Sittampalam)+  * new grid layout combinators (Ganesh Sittampalam)+  * new primitives for generating rounded rectangles and rectangular paths+  * more path functions, and new path layout 'positionAlong'+  * various bug fixes and minor improvements++Version 0.2: January 31, 2009++  * rawCairo function for creating primitive diagrams from raw Cairo code+  * line join, cap, and dashing attributes+  * bouding box visualization functions for debugging+  * new padding and positioning combinators+  * PDF, PS, and SVG output+  * experimental tree layout+  * paths, polygons, bezier curves+  * create diagrams from text+  * render on top of arbitrary background images+  * depend on colour package instead of built-in colors+  * new examples: snellen, wordcloud, dragon+  * emptyPath and pathConcat
Graphics/Rendering/Diagrams.hs view
@@ -28,8 +28,11 @@   -- ** Shapes    , circle+  , arc+  , rectPath   , rect   , roundRect+  , roundRectF    , regPolyPath   , regPoly@@ -51,6 +54,7 @@   , Path   , emptyPath   , pathFromVertices, pathFromVectors+  , pathToVertices, pathToVectors   , pathConcat   , closed, isClosed   , rotPath@@ -76,7 +80,10 @@   , hdistribA, vdistribA    , position, positionA+  , positionAlong, positionAlongA +  , grid, gridA, gridAs+   , VAlignment   , top, vcenter, bottom   , HAlignment@@ -126,6 +133,7 @@   -- $render    , renderAs+  , renderPagesAs   , OutputType(..)   , SizeSpec(..)   , renderOverPNG@@ -240,9 +248,10 @@  -- $render -- Rendering diagrams to a file is accomplished with the 'renderAs'--- function.  'renderOverPNG' also provides a specialized rendering--- method, which overlays a rendererd diagram on top of an existing--- PNG.+-- function.  'renderPagesAs' renders multiple diagrams as multiple+-- pages for suitable backends.  'renderOverPNG' also provides a+-- specialized rendering method, which overlays a rendererd diagram on+-- top of an existing PNG.  -- | Render a diagram to a file. renderAs :: OutputType -- ^ The output type to use (PNG, PS, PDF, or SVG)@@ -251,6 +260,14 @@          -> Diagram    -- ^ The diagram to render.          -> IO () renderAs otype = renderWithBackend (chooseBackend otype)++-- | Render a list of diagrams as separate pages to a file.+renderPagesAs :: OutputType -- ^ The output type to use (PS or PDF)+              -> String     -- ^ The name of the file to create.+              -> SizeSpec   -- ^ The desired width or height of the image.+              -> [Diagram]  -- ^ The diagram to render.+              -> IO ()+renderPagesAs otype = renderPagesWithBackend (choosePagesBackend otype)  -- | @renderOverPNG infile outfile d@ reads the PNG @infile@ --   and renders @d@ over this, saving the output as a PNG to @outfile@.
Graphics/Rendering/Diagrams/Engine.hs view
@@ -31,6 +31,10 @@   , renderOverlayPNG   , chooseBackend +  , writePagesPS, writePagesPDF+  , renderPagesWithBackend+  , choosePagesBackend+     -- ** Internals    , atomic@@ -42,6 +46,7 @@  import qualified Graphics.Rendering.Cairo as C import Control.Monad.Reader+import Data.List (intersperse)  -- $preproc -- These functions take a user-generated 'Diagram' object and@@ -106,11 +111,18 @@   -- scale and translate the output so that it fits within the target   -- output width and height.   let ((x,y), d') = sizeAndPos d-      s           = case size of-                      Width  w -> w/x    -- scale so width is as desired-                      Height h -> h/y    -- scale so height is as desired-                      Auto     -> 1      -- do not scale-  in (,) (s*x,s*y) $ do+      (s,sx,sy)   = case (size,x,y) of+                      (Width  w,0,0) -> (1,w,w)+                      (Height h,0,0) -> (1,h,h)+                      (Width  w,0,_) -> (1,w,y)+                      (Height h,_,0) -> (1,x,h)+                      (Width  w,_,_) -> (w/x, w, y * w/x)+                      (Height h,_,_) -> (h/y, x * h/y, h)+                      (Auto,    0,0) -> (1,1,1)+                      (Auto,    0,_) -> (1,y,y)+                      (Auto,    _,0) -> (1,x,x)+                      (Auto,    _,_) -> (1,x,y)+  in (,) (sx, sy) $ do     C.scale s s     C.translate (x/2) (y/2) @@ -154,16 +166,36 @@   withSurface fileName w h $ \surface ->     C.renderWith surface r +writePagesSurface :: (String -> Double -> Double -> (C.Surface -> IO ()) -> IO ())+                  -> (C.Surface -> Double -> Double -> C.Render ())+                  -> String+                  -> [(Point, C.Render ())]+                  -> IO ()+writePagesSurface withSurface surfaceSetSize fileName pages =+  withSurface fileName 0 0 $ \surface -> C.renderWith surface $+    sequence_ $ concat $ intersperse [C.showPage] $+        [[C.save, surfaceSetSize surface w h, r, C.restore] | ((w,h),r) <- pages]+ -- | Given a rendered diagram, output it to a file in PostScript --   format with the given width and height. writePS  :: String -> Point -> C.Render () -> IO () writePS = writeSurface C.withPSSurface +-- | Given a list of rendered diagrams with their height and width,+--   output them as separate pages to a file in PostScript format+writePagesPS :: String -> [(Point, C.Render ())] -> IO ()+writePagesPS = writePagesSurface C.withPSSurface C.psSurfaceSetSize+ -- | Given a rendered diagram, output it to a file in PDF --   format with the given width and height. writePDF :: String -> Point -> C.Render () -> IO () writePDF = writeSurface C.withPDFSurface +-- | Given a list of rendered diagrams with their height and width,+--   output them as separate pages to a file in DFt format+writePagesPDF :: String -> [(Point, C.Render ())] -> IO ()+writePagesPDF = writePagesSurface C.withPDFSurface C.pdfSurfaceSetSize+ -- | Given a rendered diagram, output it to a file in SVG --   format with the given width and height. writeSVG :: String -> Point -> C.Render () -> IO ()@@ -180,6 +212,17 @@ renderWithBackend backend name size dia = backend name wh r   where (wh, r) = compose size dia +-- | Given a file name, an output size specification, and a list of+--   'Diagram's, use a \"backend\" to render the 'Diagram's as separate+--   pages to an actual physical output.+renderPagesWithBackend :: (String -> [(Point, C.Render ())] -> IO ())+                       -> String+                       -> SizeSpec+                       -> [Diagram]+                       -> IO ()+renderPagesWithBackend backend name size dias+  = backend name (map (compose size) dias)+ renderOverlayPNG :: FilePath -> FilePath -> Diagram -> IO () renderOverlayPNG srcfile dstfile dia = overlayPNG srcfile dstfile r   where r = snd $ compose' 0 Auto dia@@ -189,6 +232,12 @@ chooseBackend PS  = writePS chooseBackend PDF = writePDF chooseBackend SVG = writeSVG++choosePagesBackend :: OutputType -> (String -> [(Point, C.Render ())] -> IO ())+choosePagesBackend PS  = writePagesPS+choosePagesBackend PDF = writePagesPDF+choosePagesBackend PNG = error "PNG doesn't support multiple pages"+choosePagesBackend SVG = error "SVG doesn't support multiple pages"  -- | Perform a rendering operation atomically, by saving the state and --   restoring it afterwards.
Graphics/Rendering/Diagrams/Layouts.hs view
@@ -30,7 +30,10 @@   , hdistribA, vdistribA    , position, positionA+  , positionAlong, positionAlongA +  , grid, gridA, gridAs+   , VAlignment   , top, vcenter, bottom   , HAlignment@@ -51,9 +54,12 @@ import Graphics.Rendering.Diagrams.Types import Graphics.Rendering.Diagrams.Attributes import Graphics.Rendering.Diagrams.Shapes+import Graphics.Rendering.Diagrams.Paths import Graphics.Rendering.Diagrams.Engine (sizeAndPos) import Control.Arrow (first)+import Control.Monad.Cont +import Data.List (transpose) import Data.Tree  -- Union -----------------------------------------------@@ -377,7 +383,17 @@ positionA ha va pds = Compound (Layout (Positioned ps ha va) ds)   where (ps, ds) = unzip pds +-- | Create a diagram from a list of subdiagrams and a given path, by+--   positioning the subdiagrams at successive vertices of the path.+--   If there are more diagrams than path vertices, the extra diagrams+--   will be discarded.+positionAlong :: [Diagram] -> Path -> Diagram+positionAlong = positionAlongA hcenter vcenter +-- | A version of 'positionAlong' with explicit alignment.+positionAlongA :: HAlignment -> VAlignment -> [Diagram] -> Path -> Diagram+positionAlongA ha va ds p = positionA ha va $ zip (pathToVertices (0,0) p) ds+ -- Tree ------------------------------------------  -- | Lay out a 'Tree' (from "Data.Tree") of 'Diagram's in a top-down@@ -449,3 +465,33 @@          -> Diagram                       -- ^ Old diagram          -> Diagram withSize f dia = Compound (Layout (FromSize f) (Identity dia))++diagSize :: Diagram -> Cont Diagram (Double, Double) +diagSize d = Cont { runCont = \f -> flip withSize d $ \w h -> f (w, h) } ++-- | Align diagrams into a grid, specifying individual alignments for each item.+--   Warning: there is currently an exponential performace blowup if you nest grids+--   (exponential in how deep the nesting is).+gridAs :: [[(HAlignment, VAlignment)]] -> [[Diagram]] -> Diagram++-- | Align diagrams into a grid with each item aligned as specified.+--   Warning: there is currently an exponential performace blowup if you nest grids+--   (exponential in how deep the nesting is).+gridA :: HAlignment -> VAlignment -> [[Diagram]] -> Diagram++-- | Align diagrams into a grid, with each item centered horizontally and vertically+--   Warning: there is currently an exponential performace blowup if you nest grids.+--   (exponential in how deep the nesting is).+grid :: [[Diagram]] -> Diagram++grid = gridA hcenter vcenter+gridA h v = gridAs (repeat (repeat (h, v)))+gridAs alignss diagss+  = flip runCont id $+     do sizess <- mapM (mapM diagSize) diagss+        let widths = map (maximum . map fst) (transpose sizess)+            heights = map (maximum . map snd) sizess+            newsizess = [[(w, h) | w <- widths] | h <- heights]+            adjss = zipWith (zipWith (\ (nw, nh) (ow, oh) -> (nw - ow, nh - oh))) newsizess sizess+            padTo (width, height) (halign, valign) = padA width height halign valign+        return $ vcat $ map hcat $ zipWith3 (zipWith3 padTo) adjss alignss diagss
Graphics/Rendering/Diagrams/Paths.hs view
@@ -18,6 +18,7 @@     emptyPath    , pathFromVertices, pathFromVectors+  , pathToVertices, pathToVectors   , pathConcat   , closed, isClosed @@ -38,6 +39,11 @@ pathInt :: Point -> Path -> [Point] pathInt s (Path _ vs) = scanl (.+.) s vs +-- | Convert a path into a list of vertices, starting with the given+--   vertex.+pathToVertices :: Point -> Path -> [Point]+pathToVertices = pathInt+ -- | \"Differentiate\" a list of vertex coordinates to produce an open --   path.  Calling 'pathDeriv' on an empty list will result in a --   run-time error.@@ -51,6 +57,11 @@ --   direction and four in the positive y direction. pathFromVectors :: [Vec] -> Path pathFromVectors = Path Open++-- | Convert a path to a list of vectors corresponding to the edges of+--   the path.+pathToVectors :: Path -> [Vec]+pathToVectors (Path _ vs) = vs  -- | The empty path, i.e. a path with no edges. emptyPath :: Path
Graphics/Rendering/Diagrams/Shapes.hs view
@@ -13,13 +13,16 @@ ----------------------------------------------------------------------------- module Graphics.Rendering.Diagrams.Shapes   ( circle+  , arc    , regPolyPath   , regPoly   , rotRegPoly    , rect+  , rectPath   , roundRect+  , roundRectF    , straight   , curved@@ -57,18 +60,25 @@           c $ C.restore   where dist (x,y) = sqrt (x*x + y*y) --- | A unit circle centered at the origin.-data Circle = Circle  deriving (Eq, Show, Read)-instance ShapeClass Circle where-  shapeSize _   = (2,2)-  renderShape _ = do-    c $ C.arc 0 0 1 0 (2*pi)+-- | A unit arc centered at the origin, with a given start and end+--   angle in radians.+data Arc = Arc Double Double  deriving (Eq, Show, Read)+instance ShapeClass Arc where+  shapeSize _ = (2,2)+  renderShape (Arc a1 a2) = do+    c $ C.arc 0 0 1 a1 a2     draw  -- | @circle r@ is a circle with radius @r@. circle :: Double -> Diagram-circle r = scale r $ Prim (Shape Circle)+circle r = arc r 0 1 +-- | @arc r a1 a2@ is a circular arc with radius @r@, starting at+--   angle @a1*2*pi@ and proceeding in a direction of increasing angle+--   to @a2*2*pi@.+arc :: Double -> Double -> Double -> Diagram+arc r a1 a2 = scale r $ Prim (Shape (Arc (a1*2*pi) (a2*2*pi)))+ -- | A path-based shape. data PathShape = PathShape PathStyle Path  deriving (Eq, Show, Read) instance ShapeClass PathShape where@@ -120,28 +130,37 @@ rotRegPoly :: Int -> Double -> Double -> Diagram rotRegPoly n r a = straight . closed . rotPath a $ regPolyPath n r --- | @Rect w@ is a 2w (width) by 2 (height) rectangle, centered at the---   origin.-data Rect = Rect Double  deriving (Eq, Show, Read)-instance ShapeClass Rect where-  shapeSize (Rect w) = (2*w,2)-  renderShape (Rect w) = do-    c $ C.rectangle (-w) (-1) (2*w) 2-    draw+-- -- | @Rect w@ is a 2w (width) by 2 (height) rectangle, centered at the+-- --   origin.+-- data Rect = Rect Double  deriving (Eq, Show, Read)+-- instance ShapeClass Rect where+--   shapeSize (Rect w) = (2*w,2)+--   renderShape (Rect w) = do+--     c $ C.rectangle (-w) (-1) (2*w) 2+--     draw +-- | @rectPath w h@ is a closed path describing a rectangle of width+--   @w@ and height @h@.+rectPath :: Double -> Double -> Path+rectPath w h = closed $ pathFromVertices [(0,0), (w,0), (w,h), (0,h)]+ -- | @rect w h@ is a rectangle of width @w@ and height @h@. rect :: Double -> Double -> Diagram-rect w h = scale (h/2) $ Prim (Shape (Rect (w/h)))+rect w h = straight $ rectPath w h --- | @RoundRect w h@ is a rectangle with rounded corners.---   Both dimensions are given to avoid unnecessary---   distortion in the curves when scaling.-data RoundRect = RoundRect Double Double deriving (Eq, Show, Read)+-- -- | @rect w h@ is a rectangle of width @w@ and height @h@.+-- rect :: Double -> Double -> Diagram+-- rect w h = scale (h/2) $ Prim (Shape (Rect (w/h)))++-- | @RoundRect w h f@ is a rectangle with rounded corners taking up a+--   fraction @f@ of the smaller side.  Both dimensions are given to+--   avoid unnecessary distortion in the curves when scaling.+data RoundRect = RoundRect Double Double Double deriving (Eq, Show, Read) instance ShapeClass RoundRect where-  shapeSize (RoundRect w h) = (w,h)-  renderShape (RoundRect w h) = do+  shapeSize (RoundRect w h _) = (w,h)+  renderShape (RoundRect w h f) = do     let (x,y) = (w/2, h/2)-        r     = min (w/3) (h/3)+        r     = min (w * f) (h * f)     c $ do C.arc (r-x) (r-y) r pi (-pi/2)            C.lineTo (x-r) (-y)            C.arc (x-r) (r-y) r (-pi/2) 0@@ -156,8 +175,14 @@ --   rounded corners having a radius one third the length of the --   shortest edge. roundRect :: Double -> Double -> Diagram-roundRect w h = Prim $ Shape $ RoundRect w h+roundRect w h = Prim . Shape $ RoundRect w h (1/3) +-- | @roundRect w h f@ is a rectangle of width @w@ and height @h@ with+--   rounded corners having a radius @f@ times the length of the+--   shortest edge.+roundRectF :: Double -> Double -> Double -> Diagram+roundRectF w h f = Prim . Shape $ RoundRect w h f+ -- | @Text s t@ is a text string @t@ at size @s@. data Text = Text Double String deriving (Eq, Show, Read) instance ShapeClass Text where@@ -180,7 +205,7 @@ unsafeExtents :: Text -> (CI.FontExtents, CI.TextExtents) unsafeExtents (Text s t) = unsafePerformIO $ do             bracket-                (CI.create =<< C.createImageSurface C.FormatARGB32 1000 1000)+                (CI.create =<< C.createImageSurface C.FormatARGB32 1 1)                 (CI.destroy)                 (\cxt -> do CI.setFontSize cxt s                             te <- CI.textExtents cxt t
Graphics/Rendering/Diagrams/Types.hs view
@@ -53,7 +53,7 @@ import Control.Monad.Reader import Data.Colour import Data.Colour.Names (black)-import qualified Data.Colour.SRGB.Linear as RGB+import qualified Data.Colour.SRGB as RGB  -- Diagrams ---------------------------------------------------------- @@ -95,33 +95,29 @@ -- require Floating and Real (so that we can convert to Double with -- fromRational . toRational), and let type defaulting figure out that -- in the expression 'lc black', black should have type Colour Double.--- This is still unsatisfactory, though---even though we know we will--- (almost) always be getting (Colour Doubles), we still run the--- values through fromRational . toRational!  instance (Floating a, Real a) => Color (Colour a) where   colorToRGBA col = (r,g,b,1)-    where c' = RGB.toRGB col-          r  = toDouble $ RGB.channelRed c'-          g  = toDouble $ RGB.channelGreen c'-          b  = toDouble $ RGB.channelBlue c'+    where c' = RGB.toSRGB . colourConvert $ col+          r  = RGB.channelRed c'+          g  = RGB.channelGreen c'+          b  = RGB.channelBlue c'  instance (Floating a, Real a) => Color (AlphaColour a) where   colorToRGBA col = (r,g,b,a)-    where a  = toDouble $ alphaChannel col-          c' = RGB.toRGB $ alphaToColour col-          r  = toDouble $ RGB.channelRed c'-          g  = toDouble $ RGB.channelGreen c'-          b  = toDouble $ RGB.channelBlue c'--toDouble :: (Real a) => a -> Double-toDouble = fromRational . toRational+    where col' = alphaColourConvert col+          a  = alphaChannel col'+          c' = RGB.toSRGB . alphaToColour $ col'+          r  = RGB.channelRed c'+          g  = RGB.channelGreen c'+          b  = RGB.channelBlue c'  instance Color SomeColor where   colorToRGBA (SomeColor col) = colorToRGBA col  alphaToColour :: (Floating a, Ord a, Fractional a) => AlphaColour a -> Colour a-alphaToColour ac = darken (recip (alphaChannel ac)) (ac `over` black)+alphaToColour ac | alphaChannel ac == 0 = ac `over` black+                 | otherwise = darken (recip (alphaChannel ac)) (ac `over` black)  -- Points ------------------------------------------------------------
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) Brent Yorgey 2008+Copyright (c) Brent Yorgey 2008-2009  All rights reserved.
diagrams.cabal view
@@ -1,5 +1,5 @@ Name:                diagrams-Version:             0.2+Version:             0.2.1 Stability:           experimental Description:         An embedded domain-specific language (EDSL) for                       creating simple diagrams, built on top of the Cairo@@ -8,7 +8,7 @@ Synopsis:            An EDSL for creating simple diagrams License:             BSD3 License-file:        LICENSE-Extra-source-files:  README,CHANGELOG+Extra-source-files:  README,CHANGES Author:              Brent Yorgey Maintainer:          byorgey@gmail.com Category:            Graphics@@ -20,10 +20,12 @@   default: False  library-  ghc-options:         -Wall+  ghc-options:       -Wall   if flag(testing)     ghc-options: -Werror-  Build-Depends:       base,mtl,containers,cairo,colour+  Build-Depends:     base >= 2 && < 5, mtl >= 1.0 && < 1.2,+                     containers >= 0.2 && < 0.3,+                     cairo >= 0.9 && < 0.11, colour >= 2.2.1 && < 2.3   Exposed-Modules:   Graphics.Rendering.Diagrams,                      Graphics.Rendering.Diagrams.Types,                      Graphics.Rendering.Diagrams.Paths,