{-# 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
  , convertBoundingLineOf
  ) where

import HGeometry.HalfSpace.Class
import HGeometry.HalfSpace.Type
import HGeometry.HalfSpace.Intersection
import HGeometry.Point
import HGeometry.Vector
import HGeometry.Line.PointAndVector
import HGeometry.Line.Class
import HGeometry.Intersection
import HGeometry.Sign
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


--------------------------------------------------------------------------------
-- * Specific functions for 2D Halfspaces, aka HalfPlanes

-- | Convert a halfplane bounded by an oriented line a halfplane
-- bounded by some more general line type.
convertBoundingLineOf   :: (Line2_ line r, Ord r, Num r) => HalfPlaneF (LinePV 2 r) -> HalfPlaneF line
convertBoundingLineOf :: forall line r.
(Line2_ line r, Ord r, Num r) =>
HalfPlaneF (LinePV 2 r) -> HalfPlaneF line
convertBoundingLineOf HalfPlaneF (LinePV 2 r)
h =
  let h' :: HalfSpaceF line
h' = HalfPlaneF (LinePV 2 r)
hHalfPlaneF (LinePV 2 r)
-> (HalfPlaneF (LinePV 2 r) -> HalfSpaceF line) -> HalfSpaceF line
forall a b. a -> (a -> b) -> b
&(LinePV 2 r -> Identity line)
-> HalfPlaneF (LinePV 2 r) -> Identity (HalfSpaceF line)
forall boundingHyperPlane boundingHyperPlane' (f :: * -> *).
Functor f =>
(boundingHyperPlane -> f boundingHyperPlane')
-> HalfSpaceF boundingHyperPlane
-> f (HalfSpaceF boundingHyperPlane')
boundingHyperPlaneLens ((LinePV 2 r -> Identity line)
 -> HalfPlaneF (LinePV 2 r) -> Identity (HalfSpaceF line))
-> (LinePV 2 r -> line)
-> HalfPlaneF (LinePV 2 r)
-> HalfSpaceF line
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \(LinePV Point 2 r
p Vector 2 r
v) -> Point 2 r -> Vector 2 r -> line
forall point.
(Point_ point 2 r, Line_ line 2 r, Num r) =>
point -> Vector 2 r -> line
forall line (d :: Nat) r point.
(Line_ line d r, Point_ point d r, Line_ line d r, Num r) =>
point -> Vector d r -> line
fromPointAndVec Point 2 r
p Vector 2 r
v
  in HalfSpaceF line
h'HalfSpaceF line
-> (HalfSpaceF line -> HalfSpaceF line) -> HalfSpaceF line
forall a b. a -> (a -> b) -> b
&(Sign -> Identity Sign)
-> HalfSpaceF line -> Identity (HalfSpaceF line)
forall halfSpace (d :: Nat) r.
HalfSpace_ halfSpace d r =>
Lens' halfSpace Sign
Lens' (HalfSpaceF line) Sign
halfSpaceSign ((Sign -> Identity Sign)
 -> HalfSpaceF line -> Identity (HalfSpaceF line))
-> (Sign -> Sign) -> HalfSpaceF line -> HalfSpaceF line
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \Sign
s -> if HalfPlaneF (LinePV 2 r) -> Point 2 r
forall geom (d :: Nat) r.
HasPickInteriorPoint geom d r =>
geom -> Point d r
pointInteriorTo HalfPlaneF (LinePV 2 r)
h Point 2 r -> HalfSpaceF line -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects` HalfSpaceF line
h'
                               then Sign
s else Sign -> Sign
flipSign Sign
s