{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.LineSegment.Class
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- A class representing line segments
--
--------------------------------------------------------------------------------
module HGeometry.LineSegment.Class
  ( LineSegment_
  , pattern LineSegment_
  , ConstructableLineSegment_(..)
  , ClosedLineSegment_
  , OpenLineSegment_

  , interpolate
  , HasOnSegment(..)

  , HasStart(..), HasEnd(..)
  , HasStartPoint(..), HasEndPoint(..)
  , StartPointOf, EndPointOf

  , ordAtY, ordAtX
  , xCoordAt, yCoordAt

  , orientLR, orientBT
  ) where

import Control.Lens
import Data.Default
import Data.Type.Ord
import HGeometry.Ext
import HGeometry.ByIndex
import HGeometry.Interval.Class
import HGeometry.Point.Class
import HGeometry.Properties
import HGeometry.Vector

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

-- $setup
-- >>> import HGeometry.LineSegment
-- >>> import HGeometry.Point

-- not sure why I made this a separate class again...

-- | Class that expresses that we can test if the segment contains a point
class HasOnSegment lineSegment d | lineSegment -> d where
  -- | Test if a point lies on a line segment.
  --
  -- As a user, you should typically just use 'intersects' instead.
  onSegment :: ( Ord r, Point_ point d r
               , r ~ NumType lineSegment, d ~ Dimension lineSegment
               ) => point -> lineSegment -> Bool

-- | A class representing line segments
class ( IntervalLike_ lineSegment point
      , Point_ point (Dimension lineSegment) (NumType lineSegment)
      ) => LineSegment_ lineSegment point | lineSegment -> point where
  {-# MINIMAL  #-}

-- | A class representing line segments
class ( LineSegment_ lineSegment point
      ) => ConstructableLineSegment_ lineSegment point where
  {-# MINIMAL uncheckedLineSegment #-}

  -- | Create a segment
  --
  -- pre: the points are disjoint
  uncheckedLineSegment     :: point -> point -> lineSegment
  -- uncheckedLineSegment s t = mkInterval (mkEndPoint s) (mkEndPoint t)

  -- | smart constructor that creates a valid segment, i.e. it
  -- validates that the endpoints are disjoint.
  mkLineSegment              :: Eq (Vector (Dimension point) (NumType point))
                             => point -> point -> Maybe lineSegment
  mkLineSegment point
s point
t
    | point
spoint
-> Getting
     (Vector (Dimension point) (NumType point))
     point
     (Vector (Dimension point) (NumType point))
-> Vector (Dimension point) (NumType point)
forall s a. s -> Getting a s a -> a
^.Getting
  (Vector (Dimension point) (NumType point))
  point
  (Vector (Dimension point) (NumType point))
forall (d :: Nat) r s.
(Dimension point ~ d, NumType point ~ r, Dimension point ~ d,
 NumType point ~ s) =>
Lens point point (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens
  point
  point
  (Vector (Dimension point) (NumType point))
  (Vector (Dimension point) (NumType point))
vector Vector (Dimension point) (NumType point)
-> Vector (Dimension point) (NumType point) -> Bool
forall a. Eq a => a -> a -> Bool
/= point
tpoint
-> Getting
     (Vector (Dimension point) (NumType point))
     point
     (Vector (Dimension point) (NumType point))
-> Vector (Dimension point) (NumType point)
forall s a. s -> Getting a s a -> a
^.Getting
  (Vector (Dimension point) (NumType point))
  point
  (Vector (Dimension point) (NumType point))
forall (d :: Nat) r s.
(Dimension point ~ d, NumType point ~ r, Dimension point ~ d,
 NumType point ~ s) =>
Lens point point (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens
  point
  point
  (Vector (Dimension point) (NumType point))
  (Vector (Dimension point) (NumType point))
vector = lineSegment -> Maybe lineSegment
forall a. a -> Maybe a
Just (lineSegment -> Maybe lineSegment)
-> lineSegment -> Maybe lineSegment
forall a b. (a -> b) -> a -> b
$ point -> point -> lineSegment
forall lineSegment point.
ConstructableLineSegment_ lineSegment point =>
point -> point -> lineSegment
uncheckedLineSegment point
s point
t
    | Bool
otherwise              = Maybe lineSegment
forall a. Maybe a
Nothing




-- | A class representing Closed Linesegments
class ( LineSegment_ lineSegment point
      , StartPointOf lineSegment ~ EndPoint Closed point
      , EndPointOf   lineSegment ~ EndPoint Closed point
      ) => ClosedLineSegment_ lineSegment point where

-- | A Class representing Open ended linesegments
class ( LineSegment_ lineSegment point
      , StartPointOf lineSegment ~ EndPoint Open point
      , EndPointOf   lineSegment ~ EndPoint Open point
      ) => OpenLineSegment_ lineSegment point where


-- | Deconstructs a line segment from the start and end point
pattern LineSegment_     :: forall lineSegment point. LineSegment_ lineSegment point
                         => point -> point -> lineSegment
pattern $mLineSegment_ :: forall {r} {lineSegment} {point}.
LineSegment_ lineSegment point =>
lineSegment -> (point -> point -> r) -> ((# #) -> r) -> r
LineSegment_ s t <- (startAndEnd -> (s,t))
{-# COMPLETE LineSegment_ #-}

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

-- | Linearly interpolate the two endpoints with a value in the range [0,1]
--
-- >>> interpolate 0.5 $ ClosedLineSegment origin (Point2 10.0 10.0)
-- Point2 5.0 5.0
-- >>> interpolate 0.1 $ ClosedLineSegment origin (Point2 10.0 10.0)
-- Point2 1.0 1.0
-- >>> interpolate 0 $ ClosedLineSegment origin (Point2 10.0 10.0)
-- Point2 0.0 0.0
-- >>> interpolate 1 $ ClosedLineSegment origin (Point2 10.0 10.0)
-- Point2 10.0 10.0
interpolate       :: forall lineSegment d point r
                     . ( Fractional r, LineSegment_ lineSegment point
                       , ConstructablePoint_ point d r
                       )
                  => r -> lineSegment -> point
interpolate :: forall lineSegment (d :: Nat) point r.
(Fractional r, LineSegment_ lineSegment point,
 ConstructablePoint_ point d r) =>
r -> lineSegment -> point
interpolate r
lam (LineSegment_ point
s point
t) =
  Vector (Dimension point) (NumType point) -> point
forall point (d :: Nat) r.
ConstructablePoint_ point d r =>
Vector d r -> point
fromVector (Vector (Dimension point) (NumType point) -> point)
-> Vector (Dimension point) (NumType point) -> point
forall a b. (a -> b) -> a -> b
$ (point
spoint
-> Getting
     (Vector (Dimension point) (NumType point))
     point
     (Vector (Dimension point) (NumType point))
-> Vector (Dimension point) (NumType point)
forall s a. s -> Getting a s a -> a
^.Getting
  (Vector (Dimension point) (NumType point))
  point
  (Vector (Dimension point) (NumType point))
forall (d :: Nat) r s.
(Dimension point ~ d, NumType point ~ r, Dimension point ~ d,
 NumType point ~ s) =>
Lens point point (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens
  point
  point
  (Vector (Dimension point) (NumType point))
  (Vector (Dimension point) (NumType point))
vector Vector (Dimension point) (NumType point)
-> r -> Vector (Dimension point) (NumType point)
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
vector -> r -> vector
^* (r
1r -> r -> r
forall a. Num a => a -> a -> a
-r
lam)) Vector (Dimension point) (NumType point)
-> Vector (Dimension point) (NumType point)
-> Vector (Dimension point) (NumType point)
forall r vector (d :: Nat).
(Num r, Additive_ vector d r) =>
vector -> vector -> vector
^+^ (point
tpoint
-> Getting
     (Vector (Dimension point) (NumType point))
     point
     (Vector (Dimension point) (NumType point))
-> Vector (Dimension point) (NumType point)
forall s a. s -> Getting a s a -> a
^.Getting
  (Vector (Dimension point) (NumType point))
  point
  (Vector (Dimension point) (NumType point))
forall (d :: Nat) r s.
(Dimension point ~ d, NumType point ~ r, Dimension point ~ d,
 NumType point ~ s) =>
Lens point point (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens
  point
  point
  (Vector (Dimension point) (NumType point))
  (Vector (Dimension point) (NumType point))
vector Vector (Dimension point) (NumType point)
-> r -> Vector (Dimension point) (NumType point)
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
vector -> r -> vector
^* r
lam)


--------------------------------------------------------------------------------
-- * Convenience functions for working with 2-dimensional line segments

-- | Given a y-coordinate, compare the segments based on the
-- x-coordinate of the intersection with the horizontal line through y
ordAtY   :: (Num r, Ord r, LineSegment_ lineSegment point, Point_ point 2 r)
         => r
         -> lineSegment -> lineSegment -> Ordering
ordAtY :: forall r lineSegment point.
(Num r, Ord r, LineSegment_ lineSegment point, Point_ point 2 r) =>
r -> lineSegment -> lineSegment -> Ordering
ordAtY r
y lineSegment
seg1 lineSegment
seg2 = r -> lineSegment -> lineSegment -> Ordering
forall r lineSegment point.
(Num r, Ord r, LineSegment_ lineSegment point, Point_ point 2 r) =>
r -> lineSegment -> lineSegment -> Ordering
ordAtX (-r
y) (lineSegment -> lineSegment
forall {p} {p} {b}.
(Dimension p ~ 2, Dimension p ~ 2, HasStart b p, HasEnd b p,
 HasVector p p, HasVector p p, Num (NumType p), Num (NumType p)) =>
b -> b
flipPlane lineSegment
seg1) (lineSegment -> lineSegment
forall {p} {p} {b}.
(Dimension p ~ 2, Dimension p ~ 2, HasStart b p, HasEnd b p,
 HasVector p p, HasVector p p, Num (NumType p), Num (NumType p)) =>
b -> b
flipPlane lineSegment
seg2)
  where
    rot90 :: Vector 2 r -> Vector 2 r
rot90 (Vector2 r
x' r
y') = r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
Vector2 (-r
y') r
x'
    flipPlane :: b -> b
flipPlane b
seg = b
segb -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
&(p -> Identity p) -> b -> Identity b
forall seg p. HasStart seg p => Lens' seg p
Lens' b p
start((p -> Identity p) -> b -> Identity b)
-> ((Vector 2 (NumType p) -> Identity (Vector 2 (NumType p)))
    -> p -> Identity p)
-> (Vector 2 (NumType p) -> Identity (Vector 2 (NumType p)))
-> b
-> Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vector 2 (NumType p) -> Identity (Vector 2 (NumType p)))
-> p -> Identity p
forall (d :: Nat) r s.
(Dimension p ~ d, NumType p ~ r, Dimension p ~ d, NumType p ~ s) =>
Lens p p (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens p p (Vector 2 (NumType p)) (Vector 2 (NumType p))
vector ((Vector 2 (NumType p) -> Identity (Vector 2 (NumType p)))
 -> b -> Identity b)
-> (Vector 2 (NumType p) -> Vector 2 (NumType p)) -> b -> b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Vector 2 (NumType p) -> Vector 2 (NumType p)
forall {r}. Num r => Vector 2 r -> Vector 2 r
rot90
                       b -> (b -> b) -> b
forall a b. a -> (a -> b) -> b
&(p -> Identity p) -> b -> Identity b
forall seg p. HasEnd seg p => Lens' seg p
Lens' b p
end((p -> Identity p) -> b -> Identity b)
-> ((Vector 2 (NumType p) -> Identity (Vector 2 (NumType p)))
    -> p -> Identity p)
-> (Vector 2 (NumType p) -> Identity (Vector 2 (NumType p)))
-> b
-> Identity b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vector 2 (NumType p) -> Identity (Vector 2 (NumType p)))
-> p -> Identity p
forall (d :: Nat) r s.
(Dimension p ~ d, NumType p ~ r, Dimension p ~ d, NumType p ~ s) =>
Lens p p (Vector d r) (Vector d s)
forall point point' (d :: Nat) r s.
(HasVector point point', Dimension point ~ d, NumType point ~ r,
 Dimension point' ~ d, NumType point' ~ s) =>
Lens point point' (Vector d r) (Vector d s)
Lens p p (Vector 2 (NumType p)) (Vector 2 (NumType p))
vector   ((Vector 2 (NumType p) -> Identity (Vector 2 (NumType p)))
 -> b -> Identity b)
-> (Vector 2 (NumType p) -> Vector 2 (NumType p)) -> b -> b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Vector 2 (NumType p) -> Vector 2 (NumType p)
forall {r}. Num r => Vector 2 r -> Vector 2 r
rot90

-- | 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, LineSegment_ lineSegment point, Point_ point 2 r)
         => r -> lineSegment -> r
xCoordAt :: forall r lineSegment point.
(Fractional r, Ord r, LineSegment_ lineSegment point,
 Point_ point 2 r) =>
r -> lineSegment -> r
xCoordAt r
y (LineSegment_ (Point2_ r
px r
py) (Point2_ r
qx r
qy))
      | 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, compare the segments based on the
-- y-coordinate of the intersection with the horizontal line through y
ordAtX   :: ( Num r, Ord r, LineSegment_ lineSegment point, Point_ point 2 r)
         => r
         -> lineSegment -> lineSegment -> Ordering
ordAtX :: forall r lineSegment point.
(Num r, Ord r, LineSegment_ lineSegment point, Point_ point 2 r) =>
r -> lineSegment -> lineSegment -> Ordering
ordAtX r
x (lineSegment -> lineSegment
forall lineSegment point (d :: Nat) r.
(LineSegment_ lineSegment point, Point_ point d r, 1 <= d,
 Ord r) =>
lineSegment -> lineSegment
orientLR -> LineSegment_ (Point2_ r
px r
py) (Point2_ r
qx r
qy))
         (lineSegment -> lineSegment
forall lineSegment point (d :: Nat) r.
(LineSegment_ lineSegment point, Point_ point d r, 1 <= d,
 Ord r) =>
lineSegment -> lineSegment
orientLR -> LineSegment_ (Point2_ r
ax r
ay) (Point2_ r
bx r
by)) =
    case (Bool
pqVertical,Bool
abVertical) of
      (Bool
True,Bool
True)   -> r
pqTop           r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` r
abTop
      (Bool
True,Bool
False)  -> (r
pqTopr -> r -> r
forall a. Num a => a -> a -> a
*(r
bxr -> r -> r
forall a. Num a => a -> a -> a
-r
ax)) r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` r
abTerm
      (Bool
False,Bool
True)  -> r
pqTerm          r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` (r
abTopr -> r -> r
forall a. Num a => a -> a -> a
*(r
qxr -> r -> r
forall a. Num a => a -> a -> a
-r
px))
      (Bool
False,Bool
False) -> r
term1           r -> r -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` r
term2
  where
    -- For ease of argument we orient the segment from left to right.
    --
    -- The main idea is to essentially take te yCoordAt implementation, and multiply out te
    -- divisor in te alpha term. More specifically:
    --
    -- for segment pq, the intersection y-coordinate is:
    --
    -- y = py + ( (x-px) / (qx-px) )*(qy-py)
    --
    -- similarly for the ab segment we have y' = ay + ( (x-ax) / (bx-ax) )*(by-ay)
    --
    -- and we wish to : y `compare` y'
    -- hence we multiply both sides by (bx-ax)*(qx-px) to get rid of the factions.
    --
    pqVertical :: Bool
pqVertical = r
px r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
qx
    abVertical :: Bool
abVertical = r
ax r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
bx
    pqTop :: r
pqTop = r
py r -> r -> r
forall a. Ord a => a -> a -> a
`max` r
qy
    abTop :: r
abTop = r
ay r -> r -> r
forall a. Ord a => a -> a -> a
`max` r
by

    -- the py + alpha*(qy-py) term multiplied by (qx-px) so that there are no
    -- more fractions
    pqTerm :: r
pqTerm = r
pyr -> r -> r
forall a. Num a => a -> a -> a
*(r
qxr -> r -> r
forall a. Num a => a -> a -> a
-r
px) r -> r -> r
forall a. Num a => a -> a -> a
+ (r
xr -> r -> r
forall a. Num a => a -> a -> a
-r
px)r -> r -> r
forall a. Num a => a -> a -> a
*(r
qyr -> r -> r
forall a. Num a => a -> a -> a
-r
py)
    abTerm :: r
abTerm = r
ayr -> r -> r
forall a. Num a => a -> a -> a
*(r
bxr -> r -> r
forall a. Num a => a -> a -> a
-r
ax) r -> r -> r
forall a. Num a => a -> a -> a
+ (r
xr -> r -> r
forall a. Num a => a -> a -> a
-r
ax)r -> r -> r
forall a. Num a => a -> a -> a
*(r
byr -> r -> r
forall a. Num a => a -> a -> a
-r
ay) --

    term1 :: r
term1 = (r
bxr -> r -> r
forall a. Num a => a -> a -> a
-r
ax) r -> r -> r
forall a. Num a => a -> a -> a
* r
pqTerm
    term2 :: r
term2 = (r
qxr -> r -> r
forall a. Num a => a -> a -> a
-r
px) r -> r -> r
forall a. Num a => a -> a -> a
* r
abTerm

-- | Orient the segment from left to right
orientLR     :: (LineSegment_ lineSegment point, Point_ point d r, 1 <= d, Ord r)
             => lineSegment -> lineSegment
orientLR :: forall lineSegment point (d :: Nat) r.
(LineSegment_ lineSegment point, Point_ point d r, 1 <= d,
 Ord r) =>
lineSegment -> lineSegment
orientLR lineSegment
seg
  | lineSegment
seglineSegment -> Getting r lineSegment r -> r
forall s a. s -> Getting a s a -> a
^.(point -> Const r point) -> lineSegment -> Const r lineSegment
forall seg p. HasStart seg p => Lens' seg p
Lens' lineSegment point
start((point -> Const r point) -> lineSegment -> Const r lineSegment)
-> ((r -> Const r r) -> point -> Const r point)
-> Getting r lineSegment r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> point -> Const r point
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<= lineSegment
seglineSegment -> Getting r lineSegment r -> r
forall s a. s -> Getting a s a -> a
^.(point -> Const r point) -> lineSegment -> Const r lineSegment
forall seg p. HasEnd seg p => Lens' seg p
Lens' lineSegment point
end((point -> Const r point) -> lineSegment -> Const r lineSegment)
-> ((r -> Const r r) -> point -> Const r point)
-> Getting r lineSegment r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> point -> Const r point
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
xCoord = lineSegment
seg
  | Bool
otherwise                            = lineSegment
seglineSegment -> (lineSegment -> lineSegment) -> lineSegment
forall a b. a -> (a -> b) -> b
&(point -> Identity point) -> lineSegment -> Identity lineSegment
forall seg p. HasStart seg p => Lens' seg p
Lens' lineSegment point
start ((point -> Identity point) -> lineSegment -> Identity lineSegment)
-> point -> lineSegment -> lineSegment
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (lineSegment
seglineSegment -> Getting point lineSegment point -> point
forall s a. s -> Getting a s a -> a
^.Getting point lineSegment point
forall seg p. HasEnd seg p => Lens' seg p
Lens' lineSegment point
end)
                                              lineSegment -> (lineSegment -> lineSegment) -> lineSegment
forall a b. a -> (a -> b) -> b
&(point -> Identity point) -> lineSegment -> Identity lineSegment
forall seg p. HasEnd seg p => Lens' seg p
Lens' lineSegment point
end   ((point -> Identity point) -> lineSegment -> Identity lineSegment)
-> point -> lineSegment -> lineSegment
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (lineSegment
seglineSegment -> Getting point lineSegment point -> point
forall s a. s -> Getting a s a -> a
^.Getting point lineSegment point
forall seg p. HasStart seg p => Lens' seg p
Lens' lineSegment point
start)


-- | Orient the segment from bottom to top
orientBT     :: (LineSegment_ lineSegment point, Point_ point d r, 2 <= d, Ord r)
             => lineSegment -> lineSegment
orientBT :: forall lineSegment point (d :: Nat) r.
(LineSegment_ lineSegment point, Point_ point d r, 2 <= d,
 Ord r) =>
lineSegment -> lineSegment
orientBT lineSegment
seg
  | lineSegment
seglineSegment -> Getting r lineSegment r -> r
forall s a. s -> Getting a s a -> a
^.(point -> Const r point) -> lineSegment -> Const r lineSegment
forall seg p. HasStart seg p => Lens' seg p
Lens' lineSegment point
start((point -> Const r point) -> lineSegment -> Const r lineSegment)
-> ((r -> Const r r) -> point -> Const r point)
-> Getting r lineSegment r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> point -> Const r point
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord r -> r -> Bool
forall a. Ord a => a -> a -> Bool
<= lineSegment
seglineSegment -> Getting r lineSegment r -> r
forall s a. s -> Getting a s a -> a
^.(point -> Const r point) -> lineSegment -> Const r lineSegment
forall seg p. HasEnd seg p => Lens' seg p
Lens' lineSegment point
end((point -> Const r point) -> lineSegment -> Const r lineSegment)
-> ((r -> Const r r) -> point -> Const r point)
-> Getting r lineSegment r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> point -> Const r point
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int point r
yCoord = lineSegment
seg
  | Bool
otherwise                            = lineSegment
seglineSegment -> (lineSegment -> lineSegment) -> lineSegment
forall a b. a -> (a -> b) -> b
&(point -> Identity point) -> lineSegment -> Identity lineSegment
forall seg p. HasStart seg p => Lens' seg p
Lens' lineSegment point
start ((point -> Identity point) -> lineSegment -> Identity lineSegment)
-> point -> lineSegment -> lineSegment
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (lineSegment
seglineSegment -> Getting point lineSegment point -> point
forall s a. s -> Getting a s a -> a
^.Getting point lineSegment point
forall seg p. HasEnd seg p => Lens' seg p
Lens' lineSegment point
end)
                                              lineSegment -> (lineSegment -> lineSegment) -> lineSegment
forall a b. a -> (a -> b) -> b
&(point -> Identity point) -> lineSegment -> Identity lineSegment
forall seg p. HasEnd seg p => Lens' seg p
Lens' lineSegment point
end   ((point -> Identity point) -> lineSegment -> Identity lineSegment)
-> point -> lineSegment -> lineSegment
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (lineSegment
seglineSegment -> Getting point lineSegment point -> point
forall s a. s -> Getting a s a -> a
^.Getting point lineSegment point
forall seg p. HasStart seg p => Lens' seg p
Lens' lineSegment point
start)



-- | 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, LineSegment_ lineSegment point, Point_ point 2 r)
         => r -> lineSegment -> r
yCoordAt :: forall r lineSegment point.
(Fractional r, Ord r, LineSegment_ lineSegment point,
 Point_ point 2 r) =>
r -> lineSegment -> r
yCoordAt r
x (LineSegment_ (Point2_ r
px r
py) (Point2_ r
qx r
qy))
    | 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)


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

instance ( LineSegment_ segment point
         ) => LineSegment_ (segment :+ extra) point where

instance ( ConstructableLineSegment_ segment point
         , Default extra
         ) => ConstructableLineSegment_ (segment :+ extra) point where
  uncheckedLineSegment :: point -> point -> segment :+ extra
uncheckedLineSegment point
p point
q = point -> point -> segment
forall lineSegment point.
ConstructableLineSegment_ lineSegment point =>
point -> point -> lineSegment
uncheckedLineSegment point
p point
q segment -> extra -> segment :+ extra
forall core extra. core -> extra -> core :+ extra
:+ extra
forall a. Default a => a
def

instance ( ClosedLineSegment_ segment point
         ) => ClosedLineSegment_ (segment :+ extra) point where

instance ( OpenLineSegment_ segment point
         ) => OpenLineSegment_ (segment :+ extra) point where

instance HasOnSegment lineSegment d =>  HasOnSegment (lineSegment :+ extra) d where
  onSegment :: forall r point.
(Ord r, Point_ point d r, r ~ NumType (lineSegment :+ extra),
 d ~ Dimension (lineSegment :+ extra)) =>
point -> (lineSegment :+ extra) -> Bool
onSegment point
q (lineSegment
s :+ extra
_) = point
q point -> lineSegment -> Bool
forall lineSegment (d :: Nat) r point.
(HasOnSegment lineSegment d, Ord r, Point_ point d r,
 r ~ NumType lineSegment, d ~ Dimension lineSegment) =>
point -> lineSegment -> Bool
forall r point.
(Ord r, Point_ point d r, r ~ NumType lineSegment,
 d ~ Dimension lineSegment) =>
point -> lineSegment -> Bool
`onSegment` lineSegment
s

instance LineSegment_ lineSegment point => LineSegment_ (ByIndex ix lineSegment) point

instance HasOnSegment lineSegment d => HasOnSegment (ByIndex ix lineSegment) d where
  onSegment :: forall r point.
(Ord r, Point_ point d r, r ~ NumType (ByIndex ix lineSegment),
 d ~ Dimension (ByIndex ix lineSegment)) =>
point -> ByIndex ix lineSegment -> Bool
onSegment point
q = point -> lineSegment -> Bool
forall lineSegment (d :: Nat) r point.
(HasOnSegment lineSegment d, Ord r, Point_ point d r,
 r ~ NumType lineSegment, d ~ Dimension lineSegment) =>
point -> lineSegment -> Bool
forall r point.
(Ord r, Point_ point (Dimension lineSegment) r,
 r ~ NumType lineSegment,
 Dimension lineSegment ~ Dimension lineSegment) =>
point -> lineSegment -> Bool
onSegment point
q (lineSegment -> Bool)
-> (ByIndex ix lineSegment -> lineSegment)
-> ByIndex ix lineSegment
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting lineSegment (ByIndex ix lineSegment) lineSegment
-> ByIndex ix lineSegment -> lineSegment
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting lineSegment (ByIndex ix lineSegment) lineSegment
forall ix a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> ByIndex ix a1 -> f (ByIndex ix a2)
theValue