content: {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE GADTs #-}
  {-# LANGUAGE FlexibleInstances #-}
  -- | Gather all the types used in the rasterization engine.
  module Graphics.Rasterific.Types
      ( -- * Geometry description
        Vector
      , Point
      , Line( .. )
      , Bezier( .. )
      , CubicBezier( .. )
      , Primitive( .. )
  
      , Primitivable( .. )
      , Geometry( .. )
  
      , Producer
      , Container
      , containerOfList
      , listOfContainer
      , containerOfFunction
      , PathCommand( .. )
      , Path( .. )
      , Transformable( .. )
      , PointFoldable( .. )
  
        -- * Rasterization control types
      , Cap( .. )
      , Join( .. )
      , FillMethod( .. )
      , SamplerRepeat( .. )
      , DashPattern
      , StrokeWidth
  
        -- * Internal type
      , EdgeSample( .. )
      , pathToPrimitives
  
        -- * Little geometry helpers
      , firstTangeantOf
      , lastTangeantOf
      , firstPointOf
      , lastPointOf
      , resplit
  
        -- * RankNType helper
      , Proxy( Proxy )
      ) where
  
  import Data.DList( DList, fromList )
  
  import Control.Monad.Identity( runIdentity )
  import Data.Foldable( foldl', toList )
  import qualified Data.Foldable as F
  import Graphics.Rasterific.Linear( V2( .. ), (^-^), nearZero )
  import Graphics.Rasterific.Operators
  import Foreign.Ptr( castPtr )
  import Foreign.Storable( Storable( sizeOf
                         , alignment
                         , peek
                         , poke
                         , peekElemOff
                         , pokeElemOff ) )
  
  -- | Represent a vector
  type Vector = V2 Float
  
  -- | Type alias just to get more meaningful
  -- type signatures
  type StrokeWidth = Float
  
  -- | Dash pattern to use
  type DashPattern = [Float]
  
  data Proxy p = Proxy
  
  -- | Describe how we will "finish" the stroking
  -- that don't loop.
  data Cap
      -- | Create a straight caping on the stroke.
      -- Cap value should be positive and represent
      -- the distance from the end of curve to the actual cap
      --
      --  * cap straight with param 0 : <<docimages/cap_straight.png>>
      --
      --  * cap straight with param 1 : <<docimages/cap_straight_1.png>>
      --
    = CapStraight Float
  
      -- | Create a rounded caping on the stroke.
      -- <<docimages/cap_round.png>>
    | CapRound
    deriving (Eq, Show)
  
  -- | Describe how to display the join of broken lines
  -- while stroking.
  data Join
      -- | Make a curved join.
      -- <<docimages/join_round.png>>
    = JoinRound
      -- | Make a mitter join. Value must be positive or null.
      -- Seems to make sense in [0;1] only
      --
      --  * Miter join with 0 : <<docimages/join_miter.png>>
      --
      --  * Miter join with 5 : <<docimages/join_miter_5.png>>
      --
    | JoinMiter Float
    deriving (Eq, Show)
  
  -- | Tell how to fill complex shapes when there is self 
  -- intersections. If the filling mode is not specified,
  -- then it's the `FillWinding` method which is used.
  --
  -- The examples used are produced with the following
  -- function:
  --
  --
  -- > fillingSample :: FillMethod -> Drawing px ()
  -- > fillingSample fillMethod = fillWithMethod fillMethod geometry where
  -- >   geometry = transform (applyTransformation $ scale 0.35 0.4
  -- >                                            <> translate (V2 (-80) (-180)))
  -- >      [ Path (V2 484 499) True
  -- >          [ PathCubicBezierCurveTo (V2 681 452) (V2 639 312) (V2 541 314)
  -- >          , PathCubicBezierCurveTo (V2 327 337) (V2 224 562) (V2 484 499)
  -- >          ]
  -- >      , Path (V2 136 377) True
  -- >          [ PathCubicBezierCurveTo (V2 244 253) (V2 424 420) (V2 357 489)
  -- >          , PathCubicBezierCurveTo (V2 302 582) (V2 47 481) (V2 136 377)
  -- >          ]
  -- >      , Path (V2 340 265) True
  -- >          [ PathCubicBezierCurveTo (V2 64 371) (V2 128 748) (V2 343 536)
  -- >          , PathCubicBezierCurveTo (V2 668 216) (V2 17 273) (V2 367 575)
  -- >          , PathCubicBezierCurveTo (V2 589 727) (V2 615 159) (V2 340 265)
  -- >          ]
  -- >      ]
  data FillMethod
    -- | Also known as nonzero rule.
    -- To determine if a point falls inside the curve, you draw 
    -- an imaginary line through that point. Next you will count
    -- how many times that line crosses the curve before it reaches
    -- that point. For every clockwise rotation, you subtract 1 and
    -- for every counter-clockwise rotation you add 1.
    --
    -- <<docimages/fill_winding.png>>
    = FillWinding
  
    -- | This rule determines the insideness of a point on 
    -- the canvas by drawing a ray from that point to infinity
    -- in any direction and counting the number of path segments
    -- from the given shape that the ray crosses. If this number
    -- is odd, the point is inside; if even, the point is outside.
    --
    -- <<docimages/fill_evenodd.png>>
    | FillEvenOdd
    deriving (Eq, Enum, Show)
  
  -- | Describe the behaviour of samplers and texturers
  -- when they are out of the bounds of image and/or gradient.
  data SamplerRepeat
      -- | Will clamp (ie. repeat the last pixel) when
      -- out of bound
      -- <<docimages/sampler_pad.png>>
    = SamplerPad
      -- | Will loop on it's definition domain
      -- <<docimages/sampler_repeat.png>>
    | SamplerRepeat
      -- | Will loop inverting axises
      -- <<docimages/sampler_reflect.png>>
    | SamplerReflect
    deriving (Eq, Enum, Show)
  
  -- | Represent a raster line
  data EdgeSample = EdgeSample
    { _sampleX     :: {-# UNPACK #-} !Float -- ^ Horizontal position
    , _sampleY     :: {-# UNPACK #-} !Float -- ^ Vertical position
    , _sampleAlpha :: {-# UNPACK #-} !Float -- ^ Alpha
    , _sampleH     :: {-# UNPACK #-} !Float -- ^ Height
    }
    deriving Show
  
  -- | Just to get faster sorting
  instance Storable EdgeSample where
     sizeOf _ = 4 * sizeOf (0 :: Float)
     alignment = sizeOf
  
     {-# INLINE peek #-}
     peek ptr = do
       let q = castPtr ptr
       sx <- peekElemOff q 0
       sy <- peekElemOff q 1
       sa <- peekElemOff q 2
       sh <- peekElemOff q 3
       return $ EdgeSample sx sy sa sh
        
     {-# INLINE poke #-}
     poke ptr (EdgeSample sx sy sa sh) = do
       let q = castPtr ptr
       pokeElemOff q 0 sx
       pokeElemOff q 1 sy
       pokeElemOff q 2 sa
       pokeElemOff q 3 sh
  
  -- | This typeclass is there to help transform the geometry,
  -- by applying a transformation on every point of a geometric
  -- element.
  class Transformable a where
      -- | Apply a transformation function for every
      --  point in the element.
      transform :: (Point -> Point) -> a -> a
      transform f = runIdentity . transformM (return . f)
  
      -- | Transform but monadic
      transformM :: Monad m => (Point -> m Point) -> a -> m a
  
  -- | Typeclass helper gathering all the points of a given
  -- geometry.
  class PointFoldable a where
      -- | Fold an accumulator on all the points of
      -- the primitive.
      foldPoints :: (b -> Point -> b) -> b -> a -> b
  
  -- | Just apply the function
  instance Transformable Point where
      {-# INLINE transform #-}
      transform f = f
      {-# INLINE transformM #-}
      transformM f = f
  
  -- | Just apply the function
  instance PointFoldable Point where
      {-# INLINE foldPoints #-}
      foldPoints f = f
  
  -- | Describe a simple 2D line between two points.
  --
  -- > fill [ Line (V2 10 10) (V2 190 10)
  -- >      , Line (V2 190 10) (V2 95 170)
  -- >      , Line (V2 95 170) (V2 10 10)]
  --
  -- <<docimages/simple_line.png>>
  --
  data Line = Line
    { _lineX0 :: {-# UNPACK #-} !Point -- ^ Origin point
    , _lineX1 :: {-# UNPACK #-} !Point -- ^ End point
    }
    deriving Eq
  
  instance Show Line where
    show (Line a b) =
        "Line (" ++ show a ++ ") ("
                 ++ show b ++ ")"
  
  instance Transformable Line where
      {-# INLINE transformM #-}
      transformM f (Line a b) = Line <$> f a <*> f b
  
  instance PointFoldable Line where
      {-# INLINE foldPoints #-}
      foldPoints f acc (Line a b) = f (f acc b) a
  
  -- | Describe a quadratic bezier spline, described
  -- using 3 points.
  --
  -- > fill [Bezier (V2 10 10) (V2 200 50) (V2 200 100)
  -- >      ,Bezier (V2 200 100) (V2 150 200) (V2 120 175)
  -- >      ,Bezier (V2 120 175) (V2 30 100) (V2 10 10)]
  --
  -- <<docimages/quadratic_bezier.png>>
  --
  data Bezier = Bezier
    { -- | Origin points, the spline will pass through it.
      _bezierX0 :: {-# UNPACK #-} !Point
      -- | Control point, the spline won't pass on it.
    , _bezierX1 :: {-# UNPACK #-} !Point
      -- | End point, the spline will pass through it.
    , _bezierX2 :: {-# UNPACK #-} !Point
    }
    deriving Eq
  
  instance Show Bezier where
      show (Bezier a b c) =
          "Bezier (" ++ show a ++ ") ("
                     ++ show b ++ ") ("
                     ++ show c ++ ")"
  
  instance Transformable Bezier where
      {-# INLINE transform #-}
      transform f (Bezier a b c) = Bezier (f a) (f b) $ f c
      {-# INLINE transformM #-}
      transformM f (Bezier a b c) = Bezier <$> f a <*> f b <*> f c
  
  instance PointFoldable Bezier where
      {-# INLINE foldPoints #-}
      foldPoints f acc (Bezier a b c) =
          foldl' f acc [a, b, c]
  
  -- | Describe a cubic bezier spline, described
  -- using 4 points.
  --
  -- > stroke 4 JoinRound (CapRound, CapRound) $
  -- >    CubicBezier (V2 0 10) (V2 205 250) (V2 (-10) 250) (V2 160 35)
  --
  -- <<docimages/cubic_bezier.png>>
  --
  data CubicBezier = CubicBezier
    { -- | Origin point, the spline will pass through it.
      _cBezierX0 :: {-# UNPACK #-} !Point
      -- | First control point of the cubic bezier curve.
    , _cBezierX1 :: {-# UNPACK #-} !Point
      -- | Second control point of the cubic bezier curve.
    , _cBezierX2 :: {-# UNPACK #-} !Point
      -- | End point of the cubic bezier curve
    , _cBezierX3 :: {-# UNPACK #-} !Point
    }
    deriving Eq
  
  instance Show CubicBezier where
    show (CubicBezier a b c d) =
       "CubicBezier (" ++ show a ++ ") ("
                  ++ show b ++ ") ("
                  ++ show c ++ ") ("
                  ++ show d ++ ")"
  
  instance Transformable CubicBezier where
      {-# INLINE transform #-}
      transform f (CubicBezier a b c d) =
         CubicBezier (f a) (f b) (f c) $ f d
      transformM f (CubicBezier a b c d) =
         CubicBezier <$> f a <*> f b <*> f c <*> f d
  
  instance PointFoldable CubicBezier where
      {-# INLINE foldPoints #-}
      foldPoints f acc (CubicBezier a b c d) =
          foldl' f acc [a, b, c, d]
  
  -- | This datatype gather all the renderable primitives,
  -- they are kept separated otherwise to allow specialization
  -- on some specific algorithms. You can mix the different
  -- primitives in a single call :
  --
  -- > fill [ toPrim $ CubicBezier (V2 50 20) (V2 90 60)
  -- >                             (V2  5 100) (V2 50 140)
  -- >      , toPrim $ Line (V2 50 140) (V2 120 80)
  -- >      , toPrim $ Line (V2 120 80) (V2 50 20) ]
  --
  -- <<docimages/primitive_mixed.png>>
  --
  data Primitive
    = LinePrim !Line      -- ^ Primitive used for lines
    | BezierPrim !Bezier  -- ^ Primitive used for quadratic beziers curves
    | CubicBezierPrim !CubicBezier -- ^ Primitive used for cubic bezier curve
    deriving (Eq, Show)
  
  -- | Generalizing constructors of the `Primitive` type to work
  -- generically.
  class Primitivable a where
    toPrim :: a -> Primitive
  
  -- | @toPrim = id@
  instance Primitivable Primitive where toPrim = id
  
  -- | @toPrim = LinePrim@
  instance Primitivable Line where toPrim = LinePrim
  
  -- | @toPrim = BezierPrim@
  instance Primitivable Bezier where toPrim = BezierPrim
  
  -- | @toPrim = CubicBezierPrim@
  instance Primitivable CubicBezier where toPrim = CubicBezierPrim
  
  -- | All the rasterization works on lists of primitives,
  -- in order to ease the use of the library, the Geometry
  -- type class provides conversion facility, which help
  -- generalising the geometry definition and avoid applying
  -- Primitive constructor.
  --
  -- Also streamline the Path conversion.
  class Geometry a where
    -- | Convert an element to a list of primitives
    -- to be rendered.
    toPrimitives :: a -> [Primitive]
  
    -- | Helper method to avoid overlaping instances.
    -- You shouldn't use it directly.
    listToPrims :: (Foldable f) => f a -> [Primitive]
    {-# INLINE listToPrims #-}
    listToPrims = F.concatMap toPrimitives . F.toList
  
  instance Geometry Path where
    {-# INLINE toPrimitives #-}
    toPrimitives = pathToPrimitives
  
  instance Geometry Primitive where
    toPrimitives e = [e]
    {-# INLINE listToPrims #-}
    listToPrims = F.toList -- Open question, is it optimised as `id`?
  
  instance Geometry Line where
    {-# INLINE toPrimitives #-}
    toPrimitives e = [toPrim e]
  
  instance Geometry Bezier where
    {-# INLINE toPrimitives #-}
    toPrimitives e = [toPrim e]
  
  instance Geometry CubicBezier where
    {-# INLINE toPrimitives #-}
    toPrimitives e = [toPrim e]
  
  -- | Generalize the geometry to any foldable container,
  -- so you can throw any container to the the 'fill' or
  -- 'stroke' function.
  instance (Foldable f, Geometry a) => Geometry (f a) where
    {-# INLINE toPrimitives #-}
    toPrimitives = listToPrims
  
  
  instance Transformable Primitive where
      {-# INLINE transform #-}
      transform f (LinePrim l) = LinePrim $ transform f l
      transform f (BezierPrim b) = BezierPrim $ transform f b
      transform f (CubicBezierPrim c) = CubicBezierPrim $ transform f c
  
      transformM f (LinePrim l) = LinePrim <$> transformM f l
      transformM f (BezierPrim b) = BezierPrim <$> transformM f b
      transformM f (CubicBezierPrim c) = CubicBezierPrim <$> transformM f c
  
  instance PointFoldable Primitive where
      {-# INLINE foldPoints #-}
      foldPoints f acc = go
        where go (LinePrim l) = foldPoints f acc l
              go (BezierPrim b) = foldPoints f acc b
              go (CubicBezierPrim c) = foldPoints f acc c
  
  instance {-# OVERLAPPABLE #-} (Traversable f, Transformable a)
        => Transformable (f a) where
      transform f = fmap (transform f)
      transformM f = mapM (transformM f)
  
  instance {-# OVERLAPPABLE #-} (Foldable f, PointFoldable a)
        => PointFoldable (f a) where
      foldPoints f = foldl' (foldPoints f)
  
  type Producer a = [a] -> [a]
  
  type Container a = DList a
  
  containerOfFunction :: ([a] -> [a]) -> Container a
  containerOfFunction f = fromList $ f []
  
  containerOfList :: [a] -> Container a
  containerOfList = fromList
  
  listOfContainer :: Container a -> [a]
  listOfContainer = toList
  
  -- | Describe a path in a way similar to many graphical
  -- packages, using a "pen" position in memory and reusing
  -- it for the next "move"
  -- For example the example from Primitive could be rewritten:
  --
  -- > fill $ Path (V2 50 20) True
  -- >    [ PathCubicBezierCurveTo (V2 90 60) (V2  5 100) (V2 50 140)
  -- >    , PathLineTo (V2 120 80) ]
  --
  -- <<docimages/path_example.png>>
  --
  data Path = Path
      { -- | Origin of the point, equivalent to the
        -- first "move" command.
        _pathOriginPoint :: Point
        -- | Tell if we must close the path.
      , _pathClose       :: Bool
        -- | List of commands in the path
      , _pathCommand     :: [PathCommand]
      }
      deriving (Eq, Show)
  
  instance Transformable Path where
      {-# INLINE transform #-}
      transform f (Path orig close rest) =
          Path (f orig) close (transform f rest)
  
      transformM f (Path orig close rest) =
          Path <$> f orig <*> pure close <*> transformM f rest
  
  
  instance PointFoldable Path where
      {-# INLINE foldPoints #-}
      foldPoints f acc (Path o _ rest) =
          foldPoints f (f acc o) rest
  
  -- | Actions to create a path
  data PathCommand
      = -- | Draw a line from the current point to another point
        PathLineTo Point
        -- | Draw a quadratic bezier curve from the current point
        -- through the control point to the end point.
      | PathQuadraticBezierCurveTo Point Point
  
        -- | Draw a cubic bezier curve using 2 control points.
      | PathCubicBezierCurveTo Point Point Point
      deriving (Eq, Show)
  
  instance Transformable PathCommand where
      transform f (PathLineTo p) = PathLineTo $ f p
      transform f (PathQuadraticBezierCurveTo p1 p2) =
          PathQuadraticBezierCurveTo (f p1) $ f p2
      transform f (PathCubicBezierCurveTo p1 p2 p3) =
          PathCubicBezierCurveTo (f p1) (f p2) $ f p3
  
      transformM f (PathLineTo p) = PathLineTo <$> f p
      transformM f (PathQuadraticBezierCurveTo p1 p2) =
          PathQuadraticBezierCurveTo <$> f p1 <*> f p2
      transformM f (PathCubicBezierCurveTo p1 p2 p3) =
          PathCubicBezierCurveTo <$> f p1 <*> f p2 <*> f p3
  
  instance PointFoldable PathCommand where
      foldPoints f acc (PathLineTo p) = f acc p
      foldPoints f acc (PathQuadraticBezierCurveTo p1 p2) =
          f (f acc p1) p2
      foldPoints f acc (PathCubicBezierCurveTo p1 p2 p3) =
          foldl' f acc [p1, p2, p3]
  
  -- | Transform a path description into a list of renderable
  -- primitives.
  pathToPrimitives :: Path -> [Primitive]
  pathToPrimitives (Path origin needClosing commands) = go origin commands
    where
      go prev [] | prev /= origin && needClosing = [LinePrim $ Line prev origin]
      go _ [] = []
      go prev (PathLineTo to : xs) =
          LinePrim (Line prev to) : go to xs
      go prev (PathQuadraticBezierCurveTo c1 to : xs) =
          BezierPrim (Bezier prev c1 to) : go to xs
      go prev (PathCubicBezierCurveTo c1 c2 to : xs) =
          CubicBezierPrim (CubicBezier prev c1 c2 to) : go to xs
  
  -- | Gives the orientation vector for the start of the
  -- primitive.
  firstTangeantOf :: Primitive -> Vector
  firstTangeantOf p = case p of
    LinePrim (Line p0 p1) -> p1 ^-^ p0
    BezierPrim (Bezier p0 p1 p2) ->
        (p1 ^-^ p0) `ifBigEnough` (p2 ^-^ p1)
    CubicBezierPrim (CubicBezier p0 p1 p2 _) -> 
         (p1 ^-^ p0) `ifBigEnough` (p2 ^-^ p1)
   where
     ifBigEnough a b | nearZero a = b
                     | otherwise = a
  
  -- | Gives the orientation vector at the end of the
  -- primitive.
  lastTangeantOf :: Primitive -> Vector
  lastTangeantOf p = case p of
    LinePrim (Line p0 p1) -> p1 ^-^ p0
    BezierPrim (Bezier _ p1 p2) -> p2 ^-^ p1
    CubicBezierPrim (CubicBezier _ _ p2 p3) -> p3 ^-^ p2
  
  -- | Extract the first point of the primitive.
  firstPointOf :: Primitive -> Point
  firstPointOf p = case p of
    LinePrim (Line p0 _) -> p0
    BezierPrim (Bezier p0 _ _) -> p0
    CubicBezierPrim (CubicBezier p0 _ _ _) -> p0
  
  -- | Return the last point of a given primitive.
  lastPointOf :: Primitive -> Point
  lastPointOf p = case p of
    LinePrim (Line _ p0) -> p0
    BezierPrim (Bezier _ _ p0) -> p0
    CubicBezierPrim (CubicBezier _ _ _ p0) -> p0
  
  resplit :: [Primitive] -> [[Primitive]]
  resplit = uncurry (:) . go where
    go [] = ([], [])
    go (x:xs@(y:_)) | lastPointOf x `isDistingableFrom` firstPointOf y =
        ([x], after:rest) where (after, rest) = go xs
    go (x:xs) = (x:curr, rest) where (curr, rest) = go xs
  
  