-----------------------------------------------------------------------------
-- |
-- 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 ((^))
import Data.Monoid (Monoid (..))
import Data.Semigroup (Semigroup(..))

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

-- | A point in two dimensions.
data Point = Point {
    Point -> Double
p_x :: Double,
    Point -> Double
p_y :: Double
} deriving Int -> Point -> ShowS
[Point] -> ShowS
Point -> String
(Int -> Point -> ShowS)
-> (Point -> String) -> ([Point] -> ShowS) -> Show Point
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Point] -> ShowS
$cshowList :: [Point] -> ShowS
show :: Point -> String
$cshow :: Point -> String
showsPrec :: Int -> Point -> ShowS
$cshowsPrec :: Int -> Point -> ShowS
Show

-- | A vector in two dimensions.
data Vector = Vector {
    Vector -> Double
v_x :: Double,
    Vector -> Double
v_y :: Double
} deriving Int -> Vector -> ShowS
[Vector] -> ShowS
Vector -> String
(Int -> Vector -> ShowS)
-> (Vector -> String) -> ([Vector] -> ShowS) -> Show Vector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vector] -> ShowS
$cshowList :: [Vector] -> ShowS
show :: Vector -> String
$cshow :: Vector -> String
showsPrec :: Int -> Vector -> ShowS
$cshowsPrec :: Int -> Vector -> ShowS
Show

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

-- | Angle of a vector (counterclockwise from positive x-axis)
vangle :: Vector -> Double
vangle :: Vector -> Double
vangle (Vector Double
x Double
y)
    | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 = Double -> Double
forall a. Floating a => a -> a
atan (Double
yDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
x)
    | Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
0 = Double -> Double
forall a. Floating a => a -> a
atan (Double
yDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
x) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
forall a. Floating a => a
pi
    | Bool
otherwise = if Double
y Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 then Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2 else -Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2

-- | Length/magnitude of a vector
vlen :: Vector -> Double
vlen :: Vector -> Double
vlen (Vector Double
x Double
y) = Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ Double
xDouble -> Integer -> Double
forall a. Num a => a -> Integer -> a
^Integer
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
yDouble -> Integer -> Double
forall a. Num a => a -> Integer -> a
^Integer
2

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

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

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

-- | Subtract two points.
psub :: Point -> Point -> Vector
psub :: Point -> Point -> Vector
psub (Point Double
x1 Double
y1) (Point Double
x2 Double
y2) = Double -> Double -> Vector
Vector (Double
x1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
x2) (Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
y2)

data Limit a = LMin | LValue a | LMax
   deriving Int -> Limit a -> ShowS
[Limit a] -> ShowS
Limit a -> String
(Int -> Limit a -> ShowS)
-> (Limit a -> String) -> ([Limit a] -> ShowS) -> Show (Limit a)
forall a. Show a => Int -> Limit a -> ShowS
forall a. Show a => [Limit a] -> ShowS
forall a. Show a => Limit a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Limit a] -> ShowS
$cshowList :: forall a. Show a => [Limit a] -> ShowS
show :: Limit a -> String
$cshow :: forall a. Show a => Limit a -> String
showsPrec :: Int -> Limit a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Limit a -> ShowS
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 Int -> Rect -> ShowS
[Rect] -> ShowS
Rect -> String
(Int -> Rect -> ShowS)
-> (Rect -> String) -> ([Rect] -> ShowS) -> Show Rect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rect] -> ShowS
$cshowList :: [Rect] -> ShowS
show :: Rect -> String
$cshow :: Rect -> String
showsPrec :: Int -> Rect -> ShowS
$cshowsPrec :: Int -> Rect -> ShowS
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 -> Point -> Point -> Point -> Rect
mkrect (Point Double
x1 Double
_) (Point Double
_ Double
y2) (Point Double
x3 Double
_) (Point Double
_ Double
y4) =
    Point -> Point -> Rect
Rect (Double -> Double -> Point
Point Double
x1 Double
y2) (Double -> Double -> Point
Point Double
x3 Double
y4)

-- | Test if a point is within a rectangle.
within :: Point -> Rect -> Bool
within :: Point -> Rect -> Bool
within (Point Double
x Double
y) (Rect (Point Double
x1 Double
y1) (Point Double
x2 Double
y2)) =
    Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
x1 Bool -> Bool -> Bool
&& Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
x2 Bool -> Bool -> Bool
&& Double
y Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
y1 Bool -> Bool -> Bool
&& Double
y Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
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 :: Limit Rect -> Limit Rect -> Limit Rect
intersectRect Limit Rect
LMax Limit Rect
r = Limit Rect
r
intersectRect Limit Rect
r Limit Rect
LMax = Limit Rect
r
intersectRect Limit Rect
LMin Limit Rect
_ = Limit Rect
forall a. Limit a
LMin
intersectRect Limit Rect
_ Limit Rect
LMin = Limit Rect
forall a. Limit a
LMin
intersectRect (LValue (Rect (Point Double
x11 Double
y11) (Point Double
x12 Double
y12)))
              (LValue (Rect (Point Double
x21 Double
y21) (Point Double
x22 Double
y22))) =
  let p1 :: Point
p1@(Point Double
x1 Double
y1) = Double -> Double -> Point
Point (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
x11 Double
x21) (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
y11 Double
y21)
      p2 :: Point
p2@(Point Double
x2 Double
y2) = Double -> Double -> Point
Point (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
x12 Double
x22) (Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
y12 Double
y22)
  in if Double
x2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
x1 Bool -> Bool -> Bool
|| Double
y2 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
y1
        then Limit Rect
forall a. Limit a
LMin
        else Rect -> Limit Rect
forall a. a -> Limit a
LValue (Rect -> Limit Rect) -> Rect -> Limit Rect
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Rect
Rect Point
p1 Point
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 -> Path
rectPath (Rect p1 :: Point
p1@(Point Double
x1 Double
y1) p3 :: Point
p3@(Point Double
x2 Double
y2)) =
  let p2 :: Point
p2 = Double -> Double -> Point
Point Double
x1 Double
y2
      p4 :: Point
p4 = Double -> Double -> Point
Point Double
x2 Double
y1
  in Point -> Path
moveTo Point
p1 Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Point -> Path
lineTo Point
p2 Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Point -> Path
lineTo Point
p3 Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Point -> Path
lineTo Point
p4 Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
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
  Path
p1 <> :: Path -> Path -> Path
<> Path
p2 = case Path
p1 of
    MoveTo Point
p Path
path -> Point -> Path -> Path
MoveTo Point
p (Path -> Path) -> Path -> Path
forall a b. (a -> b) -> a -> b
$ Path
path Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
p2
    LineTo Point
p Path
path -> Point -> Path -> Path
LineTo Point
p (Path -> Path) -> Path -> Path
forall a b. (a -> b) -> a -> b
$ Path
path Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
p2
    Arc    Point
p Double
r Double
a1 Double
a2 Path
path -> Point -> Double -> Double -> Double -> Path -> Path
Arc Point
p Double
r Double
a1 Double
a2 (Path -> Path) -> Path -> Path
forall a b. (a -> b) -> a -> b
$ Path
path Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
p2
    ArcNeg Point
p Double
r Double
a1 Double
a2 Path
path -> Point -> Double -> Double -> Double -> Path -> Path
ArcNeg Point
p Double
r Double
a1 Double
a2 (Path -> Path) -> Path -> Path
forall a b. (a -> b) -> a -> b
$ Path
path Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
<> Path
p2
    Path
End   -> Path
p2
    Path
Close -> Path
Close

instance Monoid Path where
  mappend :: Path -> Path -> Path
mappend = Path -> Path -> Path
forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: Path
mempty = Path
End

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

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

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

-- | Short-cut for 'lineTo', if you don't want to create a 'Point'.
lineTo' :: Double -> Double -> Path
lineTo' :: Double -> Double -> Path
lineTo' Double
x Double
y = Point -> Path
lineTo (Point -> Path) -> Point -> Path
forall a b. (a -> b) -> a -> b
$ Double -> Double -> Point
Point Double
x Double
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 :: Point -> Double -> Double -> Double -> Path
arc Point
p Double
r Double
a1 Double
a2 = Point -> Double -> Double -> Double -> Path -> Path
Arc Point
p Double
r Double
a1 Double
a2 Path
forall a. Monoid a => a
mempty

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

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

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

-- | A closed empty path. Closes a path when appended.
close :: Path
close :: Path
close = Path
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 :: (Point -> m)
-> (Point -> m)
-> (Point -> Double -> Double -> Double -> m)
-> (Point -> Double -> Double -> Double -> m)
-> m
-> Path
-> m
foldPath Point -> m
moveTo_ Point -> m
lineTo_ Point -> Double -> Double -> Double -> m
arc_ Point -> Double -> Double -> Double -> m
arcNeg_ m
close_ Path
path =
  let restF :: Path -> m
restF = (Point -> m)
-> (Point -> m)
-> (Point -> Double -> Double -> Double -> m)
-> (Point -> Double -> Double -> Double -> m)
-> m
-> Path
-> m
forall m.
Monoid m =>
(Point -> m)
-> (Point -> m)
-> (Point -> Double -> Double -> Double -> m)
-> (Point -> Double -> Double -> Double -> m)
-> m
-> Path
-> m
foldPath Point -> m
moveTo_ Point -> m
lineTo_ Point -> Double -> Double -> Double -> m
arc_ Point -> Double -> Double -> Double -> m
arcNeg_ m
close_
  in case Path
path of
    MoveTo Point
p Path
rest -> Point -> m
moveTo_ Point
p m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` Path -> m
restF Path
rest
    LineTo Point
p Path
rest -> Point -> m
lineTo_ Point
p m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` Path -> m
restF Path
rest
    Arc    Point
p Double
r Double
a1 Double
a2 Path
rest -> Point -> Double -> Double -> Double -> m
arc_    Point
p Double
r Double
a1 Double
a2 m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` Path -> m
restF Path
rest
    ArcNeg Point
p Double
r Double
a1 Double
a2 Path
rest -> Point -> Double -> Double -> Double -> m
arcNeg_ Point
p Double
r Double
a1 Double
a2 m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` Path -> m
restF Path
rest
    Path
End   -> m
forall a. Monoid a => a
mempty
    Path
Close -> m
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 :: Path -> Path
makeLinesExplicit (Arc Point
c Double
r Double
s Double
e Path
rest) =
  Point -> Double -> Double -> Double -> Path -> Path
Arc Point
c Double
r Double
s Double
e (Path -> Path) -> Path -> Path
forall a b. (a -> b) -> a -> b
$ Path -> Path
makeLinesExplicit' Path
rest
makeLinesExplicit (ArcNeg Point
c Double
r Double
s Double
e Path
rest) =
  Point -> Double -> Double -> Double -> Path -> Path
ArcNeg Point
c Double
r Double
s Double
e (Path -> Path) -> Path -> Path
forall a b. (a -> b) -> a -> b
$ Path -> Path
makeLinesExplicit' Path
rest
makeLinesExplicit Path
path = Path -> Path
makeLinesExplicit' Path
path

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

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

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

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

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

-- | Translate a point.
translateP :: Vector -> Point -> Point
translateP :: Vector -> Point -> Point
translateP = (Point -> Vector -> Point) -> Vector -> Point -> Point
forall a b c. (a -> b -> c) -> b -> a -> c
flip Point -> Vector -> Point
pvadd

-- | Copied from Graphics.Rendering.Cairo.Matrix
data Matrix = Matrix { Matrix -> Double
xx :: !Double, Matrix -> Double
yx :: !Double,
                       Matrix -> Double
xy :: !Double, Matrix -> Double
yy :: !Double,
                       Matrix -> Double
x0 :: !Double, Matrix -> Double
y0 :: !Double }
                     deriving Int -> Matrix -> ShowS
[Matrix] -> ShowS
Matrix -> String
(Int -> Matrix -> ShowS)
-> (Matrix -> String) -> ([Matrix] -> ShowS) -> Show Matrix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Matrix] -> ShowS
$cshowList :: [Matrix] -> ShowS
show :: Matrix -> String
$cshow :: Matrix -> String
showsPrec :: Int -> Matrix -> ShowS
$cshowsPrec :: Int -> Matrix -> ShowS
Show

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

  + :: Matrix -> Matrix -> Matrix
(+) = (Double -> Double -> Double) -> Matrix -> Matrix -> Matrix
pointwise2 Double -> Double -> Double
forall a. Num a => a -> a -> a
(+)
  (-) = (Double -> Double -> Double) -> Matrix -> Matrix -> Matrix
pointwise2 (-)

  negate :: Matrix -> Matrix
negate = (Double -> Double) -> Matrix -> Matrix
pointwise Double -> Double
forall a. Num a => a -> a
negate
  abs :: Matrix -> Matrix
abs    = (Double -> Double) -> Matrix -> Matrix
pointwise Double -> Double
forall a. Num a => a -> a
abs
  signum :: Matrix -> Matrix
signum = (Double -> Double) -> Matrix -> Matrix
pointwise Double -> Double
forall a. Num a => a -> a
signum

  fromInteger :: Integer -> Matrix
fromInteger Integer
n = Double -> Double -> Double -> Double -> Double -> Double -> Matrix
Matrix (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
n) Double
0 Double
0 (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
n) Double
0 Double
0

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

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

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

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

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

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

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

-- | Copied from Graphics.Rendering.Cairo.Matrix
adjoint :: Matrix -> Matrix
adjoint :: Matrix -> Matrix
adjoint (Matrix Double
a Double
b Double
c Double
d Double
tx Double
ty) =
  Double -> Double -> Double -> Double -> Double -> Double -> Matrix
Matrix Double
d (-Double
b) (-Double
c) Double
a (Double
cDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
ty Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
dDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
tx) (Double
bDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
tx Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
aDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
ty)

-- | Copied from Graphics.Rendering.Cairo.Matrix
invert :: Matrix -> Matrix
invert :: Matrix -> Matrix
invert m :: Matrix
m@(Matrix Double
xx_ Double
yx_ Double
xy_ Double
yy_ Double
_ Double
_) = Double -> Matrix -> Matrix
scalarMultiply (Double -> Double
forall a. Fractional a => a -> a
recip Double
det) (Matrix -> Matrix) -> Matrix -> Matrix
forall a b. (a -> b) -> a -> b
$ Matrix -> Matrix
adjoint Matrix
m
  where det :: Double
det = Double
xx_Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
yy_ Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
yx_Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
xy_