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