{-# LANGUAGE TemplateHaskell #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  HGeometry.Cone
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- A Data type to represent Cones
--
--------------------------------------------------------------------------------
module HGeometry.Cone
  ( Cone(Cone), apex, leftBoundaryVector, rightBoundaryVector
  , leftBoundary, rightBoundary
  , coneBisector
  , intersectingHalfplanes
  ) where

import HGeometry.Vector
import HGeometry.Ext
import HGeometry.HalfLine
import HGeometry.Point
import HGeometry.HalfSpace.Type
import HGeometry.Intersection
import HGeometry.Line
import HGeometry.Properties
import Control.Lens
import Data.Bitraversable
import Data.Bifoldable

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

-- | A Cone
data Cone r point edge = Cone { forall r point edge. Cone r point edge -> point
_apex                :: point
                              , forall r point edge. Cone r point edge -> Vector 2 r :+ edge
_leftBoundaryVector  :: Vector 2 r :+ edge
                              -- ^ the interior of the cone is to the right
                              , forall r point edge. Cone r point edge -> Vector 2 r :+ edge
_rightBoundaryVector :: Vector 2 r :+ edge
                              -- ^ the interior of the cone is to the left
                              }
                       deriving (Int -> Cone r point edge -> ShowS
[Cone r point edge] -> ShowS
Cone r point edge -> String
(Int -> Cone r point edge -> ShowS)
-> (Cone r point edge -> String)
-> ([Cone r point edge] -> ShowS)
-> Show (Cone r point edge)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall r point edge.
(Show point, Show r, Show edge) =>
Int -> Cone r point edge -> ShowS
forall r point edge.
(Show point, Show r, Show edge) =>
[Cone r point edge] -> ShowS
forall r point edge.
(Show point, Show r, Show edge) =>
Cone r point edge -> String
$cshowsPrec :: forall r point edge.
(Show point, Show r, Show edge) =>
Int -> Cone r point edge -> ShowS
showsPrec :: Int -> Cone r point edge -> ShowS
$cshow :: forall r point edge.
(Show point, Show r, Show edge) =>
Cone r point edge -> String
show :: Cone r point edge -> String
$cshowList :: forall r point edge.
(Show point, Show r, Show edge) =>
[Cone r point edge] -> ShowS
showList :: [Cone r point edge] -> ShowS
Show,Cone r point edge -> Cone r point edge -> Bool
(Cone r point edge -> Cone r point edge -> Bool)
-> (Cone r point edge -> Cone r point edge -> Bool)
-> Eq (Cone r point edge)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall r point edge.
(Eq point, Eq r, Eq edge) =>
Cone r point edge -> Cone r point edge -> Bool
$c== :: forall r point edge.
(Eq point, Eq r, Eq edge) =>
Cone r point edge -> Cone r point edge -> Bool
== :: Cone r point edge -> Cone r point edge -> Bool
$c/= :: forall r point edge.
(Eq point, Eq r, Eq edge) =>
Cone r point edge -> Cone r point edge -> Bool
/= :: Cone r point edge -> Cone r point edge -> Bool
Eq,Eq (Cone r point edge)
Eq (Cone r point edge) =>
(Cone r point edge -> Cone r point edge -> Ordering)
-> (Cone r point edge -> Cone r point edge -> Bool)
-> (Cone r point edge -> Cone r point edge -> Bool)
-> (Cone r point edge -> Cone r point edge -> Bool)
-> (Cone r point edge -> Cone r point edge -> Bool)
-> (Cone r point edge -> Cone r point edge -> Cone r point edge)
-> (Cone r point edge -> Cone r point edge -> Cone r point edge)
-> Ord (Cone r point edge)
Cone r point edge -> Cone r point edge -> Bool
Cone r point edge -> Cone r point edge -> Ordering
Cone r point edge -> Cone r point edge -> Cone r point edge
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
forall r point edge.
(Ord point, Ord r, Ord edge) =>
Eq (Cone r point edge)
forall r point edge.
(Ord point, Ord r, Ord edge) =>
Cone r point edge -> Cone r point edge -> Bool
forall r point edge.
(Ord point, Ord r, Ord edge) =>
Cone r point edge -> Cone r point edge -> Ordering
forall r point edge.
(Ord point, Ord r, Ord edge) =>
Cone r point edge -> Cone r point edge -> Cone r point edge
$ccompare :: forall r point edge.
(Ord point, Ord r, Ord edge) =>
Cone r point edge -> Cone r point edge -> Ordering
compare :: Cone r point edge -> Cone r point edge -> Ordering
$c< :: forall r point edge.
(Ord point, Ord r, Ord edge) =>
Cone r point edge -> Cone r point edge -> Bool
< :: Cone r point edge -> Cone r point edge -> Bool
$c<= :: forall r point edge.
(Ord point, Ord r, Ord edge) =>
Cone r point edge -> Cone r point edge -> Bool
<= :: Cone r point edge -> Cone r point edge -> Bool
$c> :: forall r point edge.
(Ord point, Ord r, Ord edge) =>
Cone r point edge -> Cone r point edge -> Bool
> :: Cone r point edge -> Cone r point edge -> Bool
$c>= :: forall r point edge.
(Ord point, Ord r, Ord edge) =>
Cone r point edge -> Cone r point edge -> Bool
>= :: Cone r point edge -> Cone r point edge -> Bool
$cmax :: forall r point edge.
(Ord point, Ord r, Ord edge) =>
Cone r point edge -> Cone r point edge -> Cone r point edge
max :: Cone r point edge -> Cone r point edge -> Cone r point edge
$cmin :: forall r point edge.
(Ord point, Ord r, Ord edge) =>
Cone r point edge -> Cone r point edge -> Cone r point edge
min :: Cone r point edge -> Cone r point edge -> Cone r point edge
Ord,(forall a b. (a -> b) -> Cone r point a -> Cone r point b)
-> (forall a b. a -> Cone r point b -> Cone r point a)
-> Functor (Cone r point)
forall a b. a -> Cone r point b -> Cone r point a
forall a b. (a -> b) -> Cone r point a -> Cone r point b
forall r point a b. a -> Cone r point b -> Cone r point a
forall r point a b. (a -> b) -> Cone r point a -> Cone r point 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 point a b. (a -> b) -> Cone r point a -> Cone r point b
fmap :: forall a b. (a -> b) -> Cone r point a -> Cone r point b
$c<$ :: forall r point a b. a -> Cone r point b -> Cone r point a
<$ :: forall a b. a -> Cone r point b -> Cone r point a
Functor,(forall m. Monoid m => Cone r point m -> m)
-> (forall m a. Monoid m => (a -> m) -> Cone r point a -> m)
-> (forall m a. Monoid m => (a -> m) -> Cone r point a -> m)
-> (forall a b. (a -> b -> b) -> b -> Cone r point a -> b)
-> (forall a b. (a -> b -> b) -> b -> Cone r point a -> b)
-> (forall b a. (b -> a -> b) -> b -> Cone r point a -> b)
-> (forall b a. (b -> a -> b) -> b -> Cone r point a -> b)
-> (forall a. (a -> a -> a) -> Cone r point a -> a)
-> (forall a. (a -> a -> a) -> Cone r point a -> a)
-> (forall a. Cone r point a -> [a])
-> (forall a. Cone r point a -> Bool)
-> (forall a. Cone r point a -> Int)
-> (forall a. Eq a => a -> Cone r point a -> Bool)
-> (forall a. Ord a => Cone r point a -> a)
-> (forall a. Ord a => Cone r point a -> a)
-> (forall a. Num a => Cone r point a -> a)
-> (forall a. Num a => Cone r point a -> a)
-> Foldable (Cone r point)
forall a. Eq a => a -> Cone r point a -> Bool
forall a. Num a => Cone r point a -> a
forall a. Ord a => Cone r point a -> a
forall m. Monoid m => Cone r point m -> m
forall a. Cone r point a -> Bool
forall a. Cone r point a -> Int
forall a. Cone r point a -> [a]
forall a. (a -> a -> a) -> Cone r point a -> a
forall m a. Monoid m => (a -> m) -> Cone r point a -> m
forall b a. (b -> a -> b) -> b -> Cone r point a -> b
forall a b. (a -> b -> b) -> b -> Cone r point a -> b
forall r point a. Eq a => a -> Cone r point a -> Bool
forall r point a. Num a => Cone r point a -> a
forall r point a. Ord a => Cone r point a -> a
forall r point m. Monoid m => Cone r point m -> m
forall r point a. Cone r point a -> Bool
forall r point a. Cone r point a -> Int
forall r point a. Cone r point a -> [a]
forall r point a. (a -> a -> a) -> Cone r point a -> a
forall r point m a. Monoid m => (a -> m) -> Cone r point a -> m
forall r point b a. (b -> a -> b) -> b -> Cone r point a -> b
forall r point a b. (a -> b -> b) -> b -> Cone r point 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 point m. Monoid m => Cone r point m -> m
fold :: forall m. Monoid m => Cone r point m -> m
$cfoldMap :: forall r point m a. Monoid m => (a -> m) -> Cone r point a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Cone r point a -> m
$cfoldMap' :: forall r point m a. Monoid m => (a -> m) -> Cone r point a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Cone r point a -> m
$cfoldr :: forall r point a b. (a -> b -> b) -> b -> Cone r point a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Cone r point a -> b
$cfoldr' :: forall r point a b. (a -> b -> b) -> b -> Cone r point a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Cone r point a -> b
$cfoldl :: forall r point b a. (b -> a -> b) -> b -> Cone r point a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Cone r point a -> b
$cfoldl' :: forall r point b a. (b -> a -> b) -> b -> Cone r point a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Cone r point a -> b
$cfoldr1 :: forall r point a. (a -> a -> a) -> Cone r point a -> a
foldr1 :: forall a. (a -> a -> a) -> Cone r point a -> a
$cfoldl1 :: forall r point a. (a -> a -> a) -> Cone r point a -> a
foldl1 :: forall a. (a -> a -> a) -> Cone r point a -> a
$ctoList :: forall r point a. Cone r point a -> [a]
toList :: forall a. Cone r point a -> [a]
$cnull :: forall r point a. Cone r point a -> Bool
null :: forall a. Cone r point a -> Bool
$clength :: forall r point a. Cone r point a -> Int
length :: forall a. Cone r point a -> Int
$celem :: forall r point a. Eq a => a -> Cone r point a -> Bool
elem :: forall a. Eq a => a -> Cone r point a -> Bool
$cmaximum :: forall r point a. Ord a => Cone r point a -> a
maximum :: forall a. Ord a => Cone r point a -> a
$cminimum :: forall r point a. Ord a => Cone r point a -> a
minimum :: forall a. Ord a => Cone r point a -> a
$csum :: forall r point a. Num a => Cone r point a -> a
sum :: forall a. Num a => Cone r point a -> a
$cproduct :: forall r point a. Num a => Cone r point a -> a
product :: forall a. Num a => Cone r point a -> a
Foldable,Functor (Cone r point)
Foldable (Cone r point)
(Functor (Cone r point), Foldable (Cone r point)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Cone r point a -> f (Cone r point b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Cone r point (f a) -> f (Cone r point a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Cone r point a -> m (Cone r point b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Cone r point (m a) -> m (Cone r point a))
-> Traversable (Cone r point)
forall r point. Functor (Cone r point)
forall r point. Foldable (Cone r point)
forall r point (m :: * -> *) a.
Monad m =>
Cone r point (m a) -> m (Cone r point a)
forall r point (f :: * -> *) a.
Applicative f =>
Cone r point (f a) -> f (Cone r point a)
forall r point (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Cone r point a -> m (Cone r point b)
forall r point (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Cone r point a -> f (Cone r point b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Cone r point (m a) -> m (Cone r point a)
forall (f :: * -> *) a.
Applicative f =>
Cone r point (f a) -> f (Cone r point a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Cone r point a -> m (Cone r point b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Cone r point a -> f (Cone r point b)
$ctraverse :: forall r point (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Cone r point a -> f (Cone r point b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Cone r point a -> f (Cone r point b)
$csequenceA :: forall r point (f :: * -> *) a.
Applicative f =>
Cone r point (f a) -> f (Cone r point a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Cone r point (f a) -> f (Cone r point a)
$cmapM :: forall r point (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Cone r point a -> m (Cone r point b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Cone r point a -> m (Cone r point b)
$csequence :: forall r point (m :: * -> *) a.
Monad m =>
Cone r point (m a) -> m (Cone r point a)
sequence :: forall (m :: * -> *) a.
Monad m =>
Cone r point (m a) -> m (Cone r point a)
Traversable)

makeLenses ''Cone

type instance NumType   (Cone r point edge) = r
type instance Dimension (Cone r point edge) = 2


instance Bifunctor (Cone r) where
  bimap :: forall a b c d. (a -> b) -> (c -> d) -> Cone r a c -> Cone r b d
bimap a -> b
f c -> d
g (Cone a
a Vector 2 r :+ c
l Vector 2 r :+ c
r) = b -> (Vector 2 r :+ d) -> (Vector 2 r :+ d) -> Cone r b d
forall r point edge.
point
-> (Vector 2 r :+ edge)
-> (Vector 2 r :+ edge)
-> Cone r point edge
Cone (a -> b
f a
a) (Vector 2 r :+ c
l(Vector 2 r :+ c)
-> ((Vector 2 r :+ c) -> Vector 2 r :+ d) -> Vector 2 r :+ d
forall a b. a -> (a -> b) -> b
&(c -> Identity d)
-> (Vector 2 r :+ c) -> Identity (Vector 2 r :+ d)
forall core extra extra' (f :: * -> *).
Functor f =>
(extra -> f extra') -> (core :+ extra) -> f (core :+ extra')
extra ((c -> Identity d)
 -> (Vector 2 r :+ c) -> Identity (Vector 2 r :+ d))
-> (c -> d) -> (Vector 2 r :+ c) -> Vector 2 r :+ d
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ c -> d
g) (Vector 2 r :+ c
r(Vector 2 r :+ c)
-> ((Vector 2 r :+ c) -> Vector 2 r :+ d) -> Vector 2 r :+ d
forall a b. a -> (a -> b) -> b
&(c -> Identity d)
-> (Vector 2 r :+ c) -> Identity (Vector 2 r :+ d)
forall core extra extra' (f :: * -> *).
Functor f =>
(extra -> f extra') -> (core :+ extra) -> f (core :+ extra')
extra ((c -> Identity d)
 -> (Vector 2 r :+ c) -> Identity (Vector 2 r :+ d))
-> (c -> d) -> (Vector 2 r :+ c) -> Vector 2 r :+ d
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ c -> d
g)

instance Bifoldable (Cone r) where
  bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> Cone r a b -> m
bifoldMap a -> m
f b -> m
g (Cone a
a Vector 2 r :+ b
l Vector 2 r :+ b
r) = a -> m
f a
a m -> m -> m
forall a. Semigroup a => a -> a -> a
<> b -> m
g (Vector 2 r :+ b
l(Vector 2 r :+ b) -> Getting b (Vector 2 r :+ b) b -> b
forall s a. s -> Getting a s a -> a
^.Getting b (Vector 2 r :+ b) b
forall core extra extra' (f :: * -> *).
Functor f =>
(extra -> f extra') -> (core :+ extra) -> f (core :+ extra')
extra) m -> m -> m
forall a. Semigroup a => a -> a -> a
<> b -> m
g (Vector 2 r :+ b
r(Vector 2 r :+ b) -> Getting b (Vector 2 r :+ b) b -> b
forall s a. s -> Getting a s a -> a
^.Getting b (Vector 2 r :+ b) b
forall core extra extra' (f :: * -> *).
Functor f =>
(extra -> f extra') -> (core :+ extra) -> f (core :+ extra')
extra)

instance Bitraversable (Cone r) where
  bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Cone r a b -> f (Cone r c d)
bitraverse a -> f c
f b -> f d
g (Cone a
a Vector 2 r :+ b
l Vector 2 r :+ b
r) = c -> (Vector 2 r :+ d) -> (Vector 2 r :+ d) -> Cone r c d
forall r point edge.
point
-> (Vector 2 r :+ edge)
-> (Vector 2 r :+ edge)
-> Cone r point edge
Cone (c -> (Vector 2 r :+ d) -> (Vector 2 r :+ d) -> Cone r c d)
-> f c -> f ((Vector 2 r :+ d) -> (Vector 2 r :+ d) -> Cone r c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f c
f a
a f ((Vector 2 r :+ d) -> (Vector 2 r :+ d) -> Cone r c d)
-> f (Vector 2 r :+ d) -> f ((Vector 2 r :+ d) -> Cone r c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Vector 2 r :+ b
l(Vector 2 r :+ b)
-> ((Vector 2 r :+ b) -> f (Vector 2 r :+ d))
-> f (Vector 2 r :+ d)
forall a b. a -> (a -> b) -> b
&(b -> f d) -> (Vector 2 r :+ b) -> f (Vector 2 r :+ d)
forall core extra extra' (f :: * -> *).
Functor f =>
(extra -> f extra') -> (core :+ extra) -> f (core :+ extra')
extra ((b -> f d) -> (Vector 2 r :+ b) -> f (Vector 2 r :+ d))
-> (b -> f d) -> (Vector 2 r :+ b) -> f (Vector 2 r :+ d)
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ b -> f d
g) f ((Vector 2 r :+ d) -> Cone r c d)
-> f (Vector 2 r :+ d) -> f (Cone r c d)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Vector 2 r :+ b
r(Vector 2 r :+ b)
-> ((Vector 2 r :+ b) -> f (Vector 2 r :+ d))
-> f (Vector 2 r :+ d)
forall a b. a -> (a -> b) -> b
&(b -> f d) -> (Vector 2 r :+ b) -> f (Vector 2 r :+ d)
forall core extra extra' (f :: * -> *).
Functor f =>
(extra -> f extra') -> (core :+ extra) -> f (core :+ extra')
extra ((b -> f d) -> (Vector 2 r :+ b) -> f (Vector 2 r :+ d))
-> (b -> f d) -> (Vector 2 r :+ b) -> f (Vector 2 r :+ d)
forall {k} (f :: k -> *) s (t :: k) a (b :: k).
LensLike f s t a b -> LensLike f s t a b
%%~ b -> f d
g)


-- | Get the left boundary as a HalfLine starting at the apex.
leftBoundary   :: ( Dimension point ~ 2, NumType point ~ r)
               => Cone r point edge -> HalfLine point :+ edge
leftBoundary :: forall point r edge.
(Dimension point ~ 2, NumType point ~ r) =>
Cone r point edge -> HalfLine point :+ edge
leftBoundary Cone r point edge
c = (Cone r point edge
cCone r point edge
-> Getting
     (Vector 2 r :+ edge) (Cone r point edge) (Vector 2 r :+ edge)
-> Vector 2 r :+ edge
forall s a. s -> Getting a s a -> a
^.Getting
  (Vector 2 r :+ edge) (Cone r point edge) (Vector 2 r :+ edge)
forall r point edge (f :: * -> *).
Functor f =>
((Vector 2 r :+ edge) -> f (Vector 2 r :+ edge))
-> Cone r point edge -> f (Cone r point edge)
leftBoundaryVector)(Vector 2 r :+ edge)
-> ((Vector 2 r :+ edge) -> HalfLine point :+ edge)
-> HalfLine point :+ edge
forall a b. a -> (a -> b) -> b
&(Vector 2 r -> Identity (HalfLine point))
-> (Vector 2 r :+ edge) -> Identity (HalfLine point :+ edge)
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core ((Vector 2 r -> Identity (HalfLine point))
 -> (Vector 2 r :+ edge) -> Identity (HalfLine point :+ edge))
-> (Vector 2 r -> HalfLine point)
-> (Vector 2 r :+ edge)
-> HalfLine point :+ edge
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ point -> Vector (Dimension point) (NumType point) -> HalfLine point
forall point.
point -> Vector (Dimension point) (NumType point) -> HalfLine point
HalfLine (Cone r point edge
cCone r point edge
-> Getting point (Cone r point edge) point -> point
forall s a. s -> Getting a s a -> a
^.Getting point (Cone r point edge) point
forall r point edge point (f :: * -> *).
Functor f =>
(point -> f point) -> Cone r point edge -> f (Cone r point edge)
apex)

-- | Get the left boundary as a HalfLine starting at the apex.
rightBoundary   :: ( Dimension point ~ 2, NumType point ~ r)
                => Cone r point edge -> HalfLine point :+ edge
rightBoundary :: forall point r edge.
(Dimension point ~ 2, NumType point ~ r) =>
Cone r point edge -> HalfLine point :+ edge
rightBoundary Cone r point edge
c = (Cone r point edge
cCone r point edge
-> Getting
     (Vector 2 r :+ edge) (Cone r point edge) (Vector 2 r :+ edge)
-> Vector 2 r :+ edge
forall s a. s -> Getting a s a -> a
^.Getting
  (Vector 2 r :+ edge) (Cone r point edge) (Vector 2 r :+ edge)
forall r point edge (f :: * -> *).
Functor f =>
((Vector 2 r :+ edge) -> f (Vector 2 r :+ edge))
-> Cone r point edge -> f (Cone r point edge)
rightBoundaryVector)(Vector 2 r :+ edge)
-> ((Vector 2 r :+ edge) -> HalfLine point :+ edge)
-> HalfLine point :+ edge
forall a b. a -> (a -> b) -> b
&(Vector 2 r -> Identity (HalfLine point))
-> (Vector 2 r :+ edge) -> Identity (HalfLine point :+ edge)
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core ((Vector 2 r -> Identity (HalfLine point))
 -> (Vector 2 r :+ edge) -> Identity (HalfLine point :+ edge))
-> (Vector 2 r -> HalfLine point)
-> (Vector 2 r :+ edge)
-> HalfLine point :+ edge
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ point -> Vector (Dimension point) (NumType point) -> HalfLine point
forall point.
point -> Vector (Dimension point) (NumType point) -> HalfLine point
HalfLine (Cone r point edge
cCone r point edge
-> Getting point (Cone r point edge) point -> point
forall s a. s -> Getting a s a -> a
^.Getting point (Cone r point edge) point
forall r point edge point (f :: * -> *).
Functor f =>
(point -> f point) -> Cone r point edge -> f (Cone r point edge)
apex)


-- | Get the bisector of the cone
coneBisector   :: (Point_ point 2 r, Num r) => Cone r point edge -> HalfLine point
coneBisector :: forall point r edge.
(Point_ point 2 r, Num r) =>
Cone r point edge -> HalfLine point
coneBisector Cone r point edge
c = point -> Vector (Dimension point) (NumType point) -> HalfLine point
forall point.
point -> Vector (Dimension point) (NumType point) -> HalfLine point
HalfLine (Cone r point edge
cCone r point edge
-> Getting point (Cone r point edge) point -> point
forall s a. s -> Getting a s a -> a
^.Getting point (Cone r point edge) point
forall r point edge point (f :: * -> *).
Functor f =>
(point -> f point) -> Cone r point edge -> f (Cone r point edge)
apex)
                         ((Cone r point edge
cCone r point edge
-> Getting (Vector 2 r) (Cone r point edge) (Vector 2 r)
-> Vector 2 r
forall s a. s -> Getting a s a -> a
^.((Vector 2 r :+ edge) -> Const (Vector 2 r) (Vector 2 r :+ edge))
-> Cone r point edge -> Const (Vector 2 r) (Cone r point edge)
forall r point edge (f :: * -> *).
Functor f =>
((Vector 2 r :+ edge) -> f (Vector 2 r :+ edge))
-> Cone r point edge -> f (Cone r point edge)
leftBoundaryVector(((Vector 2 r :+ edge) -> Const (Vector 2 r) (Vector 2 r :+ edge))
 -> Cone r point edge -> Const (Vector 2 r) (Cone r point edge))
-> ((Vector 2 r -> Const (Vector 2 r) (Vector 2 r))
    -> (Vector 2 r :+ edge) -> Const (Vector 2 r) (Vector 2 r :+ edge))
-> Getting (Vector 2 r) (Cone r point edge) (Vector 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vector 2 r -> Const (Vector 2 r) (Vector 2 r))
-> (Vector 2 r :+ edge) -> Const (Vector 2 r) (Vector 2 r :+ edge)
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core) Vector 2 r -> Vector 2 r -> Vector 2 r
forall r vector (d :: Nat).
(Num r, Additive_ vector d r) =>
vector -> vector -> vector
^+^ (Cone r point edge
cCone r point edge
-> Getting (Vector 2 r) (Cone r point edge) (Vector 2 r)
-> Vector 2 r
forall s a. s -> Getting a s a -> a
^.((Vector 2 r :+ edge) -> Const (Vector 2 r) (Vector 2 r :+ edge))
-> Cone r point edge -> Const (Vector 2 r) (Cone r point edge)
forall r point edge (f :: * -> *).
Functor f =>
((Vector 2 r :+ edge) -> f (Vector 2 r :+ edge))
-> Cone r point edge -> f (Cone r point edge)
rightBoundaryVector(((Vector 2 r :+ edge) -> Const (Vector 2 r) (Vector 2 r :+ edge))
 -> Cone r point edge -> Const (Vector 2 r) (Cone r point edge))
-> ((Vector 2 r -> Const (Vector 2 r) (Vector 2 r))
    -> (Vector 2 r :+ edge) -> Const (Vector 2 r) (Vector 2 r :+ edge))
-> Getting (Vector 2 r) (Cone r point edge) (Vector 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vector 2 r -> Const (Vector 2 r) (Vector 2 r))
-> (Vector 2 r :+ edge) -> Const (Vector 2 r) (Vector 2 r :+ edge)
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core))

-- | Get the two halfplanes so that the cone is the intersection of the two halfplanes.
-- the first halfplane is the plane right of the left boundary, whereas the
-- second halfplane is the plane left of the right boundary.
intersectingHalfplanes   :: ( Point_ point 2 r, Num r, Ord r)
                         => Cone r point edge -> Vector 2 (HalfSpaceF (LinePV 2 r))
intersectingHalfplanes :: forall point r edge.
(Point_ point 2 r, Num r, Ord r) =>
Cone r point edge -> Vector 2 (HalfSpaceF (LinePV 2 r))
intersectingHalfplanes Cone r point edge
c = HalfSpaceF (LinePV 2 r)
-> HalfSpaceF (LinePV 2 r) -> Vector 2 (HalfSpaceF (LinePV 2 r))
forall r. r -> r -> Vector 2 r
Vector2 (LinePV 2 r -> HalfSpaceF (LinePV 2 r)
forall r. (Num r, Ord r) => LinePV 2 r -> HalfSpaceF (LinePV 2 r)
rightHalfPlane (LinePV 2 r -> HalfSpaceF (LinePV 2 r))
-> LinePV 2 r -> HalfSpaceF (LinePV 2 r)
forall a b. (a -> b) -> a -> b
$ 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
a Vector 2 r
leftB)
                                   (LinePV 2 r -> HalfSpaceF (LinePV 2 r)
forall r. (Num r, Ord r) => LinePV 2 r -> HalfSpaceF (LinePV 2 r)
leftHalfPlane  (LinePV 2 r -> HalfSpaceF (LinePV 2 r))
-> LinePV 2 r -> HalfSpaceF (LinePV 2 r)
forall a b. (a -> b) -> a -> b
$ 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
a Vector 2 r
rightB)
  where
    a :: Point 2 r
a      = Cone r point edge
cCone r point edge
-> Getting (Point 2 r) (Cone r point edge) (Point 2 r) -> Point 2 r
forall s a. s -> Getting a s a -> a
^.(point -> Const (Point 2 r) point)
-> Cone r point edge -> Const (Point 2 r) (Cone r point edge)
forall r point edge point (f :: * -> *).
Functor f =>
(point -> f point) -> Cone r point edge -> f (Cone r point edge)
apex((point -> Const (Point 2 r) point)
 -> Cone r point edge -> Const (Point 2 r) (Cone r point edge))
-> ((Point 2 r -> Const (Point 2 r) (Point 2 r))
    -> point -> Const (Point 2 r) point)
-> Getting (Point 2 r) (Cone r point edge) (Point 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point 2 r -> Const (Point 2 r) (Point 2 r))
-> point -> Const (Point 2 r) point
forall point (d :: Nat) r.
Point_ point d r =>
Lens' point (Point d r)
Lens' point (Point 2 r)
asPoint
    leftB :: Vector 2 r
leftB  = Cone r point edge
cCone r point edge
-> Getting (Vector 2 r) (Cone r point edge) (Vector 2 r)
-> Vector 2 r
forall s a. s -> Getting a s a -> a
^.((Vector 2 r :+ edge) -> Const (Vector 2 r) (Vector 2 r :+ edge))
-> Cone r point edge -> Const (Vector 2 r) (Cone r point edge)
forall r point edge (f :: * -> *).
Functor f =>
((Vector 2 r :+ edge) -> f (Vector 2 r :+ edge))
-> Cone r point edge -> f (Cone r point edge)
leftBoundaryVector(((Vector 2 r :+ edge) -> Const (Vector 2 r) (Vector 2 r :+ edge))
 -> Cone r point edge -> Const (Vector 2 r) (Cone r point edge))
-> ((Vector 2 r -> Const (Vector 2 r) (Vector 2 r))
    -> (Vector 2 r :+ edge) -> Const (Vector 2 r) (Vector 2 r :+ edge))
-> Getting (Vector 2 r) (Cone r point edge) (Vector 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vector 2 r -> Const (Vector 2 r) (Vector 2 r))
-> (Vector 2 r :+ edge) -> Const (Vector 2 r) (Vector 2 r :+ edge)
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core
    rightB :: Vector 2 r
rightB = Cone r point edge
cCone r point edge
-> Getting (Vector 2 r) (Cone r point edge) (Vector 2 r)
-> Vector 2 r
forall s a. s -> Getting a s a -> a
^.((Vector 2 r :+ edge) -> Const (Vector 2 r) (Vector 2 r :+ edge))
-> Cone r point edge -> Const (Vector 2 r) (Cone r point edge)
forall r point edge (f :: * -> *).
Functor f =>
((Vector 2 r :+ edge) -> f (Vector 2 r :+ edge))
-> Cone r point edge -> f (Cone r point edge)
rightBoundaryVector(((Vector 2 r :+ edge) -> Const (Vector 2 r) (Vector 2 r :+ edge))
 -> Cone r point edge -> Const (Vector 2 r) (Cone r point edge))
-> ((Vector 2 r -> Const (Vector 2 r) (Vector 2 r))
    -> (Vector 2 r :+ edge) -> Const (Vector 2 r) (Vector 2 r :+ edge))
-> Getting (Vector 2 r) (Cone r point edge) (Vector 2 r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vector 2 r -> Const (Vector 2 r) (Vector 2 r))
-> (Vector 2 r :+ edge) -> Const (Vector 2 r) (Vector 2 r :+ edge)
forall core extra core' (f :: * -> *).
Functor f =>
(core -> f core') -> (core :+ extra) -> f (core' :+ extra)
core
{-# INLINE intersectingHalfplanes #-}

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

instance ( Point_ point 2 r, Num r, Ord r
         ) => Point 2 r `HasIntersectionWith` Cone r point edge where
  Point 2 r
q intersects :: Point 2 r -> Cone r point edge -> Bool
`intersects` Cone r point edge
cone = (HalfSpaceF (LinePV 2 r) -> Bool)
-> Vector 2 (HalfSpaceF (LinePV 2 r)) -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Point 2 r
q Point 2 r -> HalfSpaceF (LinePV 2 r) -> Bool
forall g h. HasIntersectionWith g h => g -> h -> Bool
`intersects`) (Cone r point edge -> Vector 2 (HalfSpaceF (LinePV 2 r))
forall point r edge.
(Point_ point 2 r, Num r, Ord r) =>
Cone r point edge -> Vector 2 (HalfSpaceF (LinePV 2 r))
intersectingHalfplanes Cone r point edge
cone)
  {-# INLINE intersects #-}