1 files changed, 228 insertions, 228 deletions
diff --git a/Spear/Math/Octree.hs b/Spear/Math/Octree.hs
index f5538b4..6c22468 100644
--- a/Spear/Math/Octree.hs
+++ b/Spear/Math/Octree.hs
@@ -1,228 +1,228 @@
-module Spear.Math.Octree
+module Spear.Math.Octree
-(
+(
-    Octree
+    Octree
-,   makeOctree
+,   makeOctree
-,   clone
+,   clone
-,   Spear.Math.Octree.insert
+,   Spear.Math.Octree.insert
-,   Spear.Math.Octree.map
+,   Spear.Math.Octree.map
-,   gmap
+,   gmap
-)
+)
-where
+where
-import Spear.Math.AABB
+import Spear.Math.AABB
-import Spear.Math.Collision
+import Spear.Math.Collision
-import Spear.Math.Vector
+import Spear.Math.Vector
-import Control.Applicative ((<*>))
+import Control.Applicative ((<*>))
-import Data.List
+import Data.List
-import Data.Functor
+import Data.Functor
-import Data.Monoid
+import Data.Monoid
-import qualified Data.Foldable as F
+import qualified Data.Foldable as F
-- | An octree.
+-- | An octree.
-data Octree e
+data Octree e
-    = Octree
+    = Octree
-    { root :: !AABB2
+    { root :: !AABB2
-    , ents :: ![e]
+    , ents :: ![e]
-    , c1   :: !(Octree e)
+    , c1   :: !(Octree e)
-    , c2   :: !(Octree e)
+    , c2   :: !(Octree e)
-    , c3   :: !(Octree e)
+    , c3   :: !(Octree e)
-    , c4   :: !(Octree e)
+    , c4   :: !(Octree e)
-    , c5   :: !(Octree e)
+    , c5   :: !(Octree e)
-    , c6   :: !(Octree e)
+    , c6   :: !(Octree e)
-    , c7   :: !(Octree e)
+    , c7   :: !(Octree e)
-    , c8   :: !(Octree e)
+    , c8   :: !(Octree e)
-    }
+    }
-    |
+    |
-    Leaf
+    Leaf
-    { root :: !AABB2
+    { root :: !AABB2
-    , ents :: ![e]
+    , ents :: ![e]
-    }
+    }
-- | Construct an octree using the specified AABB as the root and having the specified depth.
+-- | Construct an octree using the specified AABB as the root and having the specified depth.
-makeOctree :: Int -> AABB2 -> Octree e
+makeOctree :: Int -> AABB2 -> Octree e
-makeOctree d root@(AABB2 min max)
+makeOctree d root@(AABB2 min max)
-    | d == 0    = Leaf root []
+    | d == 0    = Leaf root []
-    | otherwise = Octree root [] c1 c2 c3 c4 c5 c6 c7 c8
+    | otherwise = Octree root [] c1 c2 c3 c4 c5 c6 c7 c8
-    where
+    where
-        boxes = subdivide root
+        boxes = subdivide root
-        c1 = makeOctree (d-1) $ boxes !! 0
+        c1 = makeOctree (d-1) $ boxes !! 0
-        c2 = makeOctree (d-1) $ boxes !! 1
+        c2 = makeOctree (d-1) $ boxes !! 1
-        c3 = makeOctree (d-1) $ boxes !! 2
+        c3 = makeOctree (d-1) $ boxes !! 2
-        c4 = makeOctree (d-1) $ boxes !! 3
+        c4 = makeOctree (d-1) $ boxes !! 3
-        c5 = makeOctree (d-1) $ boxes !! 4
+        c5 = makeOctree (d-1) $ boxes !! 4
-        c6 = makeOctree (d-1) $ boxes !! 5
+        c6 = makeOctree (d-1) $ boxes !! 5
-        c7 = makeOctree (d-1) $ boxes !! 6
+        c7 = makeOctree (d-1) $ boxes !! 6
-        c8 = makeOctree (d-1) $ boxes !! 7
+        c8 = makeOctree (d-1) $ boxes !! 7
-subdivide :: AABB2 -> [AABB2]
+subdivide :: AABB2 -> [AABB2]
-subdivide (AABB2 min max) = [a1, a2, a3, a4, a5, a6, a7, a8]
+subdivide (AABB2 min max) = [a1, a2, a3, a4, a5, a6, a7, a8]
-    where
+    where
-        v = (max-min) / 2
+        v = (max-min) / 2
-        c = vec2 (x min + x v) (y min + y v)
+        c = vec2 (x min + x v) (y min + y v)
-        a1 = AABB2 min c
+        a1 = AABB2 min c
-        a2 = AABB2 ( vec2 (x min) (y min)) ( vec2 (x c)   (y c)  )
+        a2 = AABB2 ( vec2 (x min) (y min)) ( vec2 (x c)   (y c)  )
-        a3 = AABB2 ( vec2 (x min) (y c)  ) ( vec2 (x c)   (y max))
+        a3 = AABB2 ( vec2 (x min) (y c)  ) ( vec2 (x c)   (y max))
-        a4 = AABB2 ( vec2 (x min) (y c)  ) ( vec2 (x c)   (y max))
+        a4 = AABB2 ( vec2 (x min) (y c)  ) ( vec2 (x c)   (y max))
-        a5 = AABB2 ( vec2 (x c)   (y min)) ( vec2 (x max) (y c)  )
+        a5 = AABB2 ( vec2 (x c)   (y min)) ( vec2 (x max) (y c)  )
-        a6 = AABB2 ( vec2 (x c)   (y min)) ( vec2 (x max) (y c)  )
+        a6 = AABB2 ( vec2 (x c)   (y min)) ( vec2 (x max) (y c)  )
-        a7 = AABB2 ( vec2 (x c)   (y c)  ) ( vec2 (x max) (y max))
+        a7 = AABB2 ( vec2 (x c)   (y c)  ) ( vec2 (x max) (y max))
-        a8 = AABB2 c max
+        a8 = AABB2 c max
-- | Clone the structure of the octree. The new octree has no entities.
+-- | Clone the structure of the octree. The new octree has no entities.
-clone :: Octree e -> Octree e
+clone :: Octree e -> Octree e
-clone (Leaf root ents) = Leaf root []
+clone (Leaf root ents) = Leaf root []
-clone (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) = Octree root [] c1' c2' c3' c4' c5' c6' c7' c8'
+clone (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) = Octree root [] c1' c2' c3' c4' c5' c6' c7' c8'
-    where
+    where
-        c1' = clone c1
+        c1' = clone c1
-        c2' = clone c2
+        c2' = clone c2
-        c3' = clone c3
+        c3' = clone c3
-        c4' = clone c4
+        c4' = clone c4
-        c5' = clone c5
+        c5' = clone c5
-        c6' = clone c6
+        c6' = clone c6
-        c7' = clone c7
+        c7' = clone c7
-        c8' = clone c8
+        c8' = clone c8
-keep :: (e -> AABB2 -> CollisionType) -> AABB2 -> e -> Bool
+keep :: (e -> AABB2 -> CollisionType) -> AABB2 -> e -> Bool
-keep testAABB2 aabb e = test == FullyContainedBy
+keep testAABB2 aabb e = test == FullyContainedBy
-    where test = e `testAABB2` aabb
+    where test = e `testAABB2` aabb
-- | Insert a list of entities into the octree.
+-- | Insert a list of entities into the octree.
-insert :: (e -> AABB2 -> CollisionType) -> Octree e -> [e] -> Octree e
+insert :: (e -> AABB2 -> CollisionType) -> Octree e -> [e] -> Octree e
-insert testAABB2 octree es = octree' where (octree', _) = insert' testAABB2 es octree
+insert testAABB2 octree es = octree' where (octree', _) = insert' testAABB2 es octree
-insert' :: (e -> AABB2 -> CollisionType) -> [e] -> Octree e -> (Octree e, [e])
+insert' :: (e -> AABB2 -> CollisionType) -> [e] -> Octree e -> (Octree e, [e])
-insert' testAABB2 es (Leaf root ents) = (Leaf root ents', outliers)
+insert' testAABB2 es (Leaf root ents) = (Leaf root ents', outliers)
-    where
+    where
-        ents'       = ents ++ ents_kept
+        ents'       = ents ++ ents_kept
-        ents_kept   = filter (keep testAABB2 root) es
+        ents_kept   = filter (keep testAABB2 root) es
-        outliers    = filter (not . keep testAABB2 root) es
+        outliers    = filter (not . keep testAABB2 root) es
-insert' testAABB2 es (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
+insert' testAABB2 es (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
-    (Octree root ents' c1' c2' c3' c4' c5' c6' c7' c8', outliers)
+    (Octree root ents' c1' c2' c3' c4' c5' c6' c7' c8', outliers)
-    where
+    where
-        ents'        = ents ++ ents_kept
+        ents'        = ents ++ ents_kept
-        new_ents     = es ++ ents1 ++ ents2 ++ ents3 ++ ents4 ++ ents5 ++ ents6 ++ ents7 ++ ents8
+        new_ents     = es ++ ents1 ++ ents2 ++ ents3 ++ ents4 ++ ents5 ++ ents6 ++ ents7 ++ ents8
-        ents_kept    = filter (keep testAABB2 root) new_ents
+        ents_kept    = filter (keep testAABB2 root) new_ents
-        outliers     = filter (not . keep testAABB2 root) new_ents
+        outliers     = filter (not . keep testAABB2 root) new_ents
-        (c1', ents1) = insert' testAABB2 es c1
+        (c1', ents1) = insert' testAABB2 es c1
-        (c2', ents2) = insert' testAABB2 es c2
+        (c2', ents2) = insert' testAABB2 es c2
-        (c3', ents3) = insert' testAABB2 es c3
+        (c3', ents3) = insert' testAABB2 es c3
-        (c4', ents4) = insert' testAABB2 es c4
+        (c4', ents4) = insert' testAABB2 es c4
-        (c5', ents5) = insert' testAABB2 es c5
+        (c5', ents5) = insert' testAABB2 es c5
-        (c6', ents6) = insert' testAABB2 es c6
+        (c6', ents6) = insert' testAABB2 es c6
-        (c7', ents7) = insert' testAABB2 es c7
+        (c7', ents7) = insert' testAABB2 es c7
-        (c8', ents8) = insert' testAABB2 es c8
+        (c8', ents8) = insert' testAABB2 es c8
-- | Extract all entities from the octree. The resulting octree has no entities.
+-- | Extract all entities from the octree. The resulting octree has no entities.
-extract :: Octree e -> (Octree e, [e])
+extract :: Octree e -> (Octree e, [e])
-extract (Leaf root ents) = (Leaf root [], ents)
+extract (Leaf root ents) = (Leaf root [], ents)
-extract (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) = (Octree root [] c1' c2' c3' c4' c5' c6' c7' c8', ents')
+extract (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) = (Octree root [] c1' c2' c3' c4' c5' c6' c7' c8', ents')
-    where
+    where
-        (c1', ents1) = extract c1
+        (c1', ents1) = extract c1
-        (c2', ents2) = extract c2
+        (c2', ents2) = extract c2
-        (c3', ents3) = extract c3
+        (c3', ents3) = extract c3
-        (c4', ents4) = extract c4
+        (c4', ents4) = extract c4
-        (c5', ents5) = extract c5
+        (c5', ents5) = extract c5
-        (c6', ents6) = extract c6
+        (c6', ents6) = extract c6
-        (c7', ents7) = extract c7
+        (c7', ents7) = extract c7
-        (c8', ents8) = extract c8
+        (c8', ents8) = extract c8
-        ents' = ents ++ ents1 ++ ents2 ++ ents3 ++ ents4 ++ ents5 ++ ents6 ++ ents7 ++ ents8
+        ents' = ents ++ ents1 ++ ents2 ++ ents3 ++ ents4 ++ ents5 ++ ents6 ++ ents7 ++ ents8
-- | Apply the given function to the entities in the octree.
+-- | Apply the given function to the entities in the octree.
--
+--
-- Entities that break out of their cell are reallocated appropriately.
+-- Entities that break out of their cell are reallocated appropriately.
-map :: (e -> AABB2 -> CollisionType) -> (e -> e) -> Octree e -> Octree e
+map :: (e -> AABB2 -> CollisionType) -> (e -> e) -> Octree e -> Octree e
-map testAABB2 f o =
+map testAABB2 f o =
-    let (o', outliers) = map' testAABB2 f o
+    let (o', outliers) = map' testAABB2 f o
-    in Spear.Math.Octree.insert testAABB2 o' outliers
+    in Spear.Math.Octree.insert testAABB2 o' outliers
-map' :: (e -> AABB2 -> CollisionType) -> (e -> e) -> Octree e -> (Octree e, [e])
+map' :: (e -> AABB2 -> CollisionType) -> (e -> e) -> Octree e -> (Octree e, [e])
-map' testAABB2 f (Leaf root ents) = (Leaf root ents_kept, outliers)
+map' testAABB2 f (Leaf root ents) = (Leaf root ents_kept, outliers)
-    where
+    where
-        ents'       = fmap f ents
+        ents'       = fmap f ents
-        ents_kept   = filter (keep testAABB2 root) ents'
+        ents_kept   = filter (keep testAABB2 root) ents'
-        outliers    = filter (not . keep testAABB2 root) ents'
+        outliers    = filter (not . keep testAABB2 root) ents'
-map' testAABB2 f (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
+map' testAABB2 f (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
-    (Octree root ents_kept c1' c2' c3' c4' c5' c6' c7' c8', outliers)
+    (Octree root ents_kept c1' c2' c3' c4' c5' c6' c7' c8', outliers)
-    where
+    where
-        ents'       = (fmap f ents) ++ out1 ++ out2 ++ out3 ++ out4 ++ out5 ++ out6 ++ out7 ++ out8
+        ents'       = (fmap f ents) ++ out1 ++ out2 ++ out3 ++ out4 ++ out5 ++ out6 ++ out7 ++ out8
-        ents_kept   = filter (keep testAABB2 root) ents'
+        ents_kept   = filter (keep testAABB2 root) ents'
-        outliers    = filter (not . keep testAABB2 root) ents'
+        outliers    = filter (not . keep testAABB2 root) ents'
-        (c1', out1) = map' testAABB2 f c1
+        (c1', out1) = map' testAABB2 f c1
-        (c2', out2) = map' testAABB2 f c2
+        (c2', out2) = map' testAABB2 f c2
-        (c3', out3) = map' testAABB2 f c3
+        (c3', out3) = map' testAABB2 f c3
-        (c4', out4) = map' testAABB2 f c4
+        (c4', out4) = map' testAABB2 f c4
-        (c5', out5) = map' testAABB2 f c5
+        (c5', out5) = map' testAABB2 f c5
-        (c6', out6) = map' testAABB2 f c6
+        (c6', out6) = map' testAABB2 f c6
-        (c7', out7) = map' testAABB2 f c7
+        (c7', out7) = map' testAABB2 f c7
-        (c8', out8) = map' testAABB2 f c8
+        (c8', out8) = map' testAABB2 f c8
-- | Apply a function to the entity groups in the octree.
+-- | Apply a function to the entity groups in the octree.
--
+--
-- Entities that break out of their cell are reallocated appropriately.
+-- Entities that break out of their cell are reallocated appropriately.
-gmap :: (e -> AABB2 -> CollisionType) -> (e -> e -> e) -> Octree e -> Octree e
+gmap :: (e -> AABB2 -> CollisionType) -> (e -> e -> e) -> Octree e -> Octree e
-gmap testAABB2 f o =
+gmap testAABB2 f o =
-    let (o', outliers) = gmap' testAABB2 f o
+    let (o', outliers) = gmap' testAABB2 f o
-    in Spear.Math.Octree.insert testAABB2 o' outliers
+    in Spear.Math.Octree.insert testAABB2 o' outliers
-gmap' :: (e -> AABB2 -> CollisionType) -> (e -> e -> e) -> Octree e -> (Octree e, [e])
+gmap' :: (e -> AABB2 -> CollisionType) -> (e -> e -> e) -> Octree e -> (Octree e, [e])
-gmap' testAABB2 f (Leaf root ents) = (Leaf root ents_kept, outliers)
+gmap' testAABB2 f (Leaf root ents) = (Leaf root ents_kept, outliers)
-    where
+    where
-        ents'       = f <$> ents <*> ents
+        ents'       = f <$> ents <*> ents
-        ents_kept   = filter (keep testAABB2 root) ents'
+        ents_kept   = filter (keep testAABB2 root) ents'
-        outliers    = filter (not . keep testAABB2 root) ents'
+        outliers    = filter (not . keep testAABB2 root) ents'
-gmap' testAABB2 f (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
+gmap' testAABB2 f (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
-    (Octree root ents_kept c1' c2' c3' c4' c5' c6' c7' c8', outliers)
+    (Octree root ents_kept c1' c2' c3' c4' c5' c6' c7' c8', outliers)
-    where
+    where
-        ents'= (f <$> ents <*> ents) ++ out1 ++ out2 ++ out3 ++ out4 ++ out5 ++ out6 ++ out7 ++ out8
+        ents'= (f <$> ents <*> ents) ++ out1 ++ out2 ++ out3 ++ out4 ++ out5 ++ out6 ++ out7 ++ out8
-        ents_kept   = filter (keep testAABB2 root) ents'
+        ents_kept   = filter (keep testAABB2 root) ents'
-        outliers    = filter (not . keep testAABB2 root) ents'
+        outliers    = filter (not . keep testAABB2 root) ents'
-        (c1', out1) = gmap' testAABB2 f c1
+        (c1', out1) = gmap' testAABB2 f c1
-        (c2', out2) = gmap' testAABB2 f c2
+        (c2', out2) = gmap' testAABB2 f c2
-        (c3', out3) = gmap' testAABB2 f c3
+        (c3', out3) = gmap' testAABB2 f c3
-        (c4', out4) = gmap' testAABB2 f c4
+        (c4', out4) = gmap' testAABB2 f c4
-        (c5', out5) = gmap' testAABB2 f c5
+        (c5', out5) = gmap' testAABB2 f c5
-        (c6', out6) = gmap' testAABB2 f c6
+        (c6', out6) = gmap' testAABB2 f c6
-        (c7', out7) = gmap' testAABB2 f c7
+        (c7', out7) = gmap' testAABB2 f c7
-        (c8', out8) = gmap' testAABB2 f c8
+        (c8', out8) = gmap' testAABB2 f c8
-instance Functor Octree where
+instance Functor Octree where
-    fmap f (Leaf root ents) = Leaf root $ fmap f ents
+    fmap f (Leaf root ents) = Leaf root $ fmap f ents
-    fmap f (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
+    fmap f (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
-        Octree root (fmap f ents) c1' c2' c3' c4' c5' c6' c7' c8'
+        Octree root (fmap f ents) c1' c2' c3' c4' c5' c6' c7' c8'
-        where
+        where
-            c1' = fmap f c1
+            c1' = fmap f c1
-            c2' = fmap f c2
+            c2' = fmap f c2
-            c3' = fmap f c3
+            c3' = fmap f c3
-            c4' = fmap f c4
+            c4' = fmap f c4
-            c5' = fmap f c5
+            c5' = fmap f c5
-            c6' = fmap f c6
+            c6' = fmap f c6
-            c7' = fmap f c7
+            c7' = fmap f c7
-            c8' = fmap f c8
+            c8' = fmap f c8
-instance F.Foldable Octree where
+instance F.Foldable Octree where
-    foldMap f (Leaf root ents) = mconcat . fmap f $ ents
+    foldMap f (Leaf root ents) = mconcat . fmap f $ ents
-    foldMap f (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
+    foldMap f (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
-        mconcat (fmap f ents) `mappend`
+        mconcat (fmap f ents) `mappend`
-        c1' `mappend` c2' `mappend` c3' `mappend` c4' `mappend`
+        c1' `mappend` c2' `mappend` c3' `mappend` c4' `mappend`
-        c5' `mappend` c6' `mappend` c7' `mappend` c8'
+        c5' `mappend` c6' `mappend` c7' `mappend` c8'
-        where
+        where
-            c1' = F.foldMap f c1
+            c1' = F.foldMap f c1
-            c2' = F.foldMap f c2
+            c2' = F.foldMap f c2
-            c3' = F.foldMap f c3
+            c3' = F.foldMap f c3
-            c4' = F.foldMap f c4
+            c4' = F.foldMap f c4
-            c5' = F.foldMap f c5
+            c5' = F.foldMap f c5
-            c6' = F.foldMap f c6
+            c6' = F.foldMap f c6
-            c7' = F.foldMap f c7
+            c7' = F.foldMap f c7
-            c8' = F.foldMap f c8
+            c8' = F.foldMap f c8

diff --git a/Spear/Math/Octree.hs b/Spear/Math/Octree.hs index f5538b4..6c22468 100644 --- a/Spear/Math/Octree.hs +++ b/Spear/Math/Octree.hs
@@ -1,228 +1,228 @@
1	module Spear.Math.Octree	1	module Spear.Math.Octree
2	(	2	(
3	Octree	3	Octree
4	, makeOctree	4	, makeOctree
5	, clone	5	, clone
6	, Spear.Math.Octree.insert	6	, Spear.Math.Octree.insert
7	, Spear.Math.Octree.map	7	, Spear.Math.Octree.map
8	, gmap	8	, gmap
9	)	9	)
10	where	10	where
11		11
12	import Spear.Math.AABB	12	import Spear.Math.AABB
13	import Spear.Math.Collision	13	import Spear.Math.Collision
14	import Spear.Math.Vector	14	import Spear.Math.Vector
15		15
16	import Control.Applicative ((<*>))	16	import Control.Applicative ((<*>))
17	import Data.List	17	import Data.List
18	import Data.Functor	18	import Data.Functor
19	import Data.Monoid	19	import Data.Monoid
20	import qualified Data.Foldable as F	20	import qualified Data.Foldable as F
21		21
22	-- \| An octree.	22	-- \| An octree.
23	data Octree e	23	data Octree e
24	= Octree	24	= Octree
25	{ root :: !AABB2	25	{ root :: !AABB2
26	, ents :: ![e]	26	, ents :: ![e]
27	, c1 :: !(Octree e)	27	, c1 :: !(Octree e)
28	, c2 :: !(Octree e)	28	, c2 :: !(Octree e)
29	, c3 :: !(Octree e)	29	, c3 :: !(Octree e)
30	, c4 :: !(Octree e)	30	, c4 :: !(Octree e)
31	, c5 :: !(Octree e)	31	, c5 :: !(Octree e)
32	, c6 :: !(Octree e)	32	, c6 :: !(Octree e)
33	, c7 :: !(Octree e)	33	, c7 :: !(Octree e)
34	, c8 :: !(Octree e)	34	, c8 :: !(Octree e)
35	}	35	}
36	\|	36	\|
37	Leaf	37	Leaf
38	{ root :: !AABB2	38	{ root :: !AABB2
39	, ents :: ![e]	39	, ents :: ![e]
40	}	40	}
41		41
42	-- \| Construct an octree using the specified AABB as the root and having the specified depth.	42	-- \| Construct an octree using the specified AABB as the root and having the specified depth.
43	makeOctree :: Int -> AABB2 -> Octree e	43	makeOctree :: Int -> AABB2 -> Octree e
44	makeOctree d root@(AABB2 min max)	44	makeOctree d root@(AABB2 min max)
45	\| d == 0 = Leaf root []	45	\| d == 0 = Leaf root []
46	\| otherwise = Octree root [] c1 c2 c3 c4 c5 c6 c7 c8	46	\| otherwise = Octree root [] c1 c2 c3 c4 c5 c6 c7 c8
47	where	47	where
48	boxes = subdivide root	48	boxes = subdivide root
49	c1 = makeOctree (d-1) $ boxes !! 0	49	c1 = makeOctree (d-1) $ boxes !! 0
50	c2 = makeOctree (d-1) $ boxes !! 1	50	c2 = makeOctree (d-1) $ boxes !! 1
51	c3 = makeOctree (d-1) $ boxes !! 2	51	c3 = makeOctree (d-1) $ boxes !! 2
52	c4 = makeOctree (d-1) $ boxes !! 3	52	c4 = makeOctree (d-1) $ boxes !! 3
53	c5 = makeOctree (d-1) $ boxes !! 4	53	c5 = makeOctree (d-1) $ boxes !! 4
54	c6 = makeOctree (d-1) $ boxes !! 5	54	c6 = makeOctree (d-1) $ boxes !! 5
55	c7 = makeOctree (d-1) $ boxes !! 6	55	c7 = makeOctree (d-1) $ boxes !! 6
56	c8 = makeOctree (d-1) $ boxes !! 7	56	c8 = makeOctree (d-1) $ boxes !! 7
57		57
58	subdivide :: AABB2 -> [AABB2]	58	subdivide :: AABB2 -> [AABB2]
59	subdivide (AABB2 min max) = [a1, a2, a3, a4, a5, a6, a7, a8]	59	subdivide (AABB2 min max) = [a1, a2, a3, a4, a5, a6, a7, a8]
60	where	60	where
61	v = (max-min) / 2	61	v = (max-min) / 2
62	c = vec2 (x min + x v) (y min + y v)	62	c = vec2 (x min + x v) (y min + y v)
63	a1 = AABB2 min c	63	a1 = AABB2 min c
64	a2 = AABB2 ( vec2 (x min) (y min)) ( vec2 (x c) (y c) )	64	a2 = AABB2 ( vec2 (x min) (y min)) ( vec2 (x c) (y c) )
65	a3 = AABB2 ( vec2 (x min) (y c) ) ( vec2 (x c) (y max))	65	a3 = AABB2 ( vec2 (x min) (y c) ) ( vec2 (x c) (y max))
66	a4 = AABB2 ( vec2 (x min) (y c) ) ( vec2 (x c) (y max))	66	a4 = AABB2 ( vec2 (x min) (y c) ) ( vec2 (x c) (y max))
67	a5 = AABB2 ( vec2 (x c) (y min)) ( vec2 (x max) (y c) )	67	a5 = AABB2 ( vec2 (x c) (y min)) ( vec2 (x max) (y c) )
68	a6 = AABB2 ( vec2 (x c) (y min)) ( vec2 (x max) (y c) )	68	a6 = AABB2 ( vec2 (x c) (y min)) ( vec2 (x max) (y c) )
69	a7 = AABB2 ( vec2 (x c) (y c) ) ( vec2 (x max) (y max))	69	a7 = AABB2 ( vec2 (x c) (y c) ) ( vec2 (x max) (y max))
70	a8 = AABB2 c max	70	a8 = AABB2 c max
71		71
72	-- \| Clone the structure of the octree. The new octree has no entities.	72	-- \| Clone the structure of the octree. The new octree has no entities.
73	clone :: Octree e -> Octree e	73	clone :: Octree e -> Octree e
74	clone (Leaf root ents) = Leaf root []	74	clone (Leaf root ents) = Leaf root []
75	clone (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) = Octree root [] c1' c2' c3' c4' c5' c6' c7' c8'	75	clone (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) = Octree root [] c1' c2' c3' c4' c5' c6' c7' c8'
76	where	76	where
77	c1' = clone c1	77	c1' = clone c1
78	c2' = clone c2	78	c2' = clone c2
79	c3' = clone c3	79	c3' = clone c3
80	c4' = clone c4	80	c4' = clone c4
81	c5' = clone c5	81	c5' = clone c5
82	c6' = clone c6	82	c6' = clone c6
83	c7' = clone c7	83	c7' = clone c7
84	c8' = clone c8	84	c8' = clone c8
85		85
86	keep :: (e -> AABB2 -> CollisionType) -> AABB2 -> e -> Bool	86	keep :: (e -> AABB2 -> CollisionType) -> AABB2 -> e -> Bool
87	keep testAABB2 aabb e = test == FullyContainedBy	87	keep testAABB2 aabb e = test == FullyContainedBy
88	where test = e `testAABB2` aabb	88	where test = e `testAABB2` aabb
89		89
90	-- \| Insert a list of entities into the octree.	90	-- \| Insert a list of entities into the octree.
91	insert :: (e -> AABB2 -> CollisionType) -> Octree e -> [e] -> Octree e	91	insert :: (e -> AABB2 -> CollisionType) -> Octree e -> [e] -> Octree e
92	insert testAABB2 octree es = octree' where (octree', _) = insert' testAABB2 es octree	92	insert testAABB2 octree es = octree' where (octree', _) = insert' testAABB2 es octree
93		93
94	insert' :: (e -> AABB2 -> CollisionType) -> [e] -> Octree e -> (Octree e, [e])	94	insert' :: (e -> AABB2 -> CollisionType) -> [e] -> Octree e -> (Octree e, [e])
95		95
96	insert' testAABB2 es (Leaf root ents) = (Leaf root ents', outliers)	96	insert' testAABB2 es (Leaf root ents) = (Leaf root ents', outliers)
97	where	97	where
98	ents' = ents ++ ents_kept	98	ents' = ents ++ ents_kept
99	ents_kept = filter (keep testAABB2 root) es	99	ents_kept = filter (keep testAABB2 root) es
100	outliers = filter (not . keep testAABB2 root) es	100	outliers = filter (not . keep testAABB2 root) es
101		101
102	insert' testAABB2 es (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =	102	insert' testAABB2 es (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
103	(Octree root ents' c1' c2' c3' c4' c5' c6' c7' c8', outliers)	103	(Octree root ents' c1' c2' c3' c4' c5' c6' c7' c8', outliers)
104	where	104	where
105	ents' = ents ++ ents_kept	105	ents' = ents ++ ents_kept
106	new_ents = es ++ ents1 ++ ents2 ++ ents3 ++ ents4 ++ ents5 ++ ents6 ++ ents7 ++ ents8	106	new_ents = es ++ ents1 ++ ents2 ++ ents3 ++ ents4 ++ ents5 ++ ents6 ++ ents7 ++ ents8
107	ents_kept = filter (keep testAABB2 root) new_ents	107	ents_kept = filter (keep testAABB2 root) new_ents
108	outliers = filter (not . keep testAABB2 root) new_ents	108	outliers = filter (not . keep testAABB2 root) new_ents
109	(c1', ents1) = insert' testAABB2 es c1	109	(c1', ents1) = insert' testAABB2 es c1
110	(c2', ents2) = insert' testAABB2 es c2	110	(c2', ents2) = insert' testAABB2 es c2
111	(c3', ents3) = insert' testAABB2 es c3	111	(c3', ents3) = insert' testAABB2 es c3
112	(c4', ents4) = insert' testAABB2 es c4	112	(c4', ents4) = insert' testAABB2 es c4
113	(c5', ents5) = insert' testAABB2 es c5	113	(c5', ents5) = insert' testAABB2 es c5
114	(c6', ents6) = insert' testAABB2 es c6	114	(c6', ents6) = insert' testAABB2 es c6
115	(c7', ents7) = insert' testAABB2 es c7	115	(c7', ents7) = insert' testAABB2 es c7
116	(c8', ents8) = insert' testAABB2 es c8	116	(c8', ents8) = insert' testAABB2 es c8
117		117
118	-- \| Extract all entities from the octree. The resulting octree has no entities.	118	-- \| Extract all entities from the octree. The resulting octree has no entities.
119	extract :: Octree e -> (Octree e, [e])	119	extract :: Octree e -> (Octree e, [e])
120	extract (Leaf root ents) = (Leaf root [], ents)	120	extract (Leaf root ents) = (Leaf root [], ents)
121	extract (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) = (Octree root [] c1' c2' c3' c4' c5' c6' c7' c8', ents')	121	extract (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) = (Octree root [] c1' c2' c3' c4' c5' c6' c7' c8', ents')
122	where	122	where
123	(c1', ents1) = extract c1	123	(c1', ents1) = extract c1
124	(c2', ents2) = extract c2	124	(c2', ents2) = extract c2
125	(c3', ents3) = extract c3	125	(c3', ents3) = extract c3
126	(c4', ents4) = extract c4	126	(c4', ents4) = extract c4
127	(c5', ents5) = extract c5	127	(c5', ents5) = extract c5
128	(c6', ents6) = extract c6	128	(c6', ents6) = extract c6
129	(c7', ents7) = extract c7	129	(c7', ents7) = extract c7
130	(c8', ents8) = extract c8	130	(c8', ents8) = extract c8
131	ents' = ents ++ ents1 ++ ents2 ++ ents3 ++ ents4 ++ ents5 ++ ents6 ++ ents7 ++ ents8	131	ents' = ents ++ ents1 ++ ents2 ++ ents3 ++ ents4 ++ ents5 ++ ents6 ++ ents7 ++ ents8
132		132
133	-- \| Apply the given function to the entities in the octree.	133	-- \| Apply the given function to the entities in the octree.
134	--	134	--
135	-- Entities that break out of their cell are reallocated appropriately.	135	-- Entities that break out of their cell are reallocated appropriately.
136	map :: (e -> AABB2 -> CollisionType) -> (e -> e) -> Octree e -> Octree e	136	map :: (e -> AABB2 -> CollisionType) -> (e -> e) -> Octree e -> Octree e
137	map testAABB2 f o =	137	map testAABB2 f o =
138	let (o', outliers) = map' testAABB2 f o	138	let (o', outliers) = map' testAABB2 f o
139	in Spear.Math.Octree.insert testAABB2 o' outliers	139	in Spear.Math.Octree.insert testAABB2 o' outliers
140		140
141	map' :: (e -> AABB2 -> CollisionType) -> (e -> e) -> Octree e -> (Octree e, [e])	141	map' :: (e -> AABB2 -> CollisionType) -> (e -> e) -> Octree e -> (Octree e, [e])
142		142
143	map' testAABB2 f (Leaf root ents) = (Leaf root ents_kept, outliers)	143	map' testAABB2 f (Leaf root ents) = (Leaf root ents_kept, outliers)
144	where	144	where
145	ents' = fmap f ents	145	ents' = fmap f ents
146	ents_kept = filter (keep testAABB2 root) ents'	146	ents_kept = filter (keep testAABB2 root) ents'
147	outliers = filter (not . keep testAABB2 root) ents'	147	outliers = filter (not . keep testAABB2 root) ents'
148		148
149	map' testAABB2 f (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =	149	map' testAABB2 f (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
150	(Octree root ents_kept c1' c2' c3' c4' c5' c6' c7' c8', outliers)	150	(Octree root ents_kept c1' c2' c3' c4' c5' c6' c7' c8', outliers)
151	where	151	where
152	ents' = (fmap f ents) ++ out1 ++ out2 ++ out3 ++ out4 ++ out5 ++ out6 ++ out7 ++ out8	152	ents' = (fmap f ents) ++ out1 ++ out2 ++ out3 ++ out4 ++ out5 ++ out6 ++ out7 ++ out8
153	ents_kept = filter (keep testAABB2 root) ents'	153	ents_kept = filter (keep testAABB2 root) ents'
154	outliers = filter (not . keep testAABB2 root) ents'	154	outliers = filter (not . keep testAABB2 root) ents'
155	(c1', out1) = map' testAABB2 f c1	155	(c1', out1) = map' testAABB2 f c1
156	(c2', out2) = map' testAABB2 f c2	156	(c2', out2) = map' testAABB2 f c2
157	(c3', out3) = map' testAABB2 f c3	157	(c3', out3) = map' testAABB2 f c3
158	(c4', out4) = map' testAABB2 f c4	158	(c4', out4) = map' testAABB2 f c4
159	(c5', out5) = map' testAABB2 f c5	159	(c5', out5) = map' testAABB2 f c5
160	(c6', out6) = map' testAABB2 f c6	160	(c6', out6) = map' testAABB2 f c6
161	(c7', out7) = map' testAABB2 f c7	161	(c7', out7) = map' testAABB2 f c7
162	(c8', out8) = map' testAABB2 f c8	162	(c8', out8) = map' testAABB2 f c8
163		163
164		164
165	-- \| Apply a function to the entity groups in the octree.	165	-- \| Apply a function to the entity groups in the octree.
166	--	166	--
167	-- Entities that break out of their cell are reallocated appropriately.	167	-- Entities that break out of their cell are reallocated appropriately.
168	gmap :: (e -> AABB2 -> CollisionType) -> (e -> e -> e) -> Octree e -> Octree e	168	gmap :: (e -> AABB2 -> CollisionType) -> (e -> e -> e) -> Octree e -> Octree e
169	gmap testAABB2 f o =	169	gmap testAABB2 f o =
170	let (o', outliers) = gmap' testAABB2 f o	170	let (o', outliers) = gmap' testAABB2 f o
171	in Spear.Math.Octree.insert testAABB2 o' outliers	171	in Spear.Math.Octree.insert testAABB2 o' outliers
172		172
173	gmap' :: (e -> AABB2 -> CollisionType) -> (e -> e -> e) -> Octree e -> (Octree e, [e])	173	gmap' :: (e -> AABB2 -> CollisionType) -> (e -> e -> e) -> Octree e -> (Octree e, [e])
174		174
175	gmap' testAABB2 f (Leaf root ents) = (Leaf root ents_kept, outliers)	175	gmap' testAABB2 f (Leaf root ents) = (Leaf root ents_kept, outliers)
176	where	176	where
177	ents' = f <$> ents <*> ents	177	ents' = f <$> ents <*> ents
178	ents_kept = filter (keep testAABB2 root) ents'	178	ents_kept = filter (keep testAABB2 root) ents'
179	outliers = filter (not . keep testAABB2 root) ents'	179	outliers = filter (not . keep testAABB2 root) ents'
180		180
181	gmap' testAABB2 f (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =	181	gmap' testAABB2 f (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
182	(Octree root ents_kept c1' c2' c3' c4' c5' c6' c7' c8', outliers)	182	(Octree root ents_kept c1' c2' c3' c4' c5' c6' c7' c8', outliers)
183	where	183	where
184	ents'= (f <$> ents <*> ents) ++ out1 ++ out2 ++ out3 ++ out4 ++ out5 ++ out6 ++ out7 ++ out8	184	ents'= (f <$> ents <*> ents) ++ out1 ++ out2 ++ out3 ++ out4 ++ out5 ++ out6 ++ out7 ++ out8
185	ents_kept = filter (keep testAABB2 root) ents'	185	ents_kept = filter (keep testAABB2 root) ents'
186	outliers = filter (not . keep testAABB2 root) ents'	186	outliers = filter (not . keep testAABB2 root) ents'
187	(c1', out1) = gmap' testAABB2 f c1	187	(c1', out1) = gmap' testAABB2 f c1
188	(c2', out2) = gmap' testAABB2 f c2	188	(c2', out2) = gmap' testAABB2 f c2
189	(c3', out3) = gmap' testAABB2 f c3	189	(c3', out3) = gmap' testAABB2 f c3
190	(c4', out4) = gmap' testAABB2 f c4	190	(c4', out4) = gmap' testAABB2 f c4
191	(c5', out5) = gmap' testAABB2 f c5	191	(c5', out5) = gmap' testAABB2 f c5
192	(c6', out6) = gmap' testAABB2 f c6	192	(c6', out6) = gmap' testAABB2 f c6
193	(c7', out7) = gmap' testAABB2 f c7	193	(c7', out7) = gmap' testAABB2 f c7
194	(c8', out8) = gmap' testAABB2 f c8	194	(c8', out8) = gmap' testAABB2 f c8
195		195
196	instance Functor Octree where	196	instance Functor Octree where
197		197
198	fmap f (Leaf root ents) = Leaf root $ fmap f ents	198	fmap f (Leaf root ents) = Leaf root $ fmap f ents
199		199
200	fmap f (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =	200	fmap f (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
201	Octree root (fmap f ents) c1' c2' c3' c4' c5' c6' c7' c8'	201	Octree root (fmap f ents) c1' c2' c3' c4' c5' c6' c7' c8'
202	where	202	where
203	c1' = fmap f c1	203	c1' = fmap f c1
204	c2' = fmap f c2	204	c2' = fmap f c2
205	c3' = fmap f c3	205	c3' = fmap f c3
206	c4' = fmap f c4	206	c4' = fmap f c4
207	c5' = fmap f c5	207	c5' = fmap f c5
208	c6' = fmap f c6	208	c6' = fmap f c6
209	c7' = fmap f c7	209	c7' = fmap f c7
210	c8' = fmap f c8	210	c8' = fmap f c8
211		211
212	instance F.Foldable Octree where	212	instance F.Foldable Octree where
213		213
214	foldMap f (Leaf root ents) = mconcat . fmap f $ ents	214	foldMap f (Leaf root ents) = mconcat . fmap f $ ents
215		215
216	foldMap f (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =	216	foldMap f (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
217	mconcat (fmap f ents) `mappend`	217	mconcat (fmap f ents) `mappend`
218	c1' `mappend` c2' `mappend` c3' `mappend` c4' `mappend`	218	c1' `mappend` c2' `mappend` c3' `mappend` c4' `mappend`
219	c5' `mappend` c6' `mappend` c7' `mappend` c8'	219	c5' `mappend` c6' `mappend` c7' `mappend` c8'
220	where	220	where
221	c1' = F.foldMap f c1	221	c1' = F.foldMap f c1
222	c2' = F.foldMap f c2	222	c2' = F.foldMap f c2
223	c3' = F.foldMap f c3	223	c3' = F.foldMap f c3
224	c4' = F.foldMap f c4	224	c4' = F.foldMap f c4
225	c5' = F.foldMap f c5	225	c5' = F.foldMap f c5
226	c6' = F.foldMap f c6	226	c6' = F.foldMap f c6
227	c7' = F.foldMap f c7	227	c7' = F.foldMap f c7
228	c8' = F.foldMap f c8	228	c8' = F.foldMap f c8