----------------------------------------------------------------------------- -- | -- 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))