{-# 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
-- Copyright   :  (c) 2011-2015 diagrams-lib team (see LICENSE)
-- License     :  BSD-style (see LICENSE)
-- Maintainer  :  diagrams-discuss@googlegroups.com
--
-- Bounding boxes are not very compositional (/e.g./ it is not
-- possible to do anything sensible with them under rotation), so they
-- are not used in the diagrams core.  However, they do have their
-- uses; this module provides definitions and functions for working
-- with them.
--
-----------------------------------------------------------------------------

module Diagrams.BoundingBox
  ( -- * Bounding boxes
    BoundingBox

    -- * Constructing bounding boxes
  , emptyBox, fromCorners, fromPoint, fromPoints
  , boundingBox

    -- * Queries on bounding boxes
  , isEmptyBox
  , getCorners, getAllCorners
  , boxExtents, boxCenter
  , mCenterPoint, centerPoint
  , boxTransform, boxFit
  , contains, contains'
  , inside, inside', outside, outside'

  , boxGrid

    -- * Operations on bounding boxes
  , 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

-- Unexported utility newtype

newtype NonEmptyBoundingBox v n = NonEmptyBoundingBox (Point v n, Point v n)
  deriving (NonEmptyBoundingBox v n -> NonEmptyBoundingBox v n -> Bool
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, 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
<$ :: forall a b. a -> NonEmptyBoundingBox v b -> NonEmptyBoundingBox v a
$c<$ :: forall (v :: * -> *) a b.
Functor v =>
a -> NonEmptyBoundingBox v b -> NonEmptyBoundingBox v a
fmap :: forall a b.
(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 :: forall (v :: * -> *) n. NonEmptyBoundingBox v n -> BoundingBox v n
fromNonEmpty = forall (v :: * -> *) n.
Maybe (NonEmptyBoundingBox v n) -> BoundingBox v n
BoundingBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just

fromMaybeEmpty :: Maybe (NonEmptyBoundingBox v n) -> BoundingBox v n
fromMaybeEmpty :: forall (v :: * -> *) n.
Maybe (NonEmptyBoundingBox v n) -> BoundingBox v n
fromMaybeEmpty = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (v :: * -> *) n. BoundingBox v n
emptyBox forall (v :: * -> *) n. NonEmptyBoundingBox v n -> BoundingBox v n
fromNonEmpty

nonEmptyCorners :: NonEmptyBoundingBox v n -> (Point v n, Point v n)
nonEmptyCorners :: forall (v :: * -> *) n.
NonEmptyBoundingBox v n -> (Point v n, Point v n)
nonEmptyCorners (NonEmptyBoundingBox (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 (Point v n
ul, Point v n
uh)) <> :: NonEmptyBoundingBox v n
-> NonEmptyBoundingBox v n -> NonEmptyBoundingBox v n
<> (NonEmptyBoundingBox (Point v n
vl, Point v n
vh))
    = forall (v :: * -> *) n.
(Point v n, Point v n) -> NonEmptyBoundingBox v n
NonEmptyBoundingBox (forall (f :: * -> *) a.
Additive f =>
(a -> a -> a) -> f a -> f a -> f a
liftU2 forall a. Ord a => a -> a -> a
min Point v n
ul Point v n
vl, forall (f :: * -> *) a.
Additive f =>
(a -> a -> a) -> f a -> f a -> f a
liftU2 forall a. Ord a => a -> a -> a
max Point v n
uh Point v n
vh)

-- | A bounding box is an axis-aligned region determined by two points
--   indicating its \"lower\" and \"upper\" corners.  It can also represent
--   an empty bounding box - the points are wrapped in @Maybe@.
newtype BoundingBox v n = BoundingBox (Maybe (NonEmptyBoundingBox v n))
  deriving (BoundingBox v n -> BoundingBox v n -> Bool
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, 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
<$ :: forall a b. a -> BoundingBox v b -> BoundingBox v a
$c<$ :: forall (v :: * -> *) a b.
Functor v =>
a -> BoundingBox v b -> BoundingBox v a
fmap :: forall a b. (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 :: Prism' (BoundingBox v n) ()
_Empty = forall a. a -> (a -> Bool) -> Prism' a ()
nearly forall (v :: * -> *) n. BoundingBox v n
emptyBox forall (v :: * -> *) n. BoundingBox v n -> Bool
isEmptyBox

-- | Only valid if the second point is not smaller than the first.
instance (Additive v', Foldable v', Ord n') =>
    Each (BoundingBox v n) (BoundingBox v' n') (Point v n) (Point v' n') where
  each :: Traversal
  (BoundingBox v n) (BoundingBox v' n') (Point v n) (Point v' n')
each Point v n -> f (Point v' n')
f (forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners -> Just (Point v n
l, Point v n
u)) = forall (v :: * -> *) n.
(Additive v, Foldable v, Ord n) =>
Point v n -> Point v n -> BoundingBox v n
fromCorners forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point v n -> f (Point v' n')
f Point v n
l 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 Point v n -> f (Point v' n')
_ BoundingBox v n
_                           = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (v :: * -> *) n. BoundingBox v n
emptyBox

type instance V (BoundingBox v n) = v
type instance N (BoundingBox v n) = n

-- Map a function on a homogeneous 2-tuple. (unexported utility)
mapT :: (a -> b) -> (a, a) -> (b, b)
mapT :: forall a b. (a -> b) -> (a, a) -> (b, b)
mapT a -> b
f (a
x, 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 Point (V (BoundingBox v n)) (N (BoundingBox v n))
p BoundingBox v n
b
    = forall (v :: * -> *) n.
Maybe (NonEmptyBoundingBox v n) -> BoundingBox v n
fromMaybeEmpty
    (forall (v :: * -> *) n.
(Point v n, Point v n) -> NonEmptyBoundingBox v n
NonEmptyBoundingBox forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> (a, a) -> (b, b)
mapT (forall t. HasOrigin t => Point (V t) (N t) -> t -> t
moveOriginTo Point (V (BoundingBox v n)) (N (BoundingBox v n))
p) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 BoundingBox v n
bb = forall (v :: * -> *) n m. (Point v n -> m) -> Query v n m
Query forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Enveloped a => a -> Envelope (V a) (N a)
getEnvelope forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n.
(Additive v, Traversable v) =>
BoundingBox v n -> [Point v n]
getAllCorners

-- Feels like cheating.
-- Should be possible to generalise this.
instance RealFloat n => Traced (BoundingBox V2 n) where
  getTrace :: BoundingBox V2 n
-> Trace (V (BoundingBox V2 n)) (N (BoundingBox V2 n))
getTrace = forall a. Traced a => a -> Trace (V a) (N a)
getTrace
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((forall (v :: * -> *) n a.
(InSpace v n a, HasBasis v, Enveloped a, Transformable a,
 Monoid a) =>
BoundingBox v n -> a -> a
`boxFit` forall n t. (InSpace V2 n t, TrailLike t) => n -> n -> t
rect n
1 n
1) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n a.
(InSpace v n a, HasBasis v, Enveloped a) =>
a -> BoundingBox v n
boundingBox :: Envelope V2 n -> Path V2 n)
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 BoundingBox V3 n
bb = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Transformation V3 n
tr -> forall a. Traced a => a -> Trace (V a) (N a)
getTrace forall a b. (a -> b) -> a -> b
$ forall t. Transformable t => Transformation (V t) (N t) -> t -> t
transform Transformation V3 n
tr forall n. Num n => Box n
cube) forall a b. (a -> b) -> a -> b
$
                forall (v :: * -> *) n.
(Additive v, Fractional n) =>
BoundingBox v n -> BoundingBox v n -> Maybe (Transformation v n)
boxTransform (forall (v :: * -> *) n a.
(InSpace v n a, HasBasis v, Enveloped a) =>
a -> BoundingBox v n
boundingBox forall n. Num n => Box n
cube) BoundingBox V3 n
bb

instance (Metric v, Traversable v, OrderedField n) => Alignable (BoundingBox v n) where
  defaultBoundary :: forall (v :: * -> *) n.
(V (BoundingBox v n) ~ v, N (BoundingBox v n) ~ n) =>
v n -> BoundingBox v n -> Point v n
defaultBoundary = 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 Int
d BoundingBox v n
b = case forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
b of
    Just (Point v n
l, Point v n
u) -> Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"fromCorners " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Point v n
l forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Point v n
u
    Maybe (Point v n, Point v n)
Nothing     -> String -> ShowS
showString String
"emptyBox"

instance Read (v n) => Read (BoundingBox v n) where
  readPrec :: ReadPrec (BoundingBox v n)
readPrec = forall a. ReadPrec a -> ReadPrec a
parens forall a b. (a -> b) -> a -> b
$
    (do
      Ident String
"emptyBox" <- ReadPrec Lexeme
lexP
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (v :: * -> *) n. BoundingBox v n
emptyBox
    ) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    (forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
10 forall a b. (a -> b) -> a -> b
$ do
      Ident String
"fromCorners" <- ReadPrec Lexeme
lexP
      Point v n
l <- forall a. ReadPrec a -> ReadPrec a
step forall a. Read a => ReadPrec a
readPrec
      Point v n
h <- forall a. ReadPrec a -> ReadPrec a
step forall a. Read a => ReadPrec a
readPrec
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n. NonEmptyBoundingBox v n -> BoundingBox v n
fromNonEmpty forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n.
(Point v n, Point v n) -> NonEmptyBoundingBox v n
NonEmptyBoundingBox (Point v n
l, Point v n
h)
    )

-- | An empty bounding box.  This is the same thing as @mempty@, but it doesn't
--   require the same type constraints that the @Monoid@ instance does.
emptyBox :: BoundingBox v n
emptyBox :: forall (v :: * -> *) n. BoundingBox v n
emptyBox = forall (v :: * -> *) n.
Maybe (NonEmptyBoundingBox v n) -> BoundingBox v n
BoundingBox forall a. Maybe a
Nothing

-- | Create a bounding box from a point that is component-wise @(<=)@ than the
--   other.  If this is not the case, then @mempty@ is returned.
fromCorners
  :: (Additive v, Foldable v, Ord n)
  => Point v n -> Point v n -> BoundingBox v n
fromCorners :: forall (v :: * -> *) n.
(Additive v, Foldable v, Ord n) =>
Point v n -> Point v n -> BoundingBox v n
fromCorners Point v n
l Point v n
h
  | forall (t :: * -> *). Foldable t => t Bool -> Bool
F.and (forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 forall a. Ord a => a -> a -> Bool
(<=) Point v n
l Point v n
h) = forall (v :: * -> *) n. NonEmptyBoundingBox v n -> BoundingBox v n
fromNonEmpty forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n.
(Point v n, Point v n) -> NonEmptyBoundingBox v n
NonEmptyBoundingBox (Point v n
l, Point v n
h)
  | Bool
otherwise               = forall a. Monoid a => a
mempty

-- | Create a degenerate bounding \"box\" containing only a single point.
fromPoint :: Point v n -> BoundingBox v n
fromPoint :: forall (v :: * -> *) n. Point v n -> BoundingBox v n
fromPoint Point v n
p = forall (v :: * -> *) n. NonEmptyBoundingBox v n -> BoundingBox v n
fromNonEmpty forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n.
(Point v n, Point v n) -> NonEmptyBoundingBox v n
NonEmptyBoundingBox (Point v n
p, Point v n
p)

-- | Create the smallest bounding box containing all the given points.
fromPoints :: (Additive v, Ord n) => [Point v n] -> BoundingBox v n
fromPoints :: forall (v :: * -> *) n.
(Additive v, Ord n) =>
[Point v n] -> BoundingBox v n
fromPoints = forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall (v :: * -> *) n. Point v n -> BoundingBox v n
fromPoint

-- | Create a bounding box for any enveloped object (such as a diagram or path).
boundingBox :: (InSpace v n a, HasBasis v, Enveloped a)
            => a -> BoundingBox v n
boundingBox :: forall (v :: * -> *) n a.
(InSpace v n a, HasBasis v, Enveloped a) =>
a -> BoundingBox v n
boundingBox a
a = forall (v :: * -> *) n.
Maybe (NonEmptyBoundingBox v n) -> BoundingBox v n
fromMaybeEmpty forall a b. (a -> b) -> a -> b
$ do
  v n -> n
env <- (forall (v :: * -> *) n. Envelope v n -> Maybe (v n -> n)
appEnvelope forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enveloped a => a -> Envelope (V a) (N a)
getEnvelope) a
a
  let h :: v n
h = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v n -> n
env forall (v :: * -> *) n. (HasBasis v, Num n) => v (v n)
eye
      l :: v n
l = forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (v n -> n
env forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. (Functor f, Num a) => f a -> f a
negated) forall (v :: * -> *) n. (HasBasis v, Num n) => v (v n)
eye
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n.
(Point v n, Point v n) -> NonEmptyBoundingBox v n
NonEmptyBoundingBox (forall (f :: * -> *) a. f a -> Point f a
P v n
l, forall (f :: * -> *) a. f a -> Point f a
P v n
h)

-- | Queries whether the BoundingBox is empty.
isEmptyBox :: BoundingBox v n -> Bool
isEmptyBox :: forall (v :: * -> *) n. BoundingBox v n -> Bool
isEmptyBox (BoundingBox Maybe (NonEmptyBoundingBox v n)
Nothing) = Bool
True
isEmptyBox BoundingBox v n
_                              = Bool
False

-- | Gets the lower and upper corners that define the bounding box.
getCorners :: BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners :: forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners (BoundingBox Maybe (NonEmptyBoundingBox v n)
p) = forall (v :: * -> *) n.
NonEmptyBoundingBox v n -> (Point v n, Point v n)
nonEmptyCorners forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (NonEmptyBoundingBox v n)
p

-- | Computes all of the corners of the bounding box.
getAllCorners :: (Additive v, Traversable v) => BoundingBox v n -> [Point v n]
getAllCorners :: forall (v :: * -> *) n.
(Additive v, Traversable v) =>
BoundingBox v n -> [Point v n]
getAllCorners (BoundingBox Maybe (NonEmptyBoundingBox v n)
Nothing) = []
getAllCorners (BoundingBox (Just (NonEmptyBoundingBox (Point v n
l, Point v n
u))))
  = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
T.sequence (forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 (\n
a n
b -> [n
a,n
b]) Point v n
l Point v n
u)

-- | Get the size of the bounding box - the vector from the (component-wise)
--   lesser point to the greater point.
boxExtents :: (Additive v, Num n) => BoundingBox v n -> v n
boxExtents :: forall (v :: * -> *) n.
(Additive v, Num n) =>
BoundingBox v n -> v n
boxExtents = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (f :: * -> *) a. (Additive f, Num a) => f a
zero (\(Point v n
l,Point v n
u) -> Point v n
u forall (p :: * -> *) a. (Affine p, Num a) => p a -> p a -> Diff p a
.-. Point v n
l) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners

-- | Get the center point in a bounding box.
boxCenter :: (Additive v, Fractional n) => BoundingBox v n -> Maybe (Point v n)
boxCenter :: forall (v :: * -> *) n.
(Additive v, Fractional n) =>
BoundingBox v n -> Maybe (Point v n)
boxCenter = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (f :: * -> *) a.
(Additive f, Num a) =>
a -> f a -> f a -> f a
lerp n
0.5)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners

-- | Get the center of a the bounding box of an enveloped object, return
--   'Nothing' for object with empty envelope.
mCenterPoint :: (InSpace v n a, HasBasis v, Enveloped a)
            => a -> Maybe (Point v n)
mCenterPoint :: forall (v :: * -> *) n a.
(InSpace v n a, HasBasis v, Enveloped a) =>
a -> Maybe (Point v n)
mCenterPoint = forall (v :: * -> *) n.
(Additive v, Fractional n) =>
BoundingBox v n -> Maybe (Point v n)
boxCenter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n a.
(InSpace v n a, HasBasis v, Enveloped a) =>
a -> BoundingBox v n
boundingBox

-- | Get the center of a the bounding box of an enveloped object, return
--   the origin for object with empty envelope.
centerPoint :: (InSpace v n a, HasBasis v, Enveloped a)
            => a -> Point v n
centerPoint :: forall (v :: * -> *) n a.
(InSpace v n a, HasBasis v, Enveloped a) =>
a -> Point v n
centerPoint = forall a. a -> Maybe a -> a
fromMaybe forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n a.
(InSpace v n a, HasBasis v, Enveloped a) =>
a -> Maybe (Point v n)
mCenterPoint

-- | Create a transformation mapping points from one bounding box to the
--   other. Returns 'Nothing' if either of the boxes are empty.
boxTransform
  :: (Additive v, Fractional n)
  => BoundingBox v n -> BoundingBox v n -> Maybe (Transformation v n)
boxTransform :: forall (v :: * -> *) n.
(Additive v, Fractional n) =>
BoundingBox v n -> BoundingBox v n -> Maybe (Transformation v n)
boxTransform BoundingBox v n
u BoundingBox v n
v = do
  (P v n
ul, Point v n
_) <- forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
u
  (P v n
vl, 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  = 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) forall u v. (u -> v) -> (v -> u) -> u :-: v
<-> 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 = forall (f :: * -> *) a.
Additive f =>
(a -> a -> a) -> f a -> f a -> f a
liftU2 forall a. Num a => a -> a -> a
(*) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (f :: * -> *) a.
Additive f =>
(a -> a -> a) -> f a -> f a -> f a
liftU2 forall a. Fractional a => a -> a -> a
(/)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> (a, a) -> (b, b)
mapT forall (v :: * -> *) n.
(Additive v, Num n) =>
BoundingBox v n -> v n
boxExtents
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 forall (f :: * -> *) a. (Additive f, Num a) => f a -> f a -> f a
^-^ 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)

-- | Transforms an enveloped thing to fit within a @BoundingBox@.  If the
--   bounding box is empty, then the result is also @mempty@.
boxFit
  :: (InSpace v n a, HasBasis v, Enveloped a, Transformable a, Monoid a)
  => BoundingBox v n -> a -> a
boxFit :: forall (v :: * -> *) n a.
(InSpace v n a, HasBasis v, Enveloped a, Transformable a,
 Monoid a) =>
BoundingBox v n -> a -> a
boxFit BoundingBox v n
b a
x = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall t. Transformable t => Transformation (V t) (N t) -> t -> t
`transform` a
x) forall a b. (a -> b) -> a -> b
$ forall (v :: * -> *) n.
(Additive v, Fractional n) =>
BoundingBox v n -> BoundingBox v n -> Maybe (Transformation v n)
boxTransform (forall (v :: * -> *) n a.
(InSpace v n a, HasBasis v, Enveloped a) =>
a -> BoundingBox v n
boundingBox a
x) BoundingBox v n
b

-- | Check whether a point is contained in a bounding box (including its edges).
contains :: (Additive v, Foldable v, Ord n) => BoundingBox v n -> Point v n -> Bool
contains :: forall (v :: * -> *) n.
(Additive v, Foldable v, Ord n) =>
BoundingBox v n -> Point v n -> Bool
contains BoundingBox v n
b Point v n
p = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Point v n, Point v n) -> Bool
check forall a b. (a -> b) -> a -> b
$ 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 (Point v n
l, Point v n
h) = forall (t :: * -> *). Foldable t => t Bool -> Bool
F.and (forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 forall a. Ord a => a -> a -> Bool
(<=) Point v n
l Point v n
p)
                Bool -> Bool -> Bool
&& forall (t :: * -> *). Foldable t => t Bool -> Bool
F.and (forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 forall a. Ord a => a -> a -> Bool
(<=) Point v n
p Point v n
h)

-- | Check whether a point is /strictly/ contained in a bounding box.
contains' :: (Additive v, Foldable v, Ord n) => BoundingBox v n -> Point v n -> Bool
contains' :: forall (v :: * -> *) n.
(Additive v, Foldable v, Ord n) =>
BoundingBox v n -> Point v n -> Bool
contains' BoundingBox v n
b Point v n
p = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Point v n, Point v n) -> Bool
check forall a b. (a -> b) -> a -> b
$ 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 (Point v n
l, Point v n
h) = forall (t :: * -> *). Foldable t => t Bool -> Bool
F.and (forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 forall a. Ord a => a -> a -> Bool
(<) Point v n
l Point v n
p)
                Bool -> Bool -> Bool
&& forall (t :: * -> *). Foldable t => t Bool -> Bool
F.and (forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 forall a. Ord a => a -> a -> Bool
(<) Point v n
p Point v n
h)

-- | Test whether the first bounding box is contained inside
--   the second.
inside :: (Additive v, Foldable v, Ord n) => BoundingBox v n -> BoundingBox v n -> Bool
inside :: forall (v :: * -> *) n.
(Additive v, Foldable v, Ord n) =>
BoundingBox v n -> BoundingBox v n -> Bool
inside BoundingBox v n
u BoundingBox v n
v = forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ do
  (Point v n
ul, Point v n
uh) <- forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
u
  (Point v n
vl, Point v n
vh) <- forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
v
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
F.and (forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 forall a. Ord a => a -> a -> Bool
(>=) Point v n
ul Point v n
vl)
        Bool -> Bool -> Bool
&& forall (t :: * -> *). Foldable t => t Bool -> Bool
F.and (forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 forall a. Ord a => a -> a -> Bool
(<=) Point v n
uh Point v n
vh)

-- | Test whether the first bounding box is /strictly/ contained
--   inside the second.
inside' :: (Additive v, Foldable v, Ord n) => BoundingBox v n -> BoundingBox v n -> Bool
inside' :: forall (v :: * -> *) n.
(Additive v, Foldable v, Ord n) =>
BoundingBox v n -> BoundingBox v n -> Bool
inside' BoundingBox v n
u BoundingBox v n
v = forall a. a -> Maybe a -> a
fromMaybe Bool
False forall a b. (a -> b) -> a -> b
$ do
  (Point v n
ul, Point v n
uh) <- forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
u
  (Point v n
vl, Point v n
vh) <- forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
v
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
F.and (forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 forall a. Ord a => a -> a -> Bool
(>) Point v n
ul Point v n
vl)
        Bool -> Bool -> Bool
&& forall (t :: * -> *). Foldable t => t Bool -> Bool
F.and (forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 forall a. Ord a => a -> a -> Bool
(<) Point v n
uh Point v n
vh)

-- | Test whether the first bounding box lies outside the second
--   (although they may intersect in their boundaries).
outside :: (Additive v, Foldable v, Ord n) => BoundingBox v n -> BoundingBox v n -> Bool
outside :: forall (v :: * -> *) n.
(Additive v, Foldable v, Ord n) =>
BoundingBox v n -> BoundingBox v n -> Bool
outside BoundingBox v n
u BoundingBox v n
v = forall a. a -> Maybe a -> a
fromMaybe Bool
True forall a b. (a -> b) -> a -> b
$ do
  (Point v n
ul, Point v n
uh) <- forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
u
  (Point v n
vl, Point v n
vh) <- forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
v
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
F.or (forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 forall a. Ord a => a -> a -> Bool
(<=) Point v n
uh Point v n
vl)
        Bool -> Bool -> Bool
|| forall (t :: * -> *). Foldable t => t Bool -> Bool
F.or (forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 forall a. Ord a => a -> a -> Bool
(>=) Point v n
ul Point v n
vh)

-- | Test whether the first bounding box lies /strictly/ outside the second
--   (they do not intersect at all).
outside' :: (Additive v, Foldable v, Ord n) => BoundingBox v n -> BoundingBox v n -> Bool
outside' :: forall (v :: * -> *) n.
(Additive v, Foldable v, Ord n) =>
BoundingBox v n -> BoundingBox v n -> Bool
outside' BoundingBox v n
u BoundingBox v n
v = forall a. a -> Maybe a -> a
fromMaybe Bool
True forall a b. (a -> b) -> a -> b
$ do
  (Point v n
ul, Point v n
uh) <- forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
u
  (Point v n
vl, Point v n
vh) <- forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
v
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
F.or (forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 forall a. Ord a => a -> a -> Bool
(<) Point v n
uh Point v n
vl)
        Bool -> Bool -> Bool
|| forall (t :: * -> *). Foldable t => t Bool -> Bool
F.or (forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 forall a. Ord a => a -> a -> Bool
(>) Point v n
ul Point v n
vh)

-- | Form the largest bounding box contained within this given two
--   bounding boxes, or @Nothing@ if the two bounding boxes do not
--   overlap at all.
intersection
  :: (Additive v, Foldable v, Ord n)
  => BoundingBox v n -> BoundingBox v n -> BoundingBox v n
intersection :: forall (v :: * -> *) n.
(Additive v, Foldable v, Ord n) =>
BoundingBox v n -> BoundingBox v n -> BoundingBox v n
intersection BoundingBox v n
u BoundingBox v n
v = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (v :: * -> *) n.
(Additive v, Foldable v, Ord n) =>
Point v n -> Point v n -> BoundingBox v n
fromCorners) forall a b. (a -> b) -> a -> b
$ do
  (Point v n
ul, Point v n
uh) <- forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
u
  (Point v n
vl, Point v n
vh) <- forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners BoundingBox v n
v
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 forall a. Ord a => a -> a -> a
max Point v n
ul Point v n
vl, forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 forall a. Ord a => a -> a -> a
min Point v n
uh Point v n
vh)

-- | Form the smallest bounding box containing the given two bound union.  This
--   function is just an alias for @mappend@.
union :: (Additive v, Ord n) => BoundingBox v n -> BoundingBox v n -> BoundingBox v n
union :: forall (v :: * -> *) n.
(Additive v, Ord n) =>
BoundingBox v n -> BoundingBox v n -> BoundingBox v n
union = forall a. Monoid a => a -> a -> a
mappend

-- | @boxGrid f box@ returns a grid of regularly spaced points inside
--   the box, such that there are @(1/f)@ points along each dimension.
--   For example, for a 3D box with corners at (0,0,0) and (2,2,2),
--   @boxGrid 0.1@ would yield a grid of approximately 1000 points (it
--   might actually be @11^3@ instead of @10^3@) spaced @0.2@ units
--   apart.
boxGrid
  :: (Traversable v, Additive v, Num n, Enum n)
  => n -> BoundingBox v n -> [Point v n]
boxGrid :: forall (v :: * -> *) n.
(Traversable v, Additive v, Num n, Enum n) =>
n -> BoundingBox v n -> [Point v n]
boxGrid n
f = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall (f :: * -> *) a b c.
Additive f =>
(a -> b -> c) -> f a -> f b -> f c
liftI2 n -> n -> [n]
mkRange)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (v :: * -> *) n.
BoundingBox v n -> Maybe (Point v n, Point v n)
getCorners
  where
    mkRange :: n -> n -> [n]
mkRange n
lo n
hi = [n
lo, (n
1forall a. Num a => a -> a -> a
-n
f)forall a. Num a => a -> a -> a
*n
lo forall a. Num a => a -> a -> a
+ n
fforall a. Num a => a -> a -> a
*n
hi .. n
hi]

    -- liftA2 mkRange on the two corner points creates a (Point V2
    -- [n]), where each component is the range of values for that
    -- dimension.  sequenceA then yields a grid of type [Point V2 n].