{-# 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
  , flipSegment

  , interpolate
  , validSegment
  , sampleLineSegment
  ) 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
import           Data.Geometry.Vector
import           Data.Ord (comparing)
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)

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



-- ** Converting between Lines and LineSegments

-- | Directly convert a line into a 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) (Line 2 r) = [ NoIntersection
                                                              , Point 2 r
                                                              , LineSegment 2 p r
                                                              ]


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
  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
  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. IsIntersectableWith 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 `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
  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
  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. IsIntersectableWith 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



instance (Ord r, Fractional r) =>
         LineSegment 2 p r `IsIntersectableWith` LineSegment 2 p r where
  nonEmptyIntersection :: proxy (LineSegment 2 p r)
-> proxy (LineSegment 2 p r)
-> Intersection (LineSegment 2 p r) (LineSegment 2 p r)
-> Bool
nonEmptyIntersection = proxy (LineSegment 2 p r)
-> proxy (LineSegment 2 p r)
-> Intersection (LineSegment 2 p 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

  LineSegment 2 p r
a intersect :: LineSegment 2 p r
-> LineSegment 2 p r
-> Intersection (LineSegment 2 p r) (LineSegment 2 p r)
`intersect` LineSegment 2 p r
b = CoRec Identity '[NoIntersection, Point 2 r, SubLine 2 p r r]
-> Handlers
     '[NoIntersection, Point 2 r, SubLine 2 p 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 ((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 p r r
-> Intersection (SubLine 2 p r r) (SubLine 2 p r r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` (LineSegment 2 p r
bLineSegment 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)) (Handlers
   '[NoIntersection, Point 2 r, SubLine 2 p 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 p 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 p r r]
-> Handlers
     '[NoIntersection, Point 2 r, SubLine 2 p 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 p r r]
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r]))
     '[Point 2 r, SubLine 2 p r r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (SubLine 2 p 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 p r r)
forall b a. (a -> b) -> Handler b a
H (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
 -> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r])
-> (SubLine 2 p r r -> LineSegment 2 p r)
-> SubLine 2 p r r
-> CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubLine 2 p r r -> LineSegment 2 p 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 p r])
  (SubLine 2 p 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 p 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

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 () (UnBounded r) r]
-> Handlers
     '[NoIntersection, Point 2 r, SubLine 2 () (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 () (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 () (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 () (UnBounded r) r]
-> Handlers
     '[NoIntersection, Point 2 r, SubLine 2 () (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 () (UnBounded r) r]
-> Rec
     (Handler
        (CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r]))
     '[Point 2 r, SubLine 2 () (UnBounded r) r]
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& (SubLine 2 () (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 () (UnBounded r) r)
forall b a. (a -> b) -> Handler b a
H (CoRec Identity '[NoIntersection, Point 2 r, LineSegment 2 p r]
-> SubLine 2 () (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 () (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 () (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)

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.
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).
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
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

-- | 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