diff --git a/CHANGELOG b/CHANGELOG
new file mode 100644
--- /dev/null
+++ b/CHANGELOG
@@ -0,0 +1,14 @@
+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/Graphics/Rendering/Diagrams.hs b/Graphics/Rendering/Diagrams.hs
--- a/Graphics/Rendering/Diagrams.hs
+++ b/Graphics/Rendering/Diagrams.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
-----------------------------------------------------------------------------
-- |
-- Module : Graphics.Rendering.Diagrams
@@ -8,7 +9,8 @@
-- Portability : portable
--
-- An embedded domain-specific language (EDSL) for creating simple
--- diagrams, built on top of the Cairo rendering engine.
+-- diagrams, illustrations, and other types of graphics, built on top
+-- of the Cairo rendering engine.
--
-----------------------------------------------------------------------------
@@ -26,9 +28,17 @@
-- ** Shapes
, circle
- , poly
, rect
+ , roundRect
+
+ , regPolyPath
+ , regPoly
+ , rotRegPoly
+
, shape
+ , rawCairo
+ , text
+ , textPath
-- ** Spacers
@@ -36,6 +46,18 @@
, vspace
, empty
+ -- ** Paths
+
+ , Path
+ , emptyPath
+ , pathFromVertices, pathFromVectors
+ , pathConcat
+ , closed, isClosed
+ , rotPath
+
+ , straight
+ , curved
+
-- * Combinators
-- $comb
@@ -53,11 +75,23 @@
, hdistrib, vdistrib
, hdistribA, vdistribA
+ , position, positionA
+
, VAlignment
, top, vcenter, bottom
, HAlignment
, left, hcenter, right
+ -- ** Complex layouts
+
+ , tree
+
+ -- ** Miscellaneous
+
+ , pad, padA
+ , showBBox, showBBoxes
+ , withSize
+
-- * Transformations
-- $transf
@@ -70,64 +104,71 @@
-- * Attributes
-- $attr
+ -- ** Colors
+ -- $color
+
+ , Color
+ , module Data.Colour.Names
, fillColor, fc
- , fillTransparency, ft
, lineColor, lc
+
+ -- ** Other attributes
+
, lineWidth, lw
- , Color
- , rgb
- , rgba
- , module Graphics.Rendering.Diagrams.Colors
+ , lineCap, LineCap(..)
+ , lineJoin, LineJoin(..)
+ , dashing
+ , typeface, tf
-- * Rendering
+ -- $render
- , renderToPng
- , compose
+ , renderAs
+ , 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.Colors
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 diagrams. It is compositional; starting
+(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; everything is relative. You cannot say \"this
- diagram should go at (2,1)\"; you can only say \"this diagram should
- go to the right of this other one\", or \"this diagram should go two
- units to the right and one unit above where it would otherwise
- be\".
+ 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
+ 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. Also, some shapes have
- non-obvious bounding boxes; for example, regular polygons have a
- bounding box that fits their circumcircle.
+ diagram itself ends up elsewhere. To visualize bounding boxes,
+ you can use the 'showBBox' and 'showBBoxes' functions.
- * The positive y-axis points downwards.
+ * The positive y-axis points downwards. This also means that
+ positive rotations are clockwise.
-For some simple examples, see
-.
+For some simple examples, see .
Enjoy! Please send comments, suggestions, bug reports, or patches to
-byorgey at gmail dot com.
+byorgey at cis dot upenn dot edu.
-}
@@ -139,6 +180,10 @@
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
@@ -160,23 +205,54 @@
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.
--- | XXX comment me
+-- | 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) d = Sized (x2-x1, y2-y1) . translate ((x1-x2)/2) ((y1-y2)/2) $ d
+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.
--- For a large list of predefined 'Color' values, see
--- "Graphics.Rendering.Diagrams.Colors".
--- | Render a diagram to a file in PNG format.
-renderToPng :: String -- ^ The name of the file to create.
- -> Int -- ^ The desired width of the image, in pixels.
- -> Int -- ^ The desired height of the image.
- -> Diagram -- ^ The diagram to render.
- -> IO ()
-renderToPng name w h dia = writePng name w h $
- compose (fromIntegral w) (fromIntegral h) dia
+-- $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. '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)
+
+-- | @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
diff --git a/Graphics/Rendering/Diagrams/Attributes.hs b/Graphics/Rendering/Diagrams/Attributes.hs
--- a/Graphics/Rendering/Diagrams/Attributes.hs
+++ b/Graphics/Rendering/Diagrams/Attributes.hs
@@ -12,11 +12,16 @@
--
-----------------------------------------------------------------------------
module Graphics.Rendering.Diagrams.Attributes
- ( fillColor, fc
- , fillTransparency, ft
+ ( 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
@@ -31,40 +36,38 @@
-- Fill color ----------------------
-- | Specify the default fill color for a 'Diagram'.
-newtype Fill = Fill Color deriving (Eq, Show, Read)
+newtype Fill = Fill SomeColor
instance AttrClass Fill where
- renderAttr (Fill f) = return (setEnvFillColor f)
+ 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 -> Diagram -> Diagram
-fillColor = Ann . Attr . Fill
+fillColor :: Color c => c -> Diagram -> Diagram
+fillColor = Ann . Attr . Fill . SomeColor
-- | 'fc' is provided as a convenient short synonym for 'fillColor'.
-fc :: Color -> Diagram -> Diagram
+fc :: Color c => c -> Diagram -> Diagram
fc = fillColor
-
-
-- Stroke color ----------------------
-- | Specify the default stroke color for a 'Diagram'.
-newtype Stroke = Stroke Color deriving (Eq, Show, Read)
+newtype Stroke = Stroke SomeColor
instance AttrClass Stroke where
- renderAttr (Stroke sc) = return (setEnvStrokeColor sc)
+ 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 -> Diagram -> Diagram
-lineColor = Ann . Attr . Stroke
+lineColor :: Color c => c -> Diagram -> Diagram
+lineColor = Ann . Attr . Stroke . SomeColor
-- | 'lc' is provided as a convenient short synonym for 'lineColor'.
-lc :: Color -> Diagram -> Diagram
+lc :: Color c => c -> Diagram -> Diagram
lc = lineColor
@@ -90,32 +93,20 @@
lw :: Double -> Diagram -> Diagram
lw = lineWidth
-
-
--- Transparency ------------------------------
-
-newtype FillTransparency = FT Double deriving (Eq, Show, Read)
-instance AttrClass FillTransparency where
- renderAttr (FT t) = return setFillAlpha
- where setFillAlpha env = env { envFillColor = newFillColor env }
- newFillColor env = RGBA r g b t
- where (RGBA r g b _) = envFillColor env
+-- Fonts -----------------------------
--- XXX improve this -- currently, you have to put it AFTER the color!
--- | Set the transparency used for the fill color, from 0 (completely
--- transparent) to 255 (completely opaque). Note that you can set
--- the alpha channel of the fill color using 'fillColor' combined
--- with 'rgba', but 'fillTransparency' allows you to set the alpha
--- channel independently of the color channels. This means you can
--- use it together with the colors defined in
--- "Graphics.Rendering.Diagrams.Colors".
-fillTransparency :: Int -> Diagram -> Diagram
-fillTransparency = Ann . Attr . FT . (/255) . fromIntegral
+-- | 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
--- | 'ft' is provided as a convenient short synonym for 'fillTransparency'.
-ft = fillTransparency
+-- | Change the default typeface to one named.
+typeface :: String -> Diagram -> Diagram
+typeface fontname = Ann (Attr (Typeface fontname))
--- XXX put a line transparency attribute here
+-- | Convenience function to change the typeface.
+tf :: String -> Diagram -> Diagram
+tf = typeface
-- Rotate ----------------------------
@@ -167,7 +158,7 @@
-- respectively.
newtype Scale = Scale Point deriving (Eq, Show, Read)
instance AttrClass Scale where
- attrSize (Scale k) s = k .* s
+ 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.
@@ -191,3 +182,49 @@
-- 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
diff --git a/Graphics/Rendering/Diagrams/Colors.hs b/Graphics/Rendering/Diagrams/Colors.hs
deleted file mode 100644
--- a/Graphics/Rendering/Diagrams/Colors.hs
+++ /dev/null
@@ -1,1338 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.Diagrams.Colors
--- Copyright : (c) Brent Yorgey 2008
--- License : BSD-style (see LICENSE)
--- Maintainer : byorgey@gmail.com
--- Stability : experimental
--- Portability : portable
---
--- Convenient pre-defined colors for "Graphics.Rendering.Diagrams", an
--- embedded domain-specific language (EDSL) for creating simple
--- diagrams. Color names and definitions pulled from X11\'s list of
--- colors.
---
------------------------------------------------------------------------------
-module Graphics.Rendering.Diagrams.Colors where
-
-import Graphics.Rendering.Diagrams.Types
-
-rgb' :: Int -> Int -> Int -> Color
-rgb' r g b = rgb (fromIntegral r / 255)
- (fromIntegral g / 255)
- (fromIntegral b / 255)
-
-snow :: Color
-snow = rgb' 255 250 250
-ghostWhite :: Color
-ghostWhite = rgb' 248 248 255
-whiteSmoke :: Color
-whiteSmoke = rgb' 245 245 245
-gainsboro :: Color
-gainsboro = rgb' 220 220 220
-floralWhite :: Color
-floralWhite = rgb' 255 250 240
-oldLace :: Color
-oldLace = rgb' 253 245 230
-linen :: Color
-linen = rgb' 250 240 230
-antiqueWhite :: Color
-antiqueWhite = rgb' 250 235 215
-papayaWhip :: Color
-papayaWhip = rgb' 255 239 213
-blanchedAlmond :: Color
-blanchedAlmond = rgb' 255 235 205
-bisque :: Color
-bisque = rgb' 255 228 196
-peachPuff :: Color
-peachPuff = rgb' 255 218 185
-navajoWhite :: Color
-navajoWhite = rgb' 255 222 173
-moccasin :: Color
-moccasin = rgb' 255 228 181
-cornsilk :: Color
-cornsilk = rgb' 255 248 220
-ivory :: Color
-ivory = rgb' 255 255 240
-lemonChiffon :: Color
-lemonChiffon = rgb' 255 250 205
-seashell :: Color
-seashell = rgb' 255 245 238
-honeydew :: Color
-honeydew = rgb' 240 255 240
-mintCream :: Color
-mintCream = rgb' 245 255 250
-azure :: Color
-azure = rgb' 240 255 255
-aliceBlue :: Color
-aliceBlue = rgb' 240 248 255
-lavender :: Color
-lavender = rgb' 230 230 250
-lavenderBlush :: Color
-lavenderBlush = rgb' 255 240 245
-mistyRose :: Color
-mistyRose = rgb' 255 228 225
-white :: Color
-white = rgb' 255 255 255
-black :: Color
-black = rgb' 0 0 0
-darkSlateGray :: Color
-darkSlateGray = rgb' 47 79 79
-darkSlateGrey :: Color
-darkSlateGrey = rgb' 47 79 79
-dimGray :: Color
-dimGray = rgb' 105 105 105
-dimGrey :: Color
-dimGrey = rgb' 105 105 105
-slateGray :: Color
-slateGray = rgb' 112 128 144
-slateGrey :: Color
-slateGrey = rgb' 112 128 144
-lightSlateGray :: Color
-lightSlateGray = rgb' 119 136 153
-lightSlateGrey :: Color
-lightSlateGrey = rgb' 119 136 153
-gray :: Color
-gray = rgb' 190 190 190
-grey :: Color
-grey = rgb' 190 190 190
-lightGrey :: Color
-lightGrey = rgb' 211 211 211
-lightGray :: Color
-lightGray = rgb' 211 211 211
-midnightBlue :: Color
-midnightBlue = rgb' 25 25 112
-navy :: Color
-navy = rgb' 0 0 128
-navyBlue :: Color
-navyBlue = rgb' 0 0 128
-cornflowerBlue :: Color
-cornflowerBlue = rgb' 100 149 237
-darkSlateBlue :: Color
-darkSlateBlue = rgb' 72 61 139
-slateBlue :: Color
-slateBlue = rgb' 106 90 205
-mediumSlateBlue :: Color
-mediumSlateBlue = rgb' 123 104 238
-lightSlateBlue :: Color
-lightSlateBlue = rgb' 132 112 255
-mediumBlue :: Color
-mediumBlue = rgb' 0 0 205
-royalBlue :: Color
-royalBlue = rgb' 65 105 225
-blue :: Color
-blue = rgb' 0 0 255
-dodgerBlue :: Color
-dodgerBlue = rgb' 30 144 255
-deepSkyBlue :: Color
-deepSkyBlue = rgb' 0 191 255
-skyBlue :: Color
-skyBlue = rgb' 135 206 235
-lightSkyBlue :: Color
-lightSkyBlue = rgb' 135 206 250
-steelBlue :: Color
-steelBlue = rgb' 70 130 180
-lightSteelBlue :: Color
-lightSteelBlue = rgb' 176 196 222
-lightBlue :: Color
-lightBlue = rgb' 173 216 230
-powderBlue :: Color
-powderBlue = rgb' 176 224 230
-paleTurquoise :: Color
-paleTurquoise = rgb' 175 238 238
-darkTurquoise :: Color
-darkTurquoise = rgb' 0 206 209
-mediumTurquoise :: Color
-mediumTurquoise = rgb' 72 209 204
-turquoise :: Color
-turquoise = rgb' 64 224 208
-cyan :: Color
-cyan = rgb' 0 255 255
-lightCyan :: Color
-lightCyan = rgb' 224 255 255
-cadetBlue :: Color
-cadetBlue = rgb' 95 158 160
-mediumAquamarine :: Color
-mediumAquamarine = rgb' 102 205 170
-aquamarine :: Color
-aquamarine = rgb' 127 255 212
-darkGreen :: Color
-darkGreen = rgb' 0 100 0
-darkOliveGreen :: Color
-darkOliveGreen = rgb' 85 107 47
-darkSeaGreen :: Color
-darkSeaGreen = rgb' 143 188 143
-seaGreen :: Color
-seaGreen = rgb' 46 139 87
-mediumSeaGreen :: Color
-mediumSeaGreen = rgb' 60 179 113
-lightSeaGreen :: Color
-lightSeaGreen = rgb' 32 178 170
-paleGreen :: Color
-paleGreen = rgb' 152 251 152
-springGreen :: Color
-springGreen = rgb' 0 255 127
-lawnGreen :: Color
-lawnGreen = rgb' 124 252 0
-green :: Color
-green = rgb' 0 255 0
-chartreuse :: Color
-chartreuse = rgb' 127 255 0
-mediumSpringGreen :: Color
-mediumSpringGreen = rgb' 0 250 154
-greenYellow :: Color
-greenYellow = rgb' 173 255 47
-limeGreen :: Color
-limeGreen = rgb' 50 205 50
-yellowGreen :: Color
-yellowGreen = rgb' 154 205 50
-forestGreen :: Color
-forestGreen = rgb' 34 139 34
-oliveDrab :: Color
-oliveDrab = rgb' 107 142 35
-darkKhaki :: Color
-darkKhaki = rgb' 189 183 107
-khaki :: Color
-khaki = rgb' 240 230 140
-paleGoldenrod :: Color
-paleGoldenrod = rgb' 238 232 170
-lightGoldenrodYellow :: Color
-lightGoldenrodYellow = rgb' 250 250 210
-lightYellow :: Color
-lightYellow = rgb' 255 255 224
-yellow :: Color
-yellow = rgb' 255 255 0
-gold :: Color
-gold = rgb' 255 215 0
-lightGoldenrod :: Color
-lightGoldenrod = rgb' 238 221 130
-goldenrod :: Color
-goldenrod = rgb' 218 165 32
-darkGoldenrod :: Color
-darkGoldenrod = rgb' 184 134 11
-rosyBrown :: Color
-rosyBrown = rgb' 188 143 143
-indianRed :: Color
-indianRed = rgb' 205 92 92
-saddleBrown :: Color
-saddleBrown = rgb' 139 69 19
-sienna :: Color
-sienna = rgb' 160 82 45
-peru :: Color
-peru = rgb' 205 133 63
-burlywood :: Color
-burlywood = rgb' 222 184 135
-beige :: Color
-beige = rgb' 245 245 220
-wheat :: Color
-wheat = rgb' 245 222 179
-sandyBrown :: Color
-sandyBrown = rgb' 244 164 96
-tan :: Color
-tan = rgb' 210 180 140
-chocolate :: Color
-chocolate = rgb' 210 105 30
-firebrick :: Color
-firebrick = rgb' 178 34 34
-brown :: Color
-brown = rgb' 165 42 42
-darkSalmon :: Color
-darkSalmon = rgb' 233 150 122
-salmon :: Color
-salmon = rgb' 250 128 114
-lightSalmon :: Color
-lightSalmon = rgb' 255 160 122
-orange :: Color
-orange = rgb' 255 165 0
-darkOrange :: Color
-darkOrange = rgb' 255 140 0
-coral :: Color
-coral = rgb' 255 127 80
-lightCoral :: Color
-lightCoral = rgb' 240 128 128
-tomato :: Color
-tomato = rgb' 255 99 71
-orangeRed :: Color
-orangeRed = rgb' 255 69 0
-red :: Color
-red = rgb' 255 0 0
-hotPink :: Color
-hotPink = rgb' 255 105 180
-deepPink :: Color
-deepPink = rgb' 255 20 147
-pink :: Color
-pink = rgb' 255 192 203
-lightPink :: Color
-lightPink = rgb' 255 182 193
-paleVioletRed :: Color
-paleVioletRed = rgb' 219 112 147
-maroon :: Color
-maroon = rgb' 176 48 96
-mediumVioletRed :: Color
-mediumVioletRed = rgb' 199 21 133
-violetRed :: Color
-violetRed = rgb' 208 32 144
-magenta :: Color
-magenta = rgb' 255 0 255
-violet :: Color
-violet = rgb' 238 130 238
-plum :: Color
-plum = rgb' 221 160 221
-orchid :: Color
-orchid = rgb' 218 112 214
-mediumOrchid :: Color
-mediumOrchid = rgb' 186 85 211
-darkOrchid :: Color
-darkOrchid = rgb' 153 50 204
-darkViolet :: Color
-darkViolet = rgb' 148 0 211
-blueViolet :: Color
-blueViolet = rgb' 138 43 226
-purple :: Color
-purple = rgb' 160 32 240
-mediumPurple :: Color
-mediumPurple = rgb' 147 112 219
-thistle :: Color
-thistle = rgb' 216 191 216
-snow1 :: Color
-snow1 = rgb' 255 250 250
-snow2 :: Color
-snow2 = rgb' 238 233 233
-snow3 :: Color
-snow3 = rgb' 205 201 201
-snow4 :: Color
-snow4 = rgb' 139 137 137
-seashell1 :: Color
-seashell1 = rgb' 255 245 238
-seashell2 :: Color
-seashell2 = rgb' 238 229 222
-seashell3 :: Color
-seashell3 = rgb' 205 197 191
-seashell4 :: Color
-seashell4 = rgb' 139 134 130
-antiqueWhite1 :: Color
-antiqueWhite1 = rgb' 255 239 219
-antiqueWhite2 :: Color
-antiqueWhite2 = rgb' 238 223 204
-antiqueWhite3 :: Color
-antiqueWhite3 = rgb' 205 192 176
-antiqueWhite4 :: Color
-antiqueWhite4 = rgb' 139 131 120
-bisque1 :: Color
-bisque1 = rgb' 255 228 196
-bisque2 :: Color
-bisque2 = rgb' 238 213 183
-bisque3 :: Color
-bisque3 = rgb' 205 183 158
-bisque4 :: Color
-bisque4 = rgb' 139 125 107
-peachPuff1 :: Color
-peachPuff1 = rgb' 255 218 185
-peachPuff2 :: Color
-peachPuff2 = rgb' 238 203 173
-peachPuff3 :: Color
-peachPuff3 = rgb' 205 175 149
-peachPuff4 :: Color
-peachPuff4 = rgb' 139 119 101
-navajoWhite1 :: Color
-navajoWhite1 = rgb' 255 222 173
-navajoWhite2 :: Color
-navajoWhite2 = rgb' 238 207 161
-navajoWhite3 :: Color
-navajoWhite3 = rgb' 205 179 139
-navajoWhite4 :: Color
-navajoWhite4 = rgb' 139 121 94
-lemonChiffon1 :: Color
-lemonChiffon1 = rgb' 255 250 205
-lemonChiffon2 :: Color
-lemonChiffon2 = rgb' 238 233 191
-lemonChiffon3 :: Color
-lemonChiffon3 = rgb' 205 201 165
-lemonChiffon4 :: Color
-lemonChiffon4 = rgb' 139 137 112
-cornsilk1 :: Color
-cornsilk1 = rgb' 255 248 220
-cornsilk2 :: Color
-cornsilk2 = rgb' 238 232 205
-cornsilk3 :: Color
-cornsilk3 = rgb' 205 200 177
-cornsilk4 :: Color
-cornsilk4 = rgb' 139 136 120
-ivory1 :: Color
-ivory1 = rgb' 255 255 240
-ivory2 :: Color
-ivory2 = rgb' 238 238 224
-ivory3 :: Color
-ivory3 = rgb' 205 205 193
-ivory4 :: Color
-ivory4 = rgb' 139 139 131
-honeydew1 :: Color
-honeydew1 = rgb' 240 255 240
-honeydew2 :: Color
-honeydew2 = rgb' 224 238 224
-honeydew3 :: Color
-honeydew3 = rgb' 193 205 193
-honeydew4 :: Color
-honeydew4 = rgb' 131 139 131
-lavenderBlush1 :: Color
-lavenderBlush1 = rgb' 255 240 245
-lavenderBlush2 :: Color
-lavenderBlush2 = rgb' 238 224 229
-lavenderBlush3 :: Color
-lavenderBlush3 = rgb' 205 193 197
-lavenderBlush4 :: Color
-lavenderBlush4 = rgb' 139 131 134
-mistyRose1 :: Color
-mistyRose1 = rgb' 255 228 225
-mistyRose2 :: Color
-mistyRose2 = rgb' 238 213 210
-mistyRose3 :: Color
-mistyRose3 = rgb' 205 183 181
-mistyRose4 :: Color
-mistyRose4 = rgb' 139 125 123
-azure1 :: Color
-azure1 = rgb' 240 255 255
-azure2 :: Color
-azure2 = rgb' 224 238 238
-azure3 :: Color
-azure3 = rgb' 193 205 205
-azure4 :: Color
-azure4 = rgb' 131 139 139
-slateBlue1 :: Color
-slateBlue1 = rgb' 131 111 255
-slateBlue2 :: Color
-slateBlue2 = rgb' 122 103 238
-slateBlue3 :: Color
-slateBlue3 = rgb' 105 89 205
-slateBlue4 :: Color
-slateBlue4 = rgb' 71 60 139
-royalBlue1 :: Color
-royalBlue1 = rgb' 72 118 255
-royalBlue2 :: Color
-royalBlue2 = rgb' 67 110 238
-royalBlue3 :: Color
-royalBlue3 = rgb' 58 95 205
-royalBlue4 :: Color
-royalBlue4 = rgb' 39 64 139
-blue1 :: Color
-blue1 = rgb' 0 0 255
-blue2 :: Color
-blue2 = rgb' 0 0 238
-blue3 :: Color
-blue3 = rgb' 0 0 205
-blue4 :: Color
-blue4 = rgb' 0 0 139
-dodgerBlue1 :: Color
-dodgerBlue1 = rgb' 30 144 255
-dodgerBlue2 :: Color
-dodgerBlue2 = rgb' 28 134 238
-dodgerBlue3 :: Color
-dodgerBlue3 = rgb' 24 116 205
-dodgerBlue4 :: Color
-dodgerBlue4 = rgb' 16 78 139
-steelBlue1 :: Color
-steelBlue1 = rgb' 99 184 255
-steelBlue2 :: Color
-steelBlue2 = rgb' 92 172 238
-steelBlue3 :: Color
-steelBlue3 = rgb' 79 148 205
-steelBlue4 :: Color
-steelBlue4 = rgb' 54 100 139
-deepSkyBlue1 :: Color
-deepSkyBlue1 = rgb' 0 191 255
-deepSkyBlue2 :: Color
-deepSkyBlue2 = rgb' 0 178 238
-deepSkyBlue3 :: Color
-deepSkyBlue3 = rgb' 0 154 205
-deepSkyBlue4 :: Color
-deepSkyBlue4 = rgb' 0 104 139
-skyBlue1 :: Color
-skyBlue1 = rgb' 135 206 255
-skyBlue2 :: Color
-skyBlue2 = rgb' 126 192 238
-skyBlue3 :: Color
-skyBlue3 = rgb' 108 166 205
-skyBlue4 :: Color
-skyBlue4 = rgb' 74 112 139
-lightSkyBlue1 :: Color
-lightSkyBlue1 = rgb' 176 226 255
-lightSkyBlue2 :: Color
-lightSkyBlue2 = rgb' 164 211 238
-lightSkyBlue3 :: Color
-lightSkyBlue3 = rgb' 141 182 205
-lightSkyBlue4 :: Color
-lightSkyBlue4 = rgb' 96 123 139
-slateGray1 :: Color
-slateGray1 = rgb' 198 226 255
-slateGray2 :: Color
-slateGray2 = rgb' 185 211 238
-slateGray3 :: Color
-slateGray3 = rgb' 159 182 205
-slateGray4 :: Color
-slateGray4 = rgb' 108 123 139
-lightSteelBlue1 :: Color
-lightSteelBlue1 = rgb' 202 225 255
-lightSteelBlue2 :: Color
-lightSteelBlue2 = rgb' 188 210 238
-lightSteelBlue3 :: Color
-lightSteelBlue3 = rgb' 162 181 205
-lightSteelBlue4 :: Color
-lightSteelBlue4 = rgb' 110 123 139
-lightBlue1 :: Color
-lightBlue1 = rgb' 191 239 255
-lightBlue2 :: Color
-lightBlue2 = rgb' 178 223 238
-lightBlue3 :: Color
-lightBlue3 = rgb' 154 192 205
-lightBlue4 :: Color
-lightBlue4 = rgb' 104 131 139
-lightCyan1 :: Color
-lightCyan1 = rgb' 224 255 255
-lightCyan2 :: Color
-lightCyan2 = rgb' 209 238 238
-lightCyan3 :: Color
-lightCyan3 = rgb' 180 205 205
-lightCyan4 :: Color
-lightCyan4 = rgb' 122 139 139
-paleTurquoise1 :: Color
-paleTurquoise1 = rgb' 187 255 255
-paleTurquoise2 :: Color
-paleTurquoise2 = rgb' 174 238 238
-paleTurquoise3 :: Color
-paleTurquoise3 = rgb' 150 205 205
-paleTurquoise4 :: Color
-paleTurquoise4 = rgb' 102 139 139
-cadetBlue1 :: Color
-cadetBlue1 = rgb' 152 245 255
-cadetBlue2 :: Color
-cadetBlue2 = rgb' 142 229 238
-cadetBlue3 :: Color
-cadetBlue3 = rgb' 122 197 205
-cadetBlue4 :: Color
-cadetBlue4 = rgb' 83 134 139
-turquoise1 :: Color
-turquoise1 = rgb' 0 245 255
-turquoise2 :: Color
-turquoise2 = rgb' 0 229 238
-turquoise3 :: Color
-turquoise3 = rgb' 0 197 205
-turquoise4 :: Color
-turquoise4 = rgb' 0 134 139
-cyan1 :: Color
-cyan1 = rgb' 0 255 255
-cyan2 :: Color
-cyan2 = rgb' 0 238 238
-cyan3 :: Color
-cyan3 = rgb' 0 205 205
-cyan4 :: Color
-cyan4 = rgb' 0 139 139
-darkSlateGray1 :: Color
-darkSlateGray1 = rgb' 151 255 255
-darkSlateGray2 :: Color
-darkSlateGray2 = rgb' 141 238 238
-darkSlateGray3 :: Color
-darkSlateGray3 = rgb' 121 205 205
-darkSlateGray4 :: Color
-darkSlateGray4 = rgb' 82 139 139
-aquamarine1 :: Color
-aquamarine1 = rgb' 127 255 212
-aquamarine2 :: Color
-aquamarine2 = rgb' 118 238 198
-aquamarine3 :: Color
-aquamarine3 = rgb' 102 205 170
-aquamarine4 :: Color
-aquamarine4 = rgb' 69 139 116
-darkSeaGreen1 :: Color
-darkSeaGreen1 = rgb' 193 255 193
-darkSeaGreen2 :: Color
-darkSeaGreen2 = rgb' 180 238 180
-darkSeaGreen3 :: Color
-darkSeaGreen3 = rgb' 155 205 155
-darkSeaGreen4 :: Color
-darkSeaGreen4 = rgb' 105 139 105
-seaGreen1 :: Color
-seaGreen1 = rgb' 84 255 159
-seaGreen2 :: Color
-seaGreen2 = rgb' 78 238 148
-seaGreen3 :: Color
-seaGreen3 = rgb' 67 205 128
-seaGreen4 :: Color
-seaGreen4 = rgb' 46 139 87
-paleGreen1 :: Color
-paleGreen1 = rgb' 154 255 154
-paleGreen2 :: Color
-paleGreen2 = rgb' 144 238 144
-paleGreen3 :: Color
-paleGreen3 = rgb' 124 205 124
-paleGreen4 :: Color
-paleGreen4 = rgb' 84 139 84
-springGreen1 :: Color
-springGreen1 = rgb' 0 255 127
-springGreen2 :: Color
-springGreen2 = rgb' 0 238 118
-springGreen3 :: Color
-springGreen3 = rgb' 0 205 102
-springGreen4 :: Color
-springGreen4 = rgb' 0 139 69
-green1 :: Color
-green1 = rgb' 0 255 0
-green2 :: Color
-green2 = rgb' 0 238 0
-green3 :: Color
-green3 = rgb' 0 205 0
-green4 :: Color
-green4 = rgb' 0 139 0
-chartreuse1 :: Color
-chartreuse1 = rgb' 127 255 0
-chartreuse2 :: Color
-chartreuse2 = rgb' 118 238 0
-chartreuse3 :: Color
-chartreuse3 = rgb' 102 205 0
-chartreuse4 :: Color
-chartreuse4 = rgb' 69 139 0
-oliveDrab1 :: Color
-oliveDrab1 = rgb' 192 255 62
-oliveDrab2 :: Color
-oliveDrab2 = rgb' 179 238 58
-oliveDrab3 :: Color
-oliveDrab3 = rgb' 154 205 50
-oliveDrab4 :: Color
-oliveDrab4 = rgb' 105 139 34
-darkOliveGreen1 :: Color
-darkOliveGreen1 = rgb' 202 255 112
-darkOliveGreen2 :: Color
-darkOliveGreen2 = rgb' 188 238 104
-darkOliveGreen3 :: Color
-darkOliveGreen3 = rgb' 162 205 90
-darkOliveGreen4 :: Color
-darkOliveGreen4 = rgb' 110 139 61
-khaki1 :: Color
-khaki1 = rgb' 255 246 143
-khaki2 :: Color
-khaki2 = rgb' 238 230 133
-khaki3 :: Color
-khaki3 = rgb' 205 198 115
-khaki4 :: Color
-khaki4 = rgb' 139 134 78
-lightGoldenrod1 :: Color
-lightGoldenrod1 = rgb' 255 236 139
-lightGoldenrod2 :: Color
-lightGoldenrod2 = rgb' 238 220 130
-lightGoldenrod3 :: Color
-lightGoldenrod3 = rgb' 205 190 112
-lightGoldenrod4 :: Color
-lightGoldenrod4 = rgb' 139 129 76
-lightYellow1 :: Color
-lightYellow1 = rgb' 255 255 224
-lightYellow2 :: Color
-lightYellow2 = rgb' 238 238 209
-lightYellow3 :: Color
-lightYellow3 = rgb' 205 205 180
-lightYellow4 :: Color
-lightYellow4 = rgb' 139 139 122
-yellow1 :: Color
-yellow1 = rgb' 255 255 0
-yellow2 :: Color
-yellow2 = rgb' 238 238 0
-yellow3 :: Color
-yellow3 = rgb' 205 205 0
-yellow4 :: Color
-yellow4 = rgb' 139 139 0
-gold1 :: Color
-gold1 = rgb' 255 215 0
-gold2 :: Color
-gold2 = rgb' 238 201 0
-gold3 :: Color
-gold3 = rgb' 205 173 0
-gold4 :: Color
-gold4 = rgb' 139 117 0
-goldenrod1 :: Color
-goldenrod1 = rgb' 255 193 37
-goldenrod2 :: Color
-goldenrod2 = rgb' 238 180 34
-goldenrod3 :: Color
-goldenrod3 = rgb' 205 155 29
-goldenrod4 :: Color
-goldenrod4 = rgb' 139 105 20
-darkGoldenrod1 :: Color
-darkGoldenrod1 = rgb' 255 185 15
-darkGoldenrod2 :: Color
-darkGoldenrod2 = rgb' 238 173 14
-darkGoldenrod3 :: Color
-darkGoldenrod3 = rgb' 205 149 12
-darkGoldenrod4 :: Color
-darkGoldenrod4 = rgb' 139 101 8
-rosyBrown1 :: Color
-rosyBrown1 = rgb' 255 193 193
-rosyBrown2 :: Color
-rosyBrown2 = rgb' 238 180 180
-rosyBrown3 :: Color
-rosyBrown3 = rgb' 205 155 155
-rosyBrown4 :: Color
-rosyBrown4 = rgb' 139 105 105
-indianRed1 :: Color
-indianRed1 = rgb' 255 106 106
-indianRed2 :: Color
-indianRed2 = rgb' 238 99 99
-indianRed3 :: Color
-indianRed3 = rgb' 205 85 85
-indianRed4 :: Color
-indianRed4 = rgb' 139 58 58
-sienna1 :: Color
-sienna1 = rgb' 255 130 71
-sienna2 :: Color
-sienna2 = rgb' 238 121 66
-sienna3 :: Color
-sienna3 = rgb' 205 104 57
-sienna4 :: Color
-sienna4 = rgb' 139 71 38
-burlywood1 :: Color
-burlywood1 = rgb' 255 211 155
-burlywood2 :: Color
-burlywood2 = rgb' 238 197 145
-burlywood3 :: Color
-burlywood3 = rgb' 205 170 125
-burlywood4 :: Color
-burlywood4 = rgb' 139 115 85
-wheat1 :: Color
-wheat1 = rgb' 255 231 186
-wheat2 :: Color
-wheat2 = rgb' 238 216 174
-wheat3 :: Color
-wheat3 = rgb' 205 186 150
-wheat4 :: Color
-wheat4 = rgb' 139 126 102
-tan1 :: Color
-tan1 = rgb' 255 165 79
-tan2 :: Color
-tan2 = rgb' 238 154 73
-tan3 :: Color
-tan3 = rgb' 205 133 63
-tan4 :: Color
-tan4 = rgb' 139 90 43
-chocolate1 :: Color
-chocolate1 = rgb' 255 127 36
-chocolate2 :: Color
-chocolate2 = rgb' 238 118 33
-chocolate3 :: Color
-chocolate3 = rgb' 205 102 29
-chocolate4 :: Color
-chocolate4 = rgb' 139 69 19
-firebrick1 :: Color
-firebrick1 = rgb' 255 48 48
-firebrick2 :: Color
-firebrick2 = rgb' 238 44 44
-firebrick3 :: Color
-firebrick3 = rgb' 205 38 38
-firebrick4 :: Color
-firebrick4 = rgb' 139 26 26
-brown1 :: Color
-brown1 = rgb' 255 64 64
-brown2 :: Color
-brown2 = rgb' 238 59 59
-brown3 :: Color
-brown3 = rgb' 205 51 51
-brown4 :: Color
-brown4 = rgb' 139 35 35
-salmon1 :: Color
-salmon1 = rgb' 255 140 105
-salmon2 :: Color
-salmon2 = rgb' 238 130 98
-salmon3 :: Color
-salmon3 = rgb' 205 112 84
-salmon4 :: Color
-salmon4 = rgb' 139 76 57
-lightSalmon1 :: Color
-lightSalmon1 = rgb' 255 160 122
-lightSalmon2 :: Color
-lightSalmon2 = rgb' 238 149 114
-lightSalmon3 :: Color
-lightSalmon3 = rgb' 205 129 98
-lightSalmon4 :: Color
-lightSalmon4 = rgb' 139 87 66
-orange1 :: Color
-orange1 = rgb' 255 165 0
-orange2 :: Color
-orange2 = rgb' 238 154 0
-orange3 :: Color
-orange3 = rgb' 205 133 0
-orange4 :: Color
-orange4 = rgb' 139 90 0
-darkOrange1 :: Color
-darkOrange1 = rgb' 255 127 0
-darkOrange2 :: Color
-darkOrange2 = rgb' 238 118 0
-darkOrange3 :: Color
-darkOrange3 = rgb' 205 102 0
-darkOrange4 :: Color
-darkOrange4 = rgb' 139 69 0
-coral1 :: Color
-coral1 = rgb' 255 114 86
-coral2 :: Color
-coral2 = rgb' 238 106 80
-coral3 :: Color
-coral3 = rgb' 205 91 69
-coral4 :: Color
-coral4 = rgb' 139 62 47
-tomato1 :: Color
-tomato1 = rgb' 255 99 71
-tomato2 :: Color
-tomato2 = rgb' 238 92 66
-tomato3 :: Color
-tomato3 = rgb' 205 79 57
-tomato4 :: Color
-tomato4 = rgb' 139 54 38
-orangeRed1 :: Color
-orangeRed1 = rgb' 255 69 0
-orangeRed2 :: Color
-orangeRed2 = rgb' 238 64 0
-orangeRed3 :: Color
-orangeRed3 = rgb' 205 55 0
-orangeRed4 :: Color
-orangeRed4 = rgb' 139 37 0
-red1 :: Color
-red1 = rgb' 255 0 0
-red2 :: Color
-red2 = rgb' 238 0 0
-red3 :: Color
-red3 = rgb' 205 0 0
-red4 :: Color
-red4 = rgb' 139 0 0
-deepPink1 :: Color
-deepPink1 = rgb' 255 20 147
-deepPink2 :: Color
-deepPink2 = rgb' 238 18 137
-deepPink3 :: Color
-deepPink3 = rgb' 205 16 118
-deepPink4 :: Color
-deepPink4 = rgb' 139 10 80
-hotPink1 :: Color
-hotPink1 = rgb' 255 110 180
-hotPink2 :: Color
-hotPink2 = rgb' 238 106 167
-hotPink3 :: Color
-hotPink3 = rgb' 205 96 144
-hotPink4 :: Color
-hotPink4 = rgb' 139 58 98
-pink1 :: Color
-pink1 = rgb' 255 181 197
-pink2 :: Color
-pink2 = rgb' 238 169 184
-pink3 :: Color
-pink3 = rgb' 205 145 158
-pink4 :: Color
-pink4 = rgb' 139 99 108
-lightPink1 :: Color
-lightPink1 = rgb' 255 174 185
-lightPink2 :: Color
-lightPink2 = rgb' 238 162 173
-lightPink3 :: Color
-lightPink3 = rgb' 205 140 149
-lightPink4 :: Color
-lightPink4 = rgb' 139 95 101
-paleVioletRed1 :: Color
-paleVioletRed1 = rgb' 255 130 171
-paleVioletRed2 :: Color
-paleVioletRed2 = rgb' 238 121 159
-paleVioletRed3 :: Color
-paleVioletRed3 = rgb' 205 104 137
-paleVioletRed4 :: Color
-paleVioletRed4 = rgb' 139 71 93
-maroon1 :: Color
-maroon1 = rgb' 255 52 179
-maroon2 :: Color
-maroon2 = rgb' 238 48 167
-maroon3 :: Color
-maroon3 = rgb' 205 41 144
-maroon4 :: Color
-maroon4 = rgb' 139 28 98
-violetRed1 :: Color
-violetRed1 = rgb' 255 62 150
-violetRed2 :: Color
-violetRed2 = rgb' 238 58 140
-violetRed3 :: Color
-violetRed3 = rgb' 205 50 120
-violetRed4 :: Color
-violetRed4 = rgb' 139 34 82
-magenta1 :: Color
-magenta1 = rgb' 255 0 255
-magenta2 :: Color
-magenta2 = rgb' 238 0 238
-magenta3 :: Color
-magenta3 = rgb' 205 0 205
-magenta4 :: Color
-magenta4 = rgb' 139 0 139
-orchid1 :: Color
-orchid1 = rgb' 255 131 250
-orchid2 :: Color
-orchid2 = rgb' 238 122 233
-orchid3 :: Color
-orchid3 = rgb' 205 105 201
-orchid4 :: Color
-orchid4 = rgb' 139 71 137
-plum1 :: Color
-plum1 = rgb' 255 187 255
-plum2 :: Color
-plum2 = rgb' 238 174 238
-plum3 :: Color
-plum3 = rgb' 205 150 205
-plum4 :: Color
-plum4 = rgb' 139 102 139
-mediumOrchid1 :: Color
-mediumOrchid1 = rgb' 224 102 255
-mediumOrchid2 :: Color
-mediumOrchid2 = rgb' 209 95 238
-mediumOrchid3 :: Color
-mediumOrchid3 = rgb' 180 82 205
-mediumOrchid4 :: Color
-mediumOrchid4 = rgb' 122 55 139
-darkOrchid1 :: Color
-darkOrchid1 = rgb' 191 62 255
-darkOrchid2 :: Color
-darkOrchid2 = rgb' 178 58 238
-darkOrchid3 :: Color
-darkOrchid3 = rgb' 154 50 205
-darkOrchid4 :: Color
-darkOrchid4 = rgb' 104 34 139
-purple1 :: Color
-purple1 = rgb' 155 48 255
-purple2 :: Color
-purple2 = rgb' 145 44 238
-purple3 :: Color
-purple3 = rgb' 125 38 205
-purple4 :: Color
-purple4 = rgb' 85 26 139
-mediumPurple1 :: Color
-mediumPurple1 = rgb' 171 130 255
-mediumPurple2 :: Color
-mediumPurple2 = rgb' 159 121 238
-mediumPurple3 :: Color
-mediumPurple3 = rgb' 137 104 205
-mediumPurple4 :: Color
-mediumPurple4 = rgb' 93 71 139
-thistle1 :: Color
-thistle1 = rgb' 255 225 255
-thistle2 :: Color
-thistle2 = rgb' 238 210 238
-thistle3 :: Color
-thistle3 = rgb' 205 181 205
-thistle4 :: Color
-thistle4 = rgb' 139 123 139
-gray0 :: Color
-gray0 = rgb' 0 0 0
-grey0 :: Color
-grey0 = rgb' 0 0 0
-gray1 :: Color
-gray1 = rgb' 3 3 3
-grey1 :: Color
-grey1 = rgb' 3 3 3
-gray2 :: Color
-gray2 = rgb' 5 5 5
-grey2 :: Color
-grey2 = rgb' 5 5 5
-gray3 :: Color
-gray3 = rgb' 8 8 8
-grey3 :: Color
-grey3 = rgb' 8 8 8
-gray4 :: Color
-gray4 = rgb' 10 10 10
-grey4 :: Color
-grey4 = rgb' 10 10 10
-gray5 :: Color
-gray5 = rgb' 13 13 13
-grey5 :: Color
-grey5 = rgb' 13 13 13
-gray6 :: Color
-gray6 = rgb' 15 15 15
-grey6 :: Color
-grey6 = rgb' 15 15 15
-gray7 :: Color
-gray7 = rgb' 18 18 18
-grey7 :: Color
-grey7 = rgb' 18 18 18
-gray8 :: Color
-gray8 = rgb' 20 20 20
-grey8 :: Color
-grey8 = rgb' 20 20 20
-gray9 :: Color
-gray9 = rgb' 23 23 23
-grey9 :: Color
-grey9 = rgb' 23 23 23
-gray10 :: Color
-gray10 = rgb' 26 26 26
-grey10 :: Color
-grey10 = rgb' 26 26 26
-gray11 :: Color
-gray11 = rgb' 28 28 28
-grey11 :: Color
-grey11 = rgb' 28 28 28
-gray12 :: Color
-gray12 = rgb' 31 31 31
-grey12 :: Color
-grey12 = rgb' 31 31 31
-gray13 :: Color
-gray13 = rgb' 33 33 33
-grey13 :: Color
-grey13 = rgb' 33 33 33
-gray14 :: Color
-gray14 = rgb' 36 36 36
-grey14 :: Color
-grey14 = rgb' 36 36 36
-gray15 :: Color
-gray15 = rgb' 38 38 38
-grey15 :: Color
-grey15 = rgb' 38 38 38
-gray16 :: Color
-gray16 = rgb' 41 41 41
-grey16 :: Color
-grey16 = rgb' 41 41 41
-gray17 :: Color
-gray17 = rgb' 43 43 43
-grey17 :: Color
-grey17 = rgb' 43 43 43
-gray18 :: Color
-gray18 = rgb' 46 46 46
-grey18 :: Color
-grey18 = rgb' 46 46 46
-gray19 :: Color
-gray19 = rgb' 48 48 48
-grey19 :: Color
-grey19 = rgb' 48 48 48
-gray20 :: Color
-gray20 = rgb' 51 51 51
-grey20 :: Color
-grey20 = rgb' 51 51 51
-gray21 :: Color
-gray21 = rgb' 54 54 54
-grey21 :: Color
-grey21 = rgb' 54 54 54
-gray22 :: Color
-gray22 = rgb' 56 56 56
-grey22 :: Color
-grey22 = rgb' 56 56 56
-gray23 :: Color
-gray23 = rgb' 59 59 59
-grey23 :: Color
-grey23 = rgb' 59 59 59
-gray24 :: Color
-gray24 = rgb' 61 61 61
-grey24 :: Color
-grey24 = rgb' 61 61 61
-gray25 :: Color
-gray25 = rgb' 64 64 64
-grey25 :: Color
-grey25 = rgb' 64 64 64
-gray26 :: Color
-gray26 = rgb' 66 66 66
-grey26 :: Color
-grey26 = rgb' 66 66 66
-gray27 :: Color
-gray27 = rgb' 69 69 69
-grey27 :: Color
-grey27 = rgb' 69 69 69
-gray28 :: Color
-gray28 = rgb' 71 71 71
-grey28 :: Color
-grey28 = rgb' 71 71 71
-gray29 :: Color
-gray29 = rgb' 74 74 74
-grey29 :: Color
-grey29 = rgb' 74 74 74
-gray30 :: Color
-gray30 = rgb' 77 77 77
-grey30 :: Color
-grey30 = rgb' 77 77 77
-gray31 :: Color
-gray31 = rgb' 79 79 79
-grey31 :: Color
-grey31 = rgb' 79 79 79
-gray32 :: Color
-gray32 = rgb' 82 82 82
-grey32 :: Color
-grey32 = rgb' 82 82 82
-gray33 :: Color
-gray33 = rgb' 84 84 84
-grey33 :: Color
-grey33 = rgb' 84 84 84
-gray34 :: Color
-gray34 = rgb' 87 87 87
-grey34 :: Color
-grey34 = rgb' 87 87 87
-gray35 :: Color
-gray35 = rgb' 89 89 89
-grey35 :: Color
-grey35 = rgb' 89 89 89
-gray36 :: Color
-gray36 = rgb' 92 92 92
-grey36 :: Color
-grey36 = rgb' 92 92 92
-gray37 :: Color
-gray37 = rgb' 94 94 94
-grey37 :: Color
-grey37 = rgb' 94 94 94
-gray38 :: Color
-gray38 = rgb' 97 97 97
-grey38 :: Color
-grey38 = rgb' 97 97 97
-gray39 :: Color
-gray39 = rgb' 99 99 99
-grey39 :: Color
-grey39 = rgb' 99 99 99
-gray40 :: Color
-gray40 = rgb' 102 102 102
-grey40 :: Color
-grey40 = rgb' 102 102 102
-gray41 :: Color
-gray41 = rgb' 105 105 105
-grey41 :: Color
-grey41 = rgb' 105 105 105
-gray42 :: Color
-gray42 = rgb' 107 107 107
-grey42 :: Color
-grey42 = rgb' 107 107 107
-gray43 :: Color
-gray43 = rgb' 110 110 110
-grey43 :: Color
-grey43 = rgb' 110 110 110
-gray44 :: Color
-gray44 = rgb' 112 112 112
-grey44 :: Color
-grey44 = rgb' 112 112 112
-gray45 :: Color
-gray45 = rgb' 115 115 115
-grey45 :: Color
-grey45 = rgb' 115 115 115
-gray46 :: Color
-gray46 = rgb' 117 117 117
-grey46 :: Color
-grey46 = rgb' 117 117 117
-gray47 :: Color
-gray47 = rgb' 120 120 120
-grey47 :: Color
-grey47 = rgb' 120 120 120
-gray48 :: Color
-gray48 = rgb' 122 122 122
-grey48 :: Color
-grey48 = rgb' 122 122 122
-gray49 :: Color
-gray49 = rgb' 125 125 125
-grey49 :: Color
-grey49 = rgb' 125 125 125
-gray50 :: Color
-gray50 = rgb' 127 127 127
-grey50 :: Color
-grey50 = rgb' 127 127 127
-gray51 :: Color
-gray51 = rgb' 130 130 130
-grey51 :: Color
-grey51 = rgb' 130 130 130
-gray52 :: Color
-gray52 = rgb' 133 133 133
-grey52 :: Color
-grey52 = rgb' 133 133 133
-gray53 :: Color
-gray53 = rgb' 135 135 135
-grey53 :: Color
-grey53 = rgb' 135 135 135
-gray54 :: Color
-gray54 = rgb' 138 138 138
-grey54 :: Color
-grey54 = rgb' 138 138 138
-gray55 :: Color
-gray55 = rgb' 140 140 140
-grey55 :: Color
-grey55 = rgb' 140 140 140
-gray56 :: Color
-gray56 = rgb' 143 143 143
-grey56 :: Color
-grey56 = rgb' 143 143 143
-gray57 :: Color
-gray57 = rgb' 145 145 145
-grey57 :: Color
-grey57 = rgb' 145 145 145
-gray58 :: Color
-gray58 = rgb' 148 148 148
-grey58 :: Color
-grey58 = rgb' 148 148 148
-gray59 :: Color
-gray59 = rgb' 150 150 150
-grey59 :: Color
-grey59 = rgb' 150 150 150
-gray60 :: Color
-gray60 = rgb' 153 153 153
-grey60 :: Color
-grey60 = rgb' 153 153 153
-gray61 :: Color
-gray61 = rgb' 156 156 156
-grey61 :: Color
-grey61 = rgb' 156 156 156
-gray62 :: Color
-gray62 = rgb' 158 158 158
-grey62 :: Color
-grey62 = rgb' 158 158 158
-gray63 :: Color
-gray63 = rgb' 161 161 161
-grey63 :: Color
-grey63 = rgb' 161 161 161
-gray64 :: Color
-gray64 = rgb' 163 163 163
-grey64 :: Color
-grey64 = rgb' 163 163 163
-gray65 :: Color
-gray65 = rgb' 166 166 166
-grey65 :: Color
-grey65 = rgb' 166 166 166
-gray66 :: Color
-gray66 = rgb' 168 168 168
-grey66 :: Color
-grey66 = rgb' 168 168 168
-gray67 :: Color
-gray67 = rgb' 171 171 171
-grey67 :: Color
-grey67 = rgb' 171 171 171
-gray68 :: Color
-gray68 = rgb' 173 173 173
-grey68 :: Color
-grey68 = rgb' 173 173 173
-gray69 :: Color
-gray69 = rgb' 176 176 176
-grey69 :: Color
-grey69 = rgb' 176 176 176
-gray70 :: Color
-gray70 = rgb' 179 179 179
-grey70 :: Color
-grey70 = rgb' 179 179 179
-gray71 :: Color
-gray71 = rgb' 181 181 181
-grey71 :: Color
-grey71 = rgb' 181 181 181
-gray72 :: Color
-gray72 = rgb' 184 184 184
-grey72 :: Color
-grey72 = rgb' 184 184 184
-gray73 :: Color
-gray73 = rgb' 186 186 186
-grey73 :: Color
-grey73 = rgb' 186 186 186
-gray74 :: Color
-gray74 = rgb' 189 189 189
-grey74 :: Color
-grey74 = rgb' 189 189 189
-gray75 :: Color
-gray75 = rgb' 191 191 191
-grey75 :: Color
-grey75 = rgb' 191 191 191
-gray76 :: Color
-gray76 = rgb' 194 194 194
-grey76 :: Color
-grey76 = rgb' 194 194 194
-gray77 :: Color
-gray77 = rgb' 196 196 196
-grey77 :: Color
-grey77 = rgb' 196 196 196
-gray78 :: Color
-gray78 = rgb' 199 199 199
-grey78 :: Color
-grey78 = rgb' 199 199 199
-gray79 :: Color
-gray79 = rgb' 201 201 201
-grey79 :: Color
-grey79 = rgb' 201 201 201
-gray80 :: Color
-gray80 = rgb' 204 204 204
-grey80 :: Color
-grey80 = rgb' 204 204 204
-gray81 :: Color
-gray81 = rgb' 207 207 207
-grey81 :: Color
-grey81 = rgb' 207 207 207
-gray82 :: Color
-gray82 = rgb' 209 209 209
-grey82 :: Color
-grey82 = rgb' 209 209 209
-gray83 :: Color
-gray83 = rgb' 212 212 212
-grey83 :: Color
-grey83 = rgb' 212 212 212
-gray84 :: Color
-gray84 = rgb' 214 214 214
-grey84 :: Color
-grey84 = rgb' 214 214 214
-gray85 :: Color
-gray85 = rgb' 217 217 217
-grey85 :: Color
-grey85 = rgb' 217 217 217
-gray86 :: Color
-gray86 = rgb' 219 219 219
-grey86 :: Color
-grey86 = rgb' 219 219 219
-gray87 :: Color
-gray87 = rgb' 222 222 222
-grey87 :: Color
-grey87 = rgb' 222 222 222
-gray88 :: Color
-gray88 = rgb' 224 224 224
-grey88 :: Color
-grey88 = rgb' 224 224 224
-gray89 :: Color
-gray89 = rgb' 227 227 227
-grey89 :: Color
-grey89 = rgb' 227 227 227
-gray90 :: Color
-gray90 = rgb' 229 229 229
-grey90 :: Color
-grey90 = rgb' 229 229 229
-gray91 :: Color
-gray91 = rgb' 232 232 232
-grey91 :: Color
-grey91 = rgb' 232 232 232
-gray92 :: Color
-gray92 = rgb' 235 235 235
-grey92 :: Color
-grey92 = rgb' 235 235 235
-gray93 :: Color
-gray93 = rgb' 237 237 237
-grey93 :: Color
-grey93 = rgb' 237 237 237
-gray94 :: Color
-gray94 = rgb' 240 240 240
-grey94 :: Color
-grey94 = rgb' 240 240 240
-gray95 :: Color
-gray95 = rgb' 242 242 242
-grey95 :: Color
-grey95 = rgb' 242 242 242
-gray96 :: Color
-gray96 = rgb' 245 245 245
-grey96 :: Color
-grey96 = rgb' 245 245 245
-gray97 :: Color
-gray97 = rgb' 247 247 247
-grey97 :: Color
-grey97 = rgb' 247 247 247
-gray98 :: Color
-gray98 = rgb' 250 250 250
-grey98 :: Color
-grey98 = rgb' 250 250 250
-gray99 :: Color
-gray99 = rgb' 252 252 252
-grey99 :: Color
-grey99 = rgb' 252 252 252
-gray100 :: Color
-gray100 = rgb' 255 255 255
-grey100 :: Color
-grey100 = rgb' 255 255 255
-darkGrey :: Color
-darkGrey = rgb' 169 169 169
-darkGray :: Color
-darkGray = rgb' 169 169 169
-darkBlue :: Color
-darkBlue = rgb' 0 0 139
-darkCyan :: Color
-darkCyan = rgb' 0 139 139
-darkMagenta :: Color
-darkMagenta = rgb' 139 0 139
-darkRed :: Color
-darkRed = rgb' 139 0 0
-lightGreen :: Color
-lightGreen = rgb' 144 238 144
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
@@ -26,7 +26,10 @@
-- ** User interface
, compose
- , writePng
+ , writePNG, writePS, writePDF, writeSVG
+ , renderWithBackend
+ , renderOverlayPNG
+ , chooseBackend
-- ** Internals
@@ -36,13 +39,9 @@
) where
import Graphics.Rendering.Diagrams.Types
-import Graphics.Rendering.Diagrams.Attributes
-import Graphics.Rendering.Diagrams.Layouts
import qualified Graphics.Rendering.Cairo as C
-import Control.Arrow ((***))
import Control.Monad.Reader
-import Data.List (foldl1')
-- $preproc
-- These functions take a user-generated 'Diagram' object and
@@ -71,56 +70,130 @@
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 and height and a user-constructed 'Diagram',
+-- | 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 and height.
+-- 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'.
-compose :: Double -- ^ output width
- -> Double -- ^ output height
- -> Diagram -- ^ 'Diagram' to render
- -> C.Render ()
-compose w h d = do
+-- 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 = min (w/x) (w/y)
- C.scale s s
- C.translate (x/2) (y/2)
+ 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
+ C.scale s s
+ C.translate (x/2) (y/2)
- -- Set the output background to opaque white.
- C.save
- C.setSourceRGBA 1 1 1 1
- C.paint
- C.restore
+ -- 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'
+ -- render the final diagram.
+ flip runDiaRenderM defaultDiaRenderEnv . render $ d'
--- | Given a rendered diagram, output it to a .png file with the given
--- width and height.
-writePng :: String -> Int -> Int -> C.Render () -> IO ()
-writePng fileName w h render =
- C.withImageSurface C.FormatARGB32 w h $ \surface -> do
- C.renderWith surface render
- C.surfaceWriteToPNG surface fileName
+-- | 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
+
+-- | 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 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 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
+
+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
+
-- | Perform a rendering operation atomically, by saving the state and
-- restoring it afterwards.
atomic :: DiaRenderM () -> DiaRenderM ()
-atomic render = (c C.save) >> render >> (c C.restore)
+atomic r = (c C.save) >> r >> (c C.restore)
-- | Render a diagram.
render :: Diagram -> DiaRenderM ()
@@ -129,3 +202,4 @@
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
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
@@ -29,17 +29,33 @@
, hdistrib, vdistrib
, hdistribA, vdistribA
+ , position, positionA
+
, 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 Control.Arrow ((***), first, (>>>))
+import Graphics.Rendering.Diagrams.Shapes
+import Graphics.Rendering.Diagrams.Engine (sizeAndPos)
+import Control.Arrow (first)
+import Data.Tree
+
-- Union -----------------------------------------------
-- | The union layout, which lays out diagrams superimposed on one
@@ -54,8 +70,8 @@
where (sizes, diagrams) = unzip pds
(xs, ys) = unzip sizes
(w,h) = (maximum xs, maximum ys)
- xs' = align halign w xs
- ys' = align valign h 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
@@ -64,7 +80,7 @@
union :: [Diagram] -> Diagram
union = unionA hcenter vcenter
--- | Superimpose one diagram atop another. @d1 ## d2@ results in a
+-- | 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
@@ -107,11 +123,31 @@
-- | Compute new coordinates for the centers of the subdiagrams of a
-- list, based on the alignment.
-align :: Alignment -> Double -> [Double] -> [Double]
-align TopLeft h hs = map ((/2) . (subtract h)) hs
-align Center h hs = repeat 0
-align BottomRight h hs = map negate (align TopLeft h hs)
+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
@@ -179,7 +215,7 @@
offsWSeps = zipWith (+) offsets (zipWith (*) [0..] (repeat sep))
centers = zipWith (+) (init offsWSeps) (map (/2) ws)
xs = map (subtract (w/2)) centers
- ys = align a h hs
+ ys = aligns a h hs
listPosns a (Distrib da sep) (w,h) sizes = zip xs ys
where (ws,hs) = unzip sizes
@@ -189,14 +225,14 @@
centerOffs Center _ = sep/2
centerOffs BottomRight width = sep - width/2
xs = map (subtract (w/2)) centers
- ys = align a h hs
+ 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
+-- | @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]
@@ -214,7 +250,7 @@
-- | Lay out a list of 'Diagram's horizontally, with the given
-- amount of separation in between each pair, using the given
--- vertical alignment ('top', 'center', or 'bottom').
+-- 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
@@ -242,7 +278,7 @@
vcat :: [Diagram] -> Diagram
vcat = vsep 0
--- | @d1 <> d2@ is a 'Diagram' with @d1@ above @d2@, aligned
+-- | @d1 \/\/ d2@ is a 'Diagram' with @d1@ above @d2@, aligned
-- along their left edges.
(//) :: Diagram -> Diagram -> Diagram
d1 // d2 = vcat [d1, d2]
@@ -287,10 +323,129 @@
-- | The mother-combinator for all the @sep@ functions, used
-- internally.
sepA :: ListType -> Double -> Alignment -> [Diagram] -> Diagram
-sepA lt sep align = Compound . Layout (List lt align (Sep sep))
+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 align =
- Compound . Layout (List lt align (Distrib alignD sep))
+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
+
+
+-- 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 ---------------------------------
+
+newtype Identity a = Identity a
+instance Functor Identity where
+ fmap f (Identity x) = Identity (f x)
+
+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))
diff --git a/Graphics/Rendering/Diagrams/Paths.hs b/Graphics/Rendering/Diagrams/Paths.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/Rendering/Diagrams/Paths.hs
@@ -0,0 +1,177 @@
+-----------------------------------------------------------------------------
+-- |
+-- 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
+ , 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
+
+-- | \"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
+
+-- | 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
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,34 +13,49 @@
-----------------------------------------------------------------------------
module Graphics.Rendering.Diagrams.Shapes
( circle
- , poly
+
+ , regPolyPath
+ , regPoly
+ , rotRegPoly
+
, rect
+ , roundRect
- , draw
+ , 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 Control.Arrow ((&&&), (***))
+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
- (RGBA r g b a) <- asks envFillColor
- c $ C.setSourceRGBA r g b a
+ (rf,gf,bf,af) <- asks (colorToRGBA . envFillColor)
+ c $ C.setSourceRGBA rf gf bf af
c $ C.fillPreserve
- (RGBA r g b a) <- asks envStrokeColor
- c $ C.setSourceRGBA r g b a
+ (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 = sqrt . uncurry (+) . ((^2) *** (^2))
+ where dist (x,y) = sqrt (x*x + y*y)
-- | A unit circle centered at the origin.
data Circle = Circle deriving (Eq, Show, Read)
@@ -54,28 +69,56 @@
circle :: Double -> Diagram
circle r = scale r $ Prim (Shape Circle)
+-- | 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
--- | @RPoly n@ is a regular n-gon centered at the origin, with a
--- vertex at (1,0).
-data RPoly = RPoly Int deriving (Eq, Show, Read)
-instance ShapeClass RPoly where
- shapeSize _ = (2,2)
- renderShape (RPoly n) = do
- c $ C.moveTo 1 0
- c $ mapM_ (uncurry C.lineTo . (cos &&& sin)) $
- tail [0,2*pi/nd .. (nd-1)*2*pi/nd]
- c $ C.closePath
- draw
- where nd = fromIntegral n
+-- | @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)
--- | @poly n r@ is a regular n-gon, with a circumcircle of radius @r@.
--- One vertex is oriented along the positive x-axis. Note that the
--- bounding box is the square circumscribed around the circumcircle.
-poly :: Int -> Double -> Diagram
-poly n r = scale r $ Prim (Shape (RPoly n))
+-- | @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.
@@ -90,3 +133,72 @@
rect :: Double -> Double -> Diagram
rect w h = scale (h/2) $ Prim (Shape (Rect (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)
+instance ShapeClass RoundRect where
+ shapeSize (RoundRect w h) = (w,h)
+ renderShape (RoundRect w h) = do
+ let (x,y) = (w/2, h/2)
+ r = min (w/3) (h/3)
+ 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
+
+-- | @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 1000 1000)
+ (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))
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
@@ -1,4 +1,4 @@
-{-# LANGUAGE ExistentialQuantification, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-}
+{-# LANGUAGE ExistentialQuantification, GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module : Graphics.Rendering.Diagrams.Types
@@ -21,10 +21,14 @@
Diagram(..)
- , Color(..), rgb, rgba
- , Point
- , (.+), (.*)
+ , Color(..), SomeColor(..)
+ , Point, Vec
+ , (*.), (.+.), (.-.), (.*.)
+ , Path(..)
+ , PathType(..)
+ , PathStyle(..)
+
-- * Shapes, attributes, and layouts
, ShapeClass(..), Shape(..)
@@ -40,11 +44,19 @@
, runDiaRenderM
, c
+ , SizeSpec(..)
+ , OutputType(..)
+
) where
-import Graphics.Rendering.Cairo
+import qualified Graphics.Rendering.Cairo as C
import Control.Monad.Reader
+import Data.Colour
+import Data.Colour.Names (black)
+import qualified Data.Colour.SRGB.Linear 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.
@@ -58,51 +70,94 @@
-- ^ An explicitly sized diagram whose bounding box
-- takes up a particular amount of space.
--- | 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)
+-- Colors ------------------------------------------------------------
--- | 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])
+-- | 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)
--- | The 'Color' type represents colors in red-green-blue-alpha
--- format, with each channel in the range 0-1. For a large list of
--- predefined colors, see "Graphics.Rendering.Diagrams.Colors".
-data Color = RGBA Double Double Double Double
- deriving (Eq, Show, Read)
+-- | Existential wrapper for instances of the 'Color' class.
+data SomeColor = forall c. Color c => SomeColor c
--- | Construct an opaque (alpha = 1) color from RGB values specified
--- as Doubles in the range 0-1.
-rgb :: Double -- ^ red channel
- -> Double -- ^ green channel
- -> Double -- ^ blue channel
- -> Color
-rgb r g b = rgba r g b 1
+-- 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.
+-- 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!
--- | Construct a color from RGBA values, specified as Doubles in the
--- range 0-1.
-rgba :: Double -- ^ red channel
- -> Double -- ^ green channel
- -> Double -- ^ blue channel
- -> Double -- ^ alpha (transparency) channel
- -> Color
-rgba = RGBA
+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'
+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
+
+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)
+
+-- Points ------------------------------------------------------------
+
-- | Basic 2D points/vectors.
type Point = (Double,Double)
+type Vec = Point
--- | Elementwise addition and multiplication for 'Point's.
-(.+), (.*) :: Point -> Point -> Point
-(x1,y1) .+ (x2,y2) = (x1 + x2, y1 + y2)
-(x1,y1) .* (x2,y2) = (x1 * x2, y1 * y2)
+-- | 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
@@ -125,6 +180,8 @@
-- former state afterwards.
renderAttr :: a -> DiaRenderM (DiaRenderEnv -> DiaRenderEnv)
+-- Shapes ------------------------------------------------------------
+
-- | Existential wrapper type for shapes.
data Shape = forall s. ShapeClass s => Shape s
@@ -156,44 +213,70 @@
-- | 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 :: Color
- , envStrokeColor :: Color
+data DiaRenderEnv = DREnv { envFillColor :: SomeColor
+ , envStrokeColor :: SomeColor
, envStrokeWidth :: Double
}
- deriving (Show)
-setEnvFillColor :: Color -> DiaRenderEnv -> DiaRenderEnv
-setEnvFillColor c d = d { envFillColor = c }
+setEnvFillColor :: Color c => c -> DiaRenderEnv -> DiaRenderEnv
+setEnvFillColor col d = d { envFillColor = SomeColor col }
-setEnvStrokeColor :: Color -> DiaRenderEnv -> DiaRenderEnv
-setEnvStrokeColor c d = d { envStrokeColor = c }
+setEnvStrokeColor :: Color c => c -> DiaRenderEnv -> DiaRenderEnv
+setEnvStrokeColor col d = d { envStrokeColor = SomeColor col }
setEnvStrokeWidth :: Double -> DiaRenderEnv -> DiaRenderEnv
-setEnvStrokeWidth c d = d { envStrokeWidth = c }
+setEnvStrokeWidth w d = d { envStrokeWidth = w }
-- | The default rendering environment: transparent fill with 1-pixel
-- black strokes.
defaultDiaRenderEnv :: DiaRenderEnv
-defaultDiaRenderEnv = DREnv { envFillColor = RGBA 1 1 1 0
- , envStrokeColor = RGBA 0 0 0 1
+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 Render a)
+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 -> Render a
+runDiaRenderM :: DiaRenderM a -> DiaRenderEnv -> C.Render a
runDiaRenderM (DRM m) e = runReaderT m e
-- | Lift a cairo @Render@ action into a 'DiaRenderM' action.
-c :: Render a -> DiaRenderM a
+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
diff --git a/README b/README
--- a/README
+++ b/README
@@ -1,12 +1,14 @@
Graphics.Rendering.Diagrams provides an embedded domain-specific
-language (EDSL) for creating simple diagrams in a compositional style.
+language (EDSL) for creating simple graphics in a compositional style.
+For some examples of use, see http://code.haskell.org/diagrams/ .
+
------------------------------------------------------------------------
-Building:
+To install the Diagrams library:
-Get the dependencies
+1. Get the dependencies
The diagrams library uses Haskell bindings to the Cairo vector
graphics library. In order to build the diagrams library, you
@@ -24,26 +26,39 @@
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.
-Build with Cabal:
+2. Build
- runhaskell Setup.lhs configure --prefix=$HOME --user
- runhaskell Setup.lhs build
- runhaskell Setup.lhs install
+ * Option 1: use cabal-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.)
+ If you have cabal-install, *after* installing gtk2hs, you can
+ install diagrams and the remaining dependencies with
+ cabal-install:
+ cabal install diagrams
-Building Haddock documentation (recommended):
+ Optionally, you can also pass options such as --user
+ --prefix=$HOME to install locally.
- runhaskell Setup.lhs haddock
+ * Option 2: manual build
- Once the documentation has been built, you can access it by
- pointing your browser to dist/doc/html/index.html.
+ 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.)
-For some examples of use, see
+3. Building Haddock documentation (recommended)
-http://byorgey.wordpress.com/2008/04/30/new-haskell-diagrams-library/
+ 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.
diff --git a/diagrams.cabal b/diagrams.cabal
--- a/diagrams.cabal
+++ b/diagrams.cabal
@@ -1,22 +1,33 @@
Name: diagrams
-Version: 0.1
+Version: 0.2
Stability: experimental
Description: An embedded domain-specific language (EDSL) for
creating simple diagrams, built on top of the Cairo
rendering engine.
+Homepage: http://code.haskell.org/diagrams
Synopsis: An EDSL for creating simple diagrams
License: BSD3
License-file: LICENSE
-Extra-source-files: README
+Extra-source-files: README,CHANGELOG
Author: Brent Yorgey
Maintainer: byorgey@gmail.com
Category: Graphics
-Build-Depends: base,mtl,cairo
Build-type: Simple
-Exposed-Modules: Graphics.Rendering.Diagrams,
+Cabal-version: >= 1.2
+
+flag testing
+ description: Testing mode
+ default: False
+
+library
+ ghc-options: -Wall
+ if flag(testing)
+ ghc-options: -Werror
+ Build-Depends: base,mtl,containers,cairo,colour
+ 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.Colors,
Graphics.Rendering.Diagrams.Engine