{-# LANGUAGE TemplateHaskell  #-}
{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.Ball
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- \(d\)-dimensional Balls and Spheres
--
--------------------------------------------------------------------------------
module Data.Geometry.Ball where

import           Control.DeepSeq
import           Control.Lens
import           Data.Bifunctor
import           Data.Ext
import qualified Data.Foldable as F
import           Data.Geometry.Boundary
import           Data.Geometry.Line
import           Data.Geometry.LineSegment
import           Data.Geometry.Point
import           Data.Geometry.Properties
import           Data.Geometry.Vector
import qualified Data.List as L
import qualified Data.Traversable as T
import           Data.Vinyl
import           Data.Vinyl.CoRec
import           GHC.Generics (Generic)
import           Linear.Matrix
import           Linear.V3 (V3(..))

--------------------------------------------------------------------------------
-- * A d-dimensional ball

-- | A d-dimensional ball.
data Ball d p r = Ball { Ball d p r -> Point d r :+ p
_center        :: !(Point d r :+ p)
                       , Ball d p r -> r
_squaredRadius :: !r
                       } deriving (forall x. Ball d p r -> Rep (Ball d p r) x)
-> (forall x. Rep (Ball d p r) x -> Ball d p r)
-> Generic (Ball d p r)
forall x. Rep (Ball d p r) x -> Ball d p r
forall x. Ball d p r -> Rep (Ball d p r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (d :: Nat) p r x. Rep (Ball d p r) x -> Ball d p r
forall (d :: Nat) p r x. Ball d p r -> Rep (Ball d p r) x
$cto :: forall (d :: Nat) p r x. Rep (Ball d p r) x -> Ball d p r
$cfrom :: forall (d :: Nat) p r x. Ball d p r -> Rep (Ball d p r) x
Generic
makeLenses ''Ball

-- | A lens to get/set the radius of a Ball
radius :: Floating r => Lens' (Ball d p r) r
radius :: Lens' (Ball d p r) r
radius = (Ball d p r -> r)
-> (Ball d p r -> r -> Ball d p r) -> Lens' (Ball d p r) r
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (r -> r
forall a. Floating a => a -> a
sqrt (r -> r) -> (Ball d p r -> r) -> Ball d p r -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ball d p r -> r
forall (d :: Nat) p r. Ball d p r -> r
_squaredRadius) (\(Ball Point d r :+ p
c r
_) r
r -> (Point d r :+ p) -> r -> Ball d p r
forall (d :: Nat) p r. (Point d r :+ p) -> r -> Ball d p r
Ball Point d r :+ p
c (r
rr -> Integer -> r
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2))


deriving instance (Show r, Show p, Arity d)     => Show (Ball d p r)
instance (NFData p, NFData r, Arity d) => NFData (Ball d p r)
deriving instance (Eq r, Eq p, Arity d)         => Eq (Ball d p r)

type instance NumType   (Ball d p r) = r
type instance Dimension (Ball d p r) = d

instance Arity d => Functor (Ball d p) where
  fmap :: (a -> b) -> Ball d p a -> Ball d p b
fmap a -> b
f (Ball Point d a :+ p
c a
r) = (Point d b :+ p) -> b -> Ball d p b
forall (d :: Nat) p r. (Point d r :+ p) -> r -> Ball d p r
Ball ((Point d a -> Point d b) -> (Point d a :+ p) -> Point d b :+ p
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((a -> b) -> Point d a -> Point d b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) Point d a :+ p
c) (a -> b
f a
r)

instance Arity d => Bifunctor (Ball d) where
  bimap :: (a -> b) -> (c -> d) -> Ball d a c -> Ball d b d
bimap a -> b
f c -> d
g (Ball Point d c :+ a
c c
r) = (Point d d :+ b) -> d -> Ball d b d
forall (d :: Nat) p r. (Point d r :+ p) -> r -> Ball d p r
Ball ((Point d c -> Point d d)
-> (a -> b) -> (Point d c :+ a) -> Point d d :+ b
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((c -> d) -> Point d c -> Point d d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g) a -> b
f Point d c :+ a
c) (c -> d
g c
r)


-- * Constructing Balls

-- | Given two points on the diameter of the ball, construct a ball.
fromDiameter     :: (Arity d, Fractional r) => Point d r -> Point d r -> Ball d () r
fromDiameter :: Point d r -> Point d r -> Ball d () r
fromDiameter Point d r
p Point d r
q = let c :: Point d r
c = Point d r
p Point d r -> Diff (Point d) r -> Point d r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ ((Point d r
q Point d r -> Point d r -> Diff (Point d) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point d r
p) Vector d r -> r -> Vector d r
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ r
2) in (Point d r :+ ()) -> r -> Ball d () r
forall (d :: Nat) p r. (Point d r :+ p) -> r -> Ball d p r
Ball (Point d r -> Point d r :+ ()
forall a. a -> a :+ ()
ext Point d r
c) (Point d r -> Point d r -> r
forall (p :: * -> *) a.
(Affine p, Foldable (Diff p), Num a) =>
p a -> p a -> a
qdA Point d r
c Point d r
p)

-- | Construct a ball given the center point and a point p on the boundary.
fromCenterAndPoint     :: (Arity d, Num r) => Point d r :+ p -> Point d r :+ p -> Ball d p r
fromCenterAndPoint :: (Point d r :+ p) -> (Point d r :+ p) -> Ball d p r
fromCenterAndPoint Point d r :+ p
c Point d r :+ p
p = (Point d r :+ p) -> r -> Ball d p r
forall (d :: Nat) p r. (Point d r :+ p) -> r -> Ball d p r
Ball Point d r :+ p
c (r -> Ball d p r) -> r -> Ball d p r
forall a b. (a -> b) -> a -> b
$ Point d r -> Point d r -> r
forall (p :: * -> *) a.
(Affine p, Foldable (Diff p), Num a) =>
p a -> p a -> a
qdA (Point d r :+ p
c(Point d r :+ p)
-> Getting (Point d r) (Point d r :+ p) (Point d r) -> Point d r
forall s a. s -> Getting a s a -> a
^.Getting (Point d r) (Point d r :+ p) (Point d r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (Point d r :+ p
p(Point d r :+ p)
-> Getting (Point d r) (Point d r :+ p) (Point d r) -> Point d r
forall s a. s -> Getting a s a -> a
^.Getting (Point d r) (Point d r :+ p) (Point d r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)

-- | A d dimensional unit ball centered at the origin.
unitBall :: (Arity d, Num r) => Ball d () r
unitBall :: Ball d () r
unitBall = (Point d r :+ ()) -> r -> Ball d () r
forall (d :: Nat) p r. (Point d r :+ p) -> r -> Ball d p r
Ball (Point d r -> Point d r :+ ()
forall a. a -> a :+ ()
ext Point d r
forall (d :: Nat) r. (Arity d, Num r) => Point d r
origin) r
1

-- * Querying if a point lies in a ball

-- | Query location of a point relative to a d-dimensional ball.
inBall                 :: (Arity d, Ord r, Num r)
                       => Point d r -> Ball d p r -> PointLocationResult
Point d r
p inBall :: Point d r -> Ball d p r -> PointLocationResult
`inBall` (Ball Point d r :+ p
c r
sr) = case Point d r -> Point d r -> r
forall (p :: * -> *) a.
(Affine p, Foldable (Diff p), Num a) =>
p a -> p a -> a
qdA Point d r
p (Point d r :+ p
c(Point d r :+ p)
-> Getting (Point d r) (Point d r :+ p) (Point d r) -> Point d r
forall s a. s -> Getting a s a -> a
^.Getting (Point d r) (Point d r :+ p) (Point d r)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` r
sr of
                           Ordering
LT -> PointLocationResult
Inside
                           Ordering
EQ -> PointLocationResult
OnBoundary
                           Ordering
GT -> PointLocationResult
Outside

-- | Test if a point lies strictly inside a ball
--
-- >>> (Point2 0.5 0.0) `insideBall` unitBall
-- True
-- >>> (Point2 1 0) `insideBall` unitBall
-- False
-- >>> (Point2 2 0) `insideBall` unitBall
-- False
insideBall       :: (Arity d, Ord r, Num r)
                 => Point d r -> Ball d p r -> Bool
Point d r
p insideBall :: Point d r -> Ball d p r -> Bool
`insideBall` Ball d p r
b = Point d r
p Point d r -> Ball d p r -> PointLocationResult
forall (d :: Nat) r p.
(Arity d, Ord r, Num r) =>
Point d r -> Ball d p r -> PointLocationResult
`inBall` Ball d p r
b PointLocationResult -> PointLocationResult -> Bool
forall a. Eq a => a -> a -> Bool
== PointLocationResult
Inside

-- | Test if a point lies in or on the ball
--
inClosedBall       :: (Arity d, Ord r, Num r)
                    => Point d r -> Ball d p r -> Bool
Point d r
p inClosedBall :: Point d r -> Ball d p r -> Bool
`inClosedBall` Ball d p r
b = Point d r
p Point d r -> Ball d p r -> PointLocationResult
forall (d :: Nat) r p.
(Arity d, Ord r, Num r) =>
Point d r -> Ball d p r -> PointLocationResult
`inBall` Ball d p r
b PointLocationResult -> PointLocationResult -> Bool
forall a. Eq a => a -> a -> Bool
/= PointLocationResult
Outside

-- TODO: Add test cases

-- | Test if a point lies on the boundary of a ball.
--
-- >>> (Point2 1 0) `onBall` unitBall
-- True
-- >>> (Point3 1 1 0) `onBall` unitBall
-- False
onBall       :: (Arity d, Ord r, Num r)
             => Point d r -> Ball d p r -> Bool
Point d r
p onBall :: Point d r -> Ball d p r -> Bool
`onBall` Ball d p r
b = Point d r
p Point d r -> Ball d p r -> PointLocationResult
forall (d :: Nat) r p.
(Arity d, Ord r, Num r) =>
Point d r -> Ball d p r -> PointLocationResult
`inBall` Ball d p r
b PointLocationResult -> PointLocationResult -> Bool
forall a. Eq a => a -> a -> Bool
== PointLocationResult
OnBoundary


--------------------------------------------------------------------------------
-- | Spheres, i.e. the boundary of a ball.

type Sphere d p r = Boundary (Ball d p r)


pattern Sphere     :: Point d r :+ p -> r -> Sphere d p r
pattern $bSphere :: (Point d r :+ p) -> r -> Sphere d p r
$mSphere :: forall r (d :: Nat) r p.
Sphere d p r -> ((Point d r :+ p) -> r -> r) -> (Void# -> r) -> r
Sphere c r = Boundary (Ball c r)
{-# COMPLETE Sphere #-}

-- |
_BallSphere :: Iso (Disk p r) (Disk p s) (Circle p r) (Circle p s)
_BallSphere :: p (Circle p r) (f (Circle p s)) -> p (Disk p r) (f (Disk p s))
_BallSphere = p (Circle p r) (f (Circle p s)) -> p (Disk p r) (f (Disk p s))
forall g h. Iso g h (Boundary g) (Boundary h)
_Boundary

--------------------------------------------------------------------------------
-- * Disks and Circles, aka 2-dimensional Balls and Spheres

type Disk p r = Ball 2 p r

-- | Given the center and the squared radius, constructs a disk
pattern Disk     :: Point 2 r :+ p -> r -> Disk p r
pattern $bDisk :: (Point 2 r :+ p) -> r -> Disk p r
$mDisk :: forall r r p.
Disk p r -> ((Point 2 r :+ p) -> r -> r) -> (Void# -> r) -> r
Disk c r = Ball c r
{-# COMPLETE Disk #-}

type Circle p r = Sphere 2 p r

-- | Iso for converting between Disks and Circles, i.e. forgetting the boundary
_DiskCircle  :: Iso (Disk p r) (Disk p s) (Circle p r) (Circle p s)
_DiskCircle :: p (Circle p r) (f (Circle p s)) -> p (Disk p r) (f (Disk p s))
_DiskCircle = p (Circle p r) (f (Circle p s)) -> p (Disk p r) (f (Disk p s))
forall p r s. Iso (Disk p r) (Disk p s) (Circle p r) (Circle p s)
_BallSphere

-- | Given the center and the squared radius, constructs a circle
pattern Circle     :: Point 2 r :+ p ->  r -> Circle p r
pattern $bCircle :: (Point 2 r :+ p) -> r -> Circle p r
$mCircle :: forall r r p.
Circle p r -> ((Point 2 r :+ p) -> r -> r) -> (Void# -> r) -> r
Circle c r = Sphere c r
{-# COMPLETE Circle #-}

{- HLINT ignore disk -}
-- | Given three points, get the disk through the three points. If the three
-- input points are colinear we return Nothing
--
-- >>> disk (Point2 0 10) (Point2 10 0) (Point2 (-10) 0)
-- Just (Ball {_center = Point2 0.0 0.0 :+ (), _squaredRadius = 100.0})
disk       :: (Eq r, Fractional r)
           => Point 2 r -> Point 2 r -> Point 2 r -> Maybe (Disk () r)
disk :: Point 2 r -> Point 2 r -> Point 2 r -> Maybe (Disk () r)
disk Point 2 r
p Point 2 r
q Point 2 r
r = CoRec Identity '[NoIntersection, Point 2 r, Line 2 r]
-> Handlers
     '[NoIntersection, Point 2 r, Line 2 r] (Maybe (Disk () r))
-> Maybe (Disk () r)
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match (Point 2 r -> Line 2 r
f Point 2 r
p Line 2 r -> Line 2 r -> Intersection (Line 2 r) (Line 2 r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Point 2 r -> Line 2 r
f Point 2 r
q) (Handlers
   '[NoIntersection, Point 2 r, Line 2 r] (Maybe (Disk () r))
 -> Maybe (Disk () r))
-> Handlers
     '[NoIntersection, Point 2 r, Line 2 r] (Maybe (Disk () r))
-> Maybe (Disk () r)
forall a b. (a -> b) -> a -> b
$
       (NoIntersection -> Maybe (Disk () r))
-> Handler (Maybe (Disk () r)) NoIntersection
forall b a. (a -> b) -> Handler b a
H (\NoIntersection
NoIntersection -> Maybe (Disk () r)
forall a. Maybe a
Nothing)
    Handler (Maybe (Disk () r)) NoIntersection
-> Rec (Handler (Maybe (Disk () r))) '[Point 2 r, Line 2 r]
-> Handlers
     '[NoIntersection, Point 2 r, Line 2 r] (Maybe (Disk () r))
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Point 2 r -> Maybe (Disk () r))
-> Handler (Maybe (Disk () r)) (Point 2 r)
forall b a. (a -> b) -> Handler b a
H (\c :: Point 2 r
c@Point{}      -> Disk () r -> Maybe (Disk () r)
forall a. a -> Maybe a
Just (Disk () r -> Maybe (Disk () r)) -> Disk () r -> Maybe (Disk () r)
forall a b. (a -> b) -> a -> b
$ (Point 2 r :+ ()) -> r -> Disk () r
forall (d :: Nat) p r. (Point d r :+ p) -> r -> Ball d p r
Ball (Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext Point 2 r
c) (Point 2 r -> Point 2 r -> r
forall (p :: * -> *) a.
(Affine p, Foldable (Diff p), Num a) =>
p a -> p a -> a
qdA Point 2 r
c Point 2 r
p))
    Handler (Maybe (Disk () r)) (Point 2 r)
-> Rec (Handler (Maybe (Disk () r))) '[Line 2 r]
-> Rec (Handler (Maybe (Disk () r))) '[Point 2 r, Line 2 r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Line 2 r -> Maybe (Disk () r))
-> Handler (Maybe (Disk () r)) (Line 2 r)
forall b a. (a -> b) -> Handler b a
H (\Line 2 r
_              -> Maybe (Disk () r)
forall a. Maybe a
Nothing)
    Handler (Maybe (Disk () r)) (Line 2 r)
-> Rec (Handler (Maybe (Disk () r))) '[]
-> Rec (Handler (Maybe (Disk () r))) '[Line 2 r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec (Handler (Maybe (Disk () r))) '[]
forall u (a :: u -> *). Rec a '[]
RNil
       -- If the intersection is not a point, The two lines f p and f q are
       -- parallel, that means the three input points where colinear.
  where
    -- Given a point p', get the line perpendicular, and through the midpoint
    -- of the line segment p'r
    f :: Point 2 r -> Line 2 r
f Point 2 r
p' = let v :: Diff (Point 2) r
v        = Point 2 r
r Point 2 r -> Point 2 r -> Diff (Point 2) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point 2 r
p'
               midPoint :: Point 2 r
midPoint = Point 2 r
p' Point 2 r -> Diff (Point 2) r -> Point 2 r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ (Diff (Point 2) r
Vector 2 r
v Vector 2 r -> r -> Vector 2 r
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
^/ r
2)
           in Line 2 r -> Line 2 r
forall r. Num r => Line 2 r -> Line 2 r
perpendicularTo (Point 2 r -> Vector 2 r -> Line 2 r
forall (d :: Nat) r. Point d r -> Vector d r -> Line d r
Line Point 2 r
midPoint Diff (Point 2) r
Vector 2 r
v)

-- | Creates a circle from three points on the boundary
from3Points :: Fractional r
            => Point 2 r :+ p -> Point 2 r :+ q -> Point 2 r :+ s -> Circle () r
from3Points :: (Point 2 r :+ p)
-> (Point 2 r :+ q) -> (Point 2 r :+ s) -> Circle () r
from3Points (p :: Point 2 r
p@(Point2 r
px r
py) :+ p
_) (Point2 r
qx r
qy :+ q
_) (Point2 r
sx r
sy :+ s
_) =
    (Point 2 r :+ ()) -> r -> Circle () r
forall r p. (Point 2 r :+ p) -> r -> Circle p r
Circle (Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext Point 2 r
c) (Point 2 r -> Point 2 r -> r
forall r (d :: Nat).
(Num r, Arity d) =>
Point d r -> Point d r -> r
squaredEuclideanDist Point 2 r
c Point 2 r
p)
  where
    f :: a -> a -> a
f  a
x a
y = a
xa -> Integer -> a
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2 a -> a -> a
forall a. Num a => a -> a -> a
+ a
ya -> Integer -> a
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2
    fx :: a -> a -> V3 a
fx a
x a
y = a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 (a -> a -> a
forall a. Num a => a -> a -> a
f a
x a
y) a
y       a
1
    fy :: a -> a -> V3 a
fy a
x a
y = a -> a -> a -> V3 a
forall a. a -> a -> a -> V3 a
V3 a
x       (a -> a -> a
forall a. Num a => a -> a -> a
f a
x a
y) a
1

    xnom :: r
xnom   = M33 r -> r
forall a. Num a => M33 a -> a
det33 (M33 r -> r) -> M33 r -> r
forall a b. (a -> b) -> a -> b
$ V3 r -> V3 r -> V3 r -> M33 r
forall a. a -> a -> a -> V3 a
V3 (r -> r -> V3 r
forall a. Num a => a -> a -> V3 a
fx r
px r
py) (r -> r -> V3 r
forall a. Num a => a -> a -> V3 a
fx r
qx r
qy) (r -> r -> V3 r
forall a. Num a => a -> a -> V3 a
fx r
sx r
sy)
    ynom :: r
ynom   = M33 r -> r
forall a. Num a => M33 a -> a
det33 (M33 r -> r) -> M33 r -> r
forall a b. (a -> b) -> a -> b
$ V3 r -> V3 r -> V3 r -> M33 r
forall a. a -> a -> a -> V3 a
V3 (r -> r -> V3 r
forall a. Num a => a -> a -> V3 a
fy r
px r
py) (r -> r -> V3 r
forall a. Num a => a -> a -> V3 a
fy r
qx r
qy) (r -> r -> V3 r
forall a. Num a => a -> a -> V3 a
fy r
sx r
sy)

    denom :: r
denom  = (r
2 r -> r -> r
forall a. Num a => a -> a -> a
*) (r -> r) -> (M33 r -> r) -> M33 r -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. M33 r -> r
forall a. Num a => M33 a -> a
det33 (M33 r -> r) -> M33 r -> r
forall a b. (a -> b) -> a -> b
$ V3 r -> V3 r -> V3 r -> M33 r
forall a. a -> a -> a -> V3 a
V3 (r -> r -> r -> V3 r
forall a. a -> a -> a -> V3 a
V3 r
px r
py r
1) (r -> r -> r -> V3 r
forall a. a -> a -> a -> V3 a
V3 r
qx r
qy r
1) (r -> r -> r -> V3 r
forall a. a -> a -> a -> V3 a
V3 r
sx r
sy r
1)
    c :: Point 2 r
c      = r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 (r
xnom r -> r -> r
forall a. Fractional a => a -> a -> a
/ r
denom) (r
ynom r -> r -> r
forall a. Fractional a => a -> a -> a
/ r
denom)



newtype Touching p = Touching p deriving (Int -> Touching p -> ShowS
[Touching p] -> ShowS
Touching p -> String
(Int -> Touching p -> ShowS)
-> (Touching p -> String)
-> ([Touching p] -> ShowS)
-> Show (Touching p)
forall p. Show p => Int -> Touching p -> ShowS
forall p. Show p => [Touching p] -> ShowS
forall p. Show p => Touching p -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Touching p] -> ShowS
$cshowList :: forall p. Show p => [Touching p] -> ShowS
show :: Touching p -> String
$cshow :: forall p. Show p => Touching p -> String
showsPrec :: Int -> Touching p -> ShowS
$cshowsPrec :: forall p. Show p => Int -> Touching p -> ShowS
Show,Touching p -> Touching p -> Bool
(Touching p -> Touching p -> Bool)
-> (Touching p -> Touching p -> Bool) -> Eq (Touching p)
forall p. Eq p => Touching p -> Touching p -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Touching p -> Touching p -> Bool
$c/= :: forall p. Eq p => Touching p -> Touching p -> Bool
== :: Touching p -> Touching p -> Bool
$c== :: forall p. Eq p => Touching p -> Touching p -> Bool
Eq,Eq (Touching p)
Eq (Touching p)
-> (Touching p -> Touching p -> Ordering)
-> (Touching p -> Touching p -> Bool)
-> (Touching p -> Touching p -> Bool)
-> (Touching p -> Touching p -> Bool)
-> (Touching p -> Touching p -> Bool)
-> (Touching p -> Touching p -> Touching p)
-> (Touching p -> Touching p -> Touching p)
-> Ord (Touching p)
Touching p -> Touching p -> Bool
Touching p -> Touching p -> Ordering
Touching p -> Touching p -> Touching p
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 p. Ord p => Eq (Touching p)
forall p. Ord p => Touching p -> Touching p -> Bool
forall p. Ord p => Touching p -> Touching p -> Ordering
forall p. Ord p => Touching p -> Touching p -> Touching p
min :: Touching p -> Touching p -> Touching p
$cmin :: forall p. Ord p => Touching p -> Touching p -> Touching p
max :: Touching p -> Touching p -> Touching p
$cmax :: forall p. Ord p => Touching p -> Touching p -> Touching p
>= :: Touching p -> Touching p -> Bool
$c>= :: forall p. Ord p => Touching p -> Touching p -> Bool
> :: Touching p -> Touching p -> Bool
$c> :: forall p. Ord p => Touching p -> Touching p -> Bool
<= :: Touching p -> Touching p -> Bool
$c<= :: forall p. Ord p => Touching p -> Touching p -> Bool
< :: Touching p -> Touching p -> Bool
$c< :: forall p. Ord p => Touching p -> Touching p -> Bool
compare :: Touching p -> Touching p -> Ordering
$ccompare :: forall p. Ord p => Touching p -> Touching p -> Ordering
$cp1Ord :: forall p. Ord p => Eq (Touching p)
Ord,a -> Touching b -> Touching a
(a -> b) -> Touching a -> Touching b
(forall a b. (a -> b) -> Touching a -> Touching b)
-> (forall a b. a -> Touching b -> Touching a) -> Functor Touching
forall a b. a -> Touching b -> Touching a
forall a b. (a -> b) -> Touching a -> Touching b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Touching b -> Touching a
$c<$ :: forall a b. a -> Touching b -> Touching a
fmap :: (a -> b) -> Touching a -> Touching b
$cfmap :: forall a b. (a -> b) -> Touching a -> Touching b
Functor,Touching a -> Bool
(a -> m) -> Touching a -> m
(a -> b -> b) -> b -> Touching a -> b
(forall m. Monoid m => Touching m -> m)
-> (forall m a. Monoid m => (a -> m) -> Touching a -> m)
-> (forall m a. Monoid m => (a -> m) -> Touching a -> m)
-> (forall a b. (a -> b -> b) -> b -> Touching a -> b)
-> (forall a b. (a -> b -> b) -> b -> Touching a -> b)
-> (forall b a. (b -> a -> b) -> b -> Touching a -> b)
-> (forall b a. (b -> a -> b) -> b -> Touching a -> b)
-> (forall a. (a -> a -> a) -> Touching a -> a)
-> (forall a. (a -> a -> a) -> Touching a -> a)
-> (forall a. Touching a -> [a])
-> (forall a. Touching a -> Bool)
-> (forall a. Touching a -> Int)
-> (forall a. Eq a => a -> Touching a -> Bool)
-> (forall a. Ord a => Touching a -> a)
-> (forall a. Ord a => Touching a -> a)
-> (forall a. Num a => Touching a -> a)
-> (forall a. Num a => Touching a -> a)
-> Foldable Touching
forall a. Eq a => a -> Touching a -> Bool
forall a. Num a => Touching a -> a
forall a. Ord a => Touching a -> a
forall m. Monoid m => Touching m -> m
forall a. Touching a -> Bool
forall a. Touching a -> Int
forall a. Touching a -> [a]
forall a. (a -> a -> a) -> Touching a -> a
forall m a. Monoid m => (a -> m) -> Touching a -> m
forall b a. (b -> a -> b) -> b -> Touching a -> b
forall a b. (a -> b -> b) -> b -> Touching a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Touching a -> a
$cproduct :: forall a. Num a => Touching a -> a
sum :: Touching a -> a
$csum :: forall a. Num a => Touching a -> a
minimum :: Touching a -> a
$cminimum :: forall a. Ord a => Touching a -> a
maximum :: Touching a -> a
$cmaximum :: forall a. Ord a => Touching a -> a
elem :: a -> Touching a -> Bool
$celem :: forall a. Eq a => a -> Touching a -> Bool
length :: Touching a -> Int
$clength :: forall a. Touching a -> Int
null :: Touching a -> Bool
$cnull :: forall a. Touching a -> Bool
toList :: Touching a -> [a]
$ctoList :: forall a. Touching a -> [a]
foldl1 :: (a -> a -> a) -> Touching a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Touching a -> a
foldr1 :: (a -> a -> a) -> Touching a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Touching a -> a
foldl' :: (b -> a -> b) -> b -> Touching a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Touching a -> b
foldl :: (b -> a -> b) -> b -> Touching a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Touching a -> b
foldr' :: (a -> b -> b) -> b -> Touching a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Touching a -> b
foldr :: (a -> b -> b) -> b -> Touching a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Touching a -> b
foldMap' :: (a -> m) -> Touching a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Touching a -> m
foldMap :: (a -> m) -> Touching a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Touching a -> m
fold :: Touching m -> m
$cfold :: forall m. Monoid m => Touching m -> m
F.Foldable,Functor Touching
Foldable Touching
Functor Touching
-> Foldable Touching
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Touching a -> f (Touching b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Touching (f a) -> f (Touching a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Touching a -> m (Touching b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Touching (m a) -> m (Touching a))
-> Traversable Touching
(a -> f b) -> Touching a -> f (Touching b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Touching (m a) -> m (Touching a)
forall (f :: * -> *) a.
Applicative f =>
Touching (f a) -> f (Touching a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Touching a -> m (Touching b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Touching a -> f (Touching b)
sequence :: Touching (m a) -> m (Touching a)
$csequence :: forall (m :: * -> *) a. Monad m => Touching (m a) -> m (Touching a)
mapM :: (a -> m b) -> Touching a -> m (Touching b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Touching a -> m (Touching b)
sequenceA :: Touching (f a) -> f (Touching a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Touching (f a) -> f (Touching a)
traverse :: (a -> f b) -> Touching a -> f (Touching b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Touching a -> f (Touching b)
$cp2Traversable :: Foldable Touching
$cp1Traversable :: Functor Touching
T.Traversable)

-- | No intersection, one touching point, or two points
type instance IntersectionOf (Line 2 r) (Circle p r) = [ NoIntersection
                                                       , Touching (Point 2 r)
                                                       , (Point 2 r, Point 2 r)
                                                       ]


instance (Ord r, Floating r) => Line 2 r `IsIntersectableWith` Circle p r where

  nonEmptyIntersection :: proxy (Line 2 r)
-> proxy (Circle p r)
-> Intersection (Line 2 r) (Circle p r)
-> Bool
nonEmptyIntersection = proxy (Line 2 r)
-> proxy (Circle p r)
-> Intersection (Line 2 r) (Circle p r)
-> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
 RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection

  (Line Point 2 r
p' Vector 2 r
v) intersect :: Line 2 r -> Circle p r -> Intersection (Line 2 r) (Circle p r)
`intersect` (Circle (Point 2 r
c :+ p
_) r
r) = case r
discr r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` r
0 of
                                                Ordering
LT -> NoIntersection
-> CoRec
     Identity
     '[NoIntersection, Touching (Point 2 r), (Point 2 r, Point 2 r)]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection
                                                Ordering
EQ -> Touching (Point 2 r)
-> CoRec
     Identity
     '[NoIntersection, Touching (Point 2 r), (Point 2 r, Point 2 r)]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (Touching (Point 2 r)
 -> CoRec
      Identity
      '[NoIntersection, Touching (Point 2 r), (Point 2 r, Point 2 r)])
-> (Point 2 r -> Touching (Point 2 r))
-> Point 2 r
-> CoRec
     Identity
     '[NoIntersection, Touching (Point 2 r), (Point 2 r, Point 2 r)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point 2 r -> Touching (Point 2 r)
forall p. p -> Touching p
Touching (Point 2 r
 -> CoRec
      Identity
      '[NoIntersection, Touching (Point 2 r), (Point 2 r, Point 2 r)])
-> Point 2 r
-> CoRec
     Identity
     '[NoIntersection, Touching (Point 2 r), (Point 2 r, Point 2 r)]
forall a b. (a -> b) -> a -> b
$ r -> Point 2 r
q' ((r -> r -> r) -> r
lambda r -> r -> r
forall a. Num a => a -> a -> a
(+))
                                                Ordering
GT -> let [r
l1,r
l2] = [r] -> [r]
forall a. Ord a => [a] -> [a]
L.sort [(r -> r -> r) -> r
lambda (-), (r -> r -> r) -> r
lambda r -> r -> r
forall a. Num a => a -> a -> a
(+)]
                                                      in (Point 2 r, Point 2 r)
-> CoRec
     Identity
     '[NoIntersection, Touching (Point 2 r), (Point 2 r, Point 2 r)]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (r -> Point 2 r
q' r
l1, r -> Point 2 r
q' r
l2)
    where
      (Vector2 r
vx r
vy)   = Vector 2 r
v
      -- (px, py) is the vector/point after translating the circle s.t. it is centered at the
      -- origin
      pv :: Vector 2 r
pv@(Vector2 r
px r
py) = Point 2 r
p' Point 2 r -> Point 2 r -> Diff (Point 2) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point 2 r
c

      -- q alpha is a point on the translated line
      q :: r -> Point 2 r
q r
alpha = Vector 2 r -> Point 2 r
forall (d :: Nat) r. Vector d r -> Point d r
Point (Vector 2 r -> Point 2 r) -> Vector 2 r -> Point 2 r
forall a b. (a -> b) -> a -> b
$ Vector 2 r
pv Vector 2 r -> Vector 2 r -> Vector 2 r
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ r
alpha r -> Vector 2 r -> Vector 2 r
forall (f :: * -> *) a. (Functor f, Num a) => a -> f a -> f a
*^ Vector 2 r
v
      -- a point q alpha after translating it back in the situation where c is the center of the circle.
      q' :: r -> Point 2 r
q' r
alpha = r -> Point 2 r
q r
alpha Point 2 r -> Diff (Point 2) r -> Point 2 r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ Point 2 r -> Vector 2 r
forall (d :: Nat) r. Point d r -> Vector d r
toVec Point 2 r
c

      -- let q lambda be the intersection point. We solve the following equation
      -- solving the equation (q_x)^2 + (q_y)^2 = r^2 then yields the equation
      -- L^2(vx^2 + vy^2) + L2(px*vx + py*vy) + px^2 + py^2 = 0
      -- where L = \lambda
      aa :: r
aa                   = r
vxr -> Integer -> r
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2 r -> r -> r
forall a. Num a => a -> a -> a
+ r
vyr -> Integer -> r
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2
      bb :: r
bb                   = r
2 r -> r -> r
forall a. Num a => a -> a -> a
* (r
px r -> r -> r
forall a. Num a => a -> a -> a
* r
vx r -> r -> r
forall a. Num a => a -> a -> a
+ r
py r -> r -> r
forall a. Num a => a -> a -> a
* r
vy)
      cc :: r
cc                   = r
pxr -> Integer -> r
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2 r -> r -> r
forall a. Num a => a -> a -> a
+ r
pyr -> Integer -> r
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2 r -> r -> r
forall a. Num a => a -> a -> a
- r
rr -> Integer -> r
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2
      discr :: r
discr                = r
bbr -> Integer -> r
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
2 r -> r -> r
forall a. Num a => a -> a -> a
- r
4r -> r -> r
forall a. Num a => a -> a -> a
*r
aar -> r -> r
forall a. Num a => a -> a -> a
*r
cc
      discr' :: r
discr'               = r -> r
forall a. Floating a => a -> a
sqrt r
discr
      -- This thus gives us the following value(s) for lambda
      lambda :: (r -> r -> r) -> r
lambda r -> r -> r
(|+-|)        = (-r
bb r -> r -> r
|+-| r
discr') r -> r -> r
forall a. Fractional a => a -> a -> a
/ (r
2r -> r -> r
forall a. Num a => a -> a -> a
*r
aa)


-- | A line segment may not intersect a circle, touch it, or intersect it
-- properly in one or two points.
type instance IntersectionOf (LineSegment 2 p r) (Circle q r) = [ NoIntersection
                                                                , Touching (Point 2 r)
                                                                , Point 2 r
                                                                , (Point 2 r, Point 2 r)
                                                                ]


instance (Ord r, Floating r) => LineSegment 2 p r `IsIntersectableWith` Circle q r where

  nonEmptyIntersection :: proxy (LineSegment 2 p r)
-> proxy (Circle q r)
-> Intersection (LineSegment 2 p r) (Circle q r)
-> Bool
nonEmptyIntersection = proxy (LineSegment 2 p r)
-> proxy (Circle q r)
-> Intersection (LineSegment 2 p r) (Circle q r)
-> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
 RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection

  LineSegment 2 p r
s intersect :: LineSegment 2 p r
-> Circle q r -> Intersection (LineSegment 2 p r) (Circle q r)
`intersect` Circle q r
c = CoRec
  Identity
  '[NoIntersection, Touching (Point 2 r), (Point 2 r, Point 2 r)]
-> Handlers
     '[NoIntersection, Touching (Point 2 r), (Point 2 r, Point 2 r)]
     (CoRec
        Identity
        '[NoIntersection, Touching (Point 2 r), Point 2 r,
          (Point 2 r, Point 2 r)])
-> CoRec
     Identity
     '[NoIntersection, Touching (Point 2 r), Point 2 r,
       (Point 2 r, Point 2 r)]
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match (LineSegment 2 p r
-> Line
     (Dimension (LineSegment 2 p r)) (NumType (LineSegment 2 p r))
forall t.
HasSupportingLine t =>
t -> Line (Dimension t) (NumType t)
supportingLine LineSegment 2 p r
s Line 2 r -> Circle q r -> Intersection (Line 2 r) (Circle q r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Circle q r
c) (Handlers
   '[NoIntersection, Touching (Point 2 r), (Point 2 r, Point 2 r)]
   (CoRec
      Identity
      '[NoIntersection, Touching (Point 2 r), Point 2 r,
        (Point 2 r, Point 2 r)])
 -> CoRec
      Identity
      '[NoIntersection, Touching (Point 2 r), Point 2 r,
        (Point 2 r, Point 2 r)])
-> Handlers
     '[NoIntersection, Touching (Point 2 r), (Point 2 r, Point 2 r)]
     (CoRec
        Identity
        '[NoIntersection, Touching (Point 2 r), Point 2 r,
          (Point 2 r, Point 2 r)])
-> CoRec
     Identity
     '[NoIntersection, Touching (Point 2 r), Point 2 r,
       (Point 2 r, Point 2 r)]
forall a b. (a -> b) -> a -> b
$
       (NoIntersection
 -> CoRec
      Identity
      '[NoIntersection, Touching (Point 2 r), Point 2 r,
        (Point 2 r, Point 2 r)])
-> Handler
     (CoRec
        Identity
        '[NoIntersection, Touching (Point 2 r), Point 2 r,
          (Point 2 r, Point 2 r)])
     NoIntersection
forall b a. (a -> b) -> Handler b a
H (\NoIntersection
NoIntersection -> NoIntersection
-> CoRec
     Identity
     '[NoIntersection, Touching (Point 2 r), Point 2 r,
       (Point 2 r, Point 2 r)]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection)
    Handler
  (CoRec
     Identity
     '[NoIntersection, Touching (Point 2 r), Point 2 r,
       (Point 2 r, Point 2 r)])
  NoIntersection
-> Rec
     (Handler
        (CoRec
           Identity
           '[NoIntersection, Touching (Point 2 r), Point 2 r,
             (Point 2 r, Point 2 r)]))
     '[Touching (Point 2 r), (Point 2 r, Point 2 r)]
-> Handlers
     '[NoIntersection, Touching (Point 2 r), (Point 2 r, Point 2 r)]
     (CoRec
        Identity
        '[NoIntersection, Touching (Point 2 r), Point 2 r,
          (Point 2 r, Point 2 r)])
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Touching (Point 2 r)
 -> CoRec
      Identity
      '[NoIntersection, Touching (Point 2 r), Point 2 r,
        (Point 2 r, Point 2 r)])
-> Handler
     (CoRec
        Identity
        '[NoIntersection, Touching (Point 2 r), Point 2 r,
          (Point 2 r, Point 2 r)])
     (Touching (Point 2 r))
forall b a. (a -> b) -> Handler b a
H (\(Touching Point 2 r
p)   -> if Point 2 r
p Point 2 r -> LineSegment 2 p r -> Bool
forall g h. IsIntersectableWith g h => g -> h -> Bool
`intersects` LineSegment 2 p r
s then Touching (Point 2 r)
-> CoRec
     Identity
     '[NoIntersection, Touching (Point 2 r), Point 2 r,
       (Point 2 r, Point 2 r)]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (Touching (Point 2 r)
 -> CoRec
      Identity
      '[NoIntersection, Touching (Point 2 r), Point 2 r,
        (Point 2 r, Point 2 r)])
-> Touching (Point 2 r)
-> CoRec
     Identity
     '[NoIntersection, Touching (Point 2 r), Point 2 r,
       (Point 2 r, Point 2 r)]
forall a b. (a -> b) -> a -> b
$ Point 2 r -> Touching (Point 2 r)
forall p. p -> Touching p
Touching Point 2 r
p
                                                 else  NoIntersection
-> CoRec
     Identity
     '[NoIntersection, Touching (Point 2 r), Point 2 r,
       (Point 2 r, Point 2 r)]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec   NoIntersection
NoIntersection
       )
    Handler
  (CoRec
     Identity
     '[NoIntersection, Touching (Point 2 r), Point 2 r,
       (Point 2 r, Point 2 r)])
  (Touching (Point 2 r))
-> Rec
     (Handler
        (CoRec
           Identity
           '[NoIntersection, Touching (Point 2 r), Point 2 r,
             (Point 2 r, Point 2 r)]))
     '[(Point 2 r, Point 2 r)]
-> Rec
     (Handler
        (CoRec
           Identity
           '[NoIntersection, Touching (Point 2 r), Point 2 r,
             (Point 2 r, Point 2 r)]))
     '[Touching (Point 2 r), (Point 2 r, Point 2 r)]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& ((Point 2 r, Point 2 r)
 -> CoRec
      Identity
      '[NoIntersection, Touching (Point 2 r), Point 2 r,
        (Point 2 r, Point 2 r)])
-> Handler
     (CoRec
        Identity
        '[NoIntersection, Touching (Point 2 r), Point 2 r,
          (Point 2 r, Point 2 r)])
     (Point 2 r, Point 2 r)
forall b a. (a -> b) -> Handler b a
H (\(Point 2 r
p,Point 2 r
q)          -> case (Point 2 r
p Point 2 r -> LineSegment 2 p r -> Bool
forall g h. IsIntersectableWith g h => g -> h -> Bool
`intersects` LineSegment 2 p r
s, Point 2 r
q Point 2 r -> LineSegment 2 p r -> Bool
forall g h. IsIntersectableWith g h => g -> h -> Bool
`intersects` LineSegment 2 p r
s) of
                                 (Bool
False,Bool
False) -> NoIntersection
-> CoRec
     Identity
     '[NoIntersection, Touching (Point 2 r), Point 2 r,
       (Point 2 r, Point 2 r)]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection
                                 (Bool
False,Bool
True)  -> Point 2 r
-> CoRec
     Identity
     '[NoIntersection, Touching (Point 2 r), Point 2 r,
       (Point 2 r, Point 2 r)]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec Point 2 r
q
                                 (Bool
True, Bool
False) -> Point 2 r
-> CoRec
     Identity
     '[NoIntersection, Touching (Point 2 r), Point 2 r,
       (Point 2 r, Point 2 r)]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec Point 2 r
p
                                 (Bool
True, Bool
True)  -> (Point 2 r, Point 2 r)
-> CoRec
     Identity
     '[NoIntersection, Touching (Point 2 r), Point 2 r,
       (Point 2 r, Point 2 r)]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (Point 2 r
p,Point 2 r
q)
       )
    Handler
  (CoRec
     Identity
     '[NoIntersection, Touching (Point 2 r), Point 2 r,
       (Point 2 r, Point 2 r)])
  (Point 2 r, Point 2 r)
-> Rec
     (Handler
        (CoRec
           Identity
           '[NoIntersection, Touching (Point 2 r), Point 2 r,
             (Point 2 r, Point 2 r)]))
     '[]
-> Rec
     (Handler
        (CoRec
           Identity
           '[NoIntersection, Touching (Point 2 r), Point 2 r,
             (Point 2 r, Point 2 r)]))
     '[(Point 2 r, Point 2 r)]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec
  (Handler
     (CoRec
        Identity
        '[NoIntersection, Touching (Point 2 r), Point 2 r,
          (Point 2 r, Point 2 r)]))
  '[]
forall u (a :: u -> *). Rec a '[]
RNil