----------------------------------------------------------------------------- -- | -- Module : Graphics.Rendering.Diagrams.Paths -- Copyright : (c) Brent Yorgey 2008 -- License : BSD-style (see LICENSE) -- Maintainer : byorgey@gmail.com -- Stability : experimental -- Portability : portable -- -- Type definitions and convenience functions for -- "Graphics.Rendering.Diagrams", an embedded domain-specific language -- (EDSL) for creating simple diagrams. -- ----------------------------------------------------------------------------- module Graphics.Rendering.Diagrams.Paths ( emptyPath , pathFromVertices, pathFromVectors , pathToVertices, pathToVectors , pathConcat , closed, isClosed , rotPath , pathSizeAndOffset , renderPath ) where import Graphics.Rendering.Diagrams.Types import qualified Graphics.Rendering.Cairo as C import Control.Monad (when) -- | \"Integrate\" a path given by a starting point and a sequence of -- displacements, resulting in a list of vertex coordinates. pathInt :: Point -> Path -> [Point] pathInt s (Path _ vs) = scanl (.+.) s vs -- | Convert a path into a list of vertices, starting with the given -- vertex. pathToVertices :: Point -> Path -> [Point] pathToVertices = pathInt -- | \"Differentiate\" a list of vertex coordinates to produce an open -- path. Calling 'pathDeriv' on an empty list will result in a -- run-time error. pathDeriv :: [Point] -> Path pathDeriv ps = Path Open $ zipWith (.-.) (tail ps) ps -- | Create an open path from a list of edge displacement vectors. -- For example, @pathFromVectors [(1,1), (3,4)]@ describes the path -- with two segments which first moves one unit in the positive x -- and y directions, and then moves three units in the positive x -- direction and four in the positive y direction. pathFromVectors :: [Vec] -> Path pathFromVectors = Path Open -- | Convert a path to a list of vectors corresponding to the edges of -- the path. pathToVectors :: Path -> [Vec] pathToVectors (Path _ vs) = vs -- | The empty path, i.e. a path with no edges. emptyPath :: Path emptyPath = pathFromVectors [] -- | Create an open path from a list of vertices. For example, -- @pathFromVertices [(1,3), (4,4), (6,5)]@ describes the path with -- two segments which starts at (1,3), has a corner at (4,4), and -- ends at (6,5). Note, however, that the vertices themselves are -- not significant, only the distances between them. That is, -- @pathFromVertices [(0,1), (3,2), (5,3)]@ describes exactly the -- same path. pathFromVertices :: [Point] -> Path pathFromVertices [] = emptyPath pathFromVertices vs = pathDeriv vs -- | Concatenate two open paths into a single open path consisting of -- the first followed by the second. pathConcat :: Path -> Path -> Path pathConcat (Path _ es1) (Path _ es2) = Path Open (es1 ++ es2) -- | Create a closed path (by connecting the first and last points in -- the path). closed :: Path -> Path closed (Path _ vs) = Path Closed vs -- | Determine whether a 'Path' is closed or open. isClosed :: Path -> Bool isClosed (Path Closed _) = True isClosed _ = False -- | Rotate a path by a fraction of a circle. @rotPath d@ rotates -- paths by an angle of @d*2*pi@ radians. Note that creating a -- 'Diagram' from a 'Path' (using 'straight' or 'curved' or some -- other such function) and then applying 'rotate' to it is -- different than first applying 'rotPath' to the 'Path' before -- making it into a 'Diagram'. In the latter case, the bounding box -- will be correct, whereas in the former case, the bounding box -- will still correspond to the unrotated version of the path. rotPath :: Double -> Path -> Path rotPath d (Path clsd ps) = Path clsd (map rot ps) where ang = d*2*pi ca = cos ang sa = sin ang rot (x,y) = (x * ca - y * sa, x * sa + y * ca) -- | Compute the size of a bounding box for the given 'Path', and the -- | offset of the starting vertex from the center. pathSizeAndOffset :: Path -> (Vec,Point) pathSizeAndOffset p = case pathInt (0,0) p of [] -> ((0,0),(0,0)) ps -> ((xmax - xmin, ymax - ymin), ((-xmax - xmin)/2, (-ymax - ymin)/2)) where (xs,ys) = unzip ps xmax = maximum xs xmin = minimum xs ymax = maximum ys ymin = minimum ys -- | Render a path using a particular style in the Cairo rendering monad. renderPath :: PathStyle -> Path -> C.Render () renderPath Straight = renderPathStraight renderPath (Bezier d) = renderPathBezier d -- | Render a path using straight line segments. renderPathStraight :: Path -> C.Render () renderPathStraight p@(Path clsd vs) = do let (_,offs) = pathSizeAndOffset p -- not nice to recalculate this, -- but oh well uncurry C.moveTo offs -- move to the start mapM_ (uncurry C.relLineTo) vs -- draw all the segments when (clsd==Closed) $ C.closePath -- maybe close the path -- | Render a path using Bezier curves. The first parameter -- determines what fraction of the path segments will be rounded off -- with curves; the remainder of the segments will be drawn with -- straight lines. renderPathBezier :: Double -> Path -> C.Render () renderPathBezier _ (Path _ []) = return () renderPathBezier d p@(Path clsd segs) | d > 1 = renderPathBezier 1 p | d < 0 = renderPathBezier 0 p | otherwise = do let (_,offs) = pathSizeAndOffset p segcls = ((-1)*.) . last $ pathInt (0,0) p isClsd = (clsd == Closed) uncurry C.moveTo offs -- move to the first path vertex -- move to start of the first straight segment -- (draw a line if not closed) uncurry (if' isClsd C.relMoveTo C.relLineTo) ((d/2) *. head segs) -- draw (straight, curved) pairs along path mapM_ (drawCurveSegment d) (zip segs (tail segs)) -- if closed path, we still need to draw -- two more (straight, curved) pairs: -- one for last segment + closing -- segment, one for closing segment + -- first segment if isClsd then do drawCurveSegment d (last segs, segcls) drawCurveSegment d (segcls, head segs) else -- otherwise, just finish off the last -- segment with a straight line uncurry C.relLineTo ((1 - d/2) *. last segs) if' :: Bool -> a -> a -> a if' True x _ = x if' False _ x = x -- | Given a fraction specifying which part of the segments should be -- rounded off, and two segments, draw the straight portion of the -- first segment and the curve between the first and second -- segments, using the shared vertex as a control point. drawCurveSegment :: Double -> (Vec,Vec) -> C.Render () drawCurveSegment d (v1, v2) = do let s = 1 - d uncurry C.relLineTo $ s *. v1 let ctrl@(ctrlx, ctrly) = (d/2) *. v1 let (endx, endy) = ctrl .+. ((d/2) *. v2) C.relCurveTo ctrlx ctrly ctrlx ctrly endx endy