{-# 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
  , 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.Point
import           HGeometry.HalfSpace
-- import           HGeometry.Point.EuclideanDistance
-- import           HGeometry.Point.Orientation.Degenerate
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
cr -> 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
cr -> 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.

{- 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 -> Maybe (LineEQ r)
toLinearFunction :: forall r. (Fractional r, Ord r) => LinePV 2 r -> Maybe (LineEQ r)
toLinearFunction l :: LinePV 2 r
l@(LinePV Point 2 r
_ ~(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                               -> Maybe (LineEQ r)
forall a. Maybe a
Nothing -- l is vertical
    Just (Line_x_Line_Point (Point2 r
_ r
b)) -> LineEQ r -> Maybe (LineEQ r)
forall a. a -> Maybe a
Just (LineEQ r -> Maybe (LineEQ r)) -> LineEQ r -> Maybe (LineEQ 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
_)             -> Maybe (LineEQ r)
forall a. Maybe a
Nothing -- l is a vertical line (through x=0)


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

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

-}