{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.LineSegment.Internal
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Line segment data type and some basic functions on line segments
--
--------------------------------------------------------------------------------
module Data.Geometry.LineSegment.Internal
  ( LineSegment(LineSegment, LineSegment', ClosedLineSegment, OpenLineSegment)
  , endPoints

  , _SubLine
  , module Data.Geometry.Interval


  , toLineSegment
  , onSegment, onSegment2
  , orderedEndPoints
  , segmentLength
  , sqSegmentLength
  , sqDistanceToSeg, sqDistanceToSegArg -- todo, at some point remove these. They are superfluous
  , flipSegment

  , interpolate
  , validSegment
  , sampleLineSegment

  , ordAtX, ordAtY, xCoordAt, yCoordAt
  ) where

import           Control.Arrow ((&&&))
import           Control.DeepSeq
import           Control.Lens
import           Control.Monad.Random
import           Data.Ext
import qualified Data.Foldable as F
import           Data.Geometry.Box.Internal
import           Data.Geometry.Interval hiding (width, midPoint)
import           Data.Geometry.Line.Internal
import           Data.Geometry.Point
import           Data.Geometry.Properties
import           Data.Geometry.SubLine
import           Data.Geometry.Transformation.Internal
import           Data.Geometry.Vector
import           Data.Ord (comparing)
import           Data.Tuple (swap)
import           Data.Vinyl
import           Data.Vinyl.CoRec
import           GHC.TypeLits
import           Test.QuickCheck (Arbitrary(..), suchThatMap)
import           Text.Read


--------------------------------------------------------------------------------
-- * d-dimensional LineSegments


-- | Line segments. LineSegments have a start and end point, both of which may
-- contain additional data of type p. We can think of a Line-Segment being defined as
--
--
-- >>>  data LineSegment d p r = LineSegment (EndPoint (Point d r :+ p)) (EndPoint (Point d r :+ p))
--
-- it is assumed that the two endpoints of the line segment are disjoint. This is not checked.
newtype LineSegment d p r = GLineSegment { LineSegment d p r -> Interval p (Point d r)
_unLineSeg :: Interval p (Point d r) }

makeLenses ''LineSegment


pattern LineSegment           :: EndPoint (Point d r :+ p)
                              -> EndPoint (Point d r :+ p)
                              -> LineSegment d p r
pattern $bLineSegment :: EndPoint (Point d r :+ p)
-> EndPoint (Point d r :+ p) -> LineSegment d p r
$mLineSegment :: forall r (d :: Nat) r p.
LineSegment d p r
-> (EndPoint (Point d r :+ p) -> EndPoint (Point d r :+ p) -> r)
-> (Void# -> r)
-> r
LineSegment       s t = GLineSegment (Interval s t)
{-# COMPLETE LineSegment #-}

-- | Gets the start and end point, but forgetting if they are open or closed.
pattern LineSegment'          :: Point d r :+ p
                              -> Point d r :+ p
                              -> LineSegment d p r
pattern $mLineSegment' :: forall r (d :: Nat) r p.
LineSegment d p r
-> ((Point d r :+ p) -> (Point d r :+ p) -> r) -> (Void# -> r) -> r
LineSegment'      s t <- ((^.start) &&& (^.end) -> (s,t))
{-# COMPLETE LineSegment' #-}

pattern ClosedLineSegment     :: Point d r :+ p -> Point d r :+ p -> LineSegment d p r
pattern $bClosedLineSegment :: (Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
$mClosedLineSegment :: forall r (d :: Nat) r p.
LineSegment d p r
-> ((Point d r :+ p) -> (Point d r :+ p) -> r) -> (Void# -> r) -> r
ClosedLineSegment s t = GLineSegment (ClosedInterval s t)
{-# COMPLETE ClosedLineSegment #-}

pattern OpenLineSegment     :: Point d r :+ p -> Point d r :+ p -> LineSegment d p r
pattern $bOpenLineSegment :: (Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
$mOpenLineSegment :: forall r (d :: Nat) r p.
LineSegment d p r
-> ((Point d r :+ p) -> (Point d r :+ p) -> r) -> (Void# -> r) -> r
OpenLineSegment s t = GLineSegment (OpenInterval s t)
{-# COMPLETE OpenLineSegment #-}



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

instance HasStart (LineSegment d p r) where
  type StartCore  (LineSegment d p r) = Point d r
  type StartExtra (LineSegment d p r) = p
  start :: ((StartCore (LineSegment d p r) :+ StartExtra (LineSegment d p r))
 -> f (StartCore (LineSegment d p r)
       :+ StartExtra (LineSegment d p r)))
-> LineSegment d p r -> f (LineSegment d p r)
start = (Interval p (Point d r) -> f (Interval p (Point d r)))
-> LineSegment d p r -> f (LineSegment d p r)
forall (d :: Nat) p r (d :: Nat) p r.
Iso
  (LineSegment d p r)
  (LineSegment d p r)
  (Interval p (Point d r))
  (Interval p (Point d r))
unLineSeg((Interval p (Point d r) -> f (Interval p (Point d r)))
 -> LineSegment d p r -> f (LineSegment d p r))
-> (((Point d r :+ p) -> f (Point d r :+ p))
    -> Interval p (Point d r) -> f (Interval p (Point d r)))
-> ((Point d r :+ p) -> f (Point d r :+ p))
-> LineSegment d p r
-> f (LineSegment d p r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Point d r :+ p) -> f (Point d r :+ p))
-> Interval p (Point d r) -> f (Interval p (Point d r))
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start

instance HasEnd (LineSegment d p r) where
  type EndCore  (LineSegment d p r) = Point d r
  type EndExtra (LineSegment d p r) = p
  end :: ((EndCore (LineSegment d p r) :+ EndExtra (LineSegment d p r))
 -> f (EndCore (LineSegment d p r) :+ EndExtra (LineSegment d p r)))
-> LineSegment d p r -> f (LineSegment d p r)
end = (Interval p (Point d r) -> f (Interval p (Point d r)))
-> LineSegment d p r -> f (LineSegment d p r)
forall (d :: Nat) p r (d :: Nat) p r.
Iso
  (LineSegment d p r)
  (LineSegment d p r)
  (Interval p (Point d r))
  (Interval p (Point d r))
unLineSeg((Interval p (Point d r) -> f (Interval p (Point d r)))
 -> LineSegment d p r -> f (LineSegment d p r))
-> (((Point d r :+ p) -> f (Point d r :+ p))
    -> Interval p (Point d r) -> f (Interval p (Point d r)))
-> ((Point d r :+ p) -> f (Point d r :+ p))
-> LineSegment d p r
-> f (LineSegment d p r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.((Point d r :+ p) -> f (Point d r :+ p))
-> Interval p (Point d r) -> f (Interval p (Point d r))
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end

instance (Arbitrary r, Arbitrary p, Eq r, Arity d) => Arbitrary (LineSegment d p r) where
  arbitrary :: Gen (LineSegment d p r)
arbitrary = Gen (EndPoint (Point d r :+ p), EndPoint (Point d r :+ p))
-> ((EndPoint (Point d r :+ p), EndPoint (Point d r :+ p))
    -> Maybe (LineSegment d p r))
-> Gen (LineSegment d p r)
forall a b. Gen a -> (a -> Maybe b) -> Gen b
suchThatMap ((,) (EndPoint (Point d r :+ p)
 -> EndPoint (Point d r :+ p)
 -> (EndPoint (Point d r :+ p), EndPoint (Point d r :+ p)))
-> Gen (EndPoint (Point d r :+ p))
-> Gen
     (EndPoint (Point d r :+ p)
      -> (EndPoint (Point d r :+ p), EndPoint (Point d r :+ p)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (EndPoint (Point d r :+ p))
forall a. Arbitrary a => Gen a
arbitrary Gen
  (EndPoint (Point d r :+ p)
   -> (EndPoint (Point d r :+ p), EndPoint (Point d r :+ p)))
-> Gen (EndPoint (Point d r :+ p))
-> Gen (EndPoint (Point d r :+ p), EndPoint (Point d r :+ p))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (EndPoint (Point d r :+ p))
forall a. Arbitrary a => Gen a
arbitrary)
                          ((EndPoint (Point d r :+ p)
 -> EndPoint (Point d r :+ p) -> Maybe (LineSegment d p r))
-> (EndPoint (Point d r :+ p), EndPoint (Point d r :+ p))
-> Maybe (LineSegment d p r)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry EndPoint (Point d r :+ p)
-> EndPoint (Point d r :+ p) -> Maybe (LineSegment d p r)
forall r (d :: Nat) p.
(Eq r, Arity d) =>
EndPoint (Point d r :+ p)
-> EndPoint (Point d r :+ p) -> Maybe (LineSegment d p r)
validSegment)


deriving instance (Arity d, NFData r, NFData p) => NFData (LineSegment d p r)

-- | Compute a random line segmeent
sampleLineSegment :: (Arity d, RandomGen g, Random r) => Rand g (LineSegment d () r)
sampleLineSegment :: Rand g (LineSegment d () r)
sampleLineSegment = do
  Point d r :+ ()
a <- Point d r -> Point d r :+ ()
forall a. a -> a :+ ()
ext (Point d r -> Point d r :+ ())
-> RandT g Identity (Point d r)
-> RandT g Identity (Point d r :+ ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RandT g Identity (Point d r)
forall (m :: * -> *) a. (MonadRandom m, Random a) => m a
getRandom
  Bool
a' <- RandT g Identity Bool
forall (m :: * -> *) a. (MonadRandom m, Random a) => m a
getRandom
  Point d r :+ ()
b <- Point d r -> Point d r :+ ()
forall a. a -> a :+ ()
ext (Point d r -> Point d r :+ ())
-> RandT g Identity (Point d r)
-> RandT g Identity (Point d r :+ ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RandT g Identity (Point d r)
forall (m :: * -> *) a. (MonadRandom m, Random a) => m a
getRandom
  Bool
b' <- RandT g Identity Bool
forall (m :: * -> *) a. (MonadRandom m, Random a) => m a
getRandom
  LineSegment d () r -> Rand g (LineSegment d () r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LineSegment d () r -> Rand g (LineSegment d () r))
-> LineSegment d () r -> Rand g (LineSegment d () r)
forall a b. (a -> b) -> a -> b
$ EndPoint (Point d r :+ ())
-> EndPoint (Point d r :+ ()) -> LineSegment d () r
forall (d :: Nat) r p.
EndPoint (Point d r :+ p)
-> EndPoint (Point d r :+ p) -> LineSegment d p r
LineSegment (if Bool
a' then (Point d r :+ ()) -> EndPoint (Point d r :+ ())
forall a. a -> EndPoint a
Open Point d r :+ ()
a else (Point d r :+ ()) -> EndPoint (Point d r :+ ())
forall a. a -> EndPoint a
Closed Point d r :+ ()
a) (if Bool
b' then (Point d r :+ ()) -> EndPoint (Point d r :+ ())
forall a. a -> EndPoint a
Open Point d r :+ ()
b else (Point d r :+ ()) -> EndPoint (Point d r :+ ())
forall a. a -> EndPoint a
Closed Point d r :+ ()
b)


{- HLINT ignore endPoints -}
-- | Traversal to access the endpoints. Note that this traversal
-- allows you to change more or less everything, even the dimension
-- and the numeric type used, but it preservers if the segment is open
-- or closed.
endPoints :: Traversal (LineSegment d p r) (LineSegment d' q s)
                       (Point d r :+ p)    (Point d' s :+ q)
endPoints :: ((Point d r :+ p) -> f (Point d' s :+ q))
-> LineSegment d p r -> f (LineSegment d' q s)
endPoints = \(Point d r :+ p) -> f (Point d' s :+ q)
f (LineSegment EndPoint (Point d r :+ p)
p EndPoint (Point d r :+ p)
q) -> EndPoint (Point d' s :+ q)
-> EndPoint (Point d' s :+ q) -> LineSegment d' q s
forall (d :: Nat) r p.
EndPoint (Point d r :+ p)
-> EndPoint (Point d r :+ p) -> LineSegment d p r
LineSegment (EndPoint (Point d' s :+ q)
 -> EndPoint (Point d' s :+ q) -> LineSegment d' q s)
-> f (EndPoint (Point d' s :+ q))
-> f (EndPoint (Point d' s :+ q) -> LineSegment d' q s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Point d r :+ p) -> f (Point d' s :+ q))
-> EndPoint (Point d r :+ p) -> f (EndPoint (Point d' s :+ q))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Point d r :+ p) -> f (Point d' s :+ q)
f EndPoint (Point d r :+ p)
p
                                                f (EndPoint (Point d' s :+ q) -> LineSegment d' q s)
-> f (EndPoint (Point d' s :+ q)) -> f (LineSegment d' q s)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Point d r :+ p) -> f (Point d' s :+ q))
-> EndPoint (Point d r :+ p) -> f (EndPoint (Point d' s :+ q))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Point d r :+ p) -> f (Point d' s :+ q)
f EndPoint (Point d r :+ p)
q

_SubLine :: (Num r, Arity d) => Iso' (LineSegment d p r) (SubLine d p r r)
_SubLine :: Iso' (LineSegment d p r) (SubLine d p r r)
_SubLine = (LineSegment d p r -> SubLine d p r r)
-> (SubLine d p r r -> LineSegment d p r)
-> Iso' (LineSegment d p r) (SubLine d p r r)
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso LineSegment d p r -> SubLine d p r r
forall r (d :: Nat) p.
(Num r, Arity d) =>
LineSegment d p r -> SubLine d p r r
segment2SubLine SubLine d p r r -> LineSegment d p r
forall r (d :: Nat) p.
(Num r, Arity d) =>
SubLine d p r r -> LineSegment d p r
subLineToSegment
{-# INLINE _SubLine #-}

segment2SubLine    :: (Num r, Arity d)
                   => LineSegment d p r -> SubLine d p r r
segment2SubLine :: LineSegment d p r -> SubLine d p r r
segment2SubLine LineSegment d p r
ss = Line d r -> Interval p r -> SubLine d p r r
forall (d :: Nat) p s r.
Line d r -> Interval p s -> SubLine d p s r
SubLine (Point d r -> Vector d r -> Line d r
forall (d :: Nat) r. Point d r -> Vector d r -> Line d r
Line Point d r
p (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)) (EndPoint (r :+ p) -> EndPoint (r :+ p) -> Interval p r
forall r a. EndPoint (r :+ a) -> EndPoint (r :+ a) -> Interval a r
Interval EndPoint (r :+ p)
s EndPoint (r :+ p)
e)
  where
    p :: Point d r
p = LineSegment d p r
ssLineSegment d p r
-> Getting (Point d r) (LineSegment d p r) (Point d r) -> Point d r
forall s a. s -> Getting a s a -> a
^.((Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> LineSegment d p r -> Const (Point d r) (LineSegment d p r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
 -> LineSegment d p r -> Const (Point d r) (LineSegment d p r))
-> ((Point d r -> Const (Point d r) (Point d r))
    -> (Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> Getting (Point d r) (LineSegment d p r) (Point d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point d r -> Const (Point d r) (Point d r))
-> (Point d r :+ p) -> Const (Point d r) (Point d r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core
    q :: Point d r
q = LineSegment d p r
ssLineSegment d p r
-> Getting (Point d r) (LineSegment d p r) (Point d r) -> Point d r
forall s a. s -> Getting a s a -> a
^.((Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> LineSegment d p r -> Const (Point d r) (LineSegment d p r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
 -> LineSegment d p r -> Const (Point d r) (LineSegment d p r))
-> ((Point d r -> Const (Point d r) (Point d r))
    -> (Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> Getting (Point d r) (LineSegment d p r) (Point d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point d r -> Const (Point d r) (Point d r))
-> (Point d r :+ p) -> Const (Point d r) (Point d r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core
    (Interval EndPoint (Point d r :+ p)
a EndPoint (Point d r :+ p)
b)  = LineSegment d p r
ssLineSegment d p r
-> Getting
     (Interval p (Point d r))
     (LineSegment d p r)
     (Interval p (Point d r))
-> Interval p (Point d r)
forall s a. s -> Getting a s a -> a
^.Getting
  (Interval p (Point d r))
  (LineSegment d p r)
  (Interval p (Point d r))
forall (d :: Nat) p r (d :: Nat) p r.
Iso
  (LineSegment d p r)
  (LineSegment d p r)
  (Interval p (Point d r))
  (Interval p (Point d r))
unLineSeg
    s :: EndPoint (r :+ p)
s = EndPoint (Point d r :+ p)
aEndPoint (Point d r :+ p)
-> (EndPoint (Point d r :+ p) -> EndPoint (r :+ p))
-> EndPoint (r :+ p)
forall a b. a -> (a -> b) -> b
&((Point d r :+ p) -> Identity (r :+ p))
-> EndPoint (Point d r :+ p) -> Identity (EndPoint (r :+ p))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point d r :+ p) -> Identity (r :+ p))
 -> EndPoint (Point d r :+ p) -> Identity (EndPoint (r :+ p)))
-> ((Point d r -> Identity r)
    -> (Point d r :+ p) -> Identity (r :+ p))
-> (Point d r -> Identity r)
-> EndPoint (Point d r :+ p)
-> Identity (EndPoint (r :+ p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point d r -> Identity r) -> (Point d r :+ p) -> Identity (r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((Point d r -> Identity r)
 -> EndPoint (Point d r :+ p) -> Identity (EndPoint (r :+ p)))
-> r -> EndPoint (Point d r :+ p) -> EndPoint (r :+ p)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ r
0
    e :: EndPoint (r :+ p)
e = EndPoint (Point d r :+ p)
bEndPoint (Point d r :+ p)
-> (EndPoint (Point d r :+ p) -> EndPoint (r :+ p))
-> EndPoint (r :+ p)
forall a b. a -> (a -> b) -> b
&((Point d r :+ p) -> Identity (r :+ p))
-> EndPoint (Point d r :+ p) -> Identity (EndPoint (r :+ p))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point d r :+ p) -> Identity (r :+ p))
 -> EndPoint (Point d r :+ p) -> Identity (EndPoint (r :+ p)))
-> ((Point d r -> Identity r)
    -> (Point d r :+ p) -> Identity (r :+ p))
-> (Point d r -> Identity r)
-> EndPoint (Point d r :+ p)
-> Identity (EndPoint (r :+ p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point d r -> Identity r) -> (Point d r :+ p) -> Identity (r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((Point d r -> Identity r)
 -> EndPoint (Point d r :+ p) -> Identity (EndPoint (r :+ p)))
-> r -> EndPoint (Point d r :+ p) -> EndPoint (r :+ p)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ r
1

{- HLINT ignore subLineToSegment -}
subLineToSegment    :: (Num r, Arity d) => SubLine d p r r -> LineSegment d p r
subLineToSegment :: SubLine d p r r -> LineSegment d p r
subLineToSegment SubLine d p r r
sl = let Interval EndPoint (r :+ (Point d r :+ p))
s' EndPoint (r :+ (Point d r :+ p))
e' = (SubLine d p r r -> SubLine d (Point d r :+ p) r r
forall r (d :: Nat) p.
(Num r, Arity d) =>
SubLine d p r r -> SubLine d (Point d r :+ p) r r
fixEndPoints SubLine d p r r
sl)SubLine d (Point d r :+ p) r r
-> Getting
     (Interval (Point d r :+ p) r)
     (SubLine d (Point d r :+ p) r r)
     (Interval (Point d r :+ p) r)
-> Interval (Point d r :+ p) r
forall s a. s -> Getting a s a -> a
^.Getting
  (Interval (Point d r :+ p) r)
  (SubLine d (Point d r :+ p) r r)
  (Interval (Point d r :+ p) r)
forall (d :: Nat) p1 s1 r p2 s2.
Lens
  (SubLine d p1 s1 r)
  (SubLine d p2 s2 r)
  (Interval p1 s1)
  (Interval p2 s2)
subRange
                          s :: EndPoint (Point d r :+ p)
s = EndPoint (r :+ (Point d r :+ p))
s'EndPoint (r :+ (Point d r :+ p))
-> (EndPoint (r :+ (Point d r :+ p)) -> EndPoint (Point d r :+ p))
-> EndPoint (Point d r :+ p)
forall a b. a -> (a -> b) -> b
&((r :+ (Point d r :+ p)) -> Identity (Point d r :+ p))
-> EndPoint (r :+ (Point d r :+ p))
-> Identity (EndPoint (Point d r :+ p))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint (((r :+ (Point d r :+ p)) -> Identity (Point d r :+ p))
 -> EndPoint (r :+ (Point d r :+ p))
 -> Identity (EndPoint (Point d r :+ p)))
-> ((r :+ (Point d r :+ p)) -> Point d r :+ p)
-> EndPoint (r :+ (Point d r :+ p))
-> EndPoint (Point d r :+ p)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((r :+ (Point d r :+ p))
-> Getting
     (Point d r :+ p) (r :+ (Point d r :+ p)) (Point d r :+ p)
-> Point d r :+ p
forall s a. s -> Getting a s a -> a
^.Getting (Point d r :+ p) (r :+ (Point d r :+ p)) (Point d r :+ p)
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra)
                          e :: EndPoint (Point d r :+ p)
e = EndPoint (r :+ (Point d r :+ p))
e'EndPoint (r :+ (Point d r :+ p))
-> (EndPoint (r :+ (Point d r :+ p)) -> EndPoint (Point d r :+ p))
-> EndPoint (Point d r :+ p)
forall a b. a -> (a -> b) -> b
&((r :+ (Point d r :+ p)) -> Identity (Point d r :+ p))
-> EndPoint (r :+ (Point d r :+ p))
-> Identity (EndPoint (Point d r :+ p))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint (((r :+ (Point d r :+ p)) -> Identity (Point d r :+ p))
 -> EndPoint (r :+ (Point d r :+ p))
 -> Identity (EndPoint (Point d r :+ p)))
-> ((r :+ (Point d r :+ p)) -> Point d r :+ p)
-> EndPoint (r :+ (Point d r :+ p))
-> EndPoint (Point d r :+ p)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ((r :+ (Point d r :+ p))
-> Getting
     (Point d r :+ p) (r :+ (Point d r :+ p)) (Point d r :+ p)
-> Point d r :+ p
forall s a. s -> Getting a s a -> a
^.Getting (Point d r :+ p) (r :+ (Point d r :+ p)) (Point d r :+ p)
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra)
                      in EndPoint (Point d r :+ p)
-> EndPoint (Point d r :+ p) -> LineSegment d p r
forall (d :: Nat) r p.
EndPoint (Point d r :+ p)
-> EndPoint (Point d r :+ p) -> LineSegment d p r
LineSegment EndPoint (Point d r :+ p)
s EndPoint (Point d r :+ p)
e

instance (Num r, Arity d) => HasSupportingLine (LineSegment d p r) where
  supportingLine :: LineSegment d p r
-> Line
     (Dimension (LineSegment d p r)) (NumType (LineSegment d p r))
supportingLine LineSegment d p r
s = Point d r -> Point d r -> Line d r
forall r (d :: Nat).
(Num r, Arity d) =>
Point d r -> Point d r -> Line d r
lineThrough (LineSegment d p r
sLineSegment d p r
-> Getting (Point d r) (LineSegment d p r) (Point d r) -> Point d r
forall s a. s -> Getting a s a -> a
^.((Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> LineSegment d p r -> Const (Point d r) (LineSegment d p r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
 -> LineSegment d p r -> Const (Point d r) (LineSegment d p r))
-> ((Point d r -> Const (Point d r) (Point d r))
    -> (Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> Getting (Point d r) (LineSegment d p r) (Point d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point d r -> Const (Point d r) (Point d r))
-> (Point d r :+ p) -> Const (Point d r) (Point d r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (LineSegment d p r
sLineSegment d p r
-> Getting (Point d r) (LineSegment d p r) (Point d r) -> Point d r
forall s a. s -> Getting a s a -> a
^.((Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> LineSegment d p r -> Const (Point d r) (LineSegment d p r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
 -> LineSegment d p r -> Const (Point d r) (LineSegment d p r))
-> ((Point d r -> Const (Point d r) (Point d r))
    -> (Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> Getting (Point d r) (LineSegment d p r) (Point d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point d r -> Const (Point d r) (Point d r))
-> (Point d r :+ p) -> Const (Point d r) (Point d r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)


instance (Show r, Show p, Arity d) => Show (LineSegment d p r) where
  showsPrec :: Int -> LineSegment d p r -> ShowS
showsPrec Int
d (LineSegment EndPoint (Point d r :+ p)
p' EndPoint (Point d r :+ p)
q') = case (EndPoint (Point d r :+ p)
p',EndPoint (Point d r :+ p)
q') of
      (Closed Point d r :+ p
p, Closed Point d r :+ p
q) -> String -> (Point d r :+ p) -> (Point d r :+ p) -> ShowS
forall a b. (Show a, Show b) => String -> a -> b -> ShowS
f String
"ClosedLineSegment" Point d r :+ p
p Point d r :+ p
q
      (Open Point d r :+ p
p, Open Point d r :+ p
q)     -> String -> (Point d r :+ p) -> (Point d r :+ p) -> ShowS
forall a b. (Show a, Show b) => String -> a -> b -> ShowS
f String
"OpenLineSegment"   Point d r :+ p
p Point d r :+ p
q
      (EndPoint (Point d r :+ p)
p,EndPoint (Point d r :+ p)
q)                -> String
-> EndPoint (Point d r :+ p) -> EndPoint (Point d r :+ p) -> ShowS
forall a b. (Show a, Show b) => String -> a -> b -> ShowS
f String
"LineSegment"       EndPoint (Point d r :+ p)
p EndPoint (Point d r :+ p)
q
    where
      app_prec :: Int
app_prec = Int
10
      f        :: (Show a, Show b) => String -> a -> b -> String -> String
      f :: String -> a -> b -> ShowS
f String
cn a
p b
q = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
app_prec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
                     String -> ShowS
showString String
cn ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
                   ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
app_precInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) a
p
                   ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
                   ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> b -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
app_precInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) b
q

instance (Read r, Read p, Arity d) => Read (LineSegment d p r) where
  readPrec :: ReadPrec (LineSegment d p r)
readPrec = ReadPrec (LineSegment d p r) -> ReadPrec (LineSegment d p r)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (LineSegment d p r) -> ReadPrec (LineSegment d p r))
-> ReadPrec (LineSegment d p r) -> ReadPrec (LineSegment d p r)
forall a b. (a -> b) -> a -> b
$ (Int -> ReadPrec (LineSegment d p r) -> ReadPrec (LineSegment d p r)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
app_prec (ReadPrec (LineSegment d p r) -> ReadPrec (LineSegment d p r))
-> ReadPrec (LineSegment d p r) -> ReadPrec (LineSegment d p r)
forall a b. (a -> b) -> a -> b
$ do
                                  Ident String
"ClosedLineSegment" <- ReadPrec Lexeme
lexP
                                  Point d r :+ p
p <- ReadPrec (Point d r :+ p) -> ReadPrec (Point d r :+ p)
forall a. ReadPrec a -> ReadPrec a
step ReadPrec (Point d r :+ p)
forall a. Read a => ReadPrec a
readPrec
                                  Point d r :+ p
q <- ReadPrec (Point d r :+ p) -> ReadPrec (Point d r :+ p)
forall a. ReadPrec a -> ReadPrec a
step ReadPrec (Point d r :+ p)
forall a. Read a => ReadPrec a
readPrec
                                  LineSegment d p r -> ReadPrec (LineSegment d p r)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment Point d r :+ p
p Point d r :+ p
q))
                       ReadPrec (LineSegment d p r)
-> ReadPrec (LineSegment d p r) -> ReadPrec (LineSegment d p r)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
                       (Int -> ReadPrec (LineSegment d p r) -> ReadPrec (LineSegment d p r)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
app_prec (ReadPrec (LineSegment d p r) -> ReadPrec (LineSegment d p r))
-> ReadPrec (LineSegment d p r) -> ReadPrec (LineSegment d p r)
forall a b. (a -> b) -> a -> b
$ do
                                  Ident String
"OpenLineSegment" <- ReadPrec Lexeme
lexP
                                  Point d r :+ p
p <- ReadPrec (Point d r :+ p) -> ReadPrec (Point d r :+ p)
forall a. ReadPrec a -> ReadPrec a
step ReadPrec (Point d r :+ p)
forall a. Read a => ReadPrec a
readPrec
                                  Point d r :+ p
q <- ReadPrec (Point d r :+ p) -> ReadPrec (Point d r :+ p)
forall a. ReadPrec a -> ReadPrec a
step ReadPrec (Point d r :+ p)
forall a. Read a => ReadPrec a
readPrec
                                  LineSegment d p r -> ReadPrec (LineSegment d p r)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
OpenLineSegment Point d r :+ p
p Point d r :+ p
q))
                       ReadPrec (LineSegment d p r)
-> ReadPrec (LineSegment d p r) -> ReadPrec (LineSegment d p r)
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++
                       (Int -> ReadPrec (LineSegment d p r) -> ReadPrec (LineSegment d p r)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
app_prec (ReadPrec (LineSegment d p r) -> ReadPrec (LineSegment d p r))
-> ReadPrec (LineSegment d p r) -> ReadPrec (LineSegment d p r)
forall a b. (a -> b) -> a -> b
$ do
                                  Ident String
"LineSegment" <- ReadPrec Lexeme
lexP
                                  EndPoint (Point d r :+ p)
p <- ReadPrec (EndPoint (Point d r :+ p))
-> ReadPrec (EndPoint (Point d r :+ p))
forall a. ReadPrec a -> ReadPrec a
step ReadPrec (EndPoint (Point d r :+ p))
forall a. Read a => ReadPrec a
readPrec
                                  EndPoint (Point d r :+ p)
q <- ReadPrec (EndPoint (Point d r :+ p))
-> ReadPrec (EndPoint (Point d r :+ p))
forall a. ReadPrec a -> ReadPrec a
step ReadPrec (EndPoint (Point d r :+ p))
forall a. Read a => ReadPrec a
readPrec
                                  LineSegment d p r -> ReadPrec (LineSegment d p r)
forall (m :: * -> *) a. Monad m => a -> m a
return (EndPoint (Point d r :+ p)
-> EndPoint (Point d r :+ p) -> LineSegment d p r
forall (d :: Nat) r p.
EndPoint (Point d r :+ p)
-> EndPoint (Point d r :+ p) -> LineSegment d p r
LineSegment EndPoint (Point d r :+ p)
p EndPoint (Point d r :+ p)
q))
    where app_prec :: Int
app_prec = Int
10


deriving instance (Eq r, Eq p, Arity d)     => Eq (LineSegment d p r)
-- deriving instance (Ord r, Ord p, Arity d)   => Ord (LineSegment d p r)
deriving instance Arity d                   => Functor (LineSegment d p)

instance PointFunctor (LineSegment d p) where
  pmap :: (Point (Dimension (LineSegment d p r)) r
 -> Point (Dimension (LineSegment d p s)) s)
-> LineSegment d p r -> LineSegment d p s
pmap Point (Dimension (LineSegment d p r)) r
-> Point (Dimension (LineSegment d p s)) s
f ~(LineSegment EndPoint (Point d r :+ p)
s EndPoint (Point d r :+ p)
e) = EndPoint (Point d s :+ p)
-> EndPoint (Point d s :+ p) -> LineSegment d p s
forall (d :: Nat) r p.
EndPoint (Point d r :+ p)
-> EndPoint (Point d r :+ p) -> LineSegment d p r
LineSegment (EndPoint (Point d r :+ p)
sEndPoint (Point d r :+ p)
-> (EndPoint (Point d r :+ p) -> EndPoint (Point d s :+ p))
-> EndPoint (Point d s :+ p)
forall a b. a -> (a -> b) -> b
&((Point d r :+ p) -> Identity (Point d s :+ p))
-> EndPoint (Point d r :+ p)
-> Identity (EndPoint (Point d s :+ p))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point d r :+ p) -> Identity (Point d s :+ p))
 -> EndPoint (Point d r :+ p)
 -> Identity (EndPoint (Point d s :+ p)))
-> ((Point d r -> Identity (Point d s))
    -> (Point d r :+ p) -> Identity (Point d s :+ p))
-> (Point d r -> Identity (Point d s))
-> EndPoint (Point d r :+ p)
-> Identity (EndPoint (Point d s :+ p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point d r -> Identity (Point d s))
-> (Point d r :+ p) -> Identity (Point d s :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((Point d r -> Identity (Point d s))
 -> EndPoint (Point d r :+ p)
 -> Identity (EndPoint (Point d s :+ p)))
-> (Point d r -> Point d s)
-> EndPoint (Point d r :+ p)
-> EndPoint (Point d s :+ p)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Point d r -> Point d s
Point (Dimension (LineSegment d p r)) r
-> Point (Dimension (LineSegment d p s)) s
f)
                                          (EndPoint (Point d r :+ p)
eEndPoint (Point d r :+ p)
-> (EndPoint (Point d r :+ p) -> EndPoint (Point d s :+ p))
-> EndPoint (Point d s :+ p)
forall a b. a -> (a -> b) -> b
&((Point d r :+ p) -> Identity (Point d s :+ p))
-> EndPoint (Point d r :+ p)
-> Identity (EndPoint (Point d s :+ p))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point d r :+ p) -> Identity (Point d s :+ p))
 -> EndPoint (Point d r :+ p)
 -> Identity (EndPoint (Point d s :+ p)))
-> ((Point d r -> Identity (Point d s))
    -> (Point d r :+ p) -> Identity (Point d s :+ p))
-> (Point d r -> Identity (Point d s))
-> EndPoint (Point d r :+ p)
-> Identity (EndPoint (Point d s :+ p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point d r -> Identity (Point d s))
-> (Point d r :+ p) -> Identity (Point d s :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((Point d r -> Identity (Point d s))
 -> EndPoint (Point d r :+ p)
 -> Identity (EndPoint (Point d s :+ p)))
-> (Point d r -> Point d s)
-> EndPoint (Point d r :+ p)
-> EndPoint (Point d s :+ p)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Point d r -> Point d s
Point (Dimension (LineSegment d p r)) r
-> Point (Dimension (LineSegment d p s)) s
f)

instance Arity d => IsBoxable (LineSegment d p r) where
  boundingBox :: LineSegment d p r
-> Box
     (Dimension (LineSegment d p r)) () (NumType (LineSegment d p r))
boundingBox LineSegment d p r
l = Point d r -> Box (Dimension (Point d r)) () (NumType (Point d r))
forall g.
(IsBoxable g, Ord (NumType g)) =>
g -> Box (Dimension g) () (NumType g)
boundingBox (LineSegment d p r
lLineSegment d p r
-> Getting (Point d r) (LineSegment d p r) (Point d r) -> Point d r
forall s a. s -> Getting a s a -> a
^.((Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> LineSegment d p r -> Const (Point d r) (LineSegment d p r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
 -> LineSegment d p r -> Const (Point d r) (LineSegment d p r))
-> ((Point d r -> Const (Point d r) (Point d r))
    -> (Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> Getting (Point d r) (LineSegment d p r) (Point d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point d r -> Const (Point d r) (Point d r))
-> (Point d r :+ p) -> Const (Point d r) (Point d r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) Box d () r -> Box d () r -> Box d () r
forall a. Semigroup a => a -> a -> a
<> Point d r -> Box (Dimension (Point d r)) () (NumType (Point d r))
forall g.
(IsBoxable g, Ord (NumType g)) =>
g -> Box (Dimension g) () (NumType g)
boundingBox (LineSegment d p r
lLineSegment d p r
-> Getting (Point d r) (LineSegment d p r) (Point d r) -> Point d r
forall s a. s -> Getting a s a -> a
^.((Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> LineSegment d p r -> Const (Point d r) (LineSegment d p r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
 -> LineSegment d p r -> Const (Point d r) (LineSegment d p r))
-> ((Point d r -> Const (Point d r) (Point d r))
    -> (Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> Getting (Point d r) (LineSegment d p r) (Point d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point d r -> Const (Point d r) (Point d r))
-> (Point d r :+ p) -> Const (Point d r) (Point d r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)

instance (Fractional r, Arity d, Arity (d + 1)) => IsTransformable (LineSegment d p r) where
  transformBy :: Transformation
  (Dimension (LineSegment d p r)) (NumType (LineSegment d p r))
-> LineSegment d p r -> LineSegment d p r
transformBy = Transformation
  (Dimension (LineSegment d p r)) (NumType (LineSegment d p r))
-> LineSegment d p r -> LineSegment d p r
forall (g :: * -> *) r (d :: Nat).
(PointFunctor g, Fractional r, d ~ Dimension (g r), Arity d,
 Arity (d + 1)) =>
Transformation d r -> g r -> g r
transformPointFunctor

instance Arity d => Bifunctor (LineSegment d) where
  bimap :: (a -> b) -> (c -> d) -> LineSegment d a c -> LineSegment d b d
bimap a -> b
f c -> d
g (GLineSegment Interval a (Point d c)
i) = Interval b (Point d d) -> LineSegment d b d
forall (d :: Nat) p r. Interval p (Point d r) -> LineSegment d p r
GLineSegment (Interval b (Point d d) -> LineSegment d b d)
-> Interval b (Point d d) -> LineSegment d b d
forall a b. (a -> b) -> a -> b
$ (a -> b)
-> (Point d c -> Point d d)
-> Interval a (Point d c)
-> Interval b (Point d d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f ((c -> d) -> Point d c -> Point d d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g) Interval a (Point d c)
i

-- | Transform a segment into a closed line segment
toClosedSegment                    :: LineSegment d p r -> LineSegment d p r
toClosedSegment :: LineSegment d p r -> LineSegment d p r
toClosedSegment (LineSegment' Point d r :+ p
s Point d r :+ p
t) = (Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment Point d r :+ p
s Point d r :+ p
t


-- ** Converting between Lines and LineSegments

-- | Directly convert a line into a Closed line segment.
toLineSegment            :: (Monoid p, Num r, Arity d) => Line d r -> LineSegment d p r
toLineSegment :: Line d r -> LineSegment d p r
toLineSegment (Line Point d r
p Vector d r
v) = (Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
forall (d :: Nat) r p.
(Point d r :+ p) -> (Point d r :+ p) -> LineSegment d p r
ClosedLineSegment (Point d r
p       Point d r -> p -> Point d r :+ p
forall core extra. core -> extra -> core :+ extra
:+ p
forall a. Monoid a => a
mempty)
                                             (Point d r
p Point d r -> Diff (Point d) r -> Point d r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ Diff (Point d) r
Vector d r
v Point d r -> p -> Point d r :+ p
forall core extra. core -> extra -> core :+ extra
:+ p
forall a. Monoid a => a
mempty)

-- *** Intersecting LineSegments

type instance IntersectionOf (Point d r) (LineSegment d p r) = [ NoIntersection
                                                               , Point d r
                                                               ]

-- type instance IntersectionOf (LineSegment 2 p r) (LineSegment 2 p r) = [ NoIntersection
--                                                                        , Point 2 r
--                                                                        , LineSegment 2 p r
--                                                                        ]

type instance IntersectionOf (LineSegment 2 p r) (LineSegment 2 q r) =
  [ NoIntersection, Point 2 r, LineSegment 2 (Either p q) r]

type instance IntersectionOf (LineSegment 2 p r) (Line 2 r) = [ NoIntersection
                                                              , Point 2 r
                                                              , LineSegment 2 p r
                                                              ]


instance {-# OVERLAPPING #-} (Ord r, Num r)
         => Point 2 r `HasIntersectionWith` LineSegment 2 p r where
  intersects :: Point 2 r -> LineSegment 2 p r -> Bool
intersects = Point 2 r -> LineSegment 2 p r -> Bool
forall r p.
(Ord r, Num r) =>
Point 2 r -> LineSegment 2 p r -> Bool
onSegment2

instance {-# OVERLAPPING #-} (Ord r, Num r)
         => Point 2 r `IsIntersectableWith` LineSegment 2 p r where
  nonEmptyIntersection :: proxy (Point 2 r)
-> proxy (LineSegment 2 p r)
-> Intersection (Point 2 r) (LineSegment 2 p r)
-> Bool
nonEmptyIntersection = proxy (Point 2 r)
-> proxy (LineSegment 2 p r)
-> Intersection (Point 2 r) (LineSegment 2 p r)
-> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
 RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection
  Point 2 r
p intersect :: Point 2 r
-> LineSegment 2 p r
-> Intersection (Point 2 r) (LineSegment 2 p r)
`intersect` LineSegment 2 p r
seg | Point 2 r
p Point 2 r -> LineSegment 2 p r -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` LineSegment 2 p r
seg = Point 2 r -> CoRec Identity '[NoIntersection, Point 2 r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec Point 2 r
p
                    | Bool
otherwise          = NoIntersection -> CoRec Identity '[NoIntersection, Point 2 r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection


instance {-# OVERLAPPABLE #-} (Ord r, Fractional r, Arity d)
         => Point d r `HasIntersectionWith` LineSegment d p r where
  intersects :: Point d r -> LineSegment d p r -> Bool
intersects = Point d r -> LineSegment d p r -> Bool
forall r (d :: Nat) p.
(Ord r, Fractional r, Arity d) =>
Point d r -> LineSegment d p r -> Bool
onSegment

instance {-# OVERLAPPABLE #-} (Ord r, Fractional r, Arity d)
         => Point d r `IsIntersectableWith` LineSegment d p r where
  nonEmptyIntersection :: proxy (Point d r)
-> proxy (LineSegment d p r)
-> Intersection (Point d r) (LineSegment d p r)
-> Bool
nonEmptyIntersection = proxy (Point d r)
-> proxy (LineSegment d p r)
-> Intersection (Point d r) (LineSegment d p r)
-> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
 RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection
  Point d r
p intersect :: Point d r
-> LineSegment d p r
-> Intersection (Point d r) (LineSegment d p r)
`intersect` LineSegment d p r
seg | Point d r
p Point d r -> LineSegment d p r -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` LineSegment d p r
seg = Point d r -> CoRec Identity '[NoIntersection, Point d r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec Point d r
p
                    | Bool
otherwise          = NoIntersection -> CoRec Identity '[NoIntersection, Point d r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection

-- | Test if a point lies on a line segment.
--
-- As a user, you should typically just use 'intersects' instead.
onSegment :: (Ord r, Fractional r, Arity d) => Point d r -> LineSegment d p r -> Bool
Point d r
p onSegment :: Point d r -> LineSegment d p r -> Bool
`onSegment` (LineSegment EndPoint (Point d r :+ p)
up EndPoint (Point d r :+ p)
vp) =
      Bool -> (r -> Bool) -> Maybe r -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False r -> Bool
inRange' (Vector d r -> Vector d r -> Maybe r
forall r (d :: Nat).
(Eq r, Fractional r, Arity d) =>
Vector d r -> Vector d r -> Maybe r
scalarMultiple (Point d r
p Point d r -> Point d r -> Diff (Point d) r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point d r
u) (Point d r
v 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
u))
    where
      u :: Point d r
u = EndPoint (Point d r :+ p)
upEndPoint (Point d r :+ p)
-> Getting (Point d r) (EndPoint (Point d r :+ p)) (Point d r)
-> Point d r
forall s a. s -> Getting a s a -> a
^.((Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> EndPoint (Point d r :+ p)
-> Const (Point d r) (EndPoint (Point d r :+ p))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
 -> EndPoint (Point d r :+ p)
 -> Const (Point d r) (EndPoint (Point d r :+ p)))
-> ((Point d r -> Const (Point d r) (Point d r))
    -> (Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> Getting (Point d r) (EndPoint (Point d r :+ p)) (Point d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point d r -> Const (Point d r) (Point d r))
-> (Point d r :+ p) -> Const (Point d r) (Point d r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core
      v :: Point d r
v = EndPoint (Point d r :+ p)
vpEndPoint (Point d r :+ p)
-> Getting (Point d r) (EndPoint (Point d r :+ p)) (Point d r)
-> Point d r
forall s a. s -> Getting a s a -> a
^.((Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> EndPoint (Point d r :+ p)
-> Const (Point d r) (EndPoint (Point d r :+ p))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
 -> EndPoint (Point d r :+ p)
 -> Const (Point d r) (EndPoint (Point d r :+ p)))
-> ((Point d r -> Const (Point d r) (Point d r))
    -> (Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> Getting (Point d r) (EndPoint (Point d r :+ p)) (Point d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point d r -> Const (Point d r) (Point d r))
-> (Point d r :+ p) -> Const (Point d r) (Point d r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core

      atMostUpperBound :: r -> Bool
atMostUpperBound  = if EndPoint (Point d r :+ p) -> Bool
forall a. EndPoint a -> Bool
isClosed EndPoint (Point d r :+ p)
vp then (r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<= r
1) else (r -> r -> Bool
forall a. Ord a => a -> a -> Bool
< r
1)
      atLeastLowerBound :: r -> Bool
atLeastLowerBound = if EndPoint (Point d r :+ p) -> Bool
forall a. EndPoint a -> Bool
isClosed EndPoint (Point d r :+ p)
up then (r
0 r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<=) else (r
0 r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<)

      inRange' :: r -> Bool
inRange' r
x = r -> Bool
atLeastLowerBound r
x Bool -> Bool -> Bool
&& r -> Bool
atMostUpperBound r
x
  -- the type of test we use for the 2D version might actually also
  -- work in higher dimensions that might allow us to drop the
  -- Fractional constraint


-- | Orders the endpoints of the segments in the given direction.
withRank                                       :: forall p q r. (Ord r, Num r)
                                               => Vector 2 r
                                               -> LineSegment 2 p r  -> LineSegment 2 q r
                                               -> (Interval p Int, Interval q Int)
withRank :: Vector 2 r
-> LineSegment 2 p r
-> LineSegment 2 q r
-> (Interval p Int, Interval q Int)
withRank Vector 2 r
v (LineSegment EndPoint (Point 2 r :+ p)
p EndPoint (Point 2 r :+ p)
q) (LineSegment EndPoint (Point 2 r :+ q)
a EndPoint (Point 2 r :+ q)
b) = (Interval p Int
i1,Interval q Int
i2)
  where
    -- let rank p = 3, rank q = 6
    i1 :: Interval p Int
i1 = EndPoint (Int :+ p) -> EndPoint (Int :+ p) -> Interval p Int
forall r a. EndPoint (r :+ a) -> EndPoint (r :+ a) -> Interval a r
Interval (EndPoint (Point 2 r :+ p)
pEndPoint (Point 2 r :+ p)
-> (EndPoint (Point 2 r :+ p) -> EndPoint (Int :+ p))
-> EndPoint (Int :+ p)
forall a b. a -> (a -> b) -> b
&((Point 2 r :+ p) -> Identity (Int :+ p))
-> EndPoint (Point 2 r :+ p) -> Identity (EndPoint (Int :+ p))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point 2 r :+ p) -> Identity (Int :+ p))
 -> EndPoint (Point 2 r :+ p) -> Identity (EndPoint (Int :+ p)))
-> ((Point 2 r -> Identity Int)
    -> (Point 2 r :+ p) -> Identity (Int :+ p))
-> (Point 2 r -> Identity Int)
-> EndPoint (Point 2 r :+ p)
-> Identity (EndPoint (Int :+ p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Identity Int)
-> (Point 2 r :+ p) -> Identity (Int :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((Point 2 r -> Identity Int)
 -> EndPoint (Point 2 r :+ p) -> Identity (EndPoint (Int :+ p)))
-> Int -> EndPoint (Point 2 r :+ p) -> EndPoint (Int :+ p)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
3) (EndPoint (Point 2 r :+ p)
qEndPoint (Point 2 r :+ p)
-> (EndPoint (Point 2 r :+ p) -> EndPoint (Int :+ p))
-> EndPoint (Int :+ p)
forall a b. a -> (a -> b) -> b
&((Point 2 r :+ p) -> Identity (Int :+ p))
-> EndPoint (Point 2 r :+ p) -> Identity (EndPoint (Int :+ p))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point 2 r :+ p) -> Identity (Int :+ p))
 -> EndPoint (Point 2 r :+ p) -> Identity (EndPoint (Int :+ p)))
-> ((Point 2 r -> Identity Int)
    -> (Point 2 r :+ p) -> Identity (Int :+ p))
-> (Point 2 r -> Identity Int)
-> EndPoint (Point 2 r :+ p)
-> Identity (EndPoint (Int :+ p))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Identity Int)
-> (Point 2 r :+ p) -> Identity (Int :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((Point 2 r -> Identity Int)
 -> EndPoint (Point 2 r :+ p) -> Identity (EndPoint (Int :+ p)))
-> Int -> EndPoint (Point 2 r :+ p) -> EndPoint (Int :+ p)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
6)

    i2 :: Interval q Int
i2 = EndPoint (Int :+ q) -> EndPoint (Int :+ q) -> Interval q Int
forall r a. EndPoint (r :+ a) -> EndPoint (r :+ a) -> Interval a r
Interval (EndPoint (Point 2 r :+ q)
aEndPoint (Point 2 r :+ q)
-> (EndPoint (Point 2 r :+ q) -> EndPoint (Int :+ q))
-> EndPoint (Int :+ q)
forall a b. a -> (a -> b) -> b
&((Point 2 r :+ q) -> Identity (Int :+ q))
-> EndPoint (Point 2 r :+ q) -> Identity (EndPoint (Int :+ q))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point 2 r :+ q) -> Identity (Int :+ q))
 -> EndPoint (Point 2 r :+ q) -> Identity (EndPoint (Int :+ q)))
-> ((Point 2 r -> Identity Int)
    -> (Point 2 r :+ q) -> Identity (Int :+ q))
-> (Point 2 r -> Identity Int)
-> EndPoint (Point 2 r :+ q)
-> Identity (EndPoint (Int :+ q))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Identity Int)
-> (Point 2 r :+ q) -> Identity (Int :+ q)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((Point 2 r -> Identity Int)
 -> EndPoint (Point 2 r :+ q) -> Identity (EndPoint (Int :+ q)))
-> Int -> EndPoint (Point 2 r :+ q) -> EndPoint (Int :+ q)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int -> EndPoint (Point 2 r :+ q) -> Int
assign' Int
1 EndPoint (Point 2 r :+ q)
a') (EndPoint (Point 2 r :+ q)
aEndPoint (Point 2 r :+ q)
-> (EndPoint (Point 2 r :+ q) -> EndPoint (Int :+ q))
-> EndPoint (Int :+ q)
forall a b. a -> (a -> b) -> b
&((Point 2 r :+ q) -> Identity (Int :+ q))
-> EndPoint (Point 2 r :+ q) -> Identity (EndPoint (Int :+ q))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point 2 r :+ q) -> Identity (Int :+ q))
 -> EndPoint (Point 2 r :+ q) -> Identity (EndPoint (Int :+ q)))
-> ((Point 2 r -> Identity Int)
    -> (Point 2 r :+ q) -> Identity (Int :+ q))
-> (Point 2 r -> Identity Int)
-> EndPoint (Point 2 r :+ q)
-> Identity (EndPoint (Int :+ q))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Identity Int)
-> (Point 2 r :+ q) -> Identity (Int :+ q)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((Point 2 r -> Identity Int)
 -> EndPoint (Point 2 r :+ q) -> Identity (EndPoint (Int :+ q)))
-> Int -> EndPoint (Point 2 r :+ q) -> EndPoint (Int :+ q)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int -> EndPoint (Point 2 r :+ q) -> Int
assign' Int
2 EndPoint (Point 2 r :+ q)
b')

    -- make sure the intervals are in the same order, otherwise flip them.
    (EndPoint (Point 2 r :+ q)
a',EndPoint (Point 2 r :+ q)
b') = case EndPoint (Point 2 r :+ q) -> EndPoint (Point 2 r :+ q) -> Ordering
forall a b.
EndPoint (Point 2 r :+ a) -> EndPoint (Point 2 r :+ b) -> Ordering
cmp EndPoint (Point 2 r :+ q)
a EndPoint (Point 2 r :+ q)
b of
                Ordering
LT -> (EndPoint (Point 2 r :+ q)
a,EndPoint (Point 2 r :+ q)
b)
                Ordering
EQ -> (EndPoint (Point 2 r :+ q)
a,EndPoint (Point 2 r :+ q)
b)
                Ordering
GT -> (EndPoint (Point 2 r :+ q)
b,EndPoint (Point 2 r :+ q)
a)

    assign' :: Int -> EndPoint (Point 2 r :+ q) -> Int
assign' Int
x EndPoint (Point 2 r :+ q)
c = case EndPoint (Point 2 r :+ q) -> EndPoint (Point 2 r :+ p) -> Ordering
forall a b.
EndPoint (Point 2 r :+ a) -> EndPoint (Point 2 r :+ b) -> Ordering
cmp EndPoint (Point 2 r :+ q)
c EndPoint (Point 2 r :+ p)
p of
                    Ordering
LT -> Int
x
                    Ordering
EQ -> Int
3
                    Ordering
GT -> case EndPoint (Point 2 r :+ q) -> EndPoint (Point 2 r :+ p) -> Ordering
forall a b.
EndPoint (Point 2 r :+ a) -> EndPoint (Point 2 r :+ b) -> Ordering
cmp EndPoint (Point 2 r :+ q)
c EndPoint (Point 2 r :+ p)
q of
                            Ordering
LT -> Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x
                            Ordering
EQ -> Int
6
                            Ordering
GT -> Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x

    cmp     :: EndPoint (Point 2 r :+ a) -> EndPoint (Point 2 r :+ b) -> Ordering
    cmp :: EndPoint (Point 2 r :+ a) -> EndPoint (Point 2 r :+ b) -> Ordering
cmp EndPoint (Point 2 r :+ a)
c EndPoint (Point 2 r :+ b)
d = Vector 2 r -> Point 2 r -> Point 2 r -> Ordering
forall r.
(Ord r, Num r) =>
Vector 2 r -> Point 2 r -> Point 2 r -> Ordering
cmpInDirection Vector 2 r
v (EndPoint (Point 2 r :+ a)
cEndPoint (Point 2 r :+ a)
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ a)) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ a) -> Const (Point 2 r) (Point 2 r :+ a))
-> EndPoint (Point 2 r :+ a)
-> Const (Point 2 r) (EndPoint (Point 2 r :+ a))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point 2 r :+ a) -> Const (Point 2 r) (Point 2 r :+ a))
 -> EndPoint (Point 2 r :+ a)
 -> Const (Point 2 r) (EndPoint (Point 2 r :+ a)))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ a) -> Const (Point 2 r) (Point 2 r :+ a))
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ a)) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ a) -> Const (Point 2 r) (Point 2 r :+ a)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) (EndPoint (Point 2 r :+ b)
dEndPoint (Point 2 r :+ b)
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ b)) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ b) -> Const (Point 2 r) (Point 2 r :+ b))
-> EndPoint (Point 2 r :+ b)
-> Const (Point 2 r) (EndPoint (Point 2 r :+ b))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point 2 r :+ b) -> Const (Point 2 r) (Point 2 r :+ b))
 -> EndPoint (Point 2 r :+ b)
 -> Const (Point 2 r) (EndPoint (Point 2 r :+ b)))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ b) -> Const (Point 2 r) (Point 2 r :+ b))
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ b)) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ b) -> Const (Point 2 r) (Point 2 r :+ b)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)

instance (Ord r, Num r) =>
         LineSegment 2 p r `HasIntersectionWith` LineSegment 2 q r where
  s1 :: LineSegment 2 p r
s1@(LineSegment EndPoint (Point 2 r :+ p)
p EndPoint (Point 2 r :+ p)
_) intersects :: LineSegment 2 p r -> LineSegment 2 q r -> Bool
`intersects` LineSegment 2 q r
s2
    | Line 2 r
l1 Line 2 r -> Line 2 r -> Bool
forall r. (Eq r, Num r) => Line 2 r -> Line 2 r -> Bool
`isParallelTo2` Line 2 r
Line (Dimension (LineSegment 2 q r)) (NumType (LineSegment 2 q r))
l2 = Bool
parallelCase
    | Bool
otherwise             = LineSegment 2 p r
s1 LineSegment 2 p r -> Line 2 r -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` Line 2 r
Line (Dimension (LineSegment 2 q r)) (NumType (LineSegment 2 q r))
l2  Bool -> Bool -> Bool
&& LineSegment 2 q r
s2 LineSegment 2 q r -> Line 2 r -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` Line 2 r
l1
    where
      l1 :: Line 2 r
l1@(Line Point 2 r
_ Vector 2 r
v) = 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
s1
      l2 :: Line (Dimension (LineSegment 2 q r)) (NumType (LineSegment 2 q r))
l2 = LineSegment 2 q r
-> Line
     (Dimension (LineSegment 2 q r)) (NumType (LineSegment 2 q r))
forall t.
HasSupportingLine t =>
t -> Line (Dimension t) (NumType t)
supportingLine LineSegment 2 q r
s2

      parallelCase :: Bool
parallelCase = (EndPoint (Point 2 r :+ p)
pEndPoint (Point 2 r :+ p)
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> EndPoint (Point 2 r :+ p)
-> Const (Point 2 r) (EndPoint (Point 2 r :+ p))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> EndPoint (Point 2 r :+ p)
 -> Const (Point 2 r) (EndPoint (Point 2 r :+ p)))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) Point 2 r -> Line 2 r -> Bool
forall r. (Ord r, Num r) => Point 2 r -> Line 2 r -> Bool
`onLine2` Line 2 r
Line (Dimension (LineSegment 2 q r)) (NumType (LineSegment 2 q r))
l2 Bool -> Bool -> Bool
&& Interval p Int
i1 Interval p Int -> Interval q Int -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` Interval q Int
i2
      (Interval p Int
i1,Interval q Int
i2) = Vector 2 r
-> LineSegment 2 p r
-> LineSegment 2 q r
-> (Interval p Int, Interval q Int)
forall p q r.
(Ord r, Num r) =>
Vector 2 r
-> LineSegment 2 p r
-> LineSegment 2 q r
-> (Interval p Int, Interval q Int)
withRank Vector 2 r
v LineSegment 2 p r
s1 LineSegment 2 q r
s2

    -- correctness argument:
    -- if the segments share a supportingLine (l1 and l2 parallel, and point of l1 on l2)
    -- the segments intersect iff their intervals along the line intersect.

    -- if the supporting lines intersect in a point, say x the
    -- segments intersect iff s1 intersects the supporting line and
    -- vice versa:
    ---
    -- => direction: is trivial
    -- <= direction: s1 intersects l2 means x
    -- lies on s1. Symmetrically s2 intersects l1 means x lies on
    -- s2. Hence, x lies on both s1 and s2, and thus the segments
    -- intersect.






instance (Ord r, Fractional r) =>
         LineSegment 2 p r `IsIntersectableWith` LineSegment 2 q r where
  nonEmptyIntersection :: proxy (LineSegment 2 p r)
-> proxy (LineSegment 2 q r)
-> Intersection (LineSegment 2 p r) (LineSegment 2 q r)
-> Bool
nonEmptyIntersection = proxy (LineSegment 2 p r)
-> proxy (LineSegment 2 q r)
-> Intersection (LineSegment 2 p r) (LineSegment 2 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
a intersect :: LineSegment 2 p r
-> LineSegment 2 q r
-> Intersection (LineSegment 2 p r) (LineSegment 2 q r)
`intersect` LineSegment 2 q r
b = CoRec
  Identity '[NoIntersection, Point 2 r, SubLine 2 (Either p q) r r]
-> Handlers
     '[NoIntersection, Point 2 r, SubLine 2 (Either p q) r r]
     (CoRec
        Identity
        '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r])
-> CoRec
     Identity '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r]
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match ((LineSegment 2 p r
aLineSegment 2 p r
-> Getting (SubLine 2 p r r) (LineSegment 2 p r) (SubLine 2 p r r)
-> SubLine 2 p r r
forall s a. s -> Getting a s a -> a
^.Getting (SubLine 2 p r r) (LineSegment 2 p r) (SubLine 2 p r r)
forall r (d :: Nat) p.
(Num r, Arity d) =>
Iso' (LineSegment d p r) (SubLine d p r r)
_SubLine) SubLine 2 p r r
-> SubLine 2 q r r
-> Intersection (SubLine 2 p r r) (SubLine 2 q r r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` (LineSegment 2 q r
bLineSegment 2 q r
-> Getting (SubLine 2 q r r) (LineSegment 2 q r) (SubLine 2 q r r)
-> SubLine 2 q r r
forall s a. s -> Getting a s a -> a
^.Getting (SubLine 2 q r r) (LineSegment 2 q r) (SubLine 2 q r r)
forall r (d :: Nat) p.
(Num r, Arity d) =>
Iso' (LineSegment d p r) (SubLine d p r r)
_SubLine)) (Handlers
   '[NoIntersection, Point 2 r, SubLine 2 (Either p q) r r]
   (CoRec
      Identity
      '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r])
 -> CoRec
      Identity
      '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r])
-> Handlers
     '[NoIntersection, Point 2 r, SubLine 2 (Either p q) r r]
     (CoRec
        Identity
        '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r])
-> CoRec
     Identity '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r]
forall a b. (a -> b) -> a -> b
$
         (NoIntersection
 -> CoRec
      Identity
      '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r])
-> Handler
     (CoRec
        Identity
        '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r])
     NoIntersection
forall b a. (a -> b) -> Handler b a
H NoIntersection
-> CoRec
     Identity '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec
      Handler
  (CoRec
     Identity
     '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r])
  NoIntersection
-> Rec
     (Handler
        (CoRec
           Identity
           '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r]))
     '[Point 2 r, SubLine 2 (Either p q) r r]
-> Handlers
     '[NoIntersection, Point 2 r, SubLine 2 (Either p q) r r]
     (CoRec
        Identity
        '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r])
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Point 2 r
 -> CoRec
      Identity
      '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r])
-> Handler
     (CoRec
        Identity
        '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r])
     (Point 2 r)
forall b a. (a -> b) -> Handler b a
H Point 2 r
-> CoRec
     Identity '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec
      Handler
  (CoRec
     Identity
     '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r])
  (Point 2 r)
-> Rec
     (Handler
        (CoRec
           Identity
           '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r]))
     '[SubLine 2 (Either p q) r r]
-> Rec
     (Handler
        (CoRec
           Identity
           '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r]))
     '[Point 2 r, SubLine 2 (Either p q) r r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (SubLine 2 (Either p q) r r
 -> CoRec
      Identity
      '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r])
-> Handler
     (CoRec
        Identity
        '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r])
     (SubLine 2 (Either p q) r r)
forall b a. (a -> b) -> Handler b a
H (LineSegment 2 (Either p q) r
-> CoRec
     Identity '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (LineSegment 2 (Either p q) r
 -> CoRec
      Identity
      '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r])
-> (SubLine 2 (Either p q) r r -> LineSegment 2 (Either p q) r)
-> SubLine 2 (Either p q) r r
-> CoRec
     Identity '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubLine 2 (Either p q) r r -> LineSegment 2 (Either p q) r
forall r (d :: Nat) p.
(Num r, Arity d) =>
SubLine d p r r -> LineSegment d p r
subLineToSegment)
      Handler
  (CoRec
     Identity
     '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r])
  (SubLine 2 (Either p q) r r)
-> Rec
     (Handler
        (CoRec
           Identity
           '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r]))
     '[]
-> Rec
     (Handler
        (CoRec
           Identity
           '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r]))
     '[SubLine 2 (Either p q) r r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec
  (Handler
     (CoRec
        Identity
        '[NoIntersection, Point 2 r, LineSegment 2 (Either p q) r]))
  '[]
forall u (a :: u -> *). Rec a '[]
RNil

instance (Ord r, Num r) =>
         LineSegment 2 p r `HasIntersectionWith` Line 2 r where
  (LineSegment EndPoint (Point 2 r :+ p)
p EndPoint (Point 2 r :+ p)
q) intersects :: LineSegment 2 p r -> Line 2 r -> Bool
`intersects` Line 2 r
l = case Point 2 r -> Line 2 r -> SideTest
forall r. (Ord r, Num r) => Point 2 r -> Line 2 r -> SideTest
onSide (EndPoint (Point 2 r :+ p)
pEndPoint (Point 2 r :+ p)
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> EndPoint (Point 2 r :+ p)
-> Const (Point 2 r) (EndPoint (Point 2 r :+ p))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> EndPoint (Point 2 r :+ p)
 -> Const (Point 2 r) (EndPoint (Point 2 r :+ p)))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) Line 2 r
l of
    SideTest
OnLine -> EndPoint (Point 2 r :+ p) -> Bool
forall a. EndPoint a -> Bool
isClosed EndPoint (Point 2 r :+ p)
p Bool -> Bool -> Bool
|| case Point 2 r -> Line 2 r -> SideTest
forall r. (Ord r, Num r) => Point 2 r -> Line 2 r -> SideTest
onSide (EndPoint (Point 2 r :+ p)
qEndPoint (Point 2 r :+ p)
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> EndPoint (Point 2 r :+ p)
-> Const (Point 2 r) (EndPoint (Point 2 r :+ p))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> EndPoint (Point 2 r :+ p)
 -> Const (Point 2 r) (EndPoint (Point 2 r :+ p)))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) Line 2 r
l of
                              SideTest
OnLine -> EndPoint (Point 2 r :+ p) -> Bool
forall a. EndPoint a -> Bool
isClosed EndPoint (Point 2 r :+ p)
q Bool -> Bool -> Bool
|| (EndPoint (Point 2 r :+ p)
pEndPoint (Point 2 r :+ p)
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> EndPoint (Point 2 r :+ p)
-> Const (Point 2 r) (EndPoint (Point 2 r :+ p))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> EndPoint (Point 2 r :+ p)
 -> Const (Point 2 r) (EndPoint (Point 2 r :+ p)))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) Point 2 r -> Point 2 r -> Bool
forall a. Eq a => a -> a -> Bool
/= (EndPoint (Point 2 r :+ p)
qEndPoint (Point 2 r :+ p)
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> EndPoint (Point 2 r :+ p)
-> Const (Point 2 r) (EndPoint (Point 2 r :+ p))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> EndPoint (Point 2 r :+ p)
 -> Const (Point 2 r) (EndPoint (Point 2 r :+ p)))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core)
                              SideTest
_      -> Bool
False
    SideTest
sp     -> case Point 2 r -> Line 2 r -> SideTest
forall r. (Ord r, Num r) => Point 2 r -> Line 2 r -> SideTest
onSide (EndPoint (Point 2 r :+ p)
qEndPoint (Point 2 r :+ p)
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> EndPoint (Point 2 r :+ p)
-> Const (Point 2 r) (EndPoint (Point 2 r :+ p))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> EndPoint (Point 2 r :+ p)
 -> Const (Point 2 r) (EndPoint (Point 2 r :+ p)))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) Line 2 r
l of
                SideTest
OnLine -> EndPoint (Point 2 r :+ p) -> Bool
forall a. EndPoint a -> Bool
isClosed EndPoint (Point 2 r :+ p)
q
                SideTest
sq     -> SideTest
sp SideTest -> SideTest -> Bool
forall a. Eq a => a -> a -> Bool
/= SideTest
sq


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

  LineSegment 2 p r
s intersect :: LineSegment 2 p r
-> Line 2 r -> Intersection (LineSegment 2 p r) (Line 2 r)
`intersect` Line 2 r
l = let ubSL :: SubLine 2 () (UnBounded r) r
ubSL = LineSegment 2 p r
sLineSegment 2 p r
-> Getting
     (SubLine 2 () (UnBounded r) r)
     (LineSegment 2 p r)
     (SubLine 2 () (UnBounded r) r)
-> SubLine 2 () (UnBounded r) r
forall s a. s -> Getting a s a -> a
^.(SubLine 2 p r r
 -> Const (SubLine 2 () (UnBounded r) r) (SubLine 2 p r r))
-> LineSegment 2 p r
-> Const (SubLine 2 () (UnBounded r) r) (LineSegment 2 p r)
forall r (d :: Nat) p.
(Num r, Arity d) =>
Iso' (LineSegment d p r) (SubLine d p r r)
_SubLine((SubLine 2 p r r
  -> Const (SubLine 2 () (UnBounded r) r) (SubLine 2 p r r))
 -> LineSegment 2 p r
 -> Const (SubLine 2 () (UnBounded r) r) (LineSegment 2 p r))
-> ((SubLine 2 () (UnBounded r) r
     -> Const
          (SubLine 2 () (UnBounded r) r) (SubLine 2 () (UnBounded r) r))
    -> SubLine 2 p r r
    -> Const (SubLine 2 () (UnBounded r) r) (SubLine 2 p r r))
-> Getting
     (SubLine 2 () (UnBounded r) r)
     (LineSegment 2 p r)
     (SubLine 2 () (UnBounded r) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.AReview (SubLine 2 p (UnBounded r) r) (SubLine 2 p r r)
-> Getter (SubLine 2 p r r) (SubLine 2 p (UnBounded r) r)
forall t b. AReview t b -> Getter b t
re AReview (SubLine 2 p (UnBounded r) r) (SubLine 2 p r r)
forall (d :: Nat) p r.
Prism' (SubLine d p (UnBounded r) r) (SubLine d p r r)
_unBounded((SubLine 2 p (UnBounded r) r
  -> Const
       (SubLine 2 () (UnBounded r) r) (SubLine 2 p (UnBounded r) r))
 -> SubLine 2 p r r
 -> Const (SubLine 2 () (UnBounded r) r) (SubLine 2 p r r))
-> ((SubLine 2 () (UnBounded r) r
     -> Const
          (SubLine 2 () (UnBounded r) r) (SubLine 2 () (UnBounded r) r))
    -> SubLine 2 p (UnBounded r) r
    -> Const
         (SubLine 2 () (UnBounded r) r) (SubLine 2 p (UnBounded r) r))
-> (SubLine 2 () (UnBounded r) r
    -> Const
         (SubLine 2 () (UnBounded r) r) (SubLine 2 () (UnBounded r) r))
-> SubLine 2 p r r
-> Const (SubLine 2 () (UnBounded r) r) (SubLine 2 p r r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SubLine 2 p (UnBounded r) r -> SubLine 2 () (UnBounded r) r)
-> (SubLine 2 () (UnBounded r) r
    -> Const
         (SubLine 2 () (UnBounded r) r) (SubLine 2 () (UnBounded r) r))
-> SubLine 2 p (UnBounded r) r
-> Const
     (SubLine 2 () (UnBounded r) r) (SubLine 2 p (UnBounded r) r)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to SubLine 2 p (UnBounded r) r -> SubLine 2 () (UnBounded r) r
forall (d :: Nat) p s r. SubLine d p s r -> SubLine d () s r
dropExtra
                    in CoRec
  Identity
  '[NoIntersection, Point 2 r,
    SubLine 2 (Either () ()) (UnBounded r) r]
-> Handlers
     '[NoIntersection, Point 2 r,
       SubLine 2 (Either () ()) (UnBounded r) r]
     (CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r])
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r]
forall (ts :: [*]) b. CoRec Identity ts -> Handlers ts b -> b
match (SubLine 2 () (UnBounded r) r
ubSL SubLine 2 () (UnBounded r) r
-> SubLine 2 () (UnBounded r) r
-> Intersection
     (SubLine 2 () (UnBounded r) r) (SubLine 2 () (UnBounded r) r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Line 2 r -> SubLine 2 () (UnBounded r) r
forall (d :: Nat) r.
Arity d =>
Line d r -> SubLine d () (UnBounded r) r
fromLine Line 2 r
l) (Handlers
   '[NoIntersection, Point 2 r,
     SubLine 2 (Either () ()) (UnBounded r) r]
   (CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r])
 -> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r])
-> Handlers
     '[NoIntersection, Point 2 r,
       SubLine 2 (Either () ()) (UnBounded r) r]
     (CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r])
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r]
forall a b. (a -> b) -> a -> b
$
                            (NoIntersection
 -> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r])
-> Handler
     (CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r])
     NoIntersection
forall b a. (a -> b) -> Handler b a
H  NoIntersection
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec
                         Handler
  (CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r])
  NoIntersection
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r]))
     '[Point 2 r, SubLine 2 (Either () ()) (UnBounded r) r]
-> Handlers
     '[NoIntersection, Point 2 r,
       SubLine 2 (Either () ()) (UnBounded r) r]
     (CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r])
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (Point 2 r
 -> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r])
-> Handler
     (CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r])
     (Point 2 r)
forall b a. (a -> b) -> Handler b a
H  Point 2 r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec
                         Handler
  (CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r])
  (Point 2 r)
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r]))
     '[SubLine 2 (Either () ()) (UnBounded r) r]
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r]))
     '[Point 2 r, SubLine 2 (Either () ()) (UnBounded r) r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (SubLine 2 (Either () ()) (UnBounded r) r
 -> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r])
-> Handler
     (CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r])
     (SubLine 2 (Either () ()) (UnBounded r) r)
forall b a. (a -> b) -> Handler b a
H (CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r]
-> SubLine 2 (Either () ()) (UnBounded r) r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r]
forall a b. a -> b -> a
const (LineSegment 2 p r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec LineSegment 2 p r
s))
                         Handler
  (CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r])
  (SubLine 2 (Either () ()) (UnBounded r) r)
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r]))
     '[]
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r]))
     '[SubLine 2 (Either () ()) (UnBounded r) r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& Rec
  (Handler
     (CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r]))
  '[]
forall u (a :: u -> *). Rec a '[]
RNil



-- * Functions on LineSegments

-- | Test if a point lies on a line segment.
--
-- >>> (Point2 1 0) `onSegment2` (ClosedLineSegment (origin :+ ()) (Point2 2 0 :+ ()))
-- True
-- >>> (Point2 1 1) `onSegment2` (ClosedLineSegment (origin :+ ()) (Point2 2 0 :+ ()))
-- False
-- >>> (Point2 5 0) `onSegment2` (ClosedLineSegment (origin :+ ()) (Point2 2 0 :+ ()))
-- False
-- >>> (Point2 (-1) 0) `onSegment2` (ClosedLineSegment (origin :+ ()) (Point2 2 0 :+ ()))
-- False
-- >>> (Point2 1 1) `onSegment2` (ClosedLineSegment (origin :+ ()) (Point2 3 3 :+ ()))
-- True
-- >>> (Point2 2 0) `onSegment2` (ClosedLineSegment (origin :+ ()) (Point2 2 0 :+ ()))
-- True
-- >>> origin `onSegment2` (ClosedLineSegment (origin :+ ()) (Point2 2 0 :+ ()))
-- True
onSegment2                          :: (Ord r, Num r)
                                    => Point 2 r -> LineSegment 2 p r -> Bool
Point 2 r
p onSegment2 :: Point 2 r -> LineSegment 2 p r -> Bool
`onSegment2` s :: LineSegment 2 p r
s@(LineSegment EndPoint (Point 2 r :+ p)
u EndPoint (Point 2 r :+ p)
v) = case (Point 2 r :+ ()) -> (Point 2 r :+ p) -> (Point 2 r :+ p) -> CCW
forall r a b c.
(Ord r, Num r) =>
(Point 2 r :+ a) -> (Point 2 r :+ b) -> (Point 2 r :+ c) -> CCW
ccw' (Point 2 r -> Point 2 r :+ ()
forall a. a -> a :+ ()
ext Point 2 r
p) (EndPoint (Point 2 r :+ p)
uEndPoint (Point 2 r :+ p)
-> Getting
     (Point 2 r :+ p) (EndPoint (Point 2 r :+ p)) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Getting
  (Point 2 r :+ p) (EndPoint (Point 2 r :+ p)) (Point 2 r :+ p)
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint) (EndPoint (Point 2 r :+ p)
vEndPoint (Point 2 r :+ p)
-> Getting
     (Point 2 r :+ p) (EndPoint (Point 2 r :+ p)) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Getting
  (Point 2 r :+ p) (EndPoint (Point 2 r :+ p)) (Point 2 r :+ p)
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint) of
    CCW
CoLinear -> let su :: SideTest
su = Point 2 r
p Point 2 r -> Line 2 r -> SideTest
forall r. (Ord r, Num r) => Point 2 r -> Line 2 r -> SideTest
`onSide` Line 2 r
lu
                    sv :: SideTest
sv = Point 2 r
p Point 2 r -> Line 2 r -> SideTest
forall r. (Ord r, Num r) => Point 2 r -> Line 2 r -> SideTest
`onSide` Line 2 r
lv
                in SideTest
su SideTest -> SideTest -> Bool
forall a. Eq a => a -> a -> Bool
/= SideTest
sv
                Bool -> Bool -> Bool
&& ((SideTest
su SideTest -> SideTest -> Bool
forall a. Eq a => a -> a -> Bool
== SideTest
OnLine) Bool -> Bool -> Bool
`implies` EndPoint (Point 2 r :+ p) -> Bool
forall a. EndPoint a -> Bool
isClosed EndPoint (Point 2 r :+ p)
u)
                Bool -> Bool -> Bool
&& ((SideTest
sv SideTest -> SideTest -> Bool
forall a. Eq a => a -> a -> Bool
== SideTest
OnLine) Bool -> Bool -> Bool
`implies` EndPoint (Point 2 r :+ p) -> Bool
forall a. EndPoint a -> Bool
isClosed EndPoint (Point 2 r :+ p)
v)
    CCW
_        -> Bool
False
  where
    (Line Point 2 r
_ Vector 2 r
w) = Line 2 r -> Line 2 r
forall r. Num r => Line 2 r -> Line 2 r
perpendicularTo (Line 2 r -> Line 2 r) -> Line 2 r -> Line 2 r
forall a b. (a -> b) -> a -> b
$ 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
    lu :: Line 2 r
lu = Point 2 r -> Vector 2 r -> Line 2 r
forall (d :: Nat) r. Point d r -> Vector d r -> Line d r
Line (EndPoint (Point 2 r :+ p)
uEndPoint (Point 2 r :+ p)
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> EndPoint (Point 2 r :+ p)
-> Const (Point 2 r) (EndPoint (Point 2 r :+ p))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> EndPoint (Point 2 r :+ p)
 -> Const (Point 2 r) (EndPoint (Point 2 r :+ p)))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) Vector 2 r
w
    lv :: Line 2 r
lv = Point 2 r -> Vector 2 r -> Line 2 r
forall (d :: Nat) r. Point d r -> Vector d r -> Line d r
Line (EndPoint (Point 2 r :+ p)
vEndPoint (Point 2 r :+ p)
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
-> Point 2 r
forall s a. s -> Getting a s a -> a
^.((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> EndPoint (Point 2 r :+ p)
-> Const (Point 2 r) (EndPoint (Point 2 r :+ p))
forall a b. Lens (EndPoint a) (EndPoint b) a b
unEndPoint(((Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
 -> EndPoint (Point 2 r :+ p)
 -> Const (Point 2 r) (EndPoint (Point 2 r :+ p)))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p))
-> Getting (Point 2 r) (EndPoint (Point 2 r :+ p)) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> (Point 2 r :+ p) -> Const (Point 2 r) (Point 2 r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core) Vector 2 r
w

    Bool
a implies :: Bool -> Bool -> Bool
`implies` Bool
b = Bool
b Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
a


-- | The left and right end point (or left below right if they have equal x-coords)
orderedEndPoints   :: Ord r => LineSegment 2 p r -> (Point 2 r :+ p, Point 2 r :+ p)
orderedEndPoints :: LineSegment 2 p r -> (Point 2 r :+ p, Point 2 r :+ p)
orderedEndPoints LineSegment 2 p r
s = if Point 2 r
pc Point 2 r -> Point 2 r -> Bool
forall a. Ord a => a -> a -> Bool
<= Point 2 r
qc then (Point 2 r :+ p
p, Point 2 r :+ p
q) else (Point 2 r :+ p
q,Point 2 r :+ p
p)
  where
    p :: Point 2 r :+ p
p@(Point 2 r
pc :+ p
_) = LineSegment 2 p r
sLineSegment 2 p r
-> Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start
    q :: Point 2 r :+ p
q@(Point 2 r
qc :+ p
_) = LineSegment 2 p r
sLineSegment 2 p r
-> Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
-> Point 2 r :+ p
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r :+ p) (LineSegment 2 p r) (Point 2 r :+ p)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end


-- | Length of the line segment
segmentLength                     :: (Arity d, Floating r) => LineSegment d p r -> r
segmentLength :: LineSegment d p r -> r
segmentLength ~(LineSegment' Point d r :+ p
p Point d r :+ p
q) = Point d r -> Point d r -> r
forall a (p :: * -> *).
(Floating a, Foldable (Diff p), Affine p) =>
p a -> p a -> a
distanceA (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) (Point d r :+ p
q(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)

-- | Squared length of a line segment.
sqSegmentLength                     :: (Arity d, Num r) => LineSegment d p r -> r
sqSegmentLength :: LineSegment d p r -> r
sqSegmentLength ~(LineSegment' Point d r :+ p
p Point d r :+ p
q) = 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
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) (Point d r :+ p
q(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)

-- | Squared distance from the point to the Segment s. The same remark as for
-- the 'sqDistanceToSegArg' applies here.
{-# DEPRECATED sqDistanceToSeg "use squaredEuclideanDistTo instead" #-}
sqDistanceToSeg   :: (Arity d, Fractional r, Ord r) => Point d r -> LineSegment d p r -> r
sqDistanceToSeg :: Point d r -> LineSegment d p r -> r
sqDistanceToSeg Point d r
p = (r, Point d r) -> r
forall a b. (a, b) -> a
fst ((r, Point d r) -> r)
-> (LineSegment d p r -> (r, Point d r)) -> LineSegment d p r -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point d r -> LineSegment d p r -> (r, Point d r)
forall (d :: Nat) r p.
(Arity d, Fractional r, Ord r) =>
Point d r -> LineSegment d p r -> (r, Point d r)
sqDistanceToSegArg Point d r
p

-- | Squared distance from the point to the Segment s, and the point on s
-- realizing it.
--
-- Note that if the segment is *open*, the closest point returned may
-- be one of the (open) end points, even though technically the end
-- point does not lie on the segment. (The true closest point then
-- lies arbitrarily close to the end point).
--
-- >>> :{
-- let ls = OpenLineSegment (Point2 0 0 :+ ()) (Point2 1 0 :+ ())
--     p  = Point2 2 0
-- in  snd (sqDistanceToSegArg p ls) == Point2 1 0
-- :}
-- True
sqDistanceToSegArg                          :: (Arity d, Fractional r, Ord r)
                                            => Point d r -> LineSegment d p r -> (r, Point d r)
sqDistanceToSegArg :: Point d r -> LineSegment d p r -> (r, Point d r)
sqDistanceToSegArg Point d r
p (LineSegment d p r -> LineSegment d p r
forall (d :: Nat) p r. LineSegment d p r -> LineSegment d p r
toClosedSegment -> LineSegment d p r
s) =
  let m :: (r, Point d r)
m  = Point d r -> Line d r -> (r, Point d r)
forall r (d :: Nat).
(Fractional r, Arity d) =>
Point d r -> Line d r -> (r, Point d r)
sqDistanceToArg Point d r
p (LineSegment d p r
-> Line
     (Dimension (LineSegment d p r)) (NumType (LineSegment d p r))
forall t.
HasSupportingLine t =>
t -> Line (Dimension t) (NumType t)
supportingLine LineSegment d p r
s)
      xs :: [(r, Point d r)]
xs = (r, Point d r)
m (r, Point d r) -> [(r, Point d r)] -> [(r, Point d r)]
forall a. a -> [a] -> [a]
: ((Point d r :+ p) -> (r, Point d r))
-> [Point d r :+ p] -> [(r, Point d r)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Point d r
q :+ p
_) -> (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
q, Point d r
q)) [LineSegment d p r
sLineSegment d p r
-> Getting (Point d r :+ p) (LineSegment d p r) (Point d r :+ p)
-> Point d r :+ p
forall s a. s -> Getting a s a -> a
^.Getting (Point d r :+ p) (LineSegment d p r) (Point d r :+ p)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start, LineSegment d p r
sLineSegment d p r
-> Getting (Point d r :+ p) (LineSegment d p r) (Point d r :+ p)
-> Point d r :+ p
forall s a. s -> Getting a s a -> a
^.Getting (Point d r :+ p) (LineSegment d p r) (Point d r :+ p)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end]
  in   ((r, Point d r) -> (r, Point d r) -> Ordering)
-> [(r, Point d r)] -> (r, Point d r)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
F.minimumBy (((r, Point d r) -> r)
-> (r, Point d r) -> (r, Point d r) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (r, Point d r) -> r
forall a b. (a, b) -> a
fst)
     ([(r, Point d r)] -> (r, Point d r))
-> ([(r, Point d r)] -> [(r, Point d r)])
-> [(r, Point d r)]
-> (r, Point d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((r, Point d r) -> Bool) -> [(r, Point d r)] -> [(r, Point d r)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Point d r -> LineSegment d p r -> Bool)
-> LineSegment d p r -> Point d r -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Point d r -> LineSegment d p r -> Bool
forall r (d :: Nat) p.
(Ord r, Fractional r, Arity d) =>
Point d r -> LineSegment d p r -> Bool
onSegment LineSegment d p r
s (Point d r -> Bool)
-> ((r, Point d r) -> Point d r) -> (r, Point d r) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r, Point d r) -> Point d r
forall a b. (a, b) -> b
snd) ([(r, Point d r)] -> (r, Point d r))
-> [(r, Point d r)] -> (r, Point d r)
forall a b. (a -> b) -> a -> b
$ [(r, Point d r)]
xs

instance (Fractional r, Arity d, Ord r) => HasSquaredEuclideanDistance (LineSegment d p r) where
  pointClosestToWithDistance :: Point (Dimension (LineSegment d p r)) (NumType (LineSegment d p r))
-> LineSegment d p r
-> (Point
      (Dimension (LineSegment d p r)) (NumType (LineSegment d p r)),
    NumType (LineSegment d p r))
pointClosestToWithDistance Point (Dimension (LineSegment d p r)) (NumType (LineSegment d p r))
q = (r, Point d r) -> (Point d r, r)
forall a b. (a, b) -> (b, a)
swap ((r, Point d r) -> (Point d r, r))
-> (LineSegment d p r -> (r, Point d r))
-> LineSegment d p r
-> (Point d r, r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point d r -> LineSegment d p r -> (r, Point d r)
forall (d :: Nat) r p.
(Arity d, Fractional r, Ord r) =>
Point d r -> LineSegment d p r -> (r, Point d r)
sqDistanceToSegArg Point d r
Point (Dimension (LineSegment d p r)) (NumType (LineSegment d p r))
q


-- | flips the start and end point of the segment
flipSegment   :: LineSegment d p r -> LineSegment d p r
flipSegment :: LineSegment d p r -> LineSegment d p r
flipSegment LineSegment d p r
s = let p :: Point d r :+ p
p = LineSegment d p r
sLineSegment d p r
-> Getting (Point d r :+ p) (LineSegment d p r) (Point d r :+ p)
-> Point d r :+ p
forall s a. s -> Getting a s a -> a
^.Getting (Point d r :+ p) (LineSegment d p r) (Point d r :+ p)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start
                    q :: Point d r :+ p
q = LineSegment d p r
sLineSegment d p r
-> Getting (Point d r :+ p) (LineSegment d p r) (Point d r :+ p)
-> Point d r :+ p
forall s a. s -> Getting a s a -> a
^.Getting (Point d r :+ p) (LineSegment d p r) (Point d r :+ p)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end
                in (LineSegment d p r
sLineSegment d p r
-> (LineSegment d p r -> LineSegment d p r) -> LineSegment d p r
forall a b. a -> (a -> b) -> b
&((Point d r :+ p) -> Identity (Point d r :+ p))
-> LineSegment d p r -> Identity (LineSegment d p r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start (((Point d r :+ p) -> Identity (Point d r :+ p))
 -> LineSegment d p r -> Identity (LineSegment d p r))
-> (Point d r :+ p) -> LineSegment d p r -> LineSegment d p r
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Point d r :+ p
q)LineSegment d p r
-> (LineSegment d p r -> LineSegment d p r) -> LineSegment d p r
forall a b. a -> (a -> b) -> b
&((Point d r :+ p) -> Identity (Point d r :+ p))
-> LineSegment d p r -> Identity (LineSegment d p r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end (((Point d r :+ p) -> Identity (Point d r :+ p))
 -> LineSegment d p r -> Identity (LineSegment d p r))
-> (Point d r :+ p) -> LineSegment d p r -> LineSegment d p r
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Point d r :+ p
p

-- testSeg :: LineSegment 2 () Rational
-- testSeg = LineSegment (Open $ ext origin)  (Closed $ ext (Point2 10 0))

-- horL' :: Line 2 Rational
-- horL' = horizontalLine 0

-- testI = testSeg `intersect` horL'


-- ff = bimap (fmap Val) (const ())

-- ss' = let (LineSegment p q) = testSeg in
--       LineSegment (p&unEndPoint %~ ff)
--                   (q&unEndPoint %~ ff)

-- ss'' = ss'^._SubLine

-- | Linearly interpolate the two endpoints with a value in the range [0,1]
--
-- >>> interpolate 0.5 $ ClosedLineSegment (ext $ origin) (ext $ Point2 10.0 10.0)
-- Point2 5.0 5.0
-- >>> interpolate 0.1 $ ClosedLineSegment (ext $ origin) (ext $ Point2 10.0 10.0)
-- Point2 1.0 1.0
-- >>> interpolate 0 $ ClosedLineSegment (ext $ origin) (ext $ Point2 10.0 10.0)
-- Point2 0.0 0.0
-- >>> interpolate 1 $ ClosedLineSegment (ext $ origin) (ext $ Point2 10.0 10.0)
-- Point2 10.0 10.0
interpolate                      :: (Fractional r, Arity d) => r -> LineSegment d p r -> Point d r
interpolate :: r -> LineSegment d p r -> Point d r
interpolate r
t (LineSegment' Point d r :+ p
p Point d r :+ p
q) = Vector d r -> Point d r
forall (d :: Nat) r. Vector d r -> Point d r
Point (Vector d r -> Point d r) -> Vector d r -> Point d r
forall a b. (a -> b) -> a -> b
$ ((Point d r :+ p) -> Vector d r
forall (d :: Nat) r extra. (Point d r :+ extra) -> Vector d r
asV Point d r :+ p
p Vector d r -> r -> Vector d r
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* (r
1r -> r -> r
forall a. Num a => a -> a -> a
-r
t)) Vector d r -> Vector d r -> Vector d r
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^+^ ((Point d r :+ p) -> Vector d r
forall (d :: Nat) r extra. (Point d r :+ extra) -> Vector d r
asV Point d r :+ p
q Vector d r -> r -> Vector d r
forall (f :: * -> *) a. (Functor f, Num a) => f a -> a -> f a
^* r
t)
  where
    asV :: (Point d r :+ extra) -> Vector d r
asV = ((Point d r :+ extra)
-> Getting (Vector d r) (Point d r :+ extra) (Vector d r)
-> Vector d r
forall s a. s -> Getting a s a -> a
^.(Point d r -> Const (Vector d r) (Point d r))
-> (Point d r :+ extra) -> Const (Vector d r) (Point d r :+ extra)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((Point d r -> Const (Vector d r) (Point d r))
 -> (Point d r :+ extra) -> Const (Vector d r) (Point d r :+ extra))
-> ((Vector d r -> Const (Vector d r) (Vector d r))
    -> Point d r -> Const (Vector d r) (Point d r))
-> Getting (Vector d r) (Point d r :+ extra) (Vector d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vector d r -> Const (Vector d r) (Vector d r))
-> Point d r -> Const (Vector d r) (Point d r)
forall (d :: Nat) r r'.
Lens (Point d r) (Point d r') (Vector d r) (Vector d r')
vector)


-- | smart constructor that creates a valid segment, i.e. it validates
-- that the endpoints are disjoint.
validSegment     :: (Eq r, Arity d)
                 => EndPoint (Point d r :+ p) -> EndPoint (Point d r :+ p)
                 -> Maybe (LineSegment d p r)
validSegment :: EndPoint (Point d r :+ p)
-> EndPoint (Point d r :+ p) -> Maybe (LineSegment d p r)
validSegment EndPoint (Point d r :+ p)
u EndPoint (Point d r :+ p)
v = let s :: LineSegment d p r
s = EndPoint (Point d r :+ p)
-> EndPoint (Point d r :+ p) -> LineSegment d p r
forall (d :: Nat) r p.
EndPoint (Point d r :+ p)
-> EndPoint (Point d r :+ p) -> LineSegment d p r
LineSegment EndPoint (Point d r :+ p)
u EndPoint (Point d r :+ p)
v
                   in if LineSegment d p r
sLineSegment d p r
-> Getting (Point d r) (LineSegment d p r) (Point d r) -> Point d r
forall s a. s -> Getting a s a -> a
^.((Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> LineSegment d p r -> Const (Point d r) (LineSegment d p r)
forall t. HasStart t => Lens' t (StartCore t :+ StartExtra t)
start(((Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
 -> LineSegment d p r -> Const (Point d r) (LineSegment d p r))
-> ((Point d r -> Const (Point d r) (Point d r))
    -> (Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> Getting (Point d r) (LineSegment d p r) (Point d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point d r -> Const (Point d r) (Point d r))
-> (Point d r :+ p) -> Const (Point d r) (Point d r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core Point d r -> Point d r -> Bool
forall a. Eq a => a -> a -> Bool
/= LineSegment d p r
sLineSegment d p r
-> Getting (Point d r) (LineSegment d p r) (Point d r) -> Point d r
forall s a. s -> Getting a s a -> a
^.((Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> LineSegment d p r -> Const (Point d r) (LineSegment d p r)
forall t. HasEnd t => Lens' t (EndCore t :+ EndExtra t)
end(((Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
 -> LineSegment d p r -> Const (Point d r) (LineSegment d p r))
-> ((Point d r -> Const (Point d r) (Point d r))
    -> (Point d r :+ p) -> Const (Point d r) (Point d r :+ p))
-> Getting (Point d r) (LineSegment d p r) (Point d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point d r -> Const (Point d r) (Point d r))
-> (Point d r :+ p) -> Const (Point d r) (Point d r :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core then LineSegment d p r -> Maybe (LineSegment d p r)
forall a. a -> Maybe a
Just LineSegment d p r
s else Maybe (LineSegment d p r)
forall a. Maybe a
Nothing



-- | Given a y-coordinate, compare the segments based on the
-- x-coordinate of the intersection with the horizontal line through y
ordAtY   :: (Fractional r, Ord r) => r
         -> LineSegment 2 p r -> LineSegment 2 p r -> Ordering
ordAtY :: r -> LineSegment 2 p r -> LineSegment 2 p r -> Ordering
ordAtY r
y = (LineSegment 2 p r -> r)
-> LineSegment 2 p r -> LineSegment 2 p r -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (r -> LineSegment 2 p r -> r
forall r p. (Fractional r, Ord r) => r -> LineSegment 2 p r -> r
xCoordAt r
y)

-- | Given an x-coordinate, compare the segments based on the
-- y-coordinate of the intersection with the horizontal line through y
ordAtX   :: (Fractional r, Ord r) => r
         -> LineSegment 2 p r -> LineSegment 2 p r -> Ordering
ordAtX :: r -> LineSegment 2 p r -> LineSegment 2 p r -> Ordering
ordAtX r
x = (LineSegment 2 p r -> r)
-> LineSegment 2 p r -> LineSegment 2 p r -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (r -> LineSegment 2 p r -> r
forall r p. (Fractional r, Ord r) => r -> LineSegment 2 p r -> r
yCoordAt r
x)

-- | Given a y coord and a line segment that intersects the horizontal line
-- through y, compute the x-coordinate of this intersection point.
--
-- note that we will pretend that the line segment is closed, even if it is not
xCoordAt             :: (Fractional r, Ord r) => r -> LineSegment 2 p r -> r
xCoordAt :: r -> LineSegment 2 p r -> r
xCoordAt r
y (LineSegment' (Point2 r
px r
py :+ p
_) (Point2 r
qx r
qy :+ p
_))
      | r
py r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
qy     = r
px r -> r -> r
forall a. Ord a => a -> a -> a
`max` r
qx  -- s is horizontal, and since it by the
                                    -- precondition it intersects the sweep
                                    -- line, we return the x-coord of the
                                    -- rightmost endpoint.
      | Bool
otherwise    = r
px r -> r -> r
forall a. Num a => a -> a -> a
+ r
alpha r -> r -> r
forall a. Num a => a -> a -> a
* (r
qx r -> r -> r
forall a. Num a => a -> a -> a
- r
px)
  where
    alpha :: r
alpha = (r
y r -> r -> r
forall a. Num a => a -> a -> a
- r
py) r -> r -> r
forall a. Fractional a => a -> a -> a
/ (r
qy r -> r -> r
forall a. Num a => a -> a -> a
- r
py)


-- | Given an x-coordinate and a line segment that intersects the vertical line
-- through x, compute the y-coordinate of this intersection point.
--
-- note that we will pretend that the line segment is closed, even if it is not
yCoordAt :: (Fractional r, Ord r) => r -> LineSegment 2 p r -> r
yCoordAt :: r -> LineSegment 2 p r -> r
yCoordAt r
x (LineSegment' (Point2 r
px r
py :+ p
_) (Point2 r
qx r
qy :+ p
_))
    | r
px r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
qx  = r
py r -> r -> r
forall a. Ord a => a -> a -> a
`max` r
qy -- s is vertical, since by the precondition it
                              -- intersects we return the y-coord of the topmost
                              -- endpoint.
    | Bool
otherwise = r
py r -> r -> r
forall a. Num a => a -> a -> a
+ r
alpha r -> r -> r
forall a. Num a => a -> a -> a
* (r
qy r -> r -> r
forall a. Num a => a -> a -> a
- r
py)
  where
    alpha :: r
alpha = (r
x r -> r -> r
forall a. Num a => a -> a -> a
- r
px) r -> r -> r
forall a. Fractional a => a -> a -> a
/ (r
qx r -> r -> r
forall a. Num a => a -> a -> a
- r
px)