module Data.Vec.AABB
(
AABB(..),
aabbTransform,
testAABBprojection,
Intersection(..)
)
where
import Data.Monoid
import qualified Data.Vec.Base as Vec
import Data.Vec.Base ((:.)(..), Mat44, Mat33, Vec3)
import Data.Vec.Nat
import Data.Vec.LinAlg
import Data.Vec.LinAlg.Transform3D
data AABB = AABB {
aabbMin :: Vec3 Float,
aabbMax :: Vec3 Float
}
deriving (Show, Eq)
instance Monoid AABB where
mempty = let inf = read "Infinity" :: Float in AABB (Vec.vec inf) (Vec.vec (inf))
mappend (AABB minA maxA) (AABB minB maxB) = AABB (Vec.zipWith min minA minB) (Vec.zipWith max maxA maxB)
data Intersection = Inside | Intersecting | Outside deriving (Eq, Show, Ord, Enum, Bounded)
testAABBprojection :: Mat44 Float -> AABB -> Intersection
testAABBprojection m =
let planes = [(row n3 m + row n0 m),
(row n3 m row n0 m),
(row n3 m + row n1 m),
(row n3 m row n1 m),
(row n3 m + row n2 m),
(row n3 m row n2 m)]
getMin min max = min
getMax min max = max
vMinF = Vec.map (\ni -> if ni >= 0 then getMin else getMax)
vMaxF = Vec.map (\ni -> if ni >= 0 then getMax else getMin)
checkPlane (AABB bmin bmax) Outside _ = Outside
checkPlane (AABB bmin bmax) state plane =
let n = Vec.take n3 plane
d = Vec.last plane
vMin = Vec.zipWith ($) (Vec.zipWith ($) (vMinF n) bmin) bmax
vMax = Vec.zipWith ($) (Vec.zipWith ($) (vMaxF n) bmin) bmax
in if (n `dot` vMin) + d > 0
then Outside
else if (n `dot` vMax) + d >= 0
then Intersecting
else Inside
in \aabb -> foldl (checkPlane aabb) Inside planes
aabbTransform :: Mat44 Float -> AABB -> AABB
aabbTransform m (AABB bmin bmax) =
let center = (bmax + bmin) / 2
extent = bmax center
mAbs33 = Vec.map (Vec.map abs . Vec.take n3) $ Vec.take n3 m
tcenter = project $ m `multmv` homPoint center
textent = mAbs33 `multmv` extent
in AABB (tcenter textent) (tcenter + textent)