Updates

23 files changed, 726 insertions, 793 deletions

diff --git a/Spear.cabal b/Spear.cabal
index 514bed9..e25b347 100644
--- a/Spear.cabal
+++ b/Spear.cabal
@@ -10,40 +10,86 @@ synopsis: A 2.5D game framework.
 category: Game
 author: Marc Sunet
 data-dir: ""
- 
+
 library
-    build-depends: GLFW -any, OpenGL -any, OpenGLRaw -any,
-                   StateVar -any, base -any, bytestring -any, directory -any,
-                   mtl -any, transformers -any, resourcet -any, parsec >= 3,
-                   containers -any, vector -any, array -any
-    exposed-modules: Spear.Scene.GameObject Spear.Math.QuadTree
-                     Spear.Physics.Types Spear.App Spear.App.Application Spear.App.Input
-                     Spear.Assets.Image Spear.Assets.Model Spear.Collision
-                     Spear.Math.AABB Spear.Math.Circle Spear.Math.Triangle Spear.Game
-                     Spear.GL Spear.Math.Camera Spear.Math.Entity Spear.Math.Matrix3
-                     Spear.Math.Matrix4 Spear.Math.MatrixUtils Spear.Math.Plane
-                     Spear.Math.Quaternion Spear.Math.Vector Spear.Math.Vector.Class
-                     Spear.Math.Vector.Vector3 Spear.Math.Vector.Vector4
-                     Spear.Math.Vector.Vector2
-                     Spear.Physics Spear.Physics.Rigid Spear.Render.AnimatedModel
-                     Spear.Render.Material Spear.Render.Model Spear.Render.Program
-                     Spear.Render.StaticModel Spear.Scene.Graph Spear.Scene.Light
-                     Spear.Scene.Loader Spear.Scene.Scene Spear.Scene.SceneResources
-                     Spear.Sys.Timer Spear.Sys.Store Spear.Sys.Store.ID
-                     Spear.Math.Quad Spear.Math.Ray
-                     Spear.Math.Segment Spear.Math.Utils Spear.Math.Spatial2
+    build-depends: GLFW -any,
+                   OpenGL -any,
+                   OpenGLRaw -any,
+                   StateVar -any,
+                   base -any,
+                   bytestring >= 0.10,
+                   directory -any,
+                   mtl -any,
+                   transformers -any,
+                   resourcet -any,
+                   parsec >= 3,
+                   containers -any,
+                   vector -any,
+                   array -any
+
+    exposed-modules: Spear.App
+                     Spear.App.Application
+                     Spear.App.Input
+                     Spear.Assets.Image
+                     Spear.Assets.Model
+                     Spear.Game
+                     Spear.GL
+                     Spear.Math.AABB
+                     Spear.Math.Camera
+                     Spear.Math.Circle
+                     Spear.Math.Collision
+                     Spear.Math.Entity
+                     Spear.Math.Frustum
+                     Spear.Math.Matrix3
+                     Spear.Math.Matrix4
+                     Spear.Math.MatrixUtils
+                     Spear.Math.Octree
+                     Spear.Math.Plane
+                     Spear.Math.Quaternion
+                     Spear.Math.Ray
+                     Spear.Math.Segment
+                     Spear.Math.Spatial2
                      Spear.Math.Spatial3
+                     Spear.Math.Triangle
+                     Spear.Math.Utils
+                     Spear.Math.Vector
+                     Spear.Math.Vector.Class
+                     Spear.Math.Vector.Vector2
+                     Spear.Math.Vector.Vector3
+                     Spear.Math.Vector.Vector4
+                     Spear.Render.AnimatedModel
+                     Spear.Render.Material
+                     Spear.Render.Model
+                     Spear.Render.Program
+                     Spear.Render.StaticModel
+                     Spear.Scene.GameObject
+                     Spear.Scene.Graph
+                     Spear.Scene.Light
+                     Spear.Scene.Loader
+                     Spear.Scene.SceneResources
+                     Spear.Sys.Store
+                     Spear.Sys.Store.ID
+                     Spear.Sys.Timer
+
     exposed: True
+
     buildable: True
+
     build-tools: hsc2hs -any
+
     cc-options: -O2 -g -Wno-unused-result
+
     c-sources: Spear/Assets/Image/Image.c
-               Spear/Assets/Image/BMP/BMP_load.c Spear/Assets/Model/Model.c
-               Spear/Assets/Model/MD2/MD2_load.c Spear/Assets/Model/OBJ/cvector.c
-               Spear/Assets/Model/OBJ/OBJ_load.c Spear/Render/RenderModel.c
+               Spear/Assets/Image/BMP/BMP_load.c
+               Spear/Assets/Model/Model.c
+               Spear/Assets/Model/MD2/MD2_load.c
+               Spear/Assets/Model/OBJ/cvector.c
+               Spear/Assets/Model/OBJ/OBJ_load.c
+               Spear/Render/RenderModel.c
                Spear/Sys/Timer/ctimer.c
+
     extensions: TypeFamilies
-    extra-libraries: stdc++
+
     includes: Spear/Assets/Image/BMP/BMP_load.h
               Spear/Assets/Image/Image.h Spear/Assets/Image/Image_error_code.h
               Spear/Assets/Image/sys_types.h Spear/Assets/Model/MD2/MD2_load.h
@@ -51,9 +97,12 @@ library
               Spear/Assets/Model/Model.h Spear/Assets/Model/Model_error_code.h
               Spear/Assets/Model/sys_types.h Spear/Render/RenderModel.h
               Timer/Timer.h
+
     include-dirs: Spear/Assets/Image Spear/Assets/Model Spear/Render
                   Spear/Sys
+
     hs-source-dirs: .
+
     ghc-options: -O2
-    ghc-prof-options: -rtsopts -fprof-auto -fprof-cafs
- 
+
+    ghc-prof-options: -O2 -rtsopts -fprof-auto -fprof-cafs
diff --git a/Spear/App/Application.hs b/Spear/App/Application.hs
index 1a2a616..ce52f0d 100644
--- a/Spear/App/Application.hs
+++ b/Spear/App/Application.hs
@@ -1,6 +1,6 @@
 module Spear.App.Application
 (
-    -- * Data types
+    -- * Setup
     Dimensions
 ,   Context
 ,   SpearWindow
@@ -9,7 +9,6 @@ module Spear.App.Application
 ,   DisplayBits(..)
 ,   WindowMode(..)
 ,   WindowSizeCallback
-    -- * Setup
 ,   setup
 ,   quit
     -- * Main loop
@@ -18,6 +17,9 @@ module Spear.App.Application
     -- * Helpers
 ,   swapBuffers
 ,   getParam
+,   SpecialFeature(..)
+,   enableSpecial
+,   disableSpecial
 )
 where
 
@@ -54,17 +56,17 @@ setup (w, h) displayBits windowMode (major, minor) onResize' = do
         openWindowHint OpenGLVersionMajor major
         openWindowHint OpenGLVersionMinor minor
         disableSpecial AutoPollEvent
-        
+
         let dimensions = GL.Size (unsafeCoerce w) (unsafeCoerce h)
         result <- openWindow dimensions displayBits windowMode
         windowTitle $= "Spear Game Framework"
         GL.viewport $= (Position 0 0, Size (fromIntegral w) (fromIntegral h))
-        
+
         windowSizeCallback $= (onResize onResize')
         onResize' (Size (fromIntegral w) (fromIntegral h))
-        
+
         initialiseTimingSubsystem
-    
+
     rkey <- register quit
     return $ SpearWindow rkey
 
diff --git a/Spear/App/Input.hs b/Spear/App/Input.hs
index 779557d..d49a3f7 100644
--- a/Spear/App/Input.hs
+++ b/Spear/App/Input.hs
@@ -34,7 +34,7 @@ import Data.Char (ord)
 import qualified Data.Vector.Unboxed as V
 import qualified Graphics.UI.GLFW as GLFW
 import Graphics.Rendering.OpenGL.GL.CoordTrans
-import Data.StateVar
+import Graphics.Rendering.OpenGL.GL.StateVar
 
 data Key
     = KEY_A | KEY_B | KEY_C | KEY_D | KEY_E | KEY_F | KEY_G | KEY_H
diff --git a/Spear/Collision.hs b/Spear/Collision.hs
deleted file mode 100644
index 3b80696..0000000
--- a/Spear/Collision.hs
+++ /dev/null
@@ -1,213 +0,0 @@
-module Spear.Collision
-(
-    -- * Collision tests
-    CollisionType(..)
-,   Collisionable(..)
-    -- * Collisioners
-,   Collisioner(..)
-    -- ** Construction
-,   aabbCollisioner
-,   circleCollisioner
-,   boxFromCircle
-,   buildAABB
-,   mkCols
-    -- ** Collision test
-,   collide
-    -- ** Manipulation
-,   move
-    -- * Helpers
-,   aabbFromCircle
-)
-where
-
-
-import Spear.Assets.Model
-import Spear.Math.AABB
-import Spear.Math.Circle
-import qualified Spear.Math.Matrix4 as M4
-import Spear.Math.Plane
-import Spear.Math.Vector
-
-
--- | Encodes several collision situations.
-data CollisionType = NoCollision | Collision | FullyContains | FullyContainedBy
-    deriving (Eq, Show)
-
-
-class Collisionable a where
-    collideBox    :: AABB   -> a -> CollisionType
-    collideCircle :: Circle -> a -> CollisionType
-    getAABB       :: a -> AABB
-    getCircle     :: a -> Circle
-
-
-instance Collisionable AABB where
-    
-    collideBox box1@(AABB min1 max1) box2@(AABB min2 max2)
-        | (x max1) < (x min2) = NoCollision
-        | (x min1) > (x max2) = NoCollision
-        | (y max1) < (y min2) = NoCollision
-        | (y min1) > (y max2) = NoCollision
-        | box1 `aabbpt` min2 && box1 `aabbpt` max2 = FullyContains
-        | box2 `aabbpt` min1 && box2 `aabbpt` max1 = FullyContainedBy
-        | otherwise = Collision
-    
-    collideCircle circle@(Circle c r) aabb@(AABB min max)
-        | test == FullyContains || test == FullyContainedBy = test
-        | normSq (c - boxC) > (l + r)^2 = NoCollision
-        | otherwise = Collision
-            where
-                test = aabb `collideBox` aabbFromCircle circle
-                boxC = min + (max-min)/2
-                l = norm $ min + (vec2 (x boxC) (y min)) - min
-    
-    getAABB = id
-   
-    getCircle = circleFromAABB
-
-
-instance Collisionable Circle where
-    
-    collideBox box circle = case collideCircle circle box of
-        FullyContains -> FullyContainedBy
-        FullyContainedBy -> FullyContains
-        x -> x
-    
-    collideCircle s1@(Circle c1 r1) s2@(Circle c2 r2)
-        | distance_centers <= sub_radii = if (r1 > r2) then FullyContains else FullyContainedBy
-        | distance_centers <= sum_radii = Collision
-        | otherwise = NoCollision
-        where
-            distance_centers = normSq $ c1 - c2
-            sum_radii    = (r1 + r2)^2
-            sub_radii    = (r1 - r2)^2
-    
-    getAABB = aabbFromCircle
-    
-    getCircle = id
-
-
-instance Collisionable Collisioner where
-    
-    collideBox box (AABBCol self) = collideBox box self
-    collideBox box (CircleCol self) = collideBox box self 
-    
-    collideCircle circle (AABBCol self) = collideCircle circle self
-    collideCircle circle (CircleCol self) = collideCircle circle self
-    
-    getAABB (AABBCol box) = box
-    getAABB (CircleCol c) = aabbFromCircle c
-    
-    getCircle (AABBCol box) = circleFromAABB box
-    getCircle (CircleCol c) = c
-    
-    
-
-
-aabbPoints :: AABB -> [Vector2]
-aabbPoints (AABB min max) = [p1,p2,p3,p4,p5,p6,p7,p8]
-    where
-        p1 = vec2 (x min) (y min)
-        p2 = vec2 (x min) (y min)
-        p3 = vec2 (x min) (y max)
-        p4 = vec2 (x min) (y max)
-        p5 = vec2 (x max) (y min)
-        p6 = vec2 (x max) (y min)
-        p7 = vec2 (x max) (y max)
-        p8 = vec2 (x max) (y max)
-
-
--- | A collisioner component.
-data Collisioner
-    -- | An axis-aligned bounding box.
-    = AABBCol {-# UNPACK #-} !AABB
-    -- | A bounding circle.
-    | CircleCol {-# UNPACK #-} !Circle
-
-
--- | Create a collisioner from the specified box.  
-aabbCollisioner :: AABB -> Collisioner
-aabbCollisioner = AABBCol
-
-
--- | Create a collisioner from the specified circle.
-circleCollisioner :: Circle -> Collisioner
-circleCollisioner = CircleCol
-
-
--- | Create the minimal AABB collisioner fully containing the specified circle.
-boxFromCircle :: Circle -> Collisioner
-boxFromCircle = AABBCol . aabbFromCircle
-
-
--- | Create the minimal AABB fully containing the specified collisioners.
-buildAABB :: [Collisioner] -> AABB
-buildAABB cols = aabb $ generatePoints cols
-
-
-generatePoints :: [Collisioner] -> [Vector2]
-generatePoints = foldr generate []
-    where
-        generate (AABBCol (AABB pmin pmax)) acc = p1:p2:p3:p4:p5:p6:p7:p8:acc
-            where
-                p1 = vec2 (x pmin) (y pmin)
-                p2 = vec2 (x pmin) (y pmin)
-                p3 = vec2 (x pmin) (y pmax)
-                p4 = vec2 (x pmin) (y pmax)
-                p5 = vec2 (x pmax) (y pmin)
-                p6 = vec2 (x pmax) (y pmin)
-                p7 = vec2 (x pmax) (y pmax)
-                p8 = vec2 (x pmax) (y pmax)
-    
-        generate (CircleCol (Circle c r)) acc = p1:p2:p3:p4:acc
-            where
-                p1 = c + unitx2 * (vec2 r r)
-                p2 = c - unitx2 * (vec2 r r)
-                p3 = c + unity2 * (vec2 r r)
-                p4 = c - unity2 * (vec2 r r)
-
-
--- | Compute AABB collisioners in view space from the given 3D AABB.
-mkCols :: M4.Matrix4 -- ^ Modelview matrix
-       -> Box
-       -> [Collisioner]
-mkCols modelview (Box (Vec3 xmin ymin zmin) (Vec3 xmax ymax zmax)) =
-    let
-        toVec2 v = vec2 (x v) (y v)
-        p1   = toVec2 $ modelview `M4.mulp` vec3 xmin ymin zmax
-        p2   = toVec2 $ modelview `M4.mulp` vec3 xmax ymin zmin
-        p3   = toVec2 $ modelview `M4.mulp` vec3 xmax ymax zmin
-        col1 = AABBCol $ AABB p1 p2
-        col2 = AABBCol $ AABB p1 p3
-    in
-        [col1, col2]
-
-
--- | Collide the given collisioners.
-collide :: Collisioner -> Collisioner -> CollisionType
-collide (AABBCol box1) (AABBCol box2)    = collideBox    box1 box2
-collide (CircleCol s1) (CircleCol s2)    = collideCircle s1 s2
-collide (AABBCol box) (CircleCol circle) = collideBox    box circle
-collide (CircleCol circle) (AABBCol box) = collideCircle circle box
-
-
--- | Move the collisioner.
-move :: Vector2 -> Collisioner -> Collisioner
-move v (AABBCol (AABB min max)) = AABBCol (AABB (min+v) (max+v))
-move v (CircleCol (Circle c r)) = CircleCol (Circle (c+v) r)
-
-
--- | Create the minimal box fully containing the specified circle.
-aabbFromCircle :: Circle -> AABB
-aabbFromCircle (Circle c r) = AABB bot top
-    where
-        bot = c - (vec2 r r)
-        top = c + (vec2 r r)
-
-
--- | Create the minimal circle fully containing the specified box.
-circleFromAABB :: AABB -> Circle
-circleFromAABB (AABB min max) = Circle c r
-    where
-        c = scale 0.5 (min + max)
-        r = norm . scale 0.5 $ max - min
diff --git a/Spear/GL.hs b/Spear/GL.hs
index 814099f..b5b4dfb 100644
--- a/Spear/GL.hs
+++ b/Spear/GL.hs
@@ -166,7 +166,7 @@ newProgram shaders = do
     linkProgram program
     return program
 
--- | Delete the program.
+--  Delete the program.
 deleteProgram :: GLuint -> IO ()
 --deleteProgram = glDeleteProgram
 deleteProgram prog = do
diff --git a/Spear/Math/AABB.hs b/Spear/Math/AABB.hs
index 0dacfa4..681f194 100644
--- a/Spear/Math/AABB.hs
+++ b/Spear/Math/AABB.hs
@@ -1,28 +1,40 @@
 module Spear.Math.AABB
 (
-    AABB(..)
-,   aabb
-,   aabbpt
+    AABB2(..)
+,   AABB3(..)
+,   aabb2
+,   aabb3
+,   aabb2pt
+,   aabb3pt
 )
 where
 
-
 import Spear.Math.Vector
 
+import Data.List (foldl')
 
--- | An axis-aligned bounding box.
-data AABB = AABB {-# UNPACK #-} !Vector2 {-# UNPACK #-} !Vector2
-
+-- | An axis-aligned bounding box in 2D space.
+data AABB2 = AABB2 {-# UNPACK #-} !Vector2 {-# UNPACK #-} !Vector2
 
--- | Create a 'AABB' from the given points.
-aabb :: [Vector2] -> AABB
+-- | An axis-aligned bounding box in 3D space.
+data AABB3 = AABB3 {-# UNPACK #-} !Vector3 {-# UNPACK #-} !Vector3
 
-aabb [] = error "Attempting to build a BoundingVolume from an empty list!"
+-- | Create a AABB from the given points.
+aabb2 :: [Vector2] -> AABB2
+aabb2 [] = AABB2 zero2 zero2
+aabb2 (x:xs) = foldl' update (AABB2 x x) xs
+      where update (AABB2 pmin pmax) p = AABB2 (min p pmin) (max p pmax)
 
-aabb (x:xs) = foldr update (AABB x x) xs
-    where update p (AABB pmin pmax) = AABB (min p pmin) (max p pmax)
+-- | Create an AABB from the given points.
+aabb3 :: [Vector3] -> AABB3
+aabb3 [] = AABB3 zero3 zero3
+aabb3 (x:xs) = foldl' update (AABB3 x x) xs
+      where update (AABB3 pmin pmax) p = AABB3 (min p pmin) (max p pmax)
 
+-- | Return 'True' if the given AABB contains the given point, 'False' otherwise.
+aabb2pt :: AABB2 -> Vector2 -> Bool
+aabb2pt (AABB2 pmin pmax) v = v >= pmin && v <= pmax
 
--- | Return 'True' if the given 'AABB' contains the given point, 'False' otherwise.         
-aabbpt :: AABB -> Vector2 -> Bool
-aabbpt (AABB pmin pmax) v = v >= pmin && v <= pmax
+-- | Return 'True' if the given AABB contains the given point, 'False' otherwise.
+aabb3pt :: AABB3 -> Vector3 -> Bool
+aabb3pt (AABB3 pmin pmax) v = v >= pmin && v <= pmax
diff --git a/Spear/Math/Circle.hs b/Spear/Math/Circle.hs
index ab256a4..33b60ab 100644
--- a/Spear/Math/Circle.hs
+++ b/Spear/Math/Circle.hs
@@ -1,33 +1,26 @@
 module Spear.Math.Circle
-(
-    Circle(..)
-,   circle
-,   circlept
-)
 where
 
-
 import Spear.Math.Vector
 
+import Data.List (foldl')
 
--- | A bounding volume.
+-- | A circle in 2D space.
 data Circle = Circle
     { center :: {-# UNPACK #-} !Vector2
     , radius :: {-# UNPACK #-} !Float
     }
 
-
--- | Create a 'Sphere' from the given points.
+-- | Create a circle from the given points.
 circle :: [Vector2] -> Circle
-circle [] = error "Attempting to build a Circle from an empty list!"
+circle [] = Circle zero2 0
 circle (x:xs) = Circle c r
     where
         c = pmin + (pmax-pmin)/2
         r = norm $ pmax - c
-        (pmin,pmax) = foldr update (x,x) xs
-        update p (pmin,pmax) = (min p pmin, max p pmax)
-
+        (pmin,pmax) = foldl' update (x,x) xs
+        update (pmin,pmax) p = (min p pmin, max p pmax)
 
--- | Return 'True' if the given 'Sphere' contains the given point, 'False' otherwise.         
+-- | Return 'True' if the given circle contains the given point, 'False' otherwise.
 circlept :: Circle -> Vector2 -> Bool
 circlept (Circle c r) p = r*r >= normSq (p - c)
diff --git a/Spear/Math/Collision.hs b/Spear/Math/Collision.hs
new file mode 100644
index 0000000..47cc5fd
--- /dev/null
+++ b/Spear/Math/Collision.hs
@@ -0,0 +1,242 @@
+module Spear.Math.Collision
+(
+    CollisionType(..)
+    -- * 2D Collision
+,   Collisionable2(..)
+,   Collisioner2(..)
+    -- ** Construction
+,   aabb2Collisioner
+,   circleCollisioner
+,   mkCols
+    -- ** Collision test
+,   collide
+    -- ** Manipulation
+,   move
+    -- ** Helpers
+,   buildAABB2
+,   aabb2FromCircle
+,   circleFromAABB2
+    -- * 3D Collision
+,   Collisionable3(..)
+    -- ** Helpers
+,   aabb3FromSphere
+)
+where
+
+import Spear.Assets.Model
+import Spear.Math.AABB
+import Spear.Math.Circle
+import qualified Spear.Math.Matrix4 as M4
+import Spear.Math.Plane
+import Spear.Math.Sphere
+import Spear.Math.Vector
+
+import Data.List (foldl')
+
+data CollisionType = NoCollision | Collision | FullyContains | FullyContainedBy
+     deriving (Eq, Show)
+
+-- 2D collision
+
+class Collisionable2 a where
+
+      -- | Collide the object with an AABB.
+      collideAABB2 :: AABB2 -> a -> CollisionType
+
+      -- | Collide the object with a circle.
+      collideCircle :: Circle -> a -> CollisionType
+
+instance Collisionable2 AABB2 where
+
+    collideAABB2 box1@(AABB2 min1 max1) box2@(AABB2 min2 max2)
+        | (x max1) < (x min2) = NoCollision
+        | (x min1) > (x max2) = NoCollision
+        | (y max1) < (y min2) = NoCollision
+        | (y min1) > (y max2) = NoCollision
+        | box1 `aabb2pt` min2 && box1 `aabb2pt` max2 = FullyContains
+        | box2 `aabb2pt` min1 && box2 `aabb2pt` max1 = FullyContainedBy
+        | otherwise = Collision
+
+    collideCircle circle@(Circle c r) aabb@(AABB2 min max)
+        | test == FullyContains || test == FullyContainedBy = test
+        | normSq (c - boxC) > (l + r)^2 = NoCollision
+        | otherwise = Collision
+            where
+                test = collideAABB2 aabb $ aabb2FromCircle circle
+                boxC = min + (max-min)/2
+                l = norm $ min + (vec2 (x boxC) (y min)) - min
+
+instance Collisionable2 Circle where
+
+    collideAABB2 box circle = case collideCircle circle box of
+        FullyContains    -> FullyContainedBy
+        FullyContainedBy -> FullyContains
+        x -> x
+
+    collideCircle s1@(Circle c1 r1) s2@(Circle c2 r2)
+        | distance_centers <= sub_radii = if (r1 > r2) then FullyContains else FullyContainedBy
+        | distance_centers <= sum_radii = Collision
+        | otherwise = NoCollision
+        where
+            distance_centers = normSq $ c1 - c2
+            sum_radii    = (r1 + r2)^2
+            sub_radii    = (r1 - r2)^2
+
+instance Collisionable2 Collisioner2 where
+
+    collideAABB2 box (AABB2Col self)  = collideAABB2 box self
+    collideAABB2 box (CircleCol self) = collideAABB2 box self
+
+    collideCircle circle (AABB2Col self)  = collideCircle circle self
+    collideCircle circle (CircleCol self) = collideCircle circle self
+
+aabbPoints :: AABB2 -> [Vector2]
+aabbPoints (AABB2 min max) = [p1,p2,p3,p4,p5,p6,p7,p8]
+    where
+        p1 = vec2 (x min) (y min)
+        p2 = vec2 (x min) (y min)
+        p3 = vec2 (x min) (y max)
+        p4 = vec2 (x min) (y max)
+        p5 = vec2 (x max) (y min)
+        p6 = vec2 (x max) (y min)
+        p7 = vec2 (x max) (y max)
+        p8 = vec2 (x max) (y max)
+
+
+-- | A collisioner component.
+data Collisioner2
+    -- | An axis-aligned bounding box.
+    = AABB2Col {-# UNPACK #-} !AABB2
+    -- | A bounding circle.
+    | CircleCol {-# UNPACK #-} !Circle
+
+
+-- | Create a collisioner from the specified box.
+aabb2Collisioner :: AABB2 -> Collisioner2
+aabb2Collisioner = AABB2Col
+
+-- | Create a collisioner from the specified circle.
+circleCollisioner :: Circle -> Collisioner2
+circleCollisioner = CircleCol
+
+-- | Compute AABB collisioners in view space from the given AABB.
+mkCols :: M4.Matrix4 -- ^ Modelview matrix
+       -> Box
+       -> [Collisioner2]
+mkCols modelview (Box (Vec3 xmin ymin zmin) (Vec3 xmax ymax zmax)) =
+    let
+        toVec2 v = vec2 (x v) (y v)
+        p1   = toVec2 $ modelview `M4.mulp` vec3 xmin ymin zmax
+        p2   = toVec2 $ modelview `M4.mulp` vec3 xmax ymin zmin
+        p3   = toVec2 $ modelview `M4.mulp` vec3 xmax ymax zmin
+        col1 = AABB2Col $ AABB2 p1 p2
+        col2 = AABB2Col $ AABB2 p1 p3
+    in
+        [col1, col2]
+
+-- | Create the minimal AABB fully containing the specified collisioners.
+buildAABB2 :: [Collisioner2] -> AABB2
+buildAABB2 cols = aabb2 $ generatePoints cols
+
+-- | Create the minimal box fully containing the specified circle.
+aabb2FromCircle :: Circle -> AABB2
+aabb2FromCircle (Circle c r) = AABB2 bot top
+    where
+        bot = c - (vec2 r r)
+        top = c + (vec2 r r)
+
+-- | Create the minimal circle fully containing the specified box.
+circleFromAABB2 :: AABB2 -> Circle
+circleFromAABB2 (AABB2 min max) = Circle c r
+    where
+        c = scale 0.5 (min + max)
+        r = norm . scale 0.5 $ max - min
+
+generatePoints :: [Collisioner2] -> [Vector2]
+generatePoints = foldl' generate []
+    where
+        generate acc (AABB2Col (AABB2 pmin pmax)) = p1:p2:p3:p4:p5:p6:p7:p8:acc
+            where
+                p1 = vec2 (x pmin) (y pmin)
+                p2 = vec2 (x pmin) (y pmin)
+                p3 = vec2 (x pmin) (y pmax)
+                p4 = vec2 (x pmin) (y pmax)
+                p5 = vec2 (x pmax) (y pmin)
+                p6 = vec2 (x pmax) (y pmin)
+                p7 = vec2 (x pmax) (y pmax)
+                p8 = vec2 (x pmax) (y pmax)
+
+        generate acc (CircleCol (Circle c r)) = p1:p2:p3:p4:acc
+            where
+                p1 = c + unitx2 * (vec2 r r)
+                p2 = c - unitx2 * (vec2 r r)
+                p3 = c + unity2 * (vec2 r r)
+                p4 = c - unity2 * (vec2 r r)
+
+-- | Collide the given collisioners.
+collide :: Collisioner2 -> Collisioner2 -> CollisionType
+collide (AABB2Col box1) (AABB2Col box2)   = collideAABB2  box1   box2
+collide (AABB2Col box) (CircleCol circle) = collideAABB2  box    circle
+collide (CircleCol s1) (CircleCol s2)     = collideCircle s1     s2
+collide (CircleCol circle) (AABB2Col box) = collideCircle circle box
+
+-- | Move the collisioner.
+move :: Vector2 -> Collisioner2 -> Collisioner2
+move v (AABB2Col (AABB2 min max)) = AABB2Col (AABB2 (min+v) (max+v))
+move v (CircleCol (Circle c r)) = CircleCol (Circle (c+v) r)
+
+
+-- 3D collision
+
+class Collisionable3 a where
+
+      -- | Collide the object with an AABB.
+      collideAABB3 :: AABB3 -> a -> CollisionType
+
+      -- | Collide the object with a sphere.
+      collideSphere :: Sphere -> a -> CollisionType
+
+instance Collisionable3 AABB3 where
+
+         collideAABB3 box1@(AABB3 min1 max1) box2@(AABB3 min2 max2)
+                      | (x max1) < (x min2) = NoCollision
+                      | (x min1) > (x max2) = NoCollision
+                      | (y max1) < (y min2) = NoCollision
+                      | (y min1) > (y max2) = NoCollision
+                      | box1 `aabb3pt` min2 && box1 `aabb3pt` max2 = FullyContains
+                      | box2 `aabb3pt` min1 && box2 `aabb3pt` max1 = FullyContainedBy
+                      | otherwise = Collision
+
+         collideSphere sphere@(Sphere c r) aabb@(AABB3 min max)
+                       | test == FullyContains || test == FullyContainedBy = test
+                       | normSq (c - boxC) > (l + r)^2 = NoCollision
+                       | otherwise = Collision
+                         where
+                            test = collideAABB3 aabb $ aabb3FromSphere sphere
+                            boxC = min + v
+                            l = norm v
+                            v = (max-min)/2
+
+instance Collisionable3 Sphere where
+
+         collideAABB3 box sphere = case collideSphere sphere box of
+                      FullyContains    -> FullyContainedBy
+                      FullyContainedBy -> FullyContains
+                      x -> x
+
+         collideSphere s1@(Sphere c1 r1) s2@(Sphere c2 r2)
+                       | distance_centers <= sub_radii =
+                         if (r1 > r2) then FullyContains else FullyContainedBy
+                       | distance_centers <= sum_radii = Collision
+                       | otherwise = NoCollision
+                         where
+                            distance_centers = normSq $ c1 - c2
+                            sum_radii = (r1 + r2)^2
+                            sub_radii = (r1 - r2)^2
+
+-- | Create the minimal box fully containing the specified sphere.
+aabb3FromSphere :: Sphere -> AABB3
+aabb3FromSphere (Sphere c r) = AABB3 bot top
+    where
+        bot = c - (vec3 r r r)
+        top = c + (vec3 r r r)
\ No newline at end of file
diff --git a/Spear/Math/Frustum.hs b/Spear/Math/Frustum.hs
new file mode 100644
index 0000000..b23882a
--- /dev/null
+++ b/Spear/Math/Frustum.hs
@@ -0,0 +1,28 @@
+module Spear.Math.Frustum
+where
+
+import Spear.Math.Plane
+
+data Frustum = Frustum
+     { n :: {-# UNPACK #-} !Plane
+     , f :: {-# UNPACK #-} !Plane
+     , l :: {-# UNPACK #-} !Plane
+     , r :: {-# UNPACK #-} !Plane
+     , t :: {-# UNPACK #-} !Plane
+     , b :: {-# UNPACK #-} !Plane
+     } deriving Show
+
+-- | Construct a frustum.
+frustum
+    :: Plane -- ^ Near
+    -> Plane -- ^ Far
+    -> Plane -- ^ Left
+    -> Plane -- ^ Right
+    -> Plane -- ^ Top
+    -> Plane -- ^ Bottom
+    -> Frustum
+frustum = Frustum
+
+-- | Construct a frustum.
+fromList :: [Plane] -> Frustum
+fromList (n:f:l:r:t:b:_) = Frustum n f l r t b
diff --git a/Spear/Math/Octree.hs b/Spear/Math/Octree.hs
new file mode 100644
index 0000000..f5538b4
--- /dev/null
+++ b/Spear/Math/Octree.hs
@@ -0,0 +1,228 @@
+module Spear.Math.Octree
+(
+    Octree
+,   makeOctree
+,   clone
+,   Spear.Math.Octree.insert
+,   Spear.Math.Octree.map
+,   gmap
+)
+where
+
+import Spear.Math.AABB
+import Spear.Math.Collision
+import Spear.Math.Vector
+
+import Control.Applicative ((<*>))
+import Data.List
+import Data.Functor
+import Data.Monoid
+import qualified Data.Foldable as F
+
+-- | An octree.
+data Octree e
+    = Octree
+    { root :: !AABB2
+    , ents :: ![e]
+    , c1   :: !(Octree e)
+    , c2   :: !(Octree e)
+    , c3   :: !(Octree e)
+    , c4   :: !(Octree e)
+    , c5   :: !(Octree e)
+    , c6   :: !(Octree e)
+    , c7   :: !(Octree e)
+    , c8   :: !(Octree e)
+    }
+    |
+    Leaf
+    { root :: !AABB2
+    , ents :: ![e]
+    }
+
+-- | Construct an octree using the specified AABB as the root and having the specified depth.
+makeOctree :: Int -> AABB2 -> Octree e
+makeOctree d root@(AABB2 min max)
+    | d == 0    = Leaf root []
+    | otherwise = Octree root [] c1 c2 c3 c4 c5 c6 c7 c8
+    where
+        boxes = subdivide root
+        c1 = makeOctree (d-1) $ boxes !! 0
+        c2 = makeOctree (d-1) $ boxes !! 1
+        c3 = makeOctree (d-1) $ boxes !! 2
+        c4 = makeOctree (d-1) $ boxes !! 3
+        c5 = makeOctree (d-1) $ boxes !! 4
+        c6 = makeOctree (d-1) $ boxes !! 5
+        c7 = makeOctree (d-1) $ boxes !! 6
+        c8 = makeOctree (d-1) $ boxes !! 7
+
+subdivide :: AABB2 -> [AABB2]
+subdivide (AABB2 min max) = [a1, a2, a3, a4, a5, a6, a7, a8]
+    where
+        v = (max-min) / 2
+        c = vec2 (x min + x v) (y min + y v)
+        a1 = AABB2 min 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))
+        a4 = AABB2 ( vec2 (x min) (y c)  ) ( vec2 (x c)   (y max))
+        a5 = 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))
+        a8 = AABB2 c max
+
+-- | Clone the structure of the octree. The new octree has no entities.
+clone :: Octree e -> Octree e
+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'
+    where
+        c1' = clone c1
+        c2' = clone c2
+        c3' = clone c3
+        c4' = clone c4
+        c5' = clone c5
+        c6' = clone c6
+        c7' = clone c7
+        c8' = clone c8
+
+keep :: (e -> AABB2 -> CollisionType) -> AABB2 -> e -> Bool
+keep testAABB2 aabb e = test == FullyContainedBy
+    where test = e `testAABB2` aabb
+
+-- | Insert a list of entities into the octree.
+insert :: (e -> AABB2 -> CollisionType) -> Octree e -> [e] -> Octree e
+insert testAABB2 octree es = octree' where (octree', _) = insert' testAABB2 es octree
+
+insert' :: (e -> AABB2 -> CollisionType) -> [e] -> Octree e -> (Octree e, [e])
+
+insert' testAABB2 es (Leaf root ents) = (Leaf root ents', outliers)
+    where
+        ents'       = ents ++ ents_kept
+        ents_kept   = filter (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) =
+    (Octree root ents' c1' c2' c3' c4' c5' c6' c7' c8', outliers)
+    where
+        ents'        = ents ++ ents_kept
+        new_ents     = es ++ ents1 ++ ents2 ++ ents3 ++ ents4 ++ ents5 ++ ents6 ++ ents7 ++ ents8
+        ents_kept    = filter (keep testAABB2 root) new_ents
+        outliers     = filter (not . keep testAABB2 root) new_ents
+        (c1', ents1) = insert' testAABB2 es c1
+        (c2', ents2) = insert' testAABB2 es c2
+        (c3', ents3) = insert' testAABB2 es c3
+        (c4', ents4) = insert' testAABB2 es c4
+        (c5', ents5) = insert' testAABB2 es c5
+        (c6', ents6) = insert' testAABB2 es c6
+        (c7', ents7) = insert' testAABB2 es c7
+        (c8', ents8) = insert' testAABB2 es c8
+
+-- | Extract all entities from the octree. The resulting octree has no entities.
+extract :: Octree e -> (Octree e, [e])
+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')
+    where
+        (c1', ents1) = extract c1
+        (c2', ents2) = extract c2
+        (c3', ents3) = extract c3
+        (c4', ents4) = extract c4
+        (c5', ents5) = extract c5
+        (c6', ents6) = extract c6
+        (c7', ents7) = extract c7
+        (c8', ents8) = extract c8
+        ents' = ents ++ ents1 ++ ents2 ++ ents3 ++ ents4 ++ ents5 ++ ents6 ++ ents7 ++ ents8
+
+-- | Apply the given function to the entities in the octree.
+--
+-- Entities that break out of their cell are reallocated appropriately.
+map :: (e -> AABB2 -> CollisionType) -> (e -> e) -> Octree e -> Octree e
+map testAABB2 f o =
+    let (o', outliers) = map' testAABB2 f o
+    in Spear.Math.Octree.insert testAABB2 o' outliers
+
+map' :: (e -> AABB2 -> CollisionType) -> (e -> e) -> Octree e -> (Octree e, [e])
+
+map' testAABB2 f (Leaf root ents) = (Leaf root ents_kept, outliers)
+    where
+        ents'       = fmap f ents
+        ents_kept   = filter (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) =
+    (Octree root ents_kept c1' c2' c3' c4' c5' c6' c7' c8', outliers)
+    where
+        ents'       = (fmap f ents) ++ out1 ++ out2 ++ out3 ++ out4 ++ out5 ++ out6 ++ out7 ++ out8
+        ents_kept   = filter (keep testAABB2 root) ents'
+        outliers    = filter (not . keep testAABB2 root) ents'
+        (c1', out1) = map' testAABB2 f c1
+        (c2', out2) = map' testAABB2 f c2
+        (c3', out3) = map' testAABB2 f c3
+        (c4', out4) = map' testAABB2 f c4
+        (c5', out5) = map' testAABB2 f c5
+        (c6', out6) = map' testAABB2 f c6
+        (c7', out7) = map' testAABB2 f c7
+        (c8', out8) = map' testAABB2 f c8
+
+
+-- | Apply a function to the entity groups in the octree.
+--
+-- Entities that break out of their cell are reallocated appropriately.
+gmap :: (e -> AABB2 -> CollisionType) -> (e -> e -> e) -> Octree e -> Octree e
+gmap testAABB2 f o =
+    let (o', outliers) = gmap' testAABB2 f o
+    in Spear.Math.Octree.insert testAABB2 o' outliers
+
+gmap' :: (e -> AABB2 -> CollisionType) -> (e -> e -> e) -> Octree e -> (Octree e, [e])
+
+gmap' testAABB2 f (Leaf root ents) = (Leaf root ents_kept, outliers)
+    where
+        ents'       = f <$> ents <*> ents
+        ents_kept   = filter (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) =
+    (Octree root ents_kept c1' c2' c3' c4' c5' c6' c7' c8', outliers)
+    where
+        ents'= (f <$> ents <*> ents) ++ out1 ++ out2 ++ out3 ++ out4 ++ out5 ++ out6 ++ out7 ++ out8
+        ents_kept   = filter (keep testAABB2 root) ents'
+        outliers    = filter (not . keep testAABB2 root) ents'
+        (c1', out1) = gmap' testAABB2 f c1
+        (c2', out2) = gmap' testAABB2 f c2
+        (c3', out3) = gmap' testAABB2 f c3
+        (c4', out4) = gmap' testAABB2 f c4
+        (c5', out5) = gmap' testAABB2 f c5
+        (c6', out6) = gmap' testAABB2 f c6
+        (c7', out7) = gmap' testAABB2 f c7
+        (c8', out8) = gmap' testAABB2 f c8
+
+instance Functor Octree where
+
+    fmap f (Leaf root ents) = Leaf root $ fmap f ents
+
+    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'
+        where
+            c1' = fmap f c1
+            c2' = fmap f c2
+            c3' = fmap f c3
+            c4' = fmap f c4
+            c5' = fmap f c5
+            c6' = fmap f c6
+            c7' = fmap f c7
+            c8' = fmap f c8
+
+instance F.Foldable Octree where
+
+    foldMap f (Leaf root ents) = mconcat . fmap f $ ents
+
+    foldMap f (Octree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
+        mconcat (fmap f ents) `mappend`
+        c1' `mappend` c2' `mappend` c3' `mappend` c4' `mappend`
+        c5' `mappend` c6' `mappend` c7' `mappend` c8'
+        where
+            c1' = F.foldMap f c1
+            c2' = F.foldMap f c2
+            c3' = F.foldMap f c3
+            c4' = F.foldMap f c4
+            c5' = F.foldMap f c5
+            c6' = F.foldMap f c6
+            c7' = F.foldMap f c7
+            c8' = F.foldMap f c8
diff --git a/Spear/Math/Physics.hs b/Spear/Math/Physics.hs
new file mode 100644
index 0000000..f24139b
--- /dev/null
+++ b/Spear/Math/Physics.hs
@@ -0,0 +1,9 @@
+module Spear.Math.Physics
+(
+    module Spear.Math.Physics.Rigid
+,   module Spear.Math.Physics.Types
+)
+where
+
+import Spear.Math.Physics.Rigid
+import Spear.Math.Physics.Types
diff --git a/Spear/Physics/Rigid.hs b/Spear/Math/Physics/Rigid.hs
index 99a9d5a..198385e 100644
--- a/Spear/Physics/Rigid.hs
+++ b/Spear/Math/Physics/Rigid.hs
@@ -1,6 +1,6 @@
-module Spear.Physics.Rigid
+module Spear.Math.Physics.Rigid
 (
-    module Spear.Physics.Types
+    module Spear.Math.Physics.Types
 ,   RigidBody(..)
 ,   rigidBody
 ,   update
@@ -9,7 +9,6 @@ module Spear.Physics.Rigid
 )
 where
 
-
 import qualified Spear.Math.Matrix3 as M3
 import Spear.Math.Spatial2
 import Spear.Math.Vector
@@ -18,51 +17,47 @@ import Spear.Physics.Types
 import Data.List (foldl')
 import Control.Monad.State
 
-
 data RigidBody = RigidBody
     { mass         :: {-# UNPACK #-} !Float
-    , position     :: {-# UNPACK #-} !Vector2
-    , velocity     :: {-# UNPACK #-} !Vector2
-    , acceleration :: {-# UNPACK #-} !Vector2
+    , position     :: {-# UNPACK #-} !Position
+    , velocity     :: {-# UNPACK #-} !Velocity
+    , acceleration :: {-# UNPACK #-} !Acceleration
     }
 
-
 instance Spatial2 RigidBody where
-    
+
     move v body = body { position = v + position body }
-    
+
     moveFwd     speed body = body { position = position body + scale speed unity2 }
-    
+
     moveBack    speed body = body { position = position body + scale (-speed) unity2 }
-    
+
     strafeLeft  speed body = body { position = position body + scale (-speed) unitx2 }
-    
+
     strafeRight speed body = body { position = position body + scale speed unitx2 }
-    
+
     rotate angle = id
-    
+
     setRotation angle = id
-    
+
     pos = position
-    
+
     fwd _ = unity2
-    
+
     up _ = unity2
-    
+
     right _ = unitx2
-    
+
     transform body = M3.transform unitx2 unity2 $ position body
-    
+
     setTransform transf body = body { position = M3.position transf }
-    
-    setPos p body = body { position = p }
 
+    setPos p body = body { position = p }
 
 -- | Build a 'RigidBody'.
 rigidBody :: Mass -> Position -> RigidBody
 rigidBody m x = RigidBody m x zero2 zero2
 
-
 -- | Update the given 'RigidBody'.
 update :: [Force] -> Dt -> RigidBody -> RigidBody
 update forces dt body =
@@ -78,19 +73,17 @@ update forces dt body =
     in
         RigidBody m r2 v2 a2
 
-
 -- | Set the body's velocity.
 setVelocity :: Velocity -> RigidBody -> RigidBody
 setVelocity v body = body { velocity = v }
 
-
 -- | Set the body's acceleration.
 setAcceleration :: Acceleration -> RigidBody -> RigidBody
 setAcceleration a body = body { acceleration = a }
 
 
 -- test
-gravity = vec2 0 (-10)
+{-gravity = vec2 0 (-10)
 b0 = rigidBody 50 $ vec2 0 1000
 
 
@@ -129,4 +122,4 @@ show' body =
     ", acceleration " ++ (showVec $ acceleration body)
 
 
-showVec v = (show $ x v) ++ ", " ++ (show $ y v)
+showVec v = (show $ x v) ++ ", " ++ (show $ y v)-}
diff --git a/Spear/Physics/Types.hs b/Spear/Math/Physics/Types.hs
index 62e0c04..73cd90e 100644
--- a/Spear/Physics/Types.hs
+++ b/Spear/Math/Physics/Types.hs
@@ -1,10 +1,8 @@
-module Spear.Physics.Types
+module Spear.Math.Physics.Types
 where
 
-
 import Spear.Math.Vector
 
-
 type Dt = Float
 type Force = Vector2
 type Mass = Float
diff --git a/Spear/Math/Plane.hs b/Spear/Math/Plane.hs
index b20740c..08e4570 100644
--- a/Spear/Math/Plane.hs
+++ b/Spear/Math/Plane.hs
@@ -6,12 +6,9 @@ module Spear.Math.Plane
 )
 where
 
-
 import Spear.Math.Vector
 
-
-data PointPlanePos = Front | Back | Contained deriving (Eq, Ord, Show)
-
+data PointPlanePos = Front | Back | Contained deriving (Eq, Show)
 
 data Plane = Plane
     { n :: {-# UNPACK #-} !Vector3,
@@ -19,13 +16,21 @@ data Plane = Plane
     }
     deriving(Eq, Show)
 
-
--- | Create a plane given a normal vector and a distance from the origin.
+-- | Construct a plane from  a normal vector and a distance from the origin.
 plane :: Vector3 -> Float -> Plane
 plane n d = Plane (normalise n) d
 
-
--- | Classify the given point's relative position with respect to the given plane.
+-- | Construct a plane from three points.
+--
+-- Points must be given in counter-clockwise order.
+fromPoints :: Vector3 -> Vector3 -> Vector3 -> Plane
+fromPoints p0 p1 p2 = Plane n d
+           where n  = normalise $ v1 `cross` v2
+                 v1 = p2 - p1
+                 v2 = p0 - p1
+                 d  = p0 `dot` n
+
+-- | Classify the given point's relative position with respect to the plane.
 classify :: Plane -> Vector3 -> PointPlanePos
 classify (Plane n d) pt =
     case (n `dot` pt - d) `compare` 0 of
diff --git a/Spear/Math/Quad.hs b/Spear/Math/Quad.hs
deleted file mode 100644
index 6b6215c..0000000
--- a/Spear/Math/Quad.hs
+++ /dev/null
@@ -1,31 +0,0 @@
-module Spear.Math.Quad
-(
-    Quad(..)
-,   quadpt
-)
-where
-
-
-import Spear.Math.Segment
-import Spear.Math.Utils
-import Spear.Math.Vector
-
-
-data Quad = Quad
-    { tl :: {-# UNPACK #-} !Vector2 -- ^ Top left
-    , tr :: {-# UNPACK #-} !Vector2 -- ^ Top right
-    , br :: {-# UNPACK #-} !Vector2 -- ^ Bottom right
-    , bl :: {-# UNPACK #-} !Vector2 -- ^ Bottom left
-    }
-
-
--- | Return 'True' if the given point is inside the given quad, 'False' otherwise.
-quadpt :: Quad -> Vector2 -> Bool
-quadpt (Quad tl tr br bl) p =
-    let
-        s1 = seglr (Segment tl tr) p
-        s2 = seglr (Segment tr br) p
-        s3 = seglr (Segment br bl) p
-        s4 = seglr (Segment bl tl) p
-    in
-        R == s1 && s1 == s2 && s2 == s3 && s3 == s4
diff --git a/Spear/Math/QuadTree.hs b/Spear/Math/QuadTree.hs
deleted file mode 100644
index d6b6353..0000000
--- a/Spear/Math/QuadTree.hs
+++ /dev/null
@@ -1,248 +0,0 @@
-module Spear.Math.QuadTree
-(
-    QuadTree
-,   makeQuadTree
-,   clone
-,   Spear.Math.QuadTree.insert
-,   Spear.Math.QuadTree.map
-,   gmap
-)
-where
-
-import Spear.Collision
-import Spear.Math.AABB
-import Spear.Math.Vector
-
-import Control.Applicative ((<*>))
-import Data.List
-import Data.Functor
-import Data.Monoid
-import qualified Data.Foldable as F
-
-
--- | Represents an QuadTree.
-data QuadTree e
-    = QuadTree
-    { root :: !AABB
-    , ents :: ![e]
-    , c1   :: !(QuadTree e)
-    , c2   :: !(QuadTree e)
-    , c3   :: !(QuadTree e)
-    , c4   :: !(QuadTree e)
-    , c5   :: !(QuadTree e)
-    , c6   :: !(QuadTree e)
-    , c7   :: !(QuadTree e)
-    , c8   :: !(QuadTree e)
-    }
-    |
-    Leaf
-    { root :: !AABB
-    , ents :: ![e]
-    }
-
-
--- | Builds an QuadTree using the specified AABB as the root and having the specified depth.
-makeQuadTree :: Int -> AABB -> QuadTree e
-makeQuadTree d root@(AABB min max)
-    | d == 0    = Leaf root []
-    | otherwise = QuadTree root [] c1 c2 c3 c4 c5 c6 c7 c8
-    where
-        boxes = subdivide root
-        c1 = makeQuadTree (d-1) $ boxes !! 0
-        c2 = makeQuadTree (d-1) $ boxes !! 1
-        c3 = makeQuadTree (d-1) $ boxes !! 2
-        c4 = makeQuadTree (d-1) $ boxes !! 3
-        c5 = makeQuadTree (d-1) $ boxes !! 4
-        c6 = makeQuadTree (d-1) $ boxes !! 5
-        c7 = makeQuadTree (d-1) $ boxes !! 6
-        c8 = makeQuadTree (d-1) $ boxes !! 7
-
-
-subdivide :: AABB -> [AABB]
-subdivide (AABB min max) = [a1, a2, a3, a4, a5, a6, a7, a8]
-    where
-        v = (max-min) / 2
-        c = vec2 (x min + x v) (y min + y v)
-        a1 = AABB min c
-        a2 = AABB ( vec2 (x min) (y min)) ( vec2 (x c)   (y c)  )
-        a3 = AABB ( vec2 (x min) (y c)  ) ( vec2 (x c)   (y max))
-        a4 = AABB ( vec2 (x min) (y c)  ) ( vec2 (x c)   (y max))
-        a5 = AABB ( vec2 (x c)   (y min)) ( vec2 (x max) (y c)  )
-        a6 = AABB ( vec2 (x c)   (y min)) ( vec2 (x max) (y c)  )
-        a7 = AABB ( vec2 (x c)   (y c)  ) ( vec2 (x max) (y max))
-        a8 = AABB c max
-
-
--- | Clones the structure of an octree. The new octree has no entities.
-clone :: QuadTree e -> QuadTree e
-clone (Leaf root ents) = Leaf root []
-clone (QuadTree root ents c1 c2 c3 c4 c5 c6 c7 c8) = QuadTree root [] c1' c2' c3' c4' c5' c6' c7' c8'
-    where
-        c1' = clone c1
-        c2' = clone c2
-        c3' = clone c3
-        c4' = clone c4
-        c5' = clone c5
-        c6' = clone c6
-        c7' = clone c7
-        c8' = clone c8
-        
-        
-keep :: (e -> AABB -> CollisionType) -> AABB -> e -> Bool
-keep testAABB aabb e = test == FullyContainedBy
-    where test = e `testAABB` aabb
-
-  
--- | Inserts a list of entities into the given octree.
-insert :: (e -> AABB -> CollisionType) -> QuadTree e -> [e] -> QuadTree e
-insert testAABB octree es = octree' where (octree', _) = insert' testAABB es octree
-
-
-insert' :: (e -> AABB -> CollisionType) -> [e] -> QuadTree e -> (QuadTree e, [e])
-
-insert' testAABB es (Leaf root ents) = (Leaf root ents', outliers)
-    where
-        ents'       = ents ++ ents_kept
-        ents_kept   = filter (keep testAABB root) es
-        outliers    = filter (not . keep testAABB root) es
-        
-insert' testAABB es (QuadTree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
-    (QuadTree root ents' c1' c2' c3' c4' c5' c6' c7' c8', outliers)
-    where
-        ents'        = ents ++ ents_kept
-        new_ents     = es ++ ents1 ++ ents2 ++ ents3 ++ ents4 ++ ents5 ++ ents6 ++ ents7 ++ ents8
-        ents_kept    = filter (keep testAABB root) new_ents
-        outliers     = filter (not . keep testAABB root) new_ents
-        (c1', ents1) = insert' testAABB es c1
-        (c2', ents2) = insert' testAABB es c2
-        (c3', ents3) = insert' testAABB es c3
-        (c4', ents4) = insert' testAABB es c4
-        (c5', ents5) = insert' testAABB es c5
-        (c6', ents6) = insert' testAABB es c6
-        (c7', ents7) = insert' testAABB es c7
-        (c8', ents8) = insert' testAABB es c8
-
-
--- | Extracts all entities from an octree. The resulting octree has no entities.
-extract :: QuadTree e -> (QuadTree e, [e])
-extract (Leaf root ents) = (Leaf root [], ents)
-extract (QuadTree root ents c1 c2 c3 c4 c5 c6 c7 c8) = (QuadTree root [] c1' c2' c3' c4' c5' c6' c7' c8', ents')
-    where
-        (c1', ents1) = extract c1
-        (c2', ents2) = extract c2
-        (c3', ents3) = extract c3
-        (c4', ents4) = extract c4
-        (c5', ents5) = extract c5
-        (c6', ents6) = extract c6
-        (c7', ents7) = extract c7
-        (c8', ents8) = extract c8
-        ents' = ents ++ ents1 ++ ents2 ++ ents3 ++ ents4 ++ ents5 ++ ents6 ++ ents7 ++ ents8
-
-
--- | Applies the given function to the entities in the octree.
--- Entities that break out of their cell are reallocated appropriately.
-map :: (e -> AABB -> CollisionType) -> (e -> e) -> QuadTree e -> QuadTree e
-map testAABB f o =
-    let (o', outliers) = map' testAABB f o
-    in Spear.Math.QuadTree.insert testAABB o' outliers
-
-
-map' :: (e -> AABB -> CollisionType) -> (e -> e) -> QuadTree e -> (QuadTree e, [e])
-
-
-map' testAABB f (Leaf root ents) = (Leaf root ents_kept, outliers)
-    where
-        ents'       = fmap f ents
-        ents_kept   = filter (keep testAABB root) ents'
-        outliers    = filter (not . keep testAABB root) ents'
-
-
-map' testAABB f (QuadTree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
-    (QuadTree root ents_kept c1' c2' c3' c4' c5' c6' c7' c8', outliers)
-    where
-        ents'       = (fmap f ents) ++ out1 ++ out2 ++ out3 ++ out4 ++ out5 ++ out6 ++ out7 ++ out8
-        ents_kept   = filter (keep testAABB root) ents'
-        outliers    = filter (not . keep testAABB root) ents'
-        (c1', out1) = map' testAABB f c1
-        (c2', out2) = map' testAABB f c2
-        (c3', out3) = map' testAABB f c3
-        (c4', out4) = map' testAABB f c4
-        (c5', out5) = map' testAABB f c5
-        (c6', out6) = map' testAABB f c6
-        (c7', out7) = map' testAABB f c7
-        (c8', out8) = map' testAABB f c8
-
-
--- | Applies a function to the entity groups in the octree.
--- Entities that break out of their cell are reallocated appropriately.
-gmap :: (e -> AABB -> CollisionType) -> (e -> e -> e) -> QuadTree e -> QuadTree e
-gmap testAABB f o =
-    let (o', outliers) = gmap' testAABB f o
-    in Spear.Math.QuadTree.insert testAABB o' outliers
-
-
-gmap' :: (e -> AABB -> CollisionType) -> (e -> e -> e) -> QuadTree e -> (QuadTree e, [e])
-
-gmap' testAABB f (Leaf root ents) = (Leaf root ents_kept, outliers)
-    where
-        ents'       = f <$> ents <*> ents
-        ents_kept   = filter (keep testAABB root) ents'
-        outliers    = filter (not . keep testAABB root) ents'
-
-gmap' testAABB f (QuadTree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
-    (QuadTree root ents_kept c1' c2' c3' c4' c5' c6' c7' c8', outliers)
-    where
-        ents'       = (f <$> ents <*> ents) ++ out1 ++ out2 ++ out3 ++ out4 ++ out5 ++ out6 ++ out7 ++ out8
-        ents_kept   = filter (keep testAABB root) ents'
-        outliers    = filter (not . keep testAABB root) ents'
-        (c1', out1) = gmap' testAABB f c1
-        (c2', out2) = gmap' testAABB f c2
-        (c3', out3) = gmap' testAABB f c3
-        (c4', out4) = gmap' testAABB f c4
-        (c5', out5) = gmap' testAABB f c5
-        (c6', out6) = gmap' testAABB f c6
-        (c7', out7) = gmap' testAABB f c7
-        (c8', out8) = gmap' testAABB f c8
-
-
-population :: QuadTree e -> Int
-population = F.foldr (\_ acc -> acc+1) 0
-
-
-
-
-instance Functor QuadTree where
-    
-    fmap f (Leaf root ents) = Leaf root $ fmap f ents
-    
-    fmap f (QuadTree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
-        QuadTree root (fmap f ents) c1' c2' c3' c4' c5' c6' c7' c8'
-        where
-            c1' = fmap f c1
-            c2' = fmap f c2
-            c3' = fmap f c3
-            c4' = fmap f c4
-            c5' = fmap f c5
-            c6' = fmap f c6
-            c7' = fmap f c7
-            c8' = fmap f c8
-
-
-
-instance F.Foldable QuadTree where
-    
-    foldMap f (Leaf root ents) = mconcat . fmap f $ ents
-    
-    foldMap f (QuadTree root ents c1 c2 c3 c4 c5 c6 c7 c8) =
-        mconcat (fmap f ents) `mappend`
-        c1' `mappend` c2' `mappend` c3' `mappend` c4' `mappend`
-        c5' `mappend` c6' `mappend` c7' `mappend` c8'
-        where
-            c1' = F.foldMap f c1
-            c2' = F.foldMap f c2
-            c3' = F.foldMap f c3
-            c4' = F.foldMap f c4
-            c5' = F.foldMap f c5
-            c6' = F.foldMap f c6
-            c7' = F.foldMap f c7
-            c8' = F.foldMap f c8
diff --git a/Spear/Math/Sphere.hs b/Spear/Math/Sphere.hs
new file mode 100644
index 0000000..9c80811
--- /dev/null
+++ b/Spear/Math/Sphere.hs
@@ -0,0 +1,26 @@
+module Spear.Math.Sphere
+where
+
+import Spear.Math.Vector
+
+import Data.List (foldl')
+
+-- | A sphere in 3D space.
+data Sphere = Sphere
+    { center :: {-# UNPACK #-} !Vector3
+    , radius :: {-# UNPACK #-} !Float
+    }
+
+-- | Create a sphere from the given points.
+sphere :: [Vector3] -> Sphere
+sphere [] = Sphere zero3 0
+sphere (x:xs) = Sphere c r
+    where
+        c = pmin + (pmax-pmin)/2
+        r = norm $ pmax - c
+        (pmin,pmax) = foldl' update (x,x) xs
+        update (pmin,pmax) p = (min p pmin, max p pmax)
+
+-- | Return 'True' if the given sphere contains the given point, 'False' otherwise.
+circlept :: Sphere -> Vector3 -> Bool
+circlept (Sphere c r) p = r*r >= normSq (p - c)
diff --git a/Spear/Physics.hs b/Spear/Physics.hs
deleted file mode 100644
index c143e32..0000000
--- a/Spear/Physics.hs
+++ /dev/null
@@ -1,10 +0,0 @@
-module Spear.Physics
-(
-    module Spear.Physics.Rigid
-,   module Spear.Physics.Types
-)
-where
-
-
-import Spear.Physics.Rigid
-import Spear.Physics.Types
diff --git a/Spear/Render/AnimatedModel.hs b/Spear/Render/AnimatedModel.hs
index f8a5960..c2456b2 100644
--- a/Spear/Render/AnimatedModel.hs
+++ b/Spear/Render/AnimatedModel.hs
@@ -28,10 +28,10 @@ module Spear.Render.AnimatedModel
 where
 
 import Spear.Assets.Model
-import Spear.Collision
 import Spear.Game
 import Spear.GL
 import Spear.Math.AABB
+import Spear.Math.Collision
 import Spear.Math.Matrix4 (Matrix4)
 import Spear.Math.Vector
 import Spear.Render.Material
@@ -219,7 +219,7 @@ mkColsFromAnimated
     -> Float   -- ^ Frame progress
     -> Matrix4 -- ^ Modelview matrix
     -> AnimatedModelResource
-    -> [Collisioner]
+    -> [Collisioner2]
 mkColsFromAnimated f1 f2 fp modelview modelRes =
     let
         (Box (Vec3 xmin1 ymin1 zmin1) (Vec3 xmax1 ymax1 zmax1)) = box f1 modelRes
diff --git a/Spear/Render/StaticModel.hs b/Spear/Render/StaticModel.hs
index a57f8fd..2f74c06 100644
--- a/Spear/Render/StaticModel.hs
+++ b/Spear/Render/StaticModel.hs
@@ -18,10 +18,10 @@ module Spear.Render.StaticModel
 where
 
 import Spear.Assets.Model
-import Spear.Collision
 import Spear.Game
 import Spear.GL
 import Spear.Math.AABB
+import Spear.Math.Collision
 import Spear.Math.Matrix4 (Matrix4)
 import Spear.Math.Vector
 import Spear.Render.Material
@@ -134,5 +134,5 @@ render uniforms (StaticModelRenderer model) =
 mkColsFromStatic
     :: Matrix4 -- ^ Modelview matrix
     -> StaticModelResource
-    -> [Collisioner]
+    -> [Collisioner2]
 mkColsFromStatic modelview modelRes = mkCols modelview (box 0 modelRes)
diff --git a/Spear/Scene/GameObject.hs b/Spear/Scene/GameObject.hs
index 30211f4..5ea483b 100644
--- a/Spear/Scene/GameObject.hs
+++ b/Spear/Scene/GameObject.hs
@@ -8,8 +8,8 @@ module Spear.Scene.GameObject
 ,   goNew
     -- * Accessors
 ,   currentAnimation
-,   goAABB
-,   goAABBs
+--,   goAABB
+--,   goAABBs
 ,   collisioners
 ,   goRPGtransform
 ,   numCollisioners
@@ -31,10 +31,10 @@ module Spear.Scene.GameObject
 where
 
 
-import Spear.Collision as Col
 import Spear.GL
 import Spear.Math.AABB
 import qualified Spear.Math.Camera as Cam
+import Spear.Math.Collision as Col
 import qualified Spear.Math.Matrix3 as M3
 import qualified Spear.Math.Matrix4 as M4
 import Spear.Math.MatrixUtils
@@ -73,7 +73,7 @@ dummyWindow = Window M4.id M4.id 0 0 640 480
 data GameObject = GameObject
     { gameStyle    :: !GameStyle
     , renderer     :: !(Either StaticModelRenderer AM.AnimatedModelRenderer)
-    , collisioners :: ![Collisioner]
+    , collisioners :: ![Collisioner2]
     , transform    :: !M3.Matrix3
     , axis         :: !Vector3
     , angle        :: !Float
@@ -170,7 +170,7 @@ instance S2.Spatial2 GameObject where
 -- | Create a new game object.
 goNew :: GameStyle
       -> Either StaticModelResource AM.AnimatedModelResource
-      -> [Collisioner]
+      -> [Collisioner2]
       -> M3.Matrix3 -- ^ Transform
       -> Vector3 -- ^ Axis of rotation
       -> GameObject
@@ -194,13 +194,13 @@ goUpdate dt go =
 
 
 -- | Get the game object's ith bounding box.
-goAABB :: Int -> GameObject -> AABB
-goAABB i = getAABB . flip (!!) i . collisioners
+--goAABB :: Int -> GameObject -> AABB2
+--goAABB i = getAABB . flip (!!) i . collisioners
 
 
 -- | Get the game object's bounding boxes.
-goAABBs :: GameObject -> [AABB]
-goAABBs = fmap getAABB . collisioners
+--goAABBs :: GameObject -> [AABB2]
+--goAABBs = fmap getAABB . collisioners
 
 
 -- | Get the game object's 3D transform.
@@ -242,7 +242,7 @@ setAxis ax go = go { axis = ax }
 
 
 -- | Set the game object's collisioners.
-setCollisioners :: [Collisioner] -> GameObject -> GameObject
+setCollisioners :: [Collisioner2] -> GameObject -> GameObject
 setCollisioners cols go = go { collisioners = cols }
 
 
@@ -252,7 +252,7 @@ setWindow wnd go = go { window = wnd }
 
 
 -- | Manipulate the game object's collisioners.
-withCollisioners :: GameObject -> ([Collisioner] -> [Collisioner]) -> GameObject
+withCollisioners :: GameObject -> ([Collisioner2] -> [Collisioner2]) -> GameObject
 withCollisioners go f = go { collisioners = f $ collisioners go }
 
 
diff --git a/Spear/Scene/Loader.hs b/Spear/Scene/Loader.hs
index 9d785fe..b61db94 100644
--- a/Spear/Scene/Loader.hs
+++ b/Spear/Scene/Loader.hs
@@ -18,9 +18,9 @@ module Spear.Scene.Loader
 where
 
 import Spear.Assets.Model as Model
-import Spear.Collision
 import Spear.Game
 import qualified Spear.GL as GL
+import Spear.Math.Collision
 import Spear.Math.Matrix3 as M3
 import Spear.Math.Matrix4 as M4
 import Spear.Math.MatrixUtils (fastNormalMatrix)
@@ -135,18 +135,18 @@ newModel (SceneLeaf _ props) = do
     kd   <- asVec4   $ mandatory' "kd"             props
     ks   <- asVec4   $ mandatory' "ks"             props
     shi  <- asFloat  $ mandatory' "shi"            props
-    
+
     let rotation = asRotation $ value "rotation" props
         scale    = asVec3 $ value "scale" props
-    
+
     gameIO $ printf "Loading model %s..." name
     model    <- loadModel' file rotation scale
     gameIO .  putStrLn $ "done"
     texture  <- loadTexture  tex
     sceneRes <- get
-    
+
     let material = Material ke ka kd ks shi
-    
+
     case animated model of
         False ->
             case M.lookup prog $ staticPrograms sceneRes of
@@ -173,12 +173,12 @@ loadModel' file rotation scale = do
             (case rotation of
                 Nothing  -> Prelude.id
                 Just rot -> rotateModel rot) .
-            
+
             (case scale of
                 Nothing -> Prelude.id
                 Just s  -> flip Model.transformVerts $
                     \(Vec3 x' y' z') -> Vec3 (x s * x') (y s * y') (z s * z'))
-    
+
     (fmap transform $ Model.loadModel file) >>= gameIO . toGround
 
 rotateModel :: Rotation -> Model -> Model
@@ -191,10 +191,10 @@ rotateModel (Rotation ax ay az order) model =
             ZXY -> rotY ay * rotX ax * rotZ az
             ZYX -> rotX ax * rotY ay * rotZ az
         normalMat = fastNormalMatrix mat
-        
+
         vTransform (Vec3 x' y' z') =
             let v = mat `M4.mulp` (vec3 x' y' z') in Vec3 (x v) (y v) (z v)
-        
+
         nTransform (Vec3 x' y' z') =
             let v = normalMat `M3.mul` (vec3 x' y' z') in Vec3 (x v) (y v) (z v)
     in
@@ -212,9 +212,9 @@ newShaderProgram (SceneLeaf _ props) = do
     name       <- asString $ mandatory' "name" props
     stype      <- asString $ mandatory' "type" props
     prog       <- GL.newProgram [vertShader, fragShader]
-    
+
     let getUniformLoc name = (gameIO . SV.get $ GL.uniformLocation prog name) `GL.assertGL` name
-    
+
     case stype of
         "static" -> do
             ambient    <- asString $ mandatory' "ambient"    props
@@ -225,7 +225,7 @@ newShaderProgram (SceneLeaf _ props) = do
             modelview  <- asString $ mandatory' "modelview"  props
             normalmat  <- asString $ mandatory' "normalmat"  props
             projection <- asString $ mandatory' "projection" props
-            
+
             ka    <- getUniformLoc ambient
             kd    <- getUniformLoc diffuse
             ks    <- getUniformLoc specular
@@ -234,18 +234,18 @@ newShaderProgram (SceneLeaf _ props) = do
             mview <- getUniformLoc modelview
             nmat  <- getUniformLoc normalmat
             proj  <- getUniformLoc projection
-            
+
             vertChan  <- fmap read $ asString $ mandatory' "vertex-channel" props
             normChan  <- fmap read $ asString $ mandatory' "normal-channel" props
             texChan    <- fmap read $ asString $ mandatory' "texture-channel" props
-            
+
             let channels = StaticProgramChannels vertChan normChan texChan
                 uniforms = StaticProgramUniforms ka kd ks shi tex mview nmat proj
-            
+
             loadResource name staticPrograms addStaticProgram $
                 return $ StaticProgram prog channels uniforms
             return ()
-        
+
         "animated" -> do
             ambient    <- asString $ mandatory' "ambient"    props
             diffuse    <- asString $ mandatory' "diffuse"    props
@@ -255,7 +255,7 @@ newShaderProgram (SceneLeaf _ props) = do
             modelview  <- asString $ mandatory' "modelview"  props
             normalmat  <- asString $ mandatory' "normalmat"  props
             projection <- asString $ mandatory' "projection" props
-            
+
             ka    <- getUniformLoc ambient
             kd    <- getUniformLoc diffuse
             ks    <- getUniformLoc specular
@@ -264,7 +264,7 @@ newShaderProgram (SceneLeaf _ props) = do
             mview <- getUniformLoc modelview
             nmat  <- getUniformLoc normalmat
             proj  <- getUniformLoc projection
-            
+
             vertChan1  <- fmap read $ asString $ mandatory' "vertex-channel1" props
             vertChan2  <- fmap read $ asString $ mandatory' "vertex-channel2" props
             normChan1  <- fmap read $ asString $ mandatory' "normal-channel1" props
@@ -272,14 +272,14 @@ newShaderProgram (SceneLeaf _ props) = do
             texChan    <- fmap read $ asString $ mandatory' "texture-channel" props
             fp <- asString $ mandatory' "fp" props
             p  <- getUniformLoc fp
-            
+
             let channels = AnimatedProgramChannels vertChan1 vertChan2 normChan1 normChan2 texChan
                 uniforms = AnimatedProgramUniforms ka kd ks shi tex p mview nmat proj
-            
+
             loadResource name animatedPrograms addAnimatedProgram $
                 return $ AnimatedProgram prog channels uniforms
             return ()
-        
+
         _ -> do
             loadResource name customPrograms addCustomProgram $ return prog
             return ()
@@ -352,10 +352,10 @@ newObject' newGO sceneRes nid props = do
         right'   = (asVec2   $ value "right"    props) `unspecified` vec2 1 0
         up'      =  asVec2   $ value "up"       props
         scale    = (asVec2   $ value "scale"    props) `unspecified` vec2 1 1
-    
+
     -- Compute the object's vectors if an up/forward vector has been specified.
     let (right, up) = vectors up'
-    
+
     newGO goType sceneRes props (M3.transform right up position)
 
 vectors :: Maybe Vector2 -> (Vector2, Vector2)
diff --git a/Spear/Scene/Scene.hs b/Spear/Scene/Scene.hs
deleted file mode 100644
index 57a9a40..0000000
--- a/Spear/Scene/Scene.hs
+++ /dev/null
@@ -1,150 +0,0 @@
-module Spear.Scene.Scene
-(
-    -- * Data types
-    Scene
-    -- * Construction
-,   listScene
-    -- * Insertion and deletion
-,   add
-,   remove
-,   Spear.Scene.Scene.filter
-    -- * Queries
-,   find
-,   query
-    -- * Update and render
-,   update
-,   updateM
-,   Spear.Scene.Scene.collide
-,   collideM
-,   render
-)
-where
-
-
-import Spear.Collision
-import Spear.Game (Game)
-import Spear.Math.AABB
-import Spear.Math.QuadTree as QT
-
-import Control.Applicative ((<*>))
-import Control.Monad (foldM)
-import Data.Foldable as F (foldl', mapM_)
-import Data.Functor ((<$>))
-import qualified Data.List as L (delete, filter, find)
-
-
-data Scene obj =
-    ListScene
-    { objects :: ![obj]
-    }
-    |
-    QuadTreeScene
-    { collideAABB :: obj -> AABB -> CollisionType
-    , world       :: !(QuadTree obj)
-    }
-
-
--- | Create a list-based scene.
-listScene :: [obj] -> Scene obj
-listScene = ListScene
-
-
--- Create an octree-based scene.
---octreeScene :: (obj -> AABB -> CollisionType) -> (obj -> AABB) -> [obj] -> Scene obj msg
---octreeScene collide getAABB objs = OctreeScene [] collide $ makeOctree
-
-
--- | Add a list of game objects to the given 'Scene'.
-add :: Scene obj -> [obj] -> Scene obj
-add (scene@ListScene {})   l = scene { objects = l ++ objects scene }
-add (scene@QuadTreeScene {}) l = scene { world = QT.insert (collideAABB scene) (world scene) l }
-
-
--- | Remove a game object from the given 'Scene'.
-remove :: Eq obj => Scene obj -> obj -> Scene obj
-remove (scene@ListScene {})   o = scene { objects = L.delete o (objects scene) }
---remove (scene@OctreeScene {}) o =
-
-
--- | Remove those game objects that do not satisfy the given predicate from the 'Scene'.
-filter :: (obj -> Bool) -> Scene obj -> Scene obj
-filter pred (scene@ListScene {}) = scene { objects = L.filter pred (objects scene) }
-
-
--- | Search for an object in the 'Scene'.
-find :: (obj -> Bool) -> Scene obj -> Maybe obj
-find pred (scene@ListScene {}) = L.find pred $ objects scene
-
-
--- | Return all objects that satisfy the given predicate.
-query :: (obj -> Bool) -> Scene obj -> [obj]
-query pred (scene@ListScene {}) = L.filter pred $ objects scene
-
-
-type Update obj = obj -> obj
-
-
--- | Update the given scene.
-update :: (obj -> obj) -> Scene obj -> Scene obj
-update updt (scene@ListScene {})   = scene { objects = fmap updt $ objects scene }
-update updt (scene@QuadTreeScene {}) = scene { world   = QT.map (collideAABB scene) updt $ world scene }
-
-
--- | Update the given scene.
-updateM :: Monad m => (obj -> m obj) -> Scene obj -> m (Scene obj)
-updateM updt scene@ListScene {} = mapM updt (objects scene) >>= return . ListScene
-
-
-{-update' :: (obj -> (obj, [a])) -> Scene obj -> (Scene obj, [a])
-
-update' updt (scene@ListScene {}) =
-    let (objs, msgs) = unzip . fmap updt $ objects scene
-    in (scene { objects = objs }, concat msgs)-}
-
-
--- | Perform collisions.
-collide :: ([obj] -> obj -> obj) -> Scene obj -> Scene obj
-
-collide col scene@ListScene {} =
-    let objs   = objects scene
-        objs'  = fmap (col objs) objs
-    in
-        scene { objects = objs' }
-
-collide col scene@QuadTreeScene {} = error "not yet implemented"
-    --scene { world = gmap (collideAABB scene) col $ world scene }
-
-
--- | Perform collisions.
-collideM :: Monad m => (obj -> obj -> m obj) -> Scene obj -> m (Scene obj)
-collideM col scene@ListScene {} =
-    let objs = objects scene
-
-        col' o = foldM f o objs
-        f o p  = col o p
-
-        objs' = sequence . fmap col' $ objs
-    in
-        objs' >>= return . ListScene
-
-
-{-collide' :: (obj -> obj -> (obj, [a])) -> Scene obj -> (Scene obj, [a])
-
-collide' col scene@ListScene {} =
-    let objs = objects scene
-
-        --col' :: obj -> (obj, [a])
-        col' o = foldl' f (o, []) objs
-
-        --f :: (obj, [a]) -> obj -> (obj, [a])
-        f (o, msgs) p  = let (o', msgs') = col o p in (o', msgs' ++ msgs)
-
-        (objs', msgs) = let (os, ms) = (unzip . fmap col' $ objs) in (os, concat ms)
-    in
-        (scene { objects = objs' }, msgs)-}
-
-
--- | Render the given 'Scene'.
-render :: (obj -> Game s ()) -> Scene obj -> Game s ()
-render rend (scene@ListScene {})   = Prelude.mapM_ rend $ objects scene
-render rend (scene@QuadTreeScene {}) = F.mapM_ rend $ world scene