{-# Language ScopedTypeVariables #-}
{-# Language TemplateHaskell #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.Slab
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--------------------------------------------------------------------------------
module Data.Geometry.Slab where

import           Control.Lens (makeLenses, (^.),(%~),(.~),(&), both, from)
import           Data.Bifunctor
import           Data.Ext
import qualified Data.Foldable as F
import           Data.Geometry.Box.Internal
import           Data.Geometry.Interval
import           Data.Geometry.Line
import           Data.Geometry.LineSegment
import           Data.Geometry.Point
import           Data.Geometry.Properties
import           Data.Geometry.SubLine
import qualified Data.Traversable as T
import           Data.Vinyl
import           Data.Vinyl.CoRec

--------------------------------------------------------------------------------

data Orthogonal = Horizontal | Vertical
                deriving (Int -> Orthogonal -> ShowS
[Orthogonal] -> ShowS
Orthogonal -> String
(Int -> Orthogonal -> ShowS)
-> (Orthogonal -> String)
-> ([Orthogonal] -> ShowS)
-> Show Orthogonal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Orthogonal] -> ShowS
$cshowList :: [Orthogonal] -> ShowS
show :: Orthogonal -> String
$cshow :: Orthogonal -> String
showsPrec :: Int -> Orthogonal -> ShowS
$cshowsPrec :: Int -> Orthogonal -> ShowS
Show,Orthogonal -> Orthogonal -> Bool
(Orthogonal -> Orthogonal -> Bool)
-> (Orthogonal -> Orthogonal -> Bool) -> Eq Orthogonal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Orthogonal -> Orthogonal -> Bool
$c/= :: Orthogonal -> Orthogonal -> Bool
== :: Orthogonal -> Orthogonal -> Bool
$c== :: Orthogonal -> Orthogonal -> Bool
Eq,ReadPrec [Orthogonal]
ReadPrec Orthogonal
Int -> ReadS Orthogonal
ReadS [Orthogonal]
(Int -> ReadS Orthogonal)
-> ReadS [Orthogonal]
-> ReadPrec Orthogonal
-> ReadPrec [Orthogonal]
-> Read Orthogonal
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Orthogonal]
$creadListPrec :: ReadPrec [Orthogonal]
readPrec :: ReadPrec Orthogonal
$creadPrec :: ReadPrec Orthogonal
readList :: ReadS [Orthogonal]
$creadList :: ReadS [Orthogonal]
readsPrec :: Int -> ReadS Orthogonal
$creadsPrec :: Int -> ReadS Orthogonal
Read)



newtype Slab (o :: Orthogonal) a r = Slab { Slab o a r -> Interval a r
_unSlab :: Interval a r }
                                     deriving (Int -> Slab o a r -> ShowS
[Slab o a r] -> ShowS
Slab o a r -> String
(Int -> Slab o a r -> ShowS)
-> (Slab o a r -> String)
-> ([Slab o a r] -> ShowS)
-> Show (Slab o a r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (o :: Orthogonal) a r.
(Show a, Show r) =>
Int -> Slab o a r -> ShowS
forall (o :: Orthogonal) a r.
(Show a, Show r) =>
[Slab o a r] -> ShowS
forall (o :: Orthogonal) a r.
(Show a, Show r) =>
Slab o a r -> String
showList :: [Slab o a r] -> ShowS
$cshowList :: forall (o :: Orthogonal) a r.
(Show a, Show r) =>
[Slab o a r] -> ShowS
show :: Slab o a r -> String
$cshow :: forall (o :: Orthogonal) a r.
(Show a, Show r) =>
Slab o a r -> String
showsPrec :: Int -> Slab o a r -> ShowS
$cshowsPrec :: forall (o :: Orthogonal) a r.
(Show a, Show r) =>
Int -> Slab o a r -> ShowS
Show,Slab o a r -> Slab o a r -> Bool
(Slab o a r -> Slab o a r -> Bool)
-> (Slab o a r -> Slab o a r -> Bool) -> Eq (Slab o a r)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (o :: Orthogonal) a r.
(Eq r, Eq a) =>
Slab o a r -> Slab o a r -> Bool
/= :: Slab o a r -> Slab o a r -> Bool
$c/= :: forall (o :: Orthogonal) a r.
(Eq r, Eq a) =>
Slab o a r -> Slab o a r -> Bool
== :: Slab o a r -> Slab o a r -> Bool
$c== :: forall (o :: Orthogonal) a r.
(Eq r, Eq a) =>
Slab o a r -> Slab o a r -> Bool
Eq)
makeLenses ''Slab

-- | Smart consturctor for creating a horizontal slab
horizontalSlab     :: (r :+ a) -> (r :+ a) -> Slab Horizontal a r
horizontalSlab :: (r :+ a) -> (r :+ a) -> Slab 'Horizontal a r
horizontalSlab r :+ a
l r :+ a
h = Interval a r -> Slab 'Horizontal a r
forall (o :: Orthogonal) a r. Interval a r -> Slab o a r
Slab (Interval a r -> Slab 'Horizontal a r)
-> Interval a r -> Slab 'Horizontal a r
forall a b. (a -> b) -> a -> b
$ (r :+ a) -> (r :+ a) -> Interval a r
forall r a. (r :+ a) -> (r :+ a) -> Interval a r
ClosedInterval r :+ a
l r :+ a
h

-- | Smart consturctor for creating a vertical slab
verticalSlab :: (r :+ a) -> (r :+ a) -> Slab Vertical a r
verticalSlab :: (r :+ a) -> (r :+ a) -> Slab 'Vertical a r
verticalSlab r :+ a
l r :+ a
r = Interval a r -> Slab 'Vertical a r
forall (o :: Orthogonal) a r. Interval a r -> Slab o a r
Slab (Interval a r -> Slab 'Vertical a r)
-> Interval a r -> Slab 'Vertical a r
forall a b. (a -> b) -> a -> b
$ (r :+ a) -> (r :+ a) -> Interval a r
forall r a. (r :+ a) -> (r :+ a) -> Interval a r
ClosedInterval r :+ a
l r :+ a
r

instance Functor (Slab o a) where
  fmap :: (a -> b) -> Slab o a a -> Slab o a b
fmap = (a -> b) -> Slab o a a -> Slab o a b
forall (t :: * -> *) a b. Traversable t => (a -> b) -> t a -> t b
T.fmapDefault

instance F.Foldable (Slab o a) where
  foldMap :: (a -> m) -> Slab o a a -> m
foldMap = (a -> m) -> Slab o a a -> m
forall (t :: * -> *) m a.
(Traversable t, Monoid m) =>
(a -> m) -> t a -> m
T.foldMapDefault

instance T.Traversable (Slab o a) where
  traverse :: (a -> f b) -> Slab o a a -> f (Slab o a b)
traverse a -> f b
f (Slab Interval a a
i) = Interval a b -> Slab o a b
forall (o :: Orthogonal) a r. Interval a r -> Slab o a r
Slab (Interval a b -> Slab o a b) -> f (Interval a b) -> f (Slab o a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Interval a a -> f (Interval a b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
T.traverse a -> f b
f Interval a a
i


instance Bifunctor (Slab o) where
  bimap :: (a -> b) -> (c -> d) -> Slab o a c -> Slab o b d
bimap a -> b
f c -> d
g (Slab Interval a c
i) = Interval b d -> Slab o b d
forall (o :: Orthogonal) a r. Interval a r -> Slab o a r
Slab (Interval b d -> Slab o b d) -> Interval b d -> Slab o b d
forall a b. (a -> b) -> a -> b
$ (a -> b) -> (c -> d) -> Interval a c -> Interval b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g Interval a c
i


type instance IntersectionOf (Slab o a r)          (Slab o a r) =
  [NoIntersection, Slab o a r]
type instance IntersectionOf (Slab Horizontal a r) (Slab Vertical a r) =
  '[Rectangle (a,a) r]


instance Ord r => Slab o a r `IsIntersectableWith` Slab o a r where
  nonEmptyIntersection :: proxy (Slab o a r)
-> proxy (Slab o a r)
-> Intersection (Slab o a r) (Slab o a r)
-> Bool
nonEmptyIntersection = proxy (Slab o a r)
-> proxy (Slab o a r)
-> Intersection (Slab o a r) (Slab o a r)
-> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
 RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection

  (Slab Interval a r
i) intersect :: Slab o a r -> Slab o a r -> Intersection (Slab o a r) (Slab o a r)
`intersect` (Slab Interval a r
i') = CoRec Identity '[NoIntersection, Interval a r]
-> Handlers
     '[NoIntersection, Interval a r]
     (CoRec Identity '[NoIntersection, Slab o a r])
-> CoRec Identity '[NoIntersection, Slab o a r]
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match (Interval a r
i Interval a r
-> Interval a r -> Intersection (Interval a r) (Interval a r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Interval a r
i') (Handlers
   '[NoIntersection, Interval a r]
   (CoRec Identity '[NoIntersection, Slab o a r])
 -> CoRec Identity '[NoIntersection, Slab o a r])
-> Handlers
     '[NoIntersection, Interval a r]
     (CoRec Identity '[NoIntersection, Slab o a r])
-> CoRec Identity '[NoIntersection, Slab o a r]
forall a b. (a -> b) -> a -> b
$
        (NoIntersection -> CoRec Identity '[NoIntersection, Slab o a r])
-> Handler
     (CoRec Identity '[NoIntersection, Slab o a r]) NoIntersection
forall b a. (a -> b) -> Handler b a
H (\NoIntersection
NoIntersection -> NoIntersection -> CoRec Identity '[NoIntersection, Slab o a r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection)
     Handler
  (CoRec Identity '[NoIntersection, Slab o a r]) NoIntersection
-> Rec
     (Handler (CoRec Identity '[NoIntersection, Slab o a r]))
     '[Interval a r]
-> Handlers
     '[NoIntersection, Interval a r]
     (CoRec Identity '[NoIntersection, Slab o a r])
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Interval a r -> CoRec Identity '[NoIntersection, Slab o a r])
-> Handler
     (CoRec Identity '[NoIntersection, Slab o a r]) (Interval a r)
forall b a. (a -> b) -> Handler b a
H (\Interval a r
i''            -> Slab o a r -> CoRec Identity '[NoIntersection, Slab o a r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (Interval a r -> Slab o a r
forall (o :: Orthogonal) a r. Interval a r -> Slab o a r
Slab Interval a r
i'' :: Slab o a r))
     Handler
  (CoRec Identity '[NoIntersection, Slab o a r]) (Interval a r)
-> Rec (Handler (CoRec Identity '[NoIntersection, Slab o a r])) '[]
-> Rec
     (Handler (CoRec Identity '[NoIntersection, Slab o a r]))
     '[Interval a r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Handler (CoRec Identity '[NoIntersection, Slab o a r])) '[]
forall u (a :: u -> *). Rec a '[]
RNil

instance Slab Horizontal a r `IsIntersectableWith` Slab Vertical a r where
  nonEmptyIntersection :: proxy (Slab 'Horizontal a r)
-> proxy (Slab 'Vertical a r)
-> Intersection (Slab 'Horizontal a r) (Slab 'Vertical a r)
-> Bool
nonEmptyIntersection proxy (Slab 'Horizontal a r)
_ proxy (Slab 'Vertical a r)
_ Intersection (Slab 'Horizontal a r) (Slab 'Vertical a r)
_ = Bool
True

  (Slab Interval a r
h) intersect :: Slab 'Horizontal a r
-> Slab 'Vertical a r
-> Intersection (Slab 'Horizontal a r) (Slab 'Vertical a r)
`intersect` (Slab Interval a r
v) = Box 2 (a, a) r -> CoRec Identity '[Box 2 (a, a) r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (Box 2 (a, a) r -> CoRec Identity '[Box 2 (a, a) r])
-> Box 2 (a, a) r -> CoRec Identity '[Box 2 (a, a) r]
forall a b. (a -> b) -> a -> b
$ (Point 2 r :+ (a, a)) -> (Point 2 r :+ (a, a)) -> Box 2 (a, a) r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> Box d p r
box Point 2 r :+ (a, a)
low Point 2 r :+ (a, a)
high
    where
      low :: Point 2 r :+ (a, a)
low  = r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 (Interval a r
vInterval a r -> Getting r (Interval a r) r -> r
forall s a. s -> Getting a s a -> a
^.((r :+ a) -> Const r (r :+ a))
-> Interval a r -> Const r (Interval a r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((r :+ a) -> Const r (r :+ a))
 -> Interval a r -> Const r (Interval a r))
-> ((r -> Const r r) -> (r :+ a) -> Const r (r :+ a))
-> Getting r (Interval a r) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> (r :+ a) -> Const r (r :+ a)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (Interval a r
hInterval a r -> Getting r (Interval a r) r -> r
forall s a. s -> Getting a s a -> a
^.((r :+ a) -> Const r (r :+ a))
-> Interval a r -> Const r (Interval a r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((r :+ a) -> Const r (r :+ a))
 -> Interval a r -> Const r (Interval a r))
-> ((r -> Const r r) -> (r :+ a) -> Const r (r :+ a))
-> Getting r (Interval a r) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> (r :+ a) -> Const r (r :+ a)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) Point 2 r -> (a, a) -> Point 2 r :+ (a, a)
forall core extra. core -> extra -> core :+ extra
:+ (Interval a r
vInterval a r -> Getting a (Interval a r) a -> a
forall s a. s -> Getting a s a -> a
^.((r :+ a) -> Const a (r :+ a))
-> Interval a r -> Const a (Interval a r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((r :+ a) -> Const a (r :+ a))
 -> Interval a r -> Const a (Interval a r))
-> ((a -> Const a a) -> (r :+ a) -> Const a (r :+ a))
-> Getting a (Interval a r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a -> Const a a) -> (r :+ a) -> Const a (r :+ a)
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra, Interval a r
hInterval a r -> Getting a (Interval a r) a -> a
forall s a. s -> Getting a s a -> a
^.((r :+ a) -> Const a (r :+ a))
-> Interval a r -> Const a (Interval a r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((r :+ a) -> Const a (r :+ a))
 -> Interval a r -> Const a (Interval a r))
-> ((a -> Const a a) -> (r :+ a) -> Const a (r :+ a))
-> Getting a (Interval a r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a -> Const a a) -> (r :+ a) -> Const a (r :+ a)
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra)
      high :: Point 2 r :+ (a, a)
high = r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 (Interval a r
vInterval a r -> Getting r (Interval a r) r -> r
forall s a. s -> Getting a s a -> a
^.((r :+ a) -> Const r (r :+ a))
-> Interval a r -> Const r (Interval a r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((r :+ a) -> Const r (r :+ a))
 -> Interval a r -> Const r (Interval a r))
-> ((r -> Const r r) -> (r :+ a) -> Const r (r :+ a))
-> Getting r (Interval a r) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> (r :+ a) -> Const r (r :+ a)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)   (Interval a r
hInterval a r -> Getting r (Interval a r) r -> r
forall s a. s -> Getting a s a -> a
^.((r :+ a) -> Const r (r :+ a))
-> Interval a r -> Const r (Interval a r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((r :+ a) -> Const r (r :+ a))
 -> Interval a r -> Const r (Interval a r))
-> ((r -> Const r r) -> (r :+ a) -> Const r (r :+ a))
-> Getting r (Interval a r) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> (r :+ a) -> Const r (r :+ a)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)   Point 2 r -> (a, a) -> Point 2 r :+ (a, a)
forall core extra. core -> extra -> core :+ extra
:+ (Interval a r
vInterval a r -> Getting a (Interval a r) a -> a
forall s a. s -> Getting a s a -> a
^.((r :+ a) -> Const a (r :+ a))
-> Interval a r -> Const a (Interval a r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((r :+ a) -> Const a (r :+ a))
 -> Interval a r -> Const a (Interval a r))
-> ((a -> Const a a) -> (r :+ a) -> Const a (r :+ a))
-> Getting a (Interval a r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a -> Const a a) -> (r :+ a) -> Const a (r :+ a)
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra,   Interval a r
hInterval a r -> Getting a (Interval a r) a -> a
forall s a. s -> Getting a s a -> a
^.((r :+ a) -> Const a (r :+ a))
-> Interval a r -> Const a (Interval a r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((r :+ a) -> Const a (r :+ a))
 -> Interval a r -> Const a (Interval a r))
-> ((a -> Const a a) -> (r :+ a) -> Const a (r :+ a))
-> Getting a (Interval a r) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(a -> Const a a) -> (r :+ a) -> Const a (r :+ a)
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra)



class HasBoundingLines (o :: Orthogonal) where
  -- | The two bounding lines of the slab, first the lower one, then the higher one:
  --
  boundingLines :: Num r => Slab o a r -> (Line 2 r :+ a, Line 2 r :+ a)

  inSlab :: Ord r => Point 2 r -> Slab o a r -> Bool


instance HasBoundingLines Horizontal where
  boundingLines :: Slab 'Horizontal a r -> (Line 2 r :+ a, Line 2 r :+ a)
boundingLines (Slab Interval a r
i) = (Interval a r
iInterval a r -> Getting (r :+ a) (Interval a r) (r :+ a) -> r :+ a
forall s a. s -> Getting a s a -> a
^.Getting (r :+ a) (Interval a r) (r :+ a)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start, Interval a r
iInterval a r -> Getting (r :+ a) (Interval a r) (r :+ a) -> r :+ a
forall s a. s -> Getting a s a -> a
^.Getting (r :+ a) (Interval a r) (r :+ a)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end)(r :+ a, r :+ a)
-> ((r :+ a, r :+ a) -> (Line 2 r :+ a, Line 2 r :+ a))
-> (Line 2 r :+ a, Line 2 r :+ a)
forall a b. a -> (a -> b) -> b
&((r :+ a) -> Identity (Line 2 r :+ a))
-> (r :+ a, r :+ a) -> Identity (Line 2 r :+ a, Line 2 r :+ a)
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both(((r :+ a) -> Identity (Line 2 r :+ a))
 -> (r :+ a, r :+ a) -> Identity (Line 2 r :+ a, Line 2 r :+ a))
-> ((r -> Identity (Line 2 r))
    -> (r :+ a) -> Identity (Line 2 r :+ a))
-> (r -> Identity (Line 2 r))
-> (r :+ a, r :+ a)
-> Identity (Line 2 r :+ a, Line 2 r :+ a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Identity (Line 2 r)) -> (r :+ a) -> Identity (Line 2 r :+ a)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((r -> Identity (Line 2 r))
 -> (r :+ a, r :+ a) -> Identity (Line 2 r :+ a, Line 2 r :+ a))
-> (r -> Line 2 r)
-> (r :+ a, r :+ a)
-> (Line 2 r :+ a, Line 2 r :+ a)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ r -> Line 2 r
forall r. Num r => r -> Line 2 r
horizontalLine

  Point 2 r
p inSlab :: Point 2 r -> Slab 'Horizontal a r -> Bool
`inSlab` (Slab Interval a r
i) = (Point 2 r
pPoint 2 r -> Getting r (Point 2 r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Point 2 r) r
forall (d :: Nat) (point :: Nat -> * -> *) r.
(2 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
yCoord) r -> Interval a r -> Bool
forall r a. Ord r => r -> Interval a r -> Bool
`inInterval` Interval a r
i


instance HasBoundingLines Vertical where
  boundingLines :: Slab 'Vertical a r -> (Line 2 r :+ a, Line 2 r :+ a)
boundingLines (Slab Interval a r
i) = (Interval a r
iInterval a r -> Getting (r :+ a) (Interval a r) (r :+ a) -> r :+ a
forall s a. s -> Getting a s a -> a
^.Getting (r :+ a) (Interval a r) (r :+ a)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start, Interval a r
iInterval a r -> Getting (r :+ a) (Interval a r) (r :+ a) -> r :+ a
forall s a. s -> Getting a s a -> a
^.Getting (r :+ a) (Interval a r) (r :+ a)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end)(r :+ a, r :+ a)
-> ((r :+ a, r :+ a) -> (Line 2 r :+ a, Line 2 r :+ a))
-> (Line 2 r :+ a, Line 2 r :+ a)
forall a b. a -> (a -> b) -> b
&((r :+ a) -> Identity (Line 2 r :+ a))
-> (r :+ a, r :+ a) -> Identity (Line 2 r :+ a, Line 2 r :+ a)
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both(((r :+ a) -> Identity (Line 2 r :+ a))
 -> (r :+ a, r :+ a) -> Identity (Line 2 r :+ a, Line 2 r :+ a))
-> ((r -> Identity (Line 2 r))
    -> (r :+ a) -> Identity (Line 2 r :+ a))
-> (r -> Identity (Line 2 r))
-> (r :+ a, r :+ a)
-> Identity (Line 2 r :+ a, Line 2 r :+ a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Identity (Line 2 r)) -> (r :+ a) -> Identity (Line 2 r :+ a)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((r -> Identity (Line 2 r))
 -> (r :+ a, r :+ a) -> Identity (Line 2 r :+ a, Line 2 r :+ a))
-> (r -> Line 2 r)
-> (r :+ a, r :+ a)
-> (Line 2 r :+ a, Line 2 r :+ a)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ r -> Line 2 r
forall r. Num r => r -> Line 2 r
verticalLine

  Point 2 r
p inSlab :: Point 2 r -> Slab 'Vertical a r -> Bool
`inSlab` (Slab Interval a r
i) = (Point 2 r
pPoint 2 r -> Getting r (Point 2 r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Point 2 r) r
forall (d :: Nat) (point :: Nat -> * -> *) r.
(1 <= d, Arity d, AsAPoint point) =>
Lens' (point d r) r
xCoord) r -> Interval a r -> Bool
forall r a. Ord r => r -> Interval a r -> Bool
`inInterval` Interval a r
i


type instance IntersectionOf (Line 2 r) (Slab o a r) =
  [NoIntersection, Line 2 r, LineSegment 2 a r]

instance (Fractional r, Ord r, HasBoundingLines o) =>
         Line 2 r `IsIntersectableWith` Slab o a r where
  nonEmptyIntersection :: proxy (Line 2 r)
-> proxy (Slab o a r)
-> Intersection (Line 2 r) (Slab o a r)
-> Bool
nonEmptyIntersection = proxy (Line 2 r)
-> proxy (Slab o a r)
-> Intersection (Line 2 r) (Slab o a r)
-> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
 RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection

  l :: Line 2 r
l@(Line Point 2 r
p Vector 2 r
_) intersect :: Line 2 r -> Slab o a r -> Intersection (Line 2 r) (Slab o a r)
`intersect` Slab o a r
s = CoRec Identity '[NoIntersection, Point 2 r, Line 2 r]
-> Handlers
     '[NoIntersection, Point 2 r, Line 2 r]
     (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
-> CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r]
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match (Line 2 r
l Line 2 r -> Line 2 r -> Intersection (Line 2 r) (Line 2 r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Line 2 r
a) (Handlers
   '[NoIntersection, Point 2 r, Line 2 r]
   (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
 -> CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
-> Handlers
     '[NoIntersection, Point 2 r, Line 2 r]
     (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
-> CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r]
forall a b. (a -> b) -> a -> b
$
         (NoIntersection
 -> CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
-> Handler
     (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
     NoIntersection
forall b a. (a -> b) -> Handler b a
H (\NoIntersection
NoIntersection -> if Point 2 r
p Point 2 r -> Slab o a r -> Bool
forall (o :: Orthogonal) r a.
(HasBoundingLines o, Ord r) =>
Point 2 r -> Slab o a r -> Bool
`inSlab` Slab o a r
s then Line 2 r
-> CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec Line 2 r
l else NoIntersection
-> CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection)
      Handler
  (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
  NoIntersection
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r]))
     '[Point 2 r, Line 2 r]
-> Handlers
     '[NoIntersection, Point 2 r, Line 2 r]
     (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Point 2 r
 -> CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
-> Handler
     (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
     (Point 2 r)
forall b a. (a -> b) -> Handler b a
H (\Point 2 r
pa             -> CoRec Identity '[NoIntersection, Point 2 r, Line 2 r]
-> Handlers
     '[NoIntersection, Point 2 r, Line 2 r]
     (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
-> CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r]
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match (Line 2 r
l Line 2 r -> Line 2 r -> Intersection (Line 2 r) (Line 2 r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Line 2 r
b) (Handlers
   '[NoIntersection, Point 2 r, Line 2 r]
   (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
 -> CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
-> Handlers
     '[NoIntersection, Point 2 r, Line 2 r]
     (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
-> CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r]
forall a b. (a -> b) -> a -> b
$
            (NoIntersection
 -> CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
-> Handler
     (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
     NoIntersection
forall b a. (a -> b) -> Handler b a
H NoIntersection
-> CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec -- NoIntersection
         Handler
  (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
  NoIntersection
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r]))
     '[Point 2 r, Line 2 r]
-> Handlers
     '[NoIntersection, Point 2 r, Line 2 r]
     (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Point 2 r
 -> CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
-> Handler
     (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
     (Point 2 r)
forall b a. (a -> b) -> Handler b a
H (LineSegment 2 a r
-> CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (LineSegment 2 a r
 -> CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
-> (Point 2 r -> LineSegment 2 a r)
-> Point 2 r
-> CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point 2 r -> Point 2 r -> LineSegment 2 a r
lineSegment' Point 2 r
pa)
         Handler
  (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
  (Point 2 r)
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r]))
     '[Line 2 r]
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r]))
     '[Point 2 r, Line 2 r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Line 2 r
 -> CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
-> Handler
     (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
     (Line 2 r)
forall b a. (a -> b) -> Handler b a
H (\Line 2 r
_ -> Line 2 r
-> CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec Line 2 r
l)
         Handler
  (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
  (Line 2 r)
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r]))
     '[]
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r]))
     '[Line 2 r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec
  (Handler
     (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r]))
  '[]
forall u (a :: u -> *). Rec a '[]
RNil
         )
      Handler
  (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
  (Point 2 r)
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r]))
     '[Line 2 r]
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r]))
     '[Point 2 r, Line 2 r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Line 2 r
 -> CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
-> Handler
     (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
     (Line 2 r)
forall b a. (a -> b) -> Handler b a
H (\Line 2 r
_              -> Line 2 r
-> CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec Line 2 r
l)
      Handler
  (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r])
  (Line 2 r)
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r]))
     '[]
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r]))
     '[Line 2 r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec
  (Handler
     (CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r]))
  '[]
forall u (a :: u -> *). Rec a '[]
RNil
    where
      (Line 2 r
a :+ a
_,Line 2 r
b :+ a
_) = Slab o a r -> (Line 2 r :+ a, Line 2 r :+ a)
forall (o :: Orthogonal) r a.
(HasBoundingLines o, Num r) =>
Slab o a r -> (Line 2 r :+ a, Line 2 r :+ a)
boundingLines Slab o a r
s

      -- note that this maintains the open/closedness of the slab
      lineSegment' :: Point 2 r -> Point 2 r -> LineSegment 2 a r
lineSegment' Point 2 r
pa Point 2 r
pb = let Interval EndPoint (r :+ a)
a' EndPoint (r :+ a)
b' = Slab o a r
sSlab o a r
-> Getting (Interval a r) (Slab o a r) (Interval a r)
-> Interval a r
forall s a. s -> Getting a s a -> a
^.Getting (Interval a r) (Slab o a r) (Interval a r)
forall (o :: Orthogonal) a r (o :: Orthogonal) a r.
Iso (Slab o a r) (Slab o a r) (Interval a r) (Interval a r)
unSlab
                           in EndPoint (Point 2 r :+ a)
-> EndPoint (Point 2 r :+ a) -> LineSegment 2 a r
forall (d :: Nat) r p.
EndPoint (Point d r :+ p)
-> EndPoint (Point d r :+ p) -> LineSegment d p r
LineSegment (EndPoint (r :+ a)
a'EndPoint (r :+ a)
-> (EndPoint (r :+ a) -> EndPoint (Point 2 r :+ a))
-> EndPoint (Point 2 r :+ a)
forall a b. a -> (a -> b) -> b
&((r :+ a) -> Identity (Point 2 r :+ a))
-> EndPoint (r :+ a) -> Identity (EndPoint (Point 2 r :+ a))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((r :+ a) -> Identity (Point 2 r :+ a))
 -> EndPoint (r :+ a) -> Identity (EndPoint (Point 2 r :+ a)))
-> ((r -> Identity (Point 2 r))
    -> (r :+ a) -> Identity (Point 2 r :+ a))
-> (r -> Identity (Point 2 r))
-> EndPoint (r :+ a)
-> Identity (EndPoint (Point 2 r :+ a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Identity (Point 2 r))
-> (r :+ a) -> Identity (Point 2 r :+ a)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((r -> Identity (Point 2 r))
 -> EndPoint (r :+ a) -> Identity (EndPoint (Point 2 r :+ a)))
-> Point 2 r -> EndPoint (r :+ a) -> EndPoint (Point 2 r :+ a)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Point 2 r
pa)
                                          (EndPoint (r :+ a)
b'EndPoint (r :+ a)
-> (EndPoint (r :+ a) -> EndPoint (Point 2 r :+ a))
-> EndPoint (Point 2 r :+ a)
forall a b. a -> (a -> b) -> b
&((r :+ a) -> Identity (Point 2 r :+ a))
-> EndPoint (r :+ a) -> Identity (EndPoint (Point 2 r :+ a))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((r :+ a) -> Identity (Point 2 r :+ a))
 -> EndPoint (r :+ a) -> Identity (EndPoint (Point 2 r :+ a)))
-> ((r -> Identity (Point 2 r))
    -> (r :+ a) -> Identity (Point 2 r :+ a))
-> (r -> Identity (Point 2 r))
-> EndPoint (r :+ a)
-> Identity (EndPoint (Point 2 r :+ a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Identity (Point 2 r))
-> (r :+ a) -> Identity (Point 2 r :+ a)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((r -> Identity (Point 2 r))
 -> EndPoint (r :+ a) -> Identity (EndPoint (Point 2 r :+ a)))
-> Point 2 r -> EndPoint (r :+ a) -> EndPoint (Point 2 r :+ a)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Point 2 r
pb)



type instance IntersectionOf (SubLine 2 p s r) (Slab o a r) =
  [NoIntersection, SubLine 2 () s r]

instance (Fractional r, Ord r, HasBoundingLines o) =>
         SubLine 2 a r r `IsIntersectableWith` Slab o a r where

  nonEmptyIntersection :: proxy (SubLine 2 a r r)
-> proxy (Slab o a r)
-> Intersection (SubLine 2 a r r) (Slab o a r)
-> Bool
nonEmptyIntersection = proxy (SubLine 2 a r r)
-> proxy (Slab o a r)
-> Intersection (SubLine 2 a r r) (Slab o a r)
-> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
 RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection

  sl :: SubLine 2 a r r
sl@(SubLine Line 2 r
l Interval a r
_) intersect :: SubLine 2 a r r
-> Slab o a r -> Intersection (SubLine 2 a r r) (Slab o a r)
`intersect` Slab o a r
s = CoRec Identity '[NoIntersection, Line 2 r, LineSegment 2 a r]
-> Handlers
     '[NoIntersection, Line 2 r, LineSegment 2 a r]
     (CoRec Identity '[NoIntersection, SubLine 2 () r r])
-> CoRec Identity '[NoIntersection, SubLine 2 () r r]
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match (Line 2 r
l Line 2 r -> Slab o a r -> Intersection (Line 2 r) (Slab o a r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Slab o a r
s) (Handlers
   '[NoIntersection, Line 2 r, LineSegment 2 a r]
   (CoRec Identity '[NoIntersection, SubLine 2 () r r])
 -> CoRec Identity '[NoIntersection, SubLine 2 () r r])
-> Handlers
     '[NoIntersection, Line 2 r, LineSegment 2 a r]
     (CoRec Identity '[NoIntersection, SubLine 2 () r r])
-> CoRec Identity '[NoIntersection, SubLine 2 () r r]
forall a b. (a -> b) -> a -> b
$
       (NoIntersection
 -> CoRec Identity '[NoIntersection, SubLine 2 () r r])
-> Handler
     (CoRec Identity '[NoIntersection, SubLine 2 () r r]) NoIntersection
forall b a. (a -> b) -> Handler b a
H (\NoIntersection
NoIntersection -> NoIntersection
-> CoRec Identity '[NoIntersection, SubLine 2 () r r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection)
    Handler
  (CoRec Identity '[NoIntersection, SubLine 2 () r r]) NoIntersection
-> Rec
     (Handler (CoRec Identity '[NoIntersection, SubLine 2 () r r]))
     '[Line 2 r, LineSegment 2 a r]
-> Handlers
     '[NoIntersection, Line 2 r, LineSegment 2 a r]
     (CoRec Identity '[NoIntersection, SubLine 2 () r r])
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Line 2 r -> CoRec Identity '[NoIntersection, SubLine 2 () r r])
-> Handler
     (CoRec Identity '[NoIntersection, SubLine 2 () r r]) (Line 2 r)
forall b a. (a -> b) -> Handler b a
H (\(Line Point 2 r
_ Vector 2 r
_)     -> SubLine 2 () r r
-> CoRec Identity '[NoIntersection, SubLine 2 () r r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (SubLine 2 () r r
 -> CoRec Identity '[NoIntersection, SubLine 2 () r r])
-> SubLine 2 () r r
-> CoRec Identity '[NoIntersection, SubLine 2 () r r]
forall a b. (a -> b) -> a -> b
$ SubLine 2 a r r -> SubLine 2 () r r
forall (d :: Nat) p s r. SubLine d p s r -> SubLine d () s r
dropExtra SubLine 2 a r r
sl)
    Handler
  (CoRec Identity '[NoIntersection, SubLine 2 () r r]) (Line 2 r)
-> Rec
     (Handler (CoRec Identity '[NoIntersection, SubLine 2 () r r]))
     '[LineSegment 2 a r]
-> Rec
     (Handler (CoRec Identity '[NoIntersection, SubLine 2 () r r]))
     '[Line 2 r, LineSegment 2 a r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (LineSegment 2 a r
 -> CoRec Identity '[NoIntersection, SubLine 2 () r r])
-> Handler
     (CoRec Identity '[NoIntersection, SubLine 2 () r r])
     (LineSegment 2 a r)
forall b a. (a -> b) -> Handler b a
H (\LineSegment 2 a r
seg            -> CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 a r r]
-> Handlers
     '[NoIntersection, Point 2 r, SubLine 2 a r r]
     (CoRec Identity '[NoIntersection, SubLine 2 () r r])
-> CoRec Identity '[NoIntersection, SubLine 2 () r r]
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match (SubLine 2 a r r
sl SubLine 2 a r r
-> SubLine 2 a r r
-> Intersection (SubLine 2 a r r) (SubLine 2 a r r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` (LineSegment 2 a r
segLineSegment 2 a r
-> Getting (SubLine 2 a r r) (LineSegment 2 a r) (SubLine 2 a r r)
-> SubLine 2 a r r
forall s a. s -> Getting a s a -> a
^.Getting (SubLine 2 a r r) (LineSegment 2 a r) (SubLine 2 a r r)
forall r (d :: Nat) p.
(Num r, Arity d) =>
Iso' (LineSegment d p r) (SubLine d p r r)
_SubLine)) (Handlers
   '[NoIntersection, Point 2 r, SubLine 2 a r r]
   (CoRec Identity '[NoIntersection, SubLine 2 () r r])
 -> CoRec Identity '[NoIntersection, SubLine 2 () r r])
-> Handlers
     '[NoIntersection, Point 2 r, SubLine 2 a r r]
     (CoRec Identity '[NoIntersection, SubLine 2 () r r])
-> CoRec Identity '[NoIntersection, SubLine 2 () r r]
forall a b. (a -> b) -> a -> b
$
                                    (NoIntersection
 -> CoRec Identity '[NoIntersection, SubLine 2 () r r])
-> Handler
     (CoRec Identity '[NoIntersection, SubLine 2 () r r]) NoIntersection
forall b a. (a -> b) -> Handler b a
H (\NoIntersection
NoIntersection -> NoIntersection
-> CoRec Identity '[NoIntersection, SubLine 2 () r r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection)
                                 Handler
  (CoRec Identity '[NoIntersection, SubLine 2 () r r]) NoIntersection
-> Rec
     (Handler (CoRec Identity '[NoIntersection, SubLine 2 () r r]))
     '[Point 2 r, SubLine 2 a r r]
-> Handlers
     '[NoIntersection, Point 2 r, SubLine 2 a r r]
     (CoRec Identity '[NoIntersection, SubLine 2 () r r])
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Point 2 r -> CoRec Identity '[NoIntersection, SubLine 2 () r r])
-> Handler
     (CoRec Identity '[NoIntersection, SubLine 2 () r r]) (Point 2 r)
forall b a. (a -> b) -> Handler b a
H (\p :: Point 2 r
p@Point2{}     -> SubLine 2 () r r
-> CoRec Identity '[NoIntersection, SubLine 2 () r r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (SubLine 2 () r r
 -> CoRec Identity '[NoIntersection, SubLine 2 () r r])
-> SubLine 2 () r r
-> CoRec Identity '[NoIntersection, SubLine 2 () r r]
forall a b. (a -> b) -> a -> b
$ Point 2 r -> SubLine 2 () r r
singleton Point 2 r
p)
                                 Handler
  (CoRec Identity '[NoIntersection, SubLine 2 () r r]) (Point 2 r)
-> Rec
     (Handler (CoRec Identity '[NoIntersection, SubLine 2 () r r]))
     '[SubLine 2 a r r]
-> Rec
     (Handler (CoRec Identity '[NoIntersection, SubLine 2 () r r]))
     '[Point 2 r, SubLine 2 a r r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (SubLine 2 a r r
 -> CoRec Identity '[NoIntersection, SubLine 2 () r r])
-> Handler
     (CoRec Identity '[NoIntersection, SubLine 2 () r r])
     (SubLine 2 a r r)
forall b a. (a -> b) -> Handler b a
H (                   SubLine 2 () r r
-> CoRec Identity '[NoIntersection, SubLine 2 () r r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (SubLine 2 () r r
 -> CoRec Identity '[NoIntersection, SubLine 2 () r r])
-> (SubLine 2 a r r -> SubLine 2 () r r)
-> SubLine 2 a r r
-> CoRec Identity '[NoIntersection, SubLine 2 () r r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubLine 2 a r r -> SubLine 2 () r r
forall (d :: Nat) p s r. SubLine d p s r -> SubLine d () s r
dropExtra)
                                 Handler
  (CoRec Identity '[NoIntersection, SubLine 2 () r r])
  (SubLine 2 a r r)
-> Rec
     (Handler (CoRec Identity '[NoIntersection, SubLine 2 () r r])) '[]
-> Rec
     (Handler (CoRec Identity '[NoIntersection, SubLine 2 () r r]))
     '[SubLine 2 a r r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec
  (Handler (CoRec Identity '[NoIntersection, SubLine 2 () r r])) '[]
forall u (a :: u -> *). Rec a '[]
RNil)
    Handler
  (CoRec Identity '[NoIntersection, SubLine 2 () r r])
  (LineSegment 2 a r)
-> Rec
     (Handler (CoRec Identity '[NoIntersection, SubLine 2 () r r])) '[]
-> Rec
     (Handler (CoRec Identity '[NoIntersection, SubLine 2 () r r]))
     '[LineSegment 2 a r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec
  (Handler (CoRec Identity '[NoIntersection, SubLine 2 () r r])) '[]
forall u (a :: u -> *). Rec a '[]
RNil
    where
      singleton :: Point 2 r -> SubLine 2 () r r
singleton Point 2 r
p = let x :: r :+ ()
x = r -> r :+ ()
forall a. a -> a :+ ()
ext (r -> r :+ ()) -> r -> r :+ ()
forall a b. (a -> b) -> a -> b
$ Point 2 r -> Line 2 r -> r
forall r (d :: Nat).
(Eq r, Fractional r, Arity d) =>
Point d r -> Line d r -> r
toOffset' Point 2 r
p Line 2 r
l in Line 2 r -> Interval () r -> SubLine 2 () r r
forall (d :: Nat) p s r.
Line d r -> Interval p s -> SubLine d p s r
SubLine Line 2 r
l ((r :+ ()) -> (r :+ ()) -> Interval () r
forall r a. (r :+ a) -> (r :+ a) -> Interval a r
ClosedInterval r :+ ()
x r :+ ()
x)


type instance IntersectionOf (LineSegment 2 p r) (Slab o a r) =
  [NoIntersection, LineSegment 2 () r]

instance (Fractional r, Ord r, HasBoundingLines o) =>
         LineSegment 2 a r `IsIntersectableWith` Slab o a r where
  nonEmptyIntersection :: proxy (LineSegment 2 a r)
-> proxy (Slab o a r)
-> Intersection (LineSegment 2 a r) (Slab o a r)
-> Bool
nonEmptyIntersection = proxy (LineSegment 2 a r)
-> proxy (Slab o a r)
-> Intersection (LineSegment 2 a r) (Slab o a r)
-> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
 RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection

  LineSegment 2 a r
seg intersect :: LineSegment 2 a r
-> Slab o a r -> Intersection (LineSegment 2 a r) (Slab o a r)
`intersect` Slab o a r
slab = CoRec Identity '[NoIntersection, SubLine 2 () r r]
-> Handlers
     '[NoIntersection, SubLine 2 () r r]
     (CoRec Identity '[NoIntersection, LineSegment 2 () r])
-> CoRec Identity '[NoIntersection, LineSegment 2 () r]
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match ((LineSegment 2 a r
segLineSegment 2 a r
-> Getting (SubLine 2 a r r) (LineSegment 2 a r) (SubLine 2 a r r)
-> SubLine 2 a r r
forall s a. s -> Getting a s a -> a
^.Getting (SubLine 2 a r r) (LineSegment 2 a r) (SubLine 2 a r r)
forall r (d :: Nat) p.
(Num r, Arity d) =>
Iso' (LineSegment d p r) (SubLine d p r r)
_SubLine) SubLine 2 a r r
-> Slab o a r -> Intersection (SubLine 2 a r r) (Slab o a r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Slab o a r
slab) (Handlers
   '[NoIntersection, SubLine 2 () r r]
   (CoRec Identity '[NoIntersection, LineSegment 2 () r])
 -> CoRec Identity '[NoIntersection, LineSegment 2 () r])
-> Handlers
     '[NoIntersection, SubLine 2 () r r]
     (CoRec Identity '[NoIntersection, LineSegment 2 () r])
-> CoRec Identity '[NoIntersection, LineSegment 2 () r]
forall a b. (a -> b) -> a -> b
$
       (NoIntersection
 -> CoRec Identity '[NoIntersection, LineSegment 2 () r])
-> Handler
     (CoRec Identity '[NoIntersection, LineSegment 2 () r])
     NoIntersection
forall b a. (a -> b) -> Handler b a
H (\NoIntersection
NoIntersection -> NoIntersection
-> CoRec Identity '[NoIntersection, LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec   NoIntersection
NoIntersection)
    Handler
  (CoRec Identity '[NoIntersection, LineSegment 2 () r])
  NoIntersection
-> Rec
     (Handler (CoRec Identity '[NoIntersection, LineSegment 2 () r]))
     '[SubLine 2 () r r]
-> Handlers
     '[NoIntersection, SubLine 2 () r r]
     (CoRec Identity '[NoIntersection, LineSegment 2 () r])
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (SubLine 2 () r r
 -> CoRec Identity '[NoIntersection, LineSegment 2 () r])
-> Handler
     (CoRec Identity '[NoIntersection, LineSegment 2 () r])
     (SubLine 2 () r r)
forall b a. (a -> b) -> Handler b a
H (\SubLine 2 () r r
sl             -> LineSegment 2 () r
-> CoRec Identity '[NoIntersection, LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (LineSegment 2 () r
 -> CoRec Identity '[NoIntersection, LineSegment 2 () r])
-> LineSegment 2 () r
-> CoRec Identity '[NoIntersection, LineSegment 2 () r]
forall a b. (a -> b) -> a -> b
$ SubLine 2 () r r
slSubLine 2 () r r
-> Getting
     (LineSegment 2 () r) (SubLine 2 () r r) (LineSegment 2 () r)
-> LineSegment 2 () r
forall s a. s -> Getting a s a -> a
^. AnIso
  (LineSegment 2 () r)
  (LineSegment 2 () r)
  (SubLine 2 () r r)
  (SubLine 2 () r r)
-> Iso
     (SubLine 2 () r r)
     (SubLine 2 () r r)
     (LineSegment 2 () r)
     (LineSegment 2 () r)
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso
  (LineSegment 2 () r)
  (LineSegment 2 () r)
  (SubLine 2 () r r)
  (SubLine 2 () r r)
forall r (d :: Nat) p.
(Num r, Arity d) =>
Iso' (LineSegment d p r) (SubLine d p r r)
_SubLine)
    Handler
  (CoRec Identity '[NoIntersection, LineSegment 2 () r])
  (SubLine 2 () r r)
-> Rec
     (Handler (CoRec Identity '[NoIntersection, LineSegment 2 () r]))
     '[]
-> Rec
     (Handler (CoRec Identity '[NoIntersection, LineSegment 2 () r]))
     '[SubLine 2 () r r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec
  (Handler (CoRec Identity '[NoIntersection, LineSegment 2 () r]))
  '[]
forall u (a :: u -> *). Rec a '[]
RNil




-- test :: SubLine 2 () Double Double
-- test = (ClosedLineSegment (ext origin) (ext origin))^._SubLine