-----------------------------------------------------------------------------
-- |
-- Module      :  Graphics.Rendering.Chart.Geometry
-- Copyright   :  (c) Tim Docker 2006, 2014
-- License     :  BSD-style (see chart/COPYRIGHT)
--
module Graphics.Rendering.Chart.Geometry
  ( -- * Points and Vectors
    Rect(..)
  , Point(..)
  , Vector(..)

  , RectSize
  , Range

  , pointToVec

  , mkrect
  , rectPath
  , pvadd
  , pvsub
  , psub
  , vangle
  , vlen
  , vscale
  , within
  , intersectRect

  , RectEdge(..)
  , Limit(..)
  , PointMapFn

  -- * Paths
  , Path(..)
  , lineTo, moveTo
  , lineTo', moveTo'
  , arc, arc'
  , arcNeg, arcNeg'
  , close

  , foldPath
  , makeLinesExplicit

  -- * Matrices
  , transformP, scaleP, rotateP, translateP
  , Matrix(..)
  , identity
  , rotate, scale, translate
  , scalarMultiply
  , adjoint
  , invert
  ) where

import qualified Prelude
import Prelude hiding ((^))

-- The homomorphic version to avoid casts inside the code.
(^) :: Num a => a -> Integer -> a
(^) = (Prelude.^)

-- | A point in two dimensions.
data Point = Point {
    p_x :: Double,
    p_y :: Double
} deriving Show

-- | A vector in two dimensions.
data Vector = Vector {
    v_x :: Double,
    v_y :: Double
} deriving Show

-- | Convert a 'Point' to a 'Vector'.
pointToVec :: Point -> Vector
pointToVec (Point x y) = Vector x y

-- | Angle of a vector (counterclockwise from positive x-axis)
vangle :: Vector -> Double
vangle (Vector x y)
    | x > 0 = atan (y/x)
    | x < 0 = atan (y/x) + pi
    | otherwise = if y > 0 then pi/2 else -pi/2

-- | Length/magnitude of a vector
vlen :: Vector -> Double
vlen (Vector x y) = sqrt $ x^2 + y^2

-- | Scale a vector by a constant.
vscale :: Double -> Vector -> Vector
vscale c (Vector x y) = Vector (x*c) (y*c)

-- | Add a point and a vector.
pvadd :: Point -> Vector -> Point
pvadd (Point x1 y1) (Vector x2 y2) = Point (x1+x2) (y1+y2)

-- | Subtract a vector from a point.
pvsub :: Point -> Vector -> Point
pvsub (Point x1 y1) (Vector x2 y2) = Point (x1-x2) (y1-y2)

-- | Subtract two points.
psub :: Point -> Point -> Vector
psub (Point x1 y1) (Point x2 y2) = Vector (x1-x2) (y1-y2)

data Limit a = LMin | LValue a | LMax
   deriving Show

-- | A function mapping between points.
type PointMapFn x y = (Limit x, Limit y) -> Point

-- | A rectangle is defined by two points.
data Rect = Rect Point Point
   deriving Show

-- | Edge of a rectangle.
data RectEdge = E_Top | E_Bottom | E_Left | E_Right

-- | Create a rectangle based upon the coordinates of 4 points.
mkrect :: Point -> Point -> Point -> Point -> Rect
mkrect (Point x1 _) (Point _ y2) (Point x3 _) (Point _ y4) =
    Rect (Point x1 y2) (Point x3 y4)

-- | Test if a point is within a rectangle.
within :: Point -> Rect -> Bool
within (Point x y) (Rect (Point x1 y1) (Point x2 y2)) =
    x >= x1 && x <= x2 && y >= y1 && y <= y2

-- | Intersects the rectangles. If they intersect the
--   intersection rectangle is returned.
--   'LMin' is the empty rectangle / intersection and
--   'LMax' is the infinite plane.
intersectRect :: Limit Rect -> Limit Rect -> Limit Rect
intersectRect LMax r = r
intersectRect r LMax = r
intersectRect LMin _ = LMin
intersectRect _ LMin = LMin
intersectRect (LValue (Rect (Point x11 y11) (Point x12 y12)))
              (LValue (Rect (Point x21 y21) (Point x22 y22))) =
  let p1@(Point x1 y1) = Point (max x11 x21) (max y11 y21)
      p2@(Point x2 y2) = Point (min x12 x22) (min y12 y22)
  in if x2 < x1 || y2 < y1
        then LMin
        else LValue $ Rect p1 p2

type Range    = (Double,Double)
type RectSize = (Double,Double)

{-
-- | Make a path from a rectangle.
rectPointPath :: Rect -> [Point]
rectPointPath (Rect p1@(Point x1 y1) p3@(Point x2 y2)) = [p1,p2,p3,p4,p1]
  where
    p2 = (Point x1 y2)
    p4 = (Point x2 y1)
-}

-- | Make a path from a rectangle.
rectPath :: Rect -> Path
rectPath (Rect p1@(Point x1 y1) p3@(Point x2 y2)) =
  let p2 = Point x1 y2
      p4 = Point x2 y1
  in moveTo p1 <> lineTo p2 <> lineTo p3 <> lineTo p4 <> close

-- -----------------------------------------------------------------------
-- Path Types
-- -----------------------------------------------------------------------

-- | The path type used by Charts.
--
--   A path can consist of several subpaths. Each
--   is started by a 'MoveTo' operation. All subpaths
--   are open, except the last one, which may be closed
--   using the 'Close' operation. When filling a path
--   all subpaths are closed implicitly.
--
--   Closing a subpath means that a line is drawn from
--   the end point to the start point of the subpath.
--
--   If a 'Arc' (or 'ArcNeg') is drawn a implicit line
--   from the last end point of the subpath is drawn
--   to the beginning of the arc. Another implicit line
--   is drawn from the end of an arc to the beginning of
--   the next path segment.
--
--   The beginning of a subpath is either (0,0) or set
--   by a 'MoveTo' instruction. If the first subpath is started
--   with an arc the beginning of that subpath is the beginning
--   of the arc.
data Path = MoveTo Point Path
          | LineTo Point Path
          | Arc Point Double Double Double Path
          | ArcNeg Point Double Double Double Path
          | End
          | Close

-- | Paths are monoids. After a path is closed you can not append
--   anything to it anymore. The empty path is open.
--   Use 'close' to close a path.
instance Semigroup Path where
  p1 <> p2 = case p1 of
    MoveTo p path -> MoveTo p $ path <> p2
    LineTo p path -> LineTo p $ path <> p2
    Arc    p r a1 a2 path -> Arc p r a1 a2 $ path <> p2
    ArcNeg p r a1 a2 path -> ArcNeg p r a1 a2 $ path <> p2
    End   -> p2
    Close -> Close

instance Monoid Path where
  mappend = (<>)
  mempty = End

-- | Move the paths pointer to the given location.
moveTo :: Point -> Path
moveTo p = MoveTo p mempty

-- | Short-cut for 'moveTo', if you don't want to create a 'Point'.
moveTo' :: Double -> Double -> Path
moveTo' x y = moveTo $ Point x y

-- | Move the paths pointer to the given location and draw a straight
--   line while doing so.
lineTo :: Point -> Path
lineTo p = LineTo p mempty

-- | Short-cut for 'lineTo', if you don't want to create a 'Point'.
lineTo' :: Double -> Double -> Path
lineTo' x y = lineTo $ Point x y

-- | Draw the arc of a circle. A straight line connects
--   the end of the previous path with the beginning of the arc.
--   The zero angle points in direction of the positive x-axis.
--   Angles increase in clock-wise direction. If the stop angle
--   is smaller then the start angle it is increased by multiples of
--   @2 * pi@ until is is greater or equal.
arc :: Point  -- ^ Center point of the circle arc.
    -> Double -- ^ Radius of the circle.
    -> Double -- ^ Angle to start drawing at, in radians.
    -> Double -- ^ Angle to stop drawing at, in radians.
    -> Path
arc p r a1 a2 = Arc p r a1 a2 mempty

-- | Short-cut for 'arc', if you don't want to create a 'Point'.
arc' :: Double -> Double -> Double -> Double -> Double -> Path
arc' x y r a1 a2 = Arc (Point x y) r a1 a2 mempty

-- | Like 'arc', but draws from the stop angle to the start angle
--   instead of between them.
arcNeg :: Point -> Double -> Double -> Double -> Path
arcNeg p r a1 a2 = ArcNeg p r a1 a2 mempty

-- | Short-cut for 'arcNeg', if you don't want to create a 'Point'.
arcNeg' :: Double -> Double -> Double -> Double -> Double -> Path
arcNeg' x y r a1 a2 = ArcNeg (Point x y) r a1 a2 mempty

-- | A closed empty path. Closes a path when appended.
close :: Path
close = Close

-- | Fold the given path to a monoid structure.
foldPath :: (Monoid m)
         => (Point -> m) -- ^ MoveTo
         -> (Point -> m) -- ^ LineTo
         -> (Point -> Double -> Double -> Double -> m) -- ^ Arc
         -> (Point -> Double -> Double -> Double -> m) -- ^ ArcNeg
         -> m    -- ^ Close
         -> Path -- ^ Path to fold
         -> m
foldPath moveTo_ lineTo_ arc_ arcNeg_ close_ path =
  let restF = foldPath moveTo_ lineTo_ arc_ arcNeg_ close_
  in case path of
    MoveTo p rest -> moveTo_ p `mappend` restF rest
    LineTo p rest -> lineTo_ p `mappend` restF rest
    Arc    p r a1 a2 rest -> arc_    p r a1 a2 `mappend` restF rest
    ArcNeg p r a1 a2 rest -> arcNeg_ p r a1 a2 `mappend` restF rest
    End   -> mempty
    Close -> close_

-- | Enriches the path with explicit instructions to draw lines,
--   that otherwise would be implicit. See 'Path' for details
--   about what lines in paths are implicit.
makeLinesExplicit :: Path -> Path
makeLinesExplicit (Arc c r s e rest) =
  Arc c r s e $ makeLinesExplicit' rest
makeLinesExplicit (ArcNeg c r s e rest) =
  ArcNeg c r s e $ makeLinesExplicit' rest
makeLinesExplicit path = makeLinesExplicit' path

-- | Utility for 'makeLinesExplicit'.
makeLinesExplicit' :: Path -> Path
makeLinesExplicit' End   = End
makeLinesExplicit' Close = Close
makeLinesExplicit' (Arc c r s e rest) =
  let p = translateP (pointToVec c) $ rotateP s $ Point r 0
  in lineTo p <> arc c r s e <> makeLinesExplicit' rest
makeLinesExplicit' (ArcNeg c r s e rest) =
  let p = translateP (pointToVec c) $ rotateP s $ Point r 0
  in lineTo p <> arcNeg c r s e <> makeLinesExplicit' rest
makeLinesExplicit' (MoveTo p0 rest) =
  MoveTo p0 $ makeLinesExplicit' rest
makeLinesExplicit' (LineTo p0 rest) =
  LineTo p0 $ makeLinesExplicit' rest

-- -----------------------------------------------------------------------
-- Matrix Type
-- -----------------------------------------------------------------------

-- | Transform a point using the given matrix.
transformP :: Matrix -> Point -> Point
transformP t (Point x y) = Point
  (xx t * x + xy t * y + x0 t)
  (yx t * x + yy t * y + y0 t)

-- | Rotate a point around the origin.
--   The angle is given in radians.
rotateP :: Double -> Point -> Point
rotateP a = transformP (rotate a 1)

-- | Scale a point.
scaleP :: Vector -> Point -> Point
scaleP s = transformP (scale s 1)

-- | Translate a point.
translateP :: Vector -> Point -> Point
translateP = flip pvadd

-- | Copied from Graphics.Rendering.Cairo.Matrix
data Matrix = Matrix { xx :: !Double, yx :: !Double,
                       xy :: !Double, yy :: !Double,
                       x0 :: !Double, y0 :: !Double }
                     deriving Show

-- | Copied from Graphics.Rendering.Cairo.Matrix
instance Num Matrix where
  -- use underscore to avoid ghc complaints about shadowing the Matrix
  -- field names
  (*) (Matrix xx_ yx_ xy_ yy_ x0_ y0_)
      (Matrix xx'_ yx'_ xy'_ yy'_ x0'_ y0'_) =
    Matrix (xx_ * xx'_ + yx_ * xy'_)
           (xx_ * yx'_ + yx_ * yy'_)
           (xy_ * xx'_ + yy_ * xy'_)
           (xy_ * yx'_ + yy_ * yy'_)
           (x0_ * xx'_ + y0_ * xy'_ + x0'_)
           (x0_ * yx'_ + y0_ * yy'_ + y0'_)

  (+) = pointwise2 (+)
  (-) = pointwise2 (-)

  negate = pointwise negate
  abs    = pointwise abs
  signum = pointwise signum

  fromInteger n = Matrix (fromInteger n) 0 0 (fromInteger n) 0 0

-- | Copied from Graphics.Rendering.Cairo.Matrix
{-# INLINE pointwise #-}
pointwise :: (Double -> Double) -> Matrix -> Matrix
pointwise f (Matrix xx_ yx_ xy_ yy_ x0_ y0_) =
  Matrix (f xx_) (f yx_) (f xy_) (f yy_) (f x0_) (f y0_)

-- | Copied from Graphics.Rendering.Cairo.Matrix
{-# INLINE pointwise2 #-}
pointwise2 :: (Double -> Double -> Double) -> Matrix -> Matrix -> Matrix
pointwise2 f (Matrix xx_ yx_ xy_ yy_ x0_ y0_) (Matrix xx'_ yx'_ xy'_ yy'_ x0'_ y0'_) =
  Matrix (f xx_ xx'_) (f yx_ yx'_) (f xy_ xy'_) (f yy_ yy'_) (f x0_ x0'_) (f y0_ y0'_)

-- | Copied from Graphics.Rendering.Cairo.Matrix
identity :: Matrix
identity = Matrix 1 0 0 1 0 0

-- | Copied and adopted from Graphics.Rendering.Cairo.Matrix
translate :: Vector -> Matrix -> Matrix
translate tv m = m * Matrix 1 0 0 1 (v_x tv) (v_y tv)

-- | Copied and adopted from Graphics.Rendering.Cairo.Matrix
scale :: Vector -> Matrix -> Matrix
scale sv m = m * Matrix (v_x sv) 0 0 (v_y sv) 0 0

-- | Copied from Graphics.Rendering.Cairo.Matrix
--   Rotations angle is given in radians.
rotate :: Double -> Matrix -> Matrix
rotate r m = m * Matrix c s (-s) c 0 0
  where s = sin r
        c = cos r

-- | Copied from Graphics.Rendering.Cairo.Matrix
scalarMultiply :: Double -> Matrix -> Matrix
scalarMultiply scalar = pointwise (* scalar)

-- | Copied from Graphics.Rendering.Cairo.Matrix
adjoint :: Matrix -> Matrix
adjoint (Matrix a b c d tx ty) =
  Matrix d (-b) (-c) a (c*ty - d*tx) (b*tx - a*ty)

-- | Copied from Graphics.Rendering.Cairo.Matrix
invert :: Matrix -> Matrix
invert m@(Matrix xx_ yx_ xy_ yy_ _ _) = scalarMultiply (recip det) $ adjoint m
  where det = xx_*yy_ - yx_*xy_