{-# LANGUAGE TemplateHaskell  #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE InstanceSigs  #-}
--------------------------------------------------------------------------------
-- |
-- Module      :  Data.Geometry.Box.Internal
-- Copyright   :  (C) Frank Staals
-- License     :  see the LICENSE file
-- Maintainer  :  Frank Staals
--
-- Orthogonal \(d\)-dimensiontal boxes (e.g. rectangles)
--
--------------------------------------------------------------------------------
module Data.Geometry.Box.Internal where

import           Control.DeepSeq
import           Control.Lens
import           Data.Bifoldable
import           Data.Bifunctor
import           Data.Bitraversable
import           Data.Ext
import qualified Data.Foldable as F
import           Data.Geometry.Point
import           Data.Geometry.Properties
import           Data.Geometry.Transformation
import           Data.Geometry.Vector
import qualified Data.Geometry.Vector as V
import qualified Data.List.NonEmpty as NE
import qualified Data.Range as R
import qualified Data.Semigroup.Foldable as F
import qualified Data.Vector.Fixed as FV
import           Data.Vinyl.CoRec (asA)
import           GHC.Generics (Generic)
import           GHC.TypeLits
import           Test.QuickCheck (Arbitrary(..))

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

-- | Coordinate wize minimum
newtype CWMin a = CWMin { CWMin a -> a
_cwMin :: a }
                deriving (Int -> CWMin a -> ShowS
[CWMin a] -> ShowS
CWMin a -> String
(Int -> CWMin a -> ShowS)
-> (CWMin a -> String) -> ([CWMin a] -> ShowS) -> Show (CWMin a)
forall a. Show a => Int -> CWMin a -> ShowS
forall a. Show a => [CWMin a] -> ShowS
forall a. Show a => CWMin a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CWMin a] -> ShowS
$cshowList :: forall a. Show a => [CWMin a] -> ShowS
show :: CWMin a -> String
$cshow :: forall a. Show a => CWMin a -> String
showsPrec :: Int -> CWMin a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CWMin a -> ShowS
Show,CWMin a -> CWMin a -> Bool
(CWMin a -> CWMin a -> Bool)
-> (CWMin a -> CWMin a -> Bool) -> Eq (CWMin a)
forall a. Eq a => CWMin a -> CWMin a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CWMin a -> CWMin a -> Bool
$c/= :: forall a. Eq a => CWMin a -> CWMin a -> Bool
== :: CWMin a -> CWMin a -> Bool
$c== :: forall a. Eq a => CWMin a -> CWMin a -> Bool
Eq,Eq (CWMin a)
Eq (CWMin a)
-> (CWMin a -> CWMin a -> Ordering)
-> (CWMin a -> CWMin a -> Bool)
-> (CWMin a -> CWMin a -> Bool)
-> (CWMin a -> CWMin a -> Bool)
-> (CWMin a -> CWMin a -> Bool)
-> (CWMin a -> CWMin a -> CWMin a)
-> (CWMin a -> CWMin a -> CWMin a)
-> Ord (CWMin a)
CWMin a -> CWMin a -> Bool
CWMin a -> CWMin a -> Ordering
CWMin a -> CWMin a -> CWMin a
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 a. Ord a => Eq (CWMin a)
forall a. Ord a => CWMin a -> CWMin a -> Bool
forall a. Ord a => CWMin a -> CWMin a -> Ordering
forall a. Ord a => CWMin a -> CWMin a -> CWMin a
min :: CWMin a -> CWMin a -> CWMin a
$cmin :: forall a. Ord a => CWMin a -> CWMin a -> CWMin a
max :: CWMin a -> CWMin a -> CWMin a
$cmax :: forall a. Ord a => CWMin a -> CWMin a -> CWMin a
>= :: CWMin a -> CWMin a -> Bool
$c>= :: forall a. Ord a => CWMin a -> CWMin a -> Bool
> :: CWMin a -> CWMin a -> Bool
$c> :: forall a. Ord a => CWMin a -> CWMin a -> Bool
<= :: CWMin a -> CWMin a -> Bool
$c<= :: forall a. Ord a => CWMin a -> CWMin a -> Bool
< :: CWMin a -> CWMin a -> Bool
$c< :: forall a. Ord a => CWMin a -> CWMin a -> Bool
compare :: CWMin a -> CWMin a -> Ordering
$ccompare :: forall a. Ord a => CWMin a -> CWMin a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (CWMin a)
Ord,a -> CWMin b -> CWMin a
(a -> b) -> CWMin a -> CWMin b
(forall a b. (a -> b) -> CWMin a -> CWMin b)
-> (forall a b. a -> CWMin b -> CWMin a) -> Functor CWMin
forall a b. a -> CWMin b -> CWMin a
forall a b. (a -> b) -> CWMin a -> CWMin b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CWMin b -> CWMin a
$c<$ :: forall a b. a -> CWMin b -> CWMin a
fmap :: (a -> b) -> CWMin a -> CWMin b
$cfmap :: forall a b. (a -> b) -> CWMin a -> CWMin b
Functor,CWMin a -> Bool
(a -> m) -> CWMin a -> m
(a -> b -> b) -> b -> CWMin a -> b
(forall m. Monoid m => CWMin m -> m)
-> (forall m a. Monoid m => (a -> m) -> CWMin a -> m)
-> (forall m a. Monoid m => (a -> m) -> CWMin a -> m)
-> (forall a b. (a -> b -> b) -> b -> CWMin a -> b)
-> (forall a b. (a -> b -> b) -> b -> CWMin a -> b)
-> (forall b a. (b -> a -> b) -> b -> CWMin a -> b)
-> (forall b a. (b -> a -> b) -> b -> CWMin a -> b)
-> (forall a. (a -> a -> a) -> CWMin a -> a)
-> (forall a. (a -> a -> a) -> CWMin a -> a)
-> (forall a. CWMin a -> [a])
-> (forall a. CWMin a -> Bool)
-> (forall a. CWMin a -> Int)
-> (forall a. Eq a => a -> CWMin a -> Bool)
-> (forall a. Ord a => CWMin a -> a)
-> (forall a. Ord a => CWMin a -> a)
-> (forall a. Num a => CWMin a -> a)
-> (forall a. Num a => CWMin a -> a)
-> Foldable CWMin
forall a. Eq a => a -> CWMin a -> Bool
forall a. Num a => CWMin a -> a
forall a. Ord a => CWMin a -> a
forall m. Monoid m => CWMin m -> m
forall a. CWMin a -> Bool
forall a. CWMin a -> Int
forall a. CWMin a -> [a]
forall a. (a -> a -> a) -> CWMin a -> a
forall m a. Monoid m => (a -> m) -> CWMin a -> m
forall b a. (b -> a -> b) -> b -> CWMin a -> b
forall a b. (a -> b -> b) -> b -> CWMin 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
product :: CWMin a -> a
$cproduct :: forall a. Num a => CWMin a -> a
sum :: CWMin a -> a
$csum :: forall a. Num a => CWMin a -> a
minimum :: CWMin a -> a
$cminimum :: forall a. Ord a => CWMin a -> a
maximum :: CWMin a -> a
$cmaximum :: forall a. Ord a => CWMin a -> a
elem :: a -> CWMin a -> Bool
$celem :: forall a. Eq a => a -> CWMin a -> Bool
length :: CWMin a -> Int
$clength :: forall a. CWMin a -> Int
null :: CWMin a -> Bool
$cnull :: forall a. CWMin a -> Bool
toList :: CWMin a -> [a]
$ctoList :: forall a. CWMin a -> [a]
foldl1 :: (a -> a -> a) -> CWMin a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> CWMin a -> a
foldr1 :: (a -> a -> a) -> CWMin a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> CWMin a -> a
foldl' :: (b -> a -> b) -> b -> CWMin a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> CWMin a -> b
foldl :: (b -> a -> b) -> b -> CWMin a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> CWMin a -> b
foldr' :: (a -> b -> b) -> b -> CWMin a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> CWMin a -> b
foldr :: (a -> b -> b) -> b -> CWMin a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> CWMin a -> b
foldMap' :: (a -> m) -> CWMin a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> CWMin a -> m
foldMap :: (a -> m) -> CWMin a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> CWMin a -> m
fold :: CWMin m -> m
$cfold :: forall m. Monoid m => CWMin m -> m
Foldable,Functor CWMin
Foldable CWMin
Functor CWMin
-> Foldable CWMin
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> CWMin a -> f (CWMin b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    CWMin (f a) -> f (CWMin a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> CWMin a -> m (CWMin b))
-> (forall (m :: * -> *) a. Monad m => CWMin (m a) -> m (CWMin a))
-> Traversable CWMin
(a -> f b) -> CWMin a -> f (CWMin 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 => CWMin (m a) -> m (CWMin a)
forall (f :: * -> *) a. Applicative f => CWMin (f a) -> f (CWMin a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CWMin a -> m (CWMin b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CWMin a -> f (CWMin b)
sequence :: CWMin (m a) -> m (CWMin a)
$csequence :: forall (m :: * -> *) a. Monad m => CWMin (m a) -> m (CWMin a)
mapM :: (a -> m b) -> CWMin a -> m (CWMin b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CWMin a -> m (CWMin b)
sequenceA :: CWMin (f a) -> f (CWMin a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => CWMin (f a) -> f (CWMin a)
traverse :: (a -> f b) -> CWMin a -> f (CWMin b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CWMin a -> f (CWMin b)
$cp2Traversable :: Foldable CWMin
$cp1Traversable :: Functor CWMin
Traversable,(forall x. CWMin a -> Rep (CWMin a) x)
-> (forall x. Rep (CWMin a) x -> CWMin a) -> Generic (CWMin a)
forall x. Rep (CWMin a) x -> CWMin a
forall x. CWMin a -> Rep (CWMin a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (CWMin a) x -> CWMin a
forall a x. CWMin a -> Rep (CWMin a) x
$cto :: forall a x. Rep (CWMin a) x -> CWMin a
$cfrom :: forall a x. CWMin a -> Rep (CWMin a) x
Generic,CWMin a -> ()
(CWMin a -> ()) -> NFData (CWMin a)
forall a. NFData a => CWMin a -> ()
forall a. (a -> ()) -> NFData a
rnf :: CWMin a -> ()
$crnf :: forall a. NFData a => CWMin a -> ()
NFData)
makeLenses ''CWMin

instance (Arity d, Ord r) => Semigroup (CWMin (Point d r)) where
  (CWMin Point d r
p) <> :: CWMin (Point d r) -> CWMin (Point d r) -> CWMin (Point d r)
<> (CWMin Point d r
q) = Point d r -> CWMin (Point d r)
forall a. a -> CWMin a
CWMin (Point d r -> CWMin (Point d r))
-> (Vector d r -> Point d r) -> Vector d r -> CWMin (Point d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector d r -> Point d r
forall (d :: Nat) r. Vector d r -> Point d r
Point (Vector d r -> CWMin (Point d r))
-> Vector d r -> CWMin (Point d r)
forall a b. (a -> b) -> a -> b
$ (r -> r -> r) -> Vector d r -> Vector d r -> Vector d r
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
FV.zipWith r -> r -> r
forall a. Ord a => a -> a -> a
min (Point d r
pPoint d r
-> Getting (Vector d r) (Point d r) (Vector d r) -> Vector d r
forall s a. s -> Getting a s a -> a
^.Getting (Vector d r) (Point d r) (Vector d r)
forall (d :: Nat) r r'.
Lens (Point d r) (Point d r') (Vector d r) (Vector d r')
vector) (Point d r
qPoint d r
-> Getting (Vector d r) (Point d r) (Vector d r) -> Vector d r
forall s a. s -> Getting a s a -> a
^.Getting (Vector d r) (Point d r) (Vector d r)
forall (d :: Nat) r r'.
Lens (Point d r) (Point d r') (Vector d r) (Vector d r')
vector)

-- | Coordinate wize maximum
newtype CWMax a = CWMax { CWMax a -> a
_cwMax :: a }
                deriving (Int -> CWMax a -> ShowS
[CWMax a] -> ShowS
CWMax a -> String
(Int -> CWMax a -> ShowS)
-> (CWMax a -> String) -> ([CWMax a] -> ShowS) -> Show (CWMax a)
forall a. Show a => Int -> CWMax a -> ShowS
forall a. Show a => [CWMax a] -> ShowS
forall a. Show a => CWMax a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CWMax a] -> ShowS
$cshowList :: forall a. Show a => [CWMax a] -> ShowS
show :: CWMax a -> String
$cshow :: forall a. Show a => CWMax a -> String
showsPrec :: Int -> CWMax a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> CWMax a -> ShowS
Show,CWMax a -> CWMax a -> Bool
(CWMax a -> CWMax a -> Bool)
-> (CWMax a -> CWMax a -> Bool) -> Eq (CWMax a)
forall a. Eq a => CWMax a -> CWMax a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CWMax a -> CWMax a -> Bool
$c/= :: forall a. Eq a => CWMax a -> CWMax a -> Bool
== :: CWMax a -> CWMax a -> Bool
$c== :: forall a. Eq a => CWMax a -> CWMax a -> Bool
Eq,Eq (CWMax a)
Eq (CWMax a)
-> (CWMax a -> CWMax a -> Ordering)
-> (CWMax a -> CWMax a -> Bool)
-> (CWMax a -> CWMax a -> Bool)
-> (CWMax a -> CWMax a -> Bool)
-> (CWMax a -> CWMax a -> Bool)
-> (CWMax a -> CWMax a -> CWMax a)
-> (CWMax a -> CWMax a -> CWMax a)
-> Ord (CWMax a)
CWMax a -> CWMax a -> Bool
CWMax a -> CWMax a -> Ordering
CWMax a -> CWMax a -> CWMax a
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 a. Ord a => Eq (CWMax a)
forall a. Ord a => CWMax a -> CWMax a -> Bool
forall a. Ord a => CWMax a -> CWMax a -> Ordering
forall a. Ord a => CWMax a -> CWMax a -> CWMax a
min :: CWMax a -> CWMax a -> CWMax a
$cmin :: forall a. Ord a => CWMax a -> CWMax a -> CWMax a
max :: CWMax a -> CWMax a -> CWMax a
$cmax :: forall a. Ord a => CWMax a -> CWMax a -> CWMax a
>= :: CWMax a -> CWMax a -> Bool
$c>= :: forall a. Ord a => CWMax a -> CWMax a -> Bool
> :: CWMax a -> CWMax a -> Bool
$c> :: forall a. Ord a => CWMax a -> CWMax a -> Bool
<= :: CWMax a -> CWMax a -> Bool
$c<= :: forall a. Ord a => CWMax a -> CWMax a -> Bool
< :: CWMax a -> CWMax a -> Bool
$c< :: forall a. Ord a => CWMax a -> CWMax a -> Bool
compare :: CWMax a -> CWMax a -> Ordering
$ccompare :: forall a. Ord a => CWMax a -> CWMax a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (CWMax a)
Ord,a -> CWMax b -> CWMax a
(a -> b) -> CWMax a -> CWMax b
(forall a b. (a -> b) -> CWMax a -> CWMax b)
-> (forall a b. a -> CWMax b -> CWMax a) -> Functor CWMax
forall a b. a -> CWMax b -> CWMax a
forall a b. (a -> b) -> CWMax a -> CWMax b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> CWMax b -> CWMax a
$c<$ :: forall a b. a -> CWMax b -> CWMax a
fmap :: (a -> b) -> CWMax a -> CWMax b
$cfmap :: forall a b. (a -> b) -> CWMax a -> CWMax b
Functor,CWMax a -> Bool
(a -> m) -> CWMax a -> m
(a -> b -> b) -> b -> CWMax a -> b
(forall m. Monoid m => CWMax m -> m)
-> (forall m a. Monoid m => (a -> m) -> CWMax a -> m)
-> (forall m a. Monoid m => (a -> m) -> CWMax a -> m)
-> (forall a b. (a -> b -> b) -> b -> CWMax a -> b)
-> (forall a b. (a -> b -> b) -> b -> CWMax a -> b)
-> (forall b a. (b -> a -> b) -> b -> CWMax a -> b)
-> (forall b a. (b -> a -> b) -> b -> CWMax a -> b)
-> (forall a. (a -> a -> a) -> CWMax a -> a)
-> (forall a. (a -> a -> a) -> CWMax a -> a)
-> (forall a. CWMax a -> [a])
-> (forall a. CWMax a -> Bool)
-> (forall a. CWMax a -> Int)
-> (forall a. Eq a => a -> CWMax a -> Bool)
-> (forall a. Ord a => CWMax a -> a)
-> (forall a. Ord a => CWMax a -> a)
-> (forall a. Num a => CWMax a -> a)
-> (forall a. Num a => CWMax a -> a)
-> Foldable CWMax
forall a. Eq a => a -> CWMax a -> Bool
forall a. Num a => CWMax a -> a
forall a. Ord a => CWMax a -> a
forall m. Monoid m => CWMax m -> m
forall a. CWMax a -> Bool
forall a. CWMax a -> Int
forall a. CWMax a -> [a]
forall a. (a -> a -> a) -> CWMax a -> a
forall m a. Monoid m => (a -> m) -> CWMax a -> m
forall b a. (b -> a -> b) -> b -> CWMax a -> b
forall a b. (a -> b -> b) -> b -> CWMax 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
product :: CWMax a -> a
$cproduct :: forall a. Num a => CWMax a -> a
sum :: CWMax a -> a
$csum :: forall a. Num a => CWMax a -> a
minimum :: CWMax a -> a
$cminimum :: forall a. Ord a => CWMax a -> a
maximum :: CWMax a -> a
$cmaximum :: forall a. Ord a => CWMax a -> a
elem :: a -> CWMax a -> Bool
$celem :: forall a. Eq a => a -> CWMax a -> Bool
length :: CWMax a -> Int
$clength :: forall a. CWMax a -> Int
null :: CWMax a -> Bool
$cnull :: forall a. CWMax a -> Bool
toList :: CWMax a -> [a]
$ctoList :: forall a. CWMax a -> [a]
foldl1 :: (a -> a -> a) -> CWMax a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> CWMax a -> a
foldr1 :: (a -> a -> a) -> CWMax a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> CWMax a -> a
foldl' :: (b -> a -> b) -> b -> CWMax a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> CWMax a -> b
foldl :: (b -> a -> b) -> b -> CWMax a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> CWMax a -> b
foldr' :: (a -> b -> b) -> b -> CWMax a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> CWMax a -> b
foldr :: (a -> b -> b) -> b -> CWMax a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> CWMax a -> b
foldMap' :: (a -> m) -> CWMax a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> CWMax a -> m
foldMap :: (a -> m) -> CWMax a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> CWMax a -> m
fold :: CWMax m -> m
$cfold :: forall m. Monoid m => CWMax m -> m
Foldable,Functor CWMax
Foldable CWMax
Functor CWMax
-> Foldable CWMax
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> CWMax a -> f (CWMax b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    CWMax (f a) -> f (CWMax a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> CWMax a -> m (CWMax b))
-> (forall (m :: * -> *) a. Monad m => CWMax (m a) -> m (CWMax a))
-> Traversable CWMax
(a -> f b) -> CWMax a -> f (CWMax 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 => CWMax (m a) -> m (CWMax a)
forall (f :: * -> *) a. Applicative f => CWMax (f a) -> f (CWMax a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CWMax a -> m (CWMax b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CWMax a -> f (CWMax b)
sequence :: CWMax (m a) -> m (CWMax a)
$csequence :: forall (m :: * -> *) a. Monad m => CWMax (m a) -> m (CWMax a)
mapM :: (a -> m b) -> CWMax a -> m (CWMax b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CWMax a -> m (CWMax b)
sequenceA :: CWMax (f a) -> f (CWMax a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => CWMax (f a) -> f (CWMax a)
traverse :: (a -> f b) -> CWMax a -> f (CWMax b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CWMax a -> f (CWMax b)
$cp2Traversable :: Foldable CWMax
$cp1Traversable :: Functor CWMax
Traversable,(forall x. CWMax a -> Rep (CWMax a) x)
-> (forall x. Rep (CWMax a) x -> CWMax a) -> Generic (CWMax a)
forall x. Rep (CWMax a) x -> CWMax a
forall x. CWMax a -> Rep (CWMax a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (CWMax a) x -> CWMax a
forall a x. CWMax a -> Rep (CWMax a) x
$cto :: forall a x. Rep (CWMax a) x -> CWMax a
$cfrom :: forall a x. CWMax a -> Rep (CWMax a) x
Generic,CWMax a -> ()
(CWMax a -> ()) -> NFData (CWMax a)
forall a. NFData a => CWMax a -> ()
forall a. (a -> ()) -> NFData a
rnf :: CWMax a -> ()
$crnf :: forall a. NFData a => CWMax a -> ()
NFData)
makeLenses ''CWMax

instance (Arity d, Ord r) => Semigroup (CWMax (Point d r)) where
  (CWMax Point d r
p) <> :: CWMax (Point d r) -> CWMax (Point d r) -> CWMax (Point d r)
<> (CWMax Point d r
q) = Point d r -> CWMax (Point d r)
forall a. a -> CWMax a
CWMax (Point d r -> CWMax (Point d r))
-> (Vector d r -> Point d r) -> Vector d r -> CWMax (Point d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector d r -> Point d r
forall (d :: Nat) r. Vector d r -> Point d r
Point (Vector d r -> CWMax (Point d r))
-> Vector d r -> CWMax (Point d r)
forall a b. (a -> b) -> a -> b
$ (r -> r -> r) -> Vector d r -> Vector d r -> Vector d r
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
FV.zipWith r -> r -> r
forall a. Ord a => a -> a -> a
max (Point d r
pPoint d r
-> Getting (Vector d r) (Point d r) (Vector d r) -> Vector d r
forall s a. s -> Getting a s a -> a
^.Getting (Vector d r) (Point d r) (Vector d r)
forall (d :: Nat) r r'.
Lens (Point d r) (Point d r') (Vector d r) (Vector d r')
vector) (Point d r
qPoint d r
-> Getting (Vector d r) (Point d r) (Vector d r) -> Vector d r
forall s a. s -> Getting a s a -> a
^.Getting (Vector d r) (Point d r) (Vector d r)
forall (d :: Nat) r r'.
Lens (Point d r) (Point d r') (Vector d r) (Vector d r')
vector)


--------------------------------------------------------------------------------
-- * d-dimensional boxes


data Box d p r = Box { Box d p r -> CWMin (Point d r) :+ p
_minP :: !(CWMin (Point d r) :+ p)
                     , Box d p r -> CWMax (Point d r) :+ p
_maxP :: !(CWMax (Point d r) :+ p)
                     } deriving (forall x. Box d p r -> Rep (Box d p r) x)
-> (forall x. Rep (Box d p r) x -> Box d p r)
-> Generic (Box d p r)
forall x. Rep (Box d p r) x -> Box d p r
forall x. Box d p r -> Rep (Box d p r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (d :: Nat) p r x. Rep (Box d p r) x -> Box d p r
forall (d :: Nat) p r x. Box d p r -> Rep (Box d p r) x
$cto :: forall (d :: Nat) p r x. Rep (Box d p r) x -> Box d p r
$cfrom :: forall (d :: Nat) p r x. Box d p r -> Rep (Box d p r) x
Generic
makeLenses ''Box





-- | Given the point with the lowest coordinates and the point with highest
-- coordinates, create a box.
box          :: Point d r :+ p -> Point d r :+ p -> Box d p r
box :: (Point d r :+ p) -> (Point d r :+ p) -> Box d p r
box Point d r :+ p
low Point d r :+ p
high = (CWMin (Point d r) :+ p) -> (CWMax (Point d r) :+ p) -> Box d p r
forall (d :: Nat) p r.
(CWMin (Point d r) :+ p) -> (CWMax (Point d r) :+ p) -> Box d p r
Box (Point d r :+ p
low(Point d r :+ p)
-> ((Point d r :+ p) -> CWMin (Point d r) :+ p)
-> CWMin (Point d r) :+ p
forall a b. a -> (a -> b) -> b
&(Point d r -> Identity (CWMin (Point d r)))
-> (Point d r :+ p) -> Identity (CWMin (Point d r) :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((Point d r -> Identity (CWMin (Point d r)))
 -> (Point d r :+ p) -> Identity (CWMin (Point d r) :+ p))
-> (Point d r -> CWMin (Point d r))
-> (Point d r :+ p)
-> CWMin (Point d r) :+ p
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Point d r -> CWMin (Point d r)
forall a. a -> CWMin a
CWMin) (Point d r :+ p
high(Point d r :+ p)
-> ((Point d r :+ p) -> CWMax (Point d r) :+ p)
-> CWMax (Point d r) :+ p
forall a b. a -> (a -> b) -> b
&(Point d r -> Identity (CWMax (Point d r)))
-> (Point d r :+ p) -> Identity (CWMax (Point d r) :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core ((Point d r -> Identity (CWMax (Point d r)))
 -> (Point d r :+ p) -> Identity (CWMax (Point d r) :+ p))
-> (Point d r -> CWMax (Point d r))
-> (Point d r :+ p)
-> CWMax (Point d r) :+ p
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Point d r -> CWMax (Point d r)
forall a. a -> CWMax a
CWMax)

-- | grows the box by x on all sides
grow     :: (Num r, Arity d) => r -> Box d p r -> Box d p r
grow :: r -> Box d p r -> Box d p r
grow r
x Box d p r
b = let v :: Vector d r
v = r -> Vector d r
forall (v :: * -> *) a. Vector v a => a -> v a
V.replicate r
x
           in Box d p r
bBox d p r -> (Box d p r -> Box d p r) -> Box d p r
forall a b. a -> (a -> b) -> b
&((CWMin (Point d r) :+ p) -> Identity (CWMin (Point d r) :+ p))
-> Box d p r -> Identity (Box d p r)
forall (d :: Nat) p r. Lens' (Box d p r) (CWMin (Point d r) :+ p)
minP(((CWMin (Point d r) :+ p) -> Identity (CWMin (Point d r) :+ p))
 -> Box d p r -> Identity (Box d p r))
-> ((Point d r -> Identity (Point d r))
    -> (CWMin (Point d r) :+ p) -> Identity (CWMin (Point d r) :+ p))
-> (Point d r -> Identity (Point d r))
-> Box d p r
-> Identity (Box d p r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CWMin (Point d r) -> Identity (CWMin (Point d r)))
-> (CWMin (Point d r) :+ p) -> Identity (CWMin (Point d r) :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((CWMin (Point d r) -> Identity (CWMin (Point d r)))
 -> (CWMin (Point d r) :+ p) -> Identity (CWMin (Point d r) :+ p))
-> ((Point d r -> Identity (Point d r))
    -> CWMin (Point d r) -> Identity (CWMin (Point d r)))
-> (Point d r -> Identity (Point d r))
-> (CWMin (Point d r) :+ p)
-> Identity (CWMin (Point d r) :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point d r -> Identity (Point d r))
-> CWMin (Point d r) -> Identity (CWMin (Point d r))
forall a a. Iso (CWMin a) (CWMin a) a a
cwMin ((Point d r -> Identity (Point d r))
 -> Box d p r -> Identity (Box d p r))
-> (Point d r -> Point d r) -> Box d p r -> Box d p r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Point d r -> Diff (Point d) r -> Point d r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.-^ Diff (Point d) r
Vector d r
v)
               Box d p r -> (Box d p r -> Box d p r) -> Box d p r
forall a b. a -> (a -> b) -> b
&((CWMax (Point d r) :+ p) -> Identity (CWMax (Point d r) :+ p))
-> Box d p r -> Identity (Box d p r)
forall (d :: Nat) p r. Lens' (Box d p r) (CWMax (Point d r) :+ p)
maxP(((CWMax (Point d r) :+ p) -> Identity (CWMax (Point d r) :+ p))
 -> Box d p r -> Identity (Box d p r))
-> ((Point d r -> Identity (Point d r))
    -> (CWMax (Point d r) :+ p) -> Identity (CWMax (Point d r) :+ p))
-> (Point d r -> Identity (Point d r))
-> Box d p r
-> Identity (Box d p r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CWMax (Point d r) -> Identity (CWMax (Point d r)))
-> (CWMax (Point d r) :+ p) -> Identity (CWMax (Point d r) :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((CWMax (Point d r) -> Identity (CWMax (Point d r)))
 -> (CWMax (Point d r) :+ p) -> Identity (CWMax (Point d r) :+ p))
-> ((Point d r -> Identity (Point d r))
    -> CWMax (Point d r) -> Identity (CWMax (Point d r)))
-> (Point d r -> Identity (Point d r))
-> (CWMax (Point d r) :+ p)
-> Identity (CWMax (Point d r) :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point d r -> Identity (Point d r))
-> CWMax (Point d r) -> Identity (CWMax (Point d r))
forall a a. Iso (CWMax a) (CWMax a) a a
cwMax ((Point d r -> Identity (Point d r))
 -> Box d p r -> Identity (Box d p r))
-> (Point d r -> Point d r) -> Box d p r -> Box d p r
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Point d r -> Diff (Point d) r -> Point d r
forall (p :: * -> *) a. (Affine p, Num a) => p a -> Diff p a -> p a
.+^ Diff (Point d) r
Vector d r
v)

-- | Build a d dimensional Box given d ranges.
fromExtent    :: Arity d => Vector d (R.Range r) -> Box d () r
fromExtent :: Vector d (Range r) -> Box d () r
fromExtent Vector d (Range r)
rs = (CWMin (Point d r) :+ ())
-> (CWMax (Point d r) :+ ()) -> Box d () r
forall (d :: Nat) p r.
(CWMin (Point d r) :+ p) -> (CWMax (Point d r) :+ p) -> Box d p r
Box (Point d r -> CWMin (Point d r)
forall a. a -> CWMin a
CWMin (Vector d r -> Point d r
forall (d :: Nat) r. Vector d r -> Point d r
Point (Vector d r -> Point d r) -> Vector d r -> Point d r
forall a b. (a -> b) -> a -> b
$ (Range r -> r) -> Vector d (Range r) -> Vector d r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Range r -> Getting r (Range r) r -> r
forall s a. s -> Getting a s a -> a
^.(EndPoint r -> Const r (EndPoint r))
-> Range r -> Const r (Range r)
forall a. Lens' (Range a) (EndPoint a)
R.lower((EndPoint r -> Const r (EndPoint r))
 -> Range r -> Const r (Range r))
-> ((r -> Const r r) -> EndPoint r -> Const r (EndPoint r))
-> Getting r (Range r) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> EndPoint r -> Const r (EndPoint r)
forall a b. Lens (EndPoint a) (EndPoint b) a b
R.unEndPoint) Vector d (Range r)
rs) CWMin (Point d r) -> () -> CWMin (Point d r) :+ ()
forall core extra. core -> extra -> core :+ extra
:+ ()
forall a. Monoid a => a
mempty)
                    (Point d r -> CWMax (Point d r)
forall a. a -> CWMax a
CWMax (Vector d r -> Point d r
forall (d :: Nat) r. Vector d r -> Point d r
Point (Vector d r -> Point d r) -> Vector d r -> Point d r
forall a b. (a -> b) -> a -> b
$ (Range r -> r) -> Vector d (Range r) -> Vector d r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Range r -> Getting r (Range r) r -> r
forall s a. s -> Getting a s a -> a
^.(EndPoint r -> Const r (EndPoint r))
-> Range r -> Const r (Range r)
forall a. Lens' (Range a) (EndPoint a)
R.upper((EndPoint r -> Const r (EndPoint r))
 -> Range r -> Const r (Range r))
-> ((r -> Const r r) -> EndPoint r -> Const r (EndPoint r))
-> Getting r (Range r) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(r -> Const r r) -> EndPoint r -> Const r (EndPoint r)
forall a b. Lens (EndPoint a) (EndPoint b) a b
R.unEndPoint) Vector d (Range r)
rs) CWMax (Point d r) -> () -> CWMax (Point d r) :+ ()
forall core extra. core -> extra -> core :+ extra
:+ ()
forall a. Monoid a => a
mempty)


-- | Given a center point and a vector specifying the box width's, construct a box.
fromCenter      :: (Arity d, Fractional r) => Point d r -> Vector d r -> Box d () r
fromCenter :: Point d r -> Vector d r -> Box d () r
fromCenter Point d r
c Vector d r
ws = let f :: a -> a -> Range a
f a
x a
r = a -> a -> Range a
forall a. a -> a -> Range a
R.ClosedRange (a
xa -> a -> a
forall a. Num a => a -> a -> a
-a
r) (a
xa -> a -> a
forall a. Num a => a -> a -> a
+a
r)
                  in Vector d (Range r) -> Box d () r
forall (d :: Nat) r. Arity d => Vector d (Range r) -> Box d () r
fromExtent (Vector d (Range r) -> Box d () r)
-> Vector d (Range r) -> Box d () r
forall a b. (a -> b) -> a -> b
$ (r -> r -> Range r)
-> Vector d r -> Vector d r -> Vector d (Range r)
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
FV.zipWith r -> r -> Range r
forall a. Num a => a -> a -> Range a
f (Point d r -> Vector d r
forall (d :: Nat) r. Point d r -> Vector d r
toVec Point d r
c) ((r -> r -> r
forall a. Fractional a => a -> a -> a
/r
2) (r -> r) -> Vector d r -> Vector d r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector d r
ws)


{- HLINT ignore centerPoint -}
-- | Center of the box
centerPoint   :: (Arity d, Fractional r) => Box d p r -> Point d r
centerPoint :: Box d p r -> Point d r
centerPoint Box d p r
b = Vector d r -> Point d r
forall (d :: Nat) r. Vector d r -> Point d r
Point (Vector d r -> Point d r) -> Vector d r -> Point d r
forall a b. (a -> b) -> a -> b
$ Vector d r
w Vector d r -> r -> Vector d r
forall (f :: * -> *) a.
(Functor f, Fractional a) =>
f a -> a -> f a
V.^/ r
2
  where w :: Vector d r
w = Box d p r
bBox d p r
-> Getting (Vector d r) (Box d p r) (Vector d r) -> Vector d r
forall s a. s -> Getting a s a -> a
^.((CWMin (Point d r) :+ p)
 -> Const (Vector d r) (CWMin (Point d r) :+ p))
-> Box d p r -> Const (Vector d r) (Box d p r)
forall (d :: Nat) p r. Lens' (Box d p r) (CWMin (Point d r) :+ p)
minP(((CWMin (Point d r) :+ p)
  -> Const (Vector d r) (CWMin (Point d r) :+ p))
 -> Box d p r -> Const (Vector d r) (Box d p r))
-> ((Vector d r -> Const (Vector d r) (Vector d r))
    -> (CWMin (Point d r) :+ p)
    -> Const (Vector d r) (CWMin (Point d r) :+ p))
-> Getting (Vector d r) (Box d p r) (Vector d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CWMin (Point d r) -> Const (Vector d r) (CWMin (Point d r)))
-> (CWMin (Point d r) :+ p)
-> Const (Vector d r) (CWMin (Point d r) :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((CWMin (Point d r) -> Const (Vector d r) (CWMin (Point d r)))
 -> (CWMin (Point d r) :+ p)
 -> Const (Vector d r) (CWMin (Point d r) :+ p))
-> ((Vector d r -> Const (Vector d r) (Vector d r))
    -> CWMin (Point d r) -> Const (Vector d r) (CWMin (Point d r)))
-> (Vector d r -> Const (Vector d r) (Vector d r))
-> (CWMin (Point d r) :+ p)
-> Const (Vector d r) (CWMin (Point d r) :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point d r -> Const (Vector d r) (Point d r))
-> CWMin (Point d r) -> Const (Vector d r) (CWMin (Point d r))
forall a a. Iso (CWMin a) (CWMin a) a a
cwMin((Point d r -> Const (Vector d r) (Point d r))
 -> CWMin (Point d r) -> Const (Vector d r) (CWMin (Point d r)))
-> ((Vector d r -> Const (Vector d r) (Vector d r))
    -> Point d r -> Const (Vector d r) (Point d r))
-> (Vector d r -> Const (Vector d r) (Vector d r))
-> CWMin (Point d r)
-> Const (Vector d r) (CWMin (Point d r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vector d r -> Const (Vector d r) (Vector d r))
-> Point d r -> Const (Vector d r) (Point d r)
forall (d :: Nat) r r'.
Lens (Point d r) (Point d r') (Vector d r) (Vector d r')
vector Vector d r -> Vector d r -> Vector d r
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
V.^+^ Box d p r
bBox d p r
-> Getting (Vector d r) (Box d p r) (Vector d r) -> Vector d r
forall s a. s -> Getting a s a -> a
^.((CWMax (Point d r) :+ p)
 -> Const (Vector d r) (CWMax (Point d r) :+ p))
-> Box d p r -> Const (Vector d r) (Box d p r)
forall (d :: Nat) p r. Lens' (Box d p r) (CWMax (Point d r) :+ p)
maxP(((CWMax (Point d r) :+ p)
  -> Const (Vector d r) (CWMax (Point d r) :+ p))
 -> Box d p r -> Const (Vector d r) (Box d p r))
-> ((Vector d r -> Const (Vector d r) (Vector d r))
    -> (CWMax (Point d r) :+ p)
    -> Const (Vector d r) (CWMax (Point d r) :+ p))
-> Getting (Vector d r) (Box d p r) (Vector d r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(CWMax (Point d r) -> Const (Vector d r) (CWMax (Point d r)))
-> (CWMax (Point d r) :+ p)
-> Const (Vector d r) (CWMax (Point d r) :+ p)
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core((CWMax (Point d r) -> Const (Vector d r) (CWMax (Point d r)))
 -> (CWMax (Point d r) :+ p)
 -> Const (Vector d r) (CWMax (Point d r) :+ p))
-> ((Vector d r -> Const (Vector d r) (Vector d r))
    -> CWMax (Point d r) -> Const (Vector d r) (CWMax (Point d r)))
-> (Vector d r -> Const (Vector d r) (Vector d r))
-> (CWMax (Point d r) :+ p)
-> Const (Vector d r) (CWMax (Point d r) :+ p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Point d r -> Const (Vector d r) (Point d r))
-> CWMax (Point d r) -> Const (Vector d r) (CWMax (Point d r))
forall a a. Iso (CWMax a) (CWMax a) a a
cwMax((Point d r -> Const (Vector d r) (Point d r))
 -> CWMax (Point d r) -> Const (Vector d r) (CWMax (Point d r)))
-> ((Vector d r -> Const (Vector d r) (Vector d r))
    -> Point d r -> Const (Vector d r) (Point d r))
-> (Vector d r -> Const (Vector d r) (Vector d r))
-> CWMax (Point d r)
-> Const (Vector d r) (CWMax (Point d r))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Vector d r -> Const (Vector d r) (Vector d r))
-> Point d r -> Const (Vector d r) (Point d r)
forall (d :: Nat) r r'.
Lens (Point d r) (Point d r') (Vector d r) (Vector d r')
vector



deriving instance (Show r, Show p, Arity d) => Show (Box d p r)
deriving instance (Eq r, Eq p, Arity d)     => Eq   (Box d p r)
deriving instance (Ord r, Ord p, Arity d)   => Ord  (Box d p r)

instance (Arity d, Ord r, Semigroup p) => Semigroup (Box d p r) where
  (Box CWMin (Point d r) :+ p
mi CWMax (Point d r) :+ p
ma) <> :: Box d p r -> Box d p r -> Box d p r
<> (Box CWMin (Point d r) :+ p
mi' CWMax (Point d r) :+ p
ma') = (CWMin (Point d r) :+ p) -> (CWMax (Point d r) :+ p) -> Box d p r
forall (d :: Nat) p r.
(CWMin (Point d r) :+ p) -> (CWMax (Point d r) :+ p) -> Box d p r
Box (CWMin (Point d r) :+ p
mi (CWMin (Point d r) :+ p)
-> (CWMin (Point d r) :+ p) -> CWMin (Point d r) :+ p
forall a. Semigroup a => a -> a -> a
<> CWMin (Point d r) :+ p
mi') (CWMax (Point d r) :+ p
ma (CWMax (Point d r) :+ p)
-> (CWMax (Point d r) :+ p) -> CWMax (Point d r) :+ p
forall a. Semigroup a => a -> a -> a
<> CWMax (Point d r) :+ p
ma')

type instance IntersectionOf (Box d p r) (Box d q r) = '[ NoIntersection, Box d () r]

instance (Ord r, Arity d) => Box d p r `IsIntersectableWith` Box d q r where
  nonEmptyIntersection :: proxy (Box d p r)
-> proxy (Box d q r)
-> Intersection (Box d p r) (Box d q r)
-> Bool
nonEmptyIntersection = proxy (Box d p r)
-> proxy (Box d q r)
-> Intersection (Box d p r) (Box d q r)
-> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
 RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection

  Box d p r
bx intersect :: Box d p r -> Box d q r -> Intersection (Box d p r) (Box d q r)
`intersect` Box d q r
bx' = Maybe (Vector d (Range r))
-> CoRec Identity '[NoIntersection, Box d () r]
f (Maybe (Vector d (Range r))
 -> CoRec Identity '[NoIntersection, Box d () r])
-> (Vector d (Maybe (Range r)) -> Maybe (Vector d (Range r)))
-> Vector d (Maybe (Range r))
-> CoRec Identity '[NoIntersection, Box d () r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector d (Maybe (Range r)) -> Maybe (Vector d (Range r))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Vector d (Maybe (Range r))
 -> CoRec Identity '[NoIntersection, Box d () r])
-> Vector d (Maybe (Range r))
-> CoRec Identity '[NoIntersection, Box d () r]
forall a b. (a -> b) -> a -> b
$ (Range r -> Range r -> Maybe (Range r))
-> Vector d (Range r)
-> Vector d (Range r)
-> Vector d (Maybe (Range r))
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
FV.zipWith Range r -> Range r -> Maybe (Range r)
intersect' (Box d p r -> Vector d (Range r)
forall (d :: Nat) p r. Arity d => Box d p r -> Vector d (Range r)
extent Box d p r
bx) (Box d q r -> Vector d (Range r)
forall (d :: Nat) p r. Arity d => Box d p r -> Vector d (Range r)
extent Box d q r
bx')
    where
      f :: Maybe (Vector d (Range r))
-> CoRec Identity '[NoIntersection, Box d () r]
f = CoRec Identity '[NoIntersection, Box d () r]
-> (Vector d (Range r)
    -> CoRec Identity '[NoIntersection, Box d () r])
-> Maybe (Vector d (Range r))
-> CoRec Identity '[NoIntersection, Box d () r]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (NoIntersection -> CoRec Identity '[NoIntersection, Box d () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection) (Box d () r -> CoRec Identity '[NoIntersection, Box d () r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec (Box d () r -> CoRec Identity '[NoIntersection, Box d () r])
-> (Vector d (Range r) -> Box d () r)
-> Vector d (Range r)
-> CoRec Identity '[NoIntersection, Box d () r]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector d (Range r) -> Box d () r
forall (d :: Nat) r. Arity d => Vector d (Range r) -> Box d () r
fromExtent)
      Range r
r intersect' :: Range r -> Range r -> Maybe (Range r)
`intersect'` Range r
s = forall (ts :: [*]).
NatToInt (RIndex (Range r) ts) =>
CoRec Identity ts -> Maybe (Range r)
forall t (ts :: [*]).
NatToInt (RIndex t ts) =>
CoRec Identity ts -> Maybe t
asA @(R.Range r) (CoRec Identity '[NoIntersection, Range r] -> Maybe (Range r))
-> CoRec Identity '[NoIntersection, Range r] -> Maybe (Range r)
forall a b. (a -> b) -> a -> b
$ Range r
r Range r -> Range r -> Intersection (Range r) (Range r)
forall g h. IsIntersectableWith g h => g -> h -> Intersection g h
`intersect` Range r
s

instance Arity d => Bifunctor (Box d) where
  bimap :: (a -> b) -> (c -> d) -> Box d a c -> Box d b d
bimap = (a -> b) -> (c -> d) -> Box d a c -> Box d b d
forall (t :: * -> * -> *) a b c d.
Bitraversable t =>
(a -> b) -> (c -> d) -> t a c -> t b d
bimapDefault
instance Arity d => Bifoldable (Box d) where
  bifoldMap :: (a -> m) -> (b -> m) -> Box d a b -> m
bifoldMap = (a -> m) -> (b -> m) -> Box d a b -> m
forall (t :: * -> * -> *) m a b.
(Bitraversable t, Monoid m) =>
(a -> m) -> (b -> m) -> t a b -> m
bifoldMapDefault
instance Arity d => Bitraversable (Box d) where
  bitraverse :: (a -> f c) -> (b -> f d) -> Box d a b -> f (Box d c d)
bitraverse a -> f c
f b -> f d
g (Box CWMin (Point d b) :+ a
mi CWMax (Point d b) :+ a
ma) = (CWMin (Point d d) :+ c) -> (CWMax (Point d d) :+ c) -> Box d c d
forall (d :: Nat) p r.
(CWMin (Point d r) :+ p) -> (CWMax (Point d r) :+ p) -> Box d p r
Box ((CWMin (Point d d) :+ c) -> (CWMax (Point d d) :+ c) -> Box d c d)
-> f (CWMin (Point d d) :+ c)
-> f ((CWMax (Point d d) :+ c) -> Box d c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CWMin (Point d b) -> f (CWMin (Point d d)))
-> (a -> f c)
-> (CWMin (Point d b) :+ a)
-> f (CWMin (Point d d) :+ c)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse ((b -> f d) -> CWMin (Point d b) -> f (CWMin (Point d d))
forall (t :: * -> *) (f :: * -> *) r s.
(Traversable t, Applicative f) =>
(r -> f s) -> t (Point d r) -> f (t (Point d s))
tr b -> f d
g) a -> f c
f CWMin (Point d b) :+ a
mi f ((CWMax (Point d d) :+ c) -> Box d c d)
-> f (CWMax (Point d d) :+ c) -> f (Box d c d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (CWMax (Point d b) -> f (CWMax (Point d d)))
-> (a -> f c)
-> (CWMax (Point d b) :+ a)
-> f (CWMax (Point d d) :+ c)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse ((b -> f d) -> CWMax (Point d b) -> f (CWMax (Point d d))
forall (t :: * -> *) (f :: * -> *) r s.
(Traversable t, Applicative f) =>
(r -> f s) -> t (Point d r) -> f (t (Point d s))
tr b -> f d
g) a -> f c
f CWMax (Point d b) :+ a
ma
    where
      tr    :: (Traversable t, Applicative f) => (r -> f s) -> t (Point d r) -> f (t (Point d s))
      tr :: (r -> f s) -> t (Point d r) -> f (t (Point d s))
tr r -> f s
g' = (Point d r -> f (Point d s)) -> t (Point d r) -> f (t (Point d s))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Point d r -> f (Point d s))
 -> t (Point d r) -> f (t (Point d s)))
-> (Point d r -> f (Point d s))
-> t (Point d r)
-> f (t (Point d s))
forall a b. (a -> b) -> a -> b
$ (r -> f s) -> Point d r -> f (Point d s)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse r -> f s
g'

-- -- In principle this should also just work for Boxes in higher dimensions. It is just
-- -- that we need a better way to compute their corners
-- instance (Num r, Ord r) => (Rectangle p r) `IsIntersectableWith` (Rectangle p r) where

--   nonEmptyIntersection = defaultNonEmptyIntersection

--   box@(Box a b) `intersect` box'@(Box c d)
--       |    box  `containsACornerOf` box'
--         || box' `containsACornerOf` box = coRec $ Box (mi :+ ()) (ma :+ ())
--       | otherwise                       = coRec NoIntersection
--     where

--       mi = (a^.core) `max` (c^.core)
--       ma = (b^.core) `min` (d^.core)

--       bx `containsACornerOf` bx' = let (a',b',c',d') = corners bx'
--                                    in any (\(p :+ _) -> p `inBox` bx) [a',b',c',d']


type instance IntersectionOf (Point d r) (Box d p r) = '[ NoIntersection, Point d r]

instance (Arity d, Ord r) => Point d r `IsIntersectableWith` Box d p r where
  nonEmptyIntersection :: proxy (Point d r)
-> proxy (Box d p r)
-> Intersection (Point d r) (Box d p r)
-> Bool
nonEmptyIntersection = proxy (Point d r)
-> proxy (Box d p r)
-> Intersection (Point d r) (Box d p r)
-> Bool
forall g h (proxy :: * -> *).
(NoIntersection ∈ IntersectionOf g h,
 RecApplicative (IntersectionOf g h)) =>
proxy g -> proxy h -> Intersection g h -> Bool
defaultNonEmptyIntersection
  Point d r
p intersect :: Point d r -> Box d p r -> Intersection (Point d r) (Box d p r)
`intersect` Box d p r
b
    | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Point d r
p Point d r -> Box d p r -> Bool
forall (d :: Nat) r p.
(Arity d, Ord r) =>
Point d r -> Box d p r -> Bool
`inBox` Box d p r
b = NoIntersection -> CoRec Identity '[NoIntersection, Point d r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec NoIntersection
NoIntersection
    | Bool
otherwise         = Point d r -> CoRec Identity '[NoIntersection, Point d r]
forall a (as :: [*]). (a ∈ as) => a -> CoRec Identity as
coRec Point d r
p


instance PointFunctor (Box d p) where
  pmap :: (Point (Dimension (Box d p r)) r
 -> Point (Dimension (Box d p s)) s)
-> Box d p r -> Box d p s
pmap Point (Dimension (Box d p r)) r -> Point (Dimension (Box d p s)) s
f (Box CWMin (Point d r) :+ p
mi CWMax (Point d r) :+ p
ma) = (CWMin (Point d s) :+ p) -> (CWMax (Point d s) :+ p) -> Box d p s
forall (d :: Nat) p r.
(CWMin (Point d r) :+ p) -> (CWMax (Point d r) :+ p) -> Box d p r
Box ((CWMin (Point d r) -> CWMin (Point d s))
-> (CWMin (Point d r) :+ p) -> CWMin (Point d s) :+ p
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Point d r -> Point d s) -> CWMin (Point d r) -> CWMin (Point d s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Point d r -> Point d s
Point (Dimension (Box d p r)) r -> Point (Dimension (Box d p s)) s
f) CWMin (Point d r) :+ p
mi) ((CWMax (Point d r) -> CWMax (Point d s))
-> (CWMax (Point d r) :+ p) -> CWMax (Point d s) :+ p
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Point d r -> Point d s) -> CWMax (Point d r) -> CWMax (Point d s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Point d r -> Point d s
Point (Dimension (Box d p r)) r -> Point (Dimension (Box d p s)) s
f) CWMax (Point d r) :+ p
ma)


instance (Fractional r, Arity d, Arity (d + 1))
         => IsTransformable (Box d p r) where
  -- Note that this does not guarantee the box is still a proper box Only use
  -- this to do translations and scalings. Other transformations may produce
  -- unexpected results.
  transformBy :: Transformation (Dimension (Box d p r)) (NumType (Box d p r))
-> Box d p r -> Box d p r
transformBy = Transformation (Dimension (Box d p r)) (NumType (Box d p r))
-> Box d p r -> Box d p r
forall (g :: * -> *) r (d :: Nat).
(PointFunctor g, Fractional r, d ~ Dimension (g r), Arity d,
 Arity (d + 1)) =>
Transformation d r -> g r -> g r
transformPointFunctor


instance (Arbitrary r, Arity d, Ord r) => Arbitrary (Box d () r) where
  arbitrary :: Gen (Box d () r)
arbitrary = (\Point d r
p (Point d r
q :: Point d r) -> [Point d r] -> Box (Dimension (Point d r)) () (NumType (Point d r))
forall g (c :: * -> *).
(IsBoxable g, Foldable c, Ord (NumType g), Arity (Dimension g)) =>
c g -> Box (Dimension g) () (NumType g)
boundingBoxList' [Point d r
p,Point d r
q]) (Point d r -> Point d r -> Box d () r)
-> Gen (Point d r) -> Gen (Point d r -> Box d () r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Point d r)
forall a. Arbitrary a => Gen a
arbitrary Gen (Point d r -> Box d () r)
-> Gen (Point d r) -> Gen (Box d () r)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Point d r)
forall a. Arbitrary a => Gen a
arbitrary

type instance Dimension (Box d p r) = d
type instance NumType   (Box d p r) = r

--------------------------------------------------------------------------------0
-- * Functions on d-dimensonal boxes

minPoint :: Box d p r -> Point d r :+ p
minPoint :: Box d p r -> Point d r :+ p
minPoint Box d p r
b = let (CWMin Point d r
p :+ p
e) = Box d p r
bBox d p r
-> Getting
     (CWMin (Point d r) :+ p) (Box d p r) (CWMin (Point d r) :+ p)
-> CWMin (Point d r) :+ p
forall s a. s -> Getting a s a -> a
^.Getting
  (CWMin (Point d r) :+ p) (Box d p r) (CWMin (Point d r) :+ p)
forall (d :: Nat) p r. Lens' (Box d p r) (CWMin (Point d r) :+ p)
minP in Point d r
p Point d r -> p -> Point d r :+ p
forall core extra. core -> extra -> core :+ extra
:+ p
e

maxPoint :: Box d p r -> Point d r :+ p
maxPoint :: Box d p r -> Point d r :+ p
maxPoint Box d p r
b = let (CWMax Point d r
p :+ p
e) = Box d p r
bBox d p r
-> Getting
     (CWMax (Point d r) :+ p) (Box d p r) (CWMax (Point d r) :+ p)
-> CWMax (Point d r) :+ p
forall s a. s -> Getting a s a -> a
^.Getting
  (CWMax (Point d r) :+ p) (Box d p r) (CWMax (Point d r) :+ p)
forall (d :: Nat) p r. Lens' (Box d p r) (CWMax (Point d r) :+ p)
maxP in Point d r
p Point d r -> p -> Point d r :+ p
forall core extra. core -> extra -> core :+ extra
:+ p
e

-- | Check if a point lies a box
--
-- >>> origin `inBox` (boundingBoxList' [Point3 1 2 3, Point3 10 20 30] :: Box 3 () Int)
-- False
-- >>> origin `inBox` (boundingBoxList' [Point3 (-1) (-2) (-3), Point3 10 20 30] :: Box 3 () Int)
-- True
inBox :: (Arity d, Ord r) => Point d r -> Box d p r -> Bool
Point d r
p inBox :: Point d r -> Box d p r -> Bool
`inBox` Box d p r
b = Vector d Bool -> Bool
forall (v :: * -> *). Vector v Bool => v Bool -> Bool
FV.and (Vector d Bool -> Bool)
-> (Box d p r -> Vector d Bool) -> Box d p r -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> Range r -> Bool)
-> Vector d r -> Vector d (Range r) -> Vector d Bool
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
FV.zipWith r -> Range r -> Bool
forall a. Ord a => a -> Range a -> Bool
R.inRange (Point d r -> Vector d r
forall (d :: Nat) r. Point d r -> Vector d r
toVec Point d r
p) (Vector d (Range r) -> Vector d Bool)
-> (Box d p r -> Vector d (Range r)) -> Box d p r -> Vector d Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Box d p r -> Vector d (Range r)
forall (d :: Nat) p r. Arity d => Box d p r -> Vector d (Range r)
extent (Box d p r -> Bool) -> Box d p r -> Bool
forall a b. (a -> b) -> a -> b
$ Box d p r
b


-- | Check if a point lies strictly inside a box (i.e. not on its boundary)
--
-- >>> origin `inBox` (boundingBoxList' [Point3 1 2 3, Point3 10 20 30] :: Box 3 () Int)
-- False
-- >>> origin `inBox` (boundingBoxList' [Point3 (-1) (-2) (-3), Point3 10 20 30] :: Box 3 () Int)
-- True
insideBox :: (Arity d, Ord r) => Point d r -> Box d p r -> Bool
Point d r
p insideBox :: Point d r -> Box d p r -> Bool
`insideBox` Box d p r
b = Vector d Bool -> Bool
forall (v :: * -> *). Vector v Bool => v Bool -> Bool
FV.and (Vector d Bool -> Bool)
-> (Box d p r -> Vector d Bool) -> Box d p r -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (r -> Range r -> Bool)
-> Vector d r -> Vector d (Range r) -> Vector d Bool
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
FV.zipWith r -> Range r -> Bool
forall a. Ord a => a -> Range a -> Bool
R.inRange (Point d r -> Vector d r
forall (d :: Nat) r. Point d r -> Vector d r
toVec Point d r
p) (Vector d (Range r) -> Vector d Bool)
-> (Box d p r -> Vector d (Range r)) -> Box d p r -> Vector d Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Range r -> Range r) -> Vector d (Range r) -> Vector d (Range r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range r -> Range r
forall a. Range a -> Range a
toOpenRange (Vector d (Range r) -> Vector d (Range r))
-> (Box d p r -> Vector d (Range r))
-> Box d p r
-> Vector d (Range r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Box d p r -> Vector d (Range r)
forall (d :: Nat) p r. Arity d => Box d p r -> Vector d (Range r)
extent (Box d p r -> Bool) -> Box d p r -> Bool
forall a b. (a -> b) -> a -> b
$ Box d p r
b
  where
    toOpenRange :: Range a -> Range a
toOpenRange (R.Range' a
l a
r) = a -> a -> Range a
forall a. a -> a -> Range a
R.OpenRange a
l a
r


-- | Get a vector with the extent of the box in each dimension. Note that the
-- resulting vector is 0 indexed whereas one would normally count dimensions
-- starting at zero.
--
-- >>> extent (boundingBoxList' [Point3 1 2 3, Point3 10 20 30] :: Box 3 () Int)
-- Vector3 (Range (Closed 1) (Closed 10)) (Range (Closed 2) (Closed 20)) (Range (Closed 3) (Closed 30))
extent                                 :: Arity d
                                       => Box d p r -> Vector d (R.Range r)
extent :: Box d p r -> Vector d (Range r)
extent (Box (CWMin Point d r
a :+ p
_) (CWMax Point d r
b :+ p
_)) = (r -> r -> Range r)
-> Vector d r -> Vector d r -> Vector d (Range r)
forall (v :: * -> *) a b c.
(Vector v a, Vector v b, Vector v c) =>
(a -> b -> c) -> v a -> v b -> v c
FV.zipWith r -> r -> Range r
forall a. a -> a -> Range a
R.ClosedRange (Point d r -> Vector d r
forall (d :: Nat) r. Point d r -> Vector d r
toVec Point d r
a) (Point d r -> Vector d r
forall (d :: Nat) r. Point d r -> Vector d r
toVec Point d r
b)

-- | Get the size of the box (in all dimensions). Note that the resulting vector is 0 indexed
-- whereas one would normally count dimensions starting at zero.
--
-- >>> size (boundingBoxList' [origin, Point3 1 2 3] :: Box 3 () Int)
-- Vector3 1 2 3
size :: (Arity d, Num r) => Box d p r -> Vector d r
size :: Box d p r -> Vector d r
size = (Range r -> r) -> Vector d (Range r) -> Vector d r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Range r -> r
forall r. Num r => Range r -> r
R.width (Vector d (Range r) -> Vector d r)
-> (Box d p r -> Vector d (Range r)) -> Box d p r -> Vector d r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Box d p r -> Vector d (Range r)
forall (d :: Nat) p r. Arity d => Box d p r -> Vector d (Range r)
extent

-- | Given a dimension, get the width of the box in that dimension. Dimensions are 1 indexed.
--
-- >>> widthIn (C :: C 1) (boundingBoxList' [origin, Point3 1 2 3] :: Box 3 () Int)
-- 1
-- >>> widthIn (C :: C 3) (boundingBoxList' [origin, Point3 1 2 3] :: Box 3 () Int)
-- 3
widthIn   :: forall proxy p i d r. (Arity d, Arity (i - 1), Num r, ((i-1)+1) <= d)
          => proxy i -> Box d p r -> r
widthIn :: proxy i -> Box d p r -> r
widthIn proxy i
_ = Getting r (Vector d r) r -> Vector d r -> r
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (C (i - 1) -> Lens' (Vector d r) r
forall (proxy :: Nat -> *) (i :: Nat) (d :: Nat) r.
(Arity d, KnownNat i, (i + 1) <= d) =>
proxy i -> Lens' (Vector d r) r
V.element (C (i - 1)
forall (n :: Nat). C n
C :: C (i - 1))) (Vector d r -> r) -> (Box d p r -> Vector d r) -> Box d p r -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Box d p r -> Vector d r
forall (d :: Nat) r p. (Arity d, Num r) => Box d p r -> Vector d r
size


-- | Same as 'widthIn' but with a runtime int instead of a static dimension.
--
-- >>> widthIn' 1 (boundingBoxList' [origin, Point3 1 2 3] :: Box 3 () Int)
-- Just 1
-- >>> widthIn' 3 (boundingBoxList' [origin, Point3 1 2 3] :: Box 3 () Int)
-- Just 3
-- >>> widthIn' 10 (boundingBoxList' [origin, Point3 1 2 3] :: Box 3 () Int)
-- Nothing
widthIn'   :: (Arity d, Num r) => Int -> Box d p r -> Maybe r
widthIn' :: Int -> Box d p r -> Maybe r
widthIn' Int
i = Getting (First r) (Vector d r) r -> Vector d r -> Maybe r
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Int -> Traversal' (Vector d r) r
forall (d :: Nat) r. Arity d => Int -> Traversal' (Vector d r) r
V.element' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)) (Vector d r -> Maybe r)
-> (Box d p r -> Vector d r) -> Box d p r -> Maybe r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Box d p r -> Vector d r
forall (d :: Nat) r p. (Arity d, Num r) => Box d p r -> Vector d r
size


----------------------------------------
-- * Rectangles, aka 2-dimensional boxes

type Rectangle = Box 2

-- |
-- >>> width (boundingBoxList' [origin, Point2 1 2] :: Rectangle () Int)
-- 1
-- >>> width (boundingBoxList' [origin] :: Rectangle () Int)
-- 0
width :: Num r => Rectangle p r -> r
width :: Rectangle p r -> r
width = C 1 -> Rectangle p r -> r
forall (proxy :: Nat -> *) p (i :: Nat) (d :: Nat) r.
(Arity d, Arity (i - 1), Num r, ((i - 1) + 1) <= d) =>
proxy i -> Box d p r -> r
widthIn (C 1
forall (n :: Nat). C n
C :: C 1)

-- |
-- >>> height (boundingBoxList' [origin, Point2 1 2] :: Rectangle () Int)
-- 2
-- >>> height (boundingBoxList' [origin] :: Rectangle () Int)
-- 0
height :: Num r => Rectangle p r -> r
height :: Rectangle p r -> r
height = C 2 -> Rectangle p r -> r
forall (proxy :: Nat -> *) p (i :: Nat) (d :: Nat) r.
(Arity d, Arity (i - 1), Num r, ((i - 1) + 1) <= d) =>
proxy i -> Box d p r -> r
widthIn (C 2
forall (n :: Nat). C n
C :: C 2)


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

--------------------------------------------------------------------------------
-- * Constructing bounding boxes

class IsBoxable g where
  boundingBox :: Ord (NumType g) => g -> Box (Dimension g) () (NumType g)

-- | Create a bounding box that encapsulates a list of objects.
boundingBoxList :: (IsBoxable g, F.Foldable1 c, Ord (NumType g), Arity (Dimension g))
                => c g -> Box (Dimension g) () (NumType g)
boundingBoxList :: c g -> Box (Dimension g) () (NumType g)
boundingBoxList = (g -> Box (Dimension g) () (NumType g))
-> c g -> Box (Dimension g) () (NumType g)
forall (t :: * -> *) m a.
(Foldable1 t, Semigroup m) =>
(a -> m) -> t a -> m
F.foldMap1 g -> Box (Dimension g) () (NumType g)
forall g.
(IsBoxable g, Ord (NumType g)) =>
g -> Box (Dimension g) () (NumType g)
boundingBox


-- | Unsafe version of boundingBoxList, that does not check if the list is non-empty
boundingBoxList' :: (IsBoxable g, Foldable c, Ord (NumType g), Arity (Dimension g))
                 => c g -> Box (Dimension g) () (NumType g)
boundingBoxList' :: c g -> Box (Dimension g) () (NumType g)
boundingBoxList' = NonEmpty g -> Box (Dimension g) () (NumType g)
forall g (c :: * -> *).
(IsBoxable g, Foldable1 c, Ord (NumType g), Arity (Dimension g)) =>
c g -> Box (Dimension g) () (NumType g)
boundingBoxList (NonEmpty g -> Box (Dimension g) () (NumType g))
-> (c g -> NonEmpty g) -> c g -> Box (Dimension g) () (NumType g)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [g] -> NonEmpty g
forall a. [a] -> NonEmpty a
NE.fromList ([g] -> NonEmpty g) -> (c g -> [g]) -> c g -> NonEmpty g
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c g -> [g]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

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

instance IsBoxable (Point d r) where
  boundingBox :: Point d r -> Box (Dimension (Point d r)) () (NumType (Point d r))
boundingBox Point d r
p = (CWMin (Point d r) :+ ())
-> (CWMax (Point d r) :+ ()) -> Box d () r
forall (d :: Nat) p r.
(CWMin (Point d r) :+ p) -> (CWMax (Point d r) :+ p) -> Box d p r
Box (CWMin (Point d r) -> CWMin (Point d r) :+ ()
forall a. a -> a :+ ()
ext (CWMin (Point d r) -> CWMin (Point d r) :+ ())
-> CWMin (Point d r) -> CWMin (Point d r) :+ ()
forall a b. (a -> b) -> a -> b
$ Point d r -> CWMin (Point d r)
forall a. a -> CWMin a
CWMin Point d r
p) (CWMax (Point d r) -> CWMax (Point d r) :+ ()
forall a. a -> a :+ ()
ext (CWMax (Point d r) -> CWMax (Point d r) :+ ())
-> CWMax (Point d r) -> CWMax (Point d r) :+ ()
forall a b. (a -> b) -> a -> b
$ Point d r -> CWMax (Point d r)
forall a. a -> CWMax a
CWMax Point d r
p)

instance IsBoxable (Box d p r) where
  boundingBox :: Box d p r -> Box (Dimension (Box d p r)) () (NumType (Box d p r))
boundingBox (Box CWMin (Point d r) :+ p
m CWMax (Point d r) :+ p
m') = (CWMin (Point d r) :+ ())
-> (CWMax (Point d r) :+ ()) -> Box d () r
forall (d :: Nat) p r.
(CWMin (Point d r) :+ p) -> (CWMax (Point d r) :+ p) -> Box d p r
Box (CWMin (Point d r) :+ p
m(CWMin (Point d r) :+ p)
-> ((CWMin (Point d r) :+ p) -> CWMin (Point d r) :+ ())
-> CWMin (Point d r) :+ ()
forall a b. a -> (a -> b) -> b
&(p -> Identity ())
-> (CWMin (Point d r) :+ p) -> Identity (CWMin (Point d r) :+ ())
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra ((p -> Identity ())
 -> (CWMin (Point d r) :+ p) -> Identity (CWMin (Point d r) :+ ()))
-> () -> (CWMin (Point d r) :+ p) -> CWMin (Point d r) :+ ()
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ()) (CWMax (Point d r) :+ p
m'(CWMax (Point d r) :+ p)
-> ((CWMax (Point d r) :+ p) -> CWMax (Point d r) :+ ())
-> CWMax (Point d r) :+ ()
forall a b. a -> (a -> b) -> b
&(p -> Identity ())
-> (CWMax (Point d r) :+ p) -> Identity (CWMax (Point d r) :+ ())
forall core extra extra'.
Lens (core :+ extra) (core :+ extra') extra extra'
extra ((p -> Identity ())
 -> (CWMax (Point d r) :+ p) -> Identity (CWMax (Point d r) :+ ()))
-> () -> (CWMax (Point d r) :+ p) -> CWMax (Point d r) :+ ()
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ())

instance IsBoxable c => IsBoxable (c :+ e) where
  boundingBox :: (c :+ e) -> Box (Dimension (c :+ e)) () (NumType (c :+ e))
boundingBox = c -> Box (Dimension c) () (NumType c)
forall g.
(IsBoxable g, Ord (NumType g)) =>
g -> Box (Dimension g) () (NumType g)
boundingBox (c -> Box (Dimension c) () (NumType c))
-> ((c :+ e) -> c) -> (c :+ e) -> Box (Dimension c) () (NumType c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting c (c :+ e) c -> (c :+ e) -> c
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting c (c :+ e) c
forall core extra core'.
Lens (core :+ extra) (core' :+ extra) core core'
core