{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module Diagrams.BoundingBox
(
BoundingBox
, emptyBox, fromCorners, fromPoint, fromPoints
, boundingBox
, isEmptyBox
, getCorners, getAllCorners
, boxExtents, boxCenter
, mCenterPoint, centerPoint
, boxTransform, boxFit
, contains, contains'
, inside, inside', outside, outside'
, boxGrid
, union, intersection
) where
import Control.Lens (AsEmpty (..), Each (..), nearly)
import Data.Foldable as F
import Data.Maybe (fromMaybe)
import Data.Semigroup
import Text.Read
import Diagrams.Align
import Diagrams.Core
import Diagrams.Core.Transform
import Diagrams.Path
import Diagrams.Query
import Diagrams.ThreeD.Shapes (cube)
import Diagrams.ThreeD.Types
import Diagrams.TwoD.Path ()
import Diagrams.TwoD.Shapes
import Diagrams.TwoD.Types
import Control.Applicative
import Data.Traversable as T
import Linear.Affine
import Linear.Metric
import Linear.Vector
newtype NonEmptyBoundingBox v n = NonEmptyBoundingBox (Point v n, Point v n)
deriving (NonEmptyBoundingBox v n -> NonEmptyBoundingBox v n -> Bool
(NonEmptyBoundingBox v n -> NonEmptyBoundingBox v n -> Bool)
-> (NonEmptyBoundingBox v n -> NonEmptyBoundingBox v n -> Bool)
-> Eq (NonEmptyBoundingBox v n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (v :: * -> *) n.
Eq (v n) =>
NonEmptyBoundingBox v n -> NonEmptyBoundingBox v n -> Bool
/= :: NonEmptyBoundingBox v n -> NonEmptyBoundingBox v n -> Bool
$c/= :: forall (v :: * -> *) n.
Eq (v n) =>
NonEmptyBoundingBox v n -> NonEmptyBoundingBox v n -> Bool
== :: NonEmptyBoundingBox v n -> NonEmptyBoundingBox v n -> Bool
$c== :: forall (v :: * -> *) n.
Eq (v n) =>
NonEmptyBoundingBox v n -> NonEmptyBoundingBox v n -> Bool
Eq, a -> NonEmptyBoundingBox v b -> NonEmptyBoundingBox v a
(a -> b) -> NonEmptyBoundingBox v a -> NonEmptyBoundingBox v b
(forall a b.
(a -> b) -> NonEmptyBoundingBox v a -> NonEmptyBoundingBox v b)
-> (forall a b.
a -> NonEmptyBoundingBox v b -> NonEmptyBoundingBox v a)
-> Functor (NonEmptyBoundingBox v)
forall a b. a -> NonEmptyBoundingBox v b -> NonEmptyBoundingBox v a
forall a b.
(a -> b) -> NonEmptyBoundingBox v a -> NonEmptyBoundingBox v b
forall (v :: * -> *) a b.
Functor v =>
a -> NonEmptyBoundingBox v b -> NonEmptyBoundingBox v a
forall (v :: * -> *) a b.
Functor v =>
(a -> b) -> NonEmptyBoundingBox v a -> NonEmptyBoundingBox v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> NonEmptyBoundingBox v b -> NonEmptyBoundingBox v a
$c<$ :: forall (v :: * -> *) a b.
Functor v =>
a -> NonEmptyBoundingBox v b -> NonEmptyBoundingBox v a
fmap :: (a -> b) -> NonEmptyBoundingBox v a -> NonEmptyBoundingBox v b
$cfmap :: forall (v :: * -> *) a b.
Functor v =>
(a -> b) -> NonEmptyBoundingBox v a -> NonEmptyBoundingBox v b
Functor)
type instance V (NonEmptyBoundingBox v n) = v
type instance N (NonEmptyBoundingBox v n) = n
fromNonEmpty :: NonEmptyBoundingBox v n -> BoundingBox v n
fromNonEmpty :: NonEmptyBoundingBox v n -> BoundingBox v n
fromNonEmpty = Option (NonEmptyBoundingBox v n) -> BoundingBox v n
forall (v :: * -> *) n.
Option (NonEmptyBoundingBox v n) -> BoundingBox v n
BoundingBox (Option (NonEmptyBoundingBox v n) -> BoundingBox v n)
-> (NonEmptyBoundingBox v n -> Option (NonEmptyBoundingBox v n))
-> NonEmptyBoundingBox v n
-> BoundingBox v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (NonEmptyBoundingBox v n) -> Option (NonEmptyBoundingBox v n)
forall a. Maybe a -> Option a
Option (Maybe (NonEmptyBoundingBox v n)
-> Option (NonEmptyBoundingBox v n))
-> (NonEmptyBoundingBox v n -> Maybe (NonEmptyBoundingBox v n))
-> NonEmptyBoundingBox v n
-> Option (NonEmptyBoundingBox v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyBoundingBox v n -> Maybe (NonEmptyBoundingBox v n)
forall a. a -> Maybe a
Just
fromMaybeEmpty :: Maybe (NonEmptyBoundingBox v n) -> BoundingBox v n
fromMaybeEmpty :: Maybe (NonEmptyBoundingBox v n) -> BoundingBox v n
fromMaybeEmpty = BoundingBox v n
-> (NonEmptyBoundingBox v n -> BoundingBox v n)
-> Maybe (NonEmptyBoundingBox v n)
-> BoundingBox v n
forall b a. b -> (a -> b) -> Maybe a -> b
maybe BoundingBox v n
forall (v :: * -> *) n. BoundingBox v n
emptyBox NonEmptyBoundingBox v n -> BoundingBox v n
forall (v :: * -> *) n. NonEmptyBoundingBox v n -> BoundingBox v n
fromNonEmpty
nonEmptyCorners :: NonEmptyBoundingBox v n -> (Point v n, Point v n)
nonEmptyCorners :: NonEmptyBoundingBox v n -> (Point v n, Point v n)
nonEmptyCorners (NonEmptyBoundingBox x :: (Point v n, Point v n)
x) = (Point v n, Point v n)
x
instance (Additive v, Ord n) => Semigroup (NonEmptyBoundingBox v n) where
(NonEmptyBoundingBox (ul :: Point v n
ul, uh :: Point v n
uh)) <> :: NonEmptyBoundingBox v n
-> NonEmptyBoundingBox v n -> NonEmptyBoundingBox v n
<> (NonEmptyBoundingBox (vl :: Point v n
vl, vh :: Point v n
vh))
= (Point v n, Point v n) -> NonEmptyBoundingBox v n
forall (v :: * -> *) n.
(Point v n, Point v n) -> NonEmptyBoundingBox v n
NonEmptyBoundingBox ((n -> n -> n) -> Point v n -> Point v n -> Point v n
forall (f :: * -> *) a.
Additive f =>
(a -> a -> a) -> f a -> f a -> f a
liftU2 n -> n -> n
forall a. Ord a => a -> a -> a
min Point v n
ul Point v n
vl, (n -> n -> n) -> Point v n -> Point v n -> Point v n
forall (f :: * -> *) a.
Additive f =>
(a -> a -> a) -> f a -> f a -> f a
liftU2 n -> n -> n
forall a. Ord a => a -> a -> a
max Point v n
uh Point v n
vh)
newtype BoundingBox v n = BoundingBox (Option (NonEmptyBoundingBox v n))
deriving (BoundingBox v n -> BoundingBox v n -> Bool
(BoundingBox v n -> BoundingBox v n -> Bool)
-> (BoundingBox v n -> BoundingBox v n -> Bool)
-> Eq (BoundingBox v n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (v :: * -> *) n.
Eq (v n) =>
BoundingBox v n -> BoundingBox v n -> Bool
/= :: BoundingBox v n -> BoundingBox v n -> Bool
$c/= :: forall (v :: * -> *) n.
Eq (v n) =>
BoundingBox v n -> BoundingBox v n -> Bool
== :: BoundingBox v n -> BoundingBox v n -> Bool
$c== :: forall (v :: * -> *) n.
Eq (v n) =>
BoundingBox v n -> BoundingBox v n -> Bool
Eq, a -> BoundingBox v b -> BoundingBox v a
(a -> b) -> BoundingBox v a -> BoundingBox v b
(forall a b. (a -> b) -> BoundingBox v a -> BoundingBox v b)
-> (forall a b. a -> BoundingBox v b -> BoundingBox v a)
-> Functor (BoundingBox v)
forall a b. a -> BoundingBox v b -> BoundingBox v a
forall a b. (a -> b) -> BoundingBox v a -> BoundingBox v b
forall (v :: * -> *) a b.
Functor v =>
a -> BoundingBox v b -> BoundingBox v a
forall (v :: * -> *) a b.
Functor v =>
(a -> b) -> BoundingBox v a -> BoundingBox v b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> BoundingBox v b -> BoundingBox v a
$c<$ :: forall (v :: * -> *) a b.
Functor v =>
a -> BoundingBox v b -> BoundingBox v a
fmap :: (a -> b) -> BoundingBox v a -> BoundingBox v b
$cfmap :: forall (v :: * -> *) a b.
Functor v =>
(a -> b) -> BoundingBox v a -> BoundingBox v b
Functor)
deriving instance (Additive v, Ord n) => Semigroup (BoundingBox v n)
deriving instance (Additive v, Ord n) => Monoid (BoundingBox v n)
instance AsEmpty (BoundingBox v n) where
_Empty :: p () (f ()) -> p (BoundingBox v n) (f (BoundingBox v n))
_Empty = BoundingBox v n
-> (BoundingBox v n -> Bool) -> Prism' (BoundingBox v n) ()
forall a. a -> (a -> Bool) -> Prism' a ()
nearly BoundingBox v n
forall (v :: * -> *) n. BoundingBox v n
emptyBox BoundingBox v n -> Bool
forall (v :: * -> *) n. BoundingBox v n -> Bool
isEmptyBox
instance (Additive v', Foldable v', Ord n') =>
Each (BoundingBox v n) (BoundingBox v' n') (Point v n) (Point v' n') where
each :: (Point v n -> f (Point v' n'))
-> BoundingBox v n -> f (BoundingBox v' n')
each f :: Point v n -> f (Point v' n')
f (BoundingBox v n -> Maybe (Point v n, Point v n)
forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners -> Just (l :: Point v n
l, u :: Point v n
u)) = Point v' n' -> Point v' n' -> BoundingBox v' n'
forall (v :: * -> *) n.
(Additive v, Foldable v, Ord n) =>
Point v n -> Point v n -> BoundingBox v n
fromCorners (Point v' n' -> Point v' n' -> BoundingBox v' n')
-> f (Point v' n') -> f (Point v' n' -> BoundingBox v' n')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point v n -> f (Point v' n')
f Point v n
l f (Point v' n' -> BoundingBox v' n')
-> f (Point v' n') -> f (BoundingBox v' n')
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point v n -> f (Point v' n')
f Point v n
u
each _ _ = BoundingBox v' n' -> f (BoundingBox v' n')
forall (f :: * -> *) a. Applicative f => a -> f a
pure BoundingBox v' n'
forall (v :: * -> *) n. BoundingBox v n
emptyBox
type instance V (BoundingBox v n) = v
type instance N (BoundingBox v n) = n
mapT :: (a -> b) -> (a, a) -> (b, b)
mapT :: (a -> b) -> (a, a) -> (b, b)
mapT f :: a -> b
f (x :: a
x, y :: a
y) = (a -> b
f a
x, a -> b
f a
y)
instance (Additive v, Num n) => HasOrigin (BoundingBox v n) where
moveOriginTo :: Point (V (BoundingBox v n)) (N (BoundingBox v n))
-> BoundingBox v n -> BoundingBox v n
moveOriginTo p :: Point (V (BoundingBox v n)) (N (BoundingBox v n))
p b :: BoundingBox v n
b
= Maybe (NonEmptyBoundingBox v n) -> BoundingBox v n
forall (v :: * -> *) n.
Maybe (NonEmptyBoundingBox v n) -> BoundingBox v n
fromMaybeEmpty
((Point v n, Point v n) -> NonEmptyBoundingBox v n
forall (v :: * -> *) n.
(Point v n, Point v n) -> NonEmptyBoundingBox v n
NonEmptyBoundingBox ((Point v n, Point v n) -> NonEmptyBoundingBox v n)
-> ((Point v n, Point v n) -> (Point v n, Point v n))
-> (Point v n, Point v n)
-> NonEmptyBoundingBox v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point v n -> Point v n)
-> (Point v n, Point v n) -> (Point v n, Point v n)
forall a b. (a -> b) -> (a, a) -> (b, b)
mapT (Point (V (Point v n)) (N (Point v n)) -> Point v n -> Point v n
forall t. HasOrigin t => Point (V t) (N t) -> t -> t
moveOriginTo Point (V (Point v n)) (N (Point v n))
Point (V (BoundingBox v n)) (N (BoundingBox v n))
p) ((Point v n, Point v n) -> NonEmptyBoundingBox v n)
-> Maybe (Point v n, Point v n) -> Maybe (NonEmptyBoundingBox v n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BoundingBox v n -> Maybe (Point v n, Point v n)
forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
b)
instance (Additive v, Foldable v, Ord n)
=> HasQuery (BoundingBox v n) Any where
getQuery :: BoundingBox v n
-> Query (V (BoundingBox v n)) (N (BoundingBox v n)) Any
getQuery bb :: BoundingBox v n
bb = (Point v n -> Any)
-> Query (V (BoundingBox v n)) (N (BoundingBox v n)) Any
forall (v :: * -> *) n m. (Point v n -> m) -> Query v n m
Query ((Point v n -> Any)
-> Query (V (BoundingBox v n)) (N (BoundingBox v n)) Any)
-> (Point v n -> Any)
-> Query (V (BoundingBox v n)) (N (BoundingBox v n)) Any
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any (Bool -> Any) -> (Point v n -> Bool) -> Point v n -> Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundingBox v n -> Point v n -> Bool
forall (v :: * -> *) n.
(Additive v, Foldable v, Ord n) =>
BoundingBox v n -> Point v n -> Bool
contains BoundingBox v n
bb
instance (Metric v, Traversable v, OrderedField n)
=> Enveloped (BoundingBox v n) where
getEnvelope :: BoundingBox v n
-> Envelope (V (BoundingBox v n)) (N (BoundingBox v n))
getEnvelope = [Point v n] -> Envelope v n
forall a. Enveloped a => a -> Envelope (V a) (N a)
getEnvelope ([Point v n] -> Envelope v n)
-> (BoundingBox v n -> [Point v n])
-> BoundingBox v n
-> Envelope v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundingBox v n -> [Point v n]
forall (v :: * -> *) n.
(Additive v, Traversable v) =>
BoundingBox v n -> [Point v n]
getAllCorners
instance RealFloat n => Traced (BoundingBox V2 n) where
getTrace :: BoundingBox V2 n
-> Trace (V (BoundingBox V2 n)) (N (BoundingBox V2 n))
getTrace = Path V2 n -> Trace V2 n
forall a. Traced a => a -> Trace (V a) (N a)
getTrace
(Path V2 n -> Trace V2 n)
-> (BoundingBox V2 n -> Path V2 n)
-> BoundingBox V2 n
-> Trace V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((BoundingBox V2 n -> Path V2 n -> Path V2 n
forall (v :: * -> *) n a.
(InSpace v n a, HasBasis v, Enveloped a, Transformable a,
Monoid a) =>
BoundingBox v n -> a -> a
`boxFit` n -> n -> Path V2 n
forall n t. (InSpace V2 n t, TrailLike t) => n -> n -> t
rect 1 1) (BoundingBox V2 n -> Path V2 n)
-> (Envelope V2 n -> BoundingBox V2 n)
-> Envelope V2 n
-> Path V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Envelope V2 n -> BoundingBox V2 n
forall (v :: * -> *) n a.
(InSpace v n a, HasBasis v, Enveloped a) =>
a -> BoundingBox v n
boundingBox :: Envelope V2 n -> Path V2 n)
(Envelope V2 n -> Path V2 n)
-> (BoundingBox V2 n -> Envelope V2 n)
-> BoundingBox V2 n
-> Path V2 n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundingBox V2 n -> Envelope V2 n
forall a. Enveloped a => a -> Envelope (V a) (N a)
getEnvelope
instance TypeableFloat n => Traced (BoundingBox V3 n) where
getTrace :: BoundingBox V3 n
-> Trace (V (BoundingBox V3 n)) (N (BoundingBox V3 n))
getTrace bb :: BoundingBox V3 n
bb = (Transformation V3 n -> Trace V3 n)
-> Maybe (Transformation V3 n) -> Trace V3 n
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\tr :: Transformation V3 n
tr -> Box n -> Trace V3 n
forall a. Traced a => a -> Trace (V a) (N a)
getTrace (Box n -> Trace V3 n) -> Box n -> Trace V3 n
forall a b. (a -> b) -> a -> b
$ Transformation (V (Box n)) (N (Box n)) -> Box n -> Box n
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation (V (Box n)) (N (Box n))
Transformation V3 n
tr Box n
forall n. Num n => Box n
cube) (Maybe (Transformation V3 n)
-> Trace (V (BoundingBox V3 n)) (N (BoundingBox V3 n)))
-> Maybe (Transformation V3 n)
-> Trace (V (BoundingBox V3 n)) (N (BoundingBox V3 n))
forall a b. (a -> b) -> a -> b
$
BoundingBox V3 n -> BoundingBox V3 n -> Maybe (Transformation V3 n)
forall (v :: * -> *) n.
(Additive v, Fractional n) =>
BoundingBox v n -> BoundingBox v n -> Maybe (Transformation v n)
boxTransform (Box n -> BoundingBox V3 n
forall (v :: * -> *) n a.
(InSpace v n a, HasBasis v, Enveloped a) =>
a -> BoundingBox v n
boundingBox Box n
forall n. Num n => Box n
cube) BoundingBox V3 n
bb
instance (Metric v, Traversable v, OrderedField n) => Alignable (BoundingBox v n) where
defaultBoundary :: v n -> BoundingBox v n -> Point v n
defaultBoundary = v n -> BoundingBox v n -> Point v n
forall a (v :: * -> *) n.
(V a ~ v, N a ~ n, Enveloped a) =>
v n -> a -> Point v n
envelopeP
instance Show (v n) => Show (BoundingBox v n) where
showsPrec :: Int -> BoundingBox v n -> ShowS
showsPrec d :: Int
d b :: BoundingBox v n
b = case BoundingBox v n -> Maybe (Point v n, Point v n)
forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
b of
Just (l :: Point v n
l, u :: Point v n
u) -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString "fromCorners " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Point v n -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11 Point v n
l ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar ' ' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Point v n -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11 Point v n
u
Nothing -> String -> ShowS
showString "emptyBox"
instance Read (v n) => Read (BoundingBox v n) where
readPrec :: ReadPrec (BoundingBox v n)
readPrec = ReadPrec (BoundingBox v n) -> ReadPrec (BoundingBox v n)
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec (BoundingBox v n) -> ReadPrec (BoundingBox v n))
-> ReadPrec (BoundingBox v n) -> ReadPrec (BoundingBox v n)
forall a b. (a -> b) -> a -> b
$
(do
Ident "emptyBox" <- ReadPrec Lexeme
lexP
BoundingBox v n -> ReadPrec (BoundingBox v n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure BoundingBox v n
forall (v :: * -> *) n. BoundingBox v n
emptyBox
) ReadPrec (BoundingBox v n)
-> ReadPrec (BoundingBox v n) -> ReadPrec (BoundingBox v n)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Int -> ReadPrec (BoundingBox v n) -> ReadPrec (BoundingBox v n)
forall a. Int -> ReadPrec a -> ReadPrec a
prec 10 (ReadPrec (BoundingBox v n) -> ReadPrec (BoundingBox v n))
-> ReadPrec (BoundingBox v n) -> ReadPrec (BoundingBox v n)
forall a b. (a -> b) -> a -> b
$ do
Ident "fromCorners" <- ReadPrec Lexeme
lexP
Point v n
l <- ReadPrec (Point v n) -> ReadPrec (Point v n)
forall a. ReadPrec a -> ReadPrec a
step ReadPrec (Point v n)
forall a. Read a => ReadPrec a
readPrec
Point v n
h <- ReadPrec (Point v n) -> ReadPrec (Point v n)
forall a. ReadPrec a -> ReadPrec a
step ReadPrec (Point v n)
forall a. Read a => ReadPrec a
readPrec
BoundingBox v n -> ReadPrec (BoundingBox v n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BoundingBox v n -> ReadPrec (BoundingBox v n))
-> (NonEmptyBoundingBox v n -> BoundingBox v n)
-> NonEmptyBoundingBox v n
-> ReadPrec (BoundingBox v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyBoundingBox v n -> BoundingBox v n
forall (v :: * -> *) n. NonEmptyBoundingBox v n -> BoundingBox v n
fromNonEmpty (NonEmptyBoundingBox v n -> ReadPrec (BoundingBox v n))
-> NonEmptyBoundingBox v n -> ReadPrec (BoundingBox v n)
forall a b. (a -> b) -> a -> b
$ (Point v n, Point v n) -> NonEmptyBoundingBox v n
forall (v :: * -> *) n.
(Point v n, Point v n) -> NonEmptyBoundingBox v n
NonEmptyBoundingBox (Point v n
l, Point v n
h)
)
emptyBox :: BoundingBox v n
emptyBox :: BoundingBox v n
emptyBox = Option (NonEmptyBoundingBox v n) -> BoundingBox v n
forall (v :: * -> *) n.
Option (NonEmptyBoundingBox v n) -> BoundingBox v n
BoundingBox (Option (NonEmptyBoundingBox v n) -> BoundingBox v n)
-> Option (NonEmptyBoundingBox v n) -> BoundingBox v n
forall a b. (a -> b) -> a -> b
$ Maybe (NonEmptyBoundingBox v n) -> Option (NonEmptyBoundingBox v n)
forall a. Maybe a -> Option a
Option Maybe (NonEmptyBoundingBox v n)
forall a. Maybe a
Nothing
fromCorners
:: (Additive v, Foldable v, Ord n)
=> Point v n -> Point v n -> BoundingBox v n
fromCorners :: Point v n -> Point v n -> BoundingBox v n
fromCorners l :: Point v n
l h :: Point v n
h
| Point v Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
F.and ((n -> n -> Bool) -> Point v n -> Point v n -> Point v Bool
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 n -> n -> Bool
forall a. Ord a => a -> a -> Bool
(<=) Point v n
l Point v n
h) = NonEmptyBoundingBox v n -> BoundingBox v n
forall (v :: * -> *) n. NonEmptyBoundingBox v n -> BoundingBox v n
fromNonEmpty (NonEmptyBoundingBox v n -> BoundingBox v n)
-> NonEmptyBoundingBox v n -> BoundingBox v n
forall a b. (a -> b) -> a -> b
$ (Point v n, Point v n) -> NonEmptyBoundingBox v n
forall (v :: * -> *) n.
(Point v n, Point v n) -> NonEmptyBoundingBox v n
NonEmptyBoundingBox (Point v n
l, Point v n
h)
| Bool
otherwise = BoundingBox v n
forall a. Monoid a => a
mempty
fromPoint :: Point v n -> BoundingBox v n
fromPoint :: Point v n -> BoundingBox v n
fromPoint p :: Point v n
p = NonEmptyBoundingBox v n -> BoundingBox v n
forall (v :: * -> *) n. NonEmptyBoundingBox v n -> BoundingBox v n
fromNonEmpty (NonEmptyBoundingBox v n -> BoundingBox v n)
-> NonEmptyBoundingBox v n -> BoundingBox v n
forall a b. (a -> b) -> a -> b
$ (Point v n, Point v n) -> NonEmptyBoundingBox v n
forall (v :: * -> *) n.
(Point v n, Point v n) -> NonEmptyBoundingBox v n
NonEmptyBoundingBox (Point v n
p, Point v n
p)
fromPoints :: (Additive v, Ord n) => [Point v n] -> BoundingBox v n
fromPoints :: [Point v n] -> BoundingBox v n
fromPoints = [BoundingBox v n] -> BoundingBox v n
forall a. Monoid a => [a] -> a
mconcat ([BoundingBox v n] -> BoundingBox v n)
-> ([Point v n] -> [BoundingBox v n])
-> [Point v n]
-> BoundingBox v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point v n -> BoundingBox v n) -> [Point v n] -> [BoundingBox v n]
forall a b. (a -> b) -> [a] -> [b]
map Point v n -> BoundingBox v n
forall (v :: * -> *) n. Point v n -> BoundingBox v n
fromPoint
boundingBox :: (InSpace v n a, HasBasis v, Enveloped a)
=> a -> BoundingBox v n
boundingBox :: a -> BoundingBox v n
boundingBox a :: a
a = Maybe (NonEmptyBoundingBox v n) -> BoundingBox v n
forall (v :: * -> *) n.
Maybe (NonEmptyBoundingBox v n) -> BoundingBox v n
fromMaybeEmpty (Maybe (NonEmptyBoundingBox v n) -> BoundingBox v n)
-> Maybe (NonEmptyBoundingBox v n) -> BoundingBox v n
forall a b. (a -> b) -> a -> b
$ do
v n -> n
env <- (Envelope v n -> Maybe (v n -> n)
forall (v :: * -> *) n. Envelope v n -> Maybe (v n -> n)
appEnvelope (Envelope v n -> Maybe (v n -> n))
-> (a -> Envelope v n) -> a -> Maybe (v n -> n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Envelope v n
forall a. Enveloped a => a -> Envelope (V a) (N a)
getEnvelope) a
a
let h :: v n
h = (v n -> n) -> v (v n) -> v n
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v n -> n
env v (v n)
forall (v :: * -> *) n. (HasBasis v, Num n) => v (v n)
eye
l :: v n
l = v n -> v n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated (v n -> v n) -> v n -> v n
forall a b. (a -> b) -> a -> b
$ (v n -> n) -> v (v n) -> v n
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (v n -> n
env (v n -> n) -> (v n -> v n) -> v n -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v n -> v n
forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated) v (v n)
forall (v :: * -> *) n. (HasBasis v, Num n) => v (v n)
eye
NonEmptyBoundingBox v n -> Maybe (NonEmptyBoundingBox v n)
forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmptyBoundingBox v n -> Maybe (NonEmptyBoundingBox v n))
-> NonEmptyBoundingBox v n -> Maybe (NonEmptyBoundingBox v n)
forall a b. (a -> b) -> a -> b
$ (Point v n, Point v n) -> NonEmptyBoundingBox v n
forall (v :: * -> *) n.
(Point v n, Point v n) -> NonEmptyBoundingBox v n
NonEmptyBoundingBox (v n -> Point v n
forall (f :: * -> *) a. f a -> Point f a
P v n
l, v n -> Point v n
forall (f :: * -> *) a. f a -> Point f a
P v n
h)
isEmptyBox :: BoundingBox v n -> Bool
isEmptyBox :: BoundingBox v n -> Bool
isEmptyBox (BoundingBox (Option Nothing)) = Bool
True
isEmptyBox _ = Bool
False
getCorners :: BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners :: BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners (BoundingBox p :: Option (NonEmptyBoundingBox v n)
p) = NonEmptyBoundingBox v n -> (Point v n, Point v n)
forall (v :: * -> *) n.
NonEmptyBoundingBox v n -> (Point v n, Point v n)
nonEmptyCorners (NonEmptyBoundingBox v n -> (Point v n, Point v n))
-> Maybe (NonEmptyBoundingBox v n) -> Maybe (Point v n, Point v n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Option (NonEmptyBoundingBox v n) -> Maybe (NonEmptyBoundingBox v n)
forall a. Option a -> Maybe a
getOption Option (NonEmptyBoundingBox v n)
p
getAllCorners :: (Additive v, Traversable v) => BoundingBox v n -> [Point v n]
getAllCorners :: BoundingBox v n -> [Point v n]
getAllCorners (BoundingBox (Option Nothing)) = []
getAllCorners (BoundingBox (Option (Just (NonEmptyBoundingBox (l :: Point v n
l, u :: Point v n
u)))))
= Point v [n] -> [Point v n]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
T.sequence ((n -> n -> [n]) -> Point v n -> Point v n -> Point v [n]
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 (\a :: n
a b :: n
b -> [n
a,n
b]) Point v n
l Point v n
u)
boxExtents :: (Additive v, Num n) => BoundingBox v n -> v n
boxExtents :: BoundingBox v n -> v n
boxExtents = v n
-> ((Point v n, Point v n) -> v n)
-> Maybe (Point v n, Point v n)
-> v n
forall b a. b -> (a -> b) -> Maybe a -> b
maybe v n
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero (\(l :: Point v n
l,u :: Point v n
u) -> Point v n
u Point v n -> Point v n -> Diff (Point v) n
forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point v n
l) (Maybe (Point v n, Point v n) -> v n)
-> (BoundingBox v n -> Maybe (Point v n, Point v n))
-> BoundingBox v n
-> v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundingBox v n -> Maybe (Point v n, Point v n)
forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners
boxCenter :: (Additive v, Fractional n) => BoundingBox v n -> Maybe (Point v n)
boxCenter :: BoundingBox v n -> Maybe (Point v n)
boxCenter = ((Point v n, Point v n) -> Point v n)
-> Maybe (Point v n, Point v n) -> Maybe (Point v n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Point v n -> Point v n -> Point v n)
-> (Point v n, Point v n) -> Point v n
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (n -> Point v n -> Point v n -> Point v n
forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp 0.5)) (Maybe (Point v n, Point v n) -> Maybe (Point v n))
-> (BoundingBox v n -> Maybe (Point v n, Point v n))
-> BoundingBox v n
-> Maybe (Point v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundingBox v n -> Maybe (Point v n, Point v n)
forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners
mCenterPoint :: (InSpace v n a, HasBasis v, Enveloped a)
=> a -> Maybe (Point v n)
mCenterPoint :: a -> Maybe (Point v n)
mCenterPoint = BoundingBox v n -> Maybe (Point v n)
forall (v :: * -> *) n.
(Additive v, Fractional n) =>
BoundingBox v n -> Maybe (Point v n)
boxCenter (BoundingBox v n -> Maybe (Point v n))
-> (a -> BoundingBox v n) -> a -> Maybe (Point v n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> BoundingBox v n
forall (v :: * -> *) n a.
(InSpace v n a, HasBasis v, Enveloped a) =>
a -> BoundingBox v n
boundingBox
centerPoint :: (InSpace v n a, HasBasis v, Enveloped a)
=> a -> Point v n
centerPoint :: a -> Point v n
centerPoint = Point v n -> Maybe (Point v n) -> Point v n
forall a. a -> Maybe a -> a
fromMaybe Point v n
forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin (Maybe (Point v n) -> Point v n)
-> (a -> Maybe (Point v n)) -> a -> Point v n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe (Point v n)
forall (v :: * -> *) n a.
(InSpace v n a, HasBasis v, Enveloped a) =>
a -> Maybe (Point v n)
mCenterPoint
boxTransform
:: (Additive v, Fractional n)
=> BoundingBox v n -> BoundingBox v n -> Maybe (Transformation v n)
boxTransform :: BoundingBox v n -> BoundingBox v n -> Maybe (Transformation v n)
boxTransform u :: BoundingBox v n
u v :: BoundingBox v n
v = do
(P ul :: v n
ul, _) <- BoundingBox v n -> Maybe (Point v n, Point v n)
forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
u
(P vl :: v n
vl, _) <- BoundingBox v n -> Maybe (Point v n, Point v n)
forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
v
let i :: v n :-: v n
i = (BoundingBox v n, BoundingBox v n) -> v n -> v n
forall (f :: * -> *) a.
(Additive f, Fractional a) =>
(BoundingBox f a, BoundingBox f a) -> f a -> f a
s (BoundingBox v n
v, BoundingBox v n
u) (v n -> v n) -> (v n -> v n) -> v n :-: v n
forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> (BoundingBox v n, BoundingBox v n) -> v n -> v n
forall (f :: * -> *) a.
(Additive f, Fractional a) =>
(BoundingBox f a, BoundingBox f a) -> f a -> f a
s (BoundingBox v n
u, BoundingBox v n
v)
s :: (BoundingBox f a, BoundingBox f a) -> f a -> f a
s = (a -> a -> a) -> f a -> f a -> f a
forall (f :: * -> *) a.
Additive f =>
(a -> a -> a) -> f a -> f a -> f a
liftU2 a -> a -> a
forall a. Num a => a -> a -> a
(*) (f a -> f a -> f a)
-> ((BoundingBox f a, BoundingBox f a) -> f a)
-> (BoundingBox f a, BoundingBox f a)
-> f a
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f a -> f a -> f a) -> (f a, f a) -> f a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((a -> a -> a) -> f a -> f a -> f a
forall (f :: * -> *) a.
Additive f =>
(a -> a -> a) -> f a -> f a -> f a
liftU2 a -> a -> a
forall a. Fractional a => a -> a -> a
(/)) ((f a, f a) -> f a)
-> ((BoundingBox f a, BoundingBox f a) -> (f a, f a))
-> (BoundingBox f a, BoundingBox f a)
-> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BoundingBox f a -> f a)
-> (BoundingBox f a, BoundingBox f a) -> (f a, f a)
forall a b. (a -> b) -> (a, a) -> (b, b)
mapT BoundingBox f a -> f a
forall (v :: * -> *) n.
(Additive v, Num n) =>
BoundingBox v n -> v n
boxExtents
Transformation v n -> Maybe (Transformation v n)
forall (m :: * -> *) a. Monad m => a -> m a
return (Transformation v n -> Maybe (Transformation v n))
-> Transformation v n -> Maybe (Transformation v n)
forall a b. (a -> b) -> a -> b
$ (v n :-: v n) -> (v n :-: v n) -> v n -> Transformation v n
forall (v :: * -> *) n.
(v n :-: v n) -> (v n :-: v n) -> v n -> Transformation v n
Transformation v n :-: v n
i v n :-: v n
i (v n
vl v n -> v n -> v n
forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ (BoundingBox v n, BoundingBox v n) -> v n -> v n
forall (f :: * -> *) a.
(Additive f, Fractional a) =>
(BoundingBox f a, BoundingBox f a) -> f a -> f a
s (BoundingBox v n
v, BoundingBox v n
u) v n
ul)
boxFit
:: (InSpace v n a, HasBasis v, Enveloped a, Transformable a, Monoid a)
=> BoundingBox v n -> a -> a
boxFit :: BoundingBox v n -> a -> a
boxFit b :: BoundingBox v n
b x :: a
x = a -> (Transformation v n -> a) -> Maybe (Transformation v n) -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
forall a. Monoid a => a
mempty (Transformation (V a) (N a) -> a -> a
forall t. Transformable t => Transformation (V t) (N t) -> t -> t
`transform` a
x) (Maybe (Transformation v n) -> a)
-> Maybe (Transformation v n) -> a
forall a b. (a -> b) -> a -> b
$ BoundingBox v n -> BoundingBox v n -> Maybe (Transformation v n)
forall (v :: * -> *) n.
(Additive v, Fractional n) =>
BoundingBox v n -> BoundingBox v n -> Maybe (Transformation v n)
boxTransform (a -> BoundingBox v n
forall (v :: * -> *) n a.
(InSpace v n a, HasBasis v, Enveloped a) =>
a -> BoundingBox v n
boundingBox a
x) BoundingBox v n
b
contains :: (Additive v, Foldable v, Ord n) => BoundingBox v n -> Point v n -> Bool
contains :: BoundingBox v n -> Point v n -> Bool
contains b :: BoundingBox v n
b p :: Point v n
p = Bool
-> ((Point v n, Point v n) -> Bool)
-> Maybe (Point v n, Point v n)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Point v n, Point v n) -> Bool
check (Maybe (Point v n, Point v n) -> Bool)
-> Maybe (Point v n, Point v n) -> Bool
forall a b. (a -> b) -> a -> b
$ BoundingBox v n -> Maybe (Point v n, Point v n)
forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
b
where
check :: (Point v n, Point v n) -> Bool
check (l :: Point v n
l, h :: Point v n
h) = Point v Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
F.and ((n -> n -> Bool) -> Point v n -> Point v n -> Point v Bool
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 n -> n -> Bool
forall a. Ord a => a -> a -> Bool
(<=) Point v n
l Point v n
p)
Bool -> Bool -> Bool
&& Point v Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
F.and ((n -> n -> Bool) -> Point v n -> Point v n -> Point v Bool
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 n -> n -> Bool
forall a. Ord a => a -> a -> Bool
(<=) Point v n
p Point v n
h)
contains' :: (Additive v, Foldable v, Ord n) => BoundingBox v n -> Point v n -> Bool
contains' :: BoundingBox v n -> Point v n -> Bool
contains' b :: BoundingBox v n
b p :: Point v n
p = Bool
-> ((Point v n, Point v n) -> Bool)
-> Maybe (Point v n, Point v n)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Point v n, Point v n) -> Bool
check (Maybe (Point v n, Point v n) -> Bool)
-> Maybe (Point v n, Point v n) -> Bool
forall a b. (a -> b) -> a -> b
$ BoundingBox v n -> Maybe (Point v n, Point v n)
forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
b
where
check :: (Point v n, Point v n) -> Bool
check (l :: Point v n
l, h :: Point v n
h) = Point v Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
F.and ((n -> n -> Bool) -> Point v n -> Point v n -> Point v Bool
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 n -> n -> Bool
forall a. Ord a => a -> a -> Bool
(<) Point v n
l Point v n
p)
Bool -> Bool -> Bool
&& Point v Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
F.and ((n -> n -> Bool) -> Point v n -> Point v n -> Point v Bool
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 n -> n -> Bool
forall a. Ord a => a -> a -> Bool
(<) Point v n
p Point v n
h)
inside :: (Additive v, Foldable v, Ord n) => BoundingBox v n -> BoundingBox v n -> Bool
inside :: BoundingBox v n -> BoundingBox v n -> Bool
inside u :: BoundingBox v n
u v :: BoundingBox v n
v = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
(ul :: Point v n
ul, uh :: Point v n
uh) <- BoundingBox v n -> Maybe (Point v n, Point v n)
forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
u
(vl :: Point v n
vl, vh :: Point v n
vh) <- BoundingBox v n -> Maybe (Point v n, Point v n)
forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
v
Bool -> Maybe Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Point v Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
F.and ((n -> n -> Bool) -> Point v n -> Point v n -> Point v Bool
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 n -> n -> Bool
forall a. Ord a => a -> a -> Bool
(>=) Point v n
ul Point v n
vl)
Bool -> Bool -> Bool
&& Point v Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
F.and ((n -> n -> Bool) -> Point v n -> Point v n -> Point v Bool
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 n -> n -> Bool
forall a. Ord a => a -> a -> Bool
(<=) Point v n
uh Point v n
vh)
inside' :: (Additive v, Foldable v, Ord n) => BoundingBox v n -> BoundingBox v n -> Bool
inside' :: BoundingBox v n -> BoundingBox v n -> Bool
inside' u :: BoundingBox v n
u v :: BoundingBox v n
v = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
(ul :: Point v n
ul, uh :: Point v n
uh) <- BoundingBox v n -> Maybe (Point v n, Point v n)
forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
u
(vl :: Point v n
vl, vh :: Point v n
vh) <- BoundingBox v n -> Maybe (Point v n, Point v n)
forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
v
Bool -> Maybe Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Point v Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
F.and ((n -> n -> Bool) -> Point v n -> Point v n -> Point v Bool
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 n -> n -> Bool
forall a. Ord a => a -> a -> Bool
(>) Point v n
ul Point v n
vl)
Bool -> Bool -> Bool
&& Point v Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
F.and ((n -> n -> Bool) -> Point v n -> Point v n -> Point v Bool
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 n -> n -> Bool
forall a. Ord a => a -> a -> Bool
(<) Point v n
uh Point v n
vh)
outside :: (Additive v, Foldable v, Ord n) => BoundingBox v n -> BoundingBox v n -> Bool
outside :: BoundingBox v n -> BoundingBox v n -> Bool
outside u :: BoundingBox v n
u v :: BoundingBox v n
v = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
(ul :: Point v n
ul, uh :: Point v n
uh) <- BoundingBox v n -> Maybe (Point v n, Point v n)
forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
u
(vl :: Point v n
vl, vh :: Point v n
vh) <- BoundingBox v n -> Maybe (Point v n, Point v n)
forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
v
Bool -> Maybe Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Point v Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
F.or ((n -> n -> Bool) -> Point v n -> Point v n -> Point v Bool
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 n -> n -> Bool
forall a. Ord a => a -> a -> Bool
(<=) Point v n
uh Point v n
vl)
Bool -> Bool -> Bool
|| Point v Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
F.or ((n -> n -> Bool) -> Point v n -> Point v n -> Point v Bool
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 n -> n -> Bool
forall a. Ord a => a -> a -> Bool
(>=) Point v n
ul Point v n
vh)
outside' :: (Additive v, Foldable v, Ord n) => BoundingBox v n -> BoundingBox v n -> Bool
outside' :: BoundingBox v n -> BoundingBox v n -> Bool
outside' u :: BoundingBox v n
u v :: BoundingBox v n
v = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ do
(ul :: Point v n
ul, uh :: Point v n
uh) <- BoundingBox v n -> Maybe (Point v n, Point v n)
forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
u
(vl :: Point v n
vl, vh :: Point v n
vh) <- BoundingBox v n -> Maybe (Point v n, Point v n)
forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
v
Bool -> Maybe Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
$ Point v Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
F.or ((n -> n -> Bool) -> Point v n -> Point v n -> Point v Bool
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 n -> n -> Bool
forall a. Ord a => a -> a -> Bool
(<) Point v n
uh Point v n
vl)
Bool -> Bool -> Bool
|| Point v Bool -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
F.or ((n -> n -> Bool) -> Point v n -> Point v n -> Point v Bool
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 n -> n -> Bool
forall a. Ord a => a -> a -> Bool
(>) Point v n
ul Point v n
vh)
intersection
:: (Additive v, Foldable v, Ord n)
=> BoundingBox v n -> BoundingBox v n -> BoundingBox v n
intersection :: BoundingBox v n -> BoundingBox v n -> BoundingBox v n
intersection u :: BoundingBox v n
u v :: BoundingBox v n
v = BoundingBox v n
-> ((Point v n, Point v n) -> BoundingBox v n)
-> Maybe (Point v n, Point v n)
-> BoundingBox v n
forall b a. b -> (a -> b) -> Maybe a -> b
maybe BoundingBox v n
forall a. Monoid a => a
mempty ((Point v n -> Point v n -> BoundingBox v n)
-> (Point v n, Point v n) -> BoundingBox v n
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Point v n -> Point v n -> BoundingBox v n
forall (v :: * -> *) n.
(Additive v, Foldable v, Ord n) =>
Point v n -> Point v n -> BoundingBox v n
fromCorners) (Maybe (Point v n, Point v n) -> BoundingBox v n)
-> Maybe (Point v n, Point v n) -> BoundingBox v n
forall a b. (a -> b) -> a -> b
$ do
(ul :: Point v n
ul, uh :: Point v n
uh) <- BoundingBox v n -> Maybe (Point v n, Point v n)
forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
u
(vl :: Point v n
vl, vh :: Point v n
vh) <- BoundingBox v n -> Maybe (Point v n, Point v n)
forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
v
(Point v n, Point v n) -> Maybe (Point v n, Point v n)
forall (m :: * -> *) a. Monad m => a -> m a
return ((n -> n -> n) -> Point v n -> Point v n -> Point v n
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 n -> n -> n
forall a. Ord a => a -> a -> a
max Point v n
ul Point v n
vl, (n -> n -> n) -> Point v n -> Point v n -> Point v n
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 n -> n -> n
forall a. Ord a => a -> a -> a
min Point v n
uh Point v n
vh)
union :: (Additive v, Ord n) => BoundingBox v n -> BoundingBox v n -> BoundingBox v n
union :: BoundingBox v n -> BoundingBox v n -> BoundingBox v n
union = BoundingBox v n -> BoundingBox v n -> BoundingBox v n
forall a. Monoid a => a -> a -> a
mappend
boxGrid
:: (Traversable v, Additive v, Num n, Enum n)
=> n -> BoundingBox v n -> [Point v n]
boxGrid :: n -> BoundingBox v n -> [Point v n]
boxGrid f :: n
f = [Point v n]
-> ((Point v n, Point v n) -> [Point v n])
-> Maybe (Point v n, Point v n)
-> [Point v n]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Point v [n] -> [Point v n]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (Point v [n] -> [Point v n])
-> ((Point v n, Point v n) -> Point v [n])
-> (Point v n, Point v n)
-> [Point v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Point v n -> Point v n -> Point v [n])
-> (Point v n, Point v n) -> Point v [n]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ((n -> n -> [n]) -> Point v n -> Point v n -> Point v [n]
forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 n -> n -> [n]
mkRange)) (Maybe (Point v n, Point v n) -> [Point v n])
-> (BoundingBox v n -> Maybe (Point v n, Point v n))
-> BoundingBox v n
-> [Point v n]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BoundingBox v n -> Maybe (Point v n, Point v n)
forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners
where
mkRange :: n -> n -> [n]
mkRange lo :: n
lo hi :: n
hi = [n
lo, (1n -> n -> n
forall a. Num a => a -> a -> a
-n
f)n -> n -> n
forall a. Num a => a -> a -> a
*n
lo n -> n -> n
forall a. Num a => a -> a -> a
+ n
fn -> n -> n
forall a. Num a => a -> a -> a
*n
hi .. n
hi]