{- | Classes for generically handling bounding boxes, and things that possess bounding boxes. -} {-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, TypeFamilies #-} module Data.BoundingBox.Fancy where import Data.Vector import qualified Data.BoundingBox.Range as R import qualified Data.BoundingBox.B1 as B1 import qualified Data.BoundingBox.B2 as B2 import qualified Data.BoundingBox.B3 as B3 import qualified Data.BoundingBox.B4 as B4 -- | Class for dealing with bounding boxes. class HasSpace b => BoundingBox b where -- | Given two corner points, construct a bounding box containing them both. (You can use any two points, given in any order, provided that they are from /opposite/ corners.) bound_corners :: Point b -> Point b -> b -- | Given a list of points, construct a bounding box containing them all. (Throws an exception if the list is empty.) bound_points :: [Point b] -> b -- | Return a point containing the minimum values for all coordinates. min_point :: b -> Point b -- | Return a point containing the maximum values for all coordinates. max_point :: b -> Point b -- | Test whether a given point lies within a given bounding box. within_bounds :: Point b -> b -> Bool -- | Take the union of two bounding boxes. The result is a new bounding box that contains every point that the original pair of boxes contained, and probably some extra space as well. union :: b -> b -> b -- | Take the intersection of two bounding boxes. If the boxes do not overlap, return 'Nothing'. Otherwise return a bounding box containing only the points common to both original bounding boxes. isect :: b -> b -> Maybe b -- | Take the union of a list of bounding boxes. (This is more efficient than @foldr1 union@.) unions :: [b] -> b instance HasSpace B1.BBox1 where type Point B1.BBox1 = Vector1 instance BoundingBox B1.BBox1 where bound_corners = B1.bound_corners bound_points = B1.bound_points min_point = B1.min_point max_point = B1.max_point within_bounds = B1.within_bounds union = B1.union isect = B1.isect unions = B1.unions instance HasSpace B2.BBox2 where type Point B2.BBox2 = Vector2 instance BoundingBox B2.BBox2 where bound_corners = B2.bound_corners bound_points = B2.bound_points min_point = B2.min_point max_point = B2.max_point within_bounds = B2.within_bounds union = B2.union isect = B2.isect unions = B2.unions instance HasSpace B3.BBox3 where type Point B3.BBox3 = Vector3 instance BoundingBox B3.BBox3 where bound_corners = B3.bound_corners bound_points = B3.bound_points min_point = B3.min_point max_point = B3.max_point within_bounds = B3.within_bounds union = B3.union isect = B3.isect unions = B3.unions instance HasSpace B4.BBox4 where type Point B4.BBox4 = Vector4 instance BoundingBox B4.BBox4 where bound_corners = B4.bound_corners bound_points = B4.bound_points min_point = B4.min_point max_point = B4.max_point within_bounds = B4.within_bounds union = B4.union isect = B4.isect unions = B4.unions -- | Get a 'R.Range' representing the extent of a bounding box on a specified coordinate axis. axis_range :: (BoundingBox bbox, VectorAxis (Point bbox) axis) => axis -> bbox -> R.Range axis_range axis bbox = R.Range (get_coord axis (min_point bbox)) (get_coord axis (max_point bbox)) -- | Class representing things that possess a bounding box. class HasSpace x => HasBBox x where -- | Get an object's bounding box. get_bbox :: (BoundingBox b, Point b ~ Point x) => x -> b