{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module HGeometry.LineSegment.Intersection
  ( LineLineSegmentIntersection(..)
  , LineSegmentLineSegmentIntersection(..)
  , HalfLineLineSegmentIntersection(..)
  -- , spansIntersect
  , compareColinearInterval

  , ClosedSegmentHalfSpaceIntersection(..)
  ) where

import Control.Lens
import GHC.Generics (Generic)
import HGeometry.Box.Intersection ()
import HGeometry.Ext
import HGeometry.HalfLine
import HGeometry.HalfSpace
import HGeometry.HyperPlane.Class
import HGeometry.Intersection
import HGeometry.Interval
import HGeometry.Line
import HGeometry.LineSegment.Internal
import HGeometry.Point
import HGeometry.Point.Either
import HGeometry.Properties (NumType, Dimension)

--------------------------------------------------------------------------------
-- * Line x LineSegment Intersection

-- | Line x LineSegment intersection
data LineLineSegmentIntersection lineSegment =
    Line_x_LineSegment_Point       (Point 2 (NumType lineSegment))
  | Line_x_LineSegment_LineSegment lineSegment

deriving instance (Show (Point 2 (NumType lineSegment)), Show lineSegment
                  ) => Show (LineLineSegmentIntersection lineSegment)
deriving instance (Eq (Point 2 (NumType lineSegment)), Eq lineSegment
                  ) => Eq (LineLineSegmentIntersection lineSegment)

type Intersection' lineSegment = Maybe (LineLineSegmentIntersection lineSegment)

type instance Intersection (LinePV 2 r) (LineSegment (EndPoint t) point) =
  Intersection' (LineSegment (EndPoint t) point)

type instance Intersection (LineEQ r) (LineSegment (EndPoint t) point) =
  Intersection' (LineSegment (EndPoint t) point)

type instance Intersection (LinePV 2 r) (LineSegment AnEndPoint point) =
  Intersection' (LineSegment AnEndPoint point)

type instance Intersection (LineEQ r) (LineSegment AnEndPoint point) =
  Intersection' (LineSegment AnEndPoint point)

----------------------------------------
-- * HasIntersectionWith

instance ( Point_ point 2 r, Num r, Ord r
         , IxValue (endPoint point) ~ point
         , EndPoint_ (endPoint point)
         ) => LinePV 2 r `HasIntersectionWith` LineSegment endPoint point where
  intersects :: LinePV 2 r -> LineSegment endPoint point -> Bool
intersects = LinePV 2 r -> LineSegment endPoint point -> Bool
forall line r point lineSegment.
(HyperPlane_ line 2 r, Point_ point 2 r, Num r, Ord r,
 LineSegment_ lineSegment point) =>
line -> lineSegment -> Bool
intersectsImpl
  {-# INLINE intersects #-}

instance ( Point_ point 2 r, Num r, Ord r
         , IxValue (endPoint point) ~ point
         , EndPoint_ (endPoint point)
         ) => LineEQ r `HasIntersectionWith` LineSegment endPoint point where
  --
  -- >>> LineEQ 1 2 `intersects` ClosedLineSegment origin (Point2 1 10)
  -- True
  intersects :: LineEQ r -> LineSegment endPoint point -> Bool
intersects = LineEQ r -> LineSegment endPoint point -> Bool
forall line r point lineSegment.
(HyperPlane_ line 2 r, Point_ point 2 r, Num r, Ord r,
 LineSegment_ lineSegment point) =>
line -> lineSegment -> Bool
intersectsImpl
  {-# INLINE intersects #-}

-- | Test whether a line in R^2 intersects a closed linesegment
intersectsImpl       :: ( HyperPlane_ line 2 r
                        , Point_ point 2 r
                        , Num r, Ord r
                        , LineSegment_ lineSegment point
                        ) => line -> lineSegment -> Bool
line
l intersectsImpl :: forall line r point lineSegment.
(HyperPlane_ line 2 r, Point_ point 2 r, Num r, Ord r,
 LineSegment_ lineSegment point) =>
line -> lineSegment -> Bool
`intersectsImpl` lineSegment
s = case (point -> line -> Ordering
forall point.
(Point_ point 2 r, Ord r, Num r) =>
point -> line -> Ordering
forall hyperPlane (d :: Nat) r point.
(HyperPlane_ hyperPlane d r, Point_ point d r, Ord r, Num r) =>
point -> hyperPlane -> Ordering
onSideTest (lineSegment
slineSegment -> Getting point lineSegment point -> point
forall s a. s -> Getting a s a -> a
^.Getting point lineSegment point
forall seg p. HasStart seg p => Lens' seg p
Lens' lineSegment point
start) line
l, point -> line -> Ordering
forall point.
(Point_ point 2 r, Ord r, Num r) =>
point -> line -> Ordering
forall hyperPlane (d :: Nat) r point.
(HyperPlane_ hyperPlane d r, Point_ point d r, Ord r, Num r) =>
point -> hyperPlane -> Ordering
onSideTest (lineSegment
slineSegment -> Getting point lineSegment point -> point
forall s a. s -> Getting a s a -> a
^.Getting point lineSegment point
forall seg p. HasEnd seg p => Lens' seg p
Lens' lineSegment point
end) line
l) of
                         (Ordering
LT, Ordering
LT) -> Bool
False
                         (Ordering
LT, Ordering
EQ) -> lineSegment
slineSegment
-> Getting EndPointType lineSegment EndPointType -> EndPointType
forall s a. s -> Getting a s a -> a
^.(EndPointOf lineSegment
 -> Const EndPointType (EndPointOf lineSegment))
-> lineSegment -> Const EndPointType lineSegment
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' lineSegment (EndPointOf lineSegment)
endPoint((EndPointOf lineSegment
  -> Const EndPointType (EndPointOf lineSegment))
 -> lineSegment -> Const EndPointType lineSegment)
-> ((EndPointType -> Const EndPointType EndPointType)
    -> EndPointOf lineSegment
    -> Const EndPointType (EndPointOf lineSegment))
-> Getting EndPointType lineSegment EndPointType
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EndPointOf lineSegment -> EndPointType)
-> (EndPointType -> Const EndPointType EndPointType)
-> EndPointOf lineSegment
-> Const EndPointType (EndPointOf lineSegment)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to EndPointOf lineSegment -> EndPointType
forall endPoint. EndPoint_ endPoint => endPoint -> EndPointType
endPointType EndPointType -> EndPointType -> Bool
forall a. Eq a => a -> a -> Bool
== EndPointType
Closed
                         (Ordering
LT, Ordering
GT) -> Bool
True
                         (Ordering
EQ, Ordering
EQ) -> Bool
True
                         (Ordering
EQ, Ordering
_)  -> lineSegment
slineSegment
-> Getting EndPointType lineSegment EndPointType -> EndPointType
forall s a. s -> Getting a s a -> a
^.(StartPointOf lineSegment
 -> Const EndPointType (StartPointOf lineSegment))
-> lineSegment -> Const EndPointType lineSegment
forall seg p. HasStartPoint seg p => Lens' seg p
Lens' lineSegment (StartPointOf lineSegment)
startPoint((StartPointOf lineSegment
  -> Const EndPointType (StartPointOf lineSegment))
 -> lineSegment -> Const EndPointType lineSegment)
-> ((EndPointType -> Const EndPointType EndPointType)
    -> StartPointOf lineSegment
    -> Const EndPointType (StartPointOf lineSegment))
-> Getting EndPointType lineSegment EndPointType
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(StartPointOf lineSegment -> EndPointType)
-> (EndPointType -> Const EndPointType EndPointType)
-> StartPointOf lineSegment
-> Const EndPointType (StartPointOf lineSegment)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to StartPointOf lineSegment -> EndPointType
forall endPoint. EndPoint_ endPoint => endPoint -> EndPointType
endPointType EndPointType -> EndPointType -> Bool
forall a. Eq a => a -> a -> Bool
== EndPointType
Closed
                         (Ordering
GT, Ordering
LT) -> Bool
True
                         (Ordering
GT, Ordering
EQ) -> lineSegment
slineSegment
-> Getting EndPointType lineSegment EndPointType -> EndPointType
forall s a. s -> Getting a s a -> a
^.(EndPointOf lineSegment
 -> Const EndPointType (EndPointOf lineSegment))
-> lineSegment -> Const EndPointType lineSegment
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' lineSegment (EndPointOf lineSegment)
endPoint((EndPointOf lineSegment
  -> Const EndPointType (EndPointOf lineSegment))
 -> lineSegment -> Const EndPointType lineSegment)
-> ((EndPointType -> Const EndPointType EndPointType)
    -> EndPointOf lineSegment
    -> Const EndPointType (EndPointOf lineSegment))
-> Getting EndPointType lineSegment EndPointType
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(EndPointOf lineSegment -> EndPointType)
-> (EndPointType -> Const EndPointType EndPointType)
-> EndPointOf lineSegment
-> Const EndPointType (EndPointOf lineSegment)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to EndPointOf lineSegment -> EndPointType
forall endPoint. EndPoint_ endPoint => endPoint -> EndPointType
endPointType EndPointType -> EndPointType -> Bool
forall a. Eq a => a -> a -> Bool
== EndPointType
Closed
                         (Ordering
GT, Ordering
GT) -> Bool
False
{-# INLINE intersectsImpl #-}


----------------------------------------
-- * IsIntersectableWith

instance ( Point_ point 2 r
         , Fractional r,  Ord r
         ) => LinePV 2 r `IsIntersectableWith` ClosedLineSegment point where
  intersect :: LinePV 2 r
-> ClosedLineSegment point
-> Intersection (LinePV 2 r) (ClosedLineSegment point)
intersect = LinePV 2 r
-> ClosedLineSegment point
-> Maybe (LineLineSegmentIntersection (ClosedLineSegment point))
LinePV 2 r
-> ClosedLineSegment point
-> Intersection (LinePV 2 r) (ClosedLineSegment point)
forall line r point lineSegment.
(HyperPlane_ line 2 r, Point_ point 2 r, Fractional r, Ord r,
 LineSegment_ lineSegment point, HasSupportingLine lineSegment,
 HasOnSegment lineSegment 2, IsIntersectableWith line (LinePV 2 r),
 HasIntersectionWith line lineSegment,
 Intersection line (LinePV 2 r)
 ~ Maybe (LineLineIntersection line)) =>
line
-> lineSegment -> Maybe (LineLineSegmentIntersection lineSegment)
intersectImpl
  {-# INLINE intersect #-}

instance ( Point_ point 2 r
         , Fractional r,  Ord r
         ) => LineEQ r `IsIntersectableWith` ClosedLineSegment point where
  intersect :: LineEQ r
-> ClosedLineSegment point
-> Intersection (LineEQ r) (ClosedLineSegment point)
intersect = LineEQ r
-> ClosedLineSegment point
-> Maybe (LineLineSegmentIntersection (ClosedLineSegment point))
LineEQ r
-> ClosedLineSegment point
-> Intersection (LineEQ r) (ClosedLineSegment point)
forall line r point lineSegment.
(HyperPlane_ line 2 r, Point_ point 2 r, Fractional r, Ord r,
 LineSegment_ lineSegment point, HasSupportingLine lineSegment,
 HasOnSegment lineSegment 2, IsIntersectableWith line (LinePV 2 r),
 HasIntersectionWith line lineSegment,
 Intersection line (LinePV 2 r)
 ~ Maybe (LineLineIntersection line)) =>
line
-> lineSegment -> Maybe (LineLineSegmentIntersection lineSegment)
intersectImpl
  {-# INLINE intersect #-}

instance ( Point_ point 2 r
         , Fractional r,  Ord r
         ) => LinePV 2 r `IsIntersectableWith` LineSegment AnEndPoint point where
  intersect :: LinePV 2 r
-> LineSegment AnEndPoint point
-> Intersection (LinePV 2 r) (LineSegment AnEndPoint point)
intersect = LinePV 2 r
-> LineSegment AnEndPoint point
-> Maybe
     (LineLineSegmentIntersection (LineSegment AnEndPoint point))
LinePV 2 r
-> LineSegment AnEndPoint point
-> Intersection (LinePV 2 r) (LineSegment AnEndPoint point)
forall line r point lineSegment.
(HyperPlane_ line 2 r, Point_ point 2 r, Fractional r, Ord r,
 LineSegment_ lineSegment point, HasSupportingLine lineSegment,
 HasOnSegment lineSegment 2, IsIntersectableWith line (LinePV 2 r),
 HasIntersectionWith line lineSegment,
 Intersection line (LinePV 2 r)
 ~ Maybe (LineLineIntersection line)) =>
line
-> lineSegment -> Maybe (LineLineSegmentIntersection lineSegment)
intersectImpl
  {-# INLINE intersect #-}

instance ( Point_ point 2 r
         , Fractional r,  Ord r
         ) => LineEQ r `IsIntersectableWith` LineSegment AnEndPoint point where
  intersect :: LineEQ r
-> LineSegment AnEndPoint point
-> Intersection (LineEQ r) (LineSegment AnEndPoint point)
intersect = LineEQ r
-> LineSegment AnEndPoint point
-> Maybe
     (LineLineSegmentIntersection (LineSegment AnEndPoint point))
LineEQ r
-> LineSegment AnEndPoint point
-> Intersection (LineEQ r) (LineSegment AnEndPoint point)
forall line r point lineSegment.
(HyperPlane_ line 2 r, Point_ point 2 r, Fractional r, Ord r,
 LineSegment_ lineSegment point, HasSupportingLine lineSegment,
 HasOnSegment lineSegment 2, IsIntersectableWith line (LinePV 2 r),
 HasIntersectionWith line lineSegment,
 Intersection line (LinePV 2 r)
 ~ Maybe (LineLineIntersection line)) =>
line
-> lineSegment -> Maybe (LineLineSegmentIntersection lineSegment)
intersectImpl
  {-# INLINE intersect #-}

instance ( Point_ point 2 r
         , Fractional r,  Ord r
         ) => LinePV 2 r `IsIntersectableWith` OpenLineSegment point where
  intersect :: LinePV 2 r
-> OpenLineSegment point
-> Intersection (LinePV 2 r) (OpenLineSegment point)
intersect = LinePV 2 r
-> OpenLineSegment point
-> Maybe (LineLineSegmentIntersection (OpenLineSegment point))
LinePV 2 r
-> OpenLineSegment point
-> Intersection (LinePV 2 r) (OpenLineSegment point)
forall line r point lineSegment.
(HyperPlane_ line 2 r, Point_ point 2 r, Fractional r, Ord r,
 LineSegment_ lineSegment point, HasSupportingLine lineSegment,
 HasOnSegment lineSegment 2, IsIntersectableWith line (LinePV 2 r),
 HasIntersectionWith line lineSegment,
 Intersection line (LinePV 2 r)
 ~ Maybe (LineLineIntersection line)) =>
line
-> lineSegment -> Maybe (LineLineSegmentIntersection lineSegment)
intersectImpl
  {-# INLINE intersect #-}

instance ( Point_ point 2 r
         , Fractional r,  Ord r
         ) => LineEQ r `IsIntersectableWith` OpenLineSegment point where
  intersect :: LineEQ r
-> OpenLineSegment point
-> Intersection (LineEQ r) (OpenLineSegment point)
intersect = LineEQ r
-> OpenLineSegment point
-> Maybe (LineLineSegmentIntersection (OpenLineSegment point))
LineEQ r
-> OpenLineSegment point
-> Intersection (LineEQ r) (OpenLineSegment point)
forall line r point lineSegment.
(HyperPlane_ line 2 r, Point_ point 2 r, Fractional r, Ord r,
 LineSegment_ lineSegment point, HasSupportingLine lineSegment,
 HasOnSegment lineSegment 2, IsIntersectableWith line (LinePV 2 r),
 HasIntersectionWith line lineSegment,
 Intersection line (LinePV 2 r)
 ~ Maybe (LineLineIntersection line)) =>
line
-> lineSegment -> Maybe (LineLineSegmentIntersection lineSegment)
intersectImpl
  {-# INLINE intersect #-}


-- | Implementation for intersects between lines and line segments.
--
-- the type is is sufficiently general that for various line or closed line segment types
-- we can appeal to it.
intersectImpl       :: ( HyperPlane_ line 2 r
                       , Point_ point 2 r
                       , Fractional r, Ord r
                       , LineSegment_ lineSegment point
                       , HasSupportingLine lineSegment
                       , HasOnSegment lineSegment 2
                       , line `IsIntersectableWith` LinePV 2 r
                       , line `HasIntersectionWith` lineSegment
                       , Intersection line (LinePV 2 r) ~ Maybe (LineLineIntersection line)
                       ) => line -> lineSegment
                    -> Maybe (LineLineSegmentIntersection lineSegment)
line
l intersectImpl :: forall line r point lineSegment.
(HyperPlane_ line 2 r, Point_ point 2 r, Fractional r, Ord r,
 LineSegment_ lineSegment point, HasSupportingLine lineSegment,
 HasOnSegment lineSegment 2, IsIntersectableWith line (LinePV 2 r),
 HasIntersectionWith line lineSegment,
 Intersection line (LinePV 2 r)
 ~ Maybe (LineLineIntersection line)) =>
line
-> lineSegment -> Maybe (LineLineSegmentIntersection lineSegment)
`intersectImpl` lineSegment
s = line
l line -> LinePV 2 r -> Intersection line (LinePV 2 r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` lineSegment -> LinePV (Dimension lineSegment) (NumType lineSegment)
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine lineSegment
s Maybe (LineLineIntersectionG r line)
-> (LineLineIntersectionG r line
    -> Maybe (LineLineSegmentIntersection lineSegment))
-> Maybe (LineLineSegmentIntersection lineSegment)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Line_x_Line_Point Point 2 r
p
      | Point 2 r
p Point 2 r -> lineSegment -> Bool
forall point r point' lineSegment.
(Point_ point 2 r, Point_ point' 2 r, Ord r, Num r,
 LineSegment_ lineSegment point') =>
point -> lineSegment -> Bool
`inPerpendicularSlab` lineSegment
s -> LineLineSegmentIntersection lineSegment
-> Maybe (LineLineSegmentIntersection lineSegment)
forall a. a -> Maybe a
Just (LineLineSegmentIntersection lineSegment
 -> Maybe (LineLineSegmentIntersection lineSegment))
-> LineLineSegmentIntersection lineSegment
-> Maybe (LineLineSegmentIntersection lineSegment)
forall a b. (a -> b) -> a -> b
$ Point 2 (NumType lineSegment)
-> LineLineSegmentIntersection lineSegment
forall lineSegment.
Point 2 (NumType lineSegment)
-> LineLineSegmentIntersection lineSegment
Line_x_LineSegment_Point Point 2 r
Point 2 (NumType lineSegment)
p
      | Bool
otherwise                 -> Maybe (LineLineSegmentIntersection lineSegment)
forall a. Maybe a
Nothing
    Line_x_Line_Line line
_            -> LineLineSegmentIntersection lineSegment
-> Maybe (LineLineSegmentIntersection lineSegment)
forall a. a -> Maybe a
Just (LineLineSegmentIntersection lineSegment
 -> Maybe (LineLineSegmentIntersection lineSegment))
-> LineLineSegmentIntersection lineSegment
-> Maybe (LineLineSegmentIntersection lineSegment)
forall a b. (a -> b) -> a -> b
$ lineSegment -> LineLineSegmentIntersection lineSegment
forall lineSegment.
lineSegment -> LineLineSegmentIntersection lineSegment
Line_x_LineSegment_LineSegment lineSegment
s
    -- Note that a point p that lies (i) on the supporting line of s,
    -- and (ii) in the slab perpendicular to s must lie *on* s itself.
{-# INLINE intersectImpl #-}


--------------------------------------------------------------------------------
-- * LineSegment x LineSegment

-- | LineSegment x LineSegment intersection
data LineSegmentLineSegmentIntersection lineSegment =
    LineSegment_x_LineSegment_Point       (Point 2 (NumType lineSegment))
  | LineSegment_x_LineSegment_LineSegment lineSegment

deriving instance (Show (Point 2 (NumType lineSegment)), Show lineSegment
                  ) => Show (LineSegmentLineSegmentIntersection lineSegment)
deriving instance (Eq (Point 2 (NumType lineSegment)), Eq lineSegment
                  ) => Eq (LineSegmentLineSegmentIntersection lineSegment)

type instance Intersection (LineSegment (EndPoint t) point)
                           (LineSegment (EndPoint t) point) =
  Maybe (LineSegmentLineSegmentIntersection (LineSegment (EndPoint t) point))

type instance Intersection (LineSegment AnEndPoint point)
                           (LineSegment AnEndPoint point) =
  Maybe (LineSegmentLineSegmentIntersection (LineSegment AnEndPoint point))


-- | fmap' for lineSegmentIntersections
fmap'   :: (NumType lineSegment ~ NumType lineSegment')
        => (lineSegment -> lineSegment')
        -> LineSegmentLineSegmentIntersection lineSegment
        -> LineSegmentLineSegmentIntersection lineSegment'
fmap' :: forall lineSegment lineSegment'.
(NumType lineSegment ~ NumType lineSegment') =>
(lineSegment -> lineSegment')
-> LineSegmentLineSegmentIntersection lineSegment
-> LineSegmentLineSegmentIntersection lineSegment'
fmap' lineSegment -> lineSegment'
f = \case
  LineSegment_x_LineSegment_Point Point 2 (NumType lineSegment)
p       -> Point 2 (NumType lineSegment')
-> LineSegmentLineSegmentIntersection lineSegment'
forall lineSegment.
Point 2 (NumType lineSegment)
-> LineSegmentLineSegmentIntersection lineSegment
LineSegment_x_LineSegment_Point Point 2 (NumType lineSegment)
Point 2 (NumType lineSegment')
p
  LineSegment_x_LineSegment_LineSegment lineSegment
s -> lineSegment' -> LineSegmentLineSegmentIntersection lineSegment'
forall lineSegment.
lineSegment -> LineSegmentLineSegmentIntersection lineSegment
LineSegment_x_LineSegment_LineSegment (lineSegment -> lineSegment'
f lineSegment
s)

----------------------------------------
-- * HasIntersectionWith

-- | Test if the spans (i.e. the projections onto the x-axis and on the yaxis) of the
-- segments intersect
spansIntersect      :: forall endPoint endPoint' point point' r.
                       ( Point_ point 2 r, Point_ point' 2 r
                       , Ord r, Num r, Functor endPoint, Functor endPoint'
                       , IxValue (endPoint point) ~ point
                       , EndPoint_ (endPoint point)
                       , IxValue (endPoint' point') ~ point'
                       , EndPoint_ (endPoint' point')
                       , HasIntersectionWith (Interval endPoint r) (Interval endPoint' r)
                       )
                    => LineSegment endPoint point -> LineSegment endPoint' point' -> Bool
spansIntersect :: forall (endPoint :: * -> *) (endPoint' :: * -> *) point point' r.
(Point_ point 2 r, Point_ point' 2 r, Ord r, Num r,
 Functor endPoint, Functor endPoint',
 IxValue (endPoint point) ~ point, EndPoint_ (endPoint point),
 IxValue (endPoint' point') ~ point', EndPoint_ (endPoint' point'),
 HasIntersectionWith
   (Interval endPoint r) (Interval endPoint' r)) =>
LineSegment endPoint point -> LineSegment endPoint' point' -> Bool
spansIntersect LineSegment endPoint point
s LineSegment endPoint' point'
s' = (forall aPoint. Point_ aPoint 2 r => Getter aPoint r) -> Bool
f (r -> f r) -> aPoint -> f aPoint
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
forall aPoint. Point_ aPoint 2 r => Getter aPoint r
IndexedLens' Int aPoint r
xCoord Bool -> Bool -> Bool
&& (forall aPoint. Point_ aPoint 2 r => Getter aPoint r) -> Bool
f (r -> f r) -> aPoint -> f aPoint
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
forall aPoint. Point_ aPoint 2 r => Getter aPoint r
IndexedLens' Int aPoint r
yCoord
  where
    f         :: (forall aPoint. Point_ aPoint 2 r => Getter aPoint r) -> Bool
    f :: (forall aPoint. Point_ aPoint 2 r => Getter aPoint r) -> Bool
f forall aPoint. Point_ aPoint 2 r => Getter aPoint r
coord'' = Getter point r
-> LineSegment endPoint point -> Interval AnEndPoint r
forall point (d :: Nat) r (endPoint :: * -> *).
(Point_ point d r, Ord r, IxValue (endPoint point) ~ point,
 EndPoint_ (endPoint point)) =>
Getter point r
-> LineSegment endPoint point -> Interval AnEndPoint r
spanIn (r -> f r) -> point -> f point
forall aPoint. Point_ aPoint 2 r => Getter aPoint r
Getter point r
coord'' LineSegment endPoint point
s Interval AnEndPoint r -> Interval AnEndPoint r -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` Getter point' r
-> LineSegment endPoint' point' -> Interval AnEndPoint r
forall point (d :: Nat) r (endPoint :: * -> *).
(Point_ point d r, Ord r, IxValue (endPoint point) ~ point,
 EndPoint_ (endPoint point)) =>
Getter point r
-> LineSegment endPoint point -> Interval AnEndPoint r
spanIn (r -> f r) -> point' -> f point'
forall aPoint. Point_ aPoint 2 r => Getter aPoint r
Getter point' r
coord'' LineSegment endPoint' point'
s'

instance ( Point_ point 2 r, Point_ point' 2 r, Num r,  Ord r
         , Functor endPoint
         , IxValue (endPoint point) ~ point, EndPoint_ (endPoint point)
         , IxValue (endPoint point') ~ point', EndPoint_ (endPoint point')
         , IxValue (endPoint r) ~ r, EndPoint_ (endPoint r)
         , HasIntersectionWith (Interval endPoint r) (Interval endPoint r)
         ) =>
         LineSegment endPoint point `HasIntersectionWith` LineSegment endPoint point' where
  LineSegment endPoint point
s `intersects `LineSegment endPoint point'
s' = LineSegment endPoint point
-> LinePV
     (Dimension (LineSegment endPoint point))
     (NumType (LineSegment endPoint point))
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine LineSegment endPoint point
s LinePV 2 r -> LineSegment endPoint point' -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` LineSegment endPoint point'
s' Bool -> Bool -> Bool
&& LineSegment endPoint point'
-> LinePV
     (Dimension (LineSegment endPoint point'))
     (NumType (LineSegment endPoint point'))
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine LineSegment endPoint point'
s' LinePV 2 r -> LineSegment endPoint point -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` LineSegment endPoint point
s
                      Bool -> Bool -> Bool
&& LineSegment endPoint point -> LineSegment endPoint point' -> Bool
forall (endPoint :: * -> *) (endPoint' :: * -> *) point point' r.
(Point_ point 2 r, Point_ point' 2 r, Ord r, Num r,
 Functor endPoint, Functor endPoint',
 IxValue (endPoint point) ~ point, EndPoint_ (endPoint point),
 IxValue (endPoint' point') ~ point', EndPoint_ (endPoint' point'),
 HasIntersectionWith
   (Interval endPoint r) (Interval endPoint' r)) =>
LineSegment endPoint point -> LineSegment endPoint' point' -> Bool
spansIntersect LineSegment endPoint point
s LineSegment endPoint point'
s'
  {-# INLINE intersects #-}

instance ( Point_ point 2 r, Point_ point' 2 r, Num r,  Ord r
         ) =>
         LineSegment AnEndPoint point `HasIntersectionWith` ClosedLineSegment point' where
  LineSegment AnEndPoint point
s `intersects `ClosedLineSegment point'
s' = LineSegment AnEndPoint point
-> LinePV
     (Dimension (LineSegment AnEndPoint point))
     (NumType (LineSegment AnEndPoint point))
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine LineSegment AnEndPoint point
s LinePV 2 r -> ClosedLineSegment point' -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` ClosedLineSegment point'
s' Bool -> Bool -> Bool
&& ClosedLineSegment point'
-> LinePV
     (Dimension (ClosedLineSegment point'))
     (NumType (ClosedLineSegment point'))
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine ClosedLineSegment point'
s' LinePV 2 r -> LineSegment AnEndPoint point -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` LineSegment AnEndPoint point
s
                      Bool -> Bool -> Bool
&& LineSegment AnEndPoint point -> ClosedLineSegment point' -> Bool
forall (endPoint :: * -> *) (endPoint' :: * -> *) point point' r.
(Point_ point 2 r, Point_ point' 2 r, Ord r, Num r,
 Functor endPoint, Functor endPoint',
 IxValue (endPoint point) ~ point, EndPoint_ (endPoint point),
 IxValue (endPoint' point') ~ point', EndPoint_ (endPoint' point'),
 HasIntersectionWith
   (Interval endPoint r) (Interval endPoint' r)) =>
LineSegment endPoint point -> LineSegment endPoint' point' -> Bool
spansIntersect LineSegment AnEndPoint point
s ClosedLineSegment point'
s'
  {-# INLINE intersects #-}

instance ( Point_ point 2 r, Point_ point' 2 r, Num r,  Ord r
         ) =>
         LineSegment AnEndPoint point `HasIntersectionWith` OpenLineSegment point' where
  LineSegment AnEndPoint point
s `intersects `OpenLineSegment point'
s' = LineSegment AnEndPoint point
-> LinePV
     (Dimension (LineSegment AnEndPoint point))
     (NumType (LineSegment AnEndPoint point))
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine LineSegment AnEndPoint point
s LinePV 2 r -> OpenLineSegment point' -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` OpenLineSegment point'
s' Bool -> Bool -> Bool
&& OpenLineSegment point'
-> LinePV
     (Dimension (OpenLineSegment point'))
     (NumType (OpenLineSegment point'))
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine OpenLineSegment point'
s' LinePV 2 r -> LineSegment AnEndPoint point -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` LineSegment AnEndPoint point
s
                      Bool -> Bool -> Bool
&& LineSegment AnEndPoint point -> OpenLineSegment point' -> Bool
forall (endPoint :: * -> *) (endPoint' :: * -> *) point point' r.
(Point_ point 2 r, Point_ point' 2 r, Ord r, Num r,
 Functor endPoint, Functor endPoint',
 IxValue (endPoint point) ~ point, EndPoint_ (endPoint point),
 IxValue (endPoint' point') ~ point', EndPoint_ (endPoint' point'),
 HasIntersectionWith
   (Interval endPoint r) (Interval endPoint' r)) =>
LineSegment endPoint point -> LineSegment endPoint' point' -> Bool
spansIntersect LineSegment AnEndPoint point
s OpenLineSegment point'
s'
  {-# INLINE intersects #-}

instance ( Point_ point 2 r, Point_ point' 2 r, Num r,  Ord r
         ) =>
         ClosedLineSegment point `HasIntersectionWith` LineSegment AnEndPoint point' where
  ClosedLineSegment point
s `intersects `LineSegment AnEndPoint point'
s' = ClosedLineSegment point
-> LinePV
     (Dimension (ClosedLineSegment point))
     (NumType (ClosedLineSegment point))
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine ClosedLineSegment point
s LinePV 2 r -> LineSegment AnEndPoint point' -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` LineSegment AnEndPoint point'
s' Bool -> Bool -> Bool
&& LineSegment AnEndPoint point'
-> LinePV
     (Dimension (LineSegment AnEndPoint point'))
     (NumType (LineSegment AnEndPoint point'))
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine LineSegment AnEndPoint point'
s' LinePV 2 r -> ClosedLineSegment point -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` ClosedLineSegment point
s
                      Bool -> Bool -> Bool
&& ClosedLineSegment point -> LineSegment AnEndPoint point' -> Bool
forall (endPoint :: * -> *) (endPoint' :: * -> *) point point' r.
(Point_ point 2 r, Point_ point' 2 r, Ord r, Num r,
 Functor endPoint, Functor endPoint',
 IxValue (endPoint point) ~ point, EndPoint_ (endPoint point),
 IxValue (endPoint' point') ~ point', EndPoint_ (endPoint' point'),
 HasIntersectionWith
   (Interval endPoint r) (Interval endPoint' r)) =>
LineSegment endPoint point -> LineSegment endPoint' point' -> Bool
spansIntersect ClosedLineSegment point
s LineSegment AnEndPoint point'
s'
  {-# INLINE intersects #-}

instance ( Point_ point 2 r, Point_ point' 2 r, Num r,  Ord r
         ) =>
         ClosedLineSegment point `HasIntersectionWith` OpenLineSegment point' where
  ClosedLineSegment point
s `intersects `OpenLineSegment point'
s' = ClosedLineSegment point
-> LinePV
     (Dimension (ClosedLineSegment point))
     (NumType (ClosedLineSegment point))
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine ClosedLineSegment point
s LinePV 2 r -> OpenLineSegment point' -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` OpenLineSegment point'
s' Bool -> Bool -> Bool
&& OpenLineSegment point'
-> LinePV
     (Dimension (OpenLineSegment point'))
     (NumType (OpenLineSegment point'))
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine OpenLineSegment point'
s' LinePV 2 r -> ClosedLineSegment point -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` ClosedLineSegment point
s
                      Bool -> Bool -> Bool
&& ClosedLineSegment point -> OpenLineSegment point' -> Bool
forall (endPoint :: * -> *) (endPoint' :: * -> *) point point' r.
(Point_ point 2 r, Point_ point' 2 r, Ord r, Num r,
 Functor endPoint, Functor endPoint',
 IxValue (endPoint point) ~ point, EndPoint_ (endPoint point),
 IxValue (endPoint' point') ~ point', EndPoint_ (endPoint' point'),
 HasIntersectionWith
   (Interval endPoint r) (Interval endPoint' r)) =>
LineSegment endPoint point -> LineSegment endPoint' point' -> Bool
spansIntersect ClosedLineSegment point
s OpenLineSegment point'
s'
  {-# INLINE intersects #-}

instance ( Point_ point 2 r, Point_ point' 2 r, Num r,  Ord r
         ) =>
         OpenLineSegment point `HasIntersectionWith` LineSegment AnEndPoint point' where
  OpenLineSegment point
s `intersects `LineSegment AnEndPoint point'
s' = OpenLineSegment point
-> LinePV
     (Dimension (OpenLineSegment point))
     (NumType (OpenLineSegment point))
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine OpenLineSegment point
s LinePV 2 r -> LineSegment AnEndPoint point' -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` LineSegment AnEndPoint point'
s' Bool -> Bool -> Bool
&& LineSegment AnEndPoint point'
-> LinePV
     (Dimension (LineSegment AnEndPoint point'))
     (NumType (LineSegment AnEndPoint point'))
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine LineSegment AnEndPoint point'
s' LinePV 2 r -> OpenLineSegment point -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` OpenLineSegment point
s
                      Bool -> Bool -> Bool
&& OpenLineSegment point -> LineSegment AnEndPoint point' -> Bool
forall (endPoint :: * -> *) (endPoint' :: * -> *) point point' r.
(Point_ point 2 r, Point_ point' 2 r, Ord r, Num r,
 Functor endPoint, Functor endPoint',
 IxValue (endPoint point) ~ point, EndPoint_ (endPoint point),
 IxValue (endPoint' point') ~ point', EndPoint_ (endPoint' point'),
 HasIntersectionWith
   (Interval endPoint r) (Interval endPoint' r)) =>
LineSegment endPoint point -> LineSegment endPoint' point' -> Bool
spansIntersect OpenLineSegment point
s LineSegment AnEndPoint point'
s'
  {-# INLINE intersects #-}

instance ( Point_ point 2 r, Point_ point' 2 r, Num r,  Ord r
         ) =>
         OpenLineSegment point `HasIntersectionWith` ClosedLineSegment point' where
  OpenLineSegment point
s `intersects `ClosedLineSegment point'
s' = OpenLineSegment point
-> LinePV
     (Dimension (OpenLineSegment point))
     (NumType (OpenLineSegment point))
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine OpenLineSegment point
s LinePV 2 r -> ClosedLineSegment point' -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` ClosedLineSegment point'
s' Bool -> Bool -> Bool
&& ClosedLineSegment point'
-> LinePV
     (Dimension (ClosedLineSegment point'))
     (NumType (ClosedLineSegment point'))
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine ClosedLineSegment point'
s' LinePV 2 r -> OpenLineSegment point -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` OpenLineSegment point
s
                      Bool -> Bool -> Bool
&& OpenLineSegment point -> ClosedLineSegment point' -> Bool
forall (endPoint :: * -> *) (endPoint' :: * -> *) point point' r.
(Point_ point 2 r, Point_ point' 2 r, Ord r, Num r,
 Functor endPoint, Functor endPoint',
 IxValue (endPoint point) ~ point, EndPoint_ (endPoint point),
 IxValue (endPoint' point') ~ point', EndPoint_ (endPoint' point'),
 HasIntersectionWith
   (Interval endPoint r) (Interval endPoint' r)) =>
LineSegment endPoint point -> LineSegment endPoint' point' -> Bool
spansIntersect OpenLineSegment point
s ClosedLineSegment point'
s'
  {-# INLINE intersects #-}

----------------------------------------
-- * IsIntersectableWith

-- instance ( Point_ point 2 r, Fractional r,  Ord r
--          ) =>
--          LineSegment AnEndPoint point `IsIntersectableWith` LineSegment AnEndPoint point where
--   s `intersect` s' = supportingLine s `intersect` s' >>= \case
--     Line_x_LineSegment_Point p
--       | p `onSegment` s              -> Just $ LineSegment_x_LineSegment_Point p
--       | otherwise                    -> Nothing
--     Line_x_LineSegment_LineSegment _ -> Just $ LineSegment_x_LineSegment_LineSegment todo
--       where
--         todo = error "LineSegment_x_LineSegment_LineSegment, not yet implemented"
--   {-# INLINE intersect #-}

instance ( Point_ point 2 r, Num r,  Ord r
         , Functor endPoint
         , IxValue (endPoint point) ~ point, EndPoint_ (endPoint point)
         , IxValue (endPoint r) ~ r, EndPoint_ (endPoint r)
         , HasIntersectionWith (Interval endPoint r) (Interval endPoint r)
         , IxValue (endPoint point) ~ point
         , IxValue (endPoint (r :+ endPoint point)) ~ (r :+ endPoint point)
         , EndPoint_ (endPoint point)
         , IsEndPoint (endPoint point) (endPoint (r :+ endPoint point))
         , IsIntersectableWith (LinePV 2 r) (LineSegment endPoint point)
         , Intersection (LinePV 2 r) (LineSegment endPoint point)
           ~ Maybe (LineLineSegmentIntersection (LineSegment endPoint point))
         , HasOnSegment (LineSegment endPoint point) 2
         , IsIntersectableWith (Interval endPoint (r :+ endPoint point))
                               (Interval endPoint (r :+ endPoint point))
         , Intersection (LineSegment endPoint point) (LineSegment endPoint point)
           ~ Maybe (LineSegmentLineSegmentIntersection (LineSegment endPoint point))
         , EndPoint_ (endPoint (r :+ endPoint point))
         ) => LineSegment endPoint point `IsIntersectableWith` LineSegment endPoint point where
  LineSegment endPoint point
s intersect :: LineSegment endPoint point
-> LineSegment endPoint point
-> Intersection
     (LineSegment endPoint point) (LineSegment endPoint point)
`intersect` LineSegment endPoint point
s' = LineSegment endPoint point
-> LinePV
     (Dimension (LineSegment endPoint point))
     (NumType (LineSegment endPoint point))
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine LineSegment endPoint point
s LinePV 2 r
-> LineSegment endPoint point
-> Intersection (LinePV 2 r) (LineSegment endPoint point)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` LineSegment endPoint point
s' Maybe (LineLineSegmentIntersection (LineSegment endPoint point))
-> (LineLineSegmentIntersection (LineSegment endPoint point)
    -> Maybe
         (LineSegmentLineSegmentIntersection (LineSegment endPoint point)))
-> Maybe
     (LineSegmentLineSegmentIntersection (LineSegment endPoint point))
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Line_x_LineSegment_Point Point 2 (NumType (LineSegment endPoint point))
p
        | Point 2 r
Point 2 (NumType (LineSegment endPoint point))
p Point 2 r -> LineSegment endPoint point -> Bool
forall point r point' lineSegment.
(Point_ point 2 r, Point_ point' 2 r, Ord r, Num r,
 LineSegment_ lineSegment point') =>
point -> lineSegment -> Bool
`inPerpendicularSlab` LineSegment endPoint point
s    -> LineSegmentLineSegmentIntersection (LineSegment endPoint point)
-> Maybe
     (LineSegmentLineSegmentIntersection (LineSegment endPoint point))
forall a. a -> Maybe a
Just (LineSegmentLineSegmentIntersection (LineSegment endPoint point)
 -> Maybe
      (LineSegmentLineSegmentIntersection (LineSegment endPoint point)))
-> LineSegmentLineSegmentIntersection (LineSegment endPoint point)
-> Maybe
     (LineSegmentLineSegmentIntersection (LineSegment endPoint point))
forall a b. (a -> b) -> a -> b
$ Point 2 (NumType (LineSegment endPoint point))
-> LineSegmentLineSegmentIntersection (LineSegment endPoint point)
forall lineSegment.
Point 2 (NumType lineSegment)
-> LineSegmentLineSegmentIntersection lineSegment
LineSegment_x_LineSegment_Point Point 2 (NumType (LineSegment endPoint point))
p
        | Bool
otherwise                    -> Maybe
  (LineSegmentLineSegmentIntersection (LineSegment endPoint point))
forall a. Maybe a
Nothing
      Line_x_LineSegment_LineSegment LineSegment endPoint point
_ -> LineSegment endPoint point
-> Interval endPoint (r :+ endPoint point)
forall point r (endPoint :: * -> *).
(Point_ point 2 r, Ord r, IxValue (endPoint point) ~ point,
 IxValue (endPoint (r :+ endPoint point)) ~ (r :+ endPoint point),
 EndPoint_ (endPoint point),
 IsEndPoint (endPoint point) (endPoint (r :+ endPoint point))) =>
LineSegment endPoint point
-> Interval endPoint (r :+ endPoint point)
spanIn' LineSegment endPoint point
s Interval endPoint (r :+ endPoint point)
-> Interval endPoint (r :+ endPoint point)
-> Intersection
     (Interval endPoint (r :+ endPoint point))
     (Interval endPoint (r :+ endPoint point))
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` LineSegment endPoint point
-> Interval endPoint (r :+ endPoint point)
forall point r (endPoint :: * -> *).
(Point_ point 2 r, Ord r, IxValue (endPoint point) ~ point,
 IxValue (endPoint (r :+ endPoint point)) ~ (r :+ endPoint point),
 EndPoint_ (endPoint point),
 IsEndPoint (endPoint point) (endPoint (r :+ endPoint point))) =>
LineSegment endPoint point
-> Interval endPoint (r :+ endPoint point)
spanIn' LineSegment endPoint point
s' Maybe
  (Interval_x_IntervalIntersection
     (r :+ endPoint point) (Interval endPoint (r :+ endPoint point)))
-> (Interval_x_IntervalIntersection
      (r :+ endPoint point) (Interval endPoint (r :+ endPoint point))
    -> LineSegmentLineSegmentIntersection (LineSegment endPoint point))
-> Maybe
     (LineSegmentLineSegmentIntersection (LineSegment endPoint point))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        Interval_x_Interval_Point r :+ endPoint point
xy   -> Point 2 (NumType (LineSegment endPoint point))
-> LineSegmentLineSegmentIntersection (LineSegment endPoint point)
forall lineSegment.
Point 2 (NumType lineSegment)
-> LineSegmentLineSegmentIntersection lineSegment
LineSegment_x_LineSegment_Point (Point 2 (NumType (LineSegment endPoint point))
 -> LineSegmentLineSegmentIntersection (LineSegment endPoint point))
-> Point 2 (NumType (LineSegment endPoint point))
-> LineSegmentLineSegmentIntersection (LineSegment endPoint point)
forall a b. (a -> b) -> a -> b
$
                                            r :+ endPoint point
xy(r :+ endPoint point)
-> Getting
     (Point 2 (NumType (LineSegment endPoint point)))
     (r :+ endPoint point)
     (Point 2 (NumType (LineSegment endPoint point)))
-> Point 2 (NumType (LineSegment endPoint point))
forall s a. s -> Getting a s a -> a
^.(endPoint point -> Const (Point 2 r) (endPoint point))
-> (r :+ endPoint point) -> Const (Point 2 r) (r :+ endPoint point)
forall core extra extra' (f :: * -> *).
Functor f =>
(extra -> f extra') -> (core :+ extra) -> f (core :+ extra')
extra((endPoint point -> Const (Point 2 r) (endPoint point))
 -> (r :+ endPoint point)
 -> Const (Point 2 r) (r :+ endPoint point))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> endPoint point -> Const (Point 2 r) (endPoint point))
-> (Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (r :+ endPoint point)
-> Const (Point 2 r) (r :+ endPoint point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(IxValue (endPoint point)
 -> Const (Point 2 r) (IxValue (endPoint point)))
-> endPoint point -> Const (Point 2 r) (endPoint point)
forall endPoint endPoint'.
IsEndPoint endPoint endPoint' =>
Lens endPoint endPoint' (IxValue endPoint) (IxValue endPoint')
Lens
  (endPoint point)
  (endPoint point)
  (IxValue (endPoint point))
  (IxValue (endPoint point))
_endPoint((IxValue (endPoint point)
  -> Const (Point 2 r) (IxValue (endPoint point)))
 -> endPoint point -> Const (Point 2 r) (endPoint point))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> IxValue (endPoint point)
    -> Const (Point 2 r) (IxValue (endPoint point)))
-> (Point 2 r -> Const (Point 2 r) (Point 2 r))
-> endPoint point
-> Const (Point 2 r) (endPoint point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> IxValue (endPoint point)
-> Const (Point 2 r) (IxValue (endPoint point))
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' (IxValue (endPoint point)) (Point 2 r)
asPoint
        Interval_x_Interval_Contained Interval endPoint (r :+ endPoint point)
i -> Interval endPoint (r :+ endPoint point)
-> LineSegmentLineSegmentIntersection (LineSegment endPoint point)
forall {s} {core} {endPoint :: * -> *} {point} {core}.
(HasStart s (core :+ endPoint point),
 HasEnd s (core :+ endPoint point)) =>
s
-> LineSegmentLineSegmentIntersection (LineSegment endPoint point)
mkIntersect Interval endPoint (r :+ endPoint point)
i
        Interval_x_Interval_Partial Interval endPoint (r :+ endPoint point)
i   -> Interval endPoint (r :+ endPoint point)
-> LineSegmentLineSegmentIntersection (LineSegment endPoint point)
forall {s} {core} {endPoint :: * -> *} {point} {core}.
(HasStart s (core :+ endPoint point),
 HasEnd s (core :+ endPoint point)) =>
s
-> LineSegmentLineSegmentIntersection (LineSegment endPoint point)
mkIntersect Interval endPoint (r :+ endPoint point)
i
    where
      mkIntersect :: s
-> LineSegmentLineSegmentIntersection (LineSegment endPoint point)
mkIntersect s
i =
        LineSegment endPoint point
-> LineSegmentLineSegmentIntersection (LineSegment endPoint point)
forall lineSegment.
lineSegment -> LineSegmentLineSegmentIntersection lineSegment
LineSegment_x_LineSegment_LineSegment (LineSegment endPoint point
 -> LineSegmentLineSegmentIntersection (LineSegment endPoint point))
-> LineSegment endPoint point
-> LineSegmentLineSegmentIntersection (LineSegment endPoint point)
forall a b. (a -> b) -> a -> b
$ endPoint point -> endPoint point -> LineSegment endPoint point
forall (endPoint :: * -> *) point.
endPoint point -> endPoint point -> LineSegment endPoint point
LineSegment (s
is -> Getting (endPoint point) s (endPoint point) -> endPoint point
forall s a. s -> Getting a s a -> a
^.((core :+ endPoint point)
 -> Const (endPoint point) (core :+ endPoint point))
-> s -> Const (endPoint point) s
forall seg p. HasStart seg p => Lens' seg p
Lens' s (core :+ endPoint point)
start(((core :+ endPoint point)
  -> Const (endPoint point) (core :+ endPoint point))
 -> s -> Const (endPoint point) s)
-> ((endPoint point -> Const (endPoint point) (endPoint point))
    -> (core :+ endPoint point)
    -> Const (endPoint point) (core :+ endPoint point))
-> Getting (endPoint point) s (endPoint point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(endPoint point -> Const (endPoint point) (endPoint point))
-> (core :+ endPoint point)
-> Const (endPoint point) (core :+ endPoint point)
forall core extra extra' (f :: * -> *).
Functor f =>
(extra -> f extra') -> (core :+ extra) -> f (core :+ extra')
extra) (s
is -> Getting (endPoint point) s (endPoint point) -> endPoint point
forall s a. s -> Getting a s a -> a
^.((core :+ endPoint point)
 -> Const (endPoint point) (core :+ endPoint point))
-> s -> Const (endPoint point) s
forall seg p. HasEnd seg p => Lens' seg p
Lens' s (core :+ endPoint point)
end(((core :+ endPoint point)
  -> Const (endPoint point) (core :+ endPoint point))
 -> s -> Const (endPoint point) s)
-> ((endPoint point -> Const (endPoint point) (endPoint point))
    -> (core :+ endPoint point)
    -> Const (endPoint point) (core :+ endPoint point))
-> Getting (endPoint point) s (endPoint point)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(endPoint point -> Const (endPoint point) (endPoint point))
-> (core :+ endPoint point)
-> Const (endPoint point) (core :+ endPoint point)
forall core extra extra' (f :: * -> *).
Functor f =>
(extra -> f extra') -> (core :+ extra) -> f (core :+ extra')
extra)


-- | Given a line segment, compute the span of the line segment. In principle we compute
-- the span in terms of the x-coordinate. Except wehn the segment is vertical, then we return
-- the span in the y-cooridnate instead.
spanIn'  :: ( Point_ point 2 r, Ord r
            , IxValue (endPoint point) ~ point
            , IxValue (endPoint (r :+ endPoint point)) ~ (r :+ endPoint point)
            , EndPoint_ (endPoint point)
            , IsEndPoint (endPoint point) (endPoint (r :+ endPoint point))
            ) => LineSegment endPoint point -> Interval endPoint (r :+ endPoint point)
spanIn' :: forall point r (endPoint :: * -> *).
(Point_ point 2 r, Ord r, IxValue (endPoint point) ~ point,
 IxValue (endPoint (r :+ endPoint point)) ~ (r :+ endPoint point),
 EndPoint_ (endPoint point),
 IsEndPoint (endPoint point) (endPoint (r :+ endPoint point))) =>
LineSegment endPoint point
-> Interval endPoint (r :+ endPoint point)
spanIn' seg :: LineSegment endPoint point
seg@(LineSegment endPoint point
s endPoint point
t) = case (LineSegment endPoint point
segLineSegment endPoint point
-> Getting r (LineSegment endPoint point) r -> r
forall s a. s -> Getting a s a -> a
^.(point -> Const r point)
-> LineSegment endPoint point
-> Const r (LineSegment endPoint point)
forall seg p. HasStart seg p => Lens' seg p
Lens' (LineSegment endPoint point) point
start((point -> Const r point)
 -> LineSegment endPoint point
 -> Const r (LineSegment endPoint point))
-> ((r -> Const r r) -> point -> Const r point)
-> Getting r (LineSegment endPoint point) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> point -> Const r point
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (LineSegment endPoint point
segLineSegment endPoint point
-> Getting r (LineSegment endPoint point) r -> r
forall s a. s -> Getting a s a -> a
^.(point -> Const r point)
-> LineSegment endPoint point
-> Const r (LineSegment endPoint point)
forall seg p. HasEnd seg p => Lens' seg p
Lens' (LineSegment endPoint point) point
end((point -> Const r point)
 -> LineSegment endPoint point
 -> Const r (LineSegment endPoint point))
-> ((r -> Const r r) -> point -> Const r point)
-> Getting r (LineSegment endPoint point) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> point -> Const r point
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord) of
    Ordering
LT                                        -> endPoint (r :+ endPoint point)
-> endPoint (r :+ endPoint point)
-> Interval endPoint (r :+ endPoint point)
forall {k} (endPoint :: k -> *) (r :: k).
endPoint r -> endPoint r -> Interval endPoint r
Interval (endPoint point -> endPoint (r :+ endPoint point)
forall {b} {extra}.
(IxValue b ~ (NumType (IxValue extra) :+ extra),
 Assert
   (OrdCond (CmpNat 1 (Dimension (IxValue extra))) 'True 'True 'False)
   (TypeError ...),
 IsEndPoint extra b,
 Point_
   (IxValue extra)
   (Dimension (IxValue extra))
   (NumType (IxValue extra))) =>
extra -> b
xLabel endPoint point
s) (endPoint point -> endPoint (r :+ endPoint point)
forall {b} {extra}.
(IxValue b ~ (NumType (IxValue extra) :+ extra),
 Assert
   (OrdCond (CmpNat 1 (Dimension (IxValue extra))) 'True 'True 'False)
   (TypeError ...),
 IsEndPoint extra b,
 Point_
   (IxValue extra)
   (Dimension (IxValue extra))
   (NumType (IxValue extra))) =>
extra -> b
xLabel endPoint point
t)
    Ordering
EQ | LineSegment endPoint point
segLineSegment endPoint point
-> Getting r (LineSegment endPoint point) r -> r
forall s a. s -> Getting a s a -> a
^.(point -> Const r point)
-> LineSegment endPoint point
-> Const r (LineSegment endPoint point)
forall seg p. HasStart seg p => Lens' seg p
Lens' (LineSegment endPoint point) point
start((point -> Const r point)
 -> LineSegment endPoint point
 -> Const r (LineSegment endPoint point))
-> ((r -> Const r r) -> point -> Const r point)
-> Getting r (LineSegment endPoint point) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> point -> Const r point
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<= LineSegment endPoint point
segLineSegment endPoint point
-> Getting r (LineSegment endPoint point) r -> r
forall s a. s -> Getting a s a -> a
^.(point -> Const r point)
-> LineSegment endPoint point
-> Const r (LineSegment endPoint point)
forall seg p. HasEnd seg p => Lens' seg p
Lens' (LineSegment endPoint point) point
end((point -> Const r point)
 -> LineSegment endPoint point
 -> Const r (LineSegment endPoint point))
-> ((r -> Const r r) -> point -> Const r point)
-> Getting r (LineSegment endPoint point) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> point -> Const r point
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord -> endPoint (r :+ endPoint point)
-> endPoint (r :+ endPoint point)
-> Interval endPoint (r :+ endPoint point)
forall {k} (endPoint :: k -> *) (r :: k).
endPoint r -> endPoint r -> Interval endPoint r
Interval (endPoint point -> endPoint (r :+ endPoint point)
forall {b} {extra}.
(IxValue b ~ (NumType (IxValue extra) :+ extra),
 Assert
   (OrdCond (CmpNat 2 (Dimension (IxValue extra))) 'True 'True 'False)
   (TypeError ...),
 IsEndPoint extra b,
 Point_
   (IxValue extra)
   (Dimension (IxValue extra))
   (NumType (IxValue extra))) =>
extra -> b
yLabel endPoint point
s) (endPoint point -> endPoint (r :+ endPoint point)
forall {b} {extra}.
(IxValue b ~ (NumType (IxValue extra) :+ extra),
 Assert
   (OrdCond (CmpNat 2 (Dimension (IxValue extra))) 'True 'True 'False)
   (TypeError ...),
 IsEndPoint extra b,
 Point_
   (IxValue extra)
   (Dimension (IxValue extra))
   (NumType (IxValue extra))) =>
extra -> b
yLabel endPoint point
t)
       | Bool
otherwise                            -> endPoint (r :+ endPoint point)
-> endPoint (r :+ endPoint point)
-> Interval endPoint (r :+ endPoint point)
forall {k} (endPoint :: k -> *) (r :: k).
endPoint r -> endPoint r -> Interval endPoint r
Interval (endPoint point -> endPoint (r :+ endPoint point)
forall {b} {extra}.
(IxValue b ~ (NumType (IxValue extra) :+ extra),
 Assert
   (OrdCond (CmpNat 2 (Dimension (IxValue extra))) 'True 'True 'False)
   (TypeError ...),
 IsEndPoint extra b,
 Point_
   (IxValue extra)
   (Dimension (IxValue extra))
   (NumType (IxValue extra))) =>
extra -> b
yLabel endPoint point
t) (endPoint point -> endPoint (r :+ endPoint point)
forall {b} {extra}.
(IxValue b ~ (NumType (IxValue extra) :+ extra),
 Assert
   (OrdCond (CmpNat 2 (Dimension (IxValue extra))) 'True 'True 'False)
   (TypeError ...),
 IsEndPoint extra b,
 Point_
   (IxValue extra)
   (Dimension (IxValue extra))
   (NumType (IxValue extra))) =>
extra -> b
yLabel endPoint point
s)
    Ordering
GT                                        -> endPoint (r :+ endPoint point)
-> endPoint (r :+ endPoint point)
-> Interval endPoint (r :+ endPoint point)
forall {k} (endPoint :: k -> *) (r :: k).
endPoint r -> endPoint r -> Interval endPoint r
Interval (endPoint point -> endPoint (r :+ endPoint point)
forall {b} {extra}.
(IxValue b ~ (NumType (IxValue extra) :+ extra),
 Assert
   (OrdCond (CmpNat 1 (Dimension (IxValue extra))) 'True 'True 'False)
   (TypeError ...),
 IsEndPoint extra b,
 Point_
   (IxValue extra)
   (Dimension (IxValue extra))
   (NumType (IxValue extra))) =>
extra -> b
xLabel endPoint point
t) (endPoint point -> endPoint (r :+ endPoint point)
forall {b} {extra}.
(IxValue b ~ (NumType (IxValue extra) :+ extra),
 Assert
   (OrdCond (CmpNat 1 (Dimension (IxValue extra))) 'True 'True 'False)
   (TypeError ...),
 IsEndPoint extra b,
 Point_
   (IxValue extra)
   (Dimension (IxValue extra))
   (NumType (IxValue extra))) =>
extra -> b
xLabel endPoint point
s)
  where
    xLabel :: extra -> b
xLabel extra
p = extra
pextra -> (extra -> b) -> b
forall a b. a -> (a -> b) -> b
&(IxValue extra -> Identity (NumType (IxValue extra) :+ extra))
-> extra -> Identity b
(IxValue extra -> Identity (IxValue b)) -> extra -> Identity b
forall endPoint endPoint'.
IsEndPoint endPoint endPoint' =>
Lens endPoint endPoint' (IxValue endPoint) (IxValue endPoint')
Lens extra b (IxValue extra) (IxValue b)
_endPoint ((IxValue extra -> Identity (NumType (IxValue extra) :+ extra))
 -> extra -> Identity b)
-> (IxValue extra -> NumType (IxValue extra) :+ extra)
-> extra
-> b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \IxValue extra
pt -> IxValue extra
ptIxValue extra
-> Getting
     (NumType (IxValue extra)) (IxValue extra) (NumType (IxValue extra))
-> NumType (IxValue extra)
forall s a. s -> Getting a s a -> a
^.Getting
  (NumType (IxValue extra)) (IxValue extra) (NumType (IxValue extra))
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int (IxValue extra) (NumType (IxValue extra))
xCoord NumType (IxValue extra)
-> extra -> NumType (IxValue extra) :+ extra
forall core extra. core -> extra -> core :+ extra
:+ extra
p
    yLabel :: extra -> b
yLabel extra
p = extra
pextra -> (extra -> b) -> b
forall a b. a -> (a -> b) -> b
&(IxValue extra -> Identity (NumType (IxValue extra) :+ extra))
-> extra -> Identity b
(IxValue extra -> Identity (IxValue b)) -> extra -> Identity b
forall endPoint endPoint'.
IsEndPoint endPoint endPoint' =>
Lens endPoint endPoint' (IxValue endPoint) (IxValue endPoint')
Lens extra b (IxValue extra) (IxValue b)
_endPoint ((IxValue extra -> Identity (NumType (IxValue extra) :+ extra))
 -> extra -> Identity b)
-> (IxValue extra -> NumType (IxValue extra) :+ extra)
-> extra
-> b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \IxValue extra
pt -> IxValue extra
ptIxValue extra
-> Getting
     (NumType (IxValue extra)) (IxValue extra) (NumType (IxValue extra))
-> NumType (IxValue extra)
forall s a. s -> Getting a s a -> a
^.Getting
  (NumType (IxValue extra)) (IxValue extra) (NumType (IxValue extra))
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int (IxValue extra) (NumType (IxValue extra))
yCoord NumType (IxValue extra)
-> extra -> NumType (IxValue extra) :+ extra
forall core extra. core -> extra -> core :+ extra
:+ extra
p

-- data XY = X | Y deriving (Show,Eq)


{-

instance ( Point_ point 2 r, Num r, Ord r
         ) => ClosedLineSegment point `HasIntersectionWith` ClosedLineSegment point where
  sa `intersects` sb = supportingLine sa `intersects` sb &&
                       supportingLine sb `intersects` sa
  {-# INLINE intersects #-}
  -- FIXME: this is not correct yet; i.e. if sa and sb are colinear both supportinging
  -- lines intersect the segment, but the segments may stil lbe disjoint.


instance ( Point_ point 2 r
         , Fractional r,  Ord r
         ) => ClosedLineSegment point `IsIntersectableWith` ClosedLineSegment point where
  sa `intersect` sb
    | sa `intersects` sb = Just undefined
      -- FIXME!! continue here
    | otherwise          = Nothing
  {-# INLINE intersect #-}

-}



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

type instance Intersection (LineSegment endPoint point :+ extra)
                           (LineSegment endPoint point :+ extra) =
  Maybe (LineSegmentLineSegmentIntersection (LineSegment endPoint point :+ extra))
  -- FIXME: hmm, this type is kind of nonsense, since the intersecting segment may be from
  -- different segments

-- instance ( LineSegment endPoint point `HasIntersectionWith` LineSegment endPoint point
--          ) => (LineSegment endPoint point :+ extra) `HasIntersectionWith`
--               (LineSegment endPoint point :+ extra') where
--   (s :+ _) `intersects` (s' :+ _) = s `intersects` s'

instance ( LineSegment endPoint point `IsIntersectableWith` LineSegment endPoint point
         , Intersection (LineSegment endPoint point) (LineSegment endPoint point)
           ~ Maybe (LineSegmentLineSegmentIntersection (LineSegment endPoint point))
         ) => (LineSegment endPoint point :+ extra) `IsIntersectableWith`
              (LineSegment endPoint point :+ extra) where
  (LineSegment endPoint point
s :+ extra
_) intersect :: (LineSegment endPoint point :+ extra)
-> (LineSegment endPoint point :+ extra)
-> Intersection
     (LineSegment endPoint point :+ extra)
     (LineSegment endPoint point :+ extra)
`intersect` (LineSegment endPoint point
s' :+ extra
_) = (LineSegment endPoint point -> LineSegment endPoint point :+ extra)
-> LineSegmentLineSegmentIntersection (LineSegment endPoint point)
-> LineSegmentLineSegmentIntersection
     (LineSegment endPoint point :+ extra)
forall lineSegment lineSegment'.
(NumType lineSegment ~ NumType lineSegment') =>
(lineSegment -> lineSegment')
-> LineSegmentLineSegmentIntersection lineSegment
-> LineSegmentLineSegmentIntersection lineSegment'
fmap' (LineSegment endPoint point
-> extra -> LineSegment endPoint point :+ extra
forall core extra. core -> extra -> core :+ extra
:+ extra
forall {a}. a
undef') (LineSegmentLineSegmentIntersection (LineSegment endPoint point)
 -> LineSegmentLineSegmentIntersection
      (LineSegment endPoint point :+ extra))
-> Maybe
     (LineSegmentLineSegmentIntersection (LineSegment endPoint point))
-> Maybe
     (LineSegmentLineSegmentIntersection
        (LineSegment endPoint point :+ extra))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LineSegment endPoint point
s LineSegment endPoint point
-> LineSegment endPoint point
-> Intersection
     (LineSegment endPoint point) (LineSegment endPoint point)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` LineSegment endPoint point
s'
    where
      undef' :: a
undef' = String -> a
forall a. HasCallStack => String -> a
error String
"intersect segments: not possible"



--------------------------------------------------------------------------------
-- * Intersection with HalfLines

instance ( Ord r, Num r, Point_ point 2 r
         , IxValue (endPoint point) ~ point, EndPoint_ (endPoint point)
         ) => HasIntersectionWith (HalfLine point) (LineSegment endPoint point) where
  HalfLine point
hl intersects :: HalfLine point -> LineSegment endPoint point -> Bool
`intersects` LineSegment endPoint point
seg = case point -> point -> point -> CCW
forall point r point' point''.
(Point_ point 2 r, Point_ point' 2 r, Point_ point'' 2 r, Num r,
 Ord r) =>
point -> point' -> point'' -> CCW
ccw (LineSegment endPoint point
segLineSegment endPoint point
-> Getting point (LineSegment endPoint point) point -> point
forall s a. s -> Getting a s a -> a
^.Getting point (LineSegment endPoint point) point
forall seg p. HasStart seg p => Lens' seg p
Lens' (LineSegment endPoint point) point
start) (LineSegment endPoint point
segLineSegment endPoint point
-> Getting point (LineSegment endPoint point) point -> point
forall s a. s -> Getting a s a -> a
^.Getting point (LineSegment endPoint point) point
forall seg p. HasEnd seg p => Lens' seg p
Lens' (LineSegment endPoint point) point
end) (HalfLine point
hlHalfLine point -> Getting point (HalfLine point) point -> point
forall s a. s -> Getting a s a -> a
^.Getting point (HalfLine point) point
forall seg p. HasStart seg p => Lens' seg p
Lens' (HalfLine point) point
start) of
      CCW
CoLinear -> let l :: LinePV 2 r
l = Point 2 r -> Vector 2 r -> LinePV 2 r
forall (d :: Nat) r. Point d r -> Vector d r -> LinePV d r
LinePV (HalfLine point
hlHalfLine point
-> Getting (Point 2 r) (HalfLine point) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> HalfLine point -> Const (Point 2 r) (HalfLine point)
forall seg p. HasStart seg p => Lens' seg p
Lens' (HalfLine point) point
start((point -> Const (Point 2 r) point)
 -> HalfLine point -> Const (Point 2 r) (HalfLine point))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) (HalfLine point) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint) ((LineSegment endPoint point
segLineSegment endPoint point
-> Getting point (LineSegment endPoint point) point -> point
forall s a. s -> Getting a s a -> a
^.Getting point (LineSegment endPoint point) point
forall seg p. HasEnd seg p => Lens' seg p
Lens' (LineSegment endPoint point) point
end) point -> point -> Vector 2 r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> point -> Vector d r
.-. (LineSegment endPoint point
segLineSegment endPoint point
-> Getting point (LineSegment endPoint point) point -> point
forall s a. s -> Getting a s a -> a
^.Getting point (LineSegment endPoint point) point
forall seg p. HasStart seg p => Lens' seg p
Lens' (LineSegment endPoint point) point
start))
                      -- this essentially constructs the supporting line of the segment
                      -- but anchors it at hl^.start. Since the three points are colinear
                      -- this still means the segment lies on this line.
                   in case LinePV 2 r -> LineSegment endPoint point -> CompareInterval
forall r point (endPoint :: * -> *).
(Ord r, Num r, Point_ point 2 r, IxValue (endPoint point) ~ point,
 EndPoint_ (endPoint point)) =>
LinePV 2 r -> LineSegment endPoint point -> CompareInterval
compareColinearInterval LinePV 2 r
l LineSegment endPoint point
seg of
                        CompareInterval
Before   -> (LineSegment endPoint point
segLineSegment endPoint point
-> Getting (Point 2 r) (LineSegment endPoint point) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> LineSegment endPoint point
-> Const (Point 2 r) (LineSegment endPoint point)
forall seg p. HasEnd seg p => Lens' seg p
Lens' (LineSegment endPoint point) point
end((point -> Const (Point 2 r) point)
 -> LineSegment endPoint point
 -> Const (Point 2 r) (LineSegment endPoint point))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) (LineSegment endPoint point) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint) Point 2 r -> HalfLine point -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` HalfLine point
hl
                        CompareInterval
OnStart  -> endPoint point -> Bool
isClosed (LineSegment endPoint point
segLineSegment endPoint point
-> Getting
     (endPoint point) (LineSegment endPoint point) (endPoint point)
-> endPoint point
forall s a. s -> Getting a s a -> a
^.Getting
  (endPoint point) (LineSegment endPoint point) (endPoint point)
forall seg p. HasStartPoint seg p => Lens' seg p
Lens' (LineSegment endPoint point) (endPoint point)
startPoint)
                                      Bool -> Bool -> Bool
|| (LineSegment endPoint point
segLineSegment endPoint point
-> Getting (Point 2 r) (LineSegment endPoint point) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> LineSegment endPoint point
-> Const (Point 2 r) (LineSegment endPoint point)
forall seg p. HasEnd seg p => Lens' seg p
Lens' (LineSegment endPoint point) point
end((point -> Const (Point 2 r) point)
 -> LineSegment endPoint point
 -> Const (Point 2 r) (LineSegment endPoint point))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) (LineSegment endPoint point) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint) Point 2 r -> HalfLine point -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` HalfLine point
hl
                        CompareInterval
Interior -> Bool
True
                        CompareInterval
OnEnd    -> endPoint point -> Bool
isClosed (LineSegment endPoint point
segLineSegment endPoint point
-> Getting
     (endPoint point) (LineSegment endPoint point) (endPoint point)
-> endPoint point
forall s a. s -> Getting a s a -> a
^.Getting
  (endPoint point) (LineSegment endPoint point) (endPoint point)
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' (LineSegment endPoint point) (endPoint point)
endPoint)
                                      Bool -> Bool -> Bool
|| (LineSegment endPoint point
segLineSegment endPoint point
-> Getting (Point 2 r) (LineSegment endPoint point) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> LineSegment endPoint point
-> Const (Point 2 r) (LineSegment endPoint point)
forall seg p. HasStart seg p => Lens' seg p
Lens' (LineSegment endPoint point) point
start((point -> Const (Point 2 r) point)
 -> LineSegment endPoint point
 -> Const (Point 2 r) (LineSegment endPoint point))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) (LineSegment endPoint point) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint) Point 2 r -> HalfLine point -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` HalfLine point
hl
                        CompareInterval
After    -> (LineSegment endPoint point
segLineSegment endPoint point
-> Getting (Point 2 r) (LineSegment endPoint point) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> LineSegment endPoint point
-> Const (Point 2 r) (LineSegment endPoint point)
forall seg p. HasStart seg p => Lens' seg p
Lens' (LineSegment endPoint point) point
start((point -> Const (Point 2 r) point)
 -> LineSegment endPoint point
 -> Const (Point 2 r) (LineSegment endPoint point))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) (LineSegment endPoint point) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint) Point 2 r -> HalfLine point -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` HalfLine point
hl

      -- the thing below is what holds for closed seg
      --   (seg^.start.asPoint) `intersects` hl
      --               || (seg^.end.asPoint) `intersects` hl
      --               || (hl^.start.asPoint) `intersects` seg

      CCW
_        -> HalfLine point
-> LinePV (Dimension (HalfLine point)) (NumType (HalfLine point))
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine HalfLine point
hl LinePV 2 r -> LineSegment endPoint point -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` LineSegment endPoint point
seg Bool -> Bool -> Bool
&& LineSegment endPoint point
-> LinePV
     (Dimension (LineSegment endPoint point))
     (NumType (LineSegment endPoint point))
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine LineSegment endPoint point
seg LinePV 2 r -> HalfLine point -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` HalfLine point
hl
    where
      isClosed :: endPoint point -> Bool
isClosed = (EndPointType -> EndPointType -> Bool
forall a. Eq a => a -> a -> Bool
== EndPointType
Closed) (EndPointType -> Bool)
-> (endPoint point -> EndPointType) -> endPoint point -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. endPoint point -> EndPointType
forall endPoint. EndPoint_ endPoint => endPoint -> EndPointType
endPointType
  {-# INLINE intersects #-}

type instance Intersection (HalfLine point) (LineSegment endPoint point)
  = Maybe (HalfLineLineSegmentIntersection (Point 2 (NumType point))
                                           (LineSegment endPoint point))

-- | Data type representing the intersection of a HalfLine and a LineSegment
data HalfLineLineSegmentIntersection point segment =
      HalfLine_x_LineSegment_Point       point
    | HalfLine_x_LineSegment_LineSegment segment
  deriving (Int -> HalfLineLineSegmentIntersection point segment -> ShowS
[HalfLineLineSegmentIntersection point segment] -> ShowS
HalfLineLineSegmentIntersection point segment -> String
(Int -> HalfLineLineSegmentIntersection point segment -> ShowS)
-> (HalfLineLineSegmentIntersection point segment -> String)
-> ([HalfLineLineSegmentIntersection point segment] -> ShowS)
-> Show (HalfLineLineSegmentIntersection point segment)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall point segment.
(Show point, Show segment) =>
Int -> HalfLineLineSegmentIntersection point segment -> ShowS
forall point segment.
(Show point, Show segment) =>
[HalfLineLineSegmentIntersection point segment] -> ShowS
forall point segment.
(Show point, Show segment) =>
HalfLineLineSegmentIntersection point segment -> String
$cshowsPrec :: forall point segment.
(Show point, Show segment) =>
Int -> HalfLineLineSegmentIntersection point segment -> ShowS
showsPrec :: Int -> HalfLineLineSegmentIntersection point segment -> ShowS
$cshow :: forall point segment.
(Show point, Show segment) =>
HalfLineLineSegmentIntersection point segment -> String
show :: HalfLineLineSegmentIntersection point segment -> String
$cshowList :: forall point segment.
(Show point, Show segment) =>
[HalfLineLineSegmentIntersection point segment] -> ShowS
showList :: [HalfLineLineSegmentIntersection point segment] -> ShowS
Show,HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment -> Bool
(HalfLineLineSegmentIntersection point segment
 -> HalfLineLineSegmentIntersection point segment -> Bool)
-> (HalfLineLineSegmentIntersection point segment
    -> HalfLineLineSegmentIntersection point segment -> Bool)
-> Eq (HalfLineLineSegmentIntersection point segment)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall point segment.
(Eq point, Eq segment) =>
HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment -> Bool
$c== :: forall point segment.
(Eq point, Eq segment) =>
HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment -> Bool
== :: HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment -> Bool
$c/= :: forall point segment.
(Eq point, Eq segment) =>
HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment -> Bool
/= :: HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment -> Bool
Eq,ReadPrec [HalfLineLineSegmentIntersection point segment]
ReadPrec (HalfLineLineSegmentIntersection point segment)
Int -> ReadS (HalfLineLineSegmentIntersection point segment)
ReadS [HalfLineLineSegmentIntersection point segment]
(Int -> ReadS (HalfLineLineSegmentIntersection point segment))
-> ReadS [HalfLineLineSegmentIntersection point segment]
-> ReadPrec (HalfLineLineSegmentIntersection point segment)
-> ReadPrec [HalfLineLineSegmentIntersection point segment]
-> Read (HalfLineLineSegmentIntersection point segment)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall point segment.
(Read point, Read segment) =>
ReadPrec [HalfLineLineSegmentIntersection point segment]
forall point segment.
(Read point, Read segment) =>
ReadPrec (HalfLineLineSegmentIntersection point segment)
forall point segment.
(Read point, Read segment) =>
Int -> ReadS (HalfLineLineSegmentIntersection point segment)
forall point segment.
(Read point, Read segment) =>
ReadS [HalfLineLineSegmentIntersection point segment]
$creadsPrec :: forall point segment.
(Read point, Read segment) =>
Int -> ReadS (HalfLineLineSegmentIntersection point segment)
readsPrec :: Int -> ReadS (HalfLineLineSegmentIntersection point segment)
$creadList :: forall point segment.
(Read point, Read segment) =>
ReadS [HalfLineLineSegmentIntersection point segment]
readList :: ReadS [HalfLineLineSegmentIntersection point segment]
$creadPrec :: forall point segment.
(Read point, Read segment) =>
ReadPrec (HalfLineLineSegmentIntersection point segment)
readPrec :: ReadPrec (HalfLineLineSegmentIntersection point segment)
$creadListPrec :: forall point segment.
(Read point, Read segment) =>
ReadPrec [HalfLineLineSegmentIntersection point segment]
readListPrec :: ReadPrec [HalfLineLineSegmentIntersection point segment]
Read,Eq (HalfLineLineSegmentIntersection point segment)
Eq (HalfLineLineSegmentIntersection point segment) =>
(HalfLineLineSegmentIntersection point segment
 -> HalfLineLineSegmentIntersection point segment -> Ordering)
-> (HalfLineLineSegmentIntersection point segment
    -> HalfLineLineSegmentIntersection point segment -> Bool)
-> (HalfLineLineSegmentIntersection point segment
    -> HalfLineLineSegmentIntersection point segment -> Bool)
-> (HalfLineLineSegmentIntersection point segment
    -> HalfLineLineSegmentIntersection point segment -> Bool)
-> (HalfLineLineSegmentIntersection point segment
    -> HalfLineLineSegmentIntersection point segment -> Bool)
-> (HalfLineLineSegmentIntersection point segment
    -> HalfLineLineSegmentIntersection point segment
    -> HalfLineLineSegmentIntersection point segment)
-> (HalfLineLineSegmentIntersection point segment
    -> HalfLineLineSegmentIntersection point segment
    -> HalfLineLineSegmentIntersection point segment)
-> Ord (HalfLineLineSegmentIntersection point segment)
HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment -> Bool
HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment -> Ordering
HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall point segment.
(Ord point, Ord segment) =>
Eq (HalfLineLineSegmentIntersection point segment)
forall point segment.
(Ord point, Ord segment) =>
HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment -> Bool
forall point segment.
(Ord point, Ord segment) =>
HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment -> Ordering
forall point segment.
(Ord point, Ord segment) =>
HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment
$ccompare :: forall point segment.
(Ord point, Ord segment) =>
HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment -> Ordering
compare :: HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment -> Ordering
$c< :: forall point segment.
(Ord point, Ord segment) =>
HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment -> Bool
< :: HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment -> Bool
$c<= :: forall point segment.
(Ord point, Ord segment) =>
HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment -> Bool
<= :: HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment -> Bool
$c> :: forall point segment.
(Ord point, Ord segment) =>
HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment -> Bool
> :: HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment -> Bool
$c>= :: forall point segment.
(Ord point, Ord segment) =>
HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment -> Bool
>= :: HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment -> Bool
$cmax :: forall point segment.
(Ord point, Ord segment) =>
HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment
max :: HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment
$cmin :: forall point segment.
(Ord point, Ord segment) =>
HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment
min :: HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment
-> HalfLineLineSegmentIntersection point segment
Ord,(forall x.
 HalfLineLineSegmentIntersection point segment
 -> Rep (HalfLineLineSegmentIntersection point segment) x)
-> (forall x.
    Rep (HalfLineLineSegmentIntersection point segment) x
    -> HalfLineLineSegmentIntersection point segment)
-> Generic (HalfLineLineSegmentIntersection point segment)
forall x.
Rep (HalfLineLineSegmentIntersection point segment) x
-> HalfLineLineSegmentIntersection point segment
forall x.
HalfLineLineSegmentIntersection point segment
-> Rep (HalfLineLineSegmentIntersection point segment) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall point segment x.
Rep (HalfLineLineSegmentIntersection point segment) x
-> HalfLineLineSegmentIntersection point segment
forall point segment x.
HalfLineLineSegmentIntersection point segment
-> Rep (HalfLineLineSegmentIntersection point segment) x
$cfrom :: forall point segment x.
HalfLineLineSegmentIntersection point segment
-> Rep (HalfLineLineSegmentIntersection point segment) x
from :: forall x.
HalfLineLineSegmentIntersection point segment
-> Rep (HalfLineLineSegmentIntersection point segment) x
$cto :: forall point segment x.
Rep (HalfLineLineSegmentIntersection point segment) x
-> HalfLineLineSegmentIntersection point segment
to :: forall x.
Rep (HalfLineLineSegmentIntersection point segment) x
-> HalfLineLineSegmentIntersection point segment
Generic,(forall a b.
 (a -> b)
 -> HalfLineLineSegmentIntersection point a
 -> HalfLineLineSegmentIntersection point b)
-> (forall a b.
    a
    -> HalfLineLineSegmentIntersection point b
    -> HalfLineLineSegmentIntersection point a)
-> Functor (HalfLineLineSegmentIntersection point)
forall a b.
a
-> HalfLineLineSegmentIntersection point b
-> HalfLineLineSegmentIntersection point a
forall a b.
(a -> b)
-> HalfLineLineSegmentIntersection point a
-> HalfLineLineSegmentIntersection point b
forall point a b.
a
-> HalfLineLineSegmentIntersection point b
-> HalfLineLineSegmentIntersection point a
forall point a b.
(a -> b)
-> HalfLineLineSegmentIntersection point a
-> HalfLineLineSegmentIntersection point b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall point a b.
(a -> b)
-> HalfLineLineSegmentIntersection point a
-> HalfLineLineSegmentIntersection point b
fmap :: forall a b.
(a -> b)
-> HalfLineLineSegmentIntersection point a
-> HalfLineLineSegmentIntersection point b
$c<$ :: forall point a b.
a
-> HalfLineLineSegmentIntersection point b
-> HalfLineLineSegmentIntersection point a
<$ :: forall a b.
a
-> HalfLineLineSegmentIntersection point b
-> HalfLineLineSegmentIntersection point a
Functor)

instance ( Ord r, Fractional r, Point_ point 2 r
         , IxValue (endPoint point) ~ point
         , EndPoint_ (endPoint point)
         , IsIntersectableWith (LinePV 2 r) (LineSegment endPoint point)
         , Intersection (LinePV 2 r) (LineSegment endPoint point)
           ~ Maybe (LineLineSegmentIntersection lineSegment')
         , NumType lineSegment' ~ r
         ) => IsIntersectableWith (HalfLine point) (LineSegment endPoint point) where
  HalfLine point
hl intersect :: HalfLine point
-> LineSegment endPoint point
-> Intersection (HalfLine point) (LineSegment endPoint point)
`intersect` LineSegment endPoint point
seg = LinePV 2 r
LinePV (Dimension (HalfLine point)) (NumType (HalfLine point))
m LinePV 2 r
-> LineSegment endPoint point
-> Intersection (LinePV 2 r) (LineSegment endPoint point)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` LineSegment endPoint point
seg Maybe (LineLineSegmentIntersection lineSegment')
-> (LineLineSegmentIntersection lineSegment'
    -> Maybe
         (HalfLineLineSegmentIntersection
            (Point 2 r) (LineSegment endPoint point)))
-> Maybe
     (HalfLineLineSegmentIntersection
        (Point 2 r) (LineSegment endPoint point))
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Line_x_LineSegment_Point Point 2 (NumType lineSegment')
q
        | Point 2 r
Point 2 (NumType lineSegment')
q Point 2 r -> LinePV 2 r -> SideTest
forall r point.
(Ord r, Num r, Point_ point 2 r) =>
point -> LinePV 2 r -> SideTest
`onSide` LinePV 2 r -> LinePV 2 r
forall r. Num r => LinePV 2 r -> LinePV 2 r
perpendicularTo LinePV 2 r
LinePV (Dimension (HalfLine point)) (NumType (HalfLine point))
m SideTest -> SideTest -> Bool
forall a. Eq a => a -> a -> Bool
/= SideTest
RightSide -> HalfLineLineSegmentIntersection
  (Point 2 r) (LineSegment endPoint point)
-> Maybe
     (HalfLineLineSegmentIntersection
        (Point 2 r) (LineSegment endPoint point))
forall a. a -> Maybe a
Just (HalfLineLineSegmentIntersection
   (Point 2 r) (LineSegment endPoint point)
 -> Maybe
      (HalfLineLineSegmentIntersection
         (Point 2 r) (LineSegment endPoint point)))
-> HalfLineLineSegmentIntersection
     (Point 2 r) (LineSegment endPoint point)
-> Maybe
     (HalfLineLineSegmentIntersection
        (Point 2 r) (LineSegment endPoint point))
forall a b. (a -> b) -> a -> b
$ Point 2 r
-> HalfLineLineSegmentIntersection
     (Point 2 r) (LineSegment endPoint point)
forall point segment.
point -> HalfLineLineSegmentIntersection point segment
HalfLine_x_LineSegment_Point Point 2 r
Point 2 (NumType lineSegment')
q
        | Bool
otherwise                                 -> Maybe
  (HalfLineLineSegmentIntersection
     (Point 2 r) (LineSegment endPoint point))
forall a. Maybe a
Nothing
      Line_x_LineSegment_LineSegment lineSegment'
_              -> case LinePV 2 r -> LineSegment endPoint point -> CompareInterval
forall r point (endPoint :: * -> *).
(Ord r, Num r, Point_ point 2 r, IxValue (endPoint point) ~ point,
 EndPoint_ (endPoint point)) =>
LinePV 2 r -> LineSegment endPoint point -> CompareInterval
compareColinearInterval LinePV 2 r
LinePV (Dimension (HalfLine point)) (NumType (HalfLine point))
m LineSegment endPoint point
seg of
        CompareInterval
Before   -> HalfLineLineSegmentIntersection
  (Point 2 r) (LineSegment endPoint point)
-> Maybe
     (HalfLineLineSegmentIntersection
        (Point 2 r) (LineSegment endPoint point))
forall a. a -> Maybe a
Just (HalfLineLineSegmentIntersection
   (Point 2 r) (LineSegment endPoint point)
 -> Maybe
      (HalfLineLineSegmentIntersection
         (Point 2 r) (LineSegment endPoint point)))
-> HalfLineLineSegmentIntersection
     (Point 2 r) (LineSegment endPoint point)
-> Maybe
     (HalfLineLineSegmentIntersection
        (Point 2 r) (LineSegment endPoint point))
forall a b. (a -> b) -> a -> b
$ LineSegment endPoint point
-> HalfLineLineSegmentIntersection
     (Point 2 r) (LineSegment endPoint point)
forall point segment.
segment -> HalfLineLineSegmentIntersection point segment
HalfLine_x_LineSegment_LineSegment LineSegment endPoint point
seg
        CompareInterval
OnStart  -> HalfLineLineSegmentIntersection
  (Point 2 r) (LineSegment endPoint point)
-> Maybe
     (HalfLineLineSegmentIntersection
        (Point 2 r) (LineSegment endPoint point))
forall a. a -> Maybe a
Just (HalfLineLineSegmentIntersection
   (Point 2 r) (LineSegment endPoint point)
 -> Maybe
      (HalfLineLineSegmentIntersection
         (Point 2 r) (LineSegment endPoint point)))
-> HalfLineLineSegmentIntersection
     (Point 2 r) (LineSegment endPoint point)
-> Maybe
     (HalfLineLineSegmentIntersection
        (Point 2 r) (LineSegment endPoint point))
forall a b. (a -> b) -> a -> b
$ LineSegment endPoint point
-> HalfLineLineSegmentIntersection
     (Point 2 r) (LineSegment endPoint point)
forall point segment.
segment -> HalfLineLineSegmentIntersection point segment
HalfLine_x_LineSegment_LineSegment LineSegment endPoint point
seg
        CompareInterval
Interior -> HalfLineLineSegmentIntersection
  (Point 2 r) (LineSegment endPoint point)
-> Maybe
     (HalfLineLineSegmentIntersection
        (Point 2 r) (LineSegment endPoint point))
forall a. a -> Maybe a
Just (HalfLineLineSegmentIntersection
   (Point 2 r) (LineSegment endPoint point)
 -> Maybe
      (HalfLineLineSegmentIntersection
         (Point 2 r) (LineSegment endPoint point)))
-> HalfLineLineSegmentIntersection
     (Point 2 r) (LineSegment endPoint point)
-> Maybe
     (HalfLineLineSegmentIntersection
        (Point 2 r) (LineSegment endPoint point))
forall a b. (a -> b) -> a -> b
$ LineSegment endPoint point
-> HalfLineLineSegmentIntersection
     (Point 2 r) (LineSegment endPoint point)
forall point segment.
segment -> HalfLineLineSegmentIntersection point segment
HalfLine_x_LineSegment_LineSegment (LineSegment endPoint point
 -> HalfLineLineSegmentIntersection
      (Point 2 r) (LineSegment endPoint point))
-> LineSegment endPoint point
-> HalfLineLineSegmentIntersection
     (Point 2 r) (LineSegment endPoint point)
forall a b. (a -> b) -> a -> b
$ LineSegment endPoint point
segLineSegment endPoint point
-> (LineSegment endPoint point -> LineSegment endPoint point)
-> LineSegment endPoint point
forall a b. a -> (a -> b) -> b
&(point -> Identity point)
-> LineSegment endPoint point
-> Identity (LineSegment endPoint point)
forall seg p. HasStart seg p => Lens' seg p
Lens' (LineSegment endPoint point) point
start ((point -> Identity point)
 -> LineSegment endPoint point
 -> Identity (LineSegment endPoint point))
-> point
-> LineSegment endPoint point
-> LineSegment endPoint point
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (HalfLine point
hlHalfLine point -> Getting point (HalfLine point) point -> point
forall s a. s -> Getting a s a -> a
^.Getting point (HalfLine point) point
forall seg p. HasStart seg p => Lens' seg p
Lens' (HalfLine point) point
start)
        CompareInterval
OnEnd
          | endPoint point -> Bool
isClosed (LineSegment endPoint point
segLineSegment endPoint point
-> Getting
     (endPoint point) (LineSegment endPoint point) (endPoint point)
-> endPoint point
forall s a. s -> Getting a s a -> a
^.Getting
  (endPoint point) (LineSegment endPoint point) (endPoint point)
forall seg p. HasEndPoint seg p => Lens' seg p
Lens' (LineSegment endPoint point) (endPoint point)
endPoint) -> HalfLineLineSegmentIntersection
  (Point 2 r) (LineSegment endPoint point)
-> Maybe
     (HalfLineLineSegmentIntersection
        (Point 2 r) (LineSegment endPoint point))
forall a. a -> Maybe a
Just (HalfLineLineSegmentIntersection
   (Point 2 r) (LineSegment endPoint point)
 -> Maybe
      (HalfLineLineSegmentIntersection
         (Point 2 r) (LineSegment endPoint point)))
-> HalfLineLineSegmentIntersection
     (Point 2 r) (LineSegment endPoint point)
-> Maybe
     (HalfLineLineSegmentIntersection
        (Point 2 r) (LineSegment endPoint point))
forall a b. (a -> b) -> a -> b
$ Point 2 r
-> HalfLineLineSegmentIntersection
     (Point 2 r) (LineSegment endPoint point)
forall point segment.
point -> HalfLineLineSegmentIntersection point segment
HalfLine_x_LineSegment_Point (LineSegment endPoint point
segLineSegment endPoint point
-> Getting (Point 2 r) (LineSegment endPoint point) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> LineSegment endPoint point
-> Const (Point 2 r) (LineSegment endPoint point)
forall seg p. HasEnd seg p => Lens' seg p
Lens' (LineSegment endPoint point) point
end((point -> Const (Point 2 r) point)
 -> LineSegment endPoint point
 -> Const (Point 2 r) (LineSegment endPoint point))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) (LineSegment endPoint point) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint)
          | Bool
otherwise                -> Maybe
  (HalfLineLineSegmentIntersection
     (Point 2 r) (LineSegment endPoint point))
forall a. Maybe a
Nothing
        CompareInterval
After                        -> Maybe
  (HalfLineLineSegmentIntersection
     (Point 2 r) (LineSegment endPoint point))
forall a. Maybe a
Nothing -- no intersection
    where
      m :: LinePV (Dimension (HalfLine point)) (NumType (HalfLine point))
m = HalfLine point
-> LinePV (Dimension (HalfLine point)) (NumType (HalfLine point))
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine HalfLine point
hl
      isClosed :: endPoint point -> Bool
isClosed = (EndPointType -> EndPointType -> Bool
forall a. Eq a => a -> a -> Bool
== EndPointType
Closed) (EndPointType -> Bool)
-> (endPoint point -> EndPointType) -> endPoint point -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. endPoint point -> EndPointType
forall endPoint. EndPoint_ endPoint => endPoint -> EndPointType
endPointType

-- | Given a line l, and a line segment seg that lies on l. Returns where the anchorPoint
-- of the line is with respect to the line segment (which we can interpret as some
-- interval along l).
compareColinearInterval                    :: ( Ord r, Num r
                                              , Point_ point 2 r
                                              , IxValue (endPoint point) ~ point
                                              , EndPoint_ (endPoint point)
                                              )
                                           => LinePV 2 r -> LineSegment endPoint point
                                           -> CompareInterval
compareColinearInterval :: forall r point (endPoint :: * -> *).
(Ord r, Num r, Point_ point 2 r, IxValue (endPoint point) ~ point,
 EndPoint_ (endPoint point)) =>
LinePV 2 r -> LineSegment endPoint point -> CompareInterval
compareColinearInterval l :: LinePV 2 r
l@(LinePV Point 2 r
p Vector 2 r
_) LineSegment endPoint point
seg = case Point 2 r
p Point 2 r -> LinePV 2 r -> SideTest
forall r point.
(Ord r, Num r, Point_ point 2 r) =>
point -> LinePV 2 r -> SideTest
`onSide` LinePV 2 r
mStart of
    SideTest
RightSide -> CompareInterval
Before
    SideTest
OnLine    -> CompareInterval
OnStart
    SideTest
LeftSide  -> case Point 2 r
p Point 2 r -> LinePV 2 r -> SideTest
forall r point.
(Ord r, Num r, Point_ point 2 r) =>
point -> LinePV 2 r -> SideTest
`onSide` LinePV 2 r
mEnd of
      SideTest
RightSide -> CompareInterval
Interior
      SideTest
OnLine    -> CompareInterval
OnEnd
      SideTest
LeftSide  -> CompareInterval
After
  where
    m :: LinePV 2 r
m = LinePV 2 r -> LinePV 2 r
forall r. Num r => LinePV 2 r -> LinePV 2 r
perpendicularTo LinePV 2 r
l
    mStart :: LinePV 2 r
mStart = LinePV 2 r
mLinePV 2 r -> (LinePV 2 r -> LinePV 2 r) -> LinePV 2 r
forall a b. a -> (a -> b) -> b
&(Point 2 r -> Identity (Point 2 r))
-> LinePV 2 r -> Identity (LinePV 2 r)
forall (d :: Nat) r (f :: * -> *).
Functor f =>
(Point d r -> f (Point d r)) -> LinePV d r -> f (LinePV d r)
anchorPoint ((Point 2 r -> Identity (Point 2 r))
 -> LinePV 2 r -> Identity (LinePV 2 r))
-> Point 2 r -> LinePV 2 r -> LinePV 2 r
forall s t a b. ASetter s t a b -> b -> s -> t
.~ LineSegment endPoint point
segLineSegment endPoint point
-> Getting (Point 2 r) (LineSegment endPoint point) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> LineSegment endPoint point
-> Const (Point 2 r) (LineSegment endPoint point)
forall seg p. HasStart seg p => Lens' seg p
Lens' (LineSegment endPoint point) point
start((point -> Const (Point 2 r) point)
 -> LineSegment endPoint point
 -> Const (Point 2 r) (LineSegment endPoint point))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) (LineSegment endPoint point) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint
    mEnd :: LinePV 2 r
mEnd   = LinePV 2 r
mLinePV 2 r -> (LinePV 2 r -> LinePV 2 r) -> LinePV 2 r
forall a b. a -> (a -> b) -> b
&(Point 2 r -> Identity (Point 2 r))
-> LinePV 2 r -> Identity (LinePV 2 r)
forall (d :: Nat) r (f :: * -> *).
Functor f =>
(Point d r -> f (Point d r)) -> LinePV d r -> f (LinePV d r)
anchorPoint ((Point 2 r -> Identity (Point 2 r))
 -> LinePV 2 r -> Identity (LinePV 2 r))
-> Point 2 r -> LinePV 2 r -> LinePV 2 r
forall s t a b. ASetter s t a b -> b -> s -> t
.~ LineSegment endPoint point
segLineSegment endPoint point
-> Getting (Point 2 r) (LineSegment endPoint point) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> LineSegment endPoint point
-> Const (Point 2 r) (LineSegment endPoint point)
forall seg p. HasEnd seg p => Lens' seg p
Lens' (LineSegment endPoint point) point
end((point -> Const (Point 2 r) point)
 -> LineSegment endPoint point
 -> Const (Point 2 r) (LineSegment endPoint point))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) (LineSegment endPoint point) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint
    -- the left side is the side in which the vector v points.

type instance NumType   (HalfLineLineSegmentIntersection point edge) = NumType point
type instance Dimension (HalfLineLineSegmentIntersection point edge) = Dimension point

instance ( HasSquaredEuclideanDistance point
         , HasSquaredEuclideanDistance segment
         , NumType point ~ NumType segment, Dimension point ~ Dimension segment
         ) => HasSquaredEuclideanDistance (HalfLineLineSegmentIntersection point segment) where
  pointClosestToWithDistance :: forall r (d :: Nat) point.
(r ~ NumType (HalfLineLineSegmentIntersection point segment),
 d ~ Dimension (HalfLineLineSegmentIntersection point segment),
 Num r, Point_ point d r) =>
point
-> HalfLineLineSegmentIntersection point segment -> (Point d r, r)
pointClosestToWithDistance point
q = \case
    HalfLine_x_LineSegment_Point point
p         -> point -> point -> (Point d r, r)
forall g r (d :: Nat) point.
(HasSquaredEuclideanDistance g, r ~ NumType g, d ~ Dimension g,
 Num r, Point_ point d r) =>
point -> g -> (Point d r, r)
forall r (d :: Nat) point.
(r ~ NumType point, d ~ Dimension point, Num r,
 Point_ point d r) =>
point -> point -> (Point d r, r)
pointClosestToWithDistance point
q point
p
    HalfLine_x_LineSegment_LineSegment segment
seg -> point -> segment -> (Point d r, r)
forall g r (d :: Nat) point.
(HasSquaredEuclideanDistance g, r ~ NumType g, d ~ Dimension g,
 Num r, Point_ point d r) =>
point -> g -> (Point d r, r)
forall r (d :: Nat) point.
(r ~ NumType segment, d ~ Dimension segment, Num r,
 Point_ point d r) =>
point -> segment -> (Point d r, r)
pointClosestToWithDistance point
q segment
seg


--------------------------------------------------------------------------------
-- * Intersection of HalfSpaces and Line segments

instance ( Point_ point d r, Ord r, Num r
         , HyperPlane_ plane d r
         ) => HasIntersectionWith (ClosedLineSegment point) (HalfSpaceF plane) where
  ClosedLineSegment point
seg intersects :: ClosedLineSegment point -> HalfSpaceF plane -> Bool
`intersects` HalfSpaceF plane
halfSpace = (ClosedLineSegment point
segClosedLineSegment point
-> Getting (Point d r) (ClosedLineSegment point) (Point d r)
-> Point d r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point d r) point)
-> ClosedLineSegment point
-> Const (Point d r) (ClosedLineSegment point)
forall seg p. HasStart seg p => Lens' seg p
Lens' (ClosedLineSegment point) point
start((point -> Const (Point d r) point)
 -> ClosedLineSegment point
 -> Const (Point d r) (ClosedLineSegment point))
-> ((Point d r -> Const (Point d r) (Point d r))
    -> point -> Const (Point d r) point)
-> Getting (Point d r) (ClosedLineSegment point) (Point d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point d r -> Const (Point d r) (Point d r))
-> point -> Const (Point d r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point d r)
asPoint) Point d r -> HalfSpaceF plane -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` HalfSpaceF plane
halfSpace
                            Bool -> Bool -> Bool
|| (ClosedLineSegment point
segClosedLineSegment point
-> Getting (Point d r) (ClosedLineSegment point) (Point d r)
-> Point d r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point d r) point)
-> ClosedLineSegment point
-> Const (Point d r) (ClosedLineSegment point)
forall seg p. HasEnd seg p => Lens' seg p
Lens' (ClosedLineSegment point) point
end((point -> Const (Point d r) point)
 -> ClosedLineSegment point
 -> Const (Point d r) (ClosedLineSegment point))
-> ((Point d r -> Const (Point d r) (Point d r))
    -> point -> Const (Point d r) point)
-> Getting (Point d r) (ClosedLineSegment point) (Point d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point d r -> Const (Point d r) (Point d r))
-> point -> Const (Point d r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point d r)
asPoint)   Point d r -> HalfSpaceF plane -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` HalfSpaceF plane
halfSpace


type instance Intersection (ClosedLineSegment point) (HalfSpaceF plane) =
  Maybe (ClosedSegmentHalfSpaceIntersection (CanonicalPoint point)
                                            point
        )


-- | Models the intersection of a closed linesegment and halfspace
-- if the segment intersects the bounding hyperplane, the intersection point
-- is of type extra.
data ClosedSegmentHalfSpaceIntersection extra point =
    ClosedLineSegment_x_HalfSpace_Point           point
  | ClosedLineSegment_x_HalfSpace_SubSegment      (ClosedLineSegment (OriginalOrExtra point extra))
  -- ^ the subsegment is always oriented from the intersection point towards the original point
  -- note that this may reverse the original input segment.
  | ClosedLineSegment_x_HalfSpace_CompleteSegment (ClosedLineSegment point)
  deriving (Int -> ClosedSegmentHalfSpaceIntersection extra point -> ShowS
[ClosedSegmentHalfSpaceIntersection extra point] -> ShowS
ClosedSegmentHalfSpaceIntersection extra point -> String
(Int -> ClosedSegmentHalfSpaceIntersection extra point -> ShowS)
-> (ClosedSegmentHalfSpaceIntersection extra point -> String)
-> ([ClosedSegmentHalfSpaceIntersection extra point] -> ShowS)
-> Show (ClosedSegmentHalfSpaceIntersection extra point)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall extra point.
(Show point, Show extra) =>
Int -> ClosedSegmentHalfSpaceIntersection extra point -> ShowS
forall extra point.
(Show point, Show extra) =>
[ClosedSegmentHalfSpaceIntersection extra point] -> ShowS
forall extra point.
(Show point, Show extra) =>
ClosedSegmentHalfSpaceIntersection extra point -> String
$cshowsPrec :: forall extra point.
(Show point, Show extra) =>
Int -> ClosedSegmentHalfSpaceIntersection extra point -> ShowS
showsPrec :: Int -> ClosedSegmentHalfSpaceIntersection extra point -> ShowS
$cshow :: forall extra point.
(Show point, Show extra) =>
ClosedSegmentHalfSpaceIntersection extra point -> String
show :: ClosedSegmentHalfSpaceIntersection extra point -> String
$cshowList :: forall extra point.
(Show point, Show extra) =>
[ClosedSegmentHalfSpaceIntersection extra point] -> ShowS
showList :: [ClosedSegmentHalfSpaceIntersection extra point] -> ShowS
Show,ClosedSegmentHalfSpaceIntersection extra point
-> ClosedSegmentHalfSpaceIntersection extra point -> Bool
(ClosedSegmentHalfSpaceIntersection extra point
 -> ClosedSegmentHalfSpaceIntersection extra point -> Bool)
-> (ClosedSegmentHalfSpaceIntersection extra point
    -> ClosedSegmentHalfSpaceIntersection extra point -> Bool)
-> Eq (ClosedSegmentHalfSpaceIntersection extra point)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall extra point.
(Eq point, Eq extra) =>
ClosedSegmentHalfSpaceIntersection extra point
-> ClosedSegmentHalfSpaceIntersection extra point -> Bool
$c== :: forall extra point.
(Eq point, Eq extra) =>
ClosedSegmentHalfSpaceIntersection extra point
-> ClosedSegmentHalfSpaceIntersection extra point -> Bool
== :: ClosedSegmentHalfSpaceIntersection extra point
-> ClosedSegmentHalfSpaceIntersection extra point -> Bool
$c/= :: forall extra point.
(Eq point, Eq extra) =>
ClosedSegmentHalfSpaceIntersection extra point
-> ClosedSegmentHalfSpaceIntersection extra point -> Bool
/= :: ClosedSegmentHalfSpaceIntersection extra point
-> ClosedSegmentHalfSpaceIntersection extra point -> Bool
Eq)


instance ( Point_ point 2 r, Ord r, Fractional r
         , HyperPlane_ plane 2 r
         , IsIntersectableWith (LinePV 2 r) plane
         , Intersection (LinePV 2 r) plane ~ Maybe (LineLineIntersectionG r line')
         ) => IsIntersectableWith (ClosedLineSegment point) (HalfSpaceF plane) where
  ClosedLineSegment point
seg intersect :: ClosedLineSegment point
-> HalfSpaceF plane
-> Intersection (ClosedLineSegment point) (HalfSpaceF plane)
`intersect` HalfSpaceF plane
halfSpace = case (ClosedLineSegment point
segClosedLineSegment point
-> Getting (Point 2 r) (ClosedLineSegment point) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> ClosedLineSegment point
-> Const (Point 2 r) (ClosedLineSegment point)
forall seg p. HasStart seg p => Lens' seg p
Lens' (ClosedLineSegment point) point
start((point -> Const (Point 2 r) point)
 -> ClosedLineSegment point
 -> Const (Point 2 r) (ClosedLineSegment point))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) (ClosedLineSegment point) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint) Point 2 r
-> HalfSpaceF plane -> Intersection (Point 2 r) (HalfSpaceF plane)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` HalfSpaceF plane
halfSpace of
      Maybe (Point_x_HalfSpace_Intersection (Point 2 r) (Point 2 r))
Intersection (Point 2 r) (HalfSpaceF plane)
Nothing -> case Intersection (Point 2 r) (HalfSpaceF plane)
mxEnd of
        Maybe (Point_x_HalfSpace_Intersection (Point 2 r) (Point 2 r))
Intersection (Point 2 r) (HalfSpaceF plane)
Nothing   -> Maybe (ClosedSegmentHalfSpaceIntersection (Point 2 r) point)
Intersection (ClosedLineSegment point) (HalfSpaceF plane)
forall a. Maybe a
Nothing
        Just Point_x_HalfSpace_Intersection (Point 2 r) (Point 2 r)
xEnd -> ClosedSegmentHalfSpaceIntersection (Point 2 r) point
-> Maybe (ClosedSegmentHalfSpaceIntersection (Point 2 r) point)
forall a. a -> Maybe a
Just (ClosedSegmentHalfSpaceIntersection (Point 2 r) point
 -> Maybe (ClosedSegmentHalfSpaceIntersection (Point 2 r) point))
-> ClosedSegmentHalfSpaceIntersection (Point 2 r) point
-> Maybe (ClosedSegmentHalfSpaceIntersection (Point 2 r) point)
forall a b. (a -> b) -> a -> b
$ case Point_x_HalfSpace_Intersection (Point 2 r) (Point 2 r)
xEnd of
          Point_x_HalfSpace_OnBoundary Point 2 r
_ -> point -> ClosedSegmentHalfSpaceIntersection (Point 2 r) point
forall extra point.
point -> ClosedSegmentHalfSpaceIntersection extra point
ClosedLineSegment_x_HalfSpace_Point (ClosedLineSegment point
segClosedLineSegment point
-> Getting point (ClosedLineSegment point) point -> point
forall s a. s -> Getting a s a -> a
^.Getting point (ClosedLineSegment point) point
forall seg p. HasEnd seg p => Lens' seg p
Lens' (ClosedLineSegment point) point
end)
          Point_x_HalfSpace_Interior   Point 2 r
t -> point
-> Point 2 r
-> Point 2 r
-> ClosedSegmentHalfSpaceIntersection (Point 2 r) point
subSegment (ClosedLineSegment point
segClosedLineSegment point
-> Getting point (ClosedLineSegment point) point -> point
forall s a. s -> Getting a s a -> a
^.Getting point (ClosedLineSegment point) point
forall seg p. HasEnd seg p => Lens' seg p
Lens' (ClosedLineSegment point) point
end) Point 2 r
t (ClosedLineSegment point
segClosedLineSegment point
-> Getting (Point 2 r) (ClosedLineSegment point) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> ClosedLineSegment point
-> Const (Point 2 r) (ClosedLineSegment point)
forall seg p. HasStart seg p => Lens' seg p
Lens' (ClosedLineSegment point) point
start((point -> Const (Point 2 r) point)
 -> ClosedLineSegment point
 -> Const (Point 2 r) (ClosedLineSegment point))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) (ClosedLineSegment point) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint)

      Just Point_x_HalfSpace_Intersection (Point 2 r) (Point 2 r)
xStart -> ClosedSegmentHalfSpaceIntersection (Point 2 r) point
-> Maybe (ClosedSegmentHalfSpaceIntersection (Point 2 r) point)
forall a. a -> Maybe a
Just (ClosedSegmentHalfSpaceIntersection (Point 2 r) point
 -> Maybe (ClosedSegmentHalfSpaceIntersection (Point 2 r) point))
-> ClosedSegmentHalfSpaceIntersection (Point 2 r) point
-> Maybe (ClosedSegmentHalfSpaceIntersection (Point 2 r) point)
forall a b. (a -> b) -> a -> b
$ case Point_x_HalfSpace_Intersection (Point 2 r) (Point 2 r)
xStart of
        Point_x_HalfSpace_OnBoundary Point 2 r
_ -> case Intersection (Point 2 r) (HalfSpaceF plane)
mxEnd of
          Maybe (Point_x_HalfSpace_Intersection (Point 2 r) (Point 2 r))
Intersection (Point 2 r) (HalfSpaceF plane)
Nothing  -> point -> ClosedSegmentHalfSpaceIntersection (Point 2 r) point
forall extra point.
point -> ClosedSegmentHalfSpaceIntersection extra point
ClosedLineSegment_x_HalfSpace_Point (ClosedLineSegment point
segClosedLineSegment point
-> Getting point (ClosedLineSegment point) point -> point
forall s a. s -> Getting a s a -> a
^.Getting point (ClosedLineSegment point) point
forall seg p. HasStart seg p => Lens' seg p
Lens' (ClosedLineSegment point) point
start)
          Just Point_x_HalfSpace_Intersection (Point 2 r) (Point 2 r)
_   -> ClosedSegmentHalfSpaceIntersection (Point 2 r) point
completeSeg
        Point_x_HalfSpace_Interior Point 2 r
s   -> case Intersection (Point 2 r) (HalfSpaceF plane)
mxEnd of
          Maybe (Point_x_HalfSpace_Intersection (Point 2 r) (Point 2 r))
Intersection (Point 2 r) (HalfSpaceF plane)
Nothing  -> point
-> Point 2 r
-> Point 2 r
-> ClosedSegmentHalfSpaceIntersection (Point 2 r) point
subSegment (ClosedLineSegment point
segClosedLineSegment point
-> Getting point (ClosedLineSegment point) point -> point
forall s a. s -> Getting a s a -> a
^.Getting point (ClosedLineSegment point) point
forall seg p. HasStart seg p => Lens' seg p
Lens' (ClosedLineSegment point) point
start) Point 2 r
s (ClosedLineSegment point
segClosedLineSegment point
-> Getting (Point 2 r) (ClosedLineSegment point) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> ClosedLineSegment point
-> Const (Point 2 r) (ClosedLineSegment point)
forall seg p. HasEnd seg p => Lens' seg p
Lens' (ClosedLineSegment point) point
end((point -> Const (Point 2 r) point)
 -> ClosedLineSegment point
 -> Const (Point 2 r) (ClosedLineSegment point))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) (ClosedLineSegment point) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint)
          Just Point_x_HalfSpace_Intersection (Point 2 r) (Point 2 r)
_   -> ClosedSegmentHalfSpaceIntersection (Point 2 r) point
completeSeg
    where
      completeSeg :: ClosedSegmentHalfSpaceIntersection (Point 2 r) point
completeSeg = ClosedLineSegment point
-> ClosedSegmentHalfSpaceIntersection (Point 2 r) point
forall extra point.
ClosedLineSegment point
-> ClosedSegmentHalfSpaceIntersection extra point
ClosedLineSegment_x_HalfSpace_CompleteSegment ClosedLineSegment point
seg
      mxEnd :: Intersection (Point 2 r) (HalfSpaceF plane)
mxEnd = (ClosedLineSegment point
segClosedLineSegment point
-> Getting (Point 2 r) (ClosedLineSegment point) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> ClosedLineSegment point
-> Const (Point 2 r) (ClosedLineSegment point)
forall seg p. HasEnd seg p => Lens' seg p
Lens' (ClosedLineSegment point) point
end((point -> Const (Point 2 r) point)
 -> ClosedLineSegment point
 -> Const (Point 2 r) (ClosedLineSegment point))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) (ClosedLineSegment point) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint)   Point 2 r
-> HalfSpaceF plane -> Intersection (Point 2 r) (HalfSpaceF plane)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` HalfSpaceF plane
halfSpace

      -- Compute the subsegment ; we are guarnteed that inP is inside and outP is outside
      -- the haflspace
      subSegment :: point
-> Point 2 r
-> Point 2 r
-> ClosedSegmentHalfSpaceIntersection (Point 2 r) point
subSegment point
inP' Point 2 r
inP Point 2 r
outP = ClosedLineSegment (OriginalOrExtra point (Point 2 r))
-> ClosedSegmentHalfSpaceIntersection (Point 2 r) point
forall extra point.
ClosedLineSegment (OriginalOrExtra point extra)
-> ClosedSegmentHalfSpaceIntersection extra point
ClosedLineSegment_x_HalfSpace_SubSegment
                               (ClosedLineSegment (OriginalOrExtra point (Point 2 r))
 -> ClosedSegmentHalfSpaceIntersection (Point 2 r) point)
-> (OriginalOrExtra point (Point 2 r)
    -> ClosedLineSegment (OriginalOrExtra point (Point 2 r)))
-> OriginalOrExtra point (Point 2 r)
-> ClosedSegmentHalfSpaceIntersection (Point 2 r) point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OriginalOrExtra point (Point 2 r)
-> OriginalOrExtra point (Point 2 r)
-> ClosedLineSegment (OriginalOrExtra point (Point 2 r))
forall point. point -> point -> ClosedLineSegment point
ClosedLineSegment (point -> OriginalOrExtra point (Point 2 r)
forall orig extra. orig -> OriginalOrExtra orig extra
Original point
inP')
                               (OriginalOrExtra point (Point 2 r)
 -> ClosedSegmentHalfSpaceIntersection (Point 2 r) point)
-> OriginalOrExtra point (Point 2 r)
-> ClosedSegmentHalfSpaceIntersection (Point 2 r) point
forall a b. (a -> b) -> a -> b
$ case Point 2 r -> Vector 2 r -> LinePV 2 r
forall (d :: Nat) r. Point d r -> Vector d r -> LinePV d r
LinePV Point 2 r
inP (Point 2 r
outP Point 2 r -> Point 2 r -> Vector 2 r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> point -> Vector d r
.-. Point 2 r
inP)
                                       LinePV 2 r -> plane -> Intersection (LinePV 2 r) plane
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` (HalfSpaceF plane
halfSpaceHalfSpaceF plane -> Getting plane (HalfSpaceF plane) plane -> plane
forall s a. s -> Getting a s a -> a
^.Getting plane (HalfSpaceF plane) plane
(BoundingHyperPlane (HalfSpaceF plane) 2 r
 -> Const plane (BoundingHyperPlane (HalfSpaceF plane) 2 r))
-> HalfSpaceF plane -> Const plane (HalfSpaceF plane)
forall halfSpace (d :: Nat) r.
HalfSpace_ halfSpace d r =>
Lens' halfSpace (BoundingHyperPlane halfSpace d r)
Lens'
  (HalfSpaceF plane) (BoundingHyperPlane (HalfSpaceF plane) 2 r)
boundingHyperPlane) of
        Just (Line_x_Line_Point Point 2 r
p) -> Point 2 r -> OriginalOrExtra point (Point 2 r)
forall orig extra. extra -> OriginalOrExtra orig extra
Extra Point 2 r
p
        Intersection (LinePV 2 r) plane
_                          -> String -> OriginalOrExtra point (Point 2 r)
forall a. HasCallStack => String -> a
error String
"line segment x halfspace intersection: absurd"