{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{- HLINT ignore "Use camelCase" -}
module HGeometry.HalfSpace.Intersection
  ( HalfPlaneIntersection(..)
  , LineHalfPlaneIntersection(..)

  , GetDirection(..)
  ) where

import Control.Lens
import HGeometry.HalfSpace.Type
import HGeometry.HyperPlane
import HGeometry.Intersection
import HGeometry.Line
import HGeometry.HalfLine
import HGeometry.Point
import HGeometry.Slab
import HGeometry.Cone
import HGeometry.Properties (NumType,Dimension)
import HGeometry.Vector
import HGeometry.Ext

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

-- | The non-empty intersection of two halfPlanes
data HalfPlaneIntersection r halfPlane =
    HalfPlane_x_HalfPlane_Line (BoundingHyperPlane halfPlane 2 r)
  | HalfPlane_x_HalfPlane_Slab (Slab r halfPlane)
  | HalfPlane_x_HalfPlane_Cone (Cone r (Point 2 r) halfPlane)
  | HalfPlane_x_HalfPlane_HalfPlane halfPlane

deriving instance (Show r, Show halfPlane, Show (BoundingHyperPlane halfPlane 2 r)
                  ) => Show (HalfPlaneIntersection r halfPlane)
deriving instance (Ord r, Num r, Eq halfPlane, Eq (BoundingHyperPlane halfPlane 2 r)
                  ) => Eq (HalfPlaneIntersection r halfPlane)

type instance NumType   (HalfPlaneIntersection r halfPlane) = r
type instance Dimension (HalfPlaneIntersection r halfPlane) = 2


type instance Intersection (HalfSpaceF (LinePV 2 r)) (HalfSpaceF (LinePV 2 r)) =
  Maybe (HalfPlaneIntersection r (HalfSpaceF (LinePV 2 r)))

instance ( Fractional r, Ord r
         ) => IsIntersectableWith (HalfSpaceF (LinePV 2 r)) (HalfSpaceF (LinePV 2 r)) where
  intersect :: HalfSpaceF (LinePV 2 r)
-> HalfSpaceF (LinePV 2 r)
-> Intersection (HalfSpaceF (LinePV 2 r)) (HalfSpaceF (LinePV 2 r))
intersect = HalfSpaceF (LinePV 2 r)
-> HalfSpaceF (LinePV 2 r)
-> Maybe (HalfPlaneIntersection r (HalfSpaceF (LinePV 2 r)))
HalfSpaceF (LinePV 2 r)
-> HalfSpaceF (LinePV 2 r)
-> Intersection (HalfSpaceF (LinePV 2 r)) (HalfSpaceF (LinePV 2 r))
forall halfPlane r.
(HalfPlane_ halfPlane r, Fractional r, Ord r,
 HyperPlane_ (BoundingHyperPlane halfPlane 2 r) 2 r,
 HasIntersectionWith (Point 2 r) halfPlane,
 HasPickInteriorPoint (BoundingHyperPlane halfPlane 2 r) 2 r,
 GetDirection (BoundingHyperPlane halfPlane 2 r),
 IsIntersectableWith
   (BoundingHyperPlane halfPlane 2 r)
   (BoundingHyperPlane halfPlane 2 r),
 HasSupportingLine (BoundingHyperPlane halfPlane 2 r),
 Intersection
   (BoundingHyperPlane halfPlane 2 r)
   (BoundingHyperPlane halfPlane 2 r)
 ~ Maybe
     (LineLineIntersection (BoundingHyperPlane halfPlane 2 r))) =>
halfPlane -> halfPlane -> Maybe (HalfPlaneIntersection r halfPlane)
intersectTwo

type instance Intersection (HalfSpaceF (LineEQ r)) (HalfSpaceF (LineEQ r)) =
  Maybe (HalfPlaneIntersection r (HalfSpaceF (LineEQ r)))

instance ( Fractional r, Ord r
         ) => IsIntersectableWith (HalfSpaceF (LineEQ r)) (HalfSpaceF (LineEQ r)) where
  intersect :: HalfSpaceF (LineEQ r)
-> HalfSpaceF (LineEQ r)
-> Intersection (HalfSpaceF (LineEQ r)) (HalfSpaceF (LineEQ r))
intersect = HalfSpaceF (LineEQ r)
-> HalfSpaceF (LineEQ r)
-> Maybe (HalfPlaneIntersection r (HalfSpaceF (LineEQ r)))
HalfSpaceF (LineEQ r)
-> HalfSpaceF (LineEQ r)
-> Intersection (HalfSpaceF (LineEQ r)) (HalfSpaceF (LineEQ r))
forall halfPlane r.
(HalfPlane_ halfPlane r, Fractional r, Ord r,
 HyperPlane_ (BoundingHyperPlane halfPlane 2 r) 2 r,
 HasIntersectionWith (Point 2 r) halfPlane,
 HasPickInteriorPoint (BoundingHyperPlane halfPlane 2 r) 2 r,
 GetDirection (BoundingHyperPlane halfPlane 2 r),
 IsIntersectableWith
   (BoundingHyperPlane halfPlane 2 r)
   (BoundingHyperPlane halfPlane 2 r),
 HasSupportingLine (BoundingHyperPlane halfPlane 2 r),
 Intersection
   (BoundingHyperPlane halfPlane 2 r)
   (BoundingHyperPlane halfPlane 2 r)
 ~ Maybe
     (LineLineIntersection (BoundingHyperPlane halfPlane 2 r))) =>
halfPlane -> halfPlane -> Maybe (HalfPlaneIntersection r halfPlane)
intersectTwo

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


-- | Computes the intersection of two halfplanes
intersectTwo :: forall halfPlane r.
                ( HalfPlane_ halfPlane r
                , Fractional r, Ord r
                , HyperPlane_ (BoundingHyperPlane halfPlane 2 r) 2 r
                , HasIntersectionWith (Point 2 r) halfPlane
                , HasPickInteriorPoint (BoundingHyperPlane halfPlane 2 r) 2 r
                , GetDirection (BoundingHyperPlane halfPlane 2 r)
                , IsIntersectableWith (BoundingHyperPlane halfPlane 2 r) (BoundingHyperPlane halfPlane 2 r)
                , HasSupportingLine (BoundingHyperPlane halfPlane 2 r)
                , Intersection (BoundingHyperPlane halfPlane 2 r)
                  (BoundingHyperPlane halfPlane 2 r)
                  ~ Maybe (LineLineIntersection (BoundingHyperPlane halfPlane 2 r))
                ) => halfPlane -> halfPlane -> Maybe (HalfPlaneIntersection r halfPlane)
intersectTwo :: forall halfPlane r.
(HalfPlane_ halfPlane r, Fractional r, Ord r,
 HyperPlane_ (BoundingHyperPlane halfPlane 2 r) 2 r,
 HasIntersectionWith (Point 2 r) halfPlane,
 HasPickInteriorPoint (BoundingHyperPlane halfPlane 2 r) 2 r,
 GetDirection (BoundingHyperPlane halfPlane 2 r),
 IsIntersectableWith
   (BoundingHyperPlane halfPlane 2 r)
   (BoundingHyperPlane halfPlane 2 r),
 HasSupportingLine (BoundingHyperPlane halfPlane 2 r),
 Intersection
   (BoundingHyperPlane halfPlane 2 r)
   (BoundingHyperPlane halfPlane 2 r)
 ~ Maybe
     (LineLineIntersection (BoundingHyperPlane halfPlane 2 r))) =>
halfPlane -> halfPlane -> Maybe (HalfPlaneIntersection r halfPlane)
intersectTwo halfPlane
h1 halfPlane
h2 = case BoundingHyperPlane halfPlane 2 r
l1 BoundingHyperPlane halfPlane 2 r
-> BoundingHyperPlane halfPlane 2 r
-> Intersection
     (BoundingHyperPlane halfPlane 2 r)
     (BoundingHyperPlane halfPlane 2 r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` BoundingHyperPlane halfPlane 2 r
l2 of
    Maybe (LineLineIntersectionG r (BoundingHyperPlane halfPlane 2 r))
Intersection
  (BoundingHyperPlane halfPlane 2 r)
  (BoundingHyperPlane halfPlane 2 r)
Nothing -> case (BoundingHyperPlane halfPlane 2 r -> Point 2 r
forall geom (d :: Nat) r.
HasPickInteriorPoint geom d r =>
geom -> Point d r
pointInteriorTo BoundingHyperPlane halfPlane 2 r
l1 Point 2 r -> halfPlane -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` halfPlane
h2, BoundingHyperPlane halfPlane 2 r -> Point 2 r
forall geom (d :: Nat) r.
HasPickInteriorPoint geom d r =>
geom -> Point d r
pointInteriorTo BoundingHyperPlane halfPlane 2 r
l2 Point 2 r -> halfPlane -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` halfPlane
h1) of
      (Bool
False,Bool
False) -> Maybe (HalfPlaneIntersection r halfPlane)
forall a. Maybe a
Nothing
      (Bool
True, Bool
False) -> HalfPlaneIntersection r halfPlane
-> Maybe (HalfPlaneIntersection r halfPlane)
forall a. a -> Maybe a
Just (HalfPlaneIntersection r halfPlane
 -> Maybe (HalfPlaneIntersection r halfPlane))
-> HalfPlaneIntersection r halfPlane
-> Maybe (HalfPlaneIntersection r halfPlane)
forall a b. (a -> b) -> a -> b
$ halfPlane -> HalfPlaneIntersection r halfPlane
forall r halfPlane. halfPlane -> HalfPlaneIntersection r halfPlane
HalfPlane_x_HalfPlane_HalfPlane halfPlane
h1
      (Bool
False, Bool
True) -> HalfPlaneIntersection r halfPlane
-> Maybe (HalfPlaneIntersection r halfPlane)
forall a. a -> Maybe a
Just (HalfPlaneIntersection r halfPlane
 -> Maybe (HalfPlaneIntersection r halfPlane))
-> HalfPlaneIntersection r halfPlane
-> Maybe (HalfPlaneIntersection r halfPlane)
forall a b. (a -> b) -> a -> b
$ halfPlane -> HalfPlaneIntersection r halfPlane
forall r halfPlane. halfPlane -> HalfPlaneIntersection r halfPlane
HalfPlane_x_HalfPlane_HalfPlane halfPlane
h2
      (Bool
True,Bool
True)   -> HalfPlaneIntersection r halfPlane
-> Maybe (HalfPlaneIntersection r halfPlane)
forall a. a -> Maybe a
Just (HalfPlaneIntersection r halfPlane
 -> Maybe (HalfPlaneIntersection r halfPlane))
-> HalfPlaneIntersection r halfPlane
-> Maybe (HalfPlaneIntersection r halfPlane)
forall a b. (a -> b) -> a -> b
$ Slab r halfPlane -> HalfPlaneIntersection r halfPlane
forall r halfPlane.
Slab r halfPlane -> HalfPlaneIntersection r halfPlane
HalfPlane_x_HalfPlane_Slab (halfPlane -> halfPlane -> Slab r halfPlane
forall halfPlane r.
(HalfPlane_ halfPlane r, Num r, Fractional r,
 HasIntersectionWith (Point 2 r) halfPlane,
 HasSupportingLine (BoundingHyperPlane halfPlane 2 r)) =>
halfPlane -> halfPlane -> Slab r halfPlane
fromParalelHalfplanes halfPlane
h1 halfPlane
h2)
    Just LineLineIntersectionG r (BoundingHyperPlane halfPlane 2 r)
i  -> HalfPlaneIntersection r halfPlane
-> Maybe (HalfPlaneIntersection r halfPlane)
forall a. a -> Maybe a
Just (HalfPlaneIntersection r halfPlane
 -> Maybe (HalfPlaneIntersection r halfPlane))
-> HalfPlaneIntersection r halfPlane
-> Maybe (HalfPlaneIntersection r halfPlane)
forall a b. (a -> b) -> a -> b
$ case LineLineIntersectionG r (BoundingHyperPlane halfPlane 2 r)
i of
      Line_x_Line_Line BoundingHyperPlane halfPlane 2 r
l  -> let n :: Vector 2 r
n = BoundingHyperPlane halfPlane 2 r -> Vector 2 r
forall hyperPlane (d :: Nat) r.
(HyperPlane_ hyperPlane d r, Num r, Eq r, 1 <= d) =>
hyperPlane -> Vector d r
normalVector BoundingHyperPlane halfPlane 2 r
l
                                 q :: Point 2 r
q = BoundingHyperPlane halfPlane 2 r -> Point 2 r
forall geom (d :: Nat) r.
HasPickInteriorPoint geom d r =>
geom -> Point d r
pointInteriorTo BoundingHyperPlane halfPlane 2 r
l Point 2 r -> Vector 2 r -> Point 2 r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> Vector d r -> point
.+^ Vector 2 r
n
                             in if Point 2 r
q Point 2 r -> halfPlane -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` halfPlane
h1 Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Point 2 r
q Point 2 r -> halfPlane -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` halfPlane
h2
                                then halfPlane -> HalfPlaneIntersection r halfPlane
forall r halfPlane. halfPlane -> HalfPlaneIntersection r halfPlane
HalfPlane_x_HalfPlane_HalfPlane halfPlane
h1 -- same halfplane
                                else BoundingHyperPlane halfPlane 2 r
-> HalfPlaneIntersection r halfPlane
forall r halfPlane.
BoundingHyperPlane halfPlane 2 r
-> HalfPlaneIntersection r halfPlane
HalfPlane_x_HalfPlane_Line BoundingHyperPlane halfPlane 2 r
l -- oppositive halfplanes
      Line_x_Line_Point Point 2 r
a -> Cone r (Point 2 r) halfPlane -> HalfPlaneIntersection r halfPlane
forall r halfPlane.
Cone r (Point 2 r) halfPlane -> HalfPlaneIntersection r halfPlane
HalfPlane_x_HalfPlane_Cone (Cone r (Point 2 r) halfPlane -> HalfPlaneIntersection r halfPlane)
-> Cone r (Point 2 r) halfPlane
-> HalfPlaneIntersection r halfPlane
forall a b. (a -> b) -> a -> b
$ Point 2 r
-> (Vector 2 r :+ halfPlane)
-> (Vector 2 r :+ halfPlane)
-> Cone r (Point 2 r) halfPlane
forall r point edge.
point
-> (Vector 2 r :+ edge)
-> (Vector 2 r :+ edge)
-> Cone r point edge
Cone Point 2 r
a Vector 2 r :+ halfPlane
left Vector 2 r :+ halfPlane
right
        where
          v1 :: Vector 2 r
v1 = BoundingHyperPlane halfPlane 2 r -> Vector 2 r
forall line r (d :: Nat).
(GetDirection line, r ~ NumType line, d ~ Dimension line) =>
line -> Vector d r
forall r (d :: Nat).
(r ~ NumType (BoundingHyperPlane halfPlane 2 r),
 d ~ Dimension (BoundingHyperPlane halfPlane 2 r)) =>
BoundingHyperPlane halfPlane 2 r -> Vector d r
inLineVector BoundingHyperPlane halfPlane 2 r
l1
          v2 :: Vector 2 r
v2 = BoundingHyperPlane halfPlane 2 r -> Vector 2 r
forall line r (d :: Nat).
(GetDirection line, r ~ NumType line, d ~ Dimension line) =>
line -> Vector d r
forall r (d :: Nat).
(r ~ NumType (BoundingHyperPlane halfPlane 2 r),
 d ~ Dimension (BoundingHyperPlane halfPlane 2 r)) =>
BoundingHyperPlane halfPlane 2 r -> Vector d r
inLineVector BoundingHyperPlane halfPlane 2 r
l2
          (Vector 2 r :+ halfPlane
left,Vector 2 r :+ halfPlane
right)
            | Vector 2 r -> halfPlane -> Bool
isLeftHalfPlane Vector 2 r
v1 halfPlane
h1 = case Point 2 r -> Point 2 r -> Point 2 r -> 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 (Point 2 r
forall point (d :: Nat) r.
(Num r, ConstructablePoint_ point d r) =>
point
origin :: Point 2 r) (Vector 2 r -> Point 2 r
forall v. v -> PointF v
Point Vector 2 r
v1) (Vector 2 r -> Point 2 r
forall v. v -> PointF v
Point Vector 2 r
v2) of
                CCW
CCW | Vector 2 r -> halfPlane -> Bool
isLeftHalfPlane Vector 2 r
v2 halfPlane
h2 -> (Vector 2 r -> Vector 2 r
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
vector -> vector
negated Vector 2 r
v1 Vector 2 r -> halfPlane -> Vector 2 r :+ halfPlane
forall core extra. core -> extra -> core :+ extra
:+ halfPlane
h1, Vector 2 r
v2 Vector 2 r -> halfPlane -> Vector 2 r :+ halfPlane
forall core extra. core -> extra -> core :+ extra
:+ halfPlane
h2)
                    | Bool
otherwise             -> (Vector 2 r
v2 Vector 2 r -> halfPlane -> Vector 2 r :+ halfPlane
forall core extra. core -> extra -> core :+ extra
:+ halfPlane
h2,         Vector 2 r
v1 Vector 2 r -> halfPlane -> Vector 2 r :+ halfPlane
forall core extra. core -> extra -> core :+ extra
:+ halfPlane
h1)
                CCW
CW  | Vector 2 r -> halfPlane -> Bool
isLeftHalfPlane Vector 2 r
v2 halfPlane
h2 -> (Vector 2 r -> Vector 2 r
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
vector -> vector
negated Vector 2 r
v2 Vector 2 r -> halfPlane -> Vector 2 r :+ halfPlane
forall core extra. core -> extra -> core :+ extra
:+ halfPlane
h2, Vector 2 r
v1 Vector 2 r -> halfPlane -> Vector 2 r :+ halfPlane
forall core extra. core -> extra -> core :+ extra
:+ halfPlane
h1)
                    | Bool
otherwise             -> (Vector 2 r -> Vector 2 r
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
vector -> vector
negated Vector 2 r
v1 Vector 2 r -> halfPlane -> Vector 2 r :+ halfPlane
forall core extra. core -> extra -> core :+ extra
:+ halfPlane
h1, Vector 2 r -> Vector 2 r
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
vector -> vector
negated Vector 2 r
v2 Vector 2 r -> halfPlane -> Vector 2 r :+ halfPlane
forall core extra. core -> extra -> core :+ extra
:+ halfPlane
h2)
                CCW
CoLinear -> String -> (Vector 2 r :+ halfPlane, Vector 2 r :+ halfPlane)
forall a. HasCallStack => String -> a
error String
"absurd"
            | Bool
otherwise            = case Point 2 r -> Point 2 r -> Point 2 r -> 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 (Point 2 r
forall point (d :: Nat) r.
(Num r, ConstructablePoint_ point d r) =>
point
origin :: Point 2 r) (Vector 2 r -> Point 2 r
forall v. v -> PointF v
Point Vector 2 r
v1) (Vector 2 r -> Point 2 r
forall v. v -> PointF v
Point Vector 2 r
v2) of
                CCW
CCW | Vector 2 r -> halfPlane -> Bool
isLeftHalfPlane Vector 2 r
v2 halfPlane
h2 -> (Vector 2 r -> Vector 2 r
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
vector -> vector
negated Vector 2 r
v2 Vector 2 r -> halfPlane -> Vector 2 r :+ halfPlane
forall core extra. core -> extra -> core :+ extra
:+ halfPlane
h2, Vector 2 r -> Vector 2 r
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
vector -> vector
negated Vector 2 r
v1 Vector 2 r -> halfPlane -> Vector 2 r :+ halfPlane
forall core extra. core -> extra -> core :+ extra
:+ halfPlane
h1)
                    | Bool
otherwise             -> (Vector 2 r
v1 Vector 2 r -> halfPlane -> Vector 2 r :+ halfPlane
forall core extra. core -> extra -> core :+ extra
:+ halfPlane
h1,         Vector 2 r -> Vector 2 r
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
vector -> vector
negated Vector 2 r
v2 Vector 2 r -> halfPlane -> Vector 2 r :+ halfPlane
forall core extra. core -> extra -> core :+ extra
:+ halfPlane
h2)
                CCW
CW  | Vector 2 r -> halfPlane -> Bool
isLeftHalfPlane Vector 2 r
v2 halfPlane
h2 -> (Vector 2 r
v1 Vector 2 r -> halfPlane -> Vector 2 r :+ halfPlane
forall core extra. core -> extra -> core :+ extra
:+ halfPlane
h1,         Vector 2 r
v2 Vector 2 r -> halfPlane -> Vector 2 r :+ halfPlane
forall core extra. core -> extra -> core :+ extra
:+ halfPlane
h2)
                    | Bool
otherwise             -> (Vector 2 r
v2 Vector 2 r -> halfPlane -> Vector 2 r :+ halfPlane
forall core extra. core -> extra -> core :+ extra
:+ halfPlane
h2,         Vector 2 r -> Vector 2 r
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
vector -> vector
negated Vector 2 r
v1 Vector 2 r -> halfPlane -> Vector 2 r :+ halfPlane
forall core extra. core -> extra -> core :+ extra
:+ halfPlane
h1)
                CCW
CoLinear -> String -> (Vector 2 r :+ halfPlane, Vector 2 r :+ halfPlane)
forall a. HasCallStack => String -> a
error String
"absurd"

          isLeftHalfPlane :: Vector 2 r -> halfPlane -> Bool
isLeftHalfPlane (Vector2 r
x r
y) halfPlane
h = let w :: Vector 2 r
w = r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
Vector2 (-r
y) r
x
                                                -- perpendicular to v; pointing left
                                            in (Point 2 r
a Point 2 r -> Vector 2 r -> Point 2 r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> Vector d r -> point
.+^ Vector 2 r
w) Point 2 r -> halfPlane -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` halfPlane
h
  where
    l1 :: BoundingHyperPlane halfPlane 2 r
l1 = halfPlane
h1halfPlane
-> Getting
     (BoundingHyperPlane halfPlane 2 r)
     halfPlane
     (BoundingHyperPlane halfPlane 2 r)
-> BoundingHyperPlane halfPlane 2 r
forall s a. s -> Getting a s a -> a
^.Getting
  (BoundingHyperPlane halfPlane 2 r)
  halfPlane
  (BoundingHyperPlane halfPlane 2 r)
forall halfSpace (d :: Nat) r.
HalfSpace_ halfSpace d r =>
Lens' halfSpace (BoundingHyperPlane halfSpace d r)
Lens' halfPlane (BoundingHyperPlane halfPlane 2 r)
boundingHyperPlane
    l2 :: BoundingHyperPlane halfPlane 2 r
l2 = halfPlane
h2halfPlane
-> Getting
     (BoundingHyperPlane halfPlane 2 r)
     halfPlane
     (BoundingHyperPlane halfPlane 2 r)
-> BoundingHyperPlane halfPlane 2 r
forall s a. s -> Getting a s a -> a
^.Getting
  (BoundingHyperPlane halfPlane 2 r)
  halfPlane
  (BoundingHyperPlane halfPlane 2 r)
forall halfSpace (d :: Nat) r.
HalfSpace_ halfSpace d r =>
Lens' halfSpace (BoundingHyperPlane halfSpace d r)
Lens' halfPlane (BoundingHyperPlane halfPlane 2 r)
boundingHyperPlane

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

data LineHalfPlaneIntersection r line = Line_x_HalfPlane_Line     line
                                      | Line_x_HalfPlane_HalfLine (HalfLine (Point 2 r))
  deriving (Int -> LineHalfPlaneIntersection r line -> ShowS
[LineHalfPlaneIntersection r line] -> ShowS
LineHalfPlaneIntersection r line -> String
(Int -> LineHalfPlaneIntersection r line -> ShowS)
-> (LineHalfPlaneIntersection r line -> String)
-> ([LineHalfPlaneIntersection r line] -> ShowS)
-> Show (LineHalfPlaneIntersection r line)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall r line.
(Show line, Show r) =>
Int -> LineHalfPlaneIntersection r line -> ShowS
forall r line.
(Show line, Show r) =>
[LineHalfPlaneIntersection r line] -> ShowS
forall r line.
(Show line, Show r) =>
LineHalfPlaneIntersection r line -> String
$cshowsPrec :: forall r line.
(Show line, Show r) =>
Int -> LineHalfPlaneIntersection r line -> ShowS
showsPrec :: Int -> LineHalfPlaneIntersection r line -> ShowS
$cshow :: forall r line.
(Show line, Show r) =>
LineHalfPlaneIntersection r line -> String
show :: LineHalfPlaneIntersection r line -> String
$cshowList :: forall r line.
(Show line, Show r) =>
[LineHalfPlaneIntersection r line] -> ShowS
showList :: [LineHalfPlaneIntersection r line] -> ShowS
Show,LineHalfPlaneIntersection r line
-> LineHalfPlaneIntersection r line -> Bool
(LineHalfPlaneIntersection r line
 -> LineHalfPlaneIntersection r line -> Bool)
-> (LineHalfPlaneIntersection r line
    -> LineHalfPlaneIntersection r line -> Bool)
-> Eq (LineHalfPlaneIntersection r line)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall r line.
(Eq line, Eq r) =>
LineHalfPlaneIntersection r line
-> LineHalfPlaneIntersection r line -> Bool
$c== :: forall r line.
(Eq line, Eq r) =>
LineHalfPlaneIntersection r line
-> LineHalfPlaneIntersection r line -> Bool
== :: LineHalfPlaneIntersection r line
-> LineHalfPlaneIntersection r line -> Bool
$c/= :: forall r line.
(Eq line, Eq r) =>
LineHalfPlaneIntersection r line
-> LineHalfPlaneIntersection r line -> Bool
/= :: LineHalfPlaneIntersection r line
-> LineHalfPlaneIntersection r line -> Bool
Eq)


type instance NumType   (LineHalfPlaneIntersection r line) = r
type instance Dimension (LineHalfPlaneIntersection r line) = 2



instance ( Num r, Ord r
         ) => HasIntersectionWith (LinePV 2 r) (HalfSpaceF (LinePV 2 r)) where
  intersects :: LinePV 2 r -> HalfSpaceF (LinePV 2 r) -> Bool
intersects = LinePV 2 r -> HalfSpaceF (LinePV 2 r) -> Bool
forall halfPlane r line.
(HalfPlane_ halfPlane r, Num r, Ord r, HyperPlane_ line 2 r,
 HasPickInteriorPoint line 2 r,
 HasIntersectionWith line (BoundingHyperPlane halfPlane 2 r),
 HasIntersectionWith (Point 2 r) halfPlane) =>
line -> halfPlane -> Bool
intersectsLineHalfplane
instance ( Num r, Ord r
         ) => HasIntersectionWith (LinePV 2 r) (HalfSpaceF (LineEQ r)) where
  intersects :: LinePV 2 r -> HalfSpaceF (LineEQ r) -> Bool
intersects = LinePV 2 r -> HalfSpaceF (LineEQ r) -> Bool
forall halfPlane r line.
(HalfPlane_ halfPlane r, Num r, Ord r, HyperPlane_ line 2 r,
 HasPickInteriorPoint line 2 r,
 HasIntersectionWith line (BoundingHyperPlane halfPlane 2 r),
 HasIntersectionWith (Point 2 r) halfPlane) =>
line -> halfPlane -> Bool
intersectsLineHalfplane
instance ( Num r, Ord r
         ) => HasIntersectionWith (LinePV 2 r) (HalfSpaceF (VerticalOrLineEQ r)) where
  intersects :: LinePV 2 r -> HalfSpaceF (VerticalOrLineEQ r) -> Bool
intersects = LinePV 2 r -> HalfSpaceF (VerticalOrLineEQ r) -> Bool
forall halfPlane r line.
(HalfPlane_ halfPlane r, Num r, Ord r, HyperPlane_ line 2 r,
 HasPickInteriorPoint line 2 r,
 HasIntersectionWith line (BoundingHyperPlane halfPlane 2 r),
 HasIntersectionWith (Point 2 r) halfPlane) =>
line -> halfPlane -> Bool
intersectsLineHalfplane

instance ( Num r, Ord r
         ) => HasIntersectionWith (LineEQ r) (HalfSpaceF (LinePV 2 r)) where
  intersects :: LineEQ r -> HalfSpaceF (LinePV 2 r) -> Bool
intersects = LineEQ r -> HalfSpaceF (LinePV 2 r) -> Bool
forall halfPlane r line.
(HalfPlane_ halfPlane r, Num r, Ord r, HyperPlane_ line 2 r,
 HasPickInteriorPoint line 2 r,
 HasIntersectionWith line (BoundingHyperPlane halfPlane 2 r),
 HasIntersectionWith (Point 2 r) halfPlane) =>
line -> halfPlane -> Bool
intersectsLineHalfplane
instance ( Num r, Ord r
         ) => HasIntersectionWith (LineEQ r) (HalfSpaceF (LineEQ r)) where
  intersects :: LineEQ r -> HalfSpaceF (LineEQ r) -> Bool
intersects = LineEQ r -> HalfSpaceF (LineEQ r) -> Bool
forall halfPlane r line.
(HalfPlane_ halfPlane r, Num r, Ord r, HyperPlane_ line 2 r,
 HasPickInteriorPoint line 2 r,
 HasIntersectionWith line (BoundingHyperPlane halfPlane 2 r),
 HasIntersectionWith (Point 2 r) halfPlane) =>
line -> halfPlane -> Bool
intersectsLineHalfplane
instance ( Num r, Ord r
         ) => HasIntersectionWith (LineEQ r) (HalfSpaceF (VerticalOrLineEQ r)) where
  intersects :: LineEQ r -> HalfSpaceF (VerticalOrLineEQ r) -> Bool
intersects = LineEQ r -> HalfSpaceF (VerticalOrLineEQ r) -> Bool
forall halfPlane r line.
(HalfPlane_ halfPlane r, Num r, Ord r, HyperPlane_ line 2 r,
 HasPickInteriorPoint line 2 r,
 HasIntersectionWith line (BoundingHyperPlane halfPlane 2 r),
 HasIntersectionWith (Point 2 r) halfPlane) =>
line -> halfPlane -> Bool
intersectsLineHalfplane

instance ( Num r, Ord r
         ) => HasIntersectionWith (VerticalOrLineEQ r) (HalfSpaceF (LinePV 2 r)) where
  intersects :: VerticalOrLineEQ r -> HalfSpaceF (LinePV 2 r) -> Bool
intersects = VerticalOrLineEQ r -> HalfSpaceF (LinePV 2 r) -> Bool
forall halfPlane r line.
(HalfPlane_ halfPlane r, Num r, Ord r, HyperPlane_ line 2 r,
 HasPickInteriorPoint line 2 r,
 HasIntersectionWith line (BoundingHyperPlane halfPlane 2 r),
 HasIntersectionWith (Point 2 r) halfPlane) =>
line -> halfPlane -> Bool
intersectsLineHalfplane
instance ( Num r, Ord r
         ) => HasIntersectionWith (VerticalOrLineEQ r) (HalfSpaceF (LineEQ r)) where
  intersects :: VerticalOrLineEQ r -> HalfSpaceF (LineEQ r) -> Bool
intersects = VerticalOrLineEQ r -> HalfSpaceF (LineEQ r) -> Bool
forall halfPlane r line.
(HalfPlane_ halfPlane r, Num r, Ord r, HyperPlane_ line 2 r,
 HasPickInteriorPoint line 2 r,
 HasIntersectionWith line (BoundingHyperPlane halfPlane 2 r),
 HasIntersectionWith (Point 2 r) halfPlane) =>
line -> halfPlane -> Bool
intersectsLineHalfplane
instance ( Num r, Ord r
         ) => HasIntersectionWith (VerticalOrLineEQ r) (HalfSpaceF (VerticalOrLineEQ r)) where
  intersects :: VerticalOrLineEQ r -> HalfSpaceF (VerticalOrLineEQ r) -> Bool
intersects = VerticalOrLineEQ r -> HalfSpaceF (VerticalOrLineEQ r) -> Bool
forall halfPlane r line.
(HalfPlane_ halfPlane r, Num r, Ord r, HyperPlane_ line 2 r,
 HasPickInteriorPoint line 2 r,
 HasIntersectionWith line (BoundingHyperPlane halfPlane 2 r),
 HasIntersectionWith (Point 2 r) halfPlane) =>
line -> halfPlane -> Bool
intersectsLineHalfplane


-- | test if a line and a halfplane intersect
intersectsLineHalfplane     :: ( HalfPlane_ halfPlane r
                               , Num r, Ord r
                               , HyperPlane_ line 2 r
                               , HasPickInteriorPoint line 2 r
                               , HasIntersectionWith line (BoundingHyperPlane halfPlane 2 r)
                               , HasIntersectionWith (Point 2 r) halfPlane
                               ) => line -> halfPlane -> Bool
intersectsLineHalfplane :: forall halfPlane r line.
(HalfPlane_ halfPlane r, Num r, Ord r, HyperPlane_ line 2 r,
 HasPickInteriorPoint line 2 r,
 HasIntersectionWith line (BoundingHyperPlane halfPlane 2 r),
 HasIntersectionWith (Point 2 r) halfPlane) =>
line -> halfPlane -> Bool
intersectsLineHalfplane line
l halfPlane
h = (line
l line -> BoundingHyperPlane halfPlane 2 r -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` (halfPlane
hhalfPlane
-> Getting
     (BoundingHyperPlane halfPlane 2 r)
     halfPlane
     (BoundingHyperPlane halfPlane 2 r)
-> BoundingHyperPlane halfPlane 2 r
forall s a. s -> Getting a s a -> a
^.Getting
  (BoundingHyperPlane halfPlane 2 r)
  halfPlane
  (BoundingHyperPlane halfPlane 2 r)
forall halfSpace (d :: Nat) r.
HalfSpace_ halfSpace d r =>
Lens' halfSpace (BoundingHyperPlane halfSpace d r)
Lens' halfPlane (BoundingHyperPlane halfPlane 2 r)
boundingHyperPlane)) Bool -> Bool -> Bool
||
                              (line -> Point 2 r
forall geom (d :: Nat) r.
HasPickInteriorPoint geom d r =>
geom -> Point d r
pointInteriorTo line
l Point 2 r -> halfPlane -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` halfPlane
h)

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

type instance Intersection (LinePV 2 r) (HalfSpaceF (LinePV 2 r)) =
  Maybe (LineHalfPlaneIntersection r (LinePV 2 r))
type instance Intersection (LinePV 2 r) (HalfSpaceF (LineEQ r)) =
  Maybe (LineHalfPlaneIntersection r (LinePV 2 r))
type instance Intersection (LinePV 2 r) (HalfSpaceF (VerticalOrLineEQ r)) =
  Maybe (LineHalfPlaneIntersection r (LinePV 2 r))

instance ( Fractional r, Ord r
         ) => IsIntersectableWith (LinePV 2 r) (HalfSpaceF (LinePV 2 r)) where
  intersect :: LinePV 2 r
-> HalfSpaceF (LinePV 2 r)
-> Intersection (LinePV 2 r) (HalfSpaceF (LinePV 2 r))
intersect = LinePV 2 r
-> HalfSpaceF (LinePV 2 r)
-> Maybe (LineHalfPlaneIntersection r (LinePV 2 r))
LinePV 2 r
-> HalfSpaceF (LinePV 2 r)
-> Intersection (LinePV 2 r) (HalfSpaceF (LinePV 2 r))
forall halfPlane r line.
(HalfPlane_ halfPlane r, Fractional r, Ord r, HyperPlane_ line 2 r,
 HasPickInteriorPoint line 2 r,
 HyperPlane_ (BoundingHyperPlane halfPlane 2 r) 2 r,
 IsIntersectableWith line (BoundingHyperPlane halfPlane 2 r),
 GetDirection line, HasIntersectionWith (Point 2 r) halfPlane,
 Intersection line (BoundingHyperPlane halfPlane 2 r)
 ~ Maybe (LineLineIntersection line)) =>
line -> halfPlane -> Maybe (LineHalfPlaneIntersection r line)
intersectLineHalfplane
instance ( Fractional r, Ord r
         ) => IsIntersectableWith (LinePV 2 r) (HalfSpaceF (LineEQ r)) where
  intersect :: LinePV 2 r
-> HalfSpaceF (LineEQ r)
-> Intersection (LinePV 2 r) (HalfSpaceF (LineEQ r))
intersect = LinePV 2 r
-> HalfSpaceF (LineEQ r)
-> Maybe (LineHalfPlaneIntersection r (LinePV 2 r))
LinePV 2 r
-> HalfSpaceF (LineEQ r)
-> Intersection (LinePV 2 r) (HalfSpaceF (LineEQ r))
forall halfPlane r line.
(HalfPlane_ halfPlane r, Fractional r, Ord r, HyperPlane_ line 2 r,
 HasPickInteriorPoint line 2 r,
 HyperPlane_ (BoundingHyperPlane halfPlane 2 r) 2 r,
 IsIntersectableWith line (BoundingHyperPlane halfPlane 2 r),
 GetDirection line, HasIntersectionWith (Point 2 r) halfPlane,
 Intersection line (BoundingHyperPlane halfPlane 2 r)
 ~ Maybe (LineLineIntersection line)) =>
line -> halfPlane -> Maybe (LineHalfPlaneIntersection r line)
intersectLineHalfplane
instance ( Fractional r, Ord r
         ) => IsIntersectableWith (LinePV 2 r) (HalfSpaceF (VerticalOrLineEQ r)) where
  intersect :: LinePV 2 r
-> HalfSpaceF (VerticalOrLineEQ r)
-> Intersection (LinePV 2 r) (HalfSpaceF (VerticalOrLineEQ r))
intersect = LinePV 2 r
-> HalfSpaceF (VerticalOrLineEQ r)
-> Maybe (LineHalfPlaneIntersection r (LinePV 2 r))
LinePV 2 r
-> HalfSpaceF (VerticalOrLineEQ r)
-> Intersection (LinePV 2 r) (HalfSpaceF (VerticalOrLineEQ r))
forall halfPlane r line.
(HalfPlane_ halfPlane r, Fractional r, Ord r, HyperPlane_ line 2 r,
 HasPickInteriorPoint line 2 r,
 HyperPlane_ (BoundingHyperPlane halfPlane 2 r) 2 r,
 IsIntersectableWith line (BoundingHyperPlane halfPlane 2 r),
 GetDirection line, HasIntersectionWith (Point 2 r) halfPlane,
 Intersection line (BoundingHyperPlane halfPlane 2 r)
 ~ Maybe (LineLineIntersection line)) =>
line -> halfPlane -> Maybe (LineHalfPlaneIntersection r line)
intersectLineHalfplane


type instance Intersection (LineEQ r) (HalfSpaceF (LinePV 2 r)) =
  Maybe (LineHalfPlaneIntersection r (LineEQ r))
type instance Intersection (LineEQ r) (HalfSpaceF (LineEQ r)) =
  Maybe (LineHalfPlaneIntersection r (LineEQ r))
type instance Intersection (LineEQ r) (HalfSpaceF (VerticalOrLineEQ r)) =
  Maybe (LineHalfPlaneIntersection r (LineEQ r))

instance ( Fractional r, Ord r
         ) => IsIntersectableWith (LineEQ r) (HalfSpaceF (LinePV 2 r)) where
  intersect :: LineEQ r
-> HalfSpaceF (LinePV 2 r)
-> Intersection (LineEQ r) (HalfSpaceF (LinePV 2 r))
intersect = LineEQ r
-> HalfSpaceF (LinePV 2 r)
-> Maybe (LineHalfPlaneIntersection r (LineEQ r))
LineEQ r
-> HalfSpaceF (LinePV 2 r)
-> Intersection (LineEQ r) (HalfSpaceF (LinePV 2 r))
forall halfPlane r line.
(HalfPlane_ halfPlane r, Fractional r, Ord r, HyperPlane_ line 2 r,
 HasPickInteriorPoint line 2 r,
 HyperPlane_ (BoundingHyperPlane halfPlane 2 r) 2 r,
 IsIntersectableWith line (BoundingHyperPlane halfPlane 2 r),
 GetDirection line, HasIntersectionWith (Point 2 r) halfPlane,
 Intersection line (BoundingHyperPlane halfPlane 2 r)
 ~ Maybe (LineLineIntersection line)) =>
line -> halfPlane -> Maybe (LineHalfPlaneIntersection r line)
intersectLineHalfplane
instance ( Fractional r, Ord r
         ) => IsIntersectableWith (LineEQ r) (HalfSpaceF (LineEQ r)) where
  intersect :: LineEQ r
-> HalfSpaceF (LineEQ r)
-> Intersection (LineEQ r) (HalfSpaceF (LineEQ r))
intersect = LineEQ r
-> HalfSpaceF (LineEQ r)
-> Maybe (LineHalfPlaneIntersection r (LineEQ r))
LineEQ r
-> HalfSpaceF (LineEQ r)
-> Intersection (LineEQ r) (HalfSpaceF (LineEQ r))
forall halfPlane r line.
(HalfPlane_ halfPlane r, Fractional r, Ord r, HyperPlane_ line 2 r,
 HasPickInteriorPoint line 2 r,
 HyperPlane_ (BoundingHyperPlane halfPlane 2 r) 2 r,
 IsIntersectableWith line (BoundingHyperPlane halfPlane 2 r),
 GetDirection line, HasIntersectionWith (Point 2 r) halfPlane,
 Intersection line (BoundingHyperPlane halfPlane 2 r)
 ~ Maybe (LineLineIntersection line)) =>
line -> halfPlane -> Maybe (LineHalfPlaneIntersection r line)
intersectLineHalfplane
instance ( Fractional r, Ord r
         ) => IsIntersectableWith (LineEQ r) (HalfSpaceF (VerticalOrLineEQ r)) where
  intersect :: LineEQ r
-> HalfSpaceF (VerticalOrLineEQ r)
-> Intersection (LineEQ r) (HalfSpaceF (VerticalOrLineEQ r))
intersect = LineEQ r
-> HalfSpaceF (VerticalOrLineEQ r)
-> Maybe (LineHalfPlaneIntersection r (LineEQ r))
LineEQ r
-> HalfSpaceF (VerticalOrLineEQ r)
-> Intersection (LineEQ r) (HalfSpaceF (VerticalOrLineEQ r))
forall halfPlane r line.
(HalfPlane_ halfPlane r, Fractional r, Ord r, HyperPlane_ line 2 r,
 HasPickInteriorPoint line 2 r,
 HyperPlane_ (BoundingHyperPlane halfPlane 2 r) 2 r,
 IsIntersectableWith line (BoundingHyperPlane halfPlane 2 r),
 GetDirection line, HasIntersectionWith (Point 2 r) halfPlane,
 Intersection line (BoundingHyperPlane halfPlane 2 r)
 ~ Maybe (LineLineIntersection line)) =>
line -> halfPlane -> Maybe (LineHalfPlaneIntersection r line)
intersectLineHalfplane



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

-- | Insertsect a line and a halfplane
intersectLineHalfplane   :: ( HalfPlane_ halfPlane r
                            , Fractional r, Ord r
                            , HyperPlane_ line 2 r
                            , HasPickInteriorPoint line 2 r
                            , HyperPlane_ (BoundingHyperPlane halfPlane 2 r) 2 r
                            , IsIntersectableWith line (BoundingHyperPlane halfPlane 2 r)
                            , GetDirection line
                            , HasIntersectionWith (Point 2 r) halfPlane
                            , Intersection line (BoundingHyperPlane halfPlane 2 r)
                              ~ Maybe (LineLineIntersection line)
                            ) => line -> halfPlane -> Maybe (LineHalfPlaneIntersection r line)
intersectLineHalfplane :: forall halfPlane r line.
(HalfPlane_ halfPlane r, Fractional r, Ord r, HyperPlane_ line 2 r,
 HasPickInteriorPoint line 2 r,
 HyperPlane_ (BoundingHyperPlane halfPlane 2 r) 2 r,
 IsIntersectableWith line (BoundingHyperPlane halfPlane 2 r),
 GetDirection line, HasIntersectionWith (Point 2 r) halfPlane,
 Intersection line (BoundingHyperPlane halfPlane 2 r)
 ~ Maybe (LineLineIntersection line)) =>
line -> halfPlane -> Maybe (LineHalfPlaneIntersection r line)
intersectLineHalfplane line
l halfPlane
h = case line
l line
-> BoundingHyperPlane halfPlane 2 r
-> Intersection line (BoundingHyperPlane halfPlane 2 r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` (halfPlane
hhalfPlane
-> Getting
     (BoundingHyperPlane halfPlane 2 r)
     halfPlane
     (BoundingHyperPlane halfPlane 2 r)
-> BoundingHyperPlane halfPlane 2 r
forall s a. s -> Getting a s a -> a
^.Getting
  (BoundingHyperPlane halfPlane 2 r)
  halfPlane
  (BoundingHyperPlane halfPlane 2 r)
forall halfSpace (d :: Nat) r.
HalfSpace_ halfSpace d r =>
Lens' halfSpace (BoundingHyperPlane halfSpace d r)
Lens' halfPlane (BoundingHyperPlane halfPlane 2 r)
boundingHyperPlane) of
    Maybe (LineLineIntersectionG r line)
Intersection line (BoundingHyperPlane halfPlane 2 r)
Nothing
      | line -> Point 2 r
forall geom (d :: Nat) r.
HasPickInteriorPoint geom d r =>
geom -> Point d r
pointInteriorTo line
l Point 2 r -> halfPlane -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` halfPlane
h -> LineHalfPlaneIntersection r line
-> Maybe (LineHalfPlaneIntersection r line)
forall a. a -> Maybe a
Just (LineHalfPlaneIntersection r line
 -> Maybe (LineHalfPlaneIntersection r line))
-> LineHalfPlaneIntersection r line
-> Maybe (LineHalfPlaneIntersection r line)
forall a b. (a -> b) -> a -> b
$ line -> LineHalfPlaneIntersection r line
forall r line. line -> LineHalfPlaneIntersection r line
Line_x_HalfPlane_Line line
l
      | Bool
otherwise                        -> Maybe (LineHalfPlaneIntersection r line)
forall a. Maybe a
Nothing
    Just LineLineIntersectionG r line
i                               -> LineHalfPlaneIntersection r line
-> Maybe (LineHalfPlaneIntersection r line)
forall a. a -> Maybe a
Just (LineHalfPlaneIntersection r line
 -> Maybe (LineHalfPlaneIntersection r line))
-> LineHalfPlaneIntersection r line
-> Maybe (LineHalfPlaneIntersection r line)
forall a b. (a -> b) -> a -> b
$ case LineLineIntersectionG r line
i of
      Line_x_Line_Line line
_  -> line -> LineHalfPlaneIntersection r line
forall r line. line -> LineHalfPlaneIntersection r line
Line_x_HalfPlane_Line line
l
      Line_x_Line_Point Point 2 r
p -> HalfLine (Point 2 r) -> LineHalfPlaneIntersection r line
forall r line.
HalfLine (Point 2 r) -> LineHalfPlaneIntersection r line
Line_x_HalfPlane_HalfLine (Point 2 r
-> Vector (Dimension (Point 2 r)) (NumType (Point 2 r))
-> HalfLine (Point 2 r)
forall point.
point -> Vector (Dimension point) (NumType point) -> HalfLine point
HalfLine Point 2 r
p Vector 2 r
Vector (Dimension (Point 2 r)) (NumType (Point 2 r))
v)
        where
          v' :: Vector 2 r
v' = line -> Vector 2 r
forall line r (d :: Nat).
(GetDirection line, r ~ NumType line, d ~ Dimension line) =>
line -> Vector d r
forall r (d :: Nat).
(r ~ NumType line, d ~ Dimension line) =>
line -> Vector d r
inLineVector line
l
          v :: Vector 2 r
v = if Point 2 r
p Point 2 r -> Vector 2 r -> Point 2 r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> Vector d r -> point
.+^ Vector 2 r
v' Point 2 r -> halfPlane -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` halfPlane
h then Vector 2 r
v' else Vector 2 r -> Vector 2 r
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
vector -> vector
negated Vector 2 r
v'


--------------------------------------------------------------------------------
-- Helper class to implement line x halfplane intersection

class GetDirection line where
  -- | Get a vector v that lies in the line; i.e. given a point
  -- p that lies on the line; the point p .+^ v lies also in the line.
  inLineVector :: (r ~ NumType line, d ~ Dimension line) => line -> Vector d r

instance HasDirection line => GetDirection line where
  inLineVector :: forall r (d :: Nat).
(r ~ NumType line, d ~ Dimension line) =>
line -> Vector d r
inLineVector = Getting (Vector d r) line (Vector d r) -> line -> Vector d r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Vector d r) line (Vector d r)
forall (d :: Nat) r.
(Dimension line ~ d, NumType line ~ r) =>
Lens' line (Vector d r)
forall t (d :: Nat) r.
(HasDirection t, Dimension t ~ d, NumType t ~ r) =>
Lens' t (Vector d r)
Lens' line (Vector d r)
direction
instance {-# OVERLAPPING #-} Num r => GetDirection (LineEQ r) where
  inLineVector :: forall r (d :: Nat).
(r ~ NumType (LineEQ r), d ~ Dimension (LineEQ r)) =>
LineEQ r -> Vector d r
inLineVector (LineEQ r
a r
_) = r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
Vector2 r
1 r
r
a
  -- not sure why it thinks this is overlapping, but whatever
instance Num r => GetDirection (VerticalOrLineEQ r) where
  inLineVector :: forall r (d :: Nat).
(r ~ NumType (VerticalOrLineEQ r),
 d ~ Dimension (VerticalOrLineEQ r)) =>
VerticalOrLineEQ r -> Vector d r
inLineVector = \case
    VerticalLineThrough r
_ -> r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
Vector2 r
0 r
1
    NonVertical LineEQ r
l         -> LineEQ r -> Vector d r
forall line r (d :: Nat).
(GetDirection line, r ~ NumType line, d ~ Dimension line) =>
line -> Vector d r
forall r (d :: Nat).
(r ~ NumType (LineEQ r), d ~ Dimension (LineEQ r)) =>
LineEQ r -> Vector d r
inLineVector LineEQ r
l