{-# LANGUAGE UndecidableInstances #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.HalfSpace
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Representing halfspaces
--
--------------------------------------------------------------------------------
module HGeometry.HalfSpace
  ( module HGeometry.HalfSpace.Class
  , module HGeometry.HalfSpace.Type
  , module HGeometry.HalfSpace.Intersection
  , leftBoundingVector
  , rightBoundingVector
  ) where

import HGeometry.HalfSpace.Class
import HGeometry.HalfSpace.Type
import HGeometry.HalfSpace.Intersection
import HGeometry.Point
import HGeometry.Vector
import HGeometry.Intersection
import Control.Lens

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

-- | given a point a on the bounding hyperplane; compute a vector
-- pointing in the direction of the bounding line so that the
-- halfspace is to its left.
leftBoundingVector      :: ( HalfPlane_ halfPlane r
                           , Ord r, Num r
                           , HasIntersectionWith (Point 2 r) halfPlane
                           , GetDirection (BoundingHyperPlane halfPlane 2 r)
                           )
                        => Point 2 r -> halfPlane -> Vector 2 r
leftBoundingVector :: forall halfPlane r.
(HalfPlane_ halfPlane r, Ord r, Num r,
 HasIntersectionWith (Point 2 r) halfPlane,
 GetDirection (BoundingHyperPlane halfPlane 2 r)) =>
Point 2 r -> halfPlane -> Vector 2 r
leftBoundingVector Point 2 r
a halfPlane
h' = let l :: BoundingHyperPlane halfPlane 2 r
l               = halfPlane
h'halfPlane
-> Getting
     (BoundingHyperPlane halfPlane 2 r)
     halfPlane
     (BoundingHyperPlane halfPlane 2 r)
-> BoundingHyperPlane halfPlane 2 r
forall s a. s -> Getting a s a -> a
^.Getting
  (BoundingHyperPlane halfPlane 2 r)
  halfPlane
  (BoundingHyperPlane halfPlane 2 r)
forall halfSpace (d :: Nat) r.
HalfSpace_ halfSpace d r =>
Lens' halfSpace (BoundingHyperPlane halfSpace d r)
Lens' halfPlane (BoundingHyperPlane halfPlane 2 r)
boundingHyperPlane
                              v :: Vector 2 r
v@(Vector2 r
x r
y) = BoundingHyperPlane halfPlane 2 r -> Vector 2 r
forall line r (d :: Nat).
(GetDirection line, r ~ NumType line, d ~ Dimension line) =>
line -> Vector d r
forall r (d :: Nat).
(r ~ NumType (BoundingHyperPlane halfPlane 2 r),
 d ~ Dimension (BoundingHyperPlane halfPlane 2 r)) =>
BoundingHyperPlane halfPlane 2 r -> Vector d r
inLineVector BoundingHyperPlane halfPlane 2 r
l
                              w :: Vector 2 r
w               = r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
Vector2 (-r
y) r
x
                              -- perpendicular to v; pointing left
                          in if (Point 2 r
a 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
w) Point 2 r -> halfPlane -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` halfPlane
h' then Vector 2 r
v else Vector 2 r -> Vector 2 r
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
vector -> vector
negated Vector 2 r
v
 -- it feels a bit silly we have to do this test instead of just looking
 -- at the sign of the halfplane, but alas.

-- | given a point a on the bounding hyperplane; compute a vector
-- pointing in the direction of the bounding line so that the
-- halfspace is to its right
rightBoundingVector   :: ( HalfPlane_ halfPlane r
                         , Ord r, Num r
                         , HasIntersectionWith (Point 2 r) halfPlane
                         , GetDirection (BoundingHyperPlane halfPlane 2 r)
                         )
                      => Point 2 r -> halfPlane -> Vector 2 r
rightBoundingVector :: forall halfPlane r.
(HalfPlane_ halfPlane r, Ord r, Num r,
 HasIntersectionWith (Point 2 r) halfPlane,
 GetDirection (BoundingHyperPlane halfPlane 2 r)) =>
Point 2 r -> halfPlane -> Vector 2 r
rightBoundingVector Point 2 r
p = Vector 2 r -> Vector 2 r
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
vector -> vector
negated (Vector 2 r -> Vector 2 r)
-> (halfPlane -> Vector 2 r) -> halfPlane -> Vector 2 r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point 2 r -> halfPlane -> Vector 2 r
forall halfPlane r.
(HalfPlane_ halfPlane r, Ord r, Num r,
 HasIntersectionWith (Point 2 r) halfPlane,
 GetDirection (BoundingHyperPlane halfPlane 2 r)) =>
Point 2 r -> halfPlane -> Vector 2 r
leftBoundingVector Point 2 r
p