module Data.RTree.MBB
(
MBB (..),
mbb,
area,
containsMBB,
unionMBB,
unionsMBB,
intersectMBB
)
where
import Data.Binary
import Control.Applicative ((<$>), (<*>))
import GHC.Generics (Generic)
data MBB = MBB {getUlx :: ! Double, getUly :: ! Double, getBrx :: ! Double, getBry :: ! Double}
deriving (Eq, Generic)
mbb :: Double
-> Double
-> Double
-> Double
-> MBB
mbb = MBB
unionsMBB :: [MBB] -> MBB
unionsMBB [] = error "unionsMBB': []"
unionsMBB xs = foldr1 unionMBB xs
unionMBB :: MBB -> MBB -> MBB
unionMBB (MBB ulx uly brx bry) (MBB ulx' uly' brx' bry') = MBB (min ulx ulx') (min uly uly') (max brx brx') (max bry bry')
area :: MBB -> Double
area (MBB ulx uly brx bry) = (brx ulx) * (bry uly)
containsMBB :: MBB -> MBB -> Bool
containsMBB (MBB x11 y11 x12 y12) (MBB x21 y21 x22 y22) = x11 <= x21 && y11 <= y21 && x12 >= x22 && y12 >= y22
intersectMBB :: MBB -> MBB -> Maybe MBB
intersectMBB (MBB ulx uly brx bry) (MBB ulx' uly' brx' bry')
| ulx'' <= brx'' && uly'' <= bry'' = Just $ MBB ulx'' uly'' brx'' bry''
| otherwise = Nothing
where
ulx'' = max ulx ulx'
uly'' = max uly uly'
brx'' = min brx brx'
bry'' = min bry bry'
instance Show MBB where
show (MBB ulx uly brx bry) = concat ["mbb ", show ulx, " ", show uly, " ", show brx, " ", show bry]
instance Binary MBB where
put (MBB ulx uly brx bry) = put ulx >> put uly >> put brx >> put bry
get = MBB <$> get <*> get <*> get <*> get