{- |
  This module provides the 'BBox1' type (mainly for completeness).
-}

module Data.BoundingBox.B1 where

import Data.Vector.Class
import Data.Vector.V1
import qualified Data.BoundingBox.Range as R

-- | The 'BBox1' type is basically a 'Range', but all the operations over it work with 'Vector1' (which is really 'Scalar'). While it's called a bounding /box/, a 1-dimensional box is in truth a simple line interval, just like 'Range'.
newtype BBox1 = BBox1 {BBox1 -> Range
range :: R.Range} deriving (BBox1 -> BBox1 -> Bool
(BBox1 -> BBox1 -> Bool) -> (BBox1 -> BBox1 -> Bool) -> Eq BBox1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BBox1 -> BBox1 -> Bool
== :: BBox1 -> BBox1 -> Bool
$c/= :: BBox1 -> BBox1 -> Bool
/= :: BBox1 -> BBox1 -> Bool
Eq, Int -> BBox1 -> ShowS
[BBox1] -> ShowS
BBox1 -> String
(Int -> BBox1 -> ShowS)
-> (BBox1 -> String) -> ([BBox1] -> ShowS) -> Show BBox1
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BBox1 -> ShowS
showsPrec :: Int -> BBox1 -> ShowS
$cshow :: BBox1 -> String
show :: BBox1 -> String
$cshowList :: [BBox1] -> ShowS
showList :: [BBox1] -> ShowS
Show)

-- | Given two vectors, construct a bounding box (swapping the endpoints if necessary).
bound_corners :: Vector1 -> Vector1 -> BBox1
bound_corners :: Vector1 -> Vector1 -> BBox1
bound_corners (Vector1 Scalar
xa) (Vector1 Scalar
xb) = Range -> BBox1
BBox1 (Range -> BBox1) -> Range -> BBox1
forall a b. (a -> b) -> a -> b
$ Scalar -> Scalar -> Range
R.bound_corners Scalar
xa Scalar
xb

-- | Find the bounds of a list of points. (Throws an exception if the list is empty.)
bound_points :: [Vector1] -> BBox1
bound_points :: [Vector1] -> BBox1
bound_points = Range -> BBox1
BBox1 (Range -> BBox1) -> ([Vector1] -> Range) -> [Vector1] -> BBox1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Scalar] -> Range
R.bound_points ([Scalar] -> Range)
-> ([Vector1] -> [Scalar]) -> [Vector1] -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector1 -> Scalar) -> [Vector1] -> [Scalar]
forall a b. (a -> b) -> [a] -> [b]
map Vector1 -> Scalar
v1x

-- | Test whether a 'Vector1' lies within a 'BBox1'.
within_bounds :: Vector1 -> BBox1 -> Bool
within_bounds :: Vector1 -> BBox1 -> Bool
within_bounds (Vector1 Scalar
x) (BBox1 Range
r) = Scalar
x Scalar -> Range -> Bool
`R.within_bounds` Range
r

-- | Return the minimum endpoint for a 'BBox1'.
min_point :: BBox1 -> Vector1
min_point :: BBox1 -> Vector1
min_point = Scalar -> Vector1
Vector1 (Scalar -> Vector1) -> (BBox1 -> Scalar) -> BBox1 -> Vector1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> Scalar
R.min_point (Range -> Scalar) -> (BBox1 -> Range) -> BBox1 -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BBox1 -> Range
range

-- | Return the maximum endpoint for a 'BBox1'.
max_point :: BBox1 -> Vector1
max_point :: BBox1 -> Vector1
max_point = Scalar -> Vector1
Vector1 (Scalar -> Vector1) -> (BBox1 -> Scalar) -> BBox1 -> Vector1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> Scalar
R.max_point (Range -> Scalar) -> (BBox1 -> Range) -> BBox1 -> Scalar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BBox1 -> Range
range

-- | Take the union of two 'BBox1' values. The result is a new 'BBox1' that contains all the points the original boxes contained, plus any extra space between them.
union :: BBox1 -> BBox1 -> BBox1
union :: BBox1 -> BBox1 -> BBox1
union (BBox1 Range
r0) (BBox1 Range
r1) = Range -> BBox1
BBox1 (Range
r0 Range -> Range -> Range
`R.union` Range
r1)

-- | Take the intersection of two 'BBox1' values. If the boxes do not overlap, return 'Nothing'. Otherwise return a 'BBox1' containing only the points common to both argument boxes.
isect :: BBox1 -> BBox1 -> Maybe BBox1
isect :: BBox1 -> BBox1 -> Maybe BBox1
isect (BBox1 Range
r0) (BBox1 Range
r1) = do
  Range
r <- (Range
r0 Range -> Range -> Maybe Range
`R.isect` Range
r1)
  BBox1 -> Maybe BBox1
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Range -> BBox1
BBox1 Range
r)

-- | Efficiently compute the union of a list of bounding boxes.
unions :: [BBox1] -> BBox1
unions :: [BBox1] -> BBox1
unions = Range -> BBox1
BBox1 (Range -> BBox1) -> ([BBox1] -> Range) -> [BBox1] -> BBox1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Range] -> Range
R.unions ([Range] -> Range) -> ([BBox1] -> [Range]) -> [BBox1] -> Range
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BBox1 -> Range) -> [BBox1] -> [Range]
forall a b. (a -> b) -> [a] -> [b]
map BBox1 -> Range
range