{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}

-- | Set operations on paths.  As a side effect it removes overlapping
-- regions.  Since `Path` is `TrailLike`, you can use these operations
-- directly on most diagrams combinators which generate `Loop`s, like
-- `circle` or `fromSegments`.  `Line`s are discarded, only `Loop`s
-- are used. If you have several paths, you can combine them first
-- with `<>`.  Use `toPath` if you want to convert a `Trail` or
-- `Located Trail` to a `Path`.  The `FillRule` argument determines
-- how /insideness/ is calculated.

module Diagrams.TwoD.Boolean
       (-- * operations on Paths
         union, difference, intersection, exclusion,
         -- * operations on Paths with tolerance
         union', difference', intersection', exclusion',
         -- * operations on Loops
         loopUnion, loopDifference,
         loopIntersection, loopExclusion,)
       where
import Diagrams.Prelude
import Data.Maybe
import qualified Geom2D.CubicBezier as C

fillrule :: FillRule -> C.FillRule
fillrule Winding = C.NonZero
fillrule EvenOdd = C.EvenOdd

loop2path :: Located (Trail' Loop V2 Double) -> C.ClosedPath Double
loop2path t =
  C.ClosedPath $ go x0 y0 (lineSegments $ cutLoop $ unLoc t)
  where
    (P (V2 x0 y0)) = loc t
    go :: Double -> Double -> [Segment Closed V2 Double] -> [(C.DPoint, C.PathJoin Double)]
    go _ _ [] = []
    go x y (Linear (OffsetClosed (V2 x3 y3)):r) =
      (C.Point x y, C.JoinLine) :
      go (x+x3) (y+y3) r
    go x y (Cubic (V2 x1 y1) (V2 x2 y2) (OffsetClosed (V2 x3 y3)):r) =
      (C.Point x y, C.JoinCurve (C.Point (x+x1) (y+y1)) (C.Point (x+x2) (y+y2))) :
      go (x+x3) (y+y3) r

path2loop :: C.ClosedPath Double -> Located (Trail' Loop V2 Double)
path2loop (C.ClosedPath []) = fromSegments [] `at` origin
path2loop (C.ClosedPath ((C.Point x0 y0, join):r)) =
  fromSegments (go x0 y0 join r) `at` P (V2 x0 y0)
  where go x y C.JoinLine [] =
          [straight (V2 (x0-x) (y0-y))]
        go x y C.JoinLine ((C.Point x2 y2, join'):r') =
          straight (V2 (x2-x) (y2-y)):
          go x2 y2 join' r'
        go x y (C.JoinCurve (C.Point x1 y1) (C.Point x2 y2)) r' =
          case r' of
           [] -> [bezier3 (V2 (x1-x) (y1-y))
                  (V2 (x2-x) (y2-y)) (V2 (x0-x) (y0-y))]
           ((C.Point x3 y3, join'):r'') ->
             bezier3 (V2 (x1-x) (y1-y)) (V2 (x2-x) (y2-y))
             (V2 (x3-x) (y3-y)) :
             go x3 y3 join' r''

trail2loop :: Located (Trail V2 Double) -> Maybe (Located (Trail' Loop V2 Double))
trail2loop = located (withTrail (const Nothing) Just)

offsetMax :: Offset c V2 Double -> Double
offsetMax (OffsetClosed (V2 m n)) = max (abs m) (abs n)
offsetMax OffsetOpen = 0

segmentMax :: Segment c V2 Double -> Double
segmentMax (Linear o) =
  offsetMax o
segmentMax (Cubic (V2 a b) (V2 c d) o) =
  maximum [offsetMax o, abs a, abs b,
           abs c, abs d]

loopMax :: Trail' Loop V2 Double -> Double
loopMax l = maximum (segmentMax lastSeg: map segmentMax segs)
  where (segs, lastSeg) = loopSegments l
  
defaultTol :: Double
defaultTol = 1e-7

loop2trail :: Located (Trail' Loop V2 Double) -> Located (Trail V2 Double)
loop2trail = over located wrapLoop

-- | Remove overlapping regions in the path.  If you have several
-- paths, combine them using `<>` first.
--
-- <<samples/union.svg>>
--
-- > example = strokePath $ union Winding $
-- >           (square 1) <> circle 0.5 # translate (V2 0.5 (-0.5))

union :: FillRule -> Path V2 Double -> Path V2 Double
union fill p =
  Path $ map loop2trail $ 
  loopUnion tol fill loops
  where loops = mapMaybe trail2loop $
                pathTrails p
        tol = maximum (map (loopMax.unLoc) loops) *
              defaultTol

-- | Intersection of two paths.  First overlap is removed in the two
-- input arguments, then the intersection is calculated.
-- 
-- <<samples/intersection.svg>>
--
-- > example = strokePath $
-- >          intersection Winding (square 1) $
-- >          circle 0.5 # translate (V2 0.5 (-0.5))
intersection :: FillRule -> Path V2 Double -> Path V2 Double -> Path V2 Double
intersection fill p1 p2 =
  Path $ map loop2trail $
  loopIntersection tol fill loops1 loops2
  where loops1 = mapMaybe trail2loop $
                pathTrails p1
        loops2 = mapMaybe trail2loop $
                pathTrails p2
        tol = max (maximum (map (loopMax.unLoc) loops1))
              (maximum (map (loopMax.unLoc) loops2))
              * defaultTol
-- | Difference of two paths.  First overlap is removed in the two
-- input arguments, then the difference is calculated.
--
-- <<samples/difference.svg>>
--
-- > example = strokePath $
-- >          difference Winding (square 1) $
-- >          circle 0.5 # translate (V2 0.5 (-0.5))
difference :: FillRule -> Path V2 Double -> Path V2 Double -> Path V2 Double
difference fill p1 p2 =
  Path $ map loop2trail $
  loopDifference tol fill loops1 loops2
  where loops1 = mapMaybe trail2loop $
                pathTrails p1
        loops2 = mapMaybe trail2loop $
                pathTrails p2
        tol = max (maximum (map (loopMax.unLoc) loops1))
              (maximum (map (loopMax.unLoc) loops2))
              * defaultTol

-- | Exclusion (exclusive or) of two paths.  First overlap is removed in the two
-- input arguments, then the exclusion is calculated.
--
-- <<samples/exclusion.svg>>
--
-- > example = fc grey $ strokePath $
-- >           exclusion Winding (square 1) $
-- >           circle 0.5 # translate (V2 0.5 (-0.5))
exclusion :: FillRule -> Path V2 Double -> Path V2 Double -> Path V2 Double
exclusion fill p1 p2 =
  Path $ map loop2trail $
  loopExclusion tol fill loops1 loops2
  where loops1 = mapMaybe trail2loop $
                pathTrails p1
        loops2 = mapMaybe trail2loop $
                pathTrails p2
        tol = max (maximum (map (loopMax.unLoc) loops1))
              (maximum (map (loopMax.unLoc) loops2))
              * defaultTol

-- | Like `union`, but takes a tolerance parameter.
union' :: Double -> FillRule -> Path V2 Double -> Path V2 Double
union' tol fill p =
  Path $ map loop2trail $ 
  loopUnion tol fill $
  mapMaybe trail2loop $
  pathTrails p

-- | Like `intersection`, but takes a tolerance parameter.
intersection' :: Double -> FillRule -> Path V2 Double -> Path V2 Double -> Path V2 Double
intersection' tol fill p1 p2 =
  Path $ map loop2trail $
  loopIntersection tol fill
  (mapMaybe trail2loop $ pathTrails p1)
  (mapMaybe trail2loop $ pathTrails p2)


-- | Like `difference`, but takes a tolerance parameter.
difference' :: Double -> FillRule -> Path V2 Double -> Path V2 Double -> Path V2 Double
difference' tol fill p1 p2 =
  Path $ map loop2trail $
  loopDifference tol fill
  (mapMaybe trail2loop $ pathTrails p1)
  (mapMaybe trail2loop $ pathTrails p2)

-- | Like `exclusion`, but takes a tolerance parameter.
exclusion' :: Double -> FillRule -> Path V2 Double -> Path V2 Double -> Path V2 Double
exclusion' tol fill p1 p2 =
  Path $ map loop2trail $
  loopExclusion tol fill
  (mapMaybe trail2loop $ pathTrails p1)
  (mapMaybe trail2loop $ pathTrails p2)

-- | Union of a list of loops.
loopUnion :: Double -> FillRule
          -> [Located (Trail' Loop V2 Double)]
          -> [Located (Trail' Loop V2 Double)]
loopUnion tol fill p  =
  map path2loop $ C.union (map loop2path p) (fillrule fill) tol

-- | Difference between loops.  The loops in both lists are first merged using `union`.
loopDifference :: Double -> FillRule
               -> [Located (Trail' Loop V2 Double)]
               -> [Located (Trail' Loop V2 Double)]
               -> [Located (Trail' Loop V2 Double)]
loopDifference tol fill p1 p2  =
  map path2loop $ C.difference (map loop2path p1)
  (map loop2path p2) (fillrule fill) tol

-- | Intersection of loops.  The loops in both lists are first merged using `union`.
loopIntersection :: Double -> FillRule
                 -> [Located (Trail' Loop V2 Double)]
                 -> [Located (Trail' Loop V2 Double)]
                 -> [Located (Trail' Loop V2 Double)]
loopIntersection tol fill p1 p2 =
  map path2loop $ C.intersection (map loop2path p1)
  (map loop2path p2) (fillrule fill) tol

-- | Exclusion (xor) of loops. The loops in both lists are first merged using `union`.
loopExclusion :: Double -> FillRule
              -> [Located (Trail' Loop V2 Double)]
              -> [Located (Trail' Loop V2 Double)]
              -> [Located (Trail' Loop V2 Double)]
loopExclusion tol fill p1 p2 =
  map path2loop $ C.exclusion (map loop2path p1)
  (map loop2path p2) (fillrule fill) tol