module Gelatin.Core.Bounds where
import Control.Arrow (Arrow, first, second, (>>>))
import Data.Vector.Unboxed (Unbox, Vector)
import qualified Data.Vector.Unboxed as V
import Gelatin.Core.Transform
import Linear
type BBox = (V2 Float, V2 Float)
type BCube = (V3 Float, V3 Float)
boundingCube :: (Unbox a, Real a) => Vector (V3 a) -> BCube
boundingCube vs
| V.null vs = (0,0)
| otherwise = V.foldl' f (br,tl) vs
where mn a = min a . realToFrac
mx a = max a . realToFrac
f (a, b) c = (mn <$> a <*> c, mx <$> b <*> c)
inf = 1/0
ninf = (1)/0
tl = V3 ninf ninf ninf
br = V3 inf inf inf
listToCube :: [V3 Float] -> BCube
listToCube = boundingCube . V.fromList
foldIntoCube :: Vector BCube -> BCube
foldIntoCube = boundingCube . uncurry (V.++) . V.unzip
pointInCube :: V2 Float -> BBox -> Bool
pointInCube (V2 px py) (V2 minx miny, V2 maxx maxy) =
(px >= minx && px <= maxx) && (py >= miny && py <= maxy)
applyTfrmToCube :: M44 Float -> BBox -> BBox
applyTfrmToCube t (tl,br) = listToBox [transformV2 t tl, transformV2 t br]
both :: Arrow a => a d c -> a (d, d) (c, c)
both f = first f >>> second f
boundingBox :: (Unbox a, Real a) => Vector (V2 a) -> BBox
boundingBox = second demoteV3 . first demoteV3 . boundingCube . V.map promoteV2
listToBox :: [V2 Float] -> BBox
listToBox = boundingBox . V.fromList
foldIntoBox :: Vector BBox -> BBox
foldIntoBox = boundingBox . uncurry (V.++) . V.unzip
pointInBox :: V2 Float -> BBox -> Bool
pointInBox (V2 px py) (V2 minx miny, V2 maxx maxy) =
(px >= minx && px <= maxx) && (py >= miny && py <= maxy)
applyTfrmToBox :: M44 Float -> BBox -> BBox
applyTfrmToBox t (tl,br) = listToBox [transformV2 t tl, transformV2 t br]