{-# 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           hiding (lerp)
import           Linear.Vector.Compat    (lerp)

-- Unexported utility newtype

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

-- | 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
(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
$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
/= :: BoundingBox v n -> BoundingBox v n -> Bool
Eq, (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
$cfmap :: forall (v :: * -> *) a b.
Functor v =>
(a -> b) -> BoundingBox v a -> BoundingBox v b
fmap :: forall a b. (a -> b) -> BoundingBox v a -> BoundingBox v b
$c<$ :: forall (v :: * -> *) a b.
Functor v =>
a -> BoundingBox v b -> BoundingBox v a
<$ :: forall a b. a -> BoundingBox v b -> BoundingBox v a
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 = 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

-- | 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 (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 (Point v n
l, 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 a b. f (a -> b) -> f a -> f b
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
_                           = BoundingBox v' n' -> f (BoundingBox v' n')
forall a. a -> f a
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

-- 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
    = 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 BoundingBox v n
bb = (Point (V (BoundingBox v n)) (N (BoundingBox 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 (BoundingBox v n)) (N (BoundingBox v n)) -> Any)
 -> Query (V (BoundingBox v n)) (N (BoundingBox v n)) Any)
-> (Point (V (BoundingBox v n)) (N (BoundingBox 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
[Point v n] -> Envelope (V [Point v n]) (N [Point 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

-- 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 = Path V2 n -> Trace (V (Path V2 n)) (N (Path V2 n))
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 n
1 n
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 (V (BoundingBox V2 n)) (N (BoundingBox V2 n))
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 BoundingBox V3 n
bb = (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 m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Transformation V3 n
tr -> Box n -> Trace (V (Box n)) (N (Box n))
forall a. Traced a => a -> Trace (V a) (N a)
getTrace (Box n -> Trace (V (Box n)) (N (Box n)))
-> Box n -> Trace (V (Box n)) (N (Box 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 :: forall (v :: * -> *) n.
(V (BoundingBox v n) ~ v, N (BoundingBox v n) ~ n) =>
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 Int
d 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 (Point v n
l, Point v n
u) -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"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 Int
11 Point v n
l ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
' ' 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 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 = 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 String
"emptyBox" <- ReadPrec Lexeme
lexP
      BoundingBox v n -> ReadPrec (BoundingBox v n)
forall a. a -> ReadPrec a
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 a. ReadPrec a -> ReadPrec a -> ReadPrec a
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 Int
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 String
"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 a. a -> ReadPrec a
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)
    )

-- | 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 = Maybe (NonEmptyBoundingBox v n) -> BoundingBox v n
forall (v :: * -> *) n.
Maybe (NonEmptyBoundingBox v n) -> BoundingBox v n
BoundingBox Maybe (NonEmptyBoundingBox v n)
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
  | 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 a b c. (a -> b -> c) -> Point v a -> Point v b -> Point v c
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

-- | 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 = 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)

-- | 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 = [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

-- | 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 = 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
a -> Envelope (V a) (N a)
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 a b. (a -> b) -> v a -> v b
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 a b. (a -> b) -> v a -> v b
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 a. a -> Maybe a
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)

-- | 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) = 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
<$> 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))))
  = Point v [n] -> [Point v n]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => Point v (m a) -> m (Point v a)
T.sequence ((n -> n -> [n]) -> Point v n -> Point v n -> Point v [n]
forall a b c. (a -> b -> c) -> Point v a -> Point v b -> Point v c
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 = 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 a. Num a => v a
forall (f :: * -> *) a. (Additive f, Num a) => f a
zero (\(Point v n
l,Point v n
u) -> Point v n
u Point v n -> Point v n -> Diff (Point v) n
forall a. Num a => Point v a -> Point v a -> Diff (Point v) a
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

-- | 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 = ((Point v n, Point v n) -> Point v n)
-> Maybe (Point v n, Point v n) -> Maybe (Point v n)
forall a b. (a -> b) -> Maybe a -> Maybe b
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 n
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

-- | 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 = 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

-- | 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 = 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

-- | 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
_) <- 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 v n
vl, Point v n
_) <- 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 a. (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 a. (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 a. a -> Maybe a
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 a. Num a => v a -> v a -> v a
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)

-- | 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 = 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

-- | 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 = 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 (Point v n
l, 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 a b c. (a -> b -> c) -> Point v a -> Point v b -> Point v c
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 a b c. (a -> b -> c) -> Point v a -> Point v b -> Point v c
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)

-- | 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 = 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 (Point v n
l, 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 a b c. (a -> b -> c) -> Point v a -> Point v b -> Point v c
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 a b c. (a -> b -> c) -> Point v a -> Point v b -> Point v c
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)

-- | 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 = 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
  (Point v n
ul, 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
  (Point v n
vl, 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 a. a -> Maybe a
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 a b c. (a -> b -> c) -> Point v a -> Point v b -> Point v c
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 a b c. (a -> b -> c) -> Point v a -> Point v b -> Point v c
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)

-- | 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 = 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
  (Point v n
ul, 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
  (Point v n
vl, 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 a. a -> Maybe a
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 a b c. (a -> b -> c) -> Point v a -> Point v b -> Point v c
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 a b c. (a -> b -> c) -> Point v a -> Point v b -> Point v c
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)

-- | 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 = 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
  (Point v n
ul, 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
  (Point v n
vl, 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 a. a -> Maybe a
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 a b c. (a -> b -> c) -> Point v a -> Point v b -> Point v c
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 a b c. (a -> b -> c) -> Point v a -> Point v b -> Point v c
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)

-- | 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 = 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
  (Point v n
ul, 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
  (Point v n
vl, 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 a. a -> Maybe a
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 a b c. (a -> b -> c) -> Point v a -> Point v b -> Point v c
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 a b c. (a -> b -> c) -> Point v a -> Point v b -> Point v c
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)

-- | 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 = 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
  (Point v n
ul, 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
  (Point v n
vl, 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 a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return ((n -> n -> n) -> Point v n -> Point v n -> Point v n
forall a b c. (a -> b -> c) -> Point v a -> Point v b -> Point v c
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 a b c. (a -> b -> c) -> Point v a -> Point v b -> Point v c
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)

-- | 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 = BoundingBox v n -> BoundingBox v n -> BoundingBox v n
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 = [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)
forall (f :: * -> *) a.
Applicative f =>
Point v (f a) -> f (Point v 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 a b c. (a -> b -> c) -> Point v a -> Point v b -> Point v c
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 n
lo n
hi = [n
lo, (n
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]

    -- 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].