diagrams 0.2.2.3 → 0.3
raw patch · 24 files changed
+38/−2477 lines, 24 filesdep +diagrams-cairodep +diagrams-coredep +diagrams-libdep −basedep −cairodep −coloursetup-changed
Dependencies added: diagrams-cairo, diagrams-core, diagrams-lib
Dependencies removed: base, cairo, colour, containers, mtl
Files
- CHANGES +0/−59
- Graphics/Rendering/Diagrams.hs +0/−275
- Graphics/Rendering/Diagrams/Attributes.hs +0/−230
- Graphics/Rendering/Diagrams/Engine.hs +0/−254
- Graphics/Rendering/Diagrams/Layouts.hs +0/−495
- Graphics/Rendering/Diagrams/Paths.hs +0/−188
- Graphics/Rendering/Diagrams/Shapes.hs +0/−229
- Graphics/Rendering/Diagrams/Types.hs +0/−277
- LICENSE +25/−22
- README +0/−71
- Setup.hs +2/−0
- Setup.lhs +0/−3
- diagrams.cabal +11/−31
- example/CloudPacker.hs +0/−63
- example/alignment.hs +0/−19
- example/dragon.hs +0/−29
- example/ferrers.hs +0/−26
- example/fontlist.hs +0/−14
- example/ford.hs +0/−40
- example/logo.hs +0/−27
- example/permutations.hs +0/−27
- example/sierpinski.hs +0/−12
- example/snellen.hs +0/−13
- example/wordcloud.hs +0/−73
− CHANGES
@@ -1,59 +0,0 @@-Version 0.2.2.3: May 2011-- * Mark package as deprecated in favor of diagrams-core,- diagrams-lib, diagrams-cairo--Version 0.2.2.2: December 3, 2010-- * Update containers dependency- * Tested with GHC 7.0.1--Version 0.2.2.1: November 13, 2010-- * update cairo dependency; compiles fine with cairo 0.12--Version 0.2.2: November 2, 2010-- * update mtl dependency to 2.0. Note that due to the changed- definition of Cont, this version does NOT compile with versions of- mtl previous to 2.0. If you need to use a version of mtl < 2.0- then stick with 0.2.1.3 for now.--Version 0.2.1.3: May 30, 2010-- * update cairo version range to allow 0.11- * include example files in distribution tarball--Version 0.2.1.2: March 18, 2010-- * widen some dependency version ranges to include new releases that- still work.- * remove some redundant imports.--Version 0.2.1.1: September 25, 2009-- * builds with colour-2.3.1, so update allowable version range--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
@@ -1,275 +0,0 @@-{-# OPTIONS_GHC -fno-warn-type-defaults #-}--------------------------------------------------------------------------------- |--- Module : Graphics.Rendering.Diagrams--- Copyright : (c) Brent Yorgey 2008--- License : BSD-style (see LICENSE)--- Maintainer : byorgey@gmail.com--- Stability : experimental--- Portability : portable------ An embedded domain-specific language (EDSL) for creating simple--- diagrams, illustrations, and other types of graphics, built on top--- of the Cairo rendering engine.-----------------------------------------------------------------------------------module Graphics.Rendering.Diagrams- (-- -- * Introduction-- -- $intro-- -- * Primitives-- Diagram, nil-- -- ** Shapes-- , circle- , arc- , rectPath- , rect- , roundRect- , roundRectF-- , regPolyPath- , regPoly- , rotRegPoly-- , shape- , rawCairo- , text- , textPath-- -- ** Spacers-- , hspace- , vspace- , empty-- -- ** Paths-- , Path- , emptyPath- , pathFromVertices, pathFromVectors- , pathToVertices, pathToVectors- , pathConcat- , closed, isClosed- , rotPath-- , straight- , curved-- -- * Combinators- -- $comb-- -- ** Union-- , (##), union, unionA-- -- ** Lists-- , (<>), (//)- , hcat, vcat- , hcatA, vcatA- , hsep, vsep- , hsepA, vsepA- , hdistrib, vdistrib- , hdistribA, vdistribA-- , position, positionA- , positionAlong, positionAlongA-- , grid, gridA, gridAs-- , VAlignment- , top, vcenter, bottom- , HAlignment- , left, hcenter, right-- -- ** Complex layouts-- , tree-- -- ** Miscellaneous-- , pad, padA- , showBBox, showBBoxes- , withSize-- -- * Transformations- -- $transf-- , stretch, scale, scaleX, scaleY- , translate, translateX, translateY- , rotate, rotateR-- , view-- -- * Attributes- -- $attr-- -- ** Colors- -- $color-- , Color- , module Data.Colour.Names- , fillColor, fc- , lineColor, lc-- -- ** Other attributes-- , lineWidth, lw-- , lineCap, LineCap(..)- , lineJoin, LineJoin(..)- , dashing-- , typeface, tf-- -- * Rendering- -- $render-- , renderAs- , renderPagesAs- , OutputType(..)- , SizeSpec(..)- , renderOverPNG-- ) where--import Graphics.Rendering.Diagrams.Types-import Graphics.Rendering.Diagrams.Shapes-import Graphics.Rendering.Diagrams.Paths-import Graphics.Rendering.Diagrams.Attributes-import Graphics.Rendering.Diagrams.Layouts-import Graphics.Rendering.Diagrams.Engine-import Data.Colour.Names--{- $intro--"Graphics.Rendering.Diagrams" is an embedded domain-specific language-(EDSL) for creating simple graphics. It is compositional; starting-with some basic shapes, you can build up complex diagrams by combining-simpler diagrams in various ways.--A few fundamental concepts to keep in mind:-- * When constructing diagrams, there is no concept of an absolute- coordinate system, although each diagram does have a local- coordinate system.-- * Every diagram has an associated rectangular bounding box, which- determines its positioning and alignment relative to other- diagrams. Usually this makes no difference but there are times- when it\'s nice to be aware of it. For example, translating a- diagram works by moving the diagram relative to its bounding box;- positioning the bounding box where it would have gone means the- diagram itself ends up elsewhere. To visualize bounding boxes,- you can use the 'showBBox' and 'showBBoxes' functions.-- * The positive y-axis points downwards. This also means that- positive rotations are clockwise.--For some simple examples, see <http://code.haskell.org/diagrams/>.--Enjoy! Please send comments, suggestions, bug reports, or patches to-byorgey at cis dot upenn dot edu.---}---- | The nil diagram, which takes up no space and produces no output.-nil :: Diagram-nil = Empty---- | Create a 'Diagram' out of any instance of 'ShapeClass'.-shape :: (ShapeClass s) => s -> Diagram-shape = Prim . Shape---- | Create text with black fill, no outline, and a default font.-text :: Double -> String -> Diagram-text sz str = fc black $ lw 0 $ textPath sz str---- | @hspace w@ is a 'Diagram' which produces no output but takes up--- @w@ amount of space horizontally. Useful for manually creating--- horizontal separation between two diagrams. A negative value--- of @w@ can also be used to move two diagrams closer to one--- another. @hspace w@ is equivalent to @empty w 0@.-hspace :: Double -> Diagram-hspace w = empty w 0---- | @vspace h@ is a 'Diagram' which produces no output but takes up--- @h@ amount of space vertically. Useful for manually creating--- vertical separation between two diagrams. A negative value of--- @h@ can also be used to move two diagrams closer to one--- another. @vspace h@ is equivalent to @empty 0 h@.-vspace :: Double -> Diagram-vspace h = empty 0 h---- | @empty w h@ is an empty diagram which produces no output, but--- takes up an amount of space equal to a @w@ by @h@ rectangle.-empty :: Double -> Double -> Diagram-empty w h = Sized (w, h) Empty---- $comb--- Various ways to combine 'Diagram's into larger 'Diagram's.---- $transf--- Various ways to modify and transform 'Diagram's.---- | Explicitly set a diagram's bounding box, by giving the--- coordinates of the upper left and lower right corners (keeping in--- mind that the positive y-axis points downwards). Particularly--- useful for applying to the top-level diagram in order to only--- view a portion of it in the rendered output.-view :: Point -> Point -> Diagram -> Diagram-view (x1,y1) (x2,y2) = Sized (x2-x1, y2-y1) . translate ((x1-x2)/2 - x1)- ((y1-y2)/2 - y1)---- $attr--- Attributes which affect the way in which a 'Diagram' is rendered.---- $color--- Diagrams depends on the "Data.Colour" library (available on Hackage--- as the \"colour\" package) for colo(u)r. Any functions expecting a--- color can take any instance of the 'Color' type class, which has--- instances for both the 'Data.Colour.Colour' and--- 'Data.Colour.AlphaColour' types from "Data.Colour".------ For normal use, you can just use color names from--- "Data.Colour.Names", which is re-exported by--- "Graphics.Rendering.Diagrams" for convenience. For more--- sophisticated color manipulation, use the facilities provided by--- the "Data.Colour" library. For example, to create a color directly--- from RGB values, you can use the @rgb@ function from--- "Data.Colour.SRGB.Linear".---- $render--- Rendering diagrams to a file is accomplished with the 'renderAs'--- 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)- -> String -- ^ The name of the file to create.- -> SizeSpec -- ^ The desired width or height of the image.- -> 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@.-renderOverPNG :: FilePath -> FilePath -> Diagram -> IO ()-renderOverPNG srcfile dstfile dia = renderOverlayPNG srcfile dstfile dia
− Graphics/Rendering/Diagrams/Attributes.hs
@@ -1,230 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Graphics.Rendering.Diagrams.Attributes--- Copyright : (c) Brent Yorgey 2008--- License : BSD-style (see LICENSE)--- Maintainer : byorgey@gmail.com--- Stability : experimental--- Portability : portable------ Attributes which can be added as annotations to a 'Diagram',--- implemented via instances of 'AttrClass'.----------------------------------------------------------------------------------module Graphics.Rendering.Diagrams.Attributes- ( defaultAttributes- , fillColor, fc- , lineColor, lc- , lineWidth, lw- , lineCap, C.LineCap(..)- , lineJoin, C.LineJoin(..)- , dashing-- , typeface, tf-- , stretch, scale, scaleX, scaleY- , translate, translateX, translateY- , rotate, rotateR-- ) where--import Graphics.Rendering.Diagrams.Types--import qualified Graphics.Rendering.Cairo as C----- Fill color -------------------------- | Specify the default fill color for a 'Diagram'.-newtype Fill = Fill SomeColor-instance AttrClass Fill where- renderAttr (Fill (SomeColor f)) = return (setEnvFillColor f)---- | Draw a diagram using the given fill color. Note that the new--- color only applies to parts of the diagram which are not--- otherwise colored; subdiagrams which already have an explicit--- fill color will not be affected. The default fill color is--- completely transparent.-fillColor :: Color c => c -> Diagram -> Diagram-fillColor = Ann . Attr . Fill . SomeColor---- | 'fc' is provided as a convenient short synonym for 'fillColor'.-fc :: Color c => c -> Diagram -> Diagram-fc = fillColor---- Stroke color -------------------------- | Specify the default stroke color for a 'Diagram'.-newtype Stroke = Stroke SomeColor-instance AttrClass Stroke where- renderAttr (Stroke (SomeColor sc)) = return (setEnvStrokeColor sc)---- | Draw a diagram using the given color for lines. Note that the new--- color only applies to parts of the diagram which are not--- otherwise colored; subdiagrams which already have an explicit--- line color will not be affected. The default line color is black.-lineColor :: Color c => c -> Diagram -> Diagram-lineColor = Ann . Attr . Stroke . SomeColor---- | 'lc' is provided as a convenient short synonym for 'lineColor'.-lc :: Color c => c -> Diagram -> Diagram-lc = lineColor----- Stroke width ---------------------------------- | The stroke width to be used in drawing lines or shape outlines.--- Note that the stroke width is measured in /device coordinates/,--- so a stroke width of a certain size will look the same under any--- uniform scaling. Under non-uniform (i.e. different in the x and--- y axes) scaling, however, strokes may look distorted.-newtype StrokeWidth = StrokeWidth Double deriving (Eq, Show, Read)-instance AttrClass StrokeWidth where- renderAttr (StrokeWidth w) = return (setEnvStrokeWidth w)---- | Draw shape outlines and lines with the given width. Note that--- the line width is invariant under uniform scaling, although under--- non-uniform scaling (scaling by different amounts in the x and y--- axes) lines can become distorted. The default line width is 1.-lineWidth :: Double -> Diagram -> Diagram-lineWidth = Ann . Attr . StrokeWidth---- | 'lw' is provided as a convenient short synonym for 'lineWidth'.-lw :: Double -> Diagram -> Diagram-lw = lineWidth---- Fonts --------------------------------- | Set the typeface for a text diagram-newtype Typeface = Typeface String deriving (Eq, Show, Read)-instance AttrClass Typeface where- renderAttr (Typeface fontname) = c $ C.selectFontFace fontname C.FontSlantNormal C.FontWeightNormal >> return id---- | Change the default typeface to one named.-typeface :: String -> Diagram -> Diagram-typeface fontname = Ann (Attr (Typeface fontname))---- | Convenience function to change the typeface.-tf :: String -> Diagram -> Diagram-tf = typeface---- Rotate -------------------------------- | Rotate a diagram clockwise through a certain number of radians.-newtype Rotate = Rotate Double deriving (Eq, Show, Read)-instance AttrClass Rotate where- renderAttr (Rotate d) = c $ C.rotate d >> return id---- | @rotateR r@ rotates a diagram clockwise by @r@ radians.-rotateR :: Double -> Diagram -> Diagram-rotateR r = Ann (Attr (Rotate r))---- | @rotate f@ rotates a diagram clockwise by fraction @f@ of a--- complete revolution. @rotate f@ is equivalent to @rotateR--- (2*pi*f)@.-rotate :: Double -> Diagram -> Diagram-rotate f = rotateR (2*pi*f)----- Translate ------------------------------- | Translate a diagram by the given offset.-newtype Translate = Translate Point deriving (Eq, Show, Read)-instance AttrClass Translate where- renderAttr (Translate (x,y)) = c $ C.translate x y >> return id---- | Translate a diagram by the given relative offsets in the x and y--- directions. Note that the positive x-axis is to the right, while--- the positive y-axis points downwards.-translate :: Double -> Double -> Diagram -> Diagram-translate 0 0 = id-translate dx dy = Ann (Attr (Translate (dx,dy)))---- | Translate a diagram along the x-axis only. @translateX x@ is--- equivalent to @translate x 0@.-translateX :: Double -> Diagram -> Diagram-translateX dx = translate dx 0---- | Translate a diagram along the y-axis only. @translateY y@ is--- equivalent to @translate 0 y@.-translateY :: Double -> Diagram -> Diagram-translateY dy = translate 0 dy------ Scale ------------------------------------ | Scale a diagram by the given scaling factors in the x and y axes,--- respectively.-newtype Scale = Scale Point deriving (Eq, Show, Read)-instance AttrClass Scale where- attrSize (Scale k) s = k .*. s- renderAttr (Scale (x,y)) = c $ C.scale x y >> return id---- | Stretch a diagram by a separate scaling factor for each axis.--- @stretch w h@ scales by a factor of @w@ in the x direction and--- a factor of @h@ in the y direction.-stretch :: Double -> Double -> Diagram -> Diagram-stretch sx sy = Ann (Attr (Scale (sx,sy)))---- | Scale by the same scaling factor in both dimensions, so the diagram--- retains its aspect ratio.-scale :: Double -> Diagram -> Diagram-scale 1 = id-scale s = stretch s s---- | Scale a diagram along the x-axis only. @scaleX s@ is equivalent--- to @stretch s 1@.-scaleX :: Double -> Diagram -> Diagram-scaleX sx = stretch sx 1---- | Scale a diagram along the y-axis only. @scaleY s@ is equivalent--- to @stretch 1 s@.-scaleY :: Double -> Diagram -> Diagram-scaleY sy = stretch 1 sy----- Stroke styles ------------------------------------newtype LCap = LCap C.LineCap-instance AttrClass LCap where- renderAttr (LCap lcap) = c $ C.setLineCap lcap >> return id---- | Set the line cap style. Valid values for 'LineCap' are--- @LineCapButt@, @LineCapRound@, and @LineCapSquare@.-lineCap :: C.LineCap -> Diagram -> Diagram-lineCap = Ann . Attr . LCap--newtype LJoin = LJoin C.LineJoin-instance AttrClass LJoin where- renderAttr (LJoin lj) = c $ C.setLineJoin lj >> return id---- | Set the line join style. Valid values for 'LineJoin' are--- @LineJoinMiter@, @LineJoinRound@, and @LineJoinBevel@.-lineJoin :: C.LineJoin -> Diagram -> Diagram-lineJoin = Ann . Attr . LJoin--data Dashing = Dashing [Double] Double-instance AttrClass Dashing where- renderAttr (Dashing ds offs) = c $ C.setDash ds offs >> return id---- | Set the line dashing pattern.-dashing :: [Double] -- ^ a list specifying alternate lengths of on- -- and off portions of the stroke. The empty- -- list indicates no dashing.- -> Double -- ^ an offset into the dash pattern at which the- -- stroke should start- -> Diagram -> Diagram-dashing ds offs = Ann (Attr (Dashing ds offs))---- | Apply all the default attributes to a 'Diagram'.-defaultAttributes :: Diagram -> Diagram-defaultAttributes =- case defaultDiaRenderEnv of- (DREnv (SomeColor fillC) (SomeColor strokeC) strokeW) ->- lc strokeC .- lw strokeW .- lineCap C.LineCapButt .- lineJoin C.LineJoinMiter .- dashing [] 0 .- fc fillC
− Graphics/Rendering/Diagrams/Engine.hs
@@ -1,254 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Graphics.Rendering.Diagrams.Engine--- Copyright : (c) Brent Yorgey 2008--- License : BSD-style (see LICENSE)--- Maintainer : byorgey@gmail.com--- Stability : experimental--- Portability : portable------ The core rendering engine for "Graphics.Rendering.Diagrams", an--- embedded domain-specific language (EDSL) for creating simple--- diagrams.-----------------------------------------------------------------------------------module Graphics.Rendering.Diagrams.Engine- (- -- * Preprocessing- -- $preproc-- sizeAndPos-- -- * Rendering- -- $render-- -- ** User interface-- , compose- , writePNG, writePS, writePDF, writeSVG- , renderWithBackend- , renderOverlayPNG- , chooseBackend-- , writePagesPS, writePagesPDF- , renderPagesWithBackend- , choosePagesBackend-- -- ** Internals-- , atomic- , render-- ) where--import Graphics.Rendering.Diagrams.Types--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--- preprocess it in preparation for final rendering. The--- preprocessing includes calculating diagram sizes and positioning--- diagrams by the addition of appropriate translate annotations.---- | Given a 'Diagram', compute its total size, and produce a new--- version of the 'Diagram' with all sub-'Diagram's positioned--- properly.-sizeAndPos :: Diagram -> (Point,Diagram)---- the empty diagram takes up no space.-sizeAndPos Empty = ((0,0), Empty)--sizeAndPos d@(Prim (Shape s)) = (shapeSize s, d)---- ignore the size calculated by the recursive call, and use the given--- size instead.-sizeAndPos (Sized s d) = (s, snd $ sizeAndPos d)---- attributes may affect the size of a diagram.-sizeAndPos (Ann a@(Attr attr) d) = (attrSize attr s, (Ann a d'))- where (s, d') = sizeAndPos d--sizeAndPos (Compound (Layout l ds)) = (s, Union ds')- where (s, ds') = layoutSizeAndPos l (fmap sizeAndPos ds)--sizeAndPos (Union _) = error "sizeAndPos (Union _): This should never happen!"---- $render--- The rendering code takes a 'Diagram' and turns it into--- actual graphics output, using the Cairo library to perform the low-level--- drawing operations.---- | Given a target width or height and a user-constructed 'Diagram',--- render it using the Cairo rendering library. Note that 'compose'--- takes care of all the rendering details, including preprocessing--- of the 'Diagram', and scaling/translating the final output so--- that it fits within the given width or height. 'compose' also--- produces the size of the final diagram; the width or height will--- be equal to that specified in the input, and the other dimension--- will be determined by the aspect ratio of the diagram.------ The background of the output diagram will be opaque white.------ In order to produce a physical output, the output of 'compose'--- must be given as input to an output adapter such as 'writePng'.--- Normally, however, a user of the diagrams library should not need--- to call 'compose' directly.-compose :: SizeSpec -- ^ output width or height- -> Diagram -- ^ 'Diagram' to render- -> (Point, C.Render ())- -- ^ Output width and height, and Cairo action- -- to render it-compose size d = compose' 1 size d--compose' :: Double -> SizeSpec -> Diagram -> (Point, C.Render ())-compose' opacity size d =-- -- Preprocess the diagram, and use the global bounding box size to- -- scale and translate the output so that it fits within the target- -- output width and height.- let ((x,y), d') = sizeAndPos d- (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)-- -- Set the output background to opaque white.- C.save- C.setSourceRGBA 1 1 1 opacity- C.paint- C.restore-- -- render the final diagram.- flip runDiaRenderM defaultDiaRenderEnv . render $ d'---- | Given a rendered diagram, output it to a file in PNG format with--- the given width and height.-writePNG :: String -> Point -> C.Render () -> IO ()-writePNG dstfile wh r = usingBackground wh- (\surface -> writeSurfaceToPNG surface dstfile r)---- | Given a rendered diagram, output it to a file in PNG format with--- the size and background of the PNG image @srcfile@.-overlayPNG :: String -> String -> C.Render () -> IO ()-overlayPNG srcfile dstfile r = usingPNG srcfile- (\surface -> writeSurfaceToPNG surface dstfile r)--writeSurfaceToPNG :: C.Surface -> FilePath -> C.Render () -> IO ()-writeSurfaceToPNG surface dstfile r = do- C.renderWith surface r- C.surfaceWriteToPNG surface dstfile--usingPNG :: FilePath -> (C.Surface -> IO ()) -> IO ()-usingPNG srcfile = C.withImageSurfaceFromPNG srcfile-usingBackground :: Point -> (C.Surface -> IO ()) -> IO ()-usingBackground (w,h) = C.withImageSurface C.FormatARGB32 (ceiling w) (ceiling h)--writeSurface :: (String -> Double -> Double -> (C.Surface -> IO a) -> IO a)- -> String- -> Point- -> C.Render a- -> IO a-writeSurface withSurface fileName (w,h) r =- 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 ()-writeSVG = writeSurface C.withSVGSurface---- | Given a file name, an output size specification, and a 'Diagram',--- use a \"backend\" to render the 'Diagram' to an actual physical--- output.-renderWithBackend :: (String -> Point -> C.Render () -> IO ()) -- ^ backend- -> String -- ^ file name- -> SizeSpec -- ^ output size specification- -> Diagram -- ^ the diagram to render- -> IO ()-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--chooseBackend :: OutputType -> (String -> Point -> C.Render () -> IO ())-chooseBackend PNG = writePNG-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.-atomic :: DiaRenderM () -> DiaRenderM ()-atomic r = (c C.save) >> r >> (c C.restore)---- | Render a diagram.-render :: Diagram -> DiaRenderM ()-render Empty = return ()-render (Prim (Shape s)) = renderShape s-render (Ann (Attr a) d) = atomic $ renderAttr a >>= flip local (render d)-render (Union ds) = mapM_ render ds-render (Sized _ d) = render d-render d@(Compound _) = render $ snd $ sizeAndPos d
− Graphics/Rendering/Diagrams/Layouts.hs
@@ -1,495 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses #-}--------------------------------------------------------------------------------- |--- Module : Graphics.Rendering.Diagrams.Types--- Copyright : (c) Brent Yorgey 2008--- License : BSD-style (see LICENSE)--- Maintainer : byorgey@gmail.com--- Stability : experimental--- Portability : portable------ Layout definitions for "Graphics.Rendering.Diagrams", an embedded--- domain-specific language (EDSL) for creating simple diagrams.-----------------------------------------------------------------------------------module Graphics.Rendering.Diagrams.Layouts- ( -- * Union-- (##)- , union, unionA-- -- * Lists-- , (<>), (//)- , hcat, vcat- , hcatA, vcatA- , hsep, vsep- , hsepA, vsepA- , hdistrib, vdistrib- , hdistribA, vdistribA-- , position, positionA- , positionAlong, positionAlongA-- , grid, gridA, gridAs-- , VAlignment- , top, vcenter, bottom- , HAlignment- , left, hcenter, right-- -- * Tree-- , tree-- -- * Miscellaneous-- , pad, padA- , showBBox, showBBoxes- , withSize-- ) where--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 Control.Monad.Identity--import Data.List (transpose)-import Data.Tree---- Union --------------------------------------------------- | The union layout, which lays out diagrams superimposed on one--- another. The diagrams can be aligned both vertically and--- horizontally. A union layout with centered alignment in both--- axes is simply the identity layout which does no repositioning of--- subdiagrams.-data UnionLayout = UnionL HAlignment VAlignment-instance LayoutClass UnionLayout [] where- layoutSizeAndPos _ [] = ((0,0), [])- layoutSizeAndPos (UnionL halign valign) pds = ((w,h), positionedDs)- where (sizes, diagrams) = unzip pds- (xs, ys) = unzip sizes- (w,h) = (maximum xs, maximum ys)- xs' = aligns halign w xs- ys' = aligns valign h ys- positionedDs = zipWith3 translate xs' ys' diagrams---- | Create a 'Diagram' as a union of subdiagrams which will not be--- repositioned. If the subdiagrams overlap, they will appear with--- the first 'Diagram' on the bottom, and the last on top.-union :: [Diagram] -> Diagram-union = unionA hcenter vcenter---- | Superimpose one diagram atop another. @d1 \#\# d2@ results in a--- diagram in which @d2@ is on top of @d1@ (i.e., @d1@ is drawn--- first, then @d2@).-(##) :: Diagram -> Diagram -> Diagram-d1 ## d2 = union [d1, d2]---- | Create a 'Diagram' as a union of subdiagrams superimposed on one--- another, aligned vertically and/or horizontally.-unionA :: HAlignment -> VAlignment -> [Diagram] -> Diagram-unionA ha va = Compound . Layout (UnionL ha va)---- Lists --------------------------------------------------- | The possible ways to arrange a list of diagrams.-data ListType = H -- ^ in a horizontal row, left to right- | V -- ^ in a vertical column, top to bottom- deriving (Eq, Show, Read)---- | A list of 'Diagram's can be aligned in one of several ways.-data Alignment = TopLeft -- ^ Align along top/left edges, i.e. in- -- the negative direction- | Center -- ^ Align centers- | BottomRight -- ^ Align bottom/right edges, i.e. in- -- the positive direction- deriving (Eq, Show, Read)---- | Vertical alignment.-type VAlignment = Alignment---- | Horizontal alignment.-type HAlignment = Alignment--top, vcenter, bottom :: VAlignment-left, hcenter, right :: HAlignment-top = TopLeft-bottom = BottomRight-left = TopLeft-right = BottomRight-vcenter = Center-hcenter = Center---- | Compute new coordinates for the centers of the subdiagrams of a--- list, based on the alignment.-aligns :: Alignment -- ^ the alignment to use- -> Double -- ^ the total height (resp. width) we're working with- -> [Double] -- ^ the individual heights (resp. widths) of- -- the diagrams to align- -> [Double] -- ^ the amount to translate each diagram in- -- order to be properly aligned-aligns a h hs = map (align a h) hs---- | Given a requested alignment, the total width (resp. height) of--- the enclosing bounding box, and the width (resp. height) of a--- diagram, compute the offset needed to properly align the diagram.-align :: Alignment -- ^ the alignment to use- -> Double -- ^ the total height (resp. width) we're working with- -> Double -- ^ the height (resp. widths) of the diagram to- -- align- -> Double -- ^ the offset needed to align the diagram-align a h x = alignOffset a (h - x)---- | Compute an offset corresponding to a given alignment and width.-alignOffset :: Alignment -> Double -> Double-alignOffset TopLeft x = -x/2-alignOffset Center _ = 0-alignOffset BottomRight x = x/2----- | A list of 'Diagram's can be distributed in one of several ways.-data Distribution = Sep Double -- ^ Put a constant separation between- -- each pair of diagrams- | Distrib Alignment Double- -- ^ @Distrib align sep@ represents- -- evenly spaced diagrams,- -- distributed with the @align@ of a- -- diagram placed every @sep@ units.- -- For example, @Distrib TopLeft 50@- -- means that the top/left of a- -- diagram will occur every 50- -- units.- deriving (Eq, Show, Read)---- | A horizontal or vertical list of diagrams, with configurable--- alignment and distribution.-data List = List ListType Alignment Distribution-instance LayoutClass List [] where- layoutSizeAndPos _ [] = ((0,0), [])- layoutSizeAndPos (List typ algn dist) dss =-- -- unzip sizes and diagrams, flipping sizes for a vertical layout- let (sizes, diagrams) = first (map (mswap typ)) $ unzip dss-- -- calculate the total size, given the method of distribution- size = listSize dist sizes-- -- calculate new positions for the subdiagrams, flipping- -- positions back for a vertical layout- pos = map (mswap typ) $ listPosns algn dist size sizes-- -- apply appropriate translates, and flip the final size for a- -- vertical layout- in (mswap typ size, zipWith (uncurry translate) pos diagrams)---- | Conditionally swap points, so vertical lists can be laid out--- using the same code as horizontal lists, with appropriate swaps--- before and after layout processing.-mswap :: ListType -> Point -> Point-mswap H (x,y) = (x,y)-mswap V (x,y) = (y,x)---- | Given a method of distribution and the sizes of the subdiagrams--- for a horizontal list, compute the total size of the entire list-listSize :: Distribution -> [Point] -> Point-listSize (Sep sep) ss = (x,y)- where (xs,ys) = unzip ss- x = sum xs + (sep * fromIntegral (length ss - 1))- y = maximum ys-listSize (Distrib _ sep) ss = (x,y)- where x = sep * fromIntegral (length ss)- y = maximum (map snd ss)---- | Calculate the final positions for the centers of the subdiagrams--- of a horizontal list, based on the alignment and distribution.-listPosns :: Alignment -- ^ vertical alignment of list elements- -> Distribution -- ^ horizontal distribution- -> Point -- ^ pre-calculated total size of the list- -> [Point] -- ^ sizes of individual elements- -> [Point] -- ^ new coordinates for the center of- -- each list element-listPosns a (Sep sep) (w,h) sizes = zip xs ys- where (ws,hs) = unzip sizes- offsets = scanl (+) 0 ws- offsWSeps = zipWith (+) offsets (zipWith (*) [0..] (repeat sep))- centers = zipWith (+) (init offsWSeps) (map (/2) ws)- xs = map (subtract (w/2)) centers- ys = aligns a h hs--listPosns a (Distrib da sep) (w,h) sizes = zip xs ys- where (ws,hs) = unzip sizes- offsets = zipWith (*) [0..] (repeat sep)- centers = zipWith (+) offsets (map (centerOffs da) ws)- centerOffs TopLeft width = width/2- centerOffs Center _ = sep/2- centerOffs BottomRight width = sep - width/2- xs = map (subtract (w/2)) centers- ys = aligns a h hs---- | Lay out a list of 'Diagram's horizontally from left to right,--- aligned along their top edges.-hcat :: [Diagram] -> Diagram-hcat = hsep 0---- | @d1 \<\> d2@ is a 'Diagram' with @d1@ to the left of @d2@, aligned--- along their top edges.-(<>) :: Diagram -> Diagram -> Diagram-d1 <> d2 = hcat [d1, d2]---- | Lay out a list of 'Diagram's horizontally from left to right,--- with the given vertical alignment ('top', 'vcenter', or 'bottom').-hcatA :: VAlignment -> [Diagram] -> Diagram-hcatA = hsepA 0---- | Lay out a list of 'Diagram's horizontally, aligned along their--- top edges, with a given amount of separation in between each pair.-hsep :: Double -- ^ amount of separation between each pair of diagrams- -> [Diagram] -> Diagram-hsep sep = hsepA sep top---- | Lay out a list of 'Diagram's horizontally, with the given--- amount of separation in between each pair, using the given--- vertical alignment ('top', 'vcenter', or 'bottom').-hsepA :: Double -- ^ amount of separation between each pair of diagrams- -> VAlignment -- ^ alignment to use ('top', 'vcenter', or 'bottom')- -> [Diagram] -> Diagram-hsepA = sepA H---- | Distribute a list of 'Diagram's horizontally according to a--- regular spacing, aligned along their top edges.-hdistrib :: Double -- ^ How far from one diagram to the next?- -> HAlignment -- ^ Distribute according to which parts of- -- the diagrams ('left', 'hcenter', 'right')?- -> [Diagram] -> Diagram-hdistrib sep alignD = hdistribA sep alignD top---- | Distribute a list of 'Diagram's horizontally according to a--- regular spacing, with the given alignment.-hdistribA :: Double -- ^ How far from one diagram to the next?- -> HAlignment -- ^ Distribute according to which parts of- -- the diagrams ('left', 'hcenter', 'right')?- -> VAlignment -- ^ alignment to use ('top', 'vcenter', 'bottom')- -> [Diagram] -> Diagram-hdistribA = distribA H---- | Lay out a list of 'Diagram's vertically from top to bottom,--- aligned along their left edges.-vcat :: [Diagram] -> Diagram-vcat = vsep 0---- | @d1 \/\/ d2@ is a 'Diagram' with @d1@ above @d2@, aligned--- along their left edges.-(//) :: Diagram -> Diagram -> Diagram-d1 // d2 = vcat [d1, d2]---- | Lay out a list of 'Diagram's vertically from top to bottom,--- with the given horizontal alignment ('left', 'hcenter', or 'right').-vcatA :: HAlignment -> [Diagram] -> Diagram-vcatA = vsepA 0---- | Lay out a list of 'Diagram's vertically, aligned along their--- left edges, with a given amount of separation in between each pair.-vsep :: Double -- ^ amount of separation between each pair of diagrams- -> [Diagram] -> Diagram-vsep sep = vsepA sep left---- | Lay out a list of 'Diagram's vertically, with the given--- amount of separation in between each pair, using the given--- horizontal alignment ('left', 'hcenter', or 'right').--vsepA :: Double -- ^ amount of separation between each pair of diagrams- -> HAlignment -- ^ alignment to use ('left', 'hcenter', or 'right')- -> [Diagram] -> Diagram-vsepA = sepA V---- | Distribute a list of 'Diagram's vertically according to a regular--- spacing, aligned along their left edges.-vdistrib :: Double -- ^ How far from one diagram to the next?- -> VAlignment -- ^ Distribute according to which parts of- -- the diagrams ('top', 'vcenter', 'bottom')?- -> [Diagram] -> Diagram-vdistrib sep alignD = vdistribA sep alignD left---- | Distribute a list of 'Diagram's vertically according to a--- regular spacing, with the given alignment.-vdistribA :: Double -- ^ How far from one diagram to the next?- -> VAlignment -- ^ Distribute according to which parts of- -- the diagrams ('top', 'vcenter', 'bottom')?- -> HAlignment -- ^ alignment to use ('left', 'hcenter', 'right')- -> [Diagram] -> Diagram-vdistribA = distribA V---- | The mother-combinator for all the @sep@ functions, used--- internally.-sepA :: ListType -> Double -> Alignment -> [Diagram] -> Diagram-sepA lt sep algn = Compound . Layout (List lt algn (Sep sep))---- | The mother-combinator for all the @distrib@ functions, used--- internally.-distribA :: ListType -> Double -> Alignment -> Alignment -> [Diagram] -> Diagram-distribA lt sep alignD algn =- Compound . Layout (List lt algn (Distrib alignD sep))----- Explicit subdiagram positioning -----------------------data Positioned = Positioned [Point] HAlignment VAlignment-instance LayoutClass Positioned [] where- layoutSizeAndPos _ [] = ((0,0), [])- layoutSizeAndPos (Positioned ps ha va) dss = ((w,h), pds)- where (sizes, diagrams) = unzip dss- (ws, hs) = unzip sizes- (pxs, pys) = unzip ps-- xs' = zipWith (\x w1 -> x - alignOffset ha w1) pxs ws- ys' = zipWith (\y h1 -> y - alignOffset va h1) pys hs-- hws = map (/2) ws- hhs = map (/2) hs- xmax = maximum (zipWith (+) xs' hws)- xmin = minimum (zipWith (-) xs' hws)- w = xmax - xmin- ymax = maximum (zipWith (+) ys' hhs)- ymin = minimum (zipWith (-) ys' hhs)- h = ymax - ymin-- xs'norm = map (subtract (xmin + w/2)) xs'- ys'norm = map (subtract (ymin + h/2)) ys'-- pds = zipWith3 translate xs'norm ys'norm diagrams---- | Create a diagram from a list of subdiagrams with explicit--- positions in a local coordinate system. Each subdiagram will be--- positioned with its center at the corresponding--- position. @position@ is equivalent to @positionA hcenter--- vcenter@.-position :: [(Point, Diagram)] -> Diagram-position = positionA hcenter vcenter---- | Create a diagram from a list of subdiagrams with explicit--- positions in a local coordinate system. The alignment options--- specify what part of each subdiagram should be placed on the--- corresponding position. For example, @positionA left top@ will--- position the top left corner of each subdiagram at the--- corresponding point.-positionA :: HAlignment -> VAlignment -> [(Point,Diagram)] -> Diagram-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--- fashion. This layout is experimental; future releases of the--- Diagrams library are planned which will be able to automatically--- draw edges between nodes in the tree.-tree :: Double -- ^ separation between layers- -> Double -- ^ separation between siblings- -> Tree Diagram- -> Diagram-tree _ _ (Node d []) = d-tree ls ss (Node d ts) = vsepA ls hcenter [ d, hsep ss (map (tree ls ss) ts) ]---- Miscellaneous -----------------------------------data Padded = Padded Double Double HAlignment VAlignment-instance LayoutClass Padded Identity where- layoutSizeAndPos (Padded dw dh ha va) (Identity ((w,h), d))- = ((w', h'), [translate (align ha w' w) (align va h' h) d])- where w' = w + dw- h' = h + dh---- | Add extra padding to a diagram. @pad w h d@ is a diagram which--- is the same as @d@, but with @w@ units added to the width and @h@--- units added to the height, with @d@ centered in the available--- space. Thus @pad w h@ is equivalent to @padA w h hcenter vcenter@.-pad :: Double -> Double -> Diagram -> Diagram-pad pw ph d = padA pw ph hcenter vcenter d---- | Add extra padding to a diagram, aligning the diagram as indicated--- within the avilable space.-padA :: Double -> Double -> HAlignment -> VAlignment -> Diagram -> Diagram-padA pw ph aw ah d = Compound (Layout (Padded pw ph aw ah) (Identity d))----data ShowBBox = ShowBBox-instance LayoutClass ShowBBox Identity where- layoutSizeAndPos _ (Identity ((w,h), d))- = ((w,h), [defaultAttributes $ rect w h, d])---- | Show a rectangle denoting a diagram's bounding box, in addition--- to the diagram itself.-showBBox :: Diagram -> Diagram-showBBox Empty = Empty-showBBox d = Compound . Layout ShowBBox . Identity $ d---- | Show the bounding boxes of a diagram and all its subdiagrams.-showBBoxes :: Diagram -> Diagram-showBBoxes Empty = Empty-showBBoxes d@(Prim _) = showBBox d-showBBoxes (Ann a d) = showBBox (Ann a (showBBoxes d))-showBBoxes (Compound (Layout l ds)) = showBBox (Compound (Layout l (fmap showBBoxes ds)))-showBBoxes (Union ds) = showBBox (Union (map showBBoxes ds))-showBBoxes (Sized p d) = showBBox (Sized p (showBBoxes d))--data FromSize = FromSize (Double -> Double -> Diagram)-instance LayoutClass FromSize Identity where- layoutSizeAndPos (FromSize f) (Identity ((w,h),_))- = let d = f w h in (fst (sizeAndPos d), [d])---- | Create one diagram using the current size of another.--- The new diagram is returned, the old one is discarded.-withSize :: (Double -> Double -> Diagram) -- ^ Function for new diagram- -> Diagram -- ^ Old diagram- -> Diagram-withSize f dia = Compound (Layout (FromSize f) (Identity dia))--diagSize :: Diagram -> Cont Diagram (Double, Double)-diagSize d = ContT { runContT = \f -> Identity . flip withSize d $- \w h -> runIdentity (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
@@ -1,188 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Graphics.Rendering.Diagrams.Paths--- Copyright : (c) Brent Yorgey 2008--- License : BSD-style (see LICENSE)--- Maintainer : byorgey@gmail.com--- Stability : experimental--- Portability : portable------ Type definitions and convenience functions for--- "Graphics.Rendering.Diagrams", an embedded domain-specific language--- (EDSL) for creating simple diagrams.-----------------------------------------------------------------------------------module Graphics.Rendering.Diagrams.Paths- (- emptyPath-- , pathFromVertices, pathFromVectors- , pathToVertices, pathToVectors- , pathConcat- , closed, isClosed-- , rotPath-- , pathSizeAndOffset- , renderPath-- ) where--import Graphics.Rendering.Diagrams.Types-import qualified Graphics.Rendering.Cairo as C--import Control.Monad (when)---- | \"Integrate\" a path given by a starting point and a sequence of--- displacements, resulting in a list of vertex coordinates.-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.-pathDeriv :: [Point] -> Path-pathDeriv ps = Path Open $ zipWith (.-.) (tail ps) ps---- | Create an open path from a list of edge displacement vectors.--- For example, @pathFromVectors [(1,1), (3,4)]@ describes the path--- with two segments which first moves one unit in the positive x--- and y directions, and then moves three units in the positive x--- 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-emptyPath = pathFromVectors []---- | Create an open path from a list of vertices. For example,--- @pathFromVertices [(1,3), (4,4), (6,5)]@ describes the path with--- two segments which starts at (1,3), has a corner at (4,4), and--- ends at (6,5). Note, however, that the vertices themselves are--- not significant, only the distances between them. That is,--- @pathFromVertices [(0,1), (3,2), (5,3)]@ describes exactly the--- same path.-pathFromVertices :: [Point] -> Path-pathFromVertices [] = emptyPath-pathFromVertices vs = pathDeriv vs---- | Concatenate two open paths into a single open path consisting of--- the first followed by the second.-pathConcat :: Path -> Path -> Path-pathConcat (Path _ es1) (Path _ es2) = Path Open (es1 ++ es2)---- | Create a closed path (by connecting the first and last points in--- the path).-closed :: Path -> Path-closed (Path _ vs) = Path Closed vs---- | Determine whether a 'Path' is closed or open.-isClosed :: Path -> Bool-isClosed (Path Closed _) = True-isClosed _ = False---- | Rotate a path by a fraction of a circle. @rotPath d@ rotates--- paths by an angle of @d*2*pi@ radians. Note that creating a--- 'Diagram' from a 'Path' (using 'straight' or 'curved' or some--- other such function) and then applying 'rotate' to it is--- different than first applying 'rotPath' to the 'Path' before--- making it into a 'Diagram'. In the latter case, the bounding box--- will be correct, whereas in the former case, the bounding box--- will still correspond to the unrotated version of the path.-rotPath :: Double -> Path -> Path-rotPath d (Path clsd ps) = Path clsd (map rot ps)- where ang = d*2*pi- ca = cos ang- sa = sin ang- rot (x,y) = (x * ca - y * sa, x * sa + y * ca)---- | Compute the size of a bounding box for the given 'Path', and the--- | offset of the starting vertex from the center.-pathSizeAndOffset :: Path -> (Vec,Point)-pathSizeAndOffset p = case pathInt (0,0) p of- [] -> ((0,0),(0,0))- ps -> ((xmax - xmin, ymax - ymin), ((-xmax - xmin)/2, (-ymax - ymin)/2))- where (xs,ys) = unzip ps- xmax = maximum xs- xmin = minimum xs- ymax = maximum ys- ymin = minimum ys---- | Render a path using a particular style in the Cairo rendering monad.-renderPath :: PathStyle -> Path -> C.Render ()-renderPath Straight = renderPathStraight-renderPath (Bezier d) = renderPathBezier d---- | Render a path using straight line segments.-renderPathStraight :: Path -> C.Render ()-renderPathStraight p@(Path clsd vs) = do- let (_,offs) = pathSizeAndOffset p -- not nice to recalculate this,- -- but oh well-- uncurry C.moveTo offs -- move to the start- mapM_ (uncurry C.relLineTo) vs -- draw all the segments- when (clsd==Closed) $ C.closePath -- maybe close the path---- | Render a path using Bezier curves. The first parameter--- determines what fraction of the path segments will be rounded off--- with curves; the remainder of the segments will be drawn with--- straight lines.-renderPathBezier :: Double -> Path -> C.Render ()-renderPathBezier _ (Path _ []) = return ()-renderPathBezier d p@(Path clsd segs) | d > 1 = renderPathBezier 1 p- | d < 0 = renderPathBezier 0 p- | otherwise = do- let (_,offs) = pathSizeAndOffset p- segcls = ((-1)*.) . last $ pathInt (0,0) p- isClsd = (clsd == Closed)-- uncurry C.moveTo offs -- move to the first path vertex-- -- move to start of the first straight segment- -- (draw a line if not closed)- uncurry (if' isClsd C.relMoveTo C.relLineTo) ((d/2) *. head segs)-- -- draw (straight, curved) pairs along path- mapM_ (drawCurveSegment d) (zip segs (tail segs))-- -- if closed path, we still need to draw- -- two more (straight, curved) pairs:- -- one for last segment + closing- -- segment, one for closing segment +- -- first segment- if isClsd- then do- drawCurveSegment d (last segs, segcls)- drawCurveSegment d (segcls, head segs)- else -- otherwise, just finish off the last- -- segment with a straight line- uncurry C.relLineTo ((1 - d/2) *. last segs)--if' :: Bool -> a -> a -> a-if' True x _ = x-if' False _ x = x---- | Given a fraction specifying which part of the segments should be--- rounded off, and two segments, draw the straight portion of the--- first segment and the curve between the first and second--- segments, using the shared vertex as a control point.-drawCurveSegment :: Double -> (Vec,Vec) -> C.Render ()-drawCurveSegment d (v1, v2) = do- let s = 1 - d- uncurry C.relLineTo $ s *. v1-- let ctrl@(ctrlx, ctrly) = (d/2) *. v1- let (endx, endy) = ctrl .+. ((d/2) *. v2)- C.relCurveTo ctrlx ctrly ctrlx ctrly endx endy
− Graphics/Rendering/Diagrams/Shapes.hs
@@ -1,229 +0,0 @@--------------------------------------------------------------------------------- |--- Module : Graphics.Rendering.Diagrams.Shapes--- Copyright : (c) Brent Yorgey 2008--- License : BSD-style (see LICENSE)--- Maintainer : byorgey@gmail.com--- Stability : experimental--- Portability : portable------ Primitive shapes out of which 'Diagram's can be built, implemented--- via instances of 'ShapeClass'.----------------------------------------------------------------------------------module Graphics.Rendering.Diagrams.Shapes- ( circle- , arc-- , regPolyPath- , regPoly- , rotRegPoly-- , rect- , rectPath- , roundRect- , roundRectF-- , straight- , curved-- , textPath-- , rawCairo-- ) where--import Graphics.Rendering.Diagrams.Types-import Graphics.Rendering.Diagrams.Attributes (scale)-import Graphics.Rendering.Diagrams.Paths--import qualified Graphics.Rendering.Cairo as C-import qualified Graphics.Rendering.Cairo.Internal as CI-import Control.Arrow ((&&&))-import Control.Monad.Reader-import System.IO.Unsafe (unsafePerformIO)-import Control.Exception (bracket)---- | Draw the shape defined by the current cairo path, using the--- current fill color, stroke color, and stroke width settings.-draw :: DiaRenderM ()-draw = do c $ C.save- (rf,gf,bf,af) <- asks (colorToRGBA . envFillColor)- c $ C.setSourceRGBA rf gf bf af- c $ C.fillPreserve-- (rs,gs,bs,as) <- asks (colorToRGBA . envStrokeColor)- c $ C.setSourceRGBA rs gs bs as- sw <- asks envStrokeWidth- c $ fmap dist (C.deviceToUserDistance sw 0) >>= C.setLineWidth- c $ C.stroke- c $ C.restore- where dist (x,y) = sqrt (x*x + y*y)---- | 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 = 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- shapeSize (PathShape _ p) = fst $ pathSizeAndOffset p- renderShape (PathShape style p) = c (renderPath style p) >> draw---- | @straight@ creates a 'Diagram' from a path, by drawing straight--- lines along the path edges.-straight :: Path -> Diagram-straight = Prim . Shape . PathShape Straight---- | @curved d p@ is a curved path which follows generally the path--- @p@. The parameter @d@ specifies the amount of corner rounding.--- In particular, @d@ should be a value between 0 and 1, which--- specifies what fraction of the path segments should be rounded--- off with bezier curves, using the path vertices as control--- points. Thus @d = 0@ produces the polygonal path itself, with no--- curved segments; @d = 1@ produces a continuously curving path--- tangent to the midpoints of the path segments; and intermediate--- values of @d@ interpolate between the two. The curved path--- produced will be everywhere differentiable as long as @d > 0@.--- If the path is not closed, the curve will begin and end at the--- first and last path vertices (no rounding will take place at--- these vertices).-curved :: Double -> Path -> Diagram-curved d = Prim . Shape . PathShape (Bezier d)---- | @regPolyPath n r@ is an open path corresponding to a regular--- polygon, with the first vertex oriented along the positive--- x-axis and proceeding clockwise.-regPolyPath :: Int -> Double -> Path-regPolyPath n r = pathFromVertices verts- where verts = map (((*r) . cos) &&& ((*r) . sin))- [0,2*pi/nd .. (nd-1)*2*pi/nd]- nd = fromIntegral n---- | @regPoly n r@ is a regular n-gon, with a circumcircle of radius--- @r@. One vertex is oriented along the positive x-axis.-regPoly :: Int -> Double -> Diagram-regPoly n r = straight . closed $ regPolyPath n r---- | @rotRegPoly n r a@ is the same as @'regPoly' n r@ but rotated--- through an angle of @a*2*pi@ radians (i.e., @a@ represents a--- fraction of an entire revolution). This is different than--- @'rotate' a $ 'regPoly' n r@; @rotRegPoly@ will adjust the--- bounding box correctly (using 'rotPath'), whereas the--- construction using @rotate@ will still have a bounding box--- corresponding to the unrotated polygon.-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---- | @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 = straight $ rectPath w 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)))---- | @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 f) = do- let (x,y) = (w/2, h/2)- 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- C.lineTo (x) (y-r)- C.arc (x-r) (y-r) r 0 (pi/2)- C.lineTo (r-x) (y)- C.arc (r-x) (y-r) r (pi/2) pi- C.closePath- draw---- | @roundRect w h@ is a rectangle of width @w@ and height @h@ with--- 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 (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- shapeSize t = (x,y)- where x = C.textExtentsWidth e + C.textExtentsXbearing e- y = C.fontExtentsHeight f- (f,e) = unsafeExtents t- renderShape (Text s t) = do- c $ do C.setFontSize s- (x,y) <- C.getCurrentPoint- te <- C.textExtents t- fe <- C.fontExtents- C.moveTo- (x - (C.textExtentsWidth te/2) - C.textExtentsXbearing te)- (y + (C.fontExtentsHeight fe/2) - C.fontExtentsDescent fe)- C.textPath t- draw--{-# NOINLINE unsafeExtents #-}-unsafeExtents :: Text -> (CI.FontExtents, CI.TextExtents)-unsafeExtents (Text s t) = unsafePerformIO $ do- bracket- (CI.create =<< C.createImageSurface C.FormatARGB32 1 1)- (CI.destroy)- (\cxt -> do CI.setFontSize cxt s- te <- CI.textExtents cxt t- fe <- CI.fontExtents cxt- return (fe, te))---- | @textPath s t@ is a string of text @t@ at size @s@,--- represented as an outline with separate stroke and fill.-textPath :: Double -> String -> Diagram-textPath s t = Prim (Shape (Text s t))--data RawCairo = RawCairo Point (C.Render ())-instance ShapeClass RawCairo where- shapeSize (RawCairo s _) = s- renderShape (RawCairo _ r) = c r---- | @rawCairo s r@ is a diagram with bounding box size @s@, rendered--- by executing Cairo 'Render' action @r@. Import--- "Graphics.Rendering.Cairo" to access Cairo operations.-rawCairo :: Point -> C.Render () -> Diagram-rawCairo s r = Prim (Shape (RawCairo s r))
− Graphics/Rendering/Diagrams/Types.hs
@@ -1,277 +0,0 @@-{-# LANGUAGE ExistentialQuantification, GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleInstances #-}--------------------------------------------------------------------------------- |--- Module : Graphics.Rendering.Diagrams.Types--- Copyright : (c) Brent Yorgey 2008--- License : BSD-style (see LICENSE)--- Maintainer : byorgey@gmail.com--- Stability : experimental--- Portability : portable------ Type definitions and convenience functions for--- "Graphics.Rendering.Diagrams", an embedded domain-specific language--- (EDSL) for creating simple diagrams.-----------------------------------------------------------------------------------module Graphics.Rendering.Diagrams.Types- (-- -- * Primitive types-- Diagram(..)-- , Color(..), SomeColor(..)- , Point, Vec- , (*.), (.+.), (.-.), (.*.)-- , Path(..)- , PathType(..)- , PathStyle(..)-- -- * Shapes, attributes, and layouts-- , ShapeClass(..), Shape(..)- , AttrClass(..), Attr(..)- , LayoutClass(..), Layout(..)-- -- * Rendering-- , DiaRenderEnv(..)- , defaultDiaRenderEnv- , setEnvFillColor, setEnvStrokeColor, setEnvStrokeWidth- , DiaRenderM(..)- , runDiaRenderM- , c-- , SizeSpec(..)- , OutputType(..)-- ) where--import qualified Graphics.Rendering.Cairo as C-import Control.Monad.Reader-import Data.Colour-import qualified Data.Colour.SRGB as RGB---- Diagrams -------------------------------------------------------------- | 'Diagram' is the core data type which describes a diagram.--- 'Diagram's may be constructed, transformed, combined, and--- ultimately rendered as an image.-data Diagram = Empty -- ^ The empty diagram- | Prim Shape -- ^ A primitive shape- | Ann Attr Diagram -- ^ An annotated diagram- | Compound Layout -- ^ A compound diagram- | Union [Diagram] -- ^ A fully processed compound- -- diagram, ready for rendering- | Sized Point Diagram- -- ^ An explicitly sized diagram whose bounding box- -- takes up a particular amount of space.---- Colors ---------------------------------------------------------------- | The 'Color' type class encompasses color representations which--- can be used by the Diagrams library; that is, every function in--- the Diagrams library which expects a color can take any type--- which is an instance of 'Color'. Instances are provided for both--- the 'Data.Colour.Colour' and 'Data.Colour.AlphaColour' types from--- the "Data.Colour" library.-class Color c where- colorToRGBA :: c -> (Double,Double,Double,Double)---- | Existential wrapper for instances of the 'Color' class.-data SomeColor = forall c. Color c => SomeColor c---- Note: we would like to just be able to say 'instance Color (Colour--- Double)' and so on, but the problem is that the named color--- constants in Data.Colour.Names are polymorphic with type (Floating--- a, Ord a) => Colour a, so trying to pass one of these constants to--- a function like 'lc' gives an error that there is no instance for--- Color (Colour a). Adding a type annotation like 'lc (black ::--- Colour Double)' works, but this is a pain for the user. The--- (admittedly hackish) solution is to make general instances which--- 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.--instance (Floating a, Real a) => Color (Colour a) where- colorToRGBA col = (r,g,b,1)- 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 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 | alphaChannel ac == 0 = ac `over` black- | otherwise = darken (recip (alphaChannel ac)) (ac `over` black)---- Points ---------------------------------------------------------------- | Basic 2D points/vectors.-type Point = (Double,Double)-type Vec = Point---- | Scalar multiplication.-(*.) :: Double -> Point -> Point-s *. (x,y) = (s*x, s*y)---- | Elementwise addition, subtraction and multiplication for 'Point's.-(.+.), (.-.), (.*.) :: Point -> Point -> Point-(x1,y1) .+. (x2,y2) = (x1 + x2, y1 + y2)-(x1,y1) .*. (x2,y2) = (x1 * x2, y1 * y2)-a .-. b = a .+. ((-1) *. b)---- Paths ----------------------------------------------------------------- | A path can be open (normal) or closed (first and last vertices--- connected automatically).-data PathType = Open | Closed- deriving (Eq, Show, Read)---- | A path is a series of edges which can be stroked, filled, etc.--- It can be either open (the default) or closed (i.e. the first and--- last vertices are connected).-data Path = Path PathType- [Vec]- deriving (Eq, Show, Read)---- | The styles in which a path can be rendered.-data PathStyle = Straight | Bezier Double deriving (Eq, Show, Read)---- Attributes ------------------------------------------------------------ | Existential wrapper type for attributes.-data Attr = forall a. AttrClass a => Attr a---- | Attributes which can be applied as annotations to a 'Diagram',--- and change the way the 'Diagram' is interpreted or rendered.--- Every attribute must be an instance of 'AttrClass'.-class AttrClass a where-- -- | Given an attribute and the size of the diagram to which it is- -- an annotation, return a new size for the diagram. The default- -- implementation is to simply return the size unchanged.- attrSize :: a -> Point -> Point- attrSize _ p = p-- -- | In order to implement this attribute, 'renderAttr' may perform- -- an action in the DiaRenderM monad, and return a function which- -- produces a local modification to the render environment. The- -- change produced by this function will only remain in effect- -- for any sub-diagrams, and the environment will return to its- -- former state afterwards.- renderAttr :: a -> DiaRenderM (DiaRenderEnv -> DiaRenderEnv)---- Shapes ---------------------------------------------------------------- | Existential wrapper type for shapes.-data Shape = forall s. ShapeClass s => Shape s---- | The primitive shapes which can be used to build up a diagram.--- Every primitive shape must be an instance of 'ShapeClass'.------ Given a shape @s@, if @shapeSize s@ evaluates to @(w,h)@, then--- the drawing rendered by @renderShape s@ should fit within a @w@--- by @h@ rectangle centered at the origin.------ You can create your own shape primitives by creating a new data--- type and making it an instance of 'ShapeClass'. If you do so,--- you must be sure that your 'ShapeClass' instance satisfies the--- law described above, on which the rendering engine relies in--- order to compute the proper positions for objects in a diagram.--- Otherwise, instances of your object in a diagram may extend--- outside the boundaries of the rendered image, or inadvertently--- overlap or be overlapped by other diagram elements. Of course,--- you are free to ignore this \"law\" as well; it will cause--- unexpected output at worst, and at best you may find some clever--- way to bend the system to your will. =)----class ShapeClass s where-- -- | Calculate the size (the dimensions of a bounding box centered- -- at the origin) of a shape.- shapeSize :: s -> Point-- -- | Calculate a cairo Render action to render a shape.- renderShape :: s -> DiaRenderM ()---- Layouts --------------------------------------------------------------- | An existential wrapper type for layouts. A layout consists of a--- (possibly parameterized) layout type, along with a container of--- 'Diagram's.-data Layout = forall l f. (LayoutClass l f) => Layout l (f Diagram)---- | All layouts must be instances of 'LayoutClass', along with an--- appropriate container type which must be an instance of Functor.-class (Functor f) => LayoutClass l f where- -- | Given a layout and a container of @(size, diagram)@ pairs (which- -- have already had all subdiagrams appropriately positioned),- -- compute the overall bounding box size for this layout, as well- -- as a list of positioned subdiagrams.- layoutSizeAndPos :: l -> f (Point,Diagram) -> (Point, [Diagram])---- Rendering ------------------------------------------------------------- | An environment containing additional parameters to be made--- available while rendering, which for one reason or another are--- not or cannot be provided by the cairo 'Render' monad itself.--- For example, cairo only tracks one current color, so we must--- track a fill color and stroke color separately.-data DiaRenderEnv = DREnv { envFillColor :: SomeColor- , envStrokeColor :: SomeColor- , envStrokeWidth :: Double- }--setEnvFillColor :: Color c => c -> DiaRenderEnv -> DiaRenderEnv-setEnvFillColor col d = d { envFillColor = SomeColor col }--setEnvStrokeColor :: Color c => c -> DiaRenderEnv -> DiaRenderEnv-setEnvStrokeColor col d = d { envStrokeColor = SomeColor col }--setEnvStrokeWidth :: Double -> DiaRenderEnv -> DiaRenderEnv-setEnvStrokeWidth w d = d { envStrokeWidth = w }---- | The default rendering environment: transparent fill with 1-pixel--- black strokes.-defaultDiaRenderEnv :: DiaRenderEnv-defaultDiaRenderEnv = DREnv { envFillColor = SomeColor (transparent :: AlphaColour Double)- , envStrokeColor = SomeColor (black :: Colour Double)- , envStrokeWidth = 1- }---- | The custom rendering monad: ReaderT 'DiaRenderEnv' on top of--- cairo's Render monad.-newtype DiaRenderM a = DRM (ReaderT DiaRenderEnv C.Render a)- deriving (Functor, Monad, MonadReader DiaRenderEnv)---- | Run a 'DiaRenderM' action, given an initial rendering--- environment, to produce a cairo @Render@ action.-runDiaRenderM :: DiaRenderM a -> DiaRenderEnv -> C.Render a-runDiaRenderM (DRM m) e = runReaderT m e---- | Lift a cairo @Render@ action into a 'DiaRenderM' action.-c :: C.Render a -> DiaRenderM a-c = DRM . lift---- | A specification of the size of a rendered 'Diagram'.-data SizeSpec = Width Double -- ^ an explicit width; the height is determined automatically- | Height Double -- ^ an explicit height; the width is determined automatically- | Auto -- ^ determine the size automatically- -- (do not scale)---- | The supported output file types for rendered diagrams.-data OutputType = PNG | PS | PDF | SVG
LICENSE view
@@ -1,27 +1,30 @@-Copyright (c) Brent Yorgey 2008-2009+Copyright (c)2011, Brent Yorgey All rights reserved. Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions-are met:-1. Redistributions of source code must retain the above copyright- notice, this list of conditions and the following disclaimer.-2. Redistributions in binary form must reproduce the above copyright- notice, this list of conditions and the following disclaimer in the- documentation and/or other materials provided with the distribution.-3. Neither the name of the author nor the names of other contributors- may be used to endorse or promote products derived from this software- without specific prior written permission.+modification, are permitted provided that the following conditions are met: -THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE-ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF-SUCH DAMAGE.+ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Brent Yorgey nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
− README
@@ -1,71 +0,0 @@--NOTE: This package is DEPRECATED. Instead, please see the-diagrams-core, diagrams-lib, and diagrams-cairo packages. The rest of-the README is retained for historical purposes.-----------------------------------------------------------------------------Graphics.Rendering.Diagrams provides an embedded domain-specific-language (EDSL) for creating simple graphics in a compositional style.--For some examples of use, see http://code.haskell.org/diagrams/ .----------------------------------------------------------------------------To install the Diagrams library:--1. Get the dependencies-- The diagrams library uses Haskell bindings to the Cairo vector- graphics library. In order to build the diagrams library, you- will first need the following:-- * The Cairo library itself. This is probably available through- your system's package manager and may even already be installed.- On Ubuntu, for example, it is available from the 'libcairo'- package.-- * The Haskell cairo bindings, which are packaged as part of- gtk2hs. Unfortunately, for various technical reasons, gtk2hs is- not cabalized and cannot be downloaded and installed from- Hackage. To get gtk2hs you will need to go to the gtk2hs- website (http://www.haskell.org/gtk2hs/) and follow the- instructions to download and build it.-- * The colour library, which is available from Hackage. If you use- the cabal-install build option described below, the colour- library will be downloaded and installed for you automatically.--2. Build-- * Option 1: use cabal-install-- If you have cabal-install, *after* installing gtk2hs, you can- install diagrams and the remaining dependencies with- cabal-install:-- cabal install diagrams-- Optionally, you can also pass options such as --user- --prefix=$HOME to install locally.-- * Option 2: manual build-- Once all the dependencies are built and installed, you can build- and install diagrams as follows:- - runhaskell Setup.lhs configure --prefix=$HOME --user- runhaskell Setup.lhs build- runhaskell Setup.lhs install-- (Optionally, you can omit the --prefix and --user arguments to the- configure step, and run the install step with 'sudo' in order to- install the library systemwide.)--3. Building Haddock documentation (recommended)-- runhaskell Setup.lhs haddock-- Once the documentation has been built, you can access it by - pointing your browser to dist/doc/html/diagrams/index.html.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
− Setup.lhs
@@ -1,3 +0,0 @@-#!/usr/bin/env runhaskell-> import Distribution.Simple-> main = defaultMain
diagrams.cabal view
@@ -1,38 +1,18 @@ Name: diagrams-Version: 0.2.2.3-Stability: unsupported-Description: An embedded domain-specific language (EDSL) for - creating simple diagrams, built on top of the Cairo- rendering engine. NOTE: This package is deprecated,- see the diagrams-core, diagrams-lib, and diagrams-cairo- packages instead.-Homepage: http://code.haskell.org/diagrams-Synopsis: An EDSL for creating simple diagrams+Version: 0.3+Synopsis: Embedded domain-specific language for declarative vector graphics+Description: Diagrams is an embedded domain-specific langauge for+ declarative vector graphics. This package is+ just a wrapper that depends on the diagrams-core,+ diagrams-lib, and diagrams-cairo packages.+Homepage: http://projects.haskell.org/diagrams License: BSD3 License-file: LICENSE-Extra-source-files: README,CHANGES,example/*.hs Author: Brent Yorgey-Maintainer: byorgey@gmail.com+Maintainer: byorgey@cis.upenn.edu Category: Graphics Build-type: Simple-Cabal-version: >= 1.6-Tested-with: GHC==6.12.1, GHC==6.10.4, GHC==7.0.1--flag testing- description: Testing mode- default: False+Cabal-version: >=1.2 -library- ghc-options: -Wall- if flag(testing)- ghc-options: -Werror- Build-Depends: base >= 2 && < 5, mtl >= 2.0 && < 2.1,- containers >= 0.2 && < 0.5,- cairo >= 0.9 && < 0.13, colour >= 2.2.1 && < 2.4- Exposed-Modules: Graphics.Rendering.Diagrams,- Graphics.Rendering.Diagrams.Types,- Graphics.Rendering.Diagrams.Paths,- Graphics.Rendering.Diagrams.Shapes,- Graphics.Rendering.Diagrams.Attributes,- Graphics.Rendering.Diagrams.Layouts,- Graphics.Rendering.Diagrams.Engine+Library+ Build-depends: diagrams-core, diagrams-lib, diagrams-cairo
− example/CloudPacker.hs
@@ -1,63 +0,0 @@-module CloudPacker (diagram) where---- Cobbled together from snippets and ideas by Chris Done--- http://github.com/chrisdone/wordcloud/--import Control.Arrow ((&&&), (***), first)-import Control.Monad (liftM)-import Data.Char (isLetter, toLower)-import Data.List (init, sortBy, foldl')-import Data.Maybe (listToMaybe)-import Data.Ord (comparing)-import qualified Data.Map as M--import Graphics.Rendering.Diagrams-import Graphics.Rendering.Diagrams.Engine (sizeAndPos)--type Point = (Int,Int)-type Size = Point-type Rect = (Point,Point)---- Arrange the text boxes on the page, starting with the--- largest and placing each one in the first gap available.-diagram :: [Diagram] -> Diagram-diagram = arrange . uncurry zip . (f &&& id)- where f = map toPoint . foldl addToLayout [] . map size--arrange :: [(Point,Diagram)] -> Diagram-arrange = positionA left top . map (first (fromIntegral *** fromIntegral))--addToLayout :: [Rect] -> Size -> [Rect]-addToLayout [] sz = let (w,h) = sz in [toRect (-w`div`2,-h`div`2) sz]-addToLayout rs sz = maybe rs (\p -> rs ++ [toRect p sz]) $ listToMaybe $ bestfits sz rs--bestfits :: Size -> [Rect] -> [Point]-bestfits sz rs = concatMap (\r -> aroundRect sz r rs) rs--aroundRect :: Size -> Rect -> [Rect] -> [Point]-aroundRect sz r rs = filter valid (potentials sz r)- where valid pt = not (any (overlaps (toRect pt sz)) rs)--toRect :: Point -> Size -> Rect-toRect (x,y) (w,h) = ((x,y),(x+w,y+h))-toPoint :: Rect -> Point-toPoint = fst---- Produces candidates in anti-clockwise order.-potentials :: Size -> Rect -> [Point]-potentials (w,h) ((x1,y1),(x2,y2)) = concat [leftside,rightside,bottomside,topside]- where leftside = init $ map ((,) x) [y..y2]- rightside = init $ map ((,) x2) [y2,y2-1..y]- bottomside = init $ map (flip (,) y2) [x..x2]- topside = init $ map (flip (,) y) [x2,x2-1..x]- (x,y) = (x1 - w, y1 - h)--overlaps :: Rect -> Rect -> Bool-overlaps r1 r2 = r1 `overlapX` r2 && r1 `overlapY` r2-overlapX :: Rect -> Rect -> Bool-overlapX ((x1,_),(x1',_)) ((x2,_),(x2',_)) = if x1 < x2 then x1' > x2 else x2' > x1-overlapY :: Rect -> Rect -> Bool-overlapY ((_,y1),(_,y1')) ((_,y2),(_,y2')) = if y1 < y2 then y1' > y2 else y2' > y1--size :: Diagram -> Size-size = (ceiling *** ceiling) . fst . sizeAndPos
− example/alignment.hs
@@ -1,19 +0,0 @@-{-# LANGUAGE ParallelListComp #-}-module Main where--import Graphics.Rendering.Diagrams-import Data.Colour.SRGB.Linear--colors = [ rgb r 0 0.5 | r <- [0.2, 0.4 .. 1.0] ]--circles = [ fc c $ circle r | c <- colors | r <- [5,4..1] ]--alignments = [ [ (ha,va) | ha <- [left, hcenter, right] ]- | va <- [top, vcenter, bottom] ]--dia = vsep 2 .- map (hsep 2) .- map (map (\(h,v) -> unionA h v circles)) $- alignments--main = do renderAs PNG "alignment.png" (Width 500) dia
− example/dragon.hs
@@ -1,29 +0,0 @@-{- Heighway dragon. See http://en.wikipedia.org/wiki/Dragon_curve. -}-module Main where--import Graphics.Rendering.Diagrams-import Control.Monad.State-import Data.Maybe--dragonStr :: Int -> String-dragonStr 0 = "FX"-dragonStr n = concatMap rules $ dragonStr (n-1)- where rules 'X' = "X+YF+"- rules 'Y' = "-FX-Y"- rules c = [c]--strToPath :: String -> Path-strToPath s = pathFromVectors . catMaybes $ evalState c (0,-1)- where c = mapM exec s- exec 'F' = Just `fmap` get- exec '-' = modify left >> return Nothing- exec '+' = modify right >> return Nothing- exec _ = return Nothing- left (x,y) = (-y,x)- right (x,y) = (y,-x)--dragon :: Int -> Diagram-dragon = lc red . curved 0.8 . strToPath . dragonStr--main = renderAs PNG "dragon.png" (Height 500) (dragon 14)-
− example/ferrers.hs
@@ -1,26 +0,0 @@-module Main where--import Graphics.Rendering.Diagrams-import Graphics.Rendering.Diagrams.Engine-import Graphics.Rendering.Diagrams.Types--import Data.List-import Data.Function--partitions :: Int -> [[Int]]-partitions n = partitions' n n- where partitions' 0 _ = [[]]- partitions' n 1 = [replicate n 1]- partitions' n k = do s <- [k,k-1..1]- p <- partitions' (n-s) (min (n-s) s)- return (s:p)--parts = groupBy ((==) `on` head) . partitions--ferrersTableaux :: Int -> Diagram-ferrersTableaux = vsep 20 . map (hsep 20 . map ferrers) . parts--ferrers :: [Int] -> Diagram-ferrers = hsep 3 . map (vsep 3 . flip replicate (circle 10))--main = renderAs PNG "ferrers.png" (Height 300) (lw 0 $ fc black $ ferrersTableaux 6)
− example/fontlist.hs
@@ -1,14 +0,0 @@-module Main where--import System.Cmd.Utils (pipeLinesFrom)--import Graphics.Rendering.Diagrams--import CloudPacker (diagram)--main = do- (ph, ls) <- pipeLinesFrom "fc-list" []- let fontnames = map (takeWhile (\c -> c/=':' && c/=',')) ls- renderAs PNG "fontlist.png" Auto $ diagram $ map mkText $ take 30 fontnames--mkText name = lw 0 $ fc black $ tf name $ textPath 12 name
− example/ford.hs
@@ -1,40 +0,0 @@-module Main where--import Graphics.Rendering.Diagrams--import Data.Ratio-import System.Random--(<+>) :: Rational -> Rational -> Rational-r1 <+> r2 = (numerator r1 + numerator r2) % (denominator r1 + denominator r2)--farey :: Integer -> [Rational]-farey 0 = [0%1, 1%1]-farey n = filter ((<=n) . denominator) $ insertMediants (farey (n-1))--insertMediants :: [Rational] -> [Rational]-insertMediants [] = []-insertMediants [x] = [x]-insertMediants (x:y:zs) = x : (x <+> y) : insertMediants (y:zs)--fordCircles :: Integer -> [Diagram]-fordCircles n = map toCircle $ farey n--toCircle r = translateX r' $- circle (1 / (2 * d'^2))- where r' = fromRational r- d' = fromIntegral (denominator r)--dia :: [Color] -> Diagram-dia colors = view (0,0) (1,1/2) $- unionA hcenter bottom $- zipWith fc colors (fordCircles 20)--randomColors :: [Double] -> [Color]-randomColors (r:g:b:ds) = rgb r g b : randomColors ds--main :: IO ()-main = do- g <- newStdGen- let rs = randoms g- renderAs PNG "ford.png" (Width 500) (dia $ randomColors rs)
− example/logo.hs
@@ -1,27 +0,0 @@-import Graphics.Rendering.Diagrams-import Data.Colour.SRGB--logo :: Diagram-logo = pad 3 3 $ hsepA 1 bottom [d,i,a,hspace (-1.7),g,r,a,m,s]--myGreen = sRGB 0 0.8 0--d,i,a,g,r,m,s :: Diagram--d = (fc red $ arc 4 (3/4) (1/4)) ## (fc black $ rect 0.5 8)--i = fc yellow $ rect 1 5--a = lc blue . lw 2 . fc myGreen $ rotRegPoly 3 2.5 (1/12)--g = fc aliceblue . dashing [0.1,0.1] 0 $ (arc 3 0 (1/2) ## arc 3 (1/4) (3/4))--r = curved 1 $ pathFromVertices [(0,6), (0,0), (3,1.5), (0.5, 3), (3,6)]--m = fc orange . lw 3 . lineJoin LineJoinRound $ halfM <> halfM2- where halfM = straight . closed $ pathFromVertices [(0,4), (0,0), (2,4)]- halfM2 = straight . closed $ pathFromVertices [(2,4), (2,0), (0,4)]--s = lw 5 . lc blue $ arc 1.5 (1/4) (7/8) // arc 1.5 (3/4) (3/8)--main = renderAs PNG "logo.png" (Height 100) logo
− example/permutations.hs
@@ -1,27 +0,0 @@-module Main where-import Graphics.Rendering.Diagrams-import Data.Colour.SRGB.Linear--second f (x,y) = (x,f y)--select :: [a] -> [(a,[a])]-select [] = []-select (x:xs) = (x,xs) : map (second (x:)) (select xs)--permutations :: [a] -> [[a]]-permutations [] = [[]]-permutations xs = do (e, rest) <- select xs- map (e:) $ permutations rest--dia :: Diagram-dia = arrange $ map colorsToStrip (permutations [red, yellow, blue, green'])- where green' = rgb 0 1 0--arrange :: [Diagram] -> Diagram-arrange = hsep 10 . map (vsep 5) . groups- where groups = takeWhile (not . null) . map (take 6) . iterate (drop 6)--colorsToStrip :: Color c => [c] -> Diagram-colorsToStrip = hcat . map (\c -> fc c $ rect 10 10)--main = renderAs PNG "permutations.png" (Width 300) dia
− example/sierpinski.hs
@@ -1,12 +0,0 @@-module Main where--import Graphics.Rendering.Diagrams--sierpinski :: Int -> Diagram-sierpinski 0 = fc black $ lw 0 $ rotRegPoly 3 1 (-1/4)-sierpinski n = vcatA hcenter [ s- , s <> s]- where s = sierpinski (n-1)--main = renderAs PNG "sierpinski.png" (Height 300) (sierpinski 6)-
− example/snellen.hs
@@ -1,13 +0,0 @@-module Main where--import Graphics.Rendering.Diagrams--main = renderAs PNG "snellen.png" (Width 400) snellen--snellen = vcatA hcenter $ zipWith text sizes letters--sizes = [36,24,18,12,9,6,5,4,3]-letters = ["A","D F","H Z P","T X U D","Z A D N H","P N T U H X"- ,"U A Z N F D T","N P H T A F X U","X D F H P T Z A N"- ,"F A X T D N H U P Z"]-
− example/wordcloud.hs
@@ -1,73 +0,0 @@-module Main where---- Cobbled together from snippets and ideas by Chris Done--- http://github.com/chrisdone/wordcloud/--import Control.Monad (liftM)-import Data.Char (isLetter, toLower)-import Data.List (sortBy, foldl')-import Data.Ord (comparing)-import qualified Data.Map as M--import System.Random (getStdGen, randomRs)-import System.Environment (getArgs)--import Graphics.Rendering.Diagrams-import Data.Colour (withOpacity)-import Data.Colour.SRGB.Linear (rgb)--import CloudPacker (diagram)--type Weight = Int-type Word = String-type Histogram = [(Word,Weight)]-type Colour = [Double]---- Word histograms.----histogramByFreq :: [Word] -> String -> Histogram-histogramByFreq badws = list . table where- table = filterByGood badws . histogram . words . map toLetter- list = take 150 . sortBy (flip (comparing snd)) . M.toAscList--toLetter c | isLetter c = c- | otherwise = ' '--histogram = foldl' (flip $ flip (M.insertWith' $ const (+1)) 1) M.empty--filterByGood badws = M.filterWithKey (\x y -> goodWord x) where- goodWord [_] = False- goodWord w = not $ any (==(map toLower w)) badws -- No articles.--stopwords = words "import qualified hiding data newtype type deriving instance do if then else case of let where"---main = do- args <- getArgs- let input = case args of- "-":_ -> getContents- filename:_ -> readFile filename- _ -> readFile "wordcloud.hs"- weightedwords <- histogramByFreq stopwords `liftM` input- rands <- groupsOf 3 `liftM` randomRs (0,1) `liftM` getStdGen- let sizedwords = mkWords weightedwords rands- renderAs PNG "wordcloud.png" (Width 500) $ diagram sizedwords----- Sizing and colouring the text according to the--- weight given in the histogram.-mkWords :: Histogram -> [Colour] -> [Diagram]-mkWords wwds cols = zipWith (mkWord maxweight) wwds cols- where maxweight = snd $ head wwds--mkColour [r,g,b] a = rgb r g b `withOpacity` max a 0.1--mkWord :: Weight -> (Word,Weight) -> Colour -> Diagram-mkWord mx (s,w) col = fc c $ lw 0 $ tf "URW Bookman L" $ textPath sz s- where sz = fromIntegral w * 10- c = mkColour col (max 0.2 (fromIntegral w/fromIntegral mx))--groupsOf :: Int -> [a] -> [[a]]-groupsOf n [] = []-groupsOf n xs = let (grp, remainder) = splitAt n xs- in grp : groupsOf n remainder