{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
module Diagrams.TwoD.Path.Boolean
(
union, difference, intersection, exclusion,
union', difference', intersection', exclusion',
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
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 :: 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 :: 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 :: 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
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
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)
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)
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)
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
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
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
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