{-# 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 with any combinator which generates `Loop`s, like `circle`
-- or `fromSegments`.  `Line`s are discarded, only `Loop`s are
-- used. If you have several paths, you can combine them with `<>` first.
-- Use `toPath` if you want to convert a `Trail` or `Located` `Trail`
-- to a `Path`.  The `FillRule` argument determines how /insideness/
-- is calculated for the input.

module Diagrams.TwoD.Path.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           Control.Lens       hiding (at)
import           Data.Maybe
import           Diagrams.Located
import           Diagrams.Path
import           Diagrams.Points
import           Diagrams.Segment
import           Diagrams.Trail
import           Diagrams.TrailLike
import           Diagrams.TwoD.Path
import qualified Geom2D.CubicBezier as C
import           Linear

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

loop2path :: Located (Trail' Loop V2 Double) -> C.ClosedPath Double
loop2path :: Located (Trail' Loop V2 Double) -> ClosedPath Double
loop2path Located (Trail' Loop V2 Double)
t =
  forall a. [(Point a, PathJoin a)] -> ClosedPath a
C.ClosedPath forall a b. (a -> b) -> a -> b
$ Double
-> Double
-> [Segment Closed V2 Double]
-> [(DPoint, PathJoin Double)]
go Double
x0 Double
y0 (forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Loop v n -> Trail' Line v n
cutLoop forall a b. (a -> b) -> a -> b
$ forall a. Located a -> a
unLoc Located (Trail' Loop V2 Double)
t)
  where
    (P (V2 Double
x0 Double
y0)) = forall a. Located a -> Point (V a) (N a)
loc Located (Trail' Loop V2 Double)
t
    go :: Double -> Double -> [Segment Closed V2 Double] -> [(C.DPoint, C.PathJoin Double)]
    go :: Double
-> Double
-> [Segment Closed V2 Double]
-> [(DPoint, PathJoin Double)]
go Double
_ Double
_ [] = []
    go Double
x Double
y (Linear (OffsetClosed (V2 Double
x3 Double
y3)):[Segment Closed V2 Double]
r) =
      (forall a. a -> a -> Point a
C.Point Double
x Double
y, forall a. PathJoin a
C.JoinLine) forall a. a -> [a] -> [a]
:
      Double
-> Double
-> [Segment Closed V2 Double]
-> [(DPoint, PathJoin Double)]
go (Double
xforall a. Num a => a -> a -> a
+Double
x3) (Double
yforall a. Num a => a -> a -> a
+Double
y3) [Segment Closed V2 Double]
r
    go Double
x Double
y (Cubic (V2 Double
x1 Double
y1) (V2 Double
x2 Double
y2) (OffsetClosed (V2 Double
x3 Double
y3)):[Segment Closed V2 Double]
r) =
      (forall a. a -> a -> Point a
C.Point Double
x Double
y, forall a. Point a -> Point a -> PathJoin a
C.JoinCurve (forall a. a -> a -> Point a
C.Point (Double
xforall a. Num a => a -> a -> a
+Double
x1) (Double
yforall a. Num a => a -> a -> a
+Double
y1)) (forall a. a -> a -> Point a
C.Point (Double
xforall a. Num a => a -> a -> a
+Double
x2) (Double
yforall a. Num a => a -> a -> a
+Double
y2))) forall a. a -> [a] -> [a]
:
      Double
-> Double
-> [Segment Closed V2 Double]
-> [(DPoint, PathJoin Double)]
go (Double
xforall a. Num a => a -> a -> a
+Double
x3) (Double
yforall a. Num a => a -> a -> a
+Double
y3) [Segment Closed V2 Double]
r

path2loop :: C.ClosedPath Double -> Located (Trail' Loop V2 Double)
path2loop :: ClosedPath Double -> Located (Trail' Loop V2 Double)
path2loop (C.ClosedPath []) = forall t. TrailLike t => [Segment Closed (V t) (N t)] -> t
fromSegments [] forall a. a -> Point (V a) (N a) -> Located a
`at` forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin
path2loop (C.ClosedPath ((C.Point Double
x0 Double
y0, PathJoin Double
join):[(DPoint, PathJoin Double)]
r)) =
  forall t. TrailLike t => [Segment Closed (V t) (N t)] -> t
fromSegments (Double
-> Double
-> PathJoin Double
-> [(DPoint, PathJoin Double)]
-> [Segment Closed V2 Double]
go Double
x0 Double
y0 PathJoin Double
join [(DPoint, PathJoin Double)]
r) forall a. a -> Point (V a) (N a) -> Located a
`at` forall (f :: * -> *) a. f a -> Point f a
P (forall a. a -> a -> V2 a
V2 Double
x0 Double
y0)
  where go :: Double
-> Double
-> PathJoin Double
-> [(DPoint, PathJoin Double)]
-> [Segment Closed V2 Double]
go Double
x Double
y PathJoin Double
C.JoinLine [] =
          [forall (v :: * -> *) n. v n -> Segment Closed v n
straight (forall a. a -> a -> V2 a
V2 (Double
x0forall a. Num a => a -> a -> a
-Double
x) (Double
y0forall a. Num a => a -> a -> a
-Double
y))]
        go Double
x Double
y PathJoin Double
C.JoinLine ((C.Point Double
x2 Double
y2, PathJoin Double
join'):[(DPoint, PathJoin Double)]
r') =
          forall (v :: * -> *) n. v n -> Segment Closed v n
straight (forall a. a -> a -> V2 a
V2 (Double
x2forall a. Num a => a -> a -> a
-Double
x) (Double
y2forall a. Num a => a -> a -> a
-Double
y))forall a. a -> [a] -> [a]
:
          Double
-> Double
-> PathJoin Double
-> [(DPoint, PathJoin Double)]
-> [Segment Closed V2 Double]
go Double
x2 Double
y2 PathJoin Double
join' [(DPoint, PathJoin Double)]
r'
        go Double
x Double
y (C.JoinCurve (C.Point Double
x1 Double
y1) (C.Point Double
x2 Double
y2)) [(DPoint, PathJoin Double)]
r' =
          case [(DPoint, PathJoin Double)]
r' of
           [] -> [forall (v :: * -> *) n. v n -> v n -> v n -> Segment Closed v n
bezier3 (forall a. a -> a -> V2 a
V2 (Double
x1forall a. Num a => a -> a -> a
-Double
x) (Double
y1forall a. Num a => a -> a -> a
-Double
y))
                  (forall a. a -> a -> V2 a
V2 (Double
x2forall a. Num a => a -> a -> a
-Double
x) (Double
y2forall a. Num a => a -> a -> a
-Double
y)) (forall a. a -> a -> V2 a
V2 (Double
x0forall a. Num a => a -> a -> a
-Double
x) (Double
y0forall a. Num a => a -> a -> a
-Double
y))]
           ((C.Point Double
x3 Double
y3, PathJoin Double
join'):[(DPoint, PathJoin Double)]
r'') ->
             forall (v :: * -> *) n. v n -> v n -> v n -> Segment Closed v n
bezier3 (forall a. a -> a -> V2 a
V2 (Double
x1forall a. Num a => a -> a -> a
-Double
x) (Double
y1forall a. Num a => a -> a -> a
-Double
y)) (forall a. a -> a -> V2 a
V2 (Double
x2forall a. Num a => a -> a -> a
-Double
x) (Double
y2forall a. Num a => a -> a -> a
-Double
y))
             (forall a. a -> a -> V2 a
V2 (Double
x3forall a. Num a => a -> a -> a
-Double
x) (Double
y3forall a. Num a => a -> a -> a
-Double
y)) forall a. a -> [a] -> [a]
:
             Double
-> Double
-> PathJoin Double
-> [(DPoint, PathJoin Double)]
-> [Segment Closed V2 Double]
go Double
x3 Double
y3 PathJoin Double
join' [(DPoint, PathJoin Double)]
r''

trail2loop :: Located (Trail V2 Double) -> Maybe (Located (Trail' Loop V2 Double))
trail2loop :: Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop = forall a b. SameSpace a b => Lens (Located a) (Located b) a b
located (forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just)

offsetMax :: Offset c V2 Double -> Double
offsetMax :: forall c. Offset c V2 Double -> Double
offsetMax (OffsetClosed (V2 Double
m Double
n)) = forall a. Ord a => a -> a -> a
max (forall a. Num a => a -> a
abs Double
m) (forall a. Num a => a -> a
abs Double
n)
offsetMax Offset c V2 Double
OffsetOpen = Double
0

segmentMax :: Segment c V2 Double -> Double
segmentMax :: forall c. Segment c V2 Double -> Double
segmentMax (Linear Offset c V2 Double
o) =
  forall c. Offset c V2 Double -> Double
offsetMax Offset c V2 Double
o
segmentMax (Cubic (V2 Double
a Double
b) (V2 Double
c Double
d) Offset c V2 Double
o) =
  forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [forall c. Offset c V2 Double -> Double
offsetMax Offset c V2 Double
o, forall a. Num a => a -> a
abs Double
a, forall a. Num a => a -> a
abs Double
b,
           forall a. Num a => a -> a
abs Double
c, forall a. Num a => a -> a
abs Double
d]

loopMax :: Trail' Loop V2 Double -> Double
loopMax :: Trail' Loop V2 Double -> Double
loopMax Trail' Loop V2 Double
l = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall c. Segment c V2 Double -> Double
segmentMax Segment Open V2 Double
lastSegforall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall c. Segment c V2 Double -> Double
segmentMax [Segment Closed V2 Double]
segs)
  where ([Segment Closed V2 Double]
segs, Segment Open V2 Double
lastSeg) = forall (v :: * -> *) n.
Trail' Loop v n -> ([Segment Closed v n], Segment Open v n)
loopSegments Trail' Loop V2 Double
l

defaultTol :: Double
defaultTol :: Double
defaultTol = Double
1e-7

loop2trail :: Located (Trail' Loop V2 Double) -> Located (Trail V2 Double)
loop2trail :: Located (Trail' Loop V2 Double) -> Located (Trail V2 Double)
loop2trail = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall a b. SameSpace a b => Lens (Located a) (Located b) a b
located forall (v :: * -> *) n. Trail' Loop v n -> Trail v n
wrapLoop

-- | Remove overlapping regions in the path.  If you have several
-- paths, combine them using `<>` first.
--
-- <<diagrams/src_Diagrams_TwoD_Path_Boolean_unionEx.svg#diagram=unionEx&width=300>>
--
-- > import Diagrams.TwoD.Path.Boolean
-- > import Diagrams.Prelude hiding (union)
-- >
-- > unionEx = frame 0.1 . strokePath $ union Winding $
-- >           (square 1) <> circle 0.5 # translate (V2 0.5 (-0.5))

union :: FillRule -> Path V2 Double -> Path V2 Double
union :: FillRule -> Path V2 Double -> Path V2 Double
union FillRule
fill Path V2 Double
p =
  forall (v :: * -> *) n. [Located (Trail v n)] -> Path v n
Path forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> Located (Trail V2 Double)
loop2trail forall a b. (a -> b) -> a -> b
$
  Double
-> FillRule
-> [Located (Trail' Loop V2 Double)]
-> [Located (Trail' Loop V2 Double)]
loopUnion Double
tol FillRule
fill [Located (Trail' Loop V2 Double)]
loops
  where loops :: [Located (Trail' Loop V2 Double)]
loops = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop forall a b. (a -> b) -> a -> b
$
                forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 Double
p
        tol :: Double
tol = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map (Trail' Loop V2 Double -> Double
loopMaxforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Located a -> a
unLoc) [Located (Trail' Loop V2 Double)]
loops) forall a. Num a => a -> a -> a
*
              Double
defaultTol

-- | Intersection of two paths.  First overlap is removed in the two
-- input arguments, then the intersection is calculated.
--
-- <<diagrams/src_Diagrams_TwoD_Path_Boolean_isectEx.svg#diagram=isectEx&width=200>>
--
-- > import Diagrams.TwoD.Path.Boolean
-- > import Diagrams.Prelude hiding (intersection)
-- >
-- > isectEx = frame 0.1 . 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 :: FillRule -> Path V2 Double -> Path V2 Double -> Path V2 Double
intersection FillRule
fill Path V2 Double
path1 Path V2 Double
path2 =
  forall (v :: * -> *) n. [Located (Trail v n)] -> Path v n
Path forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> Located (Trail V2 Double)
loop2trail forall a b. (a -> b) -> a -> b
$
  Double
-> FillRule
-> [Located (Trail' Loop V2 Double)]
-> [Located (Trail' Loop V2 Double)]
-> [Located (Trail' Loop V2 Double)]
loopIntersection Double
tol FillRule
fill [Located (Trail' Loop V2 Double)]
loops1 [Located (Trail' Loop V2 Double)]
loops2
  where loops1 :: [Located (Trail' Loop V2 Double)]
loops1 = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop forall a b. (a -> b) -> a -> b
$
                forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 Double
path1
        loops2 :: [Located (Trail' Loop V2 Double)]
loops2 = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop forall a b. (a -> b) -> a -> b
$
                forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 Double
path2
        tol :: Double
tol = forall a. Ord a => a -> a -> a
max (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map (Trail' Loop V2 Double -> Double
loopMaxforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Located a -> a
unLoc) [Located (Trail' Loop V2 Double)]
loops1))
              (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map (Trail' Loop V2 Double -> Double
loopMaxforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Located a -> a
unLoc) [Located (Trail' Loop V2 Double)]
loops2))
              forall a. Num a => a -> a -> a
* Double
defaultTol
-- | Difference of two paths.  First overlap is removed in the two
-- input arguments, then the difference is calculated.
--
-- <<diagrams/src_Diagrams_TwoD_Path_Boolean_diffEx.svg#diagram=diffEx&width=200>>
--
-- > import Diagrams.TwoD.Path.Boolean
-- > import Diagrams.Prelude hiding (difference)
-- >
-- > diffEx = frame 0.1 . 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 :: FillRule -> Path V2 Double -> Path V2 Double -> Path V2 Double
difference FillRule
fill Path V2 Double
path1 Path V2 Double
path2 =
  forall (v :: * -> *) n. [Located (Trail v n)] -> Path v n
Path forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> Located (Trail V2 Double)
loop2trail forall a b. (a -> b) -> a -> b
$
  Double
-> FillRule
-> [Located (Trail' Loop V2 Double)]
-> [Located (Trail' Loop V2 Double)]
-> [Located (Trail' Loop V2 Double)]
loopDifference Double
tol FillRule
fill [Located (Trail' Loop V2 Double)]
loops1 [Located (Trail' Loop V2 Double)]
loops2
  where loops1 :: [Located (Trail' Loop V2 Double)]
loops1 = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop forall a b. (a -> b) -> a -> b
$
                forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 Double
path1
        loops2 :: [Located (Trail' Loop V2 Double)]
loops2 = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop forall a b. (a -> b) -> a -> b
$
                forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 Double
path2
        tol :: Double
tol = forall a. Ord a => a -> a -> a
max (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map (Trail' Loop V2 Double -> Double
loopMaxforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Located a -> a
unLoc) [Located (Trail' Loop V2 Double)]
loops1))
              (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map (Trail' Loop V2 Double -> Double
loopMaxforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Located a -> a
unLoc) [Located (Trail' Loop V2 Double)]
loops2))
              forall a. Num a => a -> a -> a
* Double
defaultTol

-- | Exclusion (exclusive or) of two paths.  First overlap is removed in the two
-- input arguments, then the exclusion is calculated.
--
-- <<diagrams/src_Diagrams_TwoD_Path_Boolean_exclEx.svg#diagram=exclEx&width=200>>
--
-- > import Diagrams.TwoD.Path.Boolean
-- >
-- > exclEx = fc grey . frame 0.1 . 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 :: FillRule -> Path V2 Double -> Path V2 Double -> Path V2 Double
exclusion FillRule
fill Path V2 Double
path1 Path V2 Double
path2 =
  forall (v :: * -> *) n. [Located (Trail v n)] -> Path v n
Path forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> Located (Trail V2 Double)
loop2trail forall a b. (a -> b) -> a -> b
$
  Double
-> FillRule
-> [Located (Trail' Loop V2 Double)]
-> [Located (Trail' Loop V2 Double)]
-> [Located (Trail' Loop V2 Double)]
loopExclusion Double
tol FillRule
fill [Located (Trail' Loop V2 Double)]
loops1 [Located (Trail' Loop V2 Double)]
loops2
  where loops1 :: [Located (Trail' Loop V2 Double)]
loops1 = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop forall a b. (a -> b) -> a -> b
$
                forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 Double
path1
        loops2 :: [Located (Trail' Loop V2 Double)]
loops2 = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop forall a b. (a -> b) -> a -> b
$
                forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 Double
path2
        tol :: Double
tol = forall a. Ord a => a -> a -> a
max (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map (Trail' Loop V2 Double -> Double
loopMaxforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Located a -> a
unLoc) [Located (Trail' Loop V2 Double)]
loops1))
              (forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map (Trail' Loop V2 Double -> Double
loopMaxforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. Located a -> a
unLoc) [Located (Trail' Loop V2 Double)]
loops2))
              forall a. Num a => a -> a -> a
* Double
defaultTol

-- | Like `union`, but takes a tolerance parameter.
union' :: Double -> FillRule -> Path V2 Double -> Path V2 Double
union' :: Double -> FillRule -> Path V2 Double -> Path V2 Double
union' Double
tol FillRule
fill Path V2 Double
p =
  forall (v :: * -> *) n. [Located (Trail v n)] -> Path v n
Path forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> Located (Trail V2 Double)
loop2trail forall a b. (a -> b) -> a -> b
$
  Double
-> FillRule
-> [Located (Trail' Loop V2 Double)]
-> [Located (Trail' Loop V2 Double)]
loopUnion Double
tol FillRule
fill forall a b. (a -> b) -> a -> b
$
  forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop forall a b. (a -> b) -> a -> b
$
  forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 Double
p

-- | Like `intersection`, but takes a tolerance parameter.
intersection' :: Double -> FillRule -> Path V2 Double -> Path V2 Double -> Path V2 Double
intersection' :: Double
-> FillRule -> Path V2 Double -> Path V2 Double -> Path V2 Double
intersection' Double
tol FillRule
fill Path V2 Double
path1 Path V2 Double
path2 =
  forall (v :: * -> *) n. [Located (Trail v n)] -> Path v n
Path forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> Located (Trail V2 Double)
loop2trail forall a b. (a -> b) -> a -> b
$
  Double
-> FillRule
-> [Located (Trail' Loop V2 Double)]
-> [Located (Trail' Loop V2 Double)]
-> [Located (Trail' Loop V2 Double)]
loopIntersection Double
tol FillRule
fill
  (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 Double
path1)
  (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 Double
path2)


-- | Like `difference`, but takes a tolerance parameter.
difference' :: Double -> FillRule -> Path V2 Double -> Path V2 Double -> Path V2 Double
difference' :: Double
-> FillRule -> Path V2 Double -> Path V2 Double -> Path V2 Double
difference' Double
tol FillRule
fill Path V2 Double
path1 Path V2 Double
path2 =
  forall (v :: * -> *) n. [Located (Trail v n)] -> Path v n
Path forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> Located (Trail V2 Double)
loop2trail forall a b. (a -> b) -> a -> b
$
  Double
-> FillRule
-> [Located (Trail' Loop V2 Double)]
-> [Located (Trail' Loop V2 Double)]
-> [Located (Trail' Loop V2 Double)]
loopDifference Double
tol FillRule
fill
  (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 Double
path1)
  (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 Double
path2)

-- | Like `exclusion`, but takes a tolerance parameter.
exclusion' :: Double -> FillRule -> Path V2 Double -> Path V2 Double -> Path V2 Double
exclusion' :: Double
-> FillRule -> Path V2 Double -> Path V2 Double -> Path V2 Double
exclusion' Double
tol FillRule
fill Path V2 Double
path1 Path V2 Double
path2 =
  forall (v :: * -> *) n. [Located (Trail v n)] -> Path v n
Path forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> Located (Trail V2 Double)
loop2trail forall a b. (a -> b) -> a -> b
$
  Double
-> FillRule
-> [Located (Trail' Loop V2 Double)]
-> [Located (Trail' Loop V2 Double)]
-> [Located (Trail' Loop V2 Double)]
loopExclusion Double
tol FillRule
fill
  (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 Double
path1)
  (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 Double
path2)

-- | Union of a list of loops.
loopUnion :: Double -> FillRule
          -> [Located (Trail' Loop V2 Double)]
          -> [Located (Trail' Loop V2 Double)]
loopUnion :: Double
-> FillRule
-> [Located (Trail' Loop V2 Double)]
-> [Located (Trail' Loop V2 Double)]
loopUnion Double
tol FillRule
fill [Located (Trail' Loop V2 Double)]
p  =
  forall a b. (a -> b) -> [a] -> [b]
map ClosedPath Double -> Located (Trail' Loop V2 Double)
path2loop forall a b. (a -> b) -> a -> b
$ [ClosedPath Double] -> FillRule -> Double -> [ClosedPath Double]
C.union (forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> ClosedPath Double
loop2path [Located (Trail' Loop V2 Double)]
p) (FillRule -> FillRule
fillrule FillRule
fill) Double
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 :: Double
-> FillRule
-> [Located (Trail' Loop V2 Double)]
-> [Located (Trail' Loop V2 Double)]
-> [Located (Trail' Loop V2 Double)]
loopDifference Double
tol FillRule
fill [Located (Trail' Loop V2 Double)]
path1 [Located (Trail' Loop V2 Double)]
path2  =
  forall a b. (a -> b) -> [a] -> [b]
map ClosedPath Double -> Located (Trail' Loop V2 Double)
path2loop forall a b. (a -> b) -> a -> b
$ [ClosedPath Double]
-> [ClosedPath Double] -> FillRule -> Double -> [ClosedPath Double]
C.difference (forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> ClosedPath Double
loop2path [Located (Trail' Loop V2 Double)]
path1)
  (forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> ClosedPath Double
loop2path [Located (Trail' Loop V2 Double)]
path2) (FillRule -> FillRule
fillrule FillRule
fill) Double
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 :: Double
-> FillRule
-> [Located (Trail' Loop V2 Double)]
-> [Located (Trail' Loop V2 Double)]
-> [Located (Trail' Loop V2 Double)]
loopIntersection Double
tol FillRule
fill [Located (Trail' Loop V2 Double)]
path1 [Located (Trail' Loop V2 Double)]
path2 =
  forall a b. (a -> b) -> [a] -> [b]
map ClosedPath Double -> Located (Trail' Loop V2 Double)
path2loop forall a b. (a -> b) -> a -> b
$ [ClosedPath Double]
-> [ClosedPath Double] -> FillRule -> Double -> [ClosedPath Double]
C.intersection (forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> ClosedPath Double
loop2path [Located (Trail' Loop V2 Double)]
path1)
  (forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> ClosedPath Double
loop2path [Located (Trail' Loop V2 Double)]
path2) (FillRule -> FillRule
fillrule FillRule
fill) Double
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 :: Double
-> FillRule
-> [Located (Trail' Loop V2 Double)]
-> [Located (Trail' Loop V2 Double)]
-> [Located (Trail' Loop V2 Double)]
loopExclusion Double
tol FillRule
fill [Located (Trail' Loop V2 Double)]
path1 [Located (Trail' Loop V2 Double)]
path2 =
  forall a b. (a -> b) -> [a] -> [b]
map ClosedPath Double -> Located (Trail' Loop V2 Double)
path2loop forall a b. (a -> b) -> a -> b
$ [ClosedPath Double]
-> [ClosedPath Double] -> FillRule -> Double -> [ClosedPath Double]
C.exclusion (forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> ClosedPath Double
loop2path [Located (Trail' Loop V2 Double)]
path1)
  (forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> ClosedPath Double
loop2path [Located (Trail' Loop V2 Double)]
path2) (FillRule -> FillRule
fillrule FillRule
fill) Double
tol