{-# 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 =
  [(Point Double, PathJoin Double)] -> ClosedPath Double
forall a. [(Point a, PathJoin a)] -> ClosedPath a
C.ClosedPath ([(Point Double, PathJoin Double)] -> ClosedPath Double)
-> [(Point Double, PathJoin Double)] -> ClosedPath Double
forall a b. (a -> b) -> a -> b
$ Double
-> Double
-> [Segment Closed V2 Double]
-> [(Point Double, PathJoin Double)]
go Double
x0 Double
y0 (Trail' Line V2 Double -> [Segment Closed V2 Double]
forall (v :: * -> *) n. Trail' Line v n -> [Segment Closed v n]
lineSegments (Trail' Line V2 Double -> [Segment Closed V2 Double])
-> Trail' Line V2 Double -> [Segment Closed V2 Double]
forall a b. (a -> b) -> a -> b
$ Trail' Loop V2 Double -> Trail' Line V2 Double
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Trail' Loop v n -> Trail' Line v n
cutLoop (Trail' Loop V2 Double -> Trail' Line V2 Double)
-> Trail' Loop V2 Double -> Trail' Line V2 Double
forall a b. (a -> b) -> a -> b
$ Located (Trail' Loop V2 Double) -> Trail' Loop V2 Double
forall a. Located a -> a
unLoc Located (Trail' Loop V2 Double)
t)
  where
    (P (V2 Double
x0 Double
y0)) = Located (Trail' Loop V2 Double)
-> Point (V (Trail' Loop V2 Double)) (N (Trail' Loop V2 Double))
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]
-> [(Point Double, PathJoin Double)]
go Double
_ Double
_ [] = []
    go Double
x Double
y (Linear (OffsetClosed (V2 Double
x3 Double
y3)):[Segment Closed V2 Double]
r) =
      (Double -> Double -> Point Double
forall a. a -> a -> Point a
C.Point Double
x Double
y, PathJoin Double
forall a. PathJoin a
C.JoinLine) (Point Double, PathJoin Double)
-> [(Point Double, PathJoin Double)]
-> [(Point Double, PathJoin Double)]
forall a. a -> [a] -> [a]
:
      Double
-> Double
-> [Segment Closed V2 Double]
-> [(Point Double, PathJoin Double)]
go (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
x3) (Double
yDouble -> Double -> Double
forall 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) =
      (Double -> Double -> Point Double
forall a. a -> a -> Point a
C.Point Double
x Double
y, Point Double -> Point Double -> PathJoin Double
forall a. Point a -> Point a -> PathJoin a
C.JoinCurve (Double -> Double -> Point Double
forall a. a -> a -> Point a
C.Point (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
x1) (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
y1)) (Double -> Double -> Point Double
forall a. a -> a -> Point a
C.Point (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
x2) (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
y2))) (Point Double, PathJoin Double)
-> [(Point Double, PathJoin Double)]
-> [(Point Double, PathJoin Double)]
forall a. a -> [a] -> [a]
:
      Double
-> Double
-> [Segment Closed V2 Double]
-> [(Point Double, PathJoin Double)]
go (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
+Double
x3) (Double
yDouble -> Double -> Double
forall 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 []) = [Segment
   Closed (V (Trail' Loop V2 Double)) (N (Trail' Loop V2 Double))]
-> Trail' Loop V2 Double
forall t. TrailLike t => [Segment Closed (V t) (N t)] -> t
fromSegments [] Trail' Loop V2 Double
-> Point (V (Trail' Loop V2 Double)) (N (Trail' Loop V2 Double))
-> Located (Trail' Loop V2 Double)
forall a. a -> Point (V a) (N a) -> Located a
`at` Point (V (Trail' Loop V2 Double)) (N (Trail' Loop V2 Double))
Point V2 Double
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin
path2loop (C.ClosedPath ((C.Point Double
x0 Double
y0, PathJoin Double
join):[(Point Double, PathJoin Double)]
r)) =
  [Segment
   Closed (V (Trail' Loop V2 Double)) (N (Trail' Loop V2 Double))]
-> Trail' Loop V2 Double
forall t. TrailLike t => [Segment Closed (V t) (N t)] -> t
fromSegments (Double
-> Double
-> PathJoin Double
-> [(Point Double, PathJoin Double)]
-> [Segment Closed V2 Double]
go Double
x0 Double
y0 PathJoin Double
join [(Point Double, PathJoin Double)]
r) Trail' Loop V2 Double
-> Point (V (Trail' Loop V2 Double)) (N (Trail' Loop V2 Double))
-> Located (Trail' Loop V2 Double)
forall a. a -> Point (V a) (N a) -> Located a
`at` V2 Double -> Point V2 Double
forall (f :: * -> *) a. f a -> Point f a
P (Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 Double
x0 Double
y0)
  where go :: Double
-> Double
-> PathJoin Double
-> [(Point Double, PathJoin Double)]
-> [Segment Closed V2 Double]
go Double
x Double
y PathJoin Double
C.JoinLine [] =
          [V2 Double -> Segment Closed V2 Double
forall (v :: * -> *) n. v n -> Segment Closed v n
straight (Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 (Double
x0Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
x) (Double
y0Double -> Double -> Double
forall 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'):[(Point Double, PathJoin Double)]
r') =
          V2 Double -> Segment Closed V2 Double
forall (v :: * -> *) n. v n -> Segment Closed v n
straight (Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 (Double
x2Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
x) (Double
y2Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
y))Segment Closed V2 Double
-> [Segment Closed V2 Double] -> [Segment Closed V2 Double]
forall a. a -> [a] -> [a]
:
          Double
-> Double
-> PathJoin Double
-> [(Point Double, PathJoin Double)]
-> [Segment Closed V2 Double]
go Double
x2 Double
y2 PathJoin Double
join' [(Point Double, PathJoin Double)]
r'
        go Double
x Double
y (C.JoinCurve (C.Point Double
x1 Double
y1) (C.Point Double
x2 Double
y2)) [(Point Double, PathJoin Double)]
r' =
          case [(Point Double, PathJoin Double)]
r' of
           [] -> [V2 Double -> V2 Double -> V2 Double -> Segment Closed V2 Double
forall (v :: * -> *) n. v n -> v n -> v n -> Segment Closed v n
bezier3 (Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 (Double
x1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
x) (Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
y))
                  (Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 (Double
x2Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
x) (Double
y2Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
y)) (Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 (Double
x0Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
x) (Double
y0Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
y))]
           ((C.Point Double
x3 Double
y3, PathJoin Double
join'):[(Point Double, PathJoin Double)]
r'') ->
             V2 Double -> V2 Double -> V2 Double -> Segment Closed V2 Double
forall (v :: * -> *) n. v n -> v n -> v n -> Segment Closed v n
bezier3 (Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 (Double
x1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
x) (Double
y1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
y)) (Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 (Double
x2Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
x) (Double
y2Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
y))
             (Double -> Double -> V2 Double
forall a. a -> a -> V2 a
V2 (Double
x3Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
x) (Double
y3Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
y)) Segment Closed V2 Double
-> [Segment Closed V2 Double] -> [Segment Closed V2 Double]
forall a. a -> [a] -> [a]
:
             Double
-> Double
-> PathJoin Double
-> [(Point Double, PathJoin Double)]
-> [Segment Closed V2 Double]
go Double
x3 Double
y3 PathJoin Double
join' [(Point Double, 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 = (Trail V2 Double -> Maybe (Trail' Loop V2 Double))
-> Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
forall a b. SameSpace a b => Lens (Located a) (Located b) a b
Lens
  (Located (Trail V2 Double))
  (Located (Trail' Loop V2 Double))
  (Trail V2 Double)
  (Trail' Loop V2 Double)
located ((Trail' Line V2 Double -> Maybe (Trail' Loop V2 Double))
-> (Trail' Loop V2 Double -> Maybe (Trail' Loop V2 Double))
-> Trail V2 Double
-> Maybe (Trail' Loop V2 Double)
forall (v :: * -> *) n r.
(Trail' Line v n -> r) -> (Trail' Loop v n -> r) -> Trail v n -> r
withTrail (Maybe (Trail' Loop V2 Double)
-> Trail' Line V2 Double -> Maybe (Trail' Loop V2 Double)
forall a b. a -> b -> a
const Maybe (Trail' Loop V2 Double)
forall a. Maybe a
Nothing) Trail' Loop V2 Double -> Maybe (Trail' Loop V2 Double)
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)) = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (Double -> Double
forall a. Num a => a -> a
abs Double
m) (Double -> Double
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) =
  Offset c V2 Double -> Double
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) =
  [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Offset c V2 Double -> Double
forall c. Offset c V2 Double -> Double
offsetMax Offset c V2 Double
o, Double -> Double
forall a. Num a => a -> a
abs Double
a, Double -> Double
forall a. Num a => a -> a
abs Double
b,
           Double -> Double
forall a. Num a => a -> a
abs Double
c, Double -> Double
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 = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Segment Open V2 Double -> Double
forall c. Segment c V2 Double -> Double
segmentMax Segment Open V2 Double
lastSegDouble -> [Double] -> [Double]
forall a. a -> [a] -> [a]
: (Segment Closed V2 Double -> Double)
-> [Segment Closed V2 Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Segment Closed V2 Double -> Double
forall c. Segment c V2 Double -> Double
segmentMax [Segment Closed V2 Double]
segs)
  where ([Segment Closed V2 Double]
segs, Segment Open V2 Double
lastSeg) = Trail' Loop V2 Double
-> ([Segment Closed V2 Double], Segment Open V2 Double)
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 = ASetter
  (Located (Trail' Loop V2 Double))
  (Located (Trail V2 Double))
  (Trail' Loop V2 Double)
  (Trail V2 Double)
-> (Trail' Loop V2 Double -> Trail V2 Double)
-> Located (Trail' Loop V2 Double)
-> Located (Trail V2 Double)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Located (Trail' Loop V2 Double))
  (Located (Trail V2 Double))
  (Trail' Loop V2 Double)
  (Trail V2 Double)
forall a b. SameSpace a b => Lens (Located a) (Located b) a b
Lens
  (Located (Trail' Loop V2 Double))
  (Located (Trail V2 Double))
  (Trail' Loop V2 Double)
  (Trail V2 Double)
located Trail' Loop V2 Double -> Trail V2 Double
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 =
  [Located (Trail V2 Double)] -> Path V2 Double
forall (v :: * -> *) n. [Located (Trail v n)] -> Path v n
Path ([Located (Trail V2 Double)] -> Path V2 Double)
-> [Located (Trail V2 Double)] -> Path V2 Double
forall a b. (a -> b) -> a -> b
$ (Located (Trail' Loop V2 Double) -> Located (Trail V2 Double))
-> [Located (Trail' Loop V2 Double)] -> [Located (Trail V2 Double)]
forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> Located (Trail V2 Double)
loop2trail ([Located (Trail' Loop V2 Double)] -> [Located (Trail V2 Double)])
-> [Located (Trail' Loop V2 Double)] -> [Located (Trail V2 Double)]
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 = (Located (Trail V2 Double)
 -> Maybe (Located (Trail' Loop V2 Double)))
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop ([Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)])
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> b) -> a -> b
$
                Path V2 Double -> [Located (Trail V2 Double)]
forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 Double
p
        tol :: Double
tol = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Located (Trail' Loop V2 Double) -> Double)
-> [Located (Trail' Loop V2 Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Trail' Loop V2 Double -> Double
loopMax(Trail' Loop V2 Double -> Double)
-> (Located (Trail' Loop V2 Double) -> Trail' Loop V2 Double)
-> Located (Trail' Loop V2 Double)
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Located (Trail' Loop V2 Double) -> Trail' Loop V2 Double
forall a. Located a -> a
unLoc) [Located (Trail' Loop V2 Double)]
loops) Double -> Double -> Double
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 =
  [Located (Trail V2 Double)] -> Path V2 Double
forall (v :: * -> *) n. [Located (Trail v n)] -> Path v n
Path ([Located (Trail V2 Double)] -> Path V2 Double)
-> [Located (Trail V2 Double)] -> Path V2 Double
forall a b. (a -> b) -> a -> b
$ (Located (Trail' Loop V2 Double) -> Located (Trail V2 Double))
-> [Located (Trail' Loop V2 Double)] -> [Located (Trail V2 Double)]
forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> Located (Trail V2 Double)
loop2trail ([Located (Trail' Loop V2 Double)] -> [Located (Trail V2 Double)])
-> [Located (Trail' Loop V2 Double)] -> [Located (Trail V2 Double)]
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 = (Located (Trail V2 Double)
 -> Maybe (Located (Trail' Loop V2 Double)))
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop ([Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)])
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> b) -> a -> b
$
                Path V2 Double -> [Located (Trail V2 Double)]
forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 Double
path1
        loops2 :: [Located (Trail' Loop V2 Double)]
loops2 = (Located (Trail V2 Double)
 -> Maybe (Located (Trail' Loop V2 Double)))
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop ([Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)])
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> b) -> a -> b
$
                Path V2 Double -> [Located (Trail V2 Double)]
forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 Double
path2
        tol :: Double
tol = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max ([Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Located (Trail' Loop V2 Double) -> Double)
-> [Located (Trail' Loop V2 Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Trail' Loop V2 Double -> Double
loopMax(Trail' Loop V2 Double -> Double)
-> (Located (Trail' Loop V2 Double) -> Trail' Loop V2 Double)
-> Located (Trail' Loop V2 Double)
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Located (Trail' Loop V2 Double) -> Trail' Loop V2 Double
forall a. Located a -> a
unLoc) [Located (Trail' Loop V2 Double)]
loops1))
              ([Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Located (Trail' Loop V2 Double) -> Double)
-> [Located (Trail' Loop V2 Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Trail' Loop V2 Double -> Double
loopMax(Trail' Loop V2 Double -> Double)
-> (Located (Trail' Loop V2 Double) -> Trail' Loop V2 Double)
-> Located (Trail' Loop V2 Double)
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Located (Trail' Loop V2 Double) -> Trail' Loop V2 Double
forall a. Located a -> a
unLoc) [Located (Trail' Loop V2 Double)]
loops2))
              Double -> Double -> Double
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 =
  [Located (Trail V2 Double)] -> Path V2 Double
forall (v :: * -> *) n. [Located (Trail v n)] -> Path v n
Path ([Located (Trail V2 Double)] -> Path V2 Double)
-> [Located (Trail V2 Double)] -> Path V2 Double
forall a b. (a -> b) -> a -> b
$ (Located (Trail' Loop V2 Double) -> Located (Trail V2 Double))
-> [Located (Trail' Loop V2 Double)] -> [Located (Trail V2 Double)]
forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> Located (Trail V2 Double)
loop2trail ([Located (Trail' Loop V2 Double)] -> [Located (Trail V2 Double)])
-> [Located (Trail' Loop V2 Double)] -> [Located (Trail V2 Double)]
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 = (Located (Trail V2 Double)
 -> Maybe (Located (Trail' Loop V2 Double)))
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop ([Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)])
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> b) -> a -> b
$
                Path V2 Double -> [Located (Trail V2 Double)]
forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 Double
path1
        loops2 :: [Located (Trail' Loop V2 Double)]
loops2 = (Located (Trail V2 Double)
 -> Maybe (Located (Trail' Loop V2 Double)))
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop ([Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)])
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> b) -> a -> b
$
                Path V2 Double -> [Located (Trail V2 Double)]
forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 Double
path2
        tol :: Double
tol = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max ([Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Located (Trail' Loop V2 Double) -> Double)
-> [Located (Trail' Loop V2 Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Trail' Loop V2 Double -> Double
loopMax(Trail' Loop V2 Double -> Double)
-> (Located (Trail' Loop V2 Double) -> Trail' Loop V2 Double)
-> Located (Trail' Loop V2 Double)
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Located (Trail' Loop V2 Double) -> Trail' Loop V2 Double
forall a. Located a -> a
unLoc) [Located (Trail' Loop V2 Double)]
loops1))
              ([Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Located (Trail' Loop V2 Double) -> Double)
-> [Located (Trail' Loop V2 Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Trail' Loop V2 Double -> Double
loopMax(Trail' Loop V2 Double -> Double)
-> (Located (Trail' Loop V2 Double) -> Trail' Loop V2 Double)
-> Located (Trail' Loop V2 Double)
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Located (Trail' Loop V2 Double) -> Trail' Loop V2 Double
forall a. Located a -> a
unLoc) [Located (Trail' Loop V2 Double)]
loops2))
              Double -> Double -> Double
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 =
  [Located (Trail V2 Double)] -> Path V2 Double
forall (v :: * -> *) n. [Located (Trail v n)] -> Path v n
Path ([Located (Trail V2 Double)] -> Path V2 Double)
-> [Located (Trail V2 Double)] -> Path V2 Double
forall a b. (a -> b) -> a -> b
$ (Located (Trail' Loop V2 Double) -> Located (Trail V2 Double))
-> [Located (Trail' Loop V2 Double)] -> [Located (Trail V2 Double)]
forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> Located (Trail V2 Double)
loop2trail ([Located (Trail' Loop V2 Double)] -> [Located (Trail V2 Double)])
-> [Located (Trail' Loop V2 Double)] -> [Located (Trail V2 Double)]
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 = (Located (Trail V2 Double)
 -> Maybe (Located (Trail' Loop V2 Double)))
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop ([Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)])
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> b) -> a -> b
$
                Path V2 Double -> [Located (Trail V2 Double)]
forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 Double
path1
        loops2 :: [Located (Trail' Loop V2 Double)]
loops2 = (Located (Trail V2 Double)
 -> Maybe (Located (Trail' Loop V2 Double)))
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop ([Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)])
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> b) -> a -> b
$
                Path V2 Double -> [Located (Trail V2 Double)]
forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 Double
path2
        tol :: Double
tol = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max ([Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Located (Trail' Loop V2 Double) -> Double)
-> [Located (Trail' Loop V2 Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Trail' Loop V2 Double -> Double
loopMax(Trail' Loop V2 Double -> Double)
-> (Located (Trail' Loop V2 Double) -> Trail' Loop V2 Double)
-> Located (Trail' Loop V2 Double)
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Located (Trail' Loop V2 Double) -> Trail' Loop V2 Double
forall a. Located a -> a
unLoc) [Located (Trail' Loop V2 Double)]
loops1))
              ([Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Located (Trail' Loop V2 Double) -> Double)
-> [Located (Trail' Loop V2 Double)] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Trail' Loop V2 Double -> Double
loopMax(Trail' Loop V2 Double -> Double)
-> (Located (Trail' Loop V2 Double) -> Trail' Loop V2 Double)
-> Located (Trail' Loop V2 Double)
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Located (Trail' Loop V2 Double) -> Trail' Loop V2 Double
forall a. Located a -> a
unLoc) [Located (Trail' Loop V2 Double)]
loops2))
              Double -> Double -> Double
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 =
  [Located (Trail V2 Double)] -> Path V2 Double
forall (v :: * -> *) n. [Located (Trail v n)] -> Path v n
Path ([Located (Trail V2 Double)] -> Path V2 Double)
-> [Located (Trail V2 Double)] -> Path V2 Double
forall a b. (a -> b) -> a -> b
$ (Located (Trail' Loop V2 Double) -> Located (Trail V2 Double))
-> [Located (Trail' Loop V2 Double)] -> [Located (Trail V2 Double)]
forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> Located (Trail V2 Double)
loop2trail ([Located (Trail' Loop V2 Double)] -> [Located (Trail V2 Double)])
-> [Located (Trail' Loop V2 Double)] -> [Located (Trail V2 Double)]
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)]
 -> [Located (Trail' Loop V2 Double)])
-> [Located (Trail' Loop V2 Double)]
-> [Located (Trail' Loop V2 Double)]
forall a b. (a -> b) -> a -> b
$
  (Located (Trail V2 Double)
 -> Maybe (Located (Trail' Loop V2 Double)))
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop ([Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)])
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> b) -> a -> b
$
  Path V2 Double -> [Located (Trail V2 Double)]
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 =
  [Located (Trail V2 Double)] -> Path V2 Double
forall (v :: * -> *) n. [Located (Trail v n)] -> Path v n
Path ([Located (Trail V2 Double)] -> Path V2 Double)
-> [Located (Trail V2 Double)] -> Path V2 Double
forall a b. (a -> b) -> a -> b
$ (Located (Trail' Loop V2 Double) -> Located (Trail V2 Double))
-> [Located (Trail' Loop V2 Double)] -> [Located (Trail V2 Double)]
forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> Located (Trail V2 Double)
loop2trail ([Located (Trail' Loop V2 Double)] -> [Located (Trail V2 Double)])
-> [Located (Trail' Loop V2 Double)] -> [Located (Trail V2 Double)]
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 V2 Double)
 -> Maybe (Located (Trail' Loop V2 Double)))
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop ([Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)])
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> b) -> a -> b
$ Path V2 Double -> [Located (Trail V2 Double)]
forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 Double
path1)
  ((Located (Trail V2 Double)
 -> Maybe (Located (Trail' Loop V2 Double)))
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop ([Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)])
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> b) -> a -> b
$ Path V2 Double -> [Located (Trail V2 Double)]
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 =
  [Located (Trail V2 Double)] -> Path V2 Double
forall (v :: * -> *) n. [Located (Trail v n)] -> Path v n
Path ([Located (Trail V2 Double)] -> Path V2 Double)
-> [Located (Trail V2 Double)] -> Path V2 Double
forall a b. (a -> b) -> a -> b
$ (Located (Trail' Loop V2 Double) -> Located (Trail V2 Double))
-> [Located (Trail' Loop V2 Double)] -> [Located (Trail V2 Double)]
forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> Located (Trail V2 Double)
loop2trail ([Located (Trail' Loop V2 Double)] -> [Located (Trail V2 Double)])
-> [Located (Trail' Loop V2 Double)] -> [Located (Trail V2 Double)]
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 V2 Double)
 -> Maybe (Located (Trail' Loop V2 Double)))
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop ([Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)])
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> b) -> a -> b
$ Path V2 Double -> [Located (Trail V2 Double)]
forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 Double
path1)
  ((Located (Trail V2 Double)
 -> Maybe (Located (Trail' Loop V2 Double)))
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop ([Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)])
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> b) -> a -> b
$ Path V2 Double -> [Located (Trail V2 Double)]
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 =
  [Located (Trail V2 Double)] -> Path V2 Double
forall (v :: * -> *) n. [Located (Trail v n)] -> Path v n
Path ([Located (Trail V2 Double)] -> Path V2 Double)
-> [Located (Trail V2 Double)] -> Path V2 Double
forall a b. (a -> b) -> a -> b
$ (Located (Trail' Loop V2 Double) -> Located (Trail V2 Double))
-> [Located (Trail' Loop V2 Double)] -> [Located (Trail V2 Double)]
forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> Located (Trail V2 Double)
loop2trail ([Located (Trail' Loop V2 Double)] -> [Located (Trail V2 Double)])
-> [Located (Trail' Loop V2 Double)] -> [Located (Trail V2 Double)]
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 V2 Double)
 -> Maybe (Located (Trail' Loop V2 Double)))
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop ([Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)])
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> b) -> a -> b
$ Path V2 Double -> [Located (Trail V2 Double)]
forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 Double
path1)
  ((Located (Trail V2 Double)
 -> Maybe (Located (Trail' Loop V2 Double)))
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Located (Trail V2 Double)
-> Maybe (Located (Trail' Loop V2 Double))
trail2loop ([Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)])
-> [Located (Trail V2 Double)] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> b) -> a -> b
$ Path V2 Double -> [Located (Trail V2 Double)]
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  =
  (ClosedPath Double -> Located (Trail' Loop V2 Double))
-> [ClosedPath Double] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> b) -> [a] -> [b]
map ClosedPath Double -> Located (Trail' Loop V2 Double)
path2loop ([ClosedPath Double] -> [Located (Trail' Loop V2 Double)])
-> [ClosedPath Double] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> b) -> a -> b
$ [ClosedPath Double] -> FillRule -> Double -> [ClosedPath Double]
C.union ((Located (Trail' Loop V2 Double) -> ClosedPath Double)
-> [Located (Trail' Loop V2 Double)] -> [ClosedPath Double]
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  =
  (ClosedPath Double -> Located (Trail' Loop V2 Double))
-> [ClosedPath Double] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> b) -> [a] -> [b]
map ClosedPath Double -> Located (Trail' Loop V2 Double)
path2loop ([ClosedPath Double] -> [Located (Trail' Loop V2 Double)])
-> [ClosedPath Double] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> b) -> a -> b
$ [ClosedPath Double]
-> [ClosedPath Double] -> FillRule -> Double -> [ClosedPath Double]
C.difference ((Located (Trail' Loop V2 Double) -> ClosedPath Double)
-> [Located (Trail' Loop V2 Double)] -> [ClosedPath Double]
forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> ClosedPath Double
loop2path [Located (Trail' Loop V2 Double)]
path1)
  ((Located (Trail' Loop V2 Double) -> ClosedPath Double)
-> [Located (Trail' Loop V2 Double)] -> [ClosedPath Double]
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 =
  (ClosedPath Double -> Located (Trail' Loop V2 Double))
-> [ClosedPath Double] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> b) -> [a] -> [b]
map ClosedPath Double -> Located (Trail' Loop V2 Double)
path2loop ([ClosedPath Double] -> [Located (Trail' Loop V2 Double)])
-> [ClosedPath Double] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> b) -> a -> b
$ [ClosedPath Double]
-> [ClosedPath Double] -> FillRule -> Double -> [ClosedPath Double]
C.intersection ((Located (Trail' Loop V2 Double) -> ClosedPath Double)
-> [Located (Trail' Loop V2 Double)] -> [ClosedPath Double]
forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> ClosedPath Double
loop2path [Located (Trail' Loop V2 Double)]
path1)
  ((Located (Trail' Loop V2 Double) -> ClosedPath Double)
-> [Located (Trail' Loop V2 Double)] -> [ClosedPath Double]
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 =
  (ClosedPath Double -> Located (Trail' Loop V2 Double))
-> [ClosedPath Double] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> b) -> [a] -> [b]
map ClosedPath Double -> Located (Trail' Loop V2 Double)
path2loop ([ClosedPath Double] -> [Located (Trail' Loop V2 Double)])
-> [ClosedPath Double] -> [Located (Trail' Loop V2 Double)]
forall a b. (a -> b) -> a -> b
$ [ClosedPath Double]
-> [ClosedPath Double] -> FillRule -> Double -> [ClosedPath Double]
C.exclusion ((Located (Trail' Loop V2 Double) -> ClosedPath Double)
-> [Located (Trail' Loop V2 Double)] -> [ClosedPath Double]
forall a b. (a -> b) -> [a] -> [b]
map Located (Trail' Loop V2 Double) -> ClosedPath Double
loop2path [Located (Trail' Loop V2 Double)]
path1)
  ((Located (Trail' Loop V2 Double) -> ClosedPath Double)
-> [Located (Trail' Loop V2 Double)] -> [ClosedPath Double]
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