module HGE2D.QuadTree where
import HGE2D.Datas
import HGE2D.Collision
import HGE2D.Geometry
import HGE2D.Classes
import Data.List
data (Positioned a) => QuadTree a = QuadEmpty
| QuadLeaf a
| QuadBranch (QuadTree a) (QuadTree a) (QuadTree a) (QuadTree a) BoundingBox
data QuadDir = NN | NP | PN | PP
buildQuadTree :: (Positioned a) => BoundingBox -> [a] -> QuadTree a
buildQuadTree _ [] = QuadEmpty
buildQuadTree _ [x] = QuadLeaf x
buildQuadTree bb xs = QuadBranch nn np pn pp bb
where
nn = buildQuadTree bbnn $ filter isnn xs
np = buildQuadTree bbnp $ filter isnp xs
pn = buildQuadTree bbpn $ filter ispn xs
pp = buildQuadTree bbpp $ filter ispp xs
bbnn = bbFromList [center, (bbMin bb)]
bbnp = bbFromList [center, (fst $ bbMin bb, snd $ bbMax bb)]
bbpn = bbFromList [center, (fst $ bbMax bb, snd $ bbMin bb)]
bbpp = bbFromList [center, (bbMax bb)]
center = centerBB bb
isnn x = getX x <= getX center && getY x <= getY center
isnp x = getX x <= getX center && getY x > getY center
ispn x = getX x > getX center && getY x <= getY center
ispp x = getX x > getX center && getY x > getY center
calcQuadDir :: (Positioned a) => a -> BoundingBox -> QuadDir
calcQuadDir p bb
| (getX p) < (getX $ centerBB bb) && (getY p) < (getY $ centerBB bb) = NN
| (getX p) < (getX $ centerBB bb) && (getY p) >= (getY $ centerBB bb) = NP
| (getX p) >= (getX $ centerBB bb) && (getY p) < (getY $ centerBB bb) = PN
| otherwise = PP
nearestQuad :: (Positioned a, Positioned b) => a -> QuadTree b -> Maybe b
nearestQuad _ QuadEmpty = Nothing
nearestQuad _ (QuadLeaf x) = Just x
nearestQuad search (QuadBranch nn np pn pp bb) = foldResults best nodesToCheck
where
foldResults best [] = best
foldResults best [x] | mustCheck best x = minimumBy (\ a b -> compare (mayDist a) (mayDist b)) [best, nearestQuad search x]
| otherwise = best
foldResults best (x:xs) = foldResults (foldResults best [x]) xs
nodesToCheck = case calcQuadDir search bb of
NN -> [ np, pn, pp]
NP -> [nn, pn, pp]
PN -> [nn, np, pp]
PP -> [nn, np, pn ]
best = case calcQuadDir search bb of
NN -> nearestQuad search nn
NP -> nearestQuad search np
PN -> nearestQuad search pn
PP -> nearestQuad search pp
mayDist p = case p of
Nothing -> 1e300
Just x -> distanceSqr search x
mustCheck _ QuadEmpty = False
mustCheck best (QuadLeaf x) = distanceSqr search x < mayDist best
mustCheck best (QuadBranch _ _ _ _ bb) = isInsideRP search bb || distanceBBSqr search bb < mayDist best
quadTreeToList :: (Positioned a) => QuadTree a -> [a]
quadTreeToList QuadEmpty = []
quadTreeToList (QuadLeaf x) = [x]
quadTreeToList (QuadBranch nn np pn pp _) = (quadTreeToList nn) ++ (quadTreeToList np) ++ (quadTreeToList pn) ++ (quadTreeToList pp)