{-# 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 = n -> t -> s -> ([[n]], [[n]])
forall n t s.
(InSpace V2 n t, SameSpace t s, ToPath t, ToPath s,
 OrderedField n) =>
n -> t -> s -> ([[n]], [[n]])
intersectParams' n
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 = n -> Path V2 n -> Path V2 n -> ([[n]], [[n]])
forall n.
OrderedField n =>
n -> Path V2 n -> Path V2 n -> ([[n]], [[n]])
intersectParamsP' n
eps (t -> Path (V t) (N t)
forall t.
(ToPath t, Metric (V t), OrderedField (N t)) =>
t -> Path (V t) (N t)
toPath t
as) (s -> Path (V s) (N s)
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 = n -> Path V2 n -> Path V2 n -> ([[n]], [[n]])
forall n.
OrderedField n =>
n -> Path V2 n -> Path V2 n -> ([[n]], [[n]])
intersectParamsP' n
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 = (Located (Trail V2 n) -> [([n], [n])])
-> [Located (Trail V2 n)] -> [[([n], [n])]]
forall a b. (a -> b) -> [a] -> [b]
map (((Located (Trail V2 n) -> ([n], [n]))
 -> [Located (Trail V2 n)] -> [([n], [n])])
-> [Located (Trail V2 n)]
-> (Located (Trail V2 n) -> ([n], [n]))
-> [([n], [n])]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Located (Trail V2 n) -> ([n], [n]))
-> [Located (Trail V2 n)] -> [([n], [n])]
forall a b. (a -> b) -> [a] -> [b]
map (Path V2 n -> [Located (Trail V2 n)]
forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 n
bs) ((Located (Trail V2 n) -> ([n], [n])) -> [([n], [n])])
-> (Located (Trail V2 n) -> Located (Trail V2 n) -> ([n], [n]))
-> Located (Trail V2 n)
-> [([n], [n])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Located (Trail V2 n) -> Located (Trail V2 n) -> ([n], [n])
forall n.
OrderedField n =>
n -> Located (Trail V2 n) -> Located (Trail V2 n) -> ([n], [n])
intersectParamsT' n
eps) (Path V2 n -> [Located (Trail V2 n)]
forall (v :: * -> *) n. Path v n -> [Located (Trail v n)]
pathTrails Path V2 n
as)
    ps :: [[n]]
ps = ([([n], [n])] -> [n]) -> [[([n], [n])]] -> [[n]]
forall a b. (a -> b) -> [a] -> [b]
map ([[n]] -> [n]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[n]] -> [n]) -> ([([n], [n])] -> [[n]]) -> [([n], [n])] -> [n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([n], [n]) -> [n]) -> [([n], [n])] -> [[n]]
forall a b. (a -> b) -> [a] -> [b]
map ([n], [n]) -> [n]
forall a b. (a, b) -> a
fst) [[([n], [n])]]
is
    qs :: [[n]]
qs = ([([n], [n])] -> [n]) -> [[([n], [n])]] -> [[n]]
forall a b. (a -> b) -> [a] -> [b]
map ([[n]] -> [n]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[n]] -> [n]) -> ([([n], [n])] -> [[n]]) -> [([n], [n])] -> [n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([n], [n]) -> [n]) -> [([n], [n])] -> [[n]]
forall a b. (a -> b) -> [a] -> [b]
map ([n], [n]) -> [n]
forall a b. (a, b) -> b
snd) ([[([n], [n])]] -> [[([n], [n])]]
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 = n -> Located (Trail V2 n) -> Located (Trail V2 n) -> ([n], [n])
forall n.
OrderedField n =>
n -> Located (Trail V2 n) -> Located (Trail V2 n) -> ([n], [n])
intersectParamsT' n
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 = ([[n]] -> [n]
forall {a}. Fractional a => [[a]] -> [a]
reparam [[n]]
ps, [[n]] -> [n]
forall {a}. Fractional a => [[a]] -> [a]
reparam [[n]]
qs)
  where
    ([[n]]
ps, [[n]]
qs) = n -> Located (Trail V2 n) -> Located (Trail V2 n) -> ([[n]], [[n]])
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 = [[a]] -> [a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[a]] -> [a]) -> [[a]] -> [a]
forall a b. (a -> b) -> a -> b
$ (Int -> [a] -> [a]) -> [Int] -> [[a]] -> [[a]]
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 = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> a) -> [a] -> [a]) -> (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ \a
p -> (Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
segNo a -> a -> a
forall a. Num a => a -> a -> a
+ a
p) a -> a -> a
forall a. Fractional a => a -> 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 = n -> Located (Trail V2 n) -> Located (Trail V2 n) -> ([[n]], [[n]])
forall n.
OrderedField n =>
n -> Located (Trail V2 n) -> Located (Trail V2 n) -> ([[n]], [[n]])
intersectParamsTS' n
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) (Located (Trail V2 n), Located (Trail V2 n))
-> ((Located (Trail V2 n), Located (Trail V2 n))
    -> ([(Int, FixedSegment V2 n)], [(Int, FixedSegment V2 n)]))
-> ([(Int, FixedSegment V2 n)], [(Int, FixedSegment V2 n)])
forall a b. a -> (a -> b) -> b
& (Located (Trail V2 n) -> Identity [(Int, FixedSegment V2 n)])
-> (Located (Trail V2 n), Located (Trail V2 n))
-> Identity
     ([(Int, FixedSegment V2 n)], [(Int, FixedSegment V2 n)])
Traversal
  (Located (Trail V2 n), Located (Trail V2 n))
  ([(Int, FixedSegment V2 n)], [(Int, FixedSegment V2 n)])
  (Located (Trail V2 n))
  [(Int, FixedSegment V2 n)]
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both ((Located (Trail V2 n) -> Identity [(Int, FixedSegment V2 n)])
 -> (Located (Trail V2 n), Located (Trail V2 n))
 -> Identity
      ([(Int, FixedSegment V2 n)], [(Int, FixedSegment V2 n)]))
-> (Located (Trail V2 n) -> [(Int, FixedSegment V2 n)])
-> (Located (Trail V2 n), Located (Trail V2 n))
-> ([(Int, FixedSegment V2 n)], [(Int, FixedSegment V2 n)])
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Int] -> [FixedSegment V2 n] -> [(Int, FixedSegment V2 n)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([FixedSegment V2 n] -> [(Int, FixedSegment V2 n)])
-> (Located (Trail V2 n) -> [FixedSegment V2 n])
-> Located (Trail V2 n)
-> [(Int, FixedSegment V2 n)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (Trail V2 n) -> [FixedSegment V2 n]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> [FixedSegment v n]
fixTrail)
    is :: [[[(n, n)]]]
is = ((Int, FixedSegment V2 n) -> [[(n, n)]])
-> [(Int, FixedSegment V2 n)] -> [[[(n, n)]]]
forall a b. (a -> b) -> [a] -> [b]
map ((((Int, FixedSegment V2 n) -> [(n, n)])
 -> [(Int, FixedSegment V2 n)] -> [[(n, n)]])
-> [(Int, FixedSegment V2 n)]
-> ((Int, FixedSegment V2 n) -> [(n, n)])
-> [[(n, n)]]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Int, FixedSegment V2 n) -> [(n, n)])
-> [(Int, FixedSegment V2 n)] -> [[(n, n)]]
forall a b. (a -> b) -> [a] -> [b]
map [(Int, FixedSegment V2 n)]
bs' (((Int, FixedSegment V2 n) -> [(n, n)]) -> [[(n, n)]])
-> ((Int, FixedSegment V2 n)
    -> (Int, FixedSegment V2 n) -> [(n, n)])
-> (Int, FixedSegment V2 n)
-> [[(n, n)]]
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 FixedSegment V2 n -> FixedSegment V2 n -> Bool
forall a. Eq a => a -> a -> Bool
== FixedSegment V2 n
b    = []
      | Bool
otherwise = ((n, n) -> Bool) -> [(n, n)] -> [(n, n)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ((n, n) -> Bool) -> (n, n) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n, n) -> Bool
ends)
                  ([(n, n)] -> [(n, n)])
-> ([(n, n, P2 n)] -> [(n, n)]) -> [(n, n, P2 n)] -> [(n, n)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((n, n, P2 n) -> (n, n)) -> [(n, n, P2 n)] -> [(n, n)]
forall a b. (a -> b) -> [a] -> [b]
map (\(n
p, n
q, P2 n
_) -> (n
p, n
q))
                  ([(n, n, P2 n)] -> [(n, n)]) -> [(n, n, P2 n)] -> [(n, n)]
forall a b. (a -> b) -> a -> b
$ n -> FixedSegment V2 n -> FixedSegment V2 n -> [(n, n, P2 n)]
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
&& n -> n -> n
forall a. Ord a => a -> a -> a
min n
p n
q n -> n -> Bool
`near` n
0 Bool -> Bool -> Bool
&& n -> n -> n
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 Located (Trail V2 n) -> Located (Trail V2 n) -> Bool
forall a. Eq a => a -> a -> Bool
== Located (Trail V2 n)
bs Bool -> Bool -> Bool
&& (Int -> Int
forall a. Num a => a -> a
abs (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
j) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
i Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
i Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [(Int, FixedSegment V2 n)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, FixedSegment V2 n)]
as' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        near :: n -> n -> Bool
near n
x n
n = n -> n
forall a. Num a => a -> a
abs (n
x n -> n -> n
forall a. Num a => a -> a -> a
- n
n) n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
eps
    ps :: [[n]]
ps = ([[(n, n)]] -> [n]) -> [[[(n, n)]]] -> [[n]]
forall a b. (a -> b) -> [a] -> [b]
map (((n, n) -> n) -> [(n, n)] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map (n, n) -> n
forall a b. (a, b) -> a
fst ([(n, n)] -> [n]) -> ([[(n, n)]] -> [(n, n)]) -> [[(n, n)]] -> [n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(n, n)]] -> [(n, n)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) [[[(n, n)]]]
is
    qs :: [[n]]
qs = ([[(n, n)]] -> [n]) -> [[[(n, n)]]] -> [[n]]
forall a b. (a -> b) -> [a] -> [b]
map (((n, n) -> n) -> [(n, n)] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map (n, n) -> n
forall a b. (a, b) -> b
snd ([(n, n)] -> [n]) -> ([[(n, n)]] -> [(n, n)]) -> [[(n, n)]] -> [n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(n, n)]] -> [(n, n)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat) ([[[(n, n)]]] -> [[[(n, n)]]]
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 = n -> t -> s -> [[Located (Trail V2 n)]]
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
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 = n -> Path V2 n -> Path V2 n -> [[Located (Trail V2 n)]]
forall n.
(OrderedField n, Real n) =>
n -> Path V2 n -> Path V2 n -> [[Located (Trail V2 n)]]
cutPBy' n
eps (t -> Path (V t) (N t)
forall t.
(ToPath t, Metric (V t), OrderedField (N t)) =>
t -> Path (V t) (N t)
toPath t
a) (s -> Path (V s) (N s)
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 = n -> Path V2 n -> Path V2 n -> [[Located (Trail V2 n)]]
forall n.
(OrderedField n, Real n) =>
n -> Path V2 n -> Path V2 n -> [[Located (Trail V2 n)]]
cutPBy' n
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 = (Located (Trail V2 n) -> [Located (Trail V2 n)])
-> [Located (Trail V2 n)] -> [[Located (Trail V2 n)]]
forall a b. (a -> b) -> [a] -> [b]
map ((Located (Trail V2 n) -> Path V2 n -> [Located (Trail V2 n)])
-> Path V2 n -> Located (Trail V2 n) -> [Located (Trail V2 n)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (n -> Located (Trail V2 n) -> Path V2 n -> [Located (Trail V2 n)]
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) (Path V2 n -> [Located (Trail V2 n)]
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 = n -> Located (Trail V2 n) -> Path V2 n -> [Located (Trail V2 n)]
forall n.
(OrderedField n, Real n) =>
n -> Located (Trail V2 n) -> Path V2 n -> [Located (Trail V2 n)]
cutTBy' n
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
  | [n] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [n]
isects                                 = [Located (Trail V2 n)
t]
  | [n] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [n]
nearEnds Bool -> Bool -> Bool
&& Diff (Point V2) n -> n
forall a. Floating a => Diff (Point V2) a -> a
forall (f :: * -> *) a. (Metric f, Floating a) => f a -> a
norm (Point V2 n
Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
start Point V2 n -> Point V2 n -> Diff (Point V2) n
forall a. Num a => Point V2 a -> Point V2 a -> Diff (Point V2) a
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point V2 n
Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
end) n -> n -> Bool
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 = (n -> n -> Located (Trail V2 n))
-> [n] -> [n] -> [Located (Trail V2 n)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Located (Trail V2 n)
-> N (Located (Trail V2 n))
-> N (Located (Trail V2 n))
-> Located (Trail V2 n)
forall p. Sectionable p => p -> N p -> N p -> p
section Located (Trail V2 n)
t) (n
0n -> [n] -> [n]
forall a. a -> [a] -> [a]
:[n]
isects) ([n]
isects[n] -> [n] -> [n]
forall a. [a] -> [a] -> [a]
++[n
1])
    isects :: [n]
isects = [n] -> [n]
sortAndAvoidEmpty [n]
notNearEnds
    sortAndAvoidEmpty :: [n] -> [n]
sortAndAvoidEmpty = ([n] -> n) -> [[n]] -> [n]
forall a b. (a -> b) -> [a] -> [b]
map [n] -> n
forall a. HasCallStack => [a] -> a
head ([[n]] -> [n]) -> ([n] -> [[n]]) -> [n] -> [n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n -> n -> Bool) -> [n] -> [[n]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\n
a n
b -> n -> n
forall a. Num a => a -> a
abs (n
a n -> n -> n
forall a. Num a => a -> a -> a
- n
b) n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
eps) ([n] -> [[n]]) -> ([n] -> [n]) -> [n] -> [[n]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [n] -> [n]
forall a. Ord a => [a] -> [a]
sort
    ([n]
notNearEnds, [n]
nearEnds) = (n -> Bool) -> [n] -> ([n], [n])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\n
p -> (n
eps n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
p) Bool -> Bool -> Bool
&& (n
p n -> n -> Bool
forall a. Ord a => a -> a -> Bool
< n
1n -> n -> n
forall a. Num a => a -> a -> a
-n
eps)) [n]
rawIsects
    rawIsects :: [n]
rawIsects = (Located (Trail V2 n) -> [n]) -> [Located (Trail V2 n)] -> [n]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (([n], [n]) -> [n]
forall a b. (a, b) -> a
fst (([n], [n]) -> [n])
-> (Located (Trail V2 n) -> ([n], [n]))
-> Located (Trail V2 n)
-> [n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Located (Trail V2 n) -> Located (Trail V2 n) -> ([n], [n])
forall n.
OrderedField n =>
n -> Located (Trail V2 n) -> Located (Trail V2 n) -> ([n], [n])
intersectParamsT' n
eps Located (Trail V2 n)
t) (Path V2 n -> [Located (Trail V2 n)]
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 = [Located (Trail V2 n)] -> Located (Trail V2 n)
forall a. HasCallStack => [a] -> a
head [Located (Trail V2 n)]
subsections Located (Trail V2 n)
-> N (Located (Trail V2 n))
-> Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
forall p. Parametric p => p -> N p -> Codomain p (N p)
`atParam` n
N (Located (Trail V2 n))
0
    end :: Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
end   = [Located (Trail V2 n)] -> Located (Trail V2 n)
forall a. HasCallStack => [a] -> a
last [Located (Trail V2 n)]
subsections Located (Trail V2 n)
-> N (Located (Trail V2 n))
-> Codomain (Located (Trail V2 n)) (N (Located (Trail V2 n)))
forall p. Parametric p => p -> N p -> Codomain p (N p)
`atParam` n
N (Located (Trail V2 n))
1
    gluedEnds :: [Located (Trail V2 n)]
gluedEnds = [FixedSegment V2 n] -> Located (Trail V2 n)
forall (v :: * -> *) n.
(Metric v, Ord n, Floating n) =>
[FixedSegment v n] -> Located (Trail v n)
unfixTrail (Located (Trail V2 n) -> [FixedSegment V2 n]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> [FixedSegment v n]
fixTrail ([Located (Trail V2 n)] -> Located (Trail V2 n)
forall a. HasCallStack => [a] -> a
last [Located (Trail V2 n)]
subsections) [FixedSegment V2 n] -> [FixedSegment V2 n] -> [FixedSegment V2 n]
forall a. [a] -> [a] -> [a]
++ Located (Trail V2 n) -> [FixedSegment V2 n]
forall (v :: * -> *) n.
(Metric v, OrderedField n) =>
Located (Trail v n) -> [FixedSegment v n]
fixTrail ([Located (Trail V2 n)] -> Located (Trail V2 n)
forall a. HasCallStack => [a] -> a
head [Located (Trail V2 n)]
subsections))
              Located (Trail V2 n)
-> [Located (Trail V2 n)] -> [Located (Trail V2 n)]
forall a. a -> [a] -> [a]
: [Located (Trail V2 n)] -> [Located (Trail V2 n)]
forall a. HasCallStack => [a] -> [a]
init ([Located (Trail V2 n)] -> [Located (Trail V2 n)]
forall a. HasCallStack => [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 = Path v n -> [[Located (Trail v n)]]
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 = n -> Path V2 n -> [[Located (Trail V2 n)]]
forall n.
(OrderedField n, Real n) =>
n -> Path V2 n -> [[Located (Trail V2 n)]]
explodeIntersections' n
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 = n -> Path V2 n -> Path V2 n -> [[Located (Trail V2 n)]]
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 = n -> Path V2 n -> [[[Located (Trail V2 n)]]]
forall n.
(OrderedField n, Real n) =>
n -> Path V2 n -> [[[Located (Trail V2 n)]]]
explodeBoth' n
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 = ([Located (Trail V2 n)] -> [[Located (Trail V2 n)]])
-> [[Located (Trail V2 n)]] -> [[[Located (Trail V2 n)]]]
forall a b. (a -> b) -> [a] -> [b]
map ((Located (Trail V2 n) -> [Located (Trail V2 n)])
-> [Located (Trail V2 n)] -> [[Located (Trail V2 n)]]
forall a b. (a -> b) -> [a] -> [b]
map ((Located (Trail V2 n) -> Path V2 n -> [Located (Trail V2 n)])
-> Path V2 n -> Located (Trail V2 n) -> [Located (Trail V2 n)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (n -> Located (Trail V2 n) -> Path V2 n -> [Located (Trail V2 n)]
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)) ([[Located (Trail V2 n)]] -> [[[Located (Trail V2 n)]]])
-> [[Located (Trail V2 n)]] -> [[[Located (Trail V2 n)]]]
forall a b. (a -> b) -> a -> b
$ Path V2 n -> [[Located (Trail V2 n)]]
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 = [QDiagram b V2 n Any] -> QDiagram b V2 n Any
forall a. Monoid a => [a] -> a
mconcat ([QDiagram b V2 n Any] -> QDiagram b V2 n Any)
-> [QDiagram b V2 n Any] -> QDiagram b V2 n Any
forall a b. (a -> b) -> a -> b
$ (ps -> fs -> QDiagram b V2 n Any)
-> [ps] -> [fs] -> [QDiagram b V2 n Any]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ps -> fs -> QDiagram b V2 n Any
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 (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a b. (a -> b) -> a -> b
$ Path V2 n -> QDiagram b V2 n Any
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 (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a b. (a -> b) -> a -> b
$ Located (Trail V2 n) -> QDiagram b V2 n Any
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 (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a b. (a -> b) -> a -> b
$ Located (Trail' l V2 n) -> QDiagram b V2 n Any
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 (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a b. (a -> b) -> a -> b
$ Located [Segment Closed V2 n] -> QDiagram b V2 n Any
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 (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a b. (a -> b) -> a -> b
$ Located (Segment Closed V2 n) -> QDiagram b V2 n Any
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 (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a b. (a -> b) -> a -> b
$ Trail V2 n -> QDiagram b V2 n Any
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 (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a b. (a -> b) -> a -> b
$ Trail' l V2 n -> QDiagram b V2 n Any
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 (QDiagram b V2 n Any -> QDiagram b V2 n Any)
-> QDiagram b V2 n Any -> QDiagram b V2 n Any
forall a b. (a -> b) -> a -> b
$ FixedSegment V2 n -> QDiagram b V2 n Any
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