{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Line.PointAndLine
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- \(d\)-dimensional lines.
--
--------------------------------------------------------------------------------
module HGeometry.Line.PointAndVector
  ( LinePV(..)
  , anchorPoint
  , HasDirection(..)
  , isIdenticalTo
  , HasSupportingLine(..)
  , fromLinearFunction
  , fromLineEQ
  , toLinearFunction


  , SideTestUpDown(..), OnSideUpDownTest(..)
  , liesAbove, liesBelow
  , SideTest(..), onSide
  , leftHalfPlane, rightHalfPlane


  , bisector
  , perpendicularTo, isPerpendicularTo

  , cmpSlope
  ) where

import Control.DeepSeq
import Control.Lens
import GHC.Generics (Generic)
import GHC.TypeLits
import HGeometry.Ext
import HGeometry.Sign
import HGeometry.HyperPlane.Class
import HGeometry.Intersection
import HGeometry.Line.Class
import HGeometry.Line.Intersection
import HGeometry.Line.LineEQ
import HGeometry.Line.General
import HGeometry.Point
import HGeometry.HalfSpace.Type
import HGeometry.Properties (NumType, Dimension)
import HGeometry.Vector
import Text.Read

--------------------------------------------------------------------------------
-- * d-dimensional Lines

-- | A line is given by an anchor point and a vector indicating the
-- direction.
data LinePV d r = LinePV { forall (d :: Nat) r. LinePV d r -> Point d r
_anchorPoint :: !(Point  d r)
                         , forall (d :: Nat) r. LinePV d r -> Vector d r
_direction   :: !(Vector d r)
                         } deriving (forall x. LinePV d r -> Rep (LinePV d r) x)
-> (forall x. Rep (LinePV d r) x -> LinePV d r)
-> Generic (LinePV d r)
forall (d :: Nat) r x. Rep (LinePV d r) x -> LinePV d r
forall (d :: Nat) r x. LinePV d r -> Rep (LinePV d r) x
forall x. Rep (LinePV d r) x -> LinePV d r
forall x. LinePV d r -> Rep (LinePV d r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall (d :: Nat) r x. LinePV d r -> Rep (LinePV d r) x
from :: forall x. LinePV d r -> Rep (LinePV d r) x
$cto :: forall (d :: Nat) r x. Rep (LinePV d r) x -> LinePV d r
to :: forall x. Rep (LinePV d r) x -> LinePV d r
Generic

type instance Dimension (LinePV d r) = d
type instance NumType   (LinePV d r) = r

-- | Types that have a Direction field
class HasDirection t where
  -- | Lens to access the direction field
  direction :: (Dimension t ~ d, NumType t ~ r) => Lens' t (Vector d r)

instance HasDirection (LinePV d r) where
  direction :: forall (d :: Nat) r.
(Dimension (LinePV d r) ~ d, NumType (LinePV d r) ~ r) =>
Lens' (LinePV d r) (Vector d r)
direction = (LinePV d r -> Vector d r)
-> (LinePV d r -> Vector d r -> LinePV d r)
-> Lens (LinePV d r) (LinePV d r) (Vector d r) (Vector d r)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens LinePV d r -> Vector d r
LinePV d r -> Vector d r
forall (d :: Nat) r. LinePV d r -> Vector d r
_direction (\LinePV d r
p Vector d r
v -> LinePV d r
p {_direction = v})
  {-# INLINE direction #-}

-- | Lens to access the anchor point of the line
anchorPoint :: Lens' (LinePV d r) (Point d r)
anchorPoint :: forall (d :: Nat) r (f :: * -> *).
Functor f =>
(Point d r -> f (Point d r)) -> LinePV d r -> f (LinePV d r)
anchorPoint = (LinePV d r -> Point d r)
-> (LinePV d r -> Point d r -> LinePV d r)
-> Lens (LinePV d r) (LinePV d r) (Point d r) (Point d r)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens LinePV d r -> Point d r
forall (d :: Nat) r. LinePV d r -> Point d r
_anchorPoint (\LinePV d r
l Point d r
p -> LinePV d r
l { _anchorPoint = p })


instance ( Has_ Metric_ d r ) => Line_ (LinePV d r) d r where
  fromPointAndVec :: forall point.
(Point_ point d r, Line_ (LinePV d r) d r, Num r) =>
point -> Vector d r -> LinePV d r
fromPointAndVec point
p Vector d r
v = Point d r -> Vector d r -> LinePV d r
forall (d :: Nat) r. Point d r -> Vector d r -> LinePV d r
LinePV (point
ppoint -> Getting (Point d r) point (Point d r) -> Point d r
forall s a. s -> Getting a s a -> a
^.Getting (Point d r) point (Point d r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point d r)
asPoint) (Vector d r
vVector d r
-> Getting (Vector d r) (Vector d r) (Vector d r) -> Vector d r
forall s a. s -> Getting a s a -> a
^.Getting (Vector d r) (Vector d r) (Vector d r)
forall vector vector' (d :: Nat) r s.
AsVector_ vector vector' d r s =>
Iso vector vector' (Vector d r) (Vector d s)
Iso (Vector d r) (Vector d r) (Vector d r) (Vector d r)
_Vector)


instance ( Eq r, Num r
         ) => ConstructableHyperPlane_ (LinePV 2 r) 2 r where

  type HyperPlaneFromEquationConstraint (LinePV 2 r) 2 r = Fractional r

  -- equation: line equation is: c + ax + by = 0
  -- pre: not all of a b and c are zero
  hyperPlaneFromEquation :: HyperPlaneFromEquationConstraint (LinePV 2 r) 2 r =>
Vector (2 + 1) r -> LinePV 2 r
hyperPlaneFromEquation (Vector3 r
c r
a r
b)
    | r
b r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
0    = Point 2 r -> Vector 2 r -> LinePV 2 r
forall (d :: Nat) r. Point d r -> Vector d r -> LinePV d r
LinePV (r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 (- (r
c r -> r -> r
forall a. Fractional a => a -> a -> a
/ r
a)) r
0)      (r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
Vector2 r
0 r
1) -- if b=0 we are vertical
    | Bool
otherwise = Point 2 r -> Vector 2 r -> LinePV 2 r
forall (d :: Nat) r. Point d r -> Vector d r -> LinePV d r
LinePV (r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 r
0      (- (r
c r -> r -> r
forall a. Fractional a => a -> a -> a
/ r
b))) (r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
Vector2 r
c (-r
a))

  fromPointAndNormal :: forall point.
(Point_ point 2 r, Num r) =>
point -> Vector 2 r -> LinePV 2 r
fromPointAndNormal point
p (Vector2 r
vx r
vy) = Point 2 r -> Vector 2 r -> LinePV 2 r
forall (d :: Nat) r. Point d r -> Vector d r -> LinePV d r
LinePV (point
ppoint -> Getting (Point 2 r) point (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) point (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint) (r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
Vector2 (-r
vy) r
vx)


instance Num r => HyperPlaneFromPoints (LinePV 2 r) where
  hyperPlaneThrough :: forall point (d :: Nat) r.
(Point_ point d r, HyperPlane_ (LinePV 2 r) d r, Num r) =>
Vector d point -> LinePV 2 r
hyperPlaneThrough (Vector2 point
p point
q) = Point 2 r -> Vector 2 r -> LinePV 2 r
forall (d :: Nat) r. Point d r -> Vector d r -> LinePV d r
LinePV (point
ppoint -> Getting (Point 2 r) point (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) point (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint) (point
q point -> point -> Vector 2 r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> point -> Vector d r
.-. point
p)


instance ( Eq r, Num r
         ) => HyperPlane_ (LinePV 2 r) 2 r where
  hyperPlaneEquation :: Num r => LinePV 2 r -> Vector (2 + 1) r
hyperPlaneEquation (LinePV (Point2 r
px r
py) (Vector2 r
vx r
vy))
    | r
vx r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
0   = r -> r -> r -> Vector 3 r
forall r. r -> r -> r -> Vector 3 r
Vector3 (-r
px)         r
1  r
0 -- vertical line at px
    | Bool
otherwise = r -> r -> r -> Vector 3 r
forall r. r -> r -> r -> Vector 3 r
Vector3 (r
vxr -> r -> r
forall a. Num a => a -> a -> a
*r
pyr -> r -> r
forall a. Num a => a -> a -> a
-r
vyr -> r -> r
forall a. Num a => a -> a -> a
*r
px) r
vy (-r
vx)
    -- we have some non-vertical line: y = a1*x + a0 that goes through p
    -- so we have: a0 + a1*px + a2*py = 0
    -- our slope a1 = vy/vx, and our intercept a0 = py-(vy/vx)px, and a2 = (-1)
    -- multiplying everything by vx gets rid of the fraction, and yields the above equation.

instance HasPickInteriorPoint (LinePV d r) d r where
  pointInteriorTo :: LinePV d r -> Point d r
pointInteriorTo (LinePV Point d r
p Vector d r
_) = Point d r
p

{- HLINT ignore toLinearFunction -}
-- | get values a,b s.t. the input line is described by y = ax + b.
-- returns Nothing if the line is vertical
toLinearFunction                               :: forall r.
                                                  ( Fractional r, Ord r
                                                  )
                                               => LinePV 2 r -> VerticalOrLineEQ r
toLinearFunction :: forall r. (Fractional r, Ord r) => LinePV 2 r -> VerticalOrLineEQ r
toLinearFunction l :: LinePV 2 r
l@(LinePV Point 2 r
p ~(Vector2 r
vx r
vy)) =
  case LinePV 2 r
l LinePV 2 r -> LinePV 2 r -> Intersection (LinePV 2 r) (LinePV 2 r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` forall r line. (Line_ line 2 r, Num r) => r -> line
verticalLine @r @(LinePV 2 r) r
0 of
    Maybe (LineLineIntersectionG r (LinePV 2 r))
Intersection (LinePV 2 r) (LinePV 2 r)
Nothing                               -> r -> VerticalOrLineEQ r
forall r. r -> VerticalOrLineEQ r
VerticalLineThrough (Point 2 r
pPoint 2 r -> Getting r (Point 2 r) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Point 2 r) r
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int (Point 2 r) r
xCoord)
    Just (Line_x_Line_Point (Point2 r
_ r
b)) -> LineEQ r -> VerticalOrLineEQ r
forall r. LineEQ r -> VerticalOrLineEQ r
NonVertical (LineEQ r -> VerticalOrLineEQ r) -> LineEQ r -> VerticalOrLineEQ r
forall a b. (a -> b) -> a -> b
$ r -> r -> LineEQ r
forall r. r -> r -> LineEQ r
LineEQ (r
vy r -> r -> r
forall a. Fractional a => a -> a -> a
/ r
vx) r
b
    Just (Line_x_Line_Line LinePV 2 r
_)             -> r -> VerticalOrLineEQ r
forall r. r -> VerticalOrLineEQ r
VerticalLineThrough r
0

instance (Fractional r, Ord r) => AsLine (LinePV 2 r) where
  asLine :: forall r.
(NumType (LinePV 2 r) ~ r) =>
LinePV 2 r -> VerticalOrLineEQ r
asLine = LinePV 2 r -> VerticalOrLineEQ r
LinePV 2 r -> VerticalOrLineEQ r
forall r. (Fractional r, Ord r) => LinePV 2 r -> VerticalOrLineEQ r
toLinearFunction

instance ( Show r, KnownNat d
         , Has_ Additive_ d r
         -- , OptVector_ d r, OptMetric_ d r
         ) => Show (LinePV d r) where
  showsPrec :: Int -> LinePV d r -> ShowS
showsPrec Int
k (LinePV Point d r
p Vector d r
v) = Bool -> ShowS -> ShowS
showParen (Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
appPrec) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
                             String -> ShowS
showString String
"LinePV "
                             ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Point d r -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrecInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Point d r
p
                             ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' '
                             ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Vector d r -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
appPrecInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Vector d r
v

appPrec :: Int
appPrec :: Int
appPrec = Int
10

instance (Read r
         , Has_ Additive_ d r
         -- , OptVector_ d r, OptMetric_ d r
         , KnownNat d
         ) => Read (LinePV d r) where
  readPrec :: ReadPrec (LinePV d r)
readPrec = ReadPrec (LinePV d r) -> ReadPrec (LinePV d r)
forall a. ReadPrec a -> ReadPrec a
parens (Int -> ReadPrec (LinePV d r) -> ReadPrec (LinePV d r)
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
appPrec (ReadPrec (LinePV d r) -> ReadPrec (LinePV d r))
-> ReadPrec (LinePV d r) -> ReadPrec (LinePV d r)
forall a b. (a -> b) -> a -> b
$ do
                          Ident "LinePV" <- ReadPrec Lexeme
lexP
                          p <- step readPrec
                          v <- step readPrec
                          return (LinePV p v))

instance (NFData (Vector d r)) => NFData (LinePV d r)

-- deriving instance Arity d             => Functor       (Line d)
-- deriving instance Arity d             => F.Foldable    (Line d)
-- deriving instance Arity d             => T.Traversable (Line d)

-- deriving instance (Arity d, Eq r)     => Eq (LinePV d r)


instance {-# OVERLAPPING #-} (Ord r, Num r) => Eq (LinePV 2 r) where
  l :: LinePV 2 r
l@(LinePV Point 2 r
p Vector 2 r
_) == :: LinePV 2 r -> LinePV 2 r -> Bool
== LinePV 2 r
l' = LinePV 2 r
l LinePV 2 r -> LinePV 2 r -> Bool
forall r. (Eq r, Num r) => LinePV 2 r -> LinePV 2 r -> Bool
`isParallelTo2` LinePV 2 r
l' Bool -> Bool -> Bool
&& Point 2 r
p Point 2 r -> LinePV 2 r -> Bool
forall r point.
(Ord r, Num r, Point_ point 2 r) =>
point -> LinePV 2 r -> Bool
`onLine2` LinePV 2 r
l'

-- instance (Eq r, Fractional r) => Eq (LinePV d r) where
--  l@(LinePV p _) == m = l `isParallelTo` m && p `onLine` m

instance (Has_ Metric_ d r, Fractional r, Eq (Vector d r)) => HasOnLine (LinePV d r) d where
  onLine :: forall point r.
(Point_ point d r, Num r, Eq r, r ~ NumType (LinePV d r),
 d ~ Dimension (LinePV d r)) =>
point -> LinePV d r -> Bool
onLine = point -> LinePV d r -> Bool
forall point (d :: Nat) r.
(Point_ point d r, Has_ Metric_ d r, Fractional r, Eq r,
 Eq (Vector d r)) =>
point -> LinePV d r -> Bool
onLineD

-- | Test if point q lies on line l
onLineD :: ( Point_ point d r, Has_ Metric_ d r
           , Fractional r, Eq r, Eq (Vector d r)
           ) => point -> LinePV d r -> Bool
onLineD :: forall point (d :: Nat) r.
(Point_ point d r, Has_ Metric_ d r, Fractional r, Eq r,
 Eq (Vector d r)) =>
point -> LinePV d r -> Bool
onLineD point
q (LinePV Point d r
p Vector d r
v) = let q' :: Point d r
q' = point
qpoint -> Getting (Point d r) point (Point d r) -> Point d r
forall s a. s -> Getting a s a -> a
^.Getting (Point d r) point (Point d r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point d r)
asPoint
                        in Point d r
p Point d r -> Point d r -> Bool
forall a. Eq a => a -> a -> Bool
== Point d r
q' Bool -> Bool -> Bool
|| (Point d r
q' Point d r -> Point d r -> Vector d r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> point -> Vector d r
.-. Point d r
p) Vector d r -> Vector d r -> Bool
forall r vector (d :: Nat).
(Eq r, Num r, Metric_ vector d r) =>
vector -> vector -> Bool
`isScalarMultipleOf` Vector d r
v


-- instance (Arbitrary r, Arity d, Num r, Eq r) => Arbitrary (LinePV d r) where
--   arbitrary = do p <- arbitrary @(Point d r)
--                  q <- suchThat arbitrary (/= p)
--                  return $ lineThrough p q


-- ** Functions on lines



-- | Test if two lines are identical, meaning; if they have exactly the same
-- anchor point and directional vector.
isIdenticalTo                             :: Eq (Vector d r)
                                          => LinePV d r -> LinePV d r -> Bool
(LinePV Point d r
p Vector d r
u) isIdenticalTo :: forall (d :: Nat) r.
Eq (Vector d r) =>
LinePV d r -> LinePV d r -> Bool
`isIdenticalTo` (LinePV Point d r
q Vector d r
v) = (Point d r
p,Vector d r
u) (Point d r, Vector d r) -> (Point d r, Vector d r) -> Bool
forall a. Eq a => a -> a -> Bool
== (Point d r
q,Vector d r
v)


-- {-# RULES
-- "isParallelTo/isParallelTo2" [3]
--      forall (l1 :: forall r. LinePV 2 r) l2. isParallelTo l1 l2 = isParallelTo2 l1 l2
-- #-}

-- | Check whether two lines are parallel
isParallelTo2                            :: (Eq r, Num r) => LinePV 2 r -> LinePV 2 r -> Bool
isParallelTo2 :: forall r. (Eq r, Num r) => LinePV 2 r -> LinePV 2 r -> Bool
isParallelTo2 (LinePV Point 2 r
_ (Vector2 r
ux r
uy))
              (LinePV Point 2 r
_ (Vector2 r
vx r
vy)) = r
denom r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
0
    where
      denom :: r
denom = r
vy r -> r -> r
forall a. Num a => a -> a -> a
* r
ux r -> r -> r
forall a. Num a => a -> a -> a
- r
vx r -> r -> r
forall a. Num a => a -> a -> a
* r
uy

instance {-# OVERLAPPING #-} Ord r => HasOnLine (LinePV 2 r) 2 where
  onLine :: forall point r.
(Point_ point 2 r, Num r, Eq r, r ~ NumType (LinePV 2 r),
 2 ~ Dimension (LinePV 2 r)) =>
point -> LinePV 2 r -> Bool
onLine = point -> LinePV 2 r -> Bool
forall r point.
(Ord r, Num r, Point_ point 2 r) =>
point -> LinePV 2 r -> Bool
onLine2

-- | Specific 2d version of testing if apoint lies on a line.
onLine2                  :: (Ord r, Num r, Point_ point 2 r) => point -> LinePV 2 r -> Bool
point
q onLine2 :: forall r point.
(Ord r, Num r, Point_ point 2 r) =>
point -> LinePV 2 r -> Bool
`onLine2` (LinePV Point 2 r
p Vector 2 r
v) = Point 2 r -> Point 2 r -> Point 2 r -> CCW
forall point r point' point''.
(Point_ point 2 r, Point_ point' 2 r, Point_ point'' 2 r, Num r,
 Ord r) =>
point -> point' -> point'' -> CCW
ccw (point
qpoint -> Getting (Point 2 r) point (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) point (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint) Point 2 r
p (Point 2 r
p Point 2 r -> Vector 2 r -> Point 2 r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> Vector d r -> point
.+^ Vector 2 r
v) CCW -> CCW -> Bool
forall a. Eq a => a -> a -> Bool
== CCW
CoLinear

-- | The intersection of two lines is either: NoIntersection, a point or a line.
type instance Intersection (LinePV 2 r) (LinePV 2 r) =
  Maybe (LineLineIntersection (LinePV 2 r))

instance ( Ord r, Num r
         ) => LinePV 2 r `HasIntersectionWith` LinePV 2 r where
  LinePV 2 r
l1 intersects :: LinePV 2 r -> LinePV 2 r -> Bool
`intersects` l2 :: LinePV 2 r
l2@(LinePV Point 2 r
q Vector 2 r
_) =
    Bool -> Bool
not (LinePV 2 r
l1 LinePV 2 r -> LinePV 2 r -> Bool
forall r. (Eq r, Num r) => LinePV 2 r -> LinePV 2 r -> Bool
`isParallelTo2` LinePV 2 r
l2) Bool -> Bool -> Bool
|| Point 2 r
q Point 2 r -> LinePV 2 r -> Bool
forall r point.
(Ord r, Num r, Point_ point 2 r) =>
point -> LinePV 2 r -> Bool
`onLine2` LinePV 2 r
l1


instance ( Ord r
         , Fractional r
         -- , OptCVector_ 2 r, OptCVector_ 3 r
         -- , OptMetric_ 2 r, Eq (VectorFamily 2 r)
         ) => LinePV 2 r `IsIntersectableWith` LinePV 2 r where
  l :: LinePV 2 r
l@(LinePV Point 2 r
p ~(Vector2 r
ux r
uy)) intersect :: LinePV 2 r -> LinePV 2 r -> Intersection (LinePV 2 r) (LinePV 2 r)
`intersect` (LinePV Point 2 r
q ~v :: Vector 2 r
v@(Vector2 r
vx r
vy))
      | Bool
areParallel = if Point 2 r
q Point 2 r -> LinePV 2 r -> Bool
forall r point.
(Ord r, Num r, Point_ point 2 r) =>
point -> LinePV 2 r -> Bool
`onLine2` LinePV 2 r
l then LineLineIntersectionG r (LinePV 2 r)
-> Maybe (LineLineIntersectionG r (LinePV 2 r))
forall a. a -> Maybe a
Just (LineLineIntersectionG r (LinePV 2 r)
 -> Maybe (LineLineIntersectionG r (LinePV 2 r)))
-> LineLineIntersectionG r (LinePV 2 r)
-> Maybe (LineLineIntersectionG r (LinePV 2 r))
forall a b. (a -> b) -> a -> b
$ LinePV 2 r -> LineLineIntersectionG r (LinePV 2 r)
forall r line. line -> LineLineIntersectionG r line
Line_x_Line_Line LinePV 2 r
l
                                       else Maybe (LineLineIntersectionG r (LinePV 2 r))
Intersection (LinePV 2 r) (LinePV 2 r)
forall a. Maybe a
Nothing
      | Bool
otherwise   = LineLineIntersectionG r (LinePV 2 r)
-> Maybe (LineLineIntersectionG r (LinePV 2 r))
forall a. a -> Maybe a
Just (LineLineIntersectionG r (LinePV 2 r)
 -> Maybe (LineLineIntersectionG r (LinePV 2 r)))
-> LineLineIntersectionG r (LinePV 2 r)
-> Maybe (LineLineIntersectionG r (LinePV 2 r))
forall a b. (a -> b) -> a -> b
$ Point 2 r -> LineLineIntersectionG r (LinePV 2 r)
forall r line. Point 2 r -> LineLineIntersectionG r line
Line_x_Line_Point Point 2 r
r
    where
      r :: Point 2 r
r = Point 2 r
q Point 2 r -> Vector 2 r -> Point 2 r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> Vector d r -> point
.+^ (r
alpha r -> Vector 2 r -> Vector 2 r
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
r -> vector -> vector
*^ Vector 2 r
v)

      denom :: r
denom       = r
vy r -> r -> r
forall a. Num a => a -> a -> a
* r
ux r -> r -> r
forall a. Num a => a -> a -> a
- r
vx r -> r -> r
forall a. Num a => a -> a -> a
* r
uy
      areParallel :: Bool
areParallel = r
denom r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
0
      -- Instead of using areParallel, we can also use the generic 'isParallelTo' function
      -- for lines of arbitrary dimension, but this is a bit more efficient.

      alpha :: r
alpha        = (r
ux r -> r -> r
forall a. Num a => a -> a -> a
* (r
py r -> r -> r
forall a. Num a => a -> a -> a
- r
qy) r -> r -> r
forall a. Num a => a -> a -> a
+ r
uy r -> r -> r
forall a. Num a => a -> a -> a
* (r
qx r -> r -> r
forall a. Num a => a -> a -> a
- r
px)) r -> r -> r
forall a. Fractional a => a -> a -> a
/ r
denom

      Point2 r
px r
py = Point 2 r
p
      Point2 r
qx r
qy = Point 2 r
q

--------------------------------------------------------------------------------
-- * Supporting Lines

-- | Types for which we can compute a supporting line, i.e. a line
-- that contains the thing of type t.
class HasSupportingLine t where
  supportingLine :: t -> LinePV (Dimension t) (NumType t)

instance HasSupportingLine t => HasSupportingLine (t :+ extra) where
  supportingLine :: (t :+ extra)
-> LinePV (Dimension (t :+ extra)) (NumType (t :+ extra))
supportingLine = t -> LinePV (Dimension t) (NumType t)
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine (t -> LinePV (Dimension t) (NumType t))
-> ((t :+ extra) -> t)
-> (t :+ extra)
-> LinePV (Dimension t) (NumType t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting t (t :+ extra) t -> (t :+ extra) -> t
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting t (t :+ extra) t
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core

instance HasSupportingLine (LinePV d r) where
  supportingLine :: LinePV d r
-> LinePV (Dimension (LinePV d r)) (NumType (LinePV d r))
supportingLine = LinePV d r -> LinePV d r
LinePV d r
-> LinePV (Dimension (LinePV d r)) (NumType (LinePV d r))
forall a. a -> a
id

instance (Num r) => HasSupportingLine (LineEQ r) where
  supportingLine :: LineEQ r -> LinePV (Dimension (LineEQ r)) (NumType (LineEQ r))
supportingLine = LineEQ r -> LinePV 2 r
LineEQ r -> LinePV (Dimension (LineEQ r)) (NumType (LineEQ r))
forall r. Num r => LineEQ r -> LinePV 2 r
fromLineEQ

-- | Convert from a LineEQ to a Point and Line
fromLineEQ              :: Num r => LineEQ r -> LinePV 2 r
fromLineEQ :: forall r. Num r => LineEQ r -> LinePV 2 r
fromLineEQ (LineEQ r
a r
b) = r -> r -> LinePV 2 r
forall r. Num r => r -> r -> LinePV 2 r
fromLinearFunction r
a r
b

instance Num r => HasSupportingLine (VerticalOrLineEQ r) where
  supportingLine :: VerticalOrLineEQ r
-> LinePV
     (Dimension (VerticalOrLineEQ r)) (NumType (VerticalOrLineEQ r))
supportingLine = \case
    VerticalLineThrough r
x -> Point 2 r -> Vector 2 r -> LinePV 2 r
forall (d :: Nat) r. Point d r -> Vector d r -> LinePV d r
LinePV (r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 r
x r
0) (r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
Vector2 r
0 r
1)
    NonVertical LineEQ r
l         -> LineEQ r -> LinePV (Dimension (LineEQ r)) (NumType (LineEQ r))
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine LineEQ r
l

--------------------------------------------------------------------------------
-- * Convenience functions on Two dimensional lines

-- | Create a line from the linear function ax + b
fromLinearFunction     :: (Num r) => r -> r -> LinePV 2 r
fromLinearFunction :: forall r. Num r => r -> r -> LinePV 2 r
fromLinearFunction r
a r
b = Point 2 r -> Vector 2 r -> LinePV 2 r
forall (d :: Nat) r. Point d r -> Vector d r -> LinePV d r
LinePV (r -> r -> Point 2 r
forall r. r -> r -> Point 2 r
Point2 r
0 r
b) (r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
Vector2 r
1 r
a)

instance (Fractional r, Has_ Metric_ d r
         ) => HasSquaredEuclideanDistance (LinePV d r) where
  pointClosestTo :: forall r (d :: Nat) point.
(r ~ NumType (LinePV d r), d ~ Dimension (LinePV d r), Num r,
 Point_ point d r) =>
point -> LinePV d r -> Point d r
pointClosestTo (Getting (Point d r) point (Point d r) -> point -> Point d r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Point d r) point (Point d r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point d r)
asPoint -> Point d r
p) (LinePV Point d r
a Vector d r
m) = Point d r
Point d r
a Point d r -> Vector d r -> Point d r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> Vector d r -> point
.+^ (r
t0 r -> Vector d r -> Vector d r
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
r -> vector -> vector
*^ Vector d r
m)
    where
      -- see https://web.archive.org/web/20210924073744/https://monkeyproofsolutions.nl/wordpress/how-to-calculate-the-shortest-distance-between-a-point-and-a-line/
      t0 :: r
t0 = r
numerator r -> r -> r
forall a. Fractional a => a -> a -> a
/ r
divisor
      numerator :: r
numerator = (Point d r
p Point d r -> Point d r -> Vector d r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> point -> Vector d r
.-. Point d r
a) Vector d r -> Vector d r -> r
forall vector (d :: Nat) r.
(Metric_ vector d r, Num r) =>
vector -> vector -> r
`dot` Vector d r
m
      divisor :: r
divisor  = Vector d r
m Vector d r -> Vector d r -> r
forall vector (d :: Nat) r.
(Metric_ vector d r, Num r) =>
vector -> vector -> r
`dot` Vector d r
m


-- | Result of a side test
data SideTestUpDown = Below | On | Above deriving (Int -> SideTestUpDown -> ShowS
[SideTestUpDown] -> ShowS
SideTestUpDown -> String
(Int -> SideTestUpDown -> ShowS)
-> (SideTestUpDown -> String)
-> ([SideTestUpDown] -> ShowS)
-> Show SideTestUpDown
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SideTestUpDown -> ShowS
showsPrec :: Int -> SideTestUpDown -> ShowS
$cshow :: SideTestUpDown -> String
show :: SideTestUpDown -> String
$cshowList :: [SideTestUpDown] -> ShowS
showList :: [SideTestUpDown] -> ShowS
Show,ReadPrec [SideTestUpDown]
ReadPrec SideTestUpDown
Int -> ReadS SideTestUpDown
ReadS [SideTestUpDown]
(Int -> ReadS SideTestUpDown)
-> ReadS [SideTestUpDown]
-> ReadPrec SideTestUpDown
-> ReadPrec [SideTestUpDown]
-> Read SideTestUpDown
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SideTestUpDown
readsPrec :: Int -> ReadS SideTestUpDown
$creadList :: ReadS [SideTestUpDown]
readList :: ReadS [SideTestUpDown]
$creadPrec :: ReadPrec SideTestUpDown
readPrec :: ReadPrec SideTestUpDown
$creadListPrec :: ReadPrec [SideTestUpDown]
readListPrec :: ReadPrec [SideTestUpDown]
Read,SideTestUpDown -> SideTestUpDown -> Bool
(SideTestUpDown -> SideTestUpDown -> Bool)
-> (SideTestUpDown -> SideTestUpDown -> Bool) -> Eq SideTestUpDown
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SideTestUpDown -> SideTestUpDown -> Bool
== :: SideTestUpDown -> SideTestUpDown -> Bool
$c/= :: SideTestUpDown -> SideTestUpDown -> Bool
/= :: SideTestUpDown -> SideTestUpDown -> Bool
Eq,Eq SideTestUpDown
Eq SideTestUpDown =>
(SideTestUpDown -> SideTestUpDown -> Ordering)
-> (SideTestUpDown -> SideTestUpDown -> Bool)
-> (SideTestUpDown -> SideTestUpDown -> Bool)
-> (SideTestUpDown -> SideTestUpDown -> Bool)
-> (SideTestUpDown -> SideTestUpDown -> Bool)
-> (SideTestUpDown -> SideTestUpDown -> SideTestUpDown)
-> (SideTestUpDown -> SideTestUpDown -> SideTestUpDown)
-> Ord SideTestUpDown
SideTestUpDown -> SideTestUpDown -> Bool
SideTestUpDown -> SideTestUpDown -> Ordering
SideTestUpDown -> SideTestUpDown -> SideTestUpDown
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SideTestUpDown -> SideTestUpDown -> Ordering
compare :: SideTestUpDown -> SideTestUpDown -> Ordering
$c< :: SideTestUpDown -> SideTestUpDown -> Bool
< :: SideTestUpDown -> SideTestUpDown -> Bool
$c<= :: SideTestUpDown -> SideTestUpDown -> Bool
<= :: SideTestUpDown -> SideTestUpDown -> Bool
$c> :: SideTestUpDown -> SideTestUpDown -> Bool
> :: SideTestUpDown -> SideTestUpDown -> Bool
$c>= :: SideTestUpDown -> SideTestUpDown -> Bool
>= :: SideTestUpDown -> SideTestUpDown -> Bool
$cmax :: SideTestUpDown -> SideTestUpDown -> SideTestUpDown
max :: SideTestUpDown -> SideTestUpDown -> SideTestUpDown
$cmin :: SideTestUpDown -> SideTestUpDown -> SideTestUpDown
min :: SideTestUpDown -> SideTestUpDown -> SideTestUpDown
Ord)

-- | Class for types that support testing on which side (above, on,
-- below) a particular point is.
class OnSideUpDownTest t where
  -- | Given a point q and a hyperplane h, compute to which side of h q lies. For
  -- vertical hyperplanes the left side of the hyperplane is interpeted as below.
  onSideUpDown :: (d ~ Dimension t, r ~ NumType t, Ord r, Num r, Point_ point d r)
               => point -> t -> SideTestUpDown

instance OnSideUpDownTest (LinePV 2 r) where
  -- | Given a point q and a line l, compute to which side of l q lies. For
  -- vertical lines the left side of the line is interpeted as below.
  --
  -- >>> Point2 10 10 `onSideUpDown` (lineThrough origin $ Point2 10 5)
  -- Above
  -- >>> Point2 10 10 `onSideUpDown` (lineThrough origin $ Point2 (-10) 5)
  -- Above
  -- >>> Point2 5 5 `onSideUpDown` (verticalLine 10)
  -- Below
  -- >>> Point2 5 5 `onSideUpDown` (lineThrough origin $ Point2 (-3) (-3))
  -- On
  point
q onSideUpDown :: forall (d :: Nat) r point.
(d ~ Dimension (LinePV 2 r), r ~ NumType (LinePV 2 r), Ord r,
 Num r, Point_ point d r) =>
point -> LinePV 2 r -> SideTestUpDown
`onSideUpDown` (LinePV Point 2 r
p Vector 2 r
v) = let r :: Point 2 r
r    =  Point 2 r
p Point 2 r -> Vector 2 r -> Point 2 r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> Vector d r -> point
.+^ Vector 2 r
v
                                      f :: s -> Vector 2 (NumType s)
f s
z         = NumType s -> NumType s -> Vector 2 (NumType s)
forall r. r -> r -> Vector 2 r
Vector2 (s
zs -> Getting (NumType s) s (NumType s) -> NumType s
forall s a. s -> Getting a s a -> a
^.Getting (NumType s) s (NumType s)
forall (d :: Nat) point r.
(1 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int s (NumType s)
xCoord) (- (s
zs -> Getting (NumType s) s (NumType s) -> NumType s
forall s a. s -> Getting a s a -> a
^.Getting (NumType s) s (NumType s)
forall (d :: Nat) point r.
(2 <= d, Point_ point d r) =>
IndexedLens' Int point r
IndexedLens' Int s (NumType s)
yCoord))
                                      minBy :: (t -> a) -> t -> t -> t
minBy t -> a
g t
a t
b = if t -> a
g t
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= t -> a
g t
b then t
a else t
b
                                      maxBy :: (t -> a) -> t -> t -> t
maxBy t -> a
g t
a t
b = if t -> a
g t
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= t -> a
g t
b then t
a else t
b
                                  in case Point 2 r -> Point 2 r -> Point 2 r -> CCW
forall point r point' point''.
(Point_ point 2 r, Point_ point' 2 r, Point_ point'' 2 r, Num r,
 Ord r) =>
point -> point' -> point'' -> CCW
ccw ((Point 2 r -> Vector 2 r) -> Point 2 r -> Point 2 r -> Point 2 r
forall {a} {t}. Ord a => (t -> a) -> t -> t -> t
minBy Point 2 r -> Vector 2 r
Point 2 r -> Vector 2 (NumType (Point 2 r))
forall {s}.
(Assert
   (OrdCond (CmpNat 1 (Dimension s)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 2 (Dimension s)) 'True 'True 'False)
   (TypeError ...),
 Num (NumType s), Point_ s (Dimension s) (NumType s)) =>
s -> Vector 2 (NumType s)
f Point 2 r
p Point 2 r
r) ((Point 2 r -> Vector 2 r) -> Point 2 r -> Point 2 r -> Point 2 r
forall {a} {t}. Ord a => (t -> a) -> t -> t -> t
maxBy Point 2 r -> Vector 2 r
Point 2 r -> Vector 2 (NumType (Point 2 r))
forall {s}.
(Assert
   (OrdCond (CmpNat 1 (Dimension s)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat 2 (Dimension s)) 'True 'True 'False)
   (TypeError ...),
 Num (NumType s), Point_ s (Dimension s) (NumType s)) =>
s -> Vector 2 (NumType s)
f Point 2 r
p Point 2 r
r) (point
qpoint -> Getting (Point 2 r) point (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) point (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint) of
                                       CCW
CCW      -> SideTestUpDown
Above
                                       CCW
CW       -> SideTestUpDown
Below
                                       CCW
CoLinear -> SideTestUpDown
On
  {-# INLINABLE onSideUpDown #-}

-- | Result of a side test
data SideTest = LeftSide | OnLine | RightSide deriving (Int -> SideTest -> ShowS
[SideTest] -> ShowS
SideTest -> String
(Int -> SideTest -> ShowS)
-> (SideTest -> String) -> ([SideTest] -> ShowS) -> Show SideTest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SideTest -> ShowS
showsPrec :: Int -> SideTest -> ShowS
$cshow :: SideTest -> String
show :: SideTest -> String
$cshowList :: [SideTest] -> ShowS
showList :: [SideTest] -> ShowS
Show,ReadPrec [SideTest]
ReadPrec SideTest
Int -> ReadS SideTest
ReadS [SideTest]
(Int -> ReadS SideTest)
-> ReadS [SideTest]
-> ReadPrec SideTest
-> ReadPrec [SideTest]
-> Read SideTest
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SideTest
readsPrec :: Int -> ReadS SideTest
$creadList :: ReadS [SideTest]
readList :: ReadS [SideTest]
$creadPrec :: ReadPrec SideTest
readPrec :: ReadPrec SideTest
$creadListPrec :: ReadPrec [SideTest]
readListPrec :: ReadPrec [SideTest]
Read,SideTest -> SideTest -> Bool
(SideTest -> SideTest -> Bool)
-> (SideTest -> SideTest -> Bool) -> Eq SideTest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SideTest -> SideTest -> Bool
== :: SideTest -> SideTest -> Bool
$c/= :: SideTest -> SideTest -> Bool
/= :: SideTest -> SideTest -> Bool
Eq,Eq SideTest
Eq SideTest =>
(SideTest -> SideTest -> Ordering)
-> (SideTest -> SideTest -> Bool)
-> (SideTest -> SideTest -> Bool)
-> (SideTest -> SideTest -> Bool)
-> (SideTest -> SideTest -> Bool)
-> (SideTest -> SideTest -> SideTest)
-> (SideTest -> SideTest -> SideTest)
-> Ord SideTest
SideTest -> SideTest -> Bool
SideTest -> SideTest -> Ordering
SideTest -> SideTest -> SideTest
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SideTest -> SideTest -> Ordering
compare :: SideTest -> SideTest -> Ordering
$c< :: SideTest -> SideTest -> Bool
< :: SideTest -> SideTest -> Bool
$c<= :: SideTest -> SideTest -> Bool
<= :: SideTest -> SideTest -> Bool
$c> :: SideTest -> SideTest -> Bool
> :: SideTest -> SideTest -> Bool
$c>= :: SideTest -> SideTest -> Bool
>= :: SideTest -> SideTest -> Bool
$cmax :: SideTest -> SideTest -> SideTest
max :: SideTest -> SideTest -> SideTest
$cmin :: SideTest -> SideTest -> SideTest
min :: SideTest -> SideTest -> SideTest
Ord)

-- | Given a point q and a line l, compute to which side of l q lies. For
-- vertical lines the left side of the line is interpeted as below.
--
-- >>> Point2 10 10 `onSide` (lineThrough origin $ Point2 10 5)
-- LeftSide
-- >>> Point2 10 10 `onSide` (lineThrough origin $ Point2 (-10) 5)
-- RightSide
-- >>> Point2 5 5 `onSide` (verticalLine 10)
-- LeftSide
-- >>> Point2 5 5 `onSide` (lineThrough origin $ Point2 (-3) (-3))
-- OnLine
onSide                :: ( Ord r, Num r
                         , Point_ point 2 r
                         -- , OptCVector_ 2 r, OptMetric_ 2 r
                         ) => point -> LinePV 2 r -> SideTest
point
q onSide :: forall r point.
(Ord r, Num r, Point_ point 2 r) =>
point -> LinePV 2 r -> SideTest
`onSide` (LinePV Point 2 r
p Vector 2 r
v) = let r :: Point 2 r
r    =  Point 2 r
p Point 2 r -> Vector 2 r -> Point 2 r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> Vector d r -> point
.+^ Vector 2 r
v
                            -- f z         = (z^.xCoord, -z^.yCoord)
                            -- minBy g a b = F.minimumBy (comparing g) [a,b]
                            -- maxBy g a b = F.maximumBy (comparing g) [a,b]
                          in case Point 2 r -> Point 2 r -> Point 2 r -> CCW
forall point r point' point''.
(Point_ point 2 r, Point_ point' 2 r, Point_ point'' 2 r, Num r,
 Ord r) =>
point -> point' -> point'' -> CCW
ccw Point 2 r
p Point 2 r
r (point
qpoint -> Getting (Point 2 r) point (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.Getting (Point 2 r) point (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint) of
                            CCW
CCW      -> SideTest
LeftSide
                            CCW
CW       -> SideTest
RightSide
                            CCW
CoLinear -> SideTest
OnLine

-- | Test if the query point q lies (strictly) above line l
liesAbove       :: ( Ord r, Num r
                   , Point_ point 2 r
                   -- , OptCVector_ 2 r, OptMetric_ 2 r
                   ) => point -> LinePV 2 r -> Bool
point
q liesAbove :: forall r point.
(Ord r, Num r, Point_ point 2 r) =>
point -> LinePV 2 r -> Bool
`liesAbove` LinePV 2 r
l = point
q point -> LinePV 2 r -> SideTestUpDown
forall (d :: Nat) r point.
(d ~ Dimension (LinePV 2 r), r ~ NumType (LinePV 2 r), Ord r,
 Num r, Point_ point d r) =>
point -> LinePV 2 r -> SideTestUpDown
forall t (d :: Nat) r point.
(OnSideUpDownTest t, d ~ Dimension t, r ~ NumType t, Ord r, Num r,
 Point_ point d r) =>
point -> t -> SideTestUpDown
`onSideUpDown` LinePV 2 r
l SideTestUpDown -> SideTestUpDown -> Bool
forall a. Eq a => a -> a -> Bool
== SideTestUpDown
Above

-- | Test if the query point q lies (strictly) above line l
liesBelow      :: (Ord r, Num r, Point_ point 2 r
                  -- , OptCVector_ 2 r, OptMetric_ 2 r
                  ) => point -> LinePV 2 r -> Bool
point
q liesBelow :: forall r point.
(Ord r, Num r, Point_ point 2 r) =>
point -> LinePV 2 r -> Bool
`liesBelow` LinePV 2 r
l = point
q point -> LinePV 2 r -> SideTestUpDown
forall (d :: Nat) r point.
(d ~ Dimension (LinePV 2 r), r ~ NumType (LinePV 2 r), Ord r,
 Num r, Point_ point d r) =>
point -> LinePV 2 r -> SideTestUpDown
forall t (d :: Nat) r point.
(OnSideUpDownTest t, d ~ Dimension t, r ~ NumType t, Ord r, Num r,
 Point_ point d r) =>
point -> t -> SideTestUpDown
`onSideUpDown` LinePV 2 r
l SideTestUpDown -> SideTestUpDown -> Bool
forall a. Eq a => a -> a -> Bool
== SideTestUpDown
Below

-- | Get the bisector between two points
bisector     :: (Fractional r, Point_ point 2 r
                -- , OptCVector_ 2 r, OptMetric_ 2 r
                ) => point -> point -> LinePV 2 r
bisector :: forall r point.
(Fractional r, Point_ point 2 r) =>
point -> point -> LinePV 2 r
bisector point
p point
q = let v :: Vector 2 r
v = point
q point -> point -> Vector 2 r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> point -> Vector d r
.-. point
p
                   h :: Point 2 r
h = Getting (Point 2 r) point (Point 2 r) -> point -> Point 2 r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Point 2 r) point (Point 2 r)
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint (point -> Point 2 r) -> point -> Point 2 r
forall a b. (a -> b) -> a -> b
$ point
p point -> Vector 2 r -> point
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> Vector d r -> point
.+^ (Vector 2 r
v Vector 2 r -> r -> Vector 2 r
forall vector (d :: Nat) r.
(Vector_ vector d r, Fractional r) =>
vector -> r -> vector
^/ r
2)
               in LinePV 2 r -> LinePV 2 r
forall r. Num r => LinePV 2 r -> LinePV 2 r
perpendicularTo (Point 2 r -> Vector 2 r -> LinePV 2 r
forall (d :: Nat) r. Point d r -> Vector d r -> LinePV d r
LinePV Point 2 r
h Vector 2 r
v)

-- | Given a line l with anchor point p and vector v, get the line m perpendicular to l
-- that also goes through p. The line is oriented *into* the right halfplane of l.
--
-- >>> perpendicularTo $ LinePV (Point2 3 4) (Vector2 (-1) 2)
-- LinePV (Point2 3 4) (Vector2 2 1)
-- >>> perpendicularTo $ LinePV (Point2 (-1000) 268) (Vector2 (-50) 8)
-- LinePV (Point2 (-1000) 268) (Vector2 8 50)
perpendicularTo   :: Num r => LinePV 2 r -> LinePV 2 r
perpendicularTo :: forall r. Num r => LinePV 2 r -> LinePV 2 r
perpendicularTo LinePV 2 r
l = LinePV 2 r
lLinePV 2 r -> (LinePV 2 r -> LinePV 2 r) -> LinePV 2 r
forall a b. a -> (a -> b) -> b
&(Vector 2 r -> Identity (Vector 2 r))
-> LinePV 2 r -> Identity (LinePV 2 r)
forall (d :: Nat) r.
(Dimension (LinePV 2 r) ~ d, NumType (LinePV 2 r) ~ r) =>
Lens' (LinePV 2 r) (Vector d r)
forall t (d :: Nat) r.
(HasDirection t, Dimension t ~ d, NumType t ~ r) =>
Lens' t (Vector d r)
Lens' (LinePV 2 r) (Vector 2 r)
direction ((Vector 2 r -> Identity (Vector 2 r))
 -> LinePV 2 r -> Identity (LinePV 2 r))
-> (Vector 2 r -> Vector 2 r) -> LinePV 2 r -> LinePV 2 r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Vector 2 r -> Vector 2 r
forall {r}. Num r => Vector 2 r -> Vector 2 r
rot90cw
  where
    rot90cw :: Vector 2 r -> Vector 2 r
rot90cw (Vector2 r
vx r
vy) = r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
Vector2 r
vy (-r
vx)
{-# INLINE perpendicularTo #-}

-- | Test if a vector is perpendicular to the line.
isPerpendicularTo :: (Num r, Eq r
                     ) => Vector 2 r -> LinePV 2 r -> Bool
Vector 2 r
v isPerpendicularTo :: forall r. (Num r, Eq r) => Vector 2 r -> LinePV 2 r -> Bool
`isPerpendicularTo` (LinePV Point 2 r
_ Vector 2 r
u) = Vector 2 r
v Vector 2 r -> Vector 2 r -> r
forall vector (d :: Nat) r.
(Metric_ vector d r, Num r) =>
vector -> vector -> r
`dot` Vector 2 r
u r -> r -> Bool
forall a. Eq a => a -> a -> Bool
== r
0


-- | Compares the lines on slope. Vertical lines are considered larger than
-- anything else.
--
-- >>> (LinePV origin (Vector2 5 1)) `cmpSlope` (LinePV origin (Vector2 3 3))
-- LT
-- >>> (LinePV origin (Vector2 5 1)) `cmpSlope` (LinePV origin (Vector2 (-3) 3))
-- GT
-- >>> (LinePV origin (Vector2 5 1)) `cmpSlope` (LinePV origin (Vector2 0 1))
-- LT
cmpSlope :: forall r. (Num r, Ord r
                      ) => LinePV 2 r -> LinePV 2 r -> Ordering
(LinePV Point 2 r
_ Vector 2 r
u) cmpSlope :: forall r. (Num r, Ord r) => LinePV 2 r -> LinePV 2 r -> Ordering
`cmpSlope` (LinePV Point 2 r
_ Vector 2 r
v) = case Point 2 r -> Point 2 r -> Point 2 r -> CCW
forall point r point' point''.
(Point_ point 2 r, Point_ point' 2 r, Point_ point'' 2 r, Num r,
 Ord r) =>
point -> point' -> point'' -> CCW
ccw (Point 2 r
forall point (d :: Nat) r.
(Num r, ConstructablePoint_ point d r) =>
point
origin :: Point 2 r) (Vector 2 r -> Point 2 r
forall {a}. (Ord a, Num a) => Vector 2 a -> PointF (Vector 2 a)
f Vector 2 r
u) (Vector 2 r -> Point 2 r
forall {a}. (Ord a, Num a) => Vector 2 a -> PointF (Vector 2 a)
f Vector 2 r
v) of
                                         CCW
CCW      -> Ordering
LT
                                         CCW
CW       -> Ordering
GT
                                         CCW
CoLinear -> Ordering
EQ
  where
    f :: Vector 2 a -> PointF (Vector 2 a)
f w :: Vector 2 a
w@(Vector2 a
x a
y) = Vector 2 a -> PointF (Vector 2 a)
forall v. v -> PointF v
Point (Vector 2 a -> PointF (Vector 2 a))
-> Vector 2 a -> PointF (Vector 2 a)
forall a b. (a -> b) -> a -> b
$ case (a
x a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` a
0, a
y a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
0) of
                                  (Ordering
GT,Bool
_)    -> Vector 2 a
w
                                  (Ordering
EQ,Bool
True) -> Vector 2 a
w
                                  (Ordering, Bool)
_         -> (-a
1) a -> Vector 2 a -> Vector 2 a
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
r -> vector -> vector
*^ Vector 2 a
w
                                  -- x < 0, or (x==0 and y <0 ; i.e. a vertical line)



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

-- | Given the oriented line, computes the halfspace left of the line.
leftHalfPlane   :: (Num r, Ord r) => LinePV 2 r -> HalfSpaceF (LinePV 2 r)
leftHalfPlane :: forall r. (Num r, Ord r) => LinePV 2 r -> HalfSpaceF (LinePV 2 r)
leftHalfPlane LinePV 2 r
l = Sign -> LinePV 2 r -> HalfSpaceF (LinePV 2 r)
forall boundingHyperPlane.
Sign -> boundingHyperPlane -> HalfSpaceF boundingHyperPlane
HalfSpace Sign
sign LinePV 2 r
l
  where
    sign :: Sign
sign = let (LinePV Point 2 r
p Vector 2 r
v) = LinePV 2 r -> LinePV 2 r
forall r. Num r => LinePV 2 r -> LinePV 2 r
perpendicularTo LinePV 2 r
l
           in case Point 2 r -> LinePV 2 r -> Ordering
forall point.
(Point_ point 2 r, Ord r, Num r) =>
point -> LinePV 2 r -> Ordering
forall hyperPlane (d :: Nat) r point.
(HyperPlane_ hyperPlane d r, Point_ point d r, Ord r, Num r) =>
point -> hyperPlane -> Ordering
onSideTest (Point 2 r
p Point 2 r -> Vector 2 r -> Point 2 r
forall point (d :: Nat) r.
(Affine_ point d r, Num r) =>
point -> Vector d r -> point
.+^ Vector 2 r
v) LinePV 2 r
l of
                Ordering
LT -> Sign
Positive
                Ordering
_  -> Sign
Negative

-- | Given the oriented line, computes the halfspace right of the line.
rightHalfPlane   :: (Num r, Ord r) => LinePV 2 r -> HalfSpaceF (LinePV 2 r)
rightHalfPlane :: forall r. (Num r, Ord r) => LinePV 2 r -> HalfSpaceF (LinePV 2 r)
rightHalfPlane LinePV 2 r
l = let HalfSpace Sign
s LinePV 2 r
_ = LinePV 2 r -> HalfSpaceF (LinePV 2 r)
forall r. (Num r, Ord r) => LinePV 2 r -> HalfSpaceF (LinePV 2 r)
leftHalfPlane LinePV 2 r
l
                   in Sign -> LinePV 2 r -> HalfSpaceF (LinePV 2 r)
forall boundingHyperPlane.
Sign -> boundingHyperPlane -> HalfSpaceF boundingHyperPlane
HalfSpace (Sign -> Sign
flipSign Sign
s) LinePV 2 r
l

{-
-- | Lines are transformable, via line segments
instance ( Fractional r
         , TransformationConstraints d r
         -- , OptVector_ d r, OptMetric_ d r
         ) => IsTransformable (LinePV d r) where
  transformBy t (LinePV p v) = lineThrough p' q'
    where
      p' = transformBy t p
      q' = transformBy t (p .+^ v)

-}