{-# LANGUAGE TemplateHaskell  #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Slab
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- A data type to represent slabs; i.e. regions bounded by two parallel lines.
--
--------------------------------------------------------------------------------
module HGeometry.Slab
  ( Slab(Slab), definingLine, squaredWidth, leftData, rightData
  , fromParalelHalfplanes
  , leftBoundary, rightBoundary
  ) where

import HGeometry.Properties (NumType,Dimension)
import HGeometry.Line.PointAndVector
import Control.Lens
import HGeometry.Point
import HGeometry.Vector
import HGeometry.HalfSpace.Class
import HGeometry.Intersection
import HGeometry.Ext
import HGeometry.Number.Radical
import Prelude hiding (sqrt)

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

-- | A data type representing a slab.
data Slab r side = Slab { forall r side. Slab r side -> LinePV 2 r
_definingLine        :: !(LinePV 2 r)
                        -- ^ The oriented line that defines the slab. This
                        -- is the left bounding line of the slab; i.e.
                        -- the interior of the slab is to its right
                        , forall r side. Slab r side -> r
_squaredWidth  :: !r
                        -- ^ the squared width of the slab
                        , forall r side. Slab r side -> side
_leftData  :: side
                        -- ^ data associated with the left bounding line
                        , forall r side. Slab r side -> side
_rightData :: side
                        -- ^ data associated with the right bounding line
                        }
                 deriving stock (Int -> Slab r side -> ShowS
[Slab r side] -> ShowS
Slab r side -> String
(Int -> Slab r side -> ShowS)
-> (Slab r side -> String)
-> ([Slab r side] -> ShowS)
-> Show (Slab r side)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall r side. (Show r, Show side) => Int -> Slab r side -> ShowS
forall r side. (Show r, Show side) => [Slab r side] -> ShowS
forall r side. (Show r, Show side) => Slab r side -> String
$cshowsPrec :: forall r side. (Show r, Show side) => Int -> Slab r side -> ShowS
showsPrec :: Int -> Slab r side -> ShowS
$cshow :: forall r side. (Show r, Show side) => Slab r side -> String
show :: Slab r side -> String
$cshowList :: forall r side. (Show r, Show side) => [Slab r side] -> ShowS
showList :: [Slab r side] -> ShowS
Show,Slab r side -> Slab r side -> Bool
(Slab r side -> Slab r side -> Bool)
-> (Slab r side -> Slab r side -> Bool) -> Eq (Slab r side)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall r side.
(Ord r, Num r, Eq side) =>
Slab r side -> Slab r side -> Bool
$c== :: forall r side.
(Ord r, Num r, Eq side) =>
Slab r side -> Slab r side -> Bool
== :: Slab r side -> Slab r side -> Bool
$c/= :: forall r side.
(Ord r, Num r, Eq side) =>
Slab r side -> Slab r side -> Bool
/= :: Slab r side -> Slab r side -> Bool
Eq,(forall a b. (a -> b) -> Slab r a -> Slab r b)
-> (forall a b. a -> Slab r b -> Slab r a) -> Functor (Slab r)
forall a b. a -> Slab r b -> Slab r a
forall a b. (a -> b) -> Slab r a -> Slab r b
forall r a b. a -> Slab r b -> Slab r a
forall r a b. (a -> b) -> Slab r a -> Slab r b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall r a b. (a -> b) -> Slab r a -> Slab r b
fmap :: forall a b. (a -> b) -> Slab r a -> Slab r b
$c<$ :: forall r a b. a -> Slab r b -> Slab r a
<$ :: forall a b. a -> Slab r b -> Slab r a
Functor,(forall m. Monoid m => Slab r m -> m)
-> (forall m a. Monoid m => (a -> m) -> Slab r a -> m)
-> (forall m a. Monoid m => (a -> m) -> Slab r a -> m)
-> (forall a b. (a -> b -> b) -> b -> Slab r a -> b)
-> (forall a b. (a -> b -> b) -> b -> Slab r a -> b)
-> (forall b a. (b -> a -> b) -> b -> Slab r a -> b)
-> (forall b a. (b -> a -> b) -> b -> Slab r a -> b)
-> (forall a. (a -> a -> a) -> Slab r a -> a)
-> (forall a. (a -> a -> a) -> Slab r a -> a)
-> (forall a. Slab r a -> [a])
-> (forall a. Slab r a -> Bool)
-> (forall a. Slab r a -> Int)
-> (forall a. Eq a => a -> Slab r a -> Bool)
-> (forall a. Ord a => Slab r a -> a)
-> (forall a. Ord a => Slab r a -> a)
-> (forall a. Num a => Slab r a -> a)
-> (forall a. Num a => Slab r a -> a)
-> Foldable (Slab r)
forall a. Eq a => a -> Slab r a -> Bool
forall a. Num a => Slab r a -> a
forall a. Ord a => Slab r a -> a
forall m. Monoid m => Slab r m -> m
forall a. Slab r a -> Bool
forall a. Slab r a -> Int
forall a. Slab r a -> [a]
forall a. (a -> a -> a) -> Slab r a -> a
forall r a. Eq a => a -> Slab r a -> Bool
forall r a. Num a => Slab r a -> a
forall r a. Ord a => Slab r a -> a
forall m a. Monoid m => (a -> m) -> Slab r a -> m
forall r m. Monoid m => Slab r m -> m
forall m a. Monoid m => (a -> m) -> Slab r a -> m
forall r a. Slab r a -> Bool
forall r a. Slab r a -> Int
forall r a. Slab r a -> [a]
forall b a. (b -> a -> b) -> b -> Slab r a -> b
forall a b. (a -> b -> b) -> b -> Slab r a -> b
forall r a. (a -> a -> a) -> Slab r a -> a
forall r m a. Monoid m => (a -> m) -> Slab r a -> m
forall r b a. (b -> a -> b) -> b -> Slab r a -> b
forall r a b. (a -> b -> b) -> b -> Slab r a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall r m. Monoid m => Slab r m -> m
fold :: forall m. Monoid m => Slab r m -> m
$cfoldMap :: forall r m a. Monoid m => (a -> m) -> Slab r a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Slab r a -> m
$cfoldMap' :: forall r m a. Monoid m => (a -> m) -> Slab r a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Slab r a -> m
$cfoldr :: forall r a b. (a -> b -> b) -> b -> Slab r a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Slab r a -> b
$cfoldr' :: forall r a b. (a -> b -> b) -> b -> Slab r a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Slab r a -> b
$cfoldl :: forall r b a. (b -> a -> b) -> b -> Slab r a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Slab r a -> b
$cfoldl' :: forall r b a. (b -> a -> b) -> b -> Slab r a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Slab r a -> b
$cfoldr1 :: forall r a. (a -> a -> a) -> Slab r a -> a
foldr1 :: forall a. (a -> a -> a) -> Slab r a -> a
$cfoldl1 :: forall r a. (a -> a -> a) -> Slab r a -> a
foldl1 :: forall a. (a -> a -> a) -> Slab r a -> a
$ctoList :: forall r a. Slab r a -> [a]
toList :: forall a. Slab r a -> [a]
$cnull :: forall r a. Slab r a -> Bool
null :: forall a. Slab r a -> Bool
$clength :: forall r a. Slab r a -> Int
length :: forall a. Slab r a -> Int
$celem :: forall r a. Eq a => a -> Slab r a -> Bool
elem :: forall a. Eq a => a -> Slab r a -> Bool
$cmaximum :: forall r a. Ord a => Slab r a -> a
maximum :: forall a. Ord a => Slab r a -> a
$cminimum :: forall r a. Ord a => Slab r a -> a
minimum :: forall a. Ord a => Slab r a -> a
$csum :: forall r a. Num a => Slab r a -> a
sum :: forall a. Num a => Slab r a -> a
$cproduct :: forall r a. Num a => Slab r a -> a
product :: forall a. Num a => Slab r a -> a
Foldable)

makeLenses ''Slab

type instance NumType   (Slab r side) = r
type instance Dimension (Slab r side) = 2


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

-- | Create a slab out of two halfplanes whose bounding lines are parallel.
--
fromParalelHalfplanes       :: ( HalfPlane_ halfPlane r, Num r, Fractional r
                               , HasIntersectionWith (Point 2 r) halfPlane
                               , HasSupportingLine (BoundingHyperPlane halfPlane 2 r)
                               )
                            => halfPlane -> halfPlane -> Slab r halfPlane
fromParalelHalfplanes :: forall halfPlane r.
(HalfPlane_ halfPlane r, Num r, Fractional r,
 HasIntersectionWith (Point 2 r) halfPlane,
 HasSupportingLine (BoundingHyperPlane halfPlane 2 r)) =>
halfPlane -> halfPlane -> Slab r halfPlane
fromParalelHalfplanes halfPlane
h1 halfPlane
h2
    | Bool
h1IsLeftHalfPlane     = LinePV 2 r -> r -> halfPlane -> halfPlane -> Slab r halfPlane
forall r side. LinePV 2 r -> r -> side -> side -> Slab r side
Slab LinePV 2 r
l1 r
dist halfPlane
h1 halfPlane
h2
    | Bool
otherwise             = LinePV 2 r -> r -> halfPlane -> halfPlane -> Slab r halfPlane
forall r side. LinePV 2 r -> r -> side -> side -> Slab r side
Slab LinePV 2 r
l2 r
dist halfPlane
h2 halfPlane
h1
  where
    l1 :: LinePV 2 r
l1@(LinePV Point 2 r
a (Vector2 r
x r
y)) = halfPlane
h1halfPlane
-> Getting (LinePV 2 r) halfPlane (LinePV 2 r) -> LinePV 2 r
forall s a. s -> Getting a s a -> a
^.(BoundingHyperPlane halfPlane 2 r
 -> Const (LinePV 2 r) (BoundingHyperPlane halfPlane 2 r))
-> halfPlane -> Const (LinePV 2 r) halfPlane
forall halfSpace (d :: Nat) r.
HalfSpace_ halfSpace d r =>
Lens' halfSpace (BoundingHyperPlane halfSpace d r)
Lens' halfPlane (BoundingHyperPlane halfPlane 2 r)
boundingHyperPlane((BoundingHyperPlane halfPlane 2 r
  -> Const (LinePV 2 r) (BoundingHyperPlane halfPlane 2 r))
 -> halfPlane -> Const (LinePV 2 r) halfPlane)
-> ((LinePV 2 r -> Const (LinePV 2 r) (LinePV 2 r))
    -> BoundingHyperPlane halfPlane 2 r
    -> Const (LinePV 2 r) (BoundingHyperPlane halfPlane 2 r))
-> Getting (LinePV 2 r) halfPlane (LinePV 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BoundingHyperPlane halfPlane 2 r -> LinePV 2 r)
-> (LinePV 2 r -> Const (LinePV 2 r) (LinePV 2 r))
-> BoundingHyperPlane halfPlane 2 r
-> Const (LinePV 2 r) (BoundingHyperPlane halfPlane 2 r)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to BoundingHyperPlane halfPlane 2 r -> LinePV 2 r
BoundingHyperPlane halfPlane 2 r
-> LinePV
     (Dimension (BoundingHyperPlane halfPlane 2 r))
     (NumType (BoundingHyperPlane halfPlane 2 r))
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine
    l2 :: LinePV 2 r
l2                          = halfPlane
h2halfPlane
-> Getting (LinePV 2 r) halfPlane (LinePV 2 r) -> LinePV 2 r
forall s a. s -> Getting a s a -> a
^.(BoundingHyperPlane halfPlane 2 r
 -> Const (LinePV 2 r) (BoundingHyperPlane halfPlane 2 r))
-> halfPlane -> Const (LinePV 2 r) halfPlane
forall halfSpace (d :: Nat) r.
HalfSpace_ halfSpace d r =>
Lens' halfSpace (BoundingHyperPlane halfSpace d r)
Lens' halfPlane (BoundingHyperPlane halfPlane 2 r)
boundingHyperPlane((BoundingHyperPlane halfPlane 2 r
  -> Const (LinePV 2 r) (BoundingHyperPlane halfPlane 2 r))
 -> halfPlane -> Const (LinePV 2 r) halfPlane)
-> ((LinePV 2 r -> Const (LinePV 2 r) (LinePV 2 r))
    -> BoundingHyperPlane halfPlane 2 r
    -> Const (LinePV 2 r) (BoundingHyperPlane halfPlane 2 r))
-> Getting (LinePV 2 r) halfPlane (LinePV 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BoundingHyperPlane halfPlane 2 r -> LinePV 2 r)
-> (LinePV 2 r -> Const (LinePV 2 r) (LinePV 2 r))
-> BoundingHyperPlane halfPlane 2 r
-> Const (LinePV 2 r) (BoundingHyperPlane halfPlane 2 r)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to BoundingHyperPlane halfPlane 2 r -> LinePV 2 r
BoundingHyperPlane halfPlane 2 r
-> LinePV
     (Dimension (BoundingHyperPlane halfPlane 2 r))
     (NumType (BoundingHyperPlane halfPlane 2 r))
forall t.
HasSupportingLine t =>
t -> LinePV (Dimension t) (NumType t)
supportingLine

    h1IsLeftHalfPlane :: Bool
h1IsLeftHalfPlane = let  w :: Vector 2 r
w = r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
Vector2 (-r
y) r
x in (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
h1
    dist :: r
dist = Point 2 r -> LinePV 2 r -> r
forall g r (d :: Nat) point.
(HasSquaredEuclideanDistance g, r ~ NumType g, d ~ Dimension g,
 Num r, Point_ point d r) =>
point -> g -> r
forall r (d :: Nat) point.
(r ~ NumType (LinePV 2 r), d ~ Dimension (LinePV 2 r), Num r,
 Point_ point d r) =>
point -> LinePV 2 r -> r
squaredEuclideanDistTo Point 2 r
a LinePV 2 r
l2


-- | Get the left boundary of the slab
leftBoundary   :: Slab r side -> LinePV 2 r :+ side
leftBoundary :: forall r side. Slab r side -> LinePV 2 r :+ side
leftBoundary Slab r side
s = let l :: LinePV 2 r
l = Slab r side
sSlab r side
-> Getting (LinePV 2 r) (Slab r side) (LinePV 2 r) -> LinePV 2 r
forall s a. s -> Getting a s a -> a
^.Getting (LinePV 2 r) (Slab r side) (LinePV 2 r)
forall r side (f :: * -> *).
Functor f =>
(LinePV 2 r -> f (LinePV 2 r)) -> Slab r side -> f (Slab r side)
definingLine in LinePV 2 r
l LinePV 2 r -> side -> LinePV 2 r :+ side
forall core extra. core -> extra -> core :+ extra
:+ Slab r side
sSlab r side -> Getting side (Slab r side) side -> side
forall s a. s -> Getting a s a -> a
^.Getting side (Slab r side) side
forall r side (f :: * -> *).
Functor f =>
(side -> f side) -> Slab r side -> f (Slab r side)
leftData

-- | Get the right boundary of the slab
rightBoundary   :: (Fractional r, Radical r) => Slab r side -> LinePV 2 r :+ side
rightBoundary :: forall r side.
(Fractional r, Radical r) =>
Slab r side -> LinePV 2 r :+ side
rightBoundary Slab r side
s = let (LinePV Point 2 r
p v :: Vector 2 r
v@(Vector2 r
x r
y)) = Slab r side
sSlab r side
-> Getting (LinePV 2 r) (Slab r side) (LinePV 2 r) -> LinePV 2 r
forall s a. s -> Getting a s a -> a
^.Getting (LinePV 2 r) (Slab r side) (LinePV 2 r)
forall r side (f :: * -> *).
Functor f =>
(LinePV 2 r -> f (LinePV 2 r)) -> Slab r side -> f (Slab r side)
definingLine
                      n :: Vector 2 r
n                          = Vector 2 r -> Vector 2 r
forall vector (d :: Nat) r.
(Metric_ vector d r, Radical r, Fractional r) =>
vector -> vector
signorm (Vector 2 r -> Vector 2 r) -> Vector 2 r -> Vector 2 r
forall a b. (a -> b) -> a -> b
$ r -> r -> Vector 2 r
forall r. r -> r -> Vector 2 r
Vector2 r
y (-r
x)
                      dist :: r
dist                       = r -> r
forall r. Radical r => r -> r
sqrt (r -> r) -> r -> r
forall a b. (a -> b) -> a -> b
$ Slab r side
sSlab r side -> Getting r (Slab r side) r -> r
forall s a. s -> Getting a s a -> a
^.Getting r (Slab r side) r
forall r side (f :: * -> *).
Functor f =>
(r -> f r) -> Slab r side -> f (Slab r side)
squaredWidth
                      p' :: 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
.+^ (r
dist r -> Vector 2 r -> Vector 2 r
forall r vector (d :: Nat).
(Num r, Vector_ vector d r) =>
r -> vector -> vector
*^ Vector 2 r
n)
                        --
                  in (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
p' Vector 2 r
v) LinePV 2 r -> side -> LinePV 2 r :+ side
forall core extra. core -> extra -> core :+ extra
:+ Slab r side
sSlab r side -> Getting side (Slab r side) side -> side
forall s a. s -> Getting a s a -> a
^.Getting side (Slab r side) side
forall r side (f :: * -> *).
Functor f =>
(side -> f side) -> Slab r side -> f (Slab r side)
rightData