module Graphics.Rasterific.StrokeInternal
    ( flatten
    , dashize
    , strokize
    , dashedStrokize
    , splitPrimitiveUntil
    , approximatePathLength
    , isPrimitivePoint
    )  where

import Data.Monoid( (<>) )

import Graphics.Rasterific.Linear
             ( V2( .. )
             , (^-^)
             , (^+^)
             , (^*)
             , dot
             )

import Graphics.Rasterific.Operators
import Graphics.Rasterific.Types
import Graphics.Rasterific.QuadraticBezier
import Graphics.Rasterific.CubicBezier
import Graphics.Rasterific.Line

lastPoint :: Primitive -> Point
lastPoint (LinePrim (Line _ x1)) = x1
lastPoint (BezierPrim (Bezier _ _ x2)) = x2
lastPoint (CubicBezierPrim (CubicBezier _ _ _ x3)) = x3

lastPointAndNormal :: Primitive -> (Point, Vector)
lastPointAndNormal (LinePrim (Line a b)) = (b, a `normal` b)
lastPointAndNormal (BezierPrim (Bezier _ b c)) = (c, b `normal` c)
lastPointAndNormal (CubicBezierPrim (CubicBezier _ _ c d)) = (d, c `normal` d)

firstPointAndNormal :: Primitive -> (Point, Vector)
firstPointAndNormal (LinePrim (Line a b)) = (a, a `normal` b)
firstPointAndNormal (BezierPrim (Bezier a b _)) = (a, a `normal` b)
firstPointAndNormal (CubicBezierPrim (CubicBezier a b _ _)) = (a, a `normal` b)

isPrimitivePoint :: Primitive -> Bool
isPrimitivePoint p = case p of
  LinePrim l -> isLinePoint l
  BezierPrim b -> isBezierPoint b
  CubicBezierPrim c -> isCubicBezierPoint c

reversePrimitive :: Primitive -> Primitive
reversePrimitive (LinePrim (Line a b)) = LinePrim (Line b a)
reversePrimitive (BezierPrim (Bezier a b c)) =
    BezierPrim (Bezier c b a)
reversePrimitive (CubicBezierPrim (CubicBezier a b c d)) =
    CubicBezierPrim (CubicBezier d c b a)

-- | Create a "rounded" join or cap
roundJoin :: Float -> Point -> Vector -> Vector -> Container Primitive
roundJoin offset p = go
  where go u v
          -- If we're already on a nice curvature,
          -- don't bother doing anything
          | u `dot` w >= 0.9 = pure . BezierPrim $ Bezier a b c
          | otherwise = go u w <> go w v
          where --     ^
                --     |w
                -- a X---X c
                --    \ /
                --     Xp
                -- ^  / \  ^
                -- u\/   \/v
                --  /     \   .
                a = p ^+^ u ^* offset
                c = p ^+^ v ^* offset

                w = (a `normal` c) `ifZero` u

                -- Same as offseting
                n = p ^+^ w ^* offset
                b = n ^* 2 ^-^ (a `midPoint` c)

-- | Put a cap at the end of a bezier curve, depending
-- on the kind of cap wanted.
cap :: Float -> Cap -> Primitive -> Container Primitive
cap offset CapRound prim = roundJoin offset p u (- u)
  where (p, u) = lastPointAndNormal prim

cap offset (CapStraight cVal) prim =
   pure (d `lineFromTo` e) <> pure (e `lineFromTo` f)
                           <> pure (f `lineFromTo` g)
  where -- The usual "normal"
        (p, u@(V2 ux uy)) = lastPointAndNormal prim
        -- Vector pointing in the direction of the curve
        -- of norm 1
        v = V2 uy $ negate ux

        -- Finishing points around the edge
        -- -u*offset u*offset
        --       <-><->
        --     d/  /  /g
        --     /  /  /
        --    /  /  /
        --      /
        --     / curve
        --
        d = p ^+^ u ^* offset
        g = p ^-^ u ^* offset

        -- Create the "far" points
        --
        --       e        f
        --        /     /   ^
        --       /     /   / v * offset * cVal
        --     d/  /  /g
        --     /  /  /
        --    /  /  /
        --      /
        --     / curve
        --
        e = d ^+^ v ^* (offset * cVal)
        f = g ^+^ v ^* (offset * cVal)

lineFromTo :: Point -> Point -> Primitive
lineFromTo a b = LinePrim (Line a b)

miterJoin :: Float -> Float -> Point -> Vector -> Vector
          -> Container Primitive
miterJoin offset l point u v
  | uDotW > l / max 1 l && uDotW > 0.01 =
      pure (a `lineFromTo` m) <> pure (m `lineFromTo` c)
  -- A simple straight junction
  | otherwise = pure $ a `lineFromTo` c
  where --      X m
        --     /\
        --    /|w\
        -- a X---X c
        --    \ /
        --     Xp
        -- ^  / \  ^
        -- u\/   \/v
        --  /     \     .
        a = point ^+^ u ^* offset
        c = point ^+^ v ^* offset
        w = (a `normal` c) `ifZero` u

        uDotW =  u `dot` w

        -- Calculate the maximum distance on the
        -- u axis
        p = offset / uDotW
        -- middle point for "straight joining"
        m = point + w ^* p

joinPrimitives :: StrokeWidth -> Join -> Primitive -> Primitive
               -> Container Primitive
joinPrimitives offset join prim1 prim2  =
  case join of
    JoinRound -> roundJoin offset p u v
    JoinMiter l -> miterJoin offset l p u v
  where (p, u) = lastPointAndNormal prim1
        (_, v) = firstPointAndNormal prim2

offsetPrimitives :: Float -> Primitive -> Container Primitive
offsetPrimitives offset (LinePrim l) = offsetLine offset l
offsetPrimitives offset (BezierPrim b) = offsetBezier offset b
offsetPrimitives offset (CubicBezierPrim c) = offsetCubicBezier offset c

offsetAndJoin :: Float -> Join -> Cap -> [Primitive]
              -> Container Primitive
offsetAndJoin _ _ _ [] = mempty
offsetAndJoin offset join caping (firstShape:rest) = go firstShape rest
  where joiner = joinPrimitives offset join
        offseter = offsetPrimitives offset
        (firstPoint, _) = firstPointAndNormal firstShape

        go prev []
           | firstPoint `isNearby` lastPoint prev = offseter prev <> joiner prev firstShape
           | otherwise = offseter prev <> cap offset caping prev
        go prev (x:xs) =
             offseter prev <> joiner prev x <> go x xs

approximateLength :: Primitive -> Float
approximateLength (LinePrim l) = lineLength l
approximateLength (BezierPrim b) = bezierLengthApproximation b
approximateLength (CubicBezierPrim c) = cubicBezierLengthApproximation c


sanitize :: Primitive -> Container Primitive
sanitize (LinePrim l) = sanitizeLine l
sanitize (BezierPrim b) = sanitizeBezier b
sanitize (CubicBezierPrim c) = sanitizeCubicBezier c

strokize :: Geometry geom
         => StrokeWidth -> Join -> (Cap, Cap) -> geom
         -> Container Primitive
strokize width join (capStart, capEnd) geom = foldMap pathOffseter sanitized
  where
    sanitized = foldMap (listOfContainer . sanitize) <$> resplit (toPrimitives geom)
    offseter = offsetAndJoin (width / 2) join
    pathOffseter v =
        offseter capEnd v <> offseter capStart (reverse $ reversePrimitive <$> v)

flattenPrimitive :: Primitive -> Container Primitive
flattenPrimitive (BezierPrim bezier) = flattenBezier bezier
flattenPrimitive (CubicBezierPrim bezier) = flattenCubicBezier bezier
flattenPrimitive (LinePrim line) = flattenLine line

breakPrimitiveAt :: Primitive -> Float -> (Primitive, Primitive)
breakPrimitiveAt (BezierPrim bezier) at = (BezierPrim a, BezierPrim b)
  where (a, b) = bezierBreakAt bezier at
breakPrimitiveAt (CubicBezierPrim bezier) at = (CubicBezierPrim a, CubicBezierPrim b)
  where (a, b) = cubicBezierBreakAt bezier at
breakPrimitiveAt (LinePrim line) at = (LinePrim a, LinePrim b)
  where (a, b) = lineBreakAt line at


flatten :: Container Primitive -> Container Primitive
flatten = foldMap flattenPrimitive

splitPrimitiveUntil :: Float -> [Primitive] -> ([Primitive], [Primitive])
splitPrimitiveUntil = go
  where
    go _ [] = ([], [])
    go left lst
      | left <= 0 = ([], lst)
    go left (x : xs)
      | left > primLength = (x : inInterval, afterInterval)
      | otherwise = ([beforeStop], afterStop : xs)
      where
        primLength = approximateLength x
        (inInterval, afterInterval) = go (left - primLength) xs

        (beforeStop, afterStop) =
            breakPrimitiveAt x $ left / primLength

dropPattern :: Float -> DashPattern -> DashPattern
dropPattern = go
  where
    go _ [] = []
    go offset (x:xs)
        | x < 0 = x:xs -- sanitizing
        | offset < x = x - offset : xs
        | otherwise {- offset >= x -} = go (offset - x) xs

-- | Don't make them completly flat, but suficiently
-- to assume they are.
linearizePrimitives :: [Primitive] -> [Primitive]
linearizePrimitives =
  listOfContainer . foldMap flattenPrimitive . foldMap sanitize

-- | Return an approximation of the length of a given path.
-- It's results is not precise but should be enough for
-- rough calculations
approximatePathLength :: Path -> Float
approximatePathLength = approximatePrimitivesLength . pathToPrimitives

approximatePrimitivesLength :: [Primitive] -> Float
approximatePrimitivesLength prims =
  sum $ approximateLength <$> linearizePrimitives prims

dashize :: Float -> DashPattern -> [Primitive] -> [[Primitive]]
dashize offset pattern = taker infinitePattern . linearizePrimitives
  where
    realOffset | offset >= 0 = offset
               | otherwise = offset + sum pattern

    infinitePattern =
        dropPattern realOffset . cycle $ filter (> 0) pattern

    taker _ [] = []
    taker [] _ = [] -- Impossible by construction, pattern is infinite
    taker (atValue:atRest) stream = toKeep : droper atRest next
      where (toKeep, next) = splitPrimitiveUntil atValue stream

    droper _ [] = []
    droper [] _ = [] -- Impossible by construction, pattern is infinite
    droper (atValue:atRest) stream = taker atRest next
      where (_toKeep, next) = splitPrimitiveUntil atValue stream

-- | Create a list of outlines corresponding to all the
-- dashed elements. They can be then stroked
--
-- > mapM_ (stroke 3 (JoinMiter 0) (CapStraight 0, CapStraight 0)) $
-- >     dashedStrokize 0 [10, 5]
-- >                    40 JoinRound (CapStraight 0, CapStraight 0) $
-- >         CubicBezier (V2  40 160) (V2 40   40) (V2 160  40) (V2 160 160)
--
-- <<docimages/strokize_dashed_path.png>>
--
dashedStrokize :: Geometry geom
               => Float       -- ^ Starting offset
               -> DashPattern -- ^ Dashing pattern to use for stroking
               -> StrokeWidth -- ^ Stroke width
               -> Join        -- ^ Which kind of join will be used
               -> (Cap, Cap)  -- ^ Start and end capping.
               -> geom        -- ^ Elements to transform
               -> [[Primitive]]
dashedStrokize offset dashPattern width join capping geom =
    listOfContainer . strokize width join capping
        <$> dashize offset dashPattern (toPrimitives geom)