diagrams-0.2: Graphics/Rendering/Diagrams/Paths.hs
-----------------------------------------------------------------------------
-- |
-- 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