content: {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE FlexibleInstances #-}
  {-# LANGUAGE BangPatterns #-}
  -- | Module handling math regarding the handling of quadratic
  -- and cubic bezier curve.
  module Graphics.Rasterific.QuadraticBezier
      ( -- * Helper functions
        straightLine
      , bezierFromPath
      , decomposeBeziers
      , clipBezier
      , sanitizeBezier
      , sanitizeBezierFilling
      , offsetBezier
      , flattenBezier
      , bezierBreakAt
      , bezierLengthApproximation
      , isBezierPoint
      ) where
  
  import Graphics.Rasterific.Linear
               ( V2( .. )
               , (^-^)
               , (^+^)
               , (^*)
               , dot
               , norm
               , lerp
               )
  
  import Graphics.Rasterific.Operators
  import Graphics.Rasterific.Types
  
  -- | Create a list of bezier patch from a list of points,
  --
  -- > bezierFromPath [a, b, c, d, e] == [Bezier a b c, Bezier c d e]
  -- > bezierFromPath [a, b, c, d, e, f] == [Bezier a b c, Bezier c d e]
  -- > bezierFromPath [a, b, c, d, e, f, g] ==
  -- >     [Bezier a b c, Bezier c d e, Bezier e f g]
  --
  bezierFromPath :: [Point] -> [Bezier]
  bezierFromPath (a:b:rest@(c:_)) = Bezier a b c : bezierFromPath rest
  bezierFromPath _ = []
  
  isBezierPoint :: Bezier -> Bool
  isBezierPoint (Bezier a b c) =
    not $ a `isDistingableFrom` b || 
          b `isDistingableFrom` c
  
  -- | Only work if the quadratic bezier curve
  -- is nearly flat
  bezierLengthApproximation :: Bezier -> Float
  bezierLengthApproximation (Bezier a _ c) =
      norm $ c ^-^ a
  
  decomposeBeziers :: Bezier -> Producer EdgeSample
  decomposeBeziers (Bezier (V2 aRx aRy) (V2 bRx bRy) (V2 cRx cRy)) =
      go aRx aRy bRx bRy cRx cRy where
    go ax ay _bx _by cx cy cont
      | insideX && insideY =
        let !px = fromIntegral $ min floorAx floorCx
            !py = fromIntegral $ min floorAy floorCy
            !w = px + 1 - cx `middle` ax
            !h = cy - ay
        in
        EdgeSample (px + 0.5) (py + 0.5) (w * h) h : cont
        where
          floorAx, floorAy :: Int
          !floorAx = floor ax
          !floorAy = floor ay
  
          !floorCx = floor cx
          !floorCy = floor cy
  
          !insideX = floorAx == floorCx || ceiling ax == (ceiling cx :: Int)
          !insideY = floorAy == floorCy || ceiling ay == (ceiling cy :: Int)
  
  
    go !ax !ay !bx !by !cx !cy cont =
        go ax ay abx aby mx my $ go mx my bcx bcy cx cy cont
      where
        !abx = ax `middle` bx
        !aby = ay `middle` by
  
        !bcx = bx `middle` cx
        !bcy = by `middle` cy
  
        !abbcx = abx `middle` bcx
        !abbcy = aby `middle` bcy
  
        !mx | abs (abbcx - mini) < 0.1 = mini
            | abs (abbcx - maxi) < 0.1 = maxi
            | otherwise = abbcx
           where !mini = fromIntegral (floor abbcx :: Int)
                 !maxi = fromIntegral (ceiling abbcx :: Int)
  
        !my | abs (abbcy - mini) < 0.1 = mini
            | abs (abbcy - maxi) < 0.1 = maxi
            | otherwise = abbcy
           where !mini = fromIntegral (floor abbcy :: Int)
                 !maxi = fromIntegral (ceiling abbcy :: Int)
  
  
  -- | Create a quadratic bezier curve representing
  -- a straight line.
  straightLine :: Point -> Point -> Bezier
  straightLine a c = Bezier a (a `midPoint` c) c
  
  -- | Clamp the bezier curve inside a rectangle
  -- given in parameter.
  clipBezier :: Point     -- ^ Point representing the "minimal" point for cliping
             -> Point     -- ^ Point representing the "maximal" point for cliping
             -> Bezier    -- ^ The quadratic bezier curve to be clamped
             -> Container Primitive
  clipBezier mini maxi bezier@(Bezier a b c)
      -- If we are in the range bound, return the curve
      -- unaltered
      | insideX && insideY = pure $ BezierPrim bezier
      -- If one of the component is outside, clamp
      -- the components on the boundaries and output a
      -- straight line on this boundary. Useful for the
      -- filing case, to clamp the polygon drawing on
      -- the edge
      | outsideX || outsideY =
          pure . BezierPrim $ clampedA `straightLine` clampedC
      -- Not completly inside nor outside, just divide
      -- and conquer.
      | otherwise =
          recurse (Bezier a ab m) <>
              recurse (Bezier m bc c)
    where -- Minimal & maximal dimension of the bezier curve
          bmin = vmin a $ vmin b c
          bmax = vmax a $ vmax b c
  
          recurse = clipBezier mini maxi
  
          clamper = clampPoint mini maxi
          clampedA = clamper a
          clampedC = clamper c
  
          V2 insideX insideY = mini ^<=^ bmin ^&&^ bmax ^<=^ maxi
          V2 outsideX outsideY = bmax ^<=^ mini ^||^ maxi ^<=^ bmin
  
          --
          --         X B
          --        / \
          --       /   \
          --   ab X--X--X bc
          --     / abbc  \
          --    /         \
          -- A X           X C
          --
          (ab, bc, abbc) = splitBezier bezier
  
          --  mini
          --     +-------------+
          --     |             |
          --     |             |
          --     |             |
          --     +-------------+
          --                   maxi
          -- the edgeSeparator vector encode which edge
          -- is te nearest to the midpoint.
          -- if True then it's the 'min' edges which are
          -- the nearest, otherwise it's the maximum edge
          edgeSeparator =
              vabs (abbc ^-^ mini) ^<^ vabs (abbc ^-^ maxi)
  
          -- So here we 'solidify' the nearest edge position
          -- in an edge vector.
          edge = vpartition edgeSeparator mini maxi
  
          -- If we're near an edge, snap the component to the
          -- edge.
          m = vpartition (vabs (abbc ^-^ edge) ^< 0.1) edge abbc
  
  
  -- | Rewrite the bezier curve to avoid degenerate cases.
  sanitizeBezier :: Bezier -> Container Primitive
  sanitizeBezier bezier@(Bezier a b c)
     -- If the two normals vector are far apart (cos nearly -1)
     --
     --       u           v
     -- <----------   ------------>
     -- because u dot v = ||u|| * ||v|| * cos(uv)
     --
     -- This imply that AB and BC are nearly parallel
     | u `dot` v < -0.9999 =
       -- divide in to halves with
      sanitizeBezier (Bezier a (a `midPoint` abbc) abbc) <>
          sanitizeBezier (Bezier abbc (abbc `midPoint` c) c)
  
     -- b is far enough of b and c, (it's not a point)
     | a `isDistingableFrom` b && b `isDistingableFrom` c =
         pure . BezierPrim $ bezier
  
     -- if b is to nearby a or c, take the midpoint as new reference.
     | ac `isDistingableFrom` b = sanitizeBezier (Bezier a ac c)
     | otherwise = mempty
    where u = a `normal` b
          v = b `normal` c
          ac = a `midPoint` c
          abbc = (a `midPoint` b) `midPoint` (b `midPoint` c)
  
  sanitizeBezierFilling :: Bezier -> Container Primitive
  sanitizeBezierFilling bezier@(Bezier a b c)
    | isDegenerate a || isDegenerate b || isDegenerate c = mempty
    | otherwise = pure $ BezierPrim bezier
  
  bezierBreakAt :: Bezier -> Float -> (Bezier, Bezier)
  bezierBreakAt (Bezier a b c) t = (Bezier a ab abbc, Bezier abbc bc c)
    where
      --         X B
      --        / \
      --       /   \
      --   ab X--X--X bc
      --     / abbc  \
      --    /         \
      -- A X           X C
      ab = lerp t b a
      bc = lerp t c b
      abbc = lerp t bc ab
  
  splitBezier :: Bezier -> (Point, Point, Point)
  {-# INLINE splitBezier #-}
  splitBezier (Bezier a b c) = (ab, bc, abbc)
    where
      --
      --         X B
      --        / \
      --       /   \
      --   ab X--X--X bc
      --     / abbc  \
      --    /         \
      -- A X           X C
      --
      ab = a `midPoint` b
      bc = b `midPoint` c
      abbc = ab `midPoint` bc
  
  flattenBezier :: Bezier -> Container Primitive
  flattenBezier bezier@(Bezier a b c)
      -- If the spline is not too curvy, just return the
      -- shifted component
      | u `dot` v >= 0.9 = pure $ BezierPrim bezier
      -- Otherwise, divide and conquer
      | a /= b && b /= c =
          flattenBezier (Bezier a ab abbc) <>
              flattenBezier (Bezier abbc bc c)
      | otherwise = mempty
    where --
          --         X B   
          --    ^   /^\   ^
          --   u \ /w| \ / v
          --      X-----X
          --     /       \
          --    /         \
          -- A X           X C
          --
          u = a `normal` b
          v = b `normal` c
  
          (ab, bc, abbc) = splitBezier bezier
  
  -- | Move the bezier to a new position with an offset.
  offsetBezier :: Float -> Bezier -> Container Primitive
  offsetBezier offset bezier@(Bezier a b c)
      -- If the spline is not too curvy, just return the
      -- shifted component
      | u `dot` v >= 0.9 =
          pure . BezierPrim $ Bezier shiftedA mergedB shiftedC
      -- Otherwise, divide and conquer
      | a /= b && b /= c =
          offsetBezier offset (Bezier a ab abbc) <>
              offsetBezier offset (Bezier abbc bc c)
      | otherwise = mempty
    where --
          --         X B   
          --    ^   /^\   ^
          --   u \ /w| \ / v
          --      X-----X
          --     /       \
          --    /         \
          -- A X           X C
          --
          u = a `normal` b
          v = b `normal` c
          w = ab `normal` bc
  
          (ab, bc, abbc) = splitBezier bezier
  
          shiftedA = a ^+^ (u ^* offset)
          shiftedC = c ^+^ (v ^* offset)
          shiftedABBC = abbc ^+^ (w ^* offset)
          mergedB =
              (shiftedABBC ^* 2.0) ^-^ (shiftedA `midPoint` shiftedC)
  
  