{-# LANGUAGE BangPatterns #-}
-- | Handle straight lines polygon.
module Graphics.Rasterific.Line
    ( lineFromPath
    , decomposeLine
    , clipLine
    , sanitizeLine
    , sanitizeLineFilling
    , lineBreakAt
    , flattenLine
    , lineLength
    , offsetLine
    , isLinePoint
    , extendLine
    ) where

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

import Graphics.Rasterific.Operators
import Graphics.Rasterific.Types

-- | Transform a list a point to a list of lines
--
-- > lineFromPath [a, b, c, d] = [Line a b, Line b c, Line c d]
--
lineFromPath :: [Point] -> [Line]
lineFromPath [] = []
lineFromPath lst@(_:rest) =
    uncurry Line <$> zip lst rest

isLinePoint :: Line -> Bool
isLinePoint (Line a b) = not $ a `isDistingableFrom` b

lineLength :: Line -> Float
lineLength (Line a b) = norm (b ^-^ a)

sanitizeLine :: Line -> Container Primitive
sanitizeLine l@(Line p1 p2)
  | p1 `isNearby` p2 = mempty
  | otherwise = pure $ LinePrim l

sanitizeLineFilling :: Line -> Container Primitive
sanitizeLineFilling l@(Line p1 p2)
  | isDegenerate p1 || isDegenerate p2 = mempty
  | otherwise = pure $ LinePrim l

lineBreakAt :: Line -> Float -> (Line, Line)
lineBreakAt (Line a b) t = (Line a ab, Line ab b)
  where ab = lerp t b a

flattenLine :: Line -> Container Primitive
flattenLine = pure . LinePrim

offsetLine :: Float -> Line -> Container Primitive
offsetLine offset (Line a b) = pure . LinePrim $ Line shiftedA shiftedB
  where
   u = a `normal` b
   shiftedA = a ^+^ (u ^* offset)
   shiftedB = b ^+^ (u ^* offset)

-- | Clamp the bezier curve inside a rectangle
-- given in parameter.
clipLine :: Point     -- ^ Point representing the "minimal" point for cliping
         -> Point     -- ^ Point representing the "maximal" point for cliping
         -> Line      -- ^ The line
         -> Container Primitive
clipLine mini maxi poly@(Line a b)
    -- If we are in the range bound, return the curve
    -- unaltered
    | insideX && insideY = pure . LinePrim $ poly
    -- 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 . LinePrim $ Line clampedA clampedB

    -- Not completly inside nor outside, just divide
    -- and conquer.
    | otherwise = recurse (Line a m) <> recurse (Line m b)
  where -- Minimal & maximal dimension of the bezier curve
        bmin = vmin a b
        bmax = vmax a b

        recurse = clipLine mini maxi

        clamper = clampPoint mini maxi
        clampedA = clamper a
        clampedB = clamper b

        V2 insideX insideY = mini ^<=^ bmin ^&&^ bmax ^<=^ maxi
        V2 outsideX outsideY = bmax ^<=^ mini ^||^ maxi ^<=^ bmin

        -- A X-----X-----X B
        --        AB
        ab = a `midPoint` b

        --  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 (ab ^-^ mini) ^<^ vabs (ab ^-^ 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 (ab ^-^ edge) ^< 0.1) edge ab

-- TODO: implement better algorithm for lines, should
-- be doable.
decomposeLine :: Line -> Producer EdgeSample
decomposeLine (Line (V2 aRx aRy) (V2 bRx bRy)) = go aRx aRy bRx bRy where
  go !ax !ay !bx !by cont
    | insideX && insideY =
      let !px = fromIntegral $ min floorAx floorBx
          !py = fromIntegral $ min floorAy floorBy
          !w = px + 1 - (bx `middle` ax)
          !h = by - ay
      in
      EdgeSample (px + 0.5) (py + 0.5) (w * h) h : cont
      where
        floorAx, floorAy :: Int
        !floorAx = floor ax
        !floorAy = floor ay

        !floorBx = floor bx
        !floorBy = floor by

        !insideX = floorAx == floorBx || ceiling ax == (ceiling bx :: Int)
        !insideY = floorAy == floorBy || ceiling ay == (ceiling by :: Int)


  go !ax !ay !bx !by cont = go ax ay mx my $ go mx my bx by cont
    where
      !abx = ax `middle` bx
      !aby = ay `middle` by

      !mx | abs (abx - mini) < 0.1 = mini
          | abs (abx - maxi) < 0.1 = maxi
          | otherwise = abx
         where !mini = fromIntegral (floor abx :: Int)
               !maxi = fromIntegral (ceiling abx :: Int)

      !my | abs (aby - mini) < 0.1 = mini
          | abs (aby - maxi) < 0.1 = maxi
          | otherwise = aby
         where !mini = fromIntegral (floor aby :: Int)
               !maxi = fromIntegral (ceiling aby :: Int)

-- | Extend a line by two coefficient, giving a line that's a
-- linear extension of the original line.
--
-- law: extendLine 0 1 = id
extendLine :: Float  -- ^ Begin extension coefficient
           -> Float  -- ^ End extension coefficient
           -> Line   -- ^ Line to transform
           -> Line
extendLine beg end (Line p1 p2) =
    Line (lerp beg p2 p1) (lerp end p2 p1)