{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Geometry.HalfLine( HalfLine(HalfLine)
, startPoint, halfLineDirection
, toHalfLine
, halfLineToSubLine, fromSubLine
) where
import Control.DeepSeq
import Control.Lens
import Data.Ext
import qualified Data.Foldable as F
import Data.Geometry.Boundary
import Data.Geometry.Box
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 Data.Geometry.Transformation
import Data.Geometry.Vector
import qualified Data.Traversable as T
import Data.UnBounded
import qualified Data.Vector.Fixed as FV
import Data.Vinyl
import Data.Vinyl.CoRec
import GHC.Generics (Generic)
import GHC.TypeLits
data HalfLine d r = HalfLine { HalfLine d r -> Point d r
_startPoint :: Point d r
, HalfLine d r -> Vector d r
_halfLineDirection :: Vector d r
} deriving (forall x. HalfLine d r -> Rep (HalfLine d r) x)
-> (forall x. Rep (HalfLine d r) x -> HalfLine d r)
-> Generic (HalfLine d r)
forall x. Rep (HalfLine d r) x -> HalfLine d r
forall x. HalfLine d r -> Rep (HalfLine d r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (d :: Nat) r x. Rep (HalfLine d r) x -> HalfLine d r
forall (d :: Nat) r x. HalfLine d r -> Rep (HalfLine d r) x
$cto :: forall (d :: Nat) r x. Rep (HalfLine d r) x -> HalfLine d r
$cfrom :: forall (d :: Nat) r x. HalfLine d r -> Rep (HalfLine d r) x
Generic
makeLenses ''HalfLine
deriving instance (Show r, Arity d) => Show (HalfLine d r)
deriving instance (NFData r, Arity d) => NFData (HalfLine d r)
deriving instance Arity d => Functor (HalfLine d)
deriving instance Arity d => F.Foldable (HalfLine d)
deriving instance Arity d => T.Traversable (HalfLine d)
type instance Dimension (HalfLine d r) = d
type instance NumType (HalfLine d r) = r
instance {-# OVERLAPPING #-} (Eq r, Fractional r) => Eq (HalfLine 2 r) where
(HalfLine Point 2 r
p Vector 2 r
u) == :: HalfLine 2 r -> HalfLine 2 r -> Bool
== (HalfLine Point 2 r
q Vector 2 r
v) =
Point 2 r
p Point 2 r -> Point 2 r -> Bool
forall a. Eq a => a -> a -> Bool
== Point 2 r
q Bool -> Bool -> Bool
&&
Point 2 r -> Point 2 r -> Point 2 r -> Bool
forall r.
(Eq r, Num r) =>
Point 2 r -> Point 2 r -> Point 2 r -> Bool
isCoLinear Point 2 r
p (Vector 2 r -> Point 2 r
forall (d :: Nat) r. Vector d r -> Point d r
Point Vector 2 r
u) (Vector 2 r -> Point 2 r
forall (d :: Nat) r. Vector d r -> Point d r
Point Vector 2 r
v) Bool -> Bool -> Bool
&&
Bool
sameSigns
where
sameSigns :: Bool
sameSigns = Vector 2 Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
F.and (Vector 2 Bool -> Bool) -> Vector 2 Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (r -> r -> Bool) -> Vector 2 r -> Vector 2 r -> Vector 2 Bool
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
FV.zipWith (\r
a r
b -> r -> r
forall a. Num a => a -> a
signum r
ar -> r -> Bool
forall a. Eq a => a -> a -> Bool
==r -> r
forall a. Num a => a -> a
signum r
b) Vector 2 r
u Vector 2 r
v
instance (Eq r, Fractional r, Arity d) => Eq (HalfLine d r) where
(HalfLine Point d r
p Vector d r
u) == :: HalfLine d r -> HalfLine d r -> Bool
== (HalfLine Point d r
q Vector d r
v) = let lam :: Maybe r
lam = Vector d r -> Vector d r -> Maybe r
forall r (d :: Nat).
(Eq r, Fractional r, Arity d) =>
Vector d r -> Vector d r -> Maybe r
scalarMultiple Vector d r
u Vector d r
v
in Point d r
p Point d r -> Point d r -> Bool
forall a. Eq a => a -> a -> Bool
== Point d r
q Bool -> Bool -> Bool
&& (r -> r
forall a. Num a => a -> a
signum (r -> r) -> Maybe r -> Maybe r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe r
lam) Maybe r -> Maybe r -> Bool
forall a. Eq a => a -> a -> Bool
== r -> Maybe r
forall a. a -> Maybe a
Just r
1
instance HasStart (HalfLine d r) where
type StartCore (HalfLine d r) = Point d r
type (HalfLine d r) = ()
start :: ((StartCore (HalfLine d r) :+ StartExtra (HalfLine d r))
-> f (StartCore (HalfLine d r) :+ StartExtra (HalfLine d r)))
-> HalfLine d r -> f (HalfLine d r)
start = (HalfLine d r -> Point d r :+ ())
-> (HalfLine d r -> (Point d r :+ ()) -> HalfLine d r)
-> Lens
(HalfLine d r) (HalfLine d r) (Point d r :+ ()) (Point d r :+ ())
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens ((Point d r -> () -> Point d r :+ ()
forall core extra. core -> extra -> core :+ extra
:+ ()) (Point d r -> Point d r :+ ())
-> (HalfLine d r -> Point d r) -> HalfLine d r -> Point d r :+ ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HalfLine d r -> Point d r
forall (d :: Nat) r. HalfLine d r -> Point d r
_startPoint) (\(HalfLine Point d r
_ Vector d r
v) Point d r :+ ()
p -> Point d r -> Vector d r -> HalfLine d r
forall (d :: Nat) r. Point d r -> Vector d r -> HalfLine d r
HalfLine (Point d r :+ ()
p(Point d r :+ ())
-> Getting (Point d r) (Point d r :+ ()) (Point d r) -> Point d r
forall s a. s -> Getting a s a -> a
^.Getting (Point d r) (Point d r :+ ()) (Point d r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) Vector d r
v)
instance HasSupportingLine (HalfLine d r) where
supportingLine :: HalfLine d r
-> Line (Dimension (HalfLine d r)) (NumType (HalfLine d r))
supportingLine ~(HalfLine Point d r
p Vector d r
v) = Point d r -> Vector d r -> Line d r
forall (d :: Nat) r. Point d r -> Vector d r -> Line d r
Line Point d r
p Vector d r
v
instance (Fractional r, Arity d, Arity (d + 1)) => IsTransformable (HalfLine d r) where
transformBy :: Transformation (Dimension (HalfLine d r)) (NumType (HalfLine d r))
-> HalfLine d r -> HalfLine d r
transformBy Transformation (Dimension (HalfLine d r)) (NumType (HalfLine d r))
t = LineSegment d () r -> HalfLine d r
forall r (d :: Nat) p.
(Num r, Arity d) =>
LineSegment d p r -> HalfLine d r
toHalfLine (LineSegment d () r -> HalfLine d r)
-> (HalfLine d r -> LineSegment d () r)
-> HalfLine d r
-> HalfLine d r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transformation d r -> LineSegment d () r -> LineSegment d () r
forall (g :: * -> *) r (d :: Nat).
(PointFunctor g, Fractional r, d ~ Dimension (g r), Arity d,
Arity (d + 1)) =>
Transformation d r -> g r -> g r
transformPointFunctor Transformation d r
Transformation (Dimension (HalfLine d r)) (NumType (HalfLine d r))
t (LineSegment d () r -> LineSegment d () r)
-> (HalfLine d r -> LineSegment d () r)
-> HalfLine d r
-> LineSegment d () r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Num r, Arity d) => HalfLine d r -> LineSegment d () r
HalfLine d r -> LineSegment d () r
toLineSegment'
where
toLineSegment' :: (Num r, Arity d) => HalfLine d r -> LineSegment d () r
toLineSegment' :: HalfLine d r -> LineSegment d () r
toLineSegment' (HalfLine Point d r
p Vector d r
v) = (Point d r :+ ()) -> (Point d r :+ ()) -> LineSegment d () r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment (Point d r
p Point d r -> () -> Point d r :+ ()
forall core extra. core -> extra -> core :+ extra
:+ ()) ((Point d r
p Point d r -> Diff (Point d) r -> Point d r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ Diff (Point d) r
Vector d r
v) Point d r -> () -> Point d r :+ ()
forall core extra. core -> extra -> core :+ extra
:+ ())
halfLineToSubLine :: (Arity d, Num r)
=> HalfLine d r -> SubLine d () (UnBounded r) r
halfLineToSubLine :: HalfLine d r -> SubLine d () (UnBounded r) r
halfLineToSubLine (HalfLine Point d r
p Vector d r
v) = let l :: Line d r
l = Point d r -> Vector d r -> Line d r
forall (d :: Nat) r. Point d r -> Vector d r -> Line d r
Line Point d r
p Vector d r
v
in Line d r
-> Interval () (UnBounded r) -> SubLine d () (UnBounded r) r
forall (d :: Nat) p s r.
Line d r -> Interval p s -> SubLine d p s r
SubLine Line d r
l (EndPoint (UnBounded r :+ ())
-> EndPoint (UnBounded r :+ ()) -> Interval () (UnBounded r)
forall r a. EndPoint (r :+ a) -> EndPoint (r :+ a) -> Interval a r
Interval ((UnBounded r :+ ()) -> EndPoint (UnBounded r :+ ())
forall a. a -> EndPoint a
Closed ((UnBounded r :+ ()) -> EndPoint (UnBounded r :+ ()))
-> (UnBounded r :+ ()) -> EndPoint (UnBounded r :+ ())
forall a b. (a -> b) -> a -> b
$ UnBounded r -> UnBounded r :+ ()
forall a. a -> a :+ ()
ext (r -> UnBounded r
forall a. a -> UnBounded a
Val r
0))
((UnBounded r :+ ()) -> EndPoint (UnBounded r :+ ())
forall a. a -> EndPoint a
Open ((UnBounded r :+ ()) -> EndPoint (UnBounded r :+ ()))
-> (UnBounded r :+ ()) -> EndPoint (UnBounded r :+ ())
forall a b. (a -> b) -> a -> b
$ UnBounded r -> UnBounded r :+ ()
forall a. a -> a :+ ()
ext UnBounded r
forall a. UnBounded a
MaxInfinity))
fromSubLine :: (Num r, Arity d) => SubLine d p (UnBounded r) r
-> Maybe (HalfLine d r)
fromSubLine :: SubLine d p (UnBounded r) r -> Maybe (HalfLine d r)
fromSubLine (SubLine Line d r
l Interval p (UnBounded r)
i) = case (Interval p (UnBounded r)
iInterval p (UnBounded r)
-> Getting (UnBounded r) (Interval p (UnBounded r)) (UnBounded r)
-> UnBounded r
forall s a. s -> Getting a s a -> a
^.((UnBounded r :+ p) -> Const (UnBounded r) (UnBounded r :+ p))
-> Interval p (UnBounded r)
-> Const (UnBounded r) (Interval p (UnBounded r))
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((UnBounded r :+ p) -> Const (UnBounded r) (UnBounded r :+ p))
-> Interval p (UnBounded r)
-> Const (UnBounded r) (Interval p (UnBounded r)))
-> ((UnBounded r -> Const (UnBounded r) (UnBounded r))
-> (UnBounded r :+ p) -> Const (UnBounded r) (UnBounded r :+ p))
-> Getting (UnBounded r) (Interval p (UnBounded r)) (UnBounded r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(UnBounded r -> Const (UnBounded r) (UnBounded r))
-> (UnBounded r :+ p) -> Const (UnBounded r) (UnBounded r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core, Interval p (UnBounded r)
iInterval p (UnBounded r)
-> Getting (UnBounded r) (Interval p (UnBounded r)) (UnBounded r)
-> UnBounded r
forall s a. s -> Getting a s a -> a
^.((UnBounded r :+ p) -> Const (UnBounded r) (UnBounded r :+ p))
-> Interval p (UnBounded r)
-> Const (UnBounded r) (Interval p (UnBounded r))
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((UnBounded r :+ p) -> Const (UnBounded r) (UnBounded r :+ p))
-> Interval p (UnBounded r)
-> Const (UnBounded r) (Interval p (UnBounded r)))
-> ((UnBounded r -> Const (UnBounded r) (UnBounded r))
-> (UnBounded r :+ p) -> Const (UnBounded r) (UnBounded r :+ p))
-> Getting (UnBounded r) (Interval p (UnBounded r)) (UnBounded r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(UnBounded r -> Const (UnBounded r) (UnBounded r))
-> (UnBounded r :+ p) -> Const (UnBounded r) (UnBounded r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) of
(Val r
x, UnBounded r
MaxInfinity) -> HalfLine d r -> Maybe (HalfLine d r)
forall a. a -> Maybe a
Just (HalfLine d r -> Maybe (HalfLine d r))
-> HalfLine d r -> Maybe (HalfLine d r)
forall a b. (a -> b) -> a -> b
$ Point d r -> Vector d r -> HalfLine d r
forall (d :: Nat) r. Point d r -> Vector d r -> HalfLine d r
HalfLine (r -> Line d r -> Point d r
forall r (d :: Nat). (Num r, Arity d) => r -> Line d r -> Point d r
pointAt r
x Line d r
l) (Line d r
lLine d r
-> Getting (Vector d r) (Line d r) (Vector d r) -> Vector d r
forall s a. s -> Getting a s a -> a
^.Getting (Vector d r) (Line d r) (Vector d r)
forall (d :: Nat) r. Lens' (Line d r) (Vector d r)
direction)
(UnBounded r
MinInfinity, Val r
x) -> HalfLine d r -> Maybe (HalfLine d r)
forall a. a -> Maybe a
Just (HalfLine d r -> Maybe (HalfLine d r))
-> HalfLine d r -> Maybe (HalfLine d r)
forall a b. (a -> b) -> a -> b
$ Point d r -> Vector d r -> HalfLine d r
forall (d :: Nat) r. Point d r -> Vector d r -> HalfLine d r
HalfLine (r -> Line d r -> Point d r
forall r (d :: Nat). (Num r, Arity d) => r -> Line d r -> Point d r
pointAt r
x Line d r
l) ((-r
1) r -> Vector d r -> Vector d r
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Line d r
lLine d r
-> Getting (Vector d r) (Line d r) (Vector d r) -> Vector d r
forall s a. s -> Getting a s a -> a
^.Getting (Vector d r) (Line d r) (Vector d r)
forall (d :: Nat) r. Lens' (Line d r) (Vector d r)
direction)
(UnBounded r, UnBounded r)
_ -> Maybe (HalfLine d r)
forall a. Maybe a
Nothing
type instance IntersectionOf (HalfLine d r) (Line d r) = [ NoIntersection
, Point d r
, HalfLine d r
]
type instance IntersectionOf (HalfLine 2 r) (HalfLine 2 r) = [ NoIntersection
, Point 2 r
, LineSegment 2 () r
, HalfLine 2 r
]
type instance IntersectionOf (LineSegment 2 p r) (HalfLine 2 r) = [ NoIntersection
, Point 2 r
, LineSegment 2 () r
]
type instance IntersectionOf (Point d r) (HalfLine d r) = [ NoIntersection
, Point d r
]
instance (Ord r, Fractional r) => HalfLine 2 r `IsIntersectableWith` Line 2 r where
nonEmptyIntersection :: proxy (HalfLine 2 r)
-> proxy (Line 2 r)
-> Intersection (HalfLine 2 r) (Line 2 r)
-> Bool
nonEmptyIntersection = proxy (HalfLine 2 r)
-> proxy (Line 2 r)
-> Intersection (HalfLine 2 r) (Line 2 r)
-> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection
HalfLine 2 r
hl intersect :: HalfLine 2 r -> Line 2 r -> Intersection (HalfLine 2 r) (Line 2 r)
`intersect` Line 2 r
l = CoRec Identity '[NoIntersection, Point 2 r, Line 2 r]
-> Handlers
'[NoIntersection, Point 2 r, Line 2 r]
(CoRec Identity '[NoIntersection, Point 2 r, HalfLine 2 r])
-> CoRec Identity '[NoIntersection, Point 2 r, HalfLine 2 r]
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match (HalfLine 2 r
-> Line (Dimension (HalfLine 2 r)) (NumType (HalfLine 2 r))
forall t.
HasSupportingLine t =>
t -> Line (Dimension t) (NumType t)
supportingLine HalfLine 2 r
hl 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
l) (Handlers
'[NoIntersection, Point 2 r, Line 2 r]
(CoRec Identity '[NoIntersection, Point 2 r, HalfLine 2 r])
-> CoRec Identity '[NoIntersection, Point 2 r, HalfLine 2 r])
-> Handlers
'[NoIntersection, Point 2 r, Line 2 r]
(CoRec Identity '[NoIntersection, Point 2 r, HalfLine 2 r])
-> CoRec Identity '[NoIntersection, Point 2 r, HalfLine 2 r]
forall a b. (a -> b) -> a -> b
$
(NoIntersection
-> CoRec Identity '[NoIntersection, Point 2 r, HalfLine 2 r])
-> Handler
(CoRec Identity '[NoIntersection, Point 2 r, HalfLine 2 r])
NoIntersection
forall b a. (a -> b) -> Handler b a
H (\NoIntersection
NoIntersection -> NoIntersection
-> CoRec Identity '[NoIntersection, Point 2 r, HalfLine 2 r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection)
Handler
(CoRec Identity '[NoIntersection, Point 2 r, HalfLine 2 r])
NoIntersection
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 2 r, HalfLine 2 r]))
'[Point 2 r, Line 2 r]
-> Handlers
'[NoIntersection, Point 2 r, Line 2 r]
(CoRec Identity '[NoIntersection, Point 2 r, HalfLine 2 r])
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Point 2 r
-> CoRec Identity '[NoIntersection, Point 2 r, HalfLine 2 r])
-> Handler
(CoRec Identity '[NoIntersection, Point 2 r, HalfLine 2 r])
(Point 2 r)
forall b a. (a -> b) -> Handler b a
H (\Point 2 r
p -> if Point 2 r -> HalfLine 2 r -> Bool
forall r (d :: Nat).
(Ord r, Fractional r, Arity d) =>
Point d r -> HalfLine d r -> Bool
onHalfLine Point 2 r
p HalfLine 2 r
hl then Point 2 r
-> CoRec Identity '[NoIntersection, Point 2 r, HalfLine 2 r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec Point 2 r
p else NoIntersection
-> CoRec Identity '[NoIntersection, Point 2 r, HalfLine 2 r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection)
Handler
(CoRec Identity '[NoIntersection, Point 2 r, HalfLine 2 r])
(Point 2 r)
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 2 r, HalfLine 2 r]))
'[Line 2 r]
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 2 r, HalfLine 2 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, Point 2 r, HalfLine 2 r])
-> Handler
(CoRec Identity '[NoIntersection, Point 2 r, HalfLine 2 r])
(Line 2 r)
forall b a. (a -> b) -> Handler b a
H (\Line 2 r
_l' -> HalfLine 2 r
-> CoRec Identity '[NoIntersection, Point 2 r, HalfLine 2 r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec HalfLine 2 r
hl)
Handler
(CoRec Identity '[NoIntersection, Point 2 r, HalfLine 2 r])
(Line 2 r)
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 2 r, HalfLine 2 r]))
'[]
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 2 r, HalfLine 2 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, Point 2 r, HalfLine 2 r]))
'[]
forall u (a :: u -> *). Rec a '[]
RNil
instance (Ord r, Fractional r) => HalfLine 2 r `IsIntersectableWith` HalfLine 2 r where
nonEmptyIntersection :: proxy (HalfLine 2 r)
-> proxy (HalfLine 2 r)
-> Intersection (HalfLine 2 r) (HalfLine 2 r)
-> Bool
nonEmptyIntersection = proxy (HalfLine 2 r)
-> proxy (HalfLine 2 r)
-> Intersection (HalfLine 2 r) (HalfLine 2 r)
-> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection
la :: HalfLine 2 r
la@(HalfLine Point 2 r
a Vector 2 r
va) intersect :: HalfLine 2 r
-> HalfLine 2 r -> Intersection (HalfLine 2 r) (HalfLine 2 r)
`intersect` lb :: HalfLine 2 r
lb@(HalfLine Point 2 r
b Vector 2 r
vb) =
CoRec Identity '[NoIntersection, Point 2 r, Line 2 r]
-> Handlers
'[NoIntersection, Point 2 r, Line 2 r]
(CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r])
-> CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r]
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match (HalfLine 2 r
-> Line (Dimension (HalfLine 2 r)) (NumType (HalfLine 2 r))
forall t.
HasSupportingLine t =>
t -> Line (Dimension t) (NumType t)
supportingLine HalfLine 2 r
la 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` HalfLine 2 r
-> Line (Dimension (HalfLine 2 r)) (NumType (HalfLine 2 r))
forall t.
HasSupportingLine t =>
t -> Line (Dimension t) (NumType t)
supportingLine HalfLine 2 r
lb) (Handlers
'[NoIntersection, Point 2 r, Line 2 r]
(CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r])
-> CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r])
-> Handlers
'[NoIntersection, Point 2 r, Line 2 r]
(CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r])
-> CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r]
forall a b. (a -> b) -> a -> b
$
(NoIntersection
-> CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r])
-> Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r])
NoIntersection
forall b a. (a -> b) -> Handler b a
H (\NoIntersection
NoIntersection -> NoIntersection
-> CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection)
Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r])
NoIntersection
-> Rec
(Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r]))
'[Point 2 r, Line 2 r]
-> Handlers
'[NoIntersection, Point 2 r, Line 2 r]
(CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r])
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Point 2 r
-> CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r])
-> Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r])
(Point 2 r)
forall b a. (a -> b) -> Handler b a
H (\Point 2 r
p -> if Point 2 r -> HalfLine 2 r -> Bool
forall r (d :: Nat).
(Ord r, Fractional r, Arity d) =>
Point d r -> HalfLine d r -> Bool
onHalfLine Point 2 r
p HalfLine 2 r
la Bool -> Bool -> Bool
&& Point 2 r -> HalfLine 2 r -> Bool
forall r (d :: Nat).
(Ord r, Fractional r, Arity d) =>
Point d r -> HalfLine d r -> Bool
onHalfLine Point 2 r
p HalfLine 2 r
lb
then Point 2 r
-> CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec Point 2 r
p else NoIntersection
-> CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection)
Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r])
(Point 2 r)
-> Rec
(Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r]))
'[Line 2 r]
-> Rec
(Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 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, Point 2 r, LineSegment 2 () r, HalfLine 2 r])
-> Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r])
(Line 2 r)
forall b a. (a -> b) -> Handler b a
H (\Line 2 r
_line -> case ( Point 2 r
a `onHalfLine ` HalfLine 2 r
lb
, Point 2 r
b `onHalfLine ` HalfLine 2 r
la
, Vector 2 r
va Vector 2 r -> Vector 2 r -> Bool
forall r (d :: Nat).
(Eq r, Num r, Arity d) =>
Vector d r -> Vector d r -> Bool
`sameDirection` Vector 2 r
vb
) of
(Bool
False,Bool
False,Bool
_) -> NoIntersection
-> CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection
(Bool
True,Bool
True,Bool
True) -> HalfLine 2 r
-> CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec HalfLine 2 r
la
(Bool
True,Bool
True,Bool
False) -> LineSegment 2 () r
-> CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (LineSegment 2 () r
-> CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r])
-> LineSegment 2 () r
-> CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r]
forall a b. (a -> b) -> a -> b
$ (Point 2 r :+ ()) -> (Point 2 r :+ ()) -> LineSegment 2 () r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment (Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext Point 2 r
a) (Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext Point 2 r
b)
(Bool
True,Bool
_,Bool
True) -> HalfLine 2 r
-> CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec HalfLine 2 r
la
(Bool
_,Bool
True,Bool
True) -> HalfLine 2 r
-> CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec HalfLine 2 r
lb
(Bool
_,Bool
_,Bool
False) -> String
-> CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r]
forall a. HasCallStack => String -> a
error String
"HalfLine x Halfline intersection: impossible"
)
Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r])
(Line 2 r)
-> Rec
(Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 r]))
'[]
-> Rec
(Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, LineSegment 2 () r, HalfLine 2 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, Point 2 r, LineSegment 2 () r, HalfLine 2 r]))
'[]
forall u (a :: u -> *). Rec a '[]
RNil
instance (Ord r, Fractional r) => LineSegment 2 () r `IsIntersectableWith` HalfLine 2 r where
nonEmptyIntersection :: proxy (LineSegment 2 () r)
-> proxy (HalfLine 2 r)
-> Intersection (LineSegment 2 () r) (HalfLine 2 r)
-> Bool
nonEmptyIntersection = proxy (LineSegment 2 () r)
-> proxy (HalfLine 2 r)
-> Intersection (LineSegment 2 () r) (HalfLine 2 r)
-> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection
seg :: LineSegment 2 () r
seg@(LineSegment EndPoint (Point 2 r :+ ())
s EndPoint (Point 2 r :+ ())
t) intersect :: LineSegment 2 () r
-> HalfLine 2 r -> Intersection (LineSegment 2 () r) (HalfLine 2 r)
`intersect` hl :: HalfLine 2 r
hl@(HalfLine Point 2 r
o Vector 2 r
_) =
CoRec Identity '[NoIntersection, Point 2 r, Line 2 r]
-> Handlers
'[NoIntersection, Point 2 r, Line 2 r]
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match (LineSegment 2 () r
-> Line
(Dimension (LineSegment 2 () r)) (NumType (LineSegment 2 () r))
forall t.
HasSupportingLine t =>
t -> Line (Dimension t) (NumType t)
supportingLine LineSegment 2 () r
seg 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` HalfLine 2 r
-> Line (Dimension (HalfLine 2 r)) (NumType (HalfLine 2 r))
forall t.
HasSupportingLine t =>
t -> Line (Dimension t) (NumType t)
supportingLine HalfLine 2 r
hl) (Handlers
'[NoIntersection, Point 2 r, Line 2 r]
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
-> Handlers
'[NoIntersection, Point 2 r, Line 2 r]
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall a b. (a -> b) -> a -> b
$
(NoIntersection
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
-> Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
NoIntersection
forall b a. (a -> b) -> Handler b a
H (\NoIntersection
NoIntersection -> NoIntersection
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection)
Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
NoIntersection
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]))
'[Point 2 r, Line 2 r]
-> Handlers
'[NoIntersection, Point 2 r, Line 2 r]
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Point 2 r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
-> Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
(Point 2 r)
forall b a. (a -> b) -> Handler b a
H (\Point 2 r
p -> if Point 2 r -> HalfLine 2 r -> Bool
forall r (d :: Nat).
(Ord r, Fractional r, Arity d) =>
Point d r -> HalfLine d r -> Bool
onHalfLine Point 2 r
p HalfLine 2 r
hl Bool -> Bool -> Bool
&& Point 2 r
p Point 2 r -> LineSegment 2 () r -> Bool
forall g h. IsIntersectableWith g h => g -> h -> Bool
`intersects` LineSegment 2 () r
seg then Point 2 r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec Point 2 r
p
else NoIntersection
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection
)
Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
(Point 2 r)
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]))
'[Line 2 r]
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () 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, Point 2 r, LineSegment 2 () r])
-> Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
(Line 2 r)
forall b a. (a -> b) -> Handler b a
H (\Line 2 r
_line -> case (Point 2 r
o Point 2 r -> LineSegment 2 () r -> Bool
forall g h. IsIntersectableWith g h => g -> h -> Bool
`intersects` LineSegment 2 () r
seg, Point 2 r -> HalfLine 2 r -> Bool
forall r (d :: Nat).
(Ord r, Fractional r, Arity d) =>
Point d r -> HalfLine d r -> Bool
onHalfLine (EndPoint (Point 2 r :+ ())
tEndPoint (Point 2 r :+ ())
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ ())) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ ()) -> Const (Point 2 r) (Point 2 r :+ ()))
-> EndPoint (Point 2 r :+ ())
-> Const (Point 2 r) (EndPoint (Point 2 r :+ ()))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point 2 r :+ ()) -> Const (Point 2 r) (Point 2 r :+ ()))
-> EndPoint (Point 2 r :+ ())
-> Const (Point 2 r) (EndPoint (Point 2 r :+ ())))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ ()) -> Const (Point 2 r) (Point 2 r :+ ()))
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ ())) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ ()) -> Const (Point 2 r) (Point 2 r :+ ())
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) HalfLine 2 r
hl) of
(Bool
False,Bool
False) -> NoIntersection
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection
(Bool
False,Bool
True) -> LineSegment 2 () r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec LineSegment 2 () r
seg
(Bool
True,Bool
True) -> LineSegment 2 () r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (LineSegment 2 () r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
-> LineSegment 2 () r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall a b. (a -> b) -> a -> b
$ EndPoint (Point 2 r :+ ())
-> EndPoint (Point 2 r :+ ()) -> LineSegment 2 () r
forall (d :: Nat) r p.
EndPoint (Point d r :+ p)
-> EndPoint (Point d r :+ p) -> LineSegment d p r
LineSegment ((Point 2 r :+ ()) -> EndPoint (Point 2 r :+ ())
forall a. a -> EndPoint a
Closed ((Point 2 r :+ ()) -> EndPoint (Point 2 r :+ ()))
-> (Point 2 r :+ ()) -> EndPoint (Point 2 r :+ ())
forall a b. (a -> b) -> a -> b
$ Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext Point 2 r
o) EndPoint (Point 2 r :+ ())
t
(Bool
True,Bool
False) -> LineSegment 2 () r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (LineSegment 2 () r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
-> LineSegment 2 () r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall a b. (a -> b) -> a -> b
$ EndPoint (Point 2 r :+ ())
-> EndPoint (Point 2 r :+ ()) -> LineSegment 2 () r
forall (d :: Nat) r p.
EndPoint (Point d r :+ p)
-> EndPoint (Point d r :+ p) -> LineSegment d p r
LineSegment EndPoint (Point 2 r :+ ())
s ((Point 2 r :+ ()) -> EndPoint (Point 2 r :+ ())
forall a. a -> EndPoint a
Closed ((Point 2 r :+ ()) -> EndPoint (Point 2 r :+ ()))
-> (Point 2 r :+ ()) -> EndPoint (Point 2 r :+ ())
forall a b. (a -> b) -> a -> b
$ Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext Point 2 r
o)
)
Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
(Line 2 r)
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]))
'[]
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () 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, Point 2 r, LineSegment 2 () r]))
'[]
forall u (a :: u -> *). Rec a '[]
RNil
instance (Ord r, Fractional r, Arity d) => Point d r `IsIntersectableWith` HalfLine d r where
nonEmptyIntersection :: proxy (Point d r)
-> proxy (HalfLine d r)
-> Intersection (Point d r) (HalfLine d r)
-> Bool
nonEmptyIntersection = proxy (Point d r)
-> proxy (HalfLine d r)
-> Intersection (Point d r) (HalfLine d r)
-> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection
intersects :: Point d r -> HalfLine d r -> Bool
intersects = Point d r -> HalfLine d r -> Bool
forall r (d :: Nat).
(Ord r, Fractional r, Arity d) =>
Point d r -> HalfLine d r -> Bool
onHalfLine
Point d r
p intersect :: Point d r
-> HalfLine d r -> Intersection (Point d r) (HalfLine d r)
`intersect` HalfLine d r
hl | Point d r
p Point d r -> HalfLine d r -> Bool
forall g h. IsIntersectableWith g h => g -> h -> Bool
`intersects` HalfLine d r
hl = Point d r -> CoRec Identity '[NoIntersection, Point d r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec Point d r
p
| Bool
otherwise = NoIntersection -> CoRec Identity '[NoIntersection, Point d r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection
type instance IntersectionOf (HalfLine 2 r) (Boundary (Rectangle p r)) =
[ NoIntersection, Point 2 r, (Point 2 r, Point 2 r) , LineSegment 2 () r]
type instance IntersectionOf (HalfLine 2 r) (Rectangle p r) = [ NoIntersection
, Point 2 r
, LineSegment 2 () r
]
instance (Ord r, Fractional r)
=> HalfLine 2 r `IsIntersectableWith` Boundary (Rectangle p r) where
nonEmptyIntersection :: proxy (HalfLine 2 r)
-> proxy (Boundary (Rectangle p r))
-> Intersection (HalfLine 2 r) (Boundary (Rectangle p r))
-> Bool
nonEmptyIntersection = proxy (HalfLine 2 r)
-> proxy (Boundary (Rectangle p r))
-> Intersection (HalfLine 2 r) (Boundary (Rectangle p r))
-> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection
hl :: HalfLine 2 r
hl@(HalfLine Point 2 r
o Vector 2 r
v) intersect :: HalfLine 2 r
-> Boundary (Rectangle p r)
-> Intersection (HalfLine 2 r) (Boundary (Rectangle p r))
`intersect` Boundary (Rectangle p r)
br = CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
-> Handlers
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
(CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r])
-> CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match (Point 2 r -> Vector 2 r -> Line 2 r
forall (d :: Nat) r. Point d r -> Vector d r -> Line d r
Line Point 2 r
o Vector 2 r
v Line 2 r
-> Boundary (Rectangle p r)
-> Intersection (Line 2 r) (Boundary (Rectangle p r))
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Boundary (Rectangle p r)
br) (Handlers
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
(CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r])
-> CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r])
-> Handlers
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
(CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r])
-> CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
forall a b. (a -> b) -> a -> b
$
(NoIntersection
-> CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r])
-> Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r])
NoIntersection
forall b a. (a -> b) -> Handler b a
H NoIntersection
-> CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec
Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r])
NoIntersection
-> Rec
(Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]))
'[Point 2 r, (Point 2 r, Point 2 r), LineSegment 2 () r]
-> Handlers
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
(CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r])
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Point 2 r
-> CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r])
-> Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r])
(Point 2 r)
forall b a. (a -> b) -> Handler b a
H (\Point 2 r
p -> if Point 2 r
p Point 2 r -> HalfLine 2 r -> Bool
forall g h. IsIntersectableWith g h => g -> h -> Bool
`intersects` HalfLine 2 r
hl then Point 2 r
-> CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec Point 2 r
p else NoIntersection
-> CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection)
Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r])
(Point 2 r)
-> Rec
(Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]))
'[(Point 2 r, Point 2 r), LineSegment 2 () r]
-> Rec
(Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]))
'[Point 2 r, (Point 2 r, Point 2 r), LineSegment 2 () r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& ((Point 2 r, Point 2 r)
-> CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r])
-> Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r])
(Point 2 r, Point 2 r)
forall b a. (a -> b) -> Handler b a
H (\(Point 2 r
p,Point 2 r
q) -> case (Point 2 r
p Point 2 r -> HalfLine 2 r -> Bool
forall g h. IsIntersectableWith g h => g -> h -> Bool
`intersects` HalfLine 2 r
hl, Point 2 r
q Point 2 r -> HalfLine 2 r -> Bool
forall g h. IsIntersectableWith g h => g -> h -> Bool
`intersects` HalfLine 2 r
hl) of
(Bool
False,Bool
False) -> NoIntersection
-> CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection
(Bool
False,Bool
True) -> Point 2 r
-> CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec Point 2 r
q
(Bool
True,Bool
False) -> Point 2 r
-> CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec Point 2 r
p
(Bool
True,Bool
True) -> (Point 2 r, Point 2 r)
-> CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (Point 2 r
p,Point 2 r
q))
Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r])
(Point 2 r, Point 2 r)
-> Rec
(Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]))
'[LineSegment 2 () r]
-> Rec
(Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]))
'[(Point 2 r, Point 2 r), LineSegment 2 () r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (LineSegment 2 () r
-> CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r])
-> Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r])
(LineSegment 2 () r)
forall b a. (a -> b) -> Handler b a
H (\s :: LineSegment 2 () r
s@(LineSegment' Point 2 r :+ ()
p Point 2 r :+ ()
q) -> case ((Point 2 r :+ ()
p(Point 2 r :+ ())
-> Getting (Point 2 r) (Point 2 r :+ ()) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ ()) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) Point 2 r -> HalfLine 2 r -> Bool
forall g h. IsIntersectableWith g h => g -> h -> Bool
`intersects` HalfLine 2 r
hl, (Point 2 r :+ ()
q(Point 2 r :+ ())
-> Getting (Point 2 r) (Point 2 r :+ ()) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) (Point 2 r :+ ()) (Point 2 r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) Point 2 r -> HalfLine 2 r -> Bool
forall g h. IsIntersectableWith g h => g -> h -> Bool
`intersects` HalfLine 2 r
hl) of
(Bool
False,Bool
False) -> NoIntersection
-> CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection
(Bool
False,Bool
True) -> LineSegment 2 () r
-> CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (LineSegment 2 () r
-> CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r])
-> LineSegment 2 () r
-> CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
forall a b. (a -> b) -> a -> b
$ (Point 2 r :+ ()) -> (Point 2 r :+ ()) -> LineSegment 2 () r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment (Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext Point 2 r
o) Point 2 r :+ ()
q
(Bool
True,Bool
False) -> LineSegment 2 () r
-> CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (LineSegment 2 () r
-> CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r])
-> LineSegment 2 () r
-> CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
forall a b. (a -> b) -> a -> b
$ (Point 2 r :+ ()) -> (Point 2 r :+ ()) -> LineSegment 2 () r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment (Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext Point 2 r
o) Point 2 r :+ ()
p
(Bool
True,Bool
True) -> LineSegment 2 () r
-> CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec LineSegment 2 () r
s)
Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r])
(LineSegment 2 () r)
-> Rec
(Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]))
'[]
-> Rec
(Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]))
'[LineSegment 2 () r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec
(Handler
(CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]))
'[]
forall u (a :: u -> *). Rec a '[]
RNil
instance (Ord r, Fractional r)
=> HalfLine 2 r `IsIntersectableWith` Rectangle p r where
nonEmptyIntersection :: proxy (HalfLine 2 r)
-> proxy (Rectangle p r)
-> Intersection (HalfLine 2 r) (Rectangle p r)
-> Bool
nonEmptyIntersection = proxy (HalfLine 2 r)
-> proxy (Rectangle p r)
-> Intersection (HalfLine 2 r) (Rectangle p r)
-> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection
hl :: HalfLine 2 r
hl@(HalfLine Point 2 r
o Vector 2 r
_) intersect :: HalfLine 2 r
-> Rectangle p r -> Intersection (HalfLine 2 r) (Rectangle p r)
`intersect` Rectangle p r
rect = CoRec
Identity
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
-> Handlers
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match (HalfLine 2 r
hl HalfLine 2 r
-> Boundary (Rectangle p r)
-> Intersection (HalfLine 2 r) (Boundary (Rectangle p r))
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Rectangle p r -> Boundary (Rectangle p r)
forall g. g -> Boundary g
Boundary Rectangle p r
rect) (Handlers
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
-> Handlers
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall a b. (a -> b) -> a -> b
$
(NoIntersection
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
-> Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
NoIntersection
forall b a. (a -> b) -> Handler b a
H NoIntersection
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec
Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
NoIntersection
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]))
'[Point 2 r, (Point 2 r, Point 2 r), LineSegment 2 () r]
-> Handlers
'[NoIntersection, Point 2 r, (Point 2 r, Point 2 r),
LineSegment 2 () r]
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Point 2 r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
-> Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
(Point 2 r)
forall b a. (a -> b) -> Handler b a
H (\Point 2 r
p -> if Point 2 r
o Point 2 r -> Rectangle p r -> Bool
forall (d :: Nat) r p.
(Arity d, Ord r) =>
Point d r -> Box d p r -> Bool
`insideBox` Rectangle p r
rect then LineSegment 2 () r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec ((Point 2 r :+ ()) -> (Point 2 r :+ ()) -> LineSegment 2 () r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment (Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext Point 2 r
o) (Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext Point 2 r
p))
else Point 2 r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec Point 2 r
p
)
Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
(Point 2 r)
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]))
'[(Point 2 r, Point 2 r), LineSegment 2 () r]
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]))
'[Point 2 r, (Point 2 r, Point 2 r), LineSegment 2 () r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& ((Point 2 r, Point 2 r)
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
-> Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
(Point 2 r, Point 2 r)
forall b a. (a -> b) -> Handler b a
H (\(Point 2 r
p,Point 2 r
q) -> LineSegment 2 () r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (LineSegment 2 () r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
-> LineSegment 2 () r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall a b. (a -> b) -> a -> b
$ (Point 2 r :+ ()) -> (Point 2 r :+ ()) -> LineSegment 2 () r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment (Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext Point 2 r
p) (Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext Point 2 r
q))
Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
(Point 2 r, Point 2 r)
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]))
'[LineSegment 2 () r]
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]))
'[(Point 2 r, Point 2 r), LineSegment 2 () r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (LineSegment 2 () r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
-> Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
(LineSegment 2 () r)
forall b a. (a -> b) -> Handler b a
H LineSegment 2 () r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec
Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r])
(LineSegment 2 () r)
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]))
'[]
-> Rec
(Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]))
'[LineSegment 2 () r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec
(Handler
(CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 () r]))
'[]
forall u (a :: u -> *). Rec a '[]
RNil
onHalfLine :: (Ord r, Fractional r, Arity d) => Point d r -> HalfLine d r -> Bool
Point d r
p onHalfLine :: Point d r -> HalfLine d r -> Bool
`onHalfLine` (HalfLine Point d r
q Vector d r
v) = Bool -> (r -> Bool) -> Maybe r -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (r -> r -> Bool
forall a. Ord a => a -> a -> Bool
>= r
0) (Maybe r -> Bool) -> Maybe r -> Bool
forall a b. (a -> b) -> a -> b
$ Vector d r -> Vector d r -> Maybe r
forall r (d :: Nat).
(Eq r, Fractional r, Arity d) =>
Vector d r -> Vector d r -> Maybe r
scalarMultiple (Point d r
p Point d r -> Point d r -> Diff (Point d) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point d r
q) Vector d r
v
toHalfLine :: (Num r, Arity d) => LineSegment d p r -> HalfLine d r
toHalfLine :: LineSegment d p r -> HalfLine d r
toHalfLine LineSegment d p r
s = let p :: Point d r
p = LineSegment d p r
sLineSegment d p r
-> Getting (Point d r) (LineSegment d p r) (Point d r) -> Point d r
forall s a. s -> Getting a s a -> a
^.((Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> LineSegment d p r -> Const (Point d r) (LineSegment d p r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> LineSegment d p r -> Const (Point d r) (LineSegment d p r))
-> ((Point d r -> Const (Point d r) (Point d r))
-> (Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> Getting (Point d r) (LineSegment d p r) (Point d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point d r -> Const (Point d r) (Point d r))
-> (Point d r :+ p) -> Const (Point d r) (Point d r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core
q :: Point d r
q = LineSegment d p r
sLineSegment d p r
-> Getting (Point d r) (LineSegment d p r) (Point d r) -> Point d r
forall s a. s -> Getting a s a -> a
^.((Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> LineSegment d p r -> Const (Point d r) (LineSegment d p r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> LineSegment d p r -> Const (Point d r) (LineSegment d p r))
-> ((Point d r -> Const (Point d r) (Point d r))
-> (Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> Getting (Point d r) (LineSegment d p r) (Point d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point d r -> Const (Point d r) (Point d r))
-> (Point d r :+ p) -> Const (Point d r) (Point d r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core
in Point d r -> Vector d r -> HalfLine d r
forall (d :: Nat) r. Point d r -> Vector d r -> HalfLine d r
HalfLine Point d r
p (Point d r
q Point d r -> Point d r -> Diff (Point d) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point d r
p)