{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Diagrams.TwoD.Path.IntersectionExtras
-- Copyright   :  (c) 2018 Mike Zuser
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  Mike Zuser <mikezuser@gmail.com>
--
-- Extra functions for working with the intersections of `Path`s. This
-- module was motivated by `explodeIntersections`. The rest of the module is
-- either functions that where needed to build it or functions to help
-- consume it.
-----------------------------------------------------------------------------
module Diagrams.TwoD.Path.IntersectionExtras
  ( -- * Intersection Parameters
    intersectParams, intersectParams'
  , intersectParamsP, intersectParamsP'
  , intersectParamsT, intersectParamsT'
  , intersectParamsTS, intersectParamsTS'
    -- * Cutting Paths and Trails
  , cutBy, cutBy'
  , cutPBy, cutPBy'
  , cutTBy, cutTBy'
    -- * Rad Explosions
  , explodeSegments
  , explodeIntersections, explodeIntersections'
  , explodeBoth, explodeBoth'
    -- * Consuming Cut Paths
  , OnSections(..)
  ) where
import Data.List

import Diagrams.Prelude
import Diagrams.TwoD.Segment

-- defEps uses the value from Diagrams.TwoD.Path
defEps :: Fractional n => n
defEps :: forall n. Fractional n => n
defEps = n
1e-8

-----------------------------------------------------------------------------
-- Intersection Parameters --------------------------------------------------
-----------------------------------------------------------------------------

-- | Find the intersect parameters for each component trail of two pathlike
--   objects when the objects are intersected, returning a seperate list for
--   each trail.
intersectParams :: (InSpace V2 n t, SameSpace t s, ToPath t, ToPath s, OrderedField n) =>
  t -> s -> ([[n]], [[n]])
intersectParams :: forall n t s.
(InSpace V2 n t, SameSpace t s, ToPath t, ToPath s,
 OrderedField n) =>
t -> s -> ([[n]], [[n]])
intersectParams = forall n t s.
(InSpace V2 n t, SameSpace t s, ToPath t, ToPath s,
 OrderedField n) =>
n -> t -> s -> ([[n]], [[n]])
intersectParams' forall n. Fractional n => n
defEps

-- | `intersectParams` using the given tolerance.
intersectParams' :: (InSpace V2 n t, SameSpace t s, ToPath t, ToPath s, OrderedField n) =>
  n -> t -> s -> ([[n]], [[n]])
intersectParams' :: forall n t s.
(InSpace V2 n t, SameSpace t s, ToPath t, ToPath s,
 OrderedField n) =>
n -> t -> s -> ([[n]], [[n]])
intersectParams' n
eps t
as s
bs = forall n.
OrderedField n =>
n -> Path V2 n -> Path V2 n -> ([[n]], [[n]])
intersectParamsP' n
eps (forall t.
(ToPath t, Metric (V t), OrderedField (N t)) =>
t -> Path (V t) (N t)
toPath t
as) (forall t.
(ToPath t, Metric (V t), OrderedField (N t)) =>
t -> Path (V t) (N t)
toPath s
bs)

-- | Find the intersect parameters for each component trail of two
--   paths when the paths are intersected, returning a seperate list for
--   each trail.
intersectParamsP :: OrderedField n => Path V2 n -> Path V2 n -> ([[n]], [[n]])
intersectParamsP :: forall n.
OrderedField n =>
Path V2 n -> Path V2 n -> ([[n]], [[n]])
intersectParamsP = forall n.
OrderedField n =>
n -> Path V2 n -> Path V2 n -> ([[n]], [[n]])
intersectParamsP' forall n. Fractional n => n
defEps

-- | `intersectParamsP` using the given tolerance.
intersectParamsP' :: OrderedField n => n -> Path V2 n -> Path V2 n -> ([[n]], [[n]])
intersectParamsP' :: forall n.
OrderedField n =>
n -> Path V2 n -> Path V2 n -> ([[n]], [[n]])
intersectParamsP' n
eps Path V2 n
as Path V2 n
bs = ([[n]]
ps, [[n]]
qs)
  where
    is :: [[([n], [n])]]
is = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map (forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 n
bs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n.
OrderedField n =>
n -> Located (Trail V2 n) -> Located (Trail V2 n) -> ([n], [n])
intersectParamsT' n
eps) (forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 n
as)
    ps :: [[n]]
ps = forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst) [[([n], [n])]]
is
    qs :: [[n]]
qs = forall a b. (a -> b) -> [a] -> [b]
map (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd) (forall a. [[a]] -> [[a]]
transpose [[([n], [n])]]
is)

-- | Find the intersect parameters between two located trails.
intersectParamsT :: OrderedField n =>
  Located (Trail V2 n) -> Located (Trail V2 n) -> ([n], [n])
intersectParamsT :: forall n.
OrderedField n =>
Located (Trail V2 n) -> Located (Trail V2 n) -> ([n], [n])
intersectParamsT = forall n.
OrderedField n =>
n -> Located (Trail V2 n) -> Located (Trail V2 n) -> ([n], [n])
intersectParamsT' forall n. Fractional n => n
defEps

-- | `intersectParamsT` using the given tolerance.
intersectParamsT' :: OrderedField n =>
  n -> Located (Trail V2 n) -> Located (Trail V2 n) -> ([n], [n])
intersectParamsT' :: forall n.
OrderedField n =>
n -> Located (Trail V2 n) -> Located (Trail V2 n) -> ([n], [n])
intersectParamsT' n
eps Located (Trail V2 n)
as Located (Trail V2 n)
bs = (forall {a}. Fractional a => [[a]] -> [a]
reparam [[n]]
ps, forall {a}. Fractional a => [[a]] -> [a]
reparam [[n]]
qs)
  where
    ([[n]]
ps, [[n]]
qs) = forall n.
OrderedField n =>
n -> Located (Trail V2 n) -> Located (Trail V2 n) -> ([[n]], [[n]])
intersectParamsTS' n
eps Located (Trail V2 n)
as Located (Trail V2 n)
bs
    reparam :: [[a]] -> [a]
reparam [[a]]
segs = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> [a] -> [a]
f [(Int
0::Int)..] [[a]]
segs
      where f :: Int -> [a] -> [a]
f Int
segNo = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a -> b) -> a -> b
$ \a
p -> (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
segNo forall a. Num a => a -> a -> a
+ a
p) forall a. Fractional a => a -> a -> a
/ forall i a. Num i => [a] -> i
genericLength [[a]]
segs

-- | Find the intersect parameters for each component segment of two
--   located trails when the trails are intersected, returning a
--   list for each trail containing a list of intersections for
--   each segemnt of that trail.
intersectParamsTS :: OrderedField n =>
  Located (Trail V2 n) -> Located (Trail V2 n) -> ([[n]], [[n]])
intersectParamsTS :: forall n.
OrderedField n =>
Located (Trail V2 n) -> Located (Trail V2 n) -> ([[n]], [[n]])
intersectParamsTS = forall n.
OrderedField n =>
n -> Located (Trail V2 n) -> Located (Trail V2 n) -> ([[n]], [[n]])
intersectParamsTS' forall n. Fractional n => n
defEps

-- | `intersectParamsTS` using the given tolerance.
intersectParamsTS' :: OrderedField n =>
  n -> Located (Trail V2 n) -> Located (Trail V2 n) -> ([[n]], [[n]])
intersectParamsTS' :: forall n.
OrderedField n =>
n -> Located (Trail V2 n) -> Located (Trail V2 n) -> ([[n]], [[n]])
intersectParamsTS' n
eps Located (Trail V2 n)
as Located (Trail V2 n)
bs = ([[n]]
ps, [[n]]
qs)
  where
    ([(Int, FixedSegment V2 n)]
as', [(Int, FixedSegment V2 n)]
bs') = (Located (Trail V2 n)
as, Located (Trail V2 n)
bs) forall a b. a -> (a -> b) -> b
& forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> [FixedSegment v n]
fixTrail)
    is :: [[[(n, n)]]]
is = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [(Int, FixedSegment V2 n)]
bs' forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, FixedSegment V2 n) -> (Int, FixedSegment V2 n) -> [(n, n)]
isect) [(Int, FixedSegment V2 n)]
as'
    isect :: (Int, FixedSegment V2 n) -> (Int, FixedSegment V2 n) -> [(n, n)]
isect (Int
i, FixedSegment V2 n
a) (Int
j, FixedSegment V2 n
b)
      | FixedSegment V2 n
a forall a. Eq a => a -> a -> Bool
== FixedSegment V2 n
b    = []
      | Bool
otherwise = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n, n) -> Bool
ends)
                  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(n
p, n
q, P2 n
_) -> (n
p, n
q))
                  forall a b. (a -> b) -> a -> b
$ forall n.
OrderedField n =>
n -> FixedSegment V2 n -> FixedSegment V2 n -> [(n, n, P2 n)]
segmentSegment n
eps FixedSegment V2 n
a FixedSegment V2 n
b
      where
        ends :: (n, n) -> Bool
ends (n
p, n
q) = Bool
adjacent Bool -> Bool -> Bool
&& forall a. Ord a => a -> a -> a
min n
p n
q n -> n -> Bool
`near` n
0 Bool -> Bool -> Bool
&& forall a. Ord a => a -> a -> a
max n
p n
q n -> n -> Bool
`near` n
1
        adjacent :: Bool
adjacent = Located (Trail V2 n)
as forall a. Eq a => a -> a -> Bool
== Located (Trail V2 n)
bs Bool -> Bool -> Bool
&& (forall a. Num a => a -> a
abs (Int
i forall a. Num a => a -> a -> a
- Int
j) forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| forall a. Ord a => a -> a -> a
min Int
i Int
j forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& forall a. Ord a => a -> a -> a
max Int
i Int
j forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, FixedSegment V2 n)]
as' forall a. Num a => a -> a -> a
- Int
1)
        near :: n -> n -> Bool
near n
x n
n = forall a. Num a => a -> a
abs (n
x forall a. Num a => a -> a -> a
- n
n) forall a. Ord a => a -> a -> Bool
< n
eps
    ps :: [[n]]
ps = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) [[[(n, n)]]]
is
    qs :: [[n]]
qs = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) (forall a. [[a]] -> [[a]]
transpose [[[(n, n)]]]
is)

-----------------------------------------------------------------------------
-- Cutting Paths and Trails -------------------------------------------------
-----------------------------------------------------------------------------

-- | Seperate a pathlike object into sections at every point it intersects
--   a second pathlike object, returning a list of sections for each component
--   trail.
--
--   <<diagrams/src_Diagrams_TwoD_Path_IntersectionExtras_cutByEx.svg#diagram=cutByEx&width=300>>
--
--   > cutByEx = onSections (squares `cutBy` line) colorLines
--   >        <> stroke line
--   >   where
--   >     squares, line :: Path V2 Double
--   >     squares = square 1
--   >            <> square 1 # rotate (1/8 @@ turn)
--   >     line  = hrule 2
--   >     colorLines = map (map lc)
--   >       [ [ red, orange]
--   >       , [blue, purple] ]
cutBy :: (OrderedField n, Real n, InSpace V2 n t, SameSpace t s, ToPath t, ToPath s) =>
  t -> s -> [[Located (Trail V2 n)]]
cutBy :: forall n t s.
(OrderedField n, Real n, InSpace V2 n t, SameSpace t s, ToPath t,
 ToPath s) =>
t -> s -> [[Located (Trail V2 n)]]
cutBy = forall n t s.
(OrderedField n, Real n, InSpace V2 n t, SameSpace t s, ToPath t,
 ToPath s) =>
n -> t -> s -> [[Located (Trail V2 n)]]
cutBy' forall n. Fractional n => n
defEps

-- | `cutBy` using the given tolerance for calculating intersections.
cutBy' :: (OrderedField n, Real n, InSpace V2 n t, SameSpace t s, ToPath t, ToPath s) =>
  n -> t -> s -> [[Located (Trail V2 n)]]
cutBy' :: forall n t s.
(OrderedField n, Real n, InSpace V2 n t, SameSpace t s, ToPath t,
 ToPath s) =>
n -> t -> s -> [[Located (Trail V2 n)]]
cutBy' n
eps t
a s
b = forall n.
(OrderedField n, Real n) =>
n -> Path V2 n -> Path V2 n -> [[Located (Trail V2 n)]]
cutPBy' n
eps (forall t.
(ToPath t, Metric (V t), OrderedField (N t)) =>
t -> Path (V t) (N t)
toPath t
a) (forall t.
(ToPath t, Metric (V t), OrderedField (N t)) =>
t -> Path (V t) (N t)
toPath s
b)

-- | Seperate a path into sections at every point it intersects a second path,
--   returning a list of sections for each component trail.
cutPBy :: (OrderedField n, Real n) => Path V2 n -> Path V2 n -> [[Located (Trail V2 n)]]
cutPBy :: forall n.
(OrderedField n, Real n) =>
Path V2 n -> Path V2 n -> [[Located (Trail V2 n)]]
cutPBy = forall n.
(OrderedField n, Real n) =>
n -> Path V2 n -> Path V2 n -> [[Located (Trail V2 n)]]
cutPBy' forall n. Fractional n => n
defEps

-- | `cutPBy` using the given tolerance for calculating intersections.
cutPBy' :: (OrderedField n, Real n) => n -> Path V2 n -> Path V2 n -> [[Located (Trail V2 n)]]
cutPBy' :: forall n.
(OrderedField n, Real n) =>
n -> Path V2 n -> Path V2 n -> [[Located (Trail V2 n)]]
cutPBy' n
eps Path V2 n
p1 Path V2 n
p2 = forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall n.
(OrderedField n, Real n) =>
n -> Located (Trail V2 n) -> Path V2 n -> [Located (Trail V2 n)]
cutTBy' n
eps) Path V2 n
p2) (forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 n
p1)

-- | Seperate a located trail into sections at every point it intersects a path.
cutTBy :: (OrderedField n, Real n) => Located (Trail V2 n) -> Path V2 n -> [Located (Trail V2 n)]
cutTBy :: forall n.
(OrderedField n, Real n) =>
Located (Trail V2 n) -> Path V2 n -> [Located (Trail V2 n)]
cutTBy = forall n.
(OrderedField n, Real n) =>
n -> Located (Trail V2 n) -> Path V2 n -> [Located (Trail V2 n)]
cutTBy' forall n. Fractional n => n
defEps

-- | `cutTBy` using the given tolerance for calculating intersections.
cutTBy' :: (OrderedField n, Real n) => n -> Located (Trail V2 n) -> Path V2 n -> [Located (Trail V2 n)]
cutTBy' :: forall n.
(OrderedField n, Real n) =>
n -> Located (Trail V2 n) -> Path V2 n -> [Located (Trail V2 n)]
cutTBy' n
eps Located (Trail V2 n)
t Path V2 n
p
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [n]
isects                                 = [Located (Trail V2 n)
t]
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [n]
nearEnds Bool -> Bool -> Bool
&& forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm (Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
start forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
end) forall a. Ord a => a -> a -> Bool
< n
eps = [Located (Trail V2 n)]
gluedEnds
  | Bool
otherwise                                   = [Located (Trail V2 n)]
subsections
  where
    subsections :: [Located (Trail V2 n)]
subsections = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall p. Sectionable p => p -> N p -> N p -> p
section Located (Trail V2 n)
t) (n
0forall a. a -> [a] -> [a]
:[n]
isects) ([n]
isectsforall a. [a] -> [a] -> [a]
++[n
1])
    isects :: [n]
isects = [n] -> [n]
sortAndAvoidEmpty [n]
notNearEnds
    sortAndAvoidEmpty :: [n] -> [n]
sortAndAvoidEmpty = forall a b. (a -> b) -> [a] -> [b]
map forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\n
a n
b -> forall a. Num a => a -> a
abs (n
a forall a. Num a => a -> a -> a
- n
b) forall a. Ord a => a -> a -> Bool
< n
eps) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort
    ([n]
notNearEnds, [n]
nearEnds) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\n
p -> (n
eps forall a. Ord a => a -> a -> Bool
< n
p) Bool -> Bool -> Bool
&& (n
p forall a. Ord a => a -> a -> Bool
< n
1forall a. Num a => a -> a -> a
-n
eps)) [n]
rawIsects
    rawIsects :: [n]
rawIsects = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall n.
OrderedField n =>
n -> Located (Trail V2 n) -> Located (Trail V2 n) -> ([n], [n])
intersectParamsT' n
eps Located (Trail V2 n)
t) (forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 n
p)

    start :: Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
start = forall a. [a] -> a
head [Located (Trail V2 n)]
subsections forall p. Parametric p => p -> N p -> Codomain p (N p)
`atParam` n
0
    end :: Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
end   = forall a. [a] -> a
last [Located (Trail V2 n)]
subsections forall p. Parametric p => p -> N p -> Codomain p (N p)
`atParam` n
1
    gluedEnds :: [Located (Trail V2 n)]
gluedEnds = forall (v :: * -> *) n.
(Metric v, Ord n, Floating n) =>
[FixedSegment v n] -> Located (Trail v n)
unfixTrail (forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> [FixedSegment v n]
fixTrail (forall a. [a] -> a
last [Located (Trail V2 n)]
subsections) forall a. [a] -> [a] -> [a]
++ forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> [FixedSegment v n]
fixTrail (forall a. [a] -> a
head [Located (Trail V2 n)]
subsections))
              forall a. a -> [a] -> [a]
: forall a. [a] -> [a]
init (forall a. [a] -> [a]
tail [Located (Trail V2 n)]
subsections)

-----------------------------------------------------------------------------
-- Rad Explosions -----------------------------------------------------------
-----------------------------------------------------------------------------

-- | explodePath specialized to return located trails. This provides the compiler
--   the necessary type information to use it with `onSections` without providing
--   a type annotation.
--
--   <<diagrams/src_Diagrams_TwoD_Path_IntersectionExtras_explodeSegmentsEx.svg#diagram=explodeSegmentsEx&width=300>>
--
--   > explodeSegmentsEx = onSections (explodeSegments squares) colorLines
--   >   where
--   >     squares = square 1
--   >            <> square 1 # rotate (1/8 @@ turn)
--   >     colorLines = map (map lc)
--   >       [ [ red, yellow,   gold, orange]
--   >       , [blue, violet, purple, indigo] ]
explodeSegments :: (Metric v, OrderedField n) => Path v n -> [[Located (Trail v n)]]
explodeSegments :: forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Path v n -> [[Located (Trail v n)]]
explodeSegments = forall t (v :: * -> *) n.
(V t ~ v, N t ~ n, TrailLike t) =>
Path v n -> [[t]]
explodePath

-- | Turn a path a list of component trails, then cut those segments at all
--   their intersections.
--
--   <<diagrams/src_Diagrams_TwoD_Path_IntersectionExtras_explodeIntersectionsEx.svg#diagram=explodeIntersectionsEx&width=300>>
--
--   > explodeIntersectionsEx = onSections (explodeIntersections squares) colorLines
--   >   where
--   >     squares = square 1
--   >            <> square 1 # rotate (1/8 @@ turn)
--   >     colorLines = map (map lc)
--   >       [ [ gray,     red,     orange, yellow,     green,     blue,       indigo,     violet]
--   >       , [black, crimson, darkorange,   gold, darkgreen, darkblue, midnightblue, darkviolet] ]
explodeIntersections :: (OrderedField n, Real n)  => Path V2 n -> [[Located (Trail V2 n)]]
explodeIntersections :: forall n.
(OrderedField n, Real n) =>
Path V2 n -> [[Located (Trail V2 n)]]
explodeIntersections = forall n.
(OrderedField n, Real n) =>
n -> Path V2 n -> [[Located (Trail V2 n)]]
explodeIntersections' forall n. Fractional n => n
defEps

-- | `explodeIntersections` using the given tolerance for calculating intersections.
explodeIntersections' :: (OrderedField n, Real n) => n -> Path V2 n -> [[Located (Trail V2 n)]]
explodeIntersections' :: forall n.
(OrderedField n, Real n) =>
n -> Path V2 n -> [[Located (Trail V2 n)]]
explodeIntersections' n
eps Path V2 n
path = forall n t s.
(OrderedField n, Real n, InSpace V2 n t, SameSpace t s, ToPath t,
 ToPath s) =>
n -> t -> s -> [[Located (Trail V2 n)]]
cutBy' n
eps Path V2 n
path Path V2 n
path

-- | Turn a path into a list of component segments for each component trail,
--   then cut those segments at all their intersections.
--
--   <<diagrams/src_Diagrams_TwoD_Path_IntersectionExtras_explodeBothEx.svg#diagram=explodeBothEx&width=300>>
--
--   > explodeBothEx = onSections (explodeBoth squares) colorLines
--   >   where
--   >     squares = square 1
--   >            <> square 1 # rotate (1/8 @@ turn)
--   >     colorLines = map (map (map lc))
--   >       [ cycle [ [ gray,     red,     orange], [yellow,     green,     blue] ]
--   >       , cycle [ [black, crimson, darkorange], [  gold, darkgreen, darkblue] ] ]
explodeBoth :: (OrderedField n, Real n) => Path V2 n -> [[[Located (Trail V2 n)]]]
explodeBoth :: forall n.
(OrderedField n, Real n) =>
Path V2 n -> [[[Located (Trail V2 n)]]]
explodeBoth = forall n.
(OrderedField n, Real n) =>
n -> Path V2 n -> [[[Located (Trail V2 n)]]]
explodeBoth' forall n. Fractional n => n
defEps

-- | `explodeBoth` using the given tolerance for calculating intersections.
explodeBoth' :: (OrderedField n, Real n) => n -> Path V2 n -> [[[Located (Trail V2 n)]]]
explodeBoth' :: forall n.
(OrderedField n, Real n) =>
n -> Path V2 n -> [[[Located (Trail V2 n)]]]
explodeBoth' n
eps Path V2 n
path = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> b -> a -> c
flip (forall n.
(OrderedField n, Real n) =>
n -> Located (Trail V2 n) -> Path V2 n -> [Located (Trail V2 n)]
cutTBy' n
eps) Path V2 n
path)) forall a b. (a -> b) -> a -> b
$ forall t (v :: * -> *) n.
(V t ~ v, N t ~ n, TrailLike t) =>
Path v n -> [[t]]
explodePath Path V2 n
path

-----------------------------------------------------------------------------
--  Consuming Cut Paths -----------------------------------------------------
-----------------------------------------------------------------------------
class OnSections ps fs b n | ps b -> fs n, fs -> b n where
  -- | Zipply apply an arbitrarily nested list of attributes to the same shape
  --   of lists of pathlike objects, monoidally combining the results.
  --
  --   See examples for `cutBy`, `explodeSegments`, `explodeIntersections`, and `explodeBoth`.
  onSections :: ps -> fs -> QDiagram b V2 n Any

-- Need to list out the instances rather than using overlaping instances
-- with ToPath in order to use the fundep (ps b -> fs).

instance (TypeableFloat n, OnSections ps fs b n) =>
  OnSections [ps] [fs] b n where
  onSections :: [ps] -> [fs] -> QDiagram b V2 n Any
onSections [ps]
ps [fs]
fs = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall ps fs b n.
OnSections ps fs b n =>
ps -> fs -> QDiagram b V2 n Any
onSections [ps]
ps [fs]
fs

instance (TypeableFloat n, Renderable (Path V2 n) b) =>
  OnSections (Path V2 n) (QDiagram b V2 n Any -> QDiagram b V2 n Any) b n where
  onSections :: Path V2 n
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
onSections Path V2 n
ps QDiagram b V2 n Any -> QDiagram b V2 n Any
fs = QDiagram b V2 n Any -> QDiagram b V2 n Any
fs forall a b. (a -> b) -> a -> b
$ forall n t b.
(InSpace V2 n t, ToPath t, TypeableFloat n,
 Renderable (Path V2 n) b) =>
t -> QDiagram b V2 n Any
stroke Path V2 n
ps

instance (TypeableFloat n, Renderable (Path V2 n) b) =>
  OnSections (Located (Trail V2 n)) (QDiagram b V2 n Any -> QDiagram b V2 n Any) b n where
  onSections :: Located (Trail V2 n)
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
onSections Located (Trail V2 n)
ps QDiagram b V2 n Any -> QDiagram b V2 n Any
fs = QDiagram b V2 n Any -> QDiagram b V2 n Any
fs forall a b. (a -> b) -> a -> b
$ forall n t b.
(InSpace V2 n t, ToPath t, TypeableFloat n,
 Renderable (Path V2 n) b) =>
t -> QDiagram b V2 n Any
stroke Located (Trail V2 n)
ps

instance (TypeableFloat n, Renderable (Path V2 n) b) =>
  OnSections (Located (Trail' l V2 n)) (QDiagram b V2 n Any -> QDiagram b V2 n Any) b n where
  onSections :: Located (Trail' l V2 n)
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
onSections Located (Trail' l V2 n)
ps QDiagram b V2 n Any -> QDiagram b V2 n Any
fs = QDiagram b V2 n Any -> QDiagram b V2 n Any
fs forall a b. (a -> b) -> a -> b
$ forall n t b.
(InSpace V2 n t, ToPath t, TypeableFloat n,
 Renderable (Path V2 n) b) =>
t -> QDiagram b V2 n Any
stroke Located (Trail' l V2 n)
ps

instance (TypeableFloat n, Renderable (Path V2 n) b) =>
  OnSections (Located [Segment Closed V2 n]) (QDiagram b V2 n Any -> QDiagram b V2 n Any) b n where
  onSections :: Located [Segment Closed V2 n]
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
onSections Located [Segment Closed V2 n]
ps QDiagram b V2 n Any -> QDiagram b V2 n Any
fs = QDiagram b V2 n Any -> QDiagram b V2 n Any
fs forall a b. (a -> b) -> a -> b
$ forall n t b.
(InSpace V2 n t, ToPath t, TypeableFloat n,
 Renderable (Path V2 n) b) =>
t -> QDiagram b V2 n Any
stroke Located [Segment Closed V2 n]
ps

instance (TypeableFloat n, Renderable (Path V2 n) b) =>
  OnSections (Located (Segment Closed V2 n)) (QDiagram b V2 n Any -> QDiagram b V2 n Any) b n where
  onSections :: Located (Segment Closed V2 n)
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
onSections Located (Segment Closed V2 n)
ps QDiagram b V2 n Any -> QDiagram b V2 n Any
fs = QDiagram b V2 n Any -> QDiagram b V2 n Any
fs forall a b. (a -> b) -> a -> b
$ forall n t b.
(InSpace V2 n t, ToPath t, TypeableFloat n,
 Renderable (Path V2 n) b) =>
t -> QDiagram b V2 n Any
stroke Located (Segment Closed V2 n)
ps

instance (TypeableFloat n, Renderable (Path V2 n) b) =>
  OnSections (Trail V2 n) (QDiagram b V2 n Any -> QDiagram b V2 n Any) b n where
  onSections :: Trail V2 n
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
onSections Trail V2 n
ps QDiagram b V2 n Any -> QDiagram b V2 n Any
fs = QDiagram b V2 n Any -> QDiagram b V2 n Any
fs forall a b. (a -> b) -> a -> b
$ forall n t b.
(InSpace V2 n t, ToPath t, TypeableFloat n,
 Renderable (Path V2 n) b) =>
t -> QDiagram b V2 n Any
stroke Trail V2 n
ps

instance (TypeableFloat n, Renderable (Path V2 n) b) =>
  OnSections (Trail' l V2 n) (QDiagram b V2 n Any -> QDiagram b V2 n Any) b n where
  onSections :: Trail' l V2 n
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
onSections Trail' l V2 n
ps QDiagram b V2 n Any -> QDiagram b V2 n Any
fs = QDiagram b V2 n Any -> QDiagram b V2 n Any
fs forall a b. (a -> b) -> a -> b
$ forall n t b.
(InSpace V2 n t, ToPath t, TypeableFloat n,
 Renderable (Path V2 n) b) =>
t -> QDiagram b V2 n Any
stroke Trail' l V2 n
ps

instance (TypeableFloat n, Renderable (Path V2 n) b) =>
  OnSections (FixedSegment V2 n) (QDiagram b V2 n Any -> QDiagram b V2 n Any) b n where
  onSections :: FixedSegment V2 n
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
onSections FixedSegment V2 n
ps QDiagram b V2 n Any -> QDiagram b V2 n Any
fs = QDiagram b V2 n Any -> QDiagram b V2 n Any
fs forall a b. (a -> b) -> a -> b
$ forall n t b.
(InSpace V2 n t, ToPath t, TypeableFloat n,
 Renderable (Path V2 n) b) =>
t -> QDiagram b V2 n Any
stroke FixedSegment V2 n
ps

instance (TypeableFloat n, Renderable (Path V2 n) b) =>
  OnSections (QDiagram b V2 n Any) (QDiagram b V2 n Any -> QDiagram b V2 n Any) b n where
  onSections :: QDiagram b V2 n Any
-> (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any
onSections QDiagram b V2 n Any
ps QDiagram b V2 n Any -> QDiagram b V2 n Any
fs = QDiagram b V2 n Any -> QDiagram b V2 n Any
fs QDiagram b V2 n Any
ps