diff --git a/CHANGELOG b/CHANGELOG deleted file mode 100644 --- a/CHANGELOG +++ /dev/null @@ -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 diff --git a/CHANGES b/CHANGES new file mode 100644 --- /dev/null +++ b/CHANGES @@ -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 diff --git a/Graphics/Rendering/Diagrams.hs b/Graphics/Rendering/Diagrams.hs --- a/Graphics/Rendering/Diagrams.hs +++ b/Graphics/Rendering/Diagrams.hs @@ -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@. diff --git a/Graphics/Rendering/Diagrams/Engine.hs b/Graphics/Rendering/Diagrams/Engine.hs --- a/Graphics/Rendering/Diagrams/Engine.hs +++ b/Graphics/Rendering/Diagrams/Engine.hs @@ -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. diff --git a/Graphics/Rendering/Diagrams/Layouts.hs b/Graphics/Rendering/Diagrams/Layouts.hs --- a/Graphics/Rendering/Diagrams/Layouts.hs +++ b/Graphics/Rendering/Diagrams/Layouts.hs @@ -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 diff --git a/Graphics/Rendering/Diagrams/Paths.hs b/Graphics/Rendering/Diagrams/Paths.hs --- a/Graphics/Rendering/Diagrams/Paths.hs +++ b/Graphics/Rendering/Diagrams/Paths.hs @@ -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 diff --git a/Graphics/Rendering/Diagrams/Shapes.hs b/Graphics/Rendering/Diagrams/Shapes.hs --- a/Graphics/Rendering/Diagrams/Shapes.hs +++ b/Graphics/Rendering/Diagrams/Shapes.hs @@ -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 diff --git a/Graphics/Rendering/Diagrams/Types.hs b/Graphics/Rendering/Diagrams/Types.hs --- a/Graphics/Rendering/Diagrams/Types.hs +++ b/Graphics/Rendering/Diagrams/Types.hs @@ -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 ------------------------------------------------------------ diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) Brent Yorgey 2008 +Copyright (c) Brent Yorgey 2008-2009 All rights reserved. diff --git a/diagrams.cabal b/diagrams.cabal --- a/diagrams.cabal +++ b/diagrams.cabal @@ -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,