initial commit

77 files changed, 7835 insertions, 0 deletions

diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..914c31a
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,7 @@
+Copyright (c) 2012 Marc Sunet
+
+Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Spear.cabal b/Spear.cabal
new file mode 100644
index 0000000..ab8f6b9
--- /dev/null
+++ b/Spear.cabal
@@ -0,0 +1,120 @@
+name: Spear
+version: 0.1
+cabal-version: >=1.2
+build-type: Simple
+license: BSD3
+license-file: LICENSE
+maintainer: jeannekamikaze@gmail.com
+homepage: http://spear.shellblade.net
+synopsis: A 3D game framework.
+description:  
+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, resource-simple -any, parsec >= 3.1.3, containers,
+                   ansi-terminal, vector
+                   
+    exposed-modules:
+                     Spear.App
+                     Spear.App.Application
+                     Spear.App.Input
+                     
+                     Spear.Assets.Image
+                     Spear.Assets.Model
+                     
+                     Spear.Collision
+                     Spear.Collision.AABB
+                     Spear.Collision.Collision
+                     Spear.Collision.Collisioner
+                     Spear.Collision.Sphere
+                     Spear.Collision.Triangle
+                     Spear.Collision.Types
+                     
+                     Spear.Game
+                     
+                     Spear.GLSL
+                     Spear.GLSL.Buffer
+                     Spear.GLSL.Error
+                     Spear.GLSL.Management
+                     Spear.GLSL.Texture
+                     Spear.GLSL.Uniform
+                     Spear.GLSL.VAO
+                     
+                     Spear.Math.Camera
+                     Spear.Math.Entity
+                     Spear.Math.Matrix3
+                     Spear.Math.Matrix4
+                     Spear.Math.MatrixUtils
+                     Spear.Math.Octree
+                     Spear.Math.Plane
+                     Spear.Math.Spatial
+                     Spear.Math.Vector3
+                     Spear.Math.Vector4
+                     
+                     Spear.Render.AnimatedModel
+                     Spear.Render.Material
+                     Spear.Render.Model
+                     Spear.Render.Program
+                     Spear.Render.Renderable
+                     Spear.Render.StaticModel
+                     Spear.Render.Texture
+                     
+                     Spear.Scene.Graph
+                     Spear.Scene.Light
+                     Spear.Scene.Loader
+                     Spear.Scene.Scene
+                     Spear.Scene.SceneResources
+                     
+                     Spear.Setup
+                     
+                     Spear.Sys.Timer
+                     
+                     Spear.Updatable
+    exposed: True
+    
+    buildable: True
+    
+    build-tools: hsc2hs -any
+    
+    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/OBJ_load.cc
+                Spear/Render/RenderModel.c
+                Spear/Sys/Timer/ctimer.c
+               
+    extensions: TypeFamilies
+    
+    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
+                Spear/Assets/Model/OBJ/OBJ_load.h
+                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 -rtsopts
+    
+    cc-options:  -O2 -g -Wno-unused-result
+    
+    extra-libraries: stdc++
+ 
diff --git a/Spear.lkshs b/Spear.lkshs
new file mode 100644
index 0000000..a5674ae
--- /dev/null
+++ b/Spear.lkshs
@@ -0,0 +1,18 @@
+Version of session file format:
+               1
+Time of storage:
+               "Tue Jul 31 01:00:21 CEST 2012"
+Layout:        VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [("Browser",HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 290) 199)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 701) 953
+Population:    [(Just (ErrorsSt ErrorsState),[SplitP RightP,SplitP TopP]),(Just (FilesSt FilesState),[SplitP RightP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/GameMessage.hs" 295)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/GameObject.hs" 5019)),[SplitP LeftP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/GameState.hs" 265)),[SplitP LeftP]),(Just (InfoSt (InfoState Nothing)),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP BottomP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Math/Matrix4.hs" 8726)),[SplitP LeftP]),(Just (ModulesSt (ModulesState 286 (PackageScope False,False) (Just (ModuleName ["Spear","Math","Camera"]),Nothing) (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([[0,4],[0]],[]), packageDExp = ([],[]), packageDExpNoBlack = ([],[]), workspaceExp = ([],[]), workspaceExpNoBlack = ([],[]), workspaceDExp = ([],[]), workspaceDExpNoBlack = ([],[]), systemExp = ([],[]), systemExpNoBlack = ([],[])}))),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/Spear/Math/Vector3.hs" 3534)),[SplitP LeftP]),(Just (WorkspaceSt WorkspaceState),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP TopP]),(Just (BufferSt (BufferState "/home/jeanne/programming/haskell/Spear/demos/simple-scene/main.hs" 3944)),[SplitP LeftP])]
+Window size:   (1796,979)
+Completion size:
+               (750,400)
+Workspace:     Just "/home/jeanne/programming/haskell/Spear/Spear.lkshw"
+Active pane:   Just "GameMessage.hs"
+Toolbar visible:
+               True
+FindbarState:  (False,FindState {entryStr = "", entryHist = ["asd","MouseButton"], replaceStr = "MouseProperty", replaceHist = [], caseSensitive = False, entireWord = False, wrapAround = False, regex = False, lineNr = 1})
+Recently opened files:
+               ["/home/jeanne/programming/haskell/Spear/Spear/Collision/Collision.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Camera.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Entity.hs","/home/jeanne/programming/haskell/Spear/Spear/Scene/Scene.hs","/home/jeanne/programming/haskell/Spear/Spear/Math/Spatial.hs","/home/jeanne/programming/haskell/Spear/Spear/Assets/Image/BMP/BMP_load.c","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/OBJ/OBJ_load.cc","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model.hsc","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/MD2/MD2_load.c","/home/jeanne/programming/haskell/Spear/Spear/Assets/Model/Model.h","/home/jeanne/programming/haskell/Spear/demos/simple-scene/OgroAnimation.hs","/home/jeanne/programming/haskell/Spear/Spear/App/Input.hs"]
+Recently opened workspaces:
+               ["/home/jeanne/programming/haskell/Spear/Spear.lkshw","/home/jeanne/leksah.lkshw"]
\ No newline at end of file
diff --git a/Spear.lkshw b/Spear.lkshw
new file mode 100644
index 0000000..47ee51d
--- /dev/null
+++ b/Spear.lkshw
@@ -0,0 +1,10 @@
+Version of workspace file format:
+               1
+Time of storage:
+               "Tue Jul 31 00:59:07 CEST 2012"
+Name of the workspace:
+               "Spear"
+File paths of contained packages:
+               ["demos/simple-scene/simple-scene.cabal","Spear.cabal"]
+Maybe file path of an active package:
+               Just "Spear.cabal"
\ No newline at end of file
diff --git a/Spear/App.hs b/Spear/App.hs
new file mode 100644
index 0000000..a962414
--- /dev/null
+++ b/Spear/App.hs
@@ -0,0 +1,10 @@
+module Spear.App
+(
+    module Spear.App.Application
+,   module Spear.App.Input
+)
+where
+
+
+import Spear.App.Application
+import Spear.App.Input
diff --git a/Spear/App/Application.hs b/Spear/App/Application.hs
new file mode 100644
index 0000000..49fbbc7
--- /dev/null
+++ b/Spear/App/Application.hs
@@ -0,0 +1,122 @@
+module Spear.App.Application
+(
+    -- * Data types
+    Dimensions
+,   Context
+,   SpearWindow
+,   Update
+    -- * Setup
+,   setup
+,   quit
+,   releaseWindow
+    -- * Main loop
+,   run
+,   runCapped
+)
+where
+
+
+import Spear.Game
+import Spear.Setup
+import Spear.Sys.Timer as Timer
+
+import Control.Applicative
+import Control.Monad (forever, when)
+import Control.Monad.Trans.Error
+import Control.Monad.Trans.Class (lift)
+import Graphics.UI.GLFW as GLFW
+import Graphics.Rendering.OpenGL as GL
+import System.Exit
+import Unsafe.Coerce
+
+
+-- | Window dimensions.
+type Dimensions = (Int, Int)
+
+-- | A tuple specifying the desired OpenGL context, of the form (Major, Minor).
+type Context    = (Int, Int)
+
+
+-- | Represents a window.
+newtype SpearWindow = SpearWindow { rkey :: Resource }
+
+
+-- | Set up an application 'SpearWindow'.
+setup :: Dimensions -> [DisplayBits] -> WindowMode -> Context -> Setup SpearWindow
+setup (w, h) displayBits windowMode (major, minor) = do
+    glfwInit
+    
+    setupIO $ 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))
+        
+        initialiseTimingSubsystem
+    
+    rkey <- register quit
+    return $ SpearWindow rkey
+
+
+-- | Release the given 'SpearWindow'.
+releaseWindow :: SpearWindow -> Setup ()
+releaseWindow = release . rkey
+
+
+glfwInit :: Setup ()
+glfwInit = do
+    result <- setupIO GLFW.initialize
+    case result of
+        False -> setupError "GLFW.initialize failed"
+        True  -> return ()
+
+
+-- | Close the application's window.
+quit :: IO ()
+quit = GLFW.terminate
+
+
+-- | Return true if the application should continue running, false otherwise.
+type Update s = Float -> Game s (Bool)
+
+
+-- | Run the application's main loop.
+run :: Update s -> Game s ()
+run update = do
+    timer <- gameIO $ start newTimer
+    run' timer update
+
+
+run' :: Timer -> Update s -> Game s ()
+run' timer update = do
+    timer' <- gameIO $ tick timer
+    continue <- update $ getDelta timer'
+    case continue of
+        False -> return ()
+        True  -> run' timer' update
+
+
+-- | Run the application's main loop, with a limit on the frame rate.
+runCapped :: Int -> Update s -> Game s ()
+runCapped maxFPS update = do
+    let ddt = 1.0 / (fromIntegral maxFPS)
+    timer <- gameIO $ start newTimer
+    runCapped' ddt timer update
+
+
+runCapped' :: Float -> Timer -> Update s -> Game s ()
+runCapped' ddt timer update = do
+    timer' <- gameIO $ tick timer
+    continue <- update $ getDelta timer'
+    case continue of
+        False -> return ()
+        True  -> do
+            t'' <- gameIO $ tick timer'
+            let dt = getDelta t''
+            when (dt < ddt) $ gameIO $ Timer.sleep (ddt - dt)
+            runCapped' ddt timer' update
+            
diff --git a/Spear/App/Input.hs b/Spear/App/Input.hs
new file mode 100644
index 0000000..74ee1eb
--- /dev/null
+++ b/Spear/App/Input.hs
@@ -0,0 +1,220 @@
+module Spear.App.Input
+(
+    -- * Data types
+    Key(..)
+,   MouseButton(..)
+,   MouseProp(..)
+,   Keyboard
+,   Mouse(..)
+,   Input(..)
+,   DelayedMouseState
+    -- * Input state querying
+,   getKeyboard
+,   newMouse
+,   getMouse
+,   getInput
+,   pollInput
+    -- * Toggled input
+,   toggledMouse
+,   toggledKeyboard
+    -- * Delayed input
+,   delayedMouse
+)
+where
+
+
+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 Graphics.Rendering.OpenGL.GL.StateVar
+
+
+data Key
+    = KEY_A | KEY_B | KEY_C | KEY_D | KEY_E | KEY_F | KEY_G | KEY_H
+    | KEY_I | KEY_J | KEY_K | KEY_L | KEY_M | KEY_N | KEY_O | KEY_P
+    | KEY_Q | KEY_R | KEY_S | KEY_T | KEY_U | KEY_V | KEY_W | KEY_X
+    | KEY_Y | KEY_Z | KEY_0 | KEY_1 | KEY_2 | KEY_3 | KEY_4 | KEY_5
+    | KEY_6 | KEY_7 | KEY_8 | KEY_9 | KEY_F1 | KEY_F2 | KEY_F3
+    | KEY_F4 | KEY_F5 | KEY_F6 | KEY_F7 | KEY_F8 | KEY_F9 | KEY_F10
+    | KEY_F11 | KEY_F12 | KEY_ESC
+    deriving (Enum, Bounded)
+
+
+type Keyboard = Key -> Bool
+
+
+data MouseButton = LMB | RMB | MMB
+    deriving (Enum, Bounded)
+
+
+data MouseProp = MouseX | MouseY | MouseDX | MouseDY
+
+
+data Mouse = Mouse
+    { button   :: MouseButton -> Bool
+    , property :: MouseProp -> Float
+    }
+
+
+data Input = Input
+    { keyboard :: Keyboard
+    , mouse    :: Mouse
+    }
+
+
+-- | Get the keyboard.
+getKeyboard :: IO Keyboard
+getKeyboard =
+    let keyboard' :: V.Vector Bool -> Keyboard
+        keyboard' keystate key = keystate V.! fromEnum key
+        keys = fmap toEnum [0..fromEnum (maxBound :: Key)]
+    in
+        (fmap (V.fromList . fmap ((==) GLFW.Press)) . mapM GLFW.getKey . fmap toGLFWkey $ keys)
+            >>= return . keyboard'
+
+
+-- | Return a dummy mouse.
+--
+-- This function should be called to get an initial mouse.
+--
+-- The returned mouse has all keys unpressed, position set to (0,0) and 0 deta values.
+--
+-- For further mouse updates, see 'getMouse'.
+newMouse :: Mouse
+newMouse = Mouse (const False) (const 0)
+
+
+-- | Get the mouse.
+--
+-- The previous mouse state is required to compute position deltas.
+getMouse :: Mouse -> IO Mouse
+getMouse oldMouse =
+    let getButton :: V.Vector Bool -> MouseButton -> Bool
+        getButton mousestate button = mousestate V.! fromEnum button
+
+        prop' :: Float -> Float -> MouseProp -> Float
+        prop' xpos _    MouseX  = xpos
+        prop' _    ypos MouseY  = ypos
+        prop' xpos _    MouseDX = xpos - property oldMouse MouseX
+        prop' _    ypos MouseDY = ypos - property oldMouse MouseY
+
+        buttons  = fmap toEnum [0..fromEnum (maxBound :: MouseButton)]
+        getKeystate = (fmap (V.fromList . fmap ((==) GLFW.Press)) .
+                       mapM GLFW.getMouseButton .
+                       fmap toGLFWbutton $ buttons)
+    in do
+        Position xpos ypos <- get GLFW.mousePos
+        keystate <- getKeystate
+        return $ Mouse (getButton keystate) (prop' (fromIntegral xpos) (fromIntegral ypos))
+
+
+-- | Get input devices.
+getInput :: Mouse -> IO Input
+getInput oldMouse = do
+    keyboard <- getKeyboard
+    mouse    <- getMouse oldMouse
+    return $ Input keyboard mouse
+
+
+-- | Poll input devices.
+pollInput :: IO ()
+pollInput = GLFW.pollEvents
+
+
+-- | Return a mouse that reacts to button toggles.
+toggledMouse :: Mouse -- ^ Previous mouse state.
+             -> Mouse -- ^ Current mouse state.
+             -> Mouse -- ^ Toggled mouse.
+
+toggledMouse prev cur = cur { button = \bt -> button cur bt && not (button prev bt) }
+
+
+-- | Return a keyboard that reacts to key toggles.
+toggledKeyboard :: Keyboard -- ^ Previous keyboard state.
+                -> Keyboard -- ^ Current keyboard state.
+                -> Keyboard -- ^ Toggled keyboard.
+
+toggledKeyboard prev cur key = cur key && not (prev key)
+
+
+
+
+-- | Accumulated delays for each mouse button.
+type DelayedMouseState = MouseButton -> Float
+
+
+delayedMouse :: (MouseButton -> Float) -- ^ Delay configuration for each button.
+             -> Mouse -- ^ Current mouse state.
+             -> Float -- ^ Time elapsed since last udpate.
+             -> DelayedMouseState
+             -> (Mouse, DelayedMouseState)
+
+delayedMouse delay mouse dt dms =
+    let
+        accum  x  = dms x + dt
+        active x  = accum x >= delay x
+        button' x = active x && button mouse x
+        accum' x  = if button' x then 0 else accum x
+    in
+        (mouse { button = button' }, accum')
+
+
+
+
+toGLFWkey :: Key -> Int
+toGLFWkey KEY_A   = ord 'A'
+toGLFWkey KEY_B   = ord 'B'
+toGLFWkey KEY_C   = ord 'C'
+toGLFWkey KEY_D   = ord 'D'
+toGLFWkey KEY_E   = ord 'E'
+toGLFWkey KEY_F   = ord 'F'
+toGLFWkey KEY_G   = ord 'G'
+toGLFWkey KEY_H   = ord 'H'
+toGLFWkey KEY_I   = ord 'I'
+toGLFWkey KEY_J   = ord 'J'
+toGLFWkey KEY_K   = ord 'K'
+toGLFWkey KEY_L   = ord 'L'
+toGLFWkey KEY_M   = ord 'M'
+toGLFWkey KEY_N   = ord 'N'
+toGLFWkey KEY_O   = ord 'O'
+toGLFWkey KEY_P   = ord 'P'
+toGLFWkey KEY_Q   = ord 'Q'
+toGLFWkey KEY_R   = ord 'R'
+toGLFWkey KEY_S   = ord 'S'
+toGLFWkey KEY_T   = ord 'T'
+toGLFWkey KEY_U   = ord 'U'
+toGLFWkey KEY_V   = ord 'V'
+toGLFWkey KEY_W   = ord 'W'
+toGLFWkey KEY_X   = ord 'X'
+toGLFWkey KEY_Y   = ord 'Y'
+toGLFWkey KEY_Z   = ord 'Z'
+toGLFWkey KEY_0   = ord '0'
+toGLFWkey KEY_1   = ord '1'
+toGLFWkey KEY_2   = ord '2'
+toGLFWkey KEY_3   = ord '3'
+toGLFWkey KEY_4   = ord '4'
+toGLFWkey KEY_5   = ord '5'
+toGLFWkey KEY_6   = ord '6'
+toGLFWkey KEY_7   = ord '7'
+toGLFWkey KEY_8   = ord '8'
+toGLFWkey KEY_9   = ord '9'
+toGLFWkey KEY_F1  = fromEnum GLFW.F1
+toGLFWkey KEY_F2  = fromEnum GLFW.F2
+toGLFWkey KEY_F3  = fromEnum GLFW.F3
+toGLFWkey KEY_F4  = fromEnum GLFW.F4
+toGLFWkey KEY_F5  = fromEnum GLFW.F5
+toGLFWkey KEY_F6  = fromEnum GLFW.F6
+toGLFWkey KEY_F7  = fromEnum GLFW.F7
+toGLFWkey KEY_F8  = fromEnum GLFW.F8
+toGLFWkey KEY_F9  = fromEnum GLFW.F9
+toGLFWkey KEY_F10 = fromEnum GLFW.F10
+toGLFWkey KEY_F11 = fromEnum GLFW.F11
+toGLFWkey KEY_F12 = fromEnum GLFW.F12
+toGLFWkey KEY_ESC = fromEnum GLFW.ESC
+
+
+toGLFWbutton :: MouseButton -> GLFW.MouseButton
+toGLFWbutton LMB = GLFW.ButtonLeft
+toGLFWbutton RMB = GLFW.ButtonRight
+toGLFWbutton MMB = GLFW.ButtonMiddle
diff --git a/Spear/Assets/Image.hsc b/Spear/Assets/Image.hsc
new file mode 100644
index 0000000..2b5c482
--- /dev/null
+++ b/Spear/Assets/Image.hsc
@@ -0,0 +1,144 @@
+{-# LANGUAGE CPP, ForeignFunctionInterface #-}
+
+module Spear.Assets.Image
+(
+    -- * Data types
+    Image
+    -- * Loading and unloading
+,   loadImage
+,   releaseImage
+    -- * Accessors
+,   width
+,   height
+,   bpp
+,   pixels
+)
+where
+
+
+import Spear.Setup
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.Types
+import Foreign.C.String
+import Foreign.Marshal.Utils as Foreign (with)
+import Foreign.Marshal.Alloc (alloca)
+import Data.List (splitAt, elemIndex)
+import Data.Char (toLower)
+
+
+#include "Image.h"
+#include "BMP/BMP_load.h"
+
+
+data ImageErrorCode
+    = ImageSuccess
+    | ImageReadError
+    | ImageMemoryAllocationError
+    | ImageFileNotFound
+    | ImageInvalidFormat
+    | ImageNoSuitableLoader
+    deriving (Eq, Enum, Show)
+
+
+data CImage = CImage
+    { cwidth  :: CInt
+    , cheight :: CInt
+    , cbpp    :: CInt
+    , cpixels :: Ptr CUChar
+    }
+
+
+instance Storable CImage where
+    sizeOf _    = #{size Image}
+    alignment _ = alignment (undefined :: CInt)
+    
+    peek ptr = do
+        width  <- #{peek Image, width}  ptr
+        height <- #{peek Image, height} ptr
+        bpp    <- #{peek Image, bpp}    ptr
+        pixels <- #{peek Image, pixels} ptr
+        return $ CImage width height bpp pixels
+    
+    poke ptr (CImage width height bpp pixels) = do
+        #{poke Image, width}  ptr width
+        #{poke Image, height} ptr height
+        #{poke Image, bpp}    ptr bpp
+        #{poke Image, pixels} ptr pixels
+
+
+-- | Represents an image 'Resource'.
+data Image = Image
+    { imageData :: CImage
+    , rkey      :: Resource
+    }
+
+
+foreign import ccall "Image.h image_free"
+    image_free :: Ptr CImage -> IO ()
+
+
+foreign import ccall "BMP_load.h BMP_load"
+    bmp_load' :: Ptr CChar -> Ptr CImage -> IO Int
+
+
+bmp_load :: Ptr CChar -> Ptr CImage -> IO ImageErrorCode
+bmp_load file image = bmp_load' file image >>= \code -> return . toEnum $ code
+
+
+-- | Load the image specified by the given file.
+loadImage :: FilePath -> Setup Image
+loadImage file = do
+    dotPos <- case elemIndex '.' file of
+            Nothing -> setupError $ "file name has no extension: " ++ file
+            Just p  -> return p
+    
+    let ext = map toLower . tail . snd $ splitAt dotPos file
+    
+    result <- setupIO . alloca $ \ptr -> do
+        status <- withCString file $ \fileCstr -> do
+            case ext of
+                "bmp" -> bmp_load fileCstr ptr
+                _     -> return ImageNoSuitableLoader
+        
+        case status of
+            ImageSuccess               -> peek ptr >>= return . Right
+            ImageReadError             -> return . Left $ "read error"
+            ImageMemoryAllocationError -> return . Left $ "memory allocation error"
+            ImageFileNotFound          -> return . Left $ "file not found"
+            ImageInvalidFormat         -> return . Left $ "invalid format"
+            ImageNoSuitableLoader      -> return . Left $ "no suitable loader for extension " ++ ext
+        
+    case result of
+        Right image -> register (freeImage image) >>= return . Image image
+        Left  err   -> setupError $ "loadImage: " ++ err
+
+
+-- | Release the given 'Image'.
+releaseImage :: Image -> Setup ()
+releaseImage = release . rkey
+
+
+-- | Free the given 'CImage'.
+freeImage :: CImage -> IO ()
+freeImage image = Foreign.with image image_free
+
+
+-- | Return the given image's width.
+width :: Image -> Int
+width = fromIntegral . cwidth . imageData
+
+
+-- | Return the given image's height.
+height :: Image -> Int
+height = fromIntegral . cheight . imageData
+
+
+-- | Return the given image's bits per pixel.
+bpp :: Image -> Int
+bpp = fromIntegral . cbpp . imageData
+
+
+-- | Return the given image's pixels.
+pixels :: Image -> Ptr CUChar
+pixels = cpixels . imageData
diff --git a/Spear/Assets/Image/BMP/BMP_load.c b/Spear/Assets/Image/BMP/BMP_load.c
new file mode 100644
index 0000000..5c1b195
--- /dev/null
+++ b/Spear/Assets/Image/BMP/BMP_load.c
@@ -0,0 +1,257 @@
+#include "BMP_load.h"

+#include <stdio.h>

+#include <string.h>
+#include <stdlib.h>

+#include <math.h>

+

+#define BITMAP_ID   0x4D42

+

+

+/// Bitmap file header structure.

+typedef struct

+{

+    U16 type;           // Specifies the image type; must be BM (0x4D42).

+    U32 size;           // Specifies the size in bytes of the bitmap file.

+    U32 reserved;       // Reserved; must be zero.

+    U32 offBits;        // Specifies the offset, in bytes, from the BitmapFileHeader structure to the bitmap bits.

+}

+BitmapFileHeader;

+

+

+/// Bitmap info header structure.

+typedef struct

+{

+    U32 size;           // Specifies the number of bytes required by the structure.

+    U32 width;          // Specifies the width of the bitmap, in pixels.

+    U32 height;         // Specifies the height of the bitmap, in pixels.

+    U16 planes;         // Specifies the number of color planes; must be 1.

+    U16 bitCount;       // Specifies the number of bits per pixel; must be 1, 4, 16, 24, or 32.

+    U32 compression;    // Specifies the type of compression.

+    U32 imageSize;      // Specifies the size of the image in bytes.

+    U32 xPelsPerMeter;  // Specifies the number of pixels per meter on the x axis.

+    U32 yPelsPerMeter;  // Specifies the number of pixels per meter on the y axis.

+    U32 clrUsed;        // Specifies the number of colours used by the bitmap.

+    U32 clrImportant;   // Specifies the number of colours that are important.

+}

+BitmapInfoHeader;

+

+

+static void safe_free (void* ptr)

+{

+    if (ptr) free (ptr);

+}

+

+

+static Image_error_code read_raw_data(

+    FILE* filePtr, const BitmapFileHeader* bitmapFileHeader,

+    const BitmapInfoHeader* bitmapInfoHeader, U8** data)

+{

+    U8* bitmapImage;

+    U8* auxrow;

+    size_t row_size  = bitmapInfoHeader->width * 3;

+    size_t numBytes = bitmapInfoHeader->height * row_size;

+    size_t bytes_read;

+    

+    // Allocate memory for the bitmap data and the auxiliary row.

+    bitmapImage = (U8*) malloc (numBytes);

+    auxrow = (U8*) malloc (row_size);

+    if (!bitmapImage || !auxrow)

+    {

+        safe_free (bitmapImage);

+        safe_free (auxrow);

+        return Image_Memory_Allocation_Error;

+    }

+    

+    // Move the file pointer to the beginning of bitmap data and read the data.

+    fseek(filePtr, bitmapFileHeader->offBits, SEEK_SET);

+    bytes_read = fread(bitmapImage, 1, numBytes, filePtr);

+    if (bytes_read != numBytes)

+    {

+        free(bitmapImage);

+        return Image_Read_Error;

+    }

+    

+    size_t i;

+    

+    // Reverse rows.

+    /*size_t h = bitmapInfoHeader->height / 2;

+    for (i = 0; i < h; ++i)

+    {

+        U8* row1 = bitmapImage + i * row_size;

+        U8* row2 = bitmapImage + (bitmapInfoHeader->height - i - 1) * row_size;

+        

+        memcpy (auxrow, row1, row_size);

+        memcpy (row1, row2, row_size);

+        memcpy (row2, auxrow, row_size);

+    }*/

+    

+    // Swap B and R channels. BGR -> RGB.

+    for (i = 0; i < bytes_read; i+= 3)

+    {

+        U8 tmp = bitmapImage[i];

+        bitmapImage[i] = bitmapImage[i+2];

+        bitmapImage[i+2] = tmp;

+    }

+    

+    *data = bitmapImage;

+

+    return Image_Success;

+}

+

+

+static Image_error_code read_paletised_data8

+    (FILE* filePtr, const BitmapInfoHeader *bitmapInfoHeader, U8** data)

+{

+    U8* bitmapImage;

+    U8* palette;

+    U8* colourIndices;

+    size_t bytes_read;

+    

+    size_t paletteSize = pow(2, bitmapInfoHeader->bitCount) * 4;

+    size_t colourIndicesSize = bitmapInfoHeader->width * bitmapInfoHeader->height;

+    int bitmapImageSize = colourIndicesSize * 3;

+    

+    // Save memory for the palette, colour indices and bitmap image.

+    palette = (U8*) malloc (paletteSize);

+    colourIndices = (U8*) malloc(colourIndicesSize);

+    bitmapImage = (U8*) malloc(bitmapImageSize);

+    if (!palette | !colourIndices || !bitmapImage)

+    {

+        safe_free (palette);

+        safe_free (colourIndices);

+        safe_free (bitmapImage);

+        return Image_Memory_Allocation_Error;

+    }

+    

+    // Read the colour palette.

+    bytes_read = fread(palette, 1, paletteSize, filePtr);

+    if (bytes_read != paletteSize) return Image_Read_Error;

+    

+    // Read the colour indices.

+    bytes_read = fread(colourIndices, 1, colourIndicesSize, filePtr);

+    if (bytes_read != colourIndicesSize) return Image_Read_Error;

+    

+    // Decode the image data.

+    U8* imgptr = &bitmapImage[bitmapImageSize - (bitmapInfoHeader->width * 4)];

+    

+    size_t i;

+    for (i = 0;  i < colourIndicesSize; i++)

+    {

+        int index = colourIndices[i];

+        

+        memcpy(imgptr, (const void*) &palette[index * 4], 3);

+        imgptr += 3;

+        

+        if (!((i+1) % bitmapInfoHeader->width))

+        {

+            imgptr -= (bitmapInfoHeader->width * 4 * 2);

+        }

+    }

+    

+    free(palette);

+    free(colourIndices);

+    

+    *data = bitmapImage;

+    

+    return Image_Success;

+}

+

+

+Image_error_code BMP_load (const char* filename, Image* image)

+{

+    FILE* filePtr;

+    BitmapFileHeader bitmapFileHeader;

+    BitmapInfoHeader bitmapInfoHeader;

+    U8 buf[40];

+    U8* data;

+    

+    // Open the file in binary read-only mode.

+    filePtr = fopen(filename, "rb");

+    if (!filePtr) return Image_File_Not_Found;

+    

+    if ((fread(buf, 14, 1, filePtr)) != 1)

+    {

+        fclose(filePtr);

+        return Image_Read_Error;

+    }

+

+    bitmapFileHeader.type       = *((U16*)buf);

+    bitmapFileHeader.size       = *((U32*)(buf+2));

+    bitmapFileHeader.reserved   = *((U32*)(buf+6));

+    bitmapFileHeader.offBits    = *((U32*)(buf+10));

+    

+    // Check that this is in fact a BMP file.

+    if (bitmapFileHeader.type != BITMAP_ID)

+    {

+        fprintf(stderr, "Not a valid BMP file\n");

+        fclose(filePtr);

+        return Image_Invalid_Format;

+    }

+    

+    if ((fread(&buf, 40, 1, filePtr)) != 1)

+    {

+        fclose(filePtr);

+        return Image_Read_Error;

+    }

+    

+    bitmapInfoHeader.size           = *((U32*)(buf));

+    bitmapInfoHeader.width          = *((U32*)(buf+4));

+    bitmapInfoHeader.height         = *((U32*)(buf+8));

+    bitmapInfoHeader.planes         = *((U16*)(buf+12));

+    bitmapInfoHeader.bitCount       = *((U16*)(buf+14));

+    bitmapInfoHeader.compression    = *((U32*)(buf+16));

+    bitmapInfoHeader.imageSize      = *((U32*)(buf+20));

+    bitmapInfoHeader.xPelsPerMeter  = *((U32*)(buf+24));

+    bitmapInfoHeader.yPelsPerMeter  = *((U32*)(buf+28));

+    bitmapInfoHeader.clrUsed        = *((U32*)(buf+32));

+    bitmapInfoHeader.clrImportant   = *((U32*)(buf+36));

+    

+    // Check that no compression is used.

+    // Compression is not supported at the moment.

+    if (bitmapInfoHeader.compression != 0)

+    {

+        fprintf(stderr, "Compression not supported\n");

+        fclose(filePtr);

+        return Image_Invalid_Format;

+    }

+    

+    // Check that this is a Windows BMP file.

+    // Other formats are not supported.

+    if (bitmapInfoHeader.size != 40)

+    {

+        fprintf(stderr, "Only Windows BMP files supported\n");

+        fclose(filePtr);

+        return Image_Invalid_Format;

+    }

+    

+    Image_error_code status;

+    

+    if (bitmapInfoHeader.bitCount == 8)

+    {

+        // The BMP file uses a colour palette.

+        // We are already positioned at the colour palette.

+        status = read_paletised_data8 (filePtr, &bitmapInfoHeader, &data);

+    }

+    else if (bitmapInfoHeader.bitCount >= 16)

+    {

+        // The BMP file uses no colour palette.

+        status = read_raw_data (filePtr, &bitmapFileHeader, &bitmapInfoHeader, &data);

+    }

+    else

+    {

+        fprintf(stderr, "Only 24-bit and 16-bit palette images supported\n");

+        fclose(filePtr);

+        return Image_Invalid_Format;

+    }

+    

+    fclose(filePtr);

+    

+    if (data == 0) return status;

+    

+    image->width  = bitmapInfoHeader.width;

+    image->height = bitmapInfoHeader.height;

+    image->bpp    = 3;

+    image->pixels = data;

+    

+    return Image_Success;

+}

diff --git a/Spear/Assets/Image/BMP/BMP_load.h b/Spear/Assets/Image/BMP/BMP_load.h
new file mode 100644
index 0000000..f4ad32f
--- /dev/null
+++ b/Spear/Assets/Image/BMP/BMP_load.h
@@ -0,0 +1,23 @@
+#ifndef _BMP_LOAD_H

+#define _BMP_LOAD_H
+
+
+#include "../Image.h"

+#include "../Image_error_code.h"

+

+

+#ifdef __cplusplus

+extern "C" {

+#endif

+

+
+/// Loads the BMP file specified by the given string.
+/// (0,0) corresponds to the top left corner of the image.

+Image_error_code BMP_load (const char* filename, Image* image);
+

+

+#ifdef __cplusplus

+}

+#endif

+

+#endif // _BMP_LOAD_H

diff --git a/Spear/Assets/Image/Image.c b/Spear/Assets/Image/Image.c
new file mode 100644
index 0000000..9abebe2
--- /dev/null
+++ b/Spear/Assets/Image/Image.c
@@ -0,0 +1,8 @@
+#include "Image.h"
+#include <stdlib.h>
+
+
+void image_free (Image* image)
+{
+    free (image->pixels);
+} 
diff --git a/Spear/Assets/Image/Image.h b/Spear/Assets/Image/Image.h
new file mode 100644
index 0000000..bffdd97
--- /dev/null
+++ b/Spear/Assets/Image/Image.h
@@ -0,0 +1,32 @@
+#ifndef _SPEAR_IMAGE_H
+#define _SPEAR_IMAGE_H
+
+#include "sys_types.h"
+
+
+typedef struct
+{
+    int width;
+    int height;
+    int bpp;    // Bits per pixel.
+                // If bpp = 3 then format = RGB.
+                // If bpp = 4 then format = RGBA.
+    U8* pixels;
+}
+Image;
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/// Frees the given Image from memory.
+/// The 'image' pointer itself is not freed.
+void image_free (Image* image);
+
+#ifdef __cplusplus
+}
+#endif
+
+
+#endif // _SPEAR_IMAGE_H
diff --git a/Spear/Assets/Image/Image_error_code.h b/Spear/Assets/Image/Image_error_code.h
new file mode 100644
index 0000000..9e78aeb
--- /dev/null
+++ b/Spear/Assets/Image/Image_error_code.h
@@ -0,0 +1,15 @@
+#ifndef _SPEAR_IMAGE_ERROR_CODE_H
+#define _SPEAR_IMAGE_ERROR_CODE_H
+
+typedef enum
+{
+    Image_Success,
+    Image_Read_Error,
+    Image_Memory_Allocation_Error,
+    Image_File_Not_Found,
+    Image_Invalid_Format,
+    Image_No_Suitable_Loader,
+}
+Image_error_code;
+
+#endif // _SPEAR_IMAGE_ERROR_CODE_H
diff --git a/Spear/Assets/Image/sys_types.h b/Spear/Assets/Image/sys_types.h
new file mode 100644
index 0000000..e4eb251
--- /dev/null
+++ b/Spear/Assets/Image/sys_types.h
@@ -0,0 +1,16 @@
+#ifndef _SPEAR_SYS_TYPES_H
+#define _SPEAR_SYS_TYPES_H
+
+#include <stdint.h>
+
+typedef int8_t   I8;
+typedef int16_t  I16;
+typedef int32_t  I32;
+typedef int64_t  I64;
+typedef uint8_t  U8;
+typedef uint16_t U16;
+typedef uint32_t U32;
+typedef uint64_t U64;
+
+#endif // _SPEAR_SYS_TYPES_H
+
diff --git a/Spear/Assets/Model.hsc b/Spear/Assets/Model.hsc
new file mode 100644
index 0000000..e8eff0f
--- /dev/null
+++ b/Spear/Assets/Model.hsc
@@ -0,0 +1,334 @@
+{-# LANGUAGE CPP, ForeignFunctionInterface #-}
+
+module Spear.Assets.Model
+(
+    -- * Data types
+    ModelErrorCode
+,   Vec3
+,   TexCoord
+,   CModel(..)
+,   Animation(..)
+,   Model
+    -- * Loading and unloading
+,   loadModel
+,   releaseModel
+    -- * Accessors
+,   animated
+,   vertices
+,   normals
+,   texCoords
+,   triangles
+,   skins
+,   numFrames
+,   numVertices
+,   numTriangles
+,   numTexCoords
+,   numSkins
+,   cmodel
+,   animation
+,   animationByName
+,   numAnimations
+    -- * Manipulation
+,   transform
+)
+where
+
+
+import Spear.Setup
+import qualified Spear.Math.Matrix4 as M4
+import qualified Spear.Math.Matrix3 as M3
+import Spear.Math.MatrixUtils
+
+import qualified Data.ByteString.Char8 as B
+import Data.Char (toLower)
+import Data.List (splitAt, elemIndex)
+import qualified Data.Vector as V
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.Types
+import Foreign.C.String
+import Foreign.Marshal.Utils as Foreign (with)
+import Foreign.Marshal.Alloc (alloca, allocaBytes)
+import Foreign.Marshal.Array (copyArray, peekArray)
+import Unsafe.Coerce (unsafeCoerce)
+
+
+#include "Model.h"
+#include "MD2/MD2_load.h"
+#include "OBJ/OBJ_load.h"
+
+
+data ModelErrorCode
+    = ModelSuccess
+    | ModelReadError
+    | ModelMemoryAllocationError
+    | ModelFileNotFound
+    | ModelFileMismatch
+    | ModelNoSuitableLoader
+    deriving (Eq, Enum, Show)
+
+
+data Vec3 = Vec3 !CFloat !CFloat !CFloat
+
+data TexCoord = TexCoord !CFloat !CFloat
+
+data Triangle = Triangle !CUShort !CUShort !CUShort !CUShort !CUShort !CUShort
+
+data Skin = Skin !(Ptr Char)
+
+data CAnimation = CAnimation !B.ByteString !CUInt !CUInt
+
+
+-- | The model's underlying representation.
+data CModel = CModel
+    { cVerts       :: Ptr Vec3       -- ^ Pointer to an array of 'cnFrames' * 'cnVerts' vertices.
+    , cNormals     :: Ptr Vec3       -- ^ Pointer to an array of 'cnFrames' * cnVerts normals.
+    , cTexCoords   :: Ptr TexCoord   -- ^ Pointer to an array of 'cnTris' texture coordinates.
+    , cTris        :: Ptr Triangle   -- ^ Pointer to an array of 'cnTris' triangles.
+    , cSkins       :: Ptr Skin       -- ^ Pointer to an array of 'cnSkins' skins.
+    , cAnimations  :: Ptr CAnimation -- ^ Pointer to an array of 'cnAnimations' animations.
+    , cnFrames     :: CUInt          -- ^ Number of frames.
+    , cnVerts      :: CUInt          -- ^ Number of vertices per frame.
+    , cnTris       :: CUInt          -- ^ Number of triangles in one frame.
+    , cnTexCoords  :: CUInt          -- ^ Number of texture coordinates in one frame.
+    , cnSkins      :: CUInt          -- ^ Number of skins.
+    , cnAnimations :: CUInt          -- ^ Number of animations.
+    }
+
+
+instance Storable CModel where
+    sizeOf _    = #{size Model}
+    alignment _ = alignment (undefined :: CUInt)
+
+    peek ptr = do
+        vertices      <- #{peek Model, vertices}      ptr
+        normals       <- #{peek Model, normals}       ptr
+        texCoords     <- #{peek Model, texCoords}     ptr
+        triangles     <- #{peek Model, triangles}     ptr
+        skins         <- #{peek Model, skins}         ptr
+        animations    <- #{peek Model, animations}    ptr
+        numFrames     <- #{peek Model, numFrames}     ptr
+        numVertices   <- #{peek Model, numVertices}   ptr
+        numTriangles  <- #{peek Model, numTriangles}  ptr
+        numTexCoords  <- #{peek Model, numTexCoords}  ptr
+        numSkins      <- #{peek Model, numSkins}      ptr
+        numAnimations <- #{peek Model, numAnimations} ptr
+        return $
+            CModel vertices normals texCoords triangles skins animations
+                   numFrames numVertices numTriangles numTexCoords numSkins numAnimations
+
+    poke ptr
+        (CModel verts normals texCoords tris skins animations
+         numFrames numVerts numTris numTex numSkins numAnimations) = do
+            #{poke Model, vertices}      ptr verts
+            #{poke Model, normals}       ptr normals
+            #{poke Model, texCoords}     ptr texCoords
+            #{poke Model, triangles}     ptr tris
+            #{poke Model, skins}         ptr skins
+            #{poke Model, animations}    ptr animations
+            #{poke Model, numFrames}     ptr numFrames
+            #{poke Model, numVertices}   ptr numVerts
+            #{poke Model, numTriangles}  ptr numTris
+            #{poke Model, numTexCoords}  ptr numTex
+            #{poke Model, numSkins}      ptr numSkins
+            #{poke Model, numAnimations} ptr numAnimations
+
+
+-- data CAnimation = CAnimation !(Ptr CChar) !CUInt !CUInt
+instance Storable CAnimation where
+    sizeOf _    = #{size animation}
+    alignment _ = alignment (undefined :: CUInt)
+
+    peek ptr = do
+        name  <- B.packCString (unsafeCoerce ptr)
+        start <- #{peek animation, start} ptr
+        end   <- #{peek animation, end}   ptr
+        return $ CAnimation name start end
+
+    poke ptr (CAnimation name start end) = do
+        B.useAsCStringLen name $ \(sptr, len) -> copyArray (unsafeCoerce ptr) sptr len
+        #{poke animation, start} ptr start
+        #{poke animation, end}   ptr end
+
+
+data Animation = Animation
+    { name  :: String
+    , start :: Int
+    , end   :: Int
+    }
+
+
+-- | A model 'Resource'.
+data Model = Model
+    { modelData   :: CModel
+    , mAnimations :: V.Vector Animation
+    , rkey        :: Resource
+    }
+
+
+foreign import ccall "Model.h model_free"
+    model_free :: Ptr CModel -> IO ()
+
+
+foreign import ccall "MD2_load.h MD2_load"
+    md2_load' :: Ptr CChar -> CChar -> CChar -> Ptr CModel -> IO Int
+
+
+foreign import ccall "OBJ_load.h OBJ_load"
+    obj_load' :: Ptr CChar -> CChar -> CChar -> Ptr CModel -> IO Int
+
+
+md2_load :: Ptr CChar -> CChar -> CChar -> Ptr CModel -> IO ModelErrorCode
+md2_load file clockwise leftHanded model =
+    md2_load' file clockwise leftHanded model >>= \code -> return . toEnum $ code
+
+
+obj_load :: Ptr CChar -> CChar -> CChar -> Ptr CModel -> IO ModelErrorCode
+obj_load file clockwise leftHanded model =
+    obj_load' file clockwise leftHanded model >>= \code -> return . toEnum $ code
+
+
+-- | Load the model specified by the given 'FilePath'.
+loadModel :: FilePath -> Setup Model
+loadModel file = do
+    dotPos <- case elemIndex '.' file of
+            Nothing -> setupError $ "file name has no extension: " ++ file
+            Just p  -> return p
+
+    let ext = map toLower . tail . snd $ splitAt dotPos file
+
+    result <- setupIO . alloca $ \ptr -> do
+        status <- withCString file $ \fileCstr -> do
+            case ext of
+                "md2" -> md2_load fileCstr 0 0 ptr
+                "obj" -> obj_load fileCstr 0 0 ptr
+                _     -> return ModelNoSuitableLoader
+
+        case status of
+            ModelSuccess                -> peek ptr >>= return . Right
+            ModelReadError              -> return . Left $ "read error"
+            ModelMemoryAllocationError  -> return . Left $ "memory allocation error"
+            ModelFileNotFound           -> return . Left $ "file not found"
+            ModelFileMismatch           -> return . Left $ "file mismatch"
+            ModelNoSuitableLoader       -> return . Left $ "no suitable loader for extension " ++ ext
+
+    case result of
+        Right model ->
+            let numAnimations = fromIntegral $ cnAnimations model
+            in register (freeModel model) >>=
+                case numAnimations of
+                    0 -> return . Model model V.empty
+                    _ -> \key -> setupIO $ do
+                        canims <- peekArray numAnimations $ cAnimations model
+                        let animations = V.fromList $ fmap fromCAnimation canims
+                        return $ Model model animations key
+
+        Left  err   -> setupError $ "loadModel: " ++ err
+
+
+fromCAnimation :: CAnimation -> Animation
+fromCAnimation (CAnimation cname start end) =
+    Animation (B.unpack cname) (fromIntegral start) (fromIntegral end)
+
+
+-- | Release the given 'Model'.
+releaseModel :: Model -> Setup ()
+releaseModel = release . rkey
+
+
+-- | Free the given 'CModel'.
+freeModel :: CModel -> IO ()
+freeModel model = Foreign.with model model_free
+
+
+-- | Return 'True' if the given 'Model' is animated, 'False' otherwise.
+animated :: Model -> Bool
+animated = (>1) . numFrames
+
+
+-- | Return the given 'Model's vertices.
+vertices :: Model -> Ptr Vec3
+vertices = cVerts . modelData
+
+
+-- | Return the given 'Model's normals.
+normals :: Model -> Ptr Vec3
+normals = cNormals . modelData
+
+
+-- | Return the given 'Model's texCoords.
+texCoords :: Model -> Ptr TexCoord
+texCoords = cTexCoords . modelData
+
+
+-- | Return the given 'Model's triangles.
+triangles :: Model -> Ptr Triangle
+triangles = cTris . modelData
+
+
+-- | Return the given 'Model's skins.
+skins :: Model -> Ptr Skin
+skins = cSkins . modelData
+
+
+-- | Return the given 'Model's number of frames.
+numFrames :: Model -> Int
+numFrames = fromIntegral . cnFrames . modelData
+
+
+-- | Return the given 'Model's number of vertices.
+numVertices :: Model -> Int
+numVertices = fromIntegral . cnVerts . modelData
+
+
+-- | Return the given 'Model's number of triangles.
+numTriangles :: Model -> Int
+numTriangles = fromIntegral . cnTris . modelData
+
+
+-- | Return the given 'Model's number of texture coordinates.
+numTexCoords :: Model -> Int
+numTexCoords = fromIntegral . cnTexCoords . modelData
+
+
+-- | Return the given 'Model's number of skins.
+numSkins :: Model -> Int
+numSkins = fromIntegral . cnSkins . modelData
+
+
+-- | Return the underlying 'CModel'.
+cmodel :: Model -> CModel
+cmodel = modelData
+
+
+-- | Return the model's ith animation.
+animation :: Model -> Int -> Animation
+animation model i = mAnimations model V.! i
+
+
+-- | Return the animation specified by the given string.
+animationByName :: Model -> String -> Maybe Animation
+animationByName model anim = V.find ((==) anim . name) $ mAnimations model
+
+
+-- | Return the number of animations in the given 'Model'.
+numAnimations :: Model -> Int
+numAnimations = V.length . mAnimations
+
+
+-- | Transform the given 'Model's vertices with the given matrix.
+transform :: M4.Matrix4 -> Model -> IO ()
+transform mat (Model model _ _) =
+    allocaBytes (16*sizeFloat) $ \matPtr ->
+    allocaBytes (9*sizeFloat)  $ \normalPtr ->
+    with model $ \modelPtr -> do
+        poke matPtr mat
+        poke normalPtr $ fastNormalMatrix mat
+        model_transform modelPtr matPtr normalPtr
+
+
+foreign import ccall "Model.h model_transform"
+    model_transform :: Ptr CModel -> Ptr M4.Matrix4 -> Ptr M3.Matrix3 -> IO ()
+
+
+sizeFloat = #{size float}
diff --git a/Spear/Assets/Model/MD2/MD2_load.c b/Spear/Assets/Model/MD2/MD2_load.c
new file mode 100644
index 0000000..238bc9a
--- /dev/null
+++ b/Spear/Assets/Model/MD2/MD2_load.c
@@ -0,0 +1,483 @@
+#include "MD2_load.h"
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h> // malloc
+#include <math.h> // sqrt
+
+//! The MD2 magic number used to identify MD2 files.
+#define MD2_ID  0x32504449
+
+//! Limit values for the MD2 file format.
+#define MD2_MAX_TRIANGLES   4096
+#define MD2_MAX_VERTICES    2048
+#define MD2_MAX_TEXCOORDS   2048
+#define MD2_MAX_FRAMES       512
+#define MD2_MAX_SKINS         32
+
+
+/// MD2 file header.
+typedef struct
+{
+    I32     magic;                  /// The magic number "IDP2"; 844121161 in decimal; 0x32504449
+    I32     version;                /// Version number, always 8.
+    I32     skinWidth;              /// Width of the skin(s) in pixels.
+    I32     skinHeight;             /// Height of the skin(s) in pixels.
+    I32     frameSize;              /// Size of a single frame in bytes.
+    I32     numSkins;               /// Number of skins.
+    I32     numVertices;            /// Number of vertices in a single frame.
+    I32     numTexCoords;           /// Number of texture coordinates.
+    I32     numTriangles;           /// Number of triangles.
+    I32     numGlCommands;          /// Number of dwords in the Gl command list.
+    I32     numFrames;              /// Number of frames.
+    I32     offsetSkins;            /// Offset from the start of the file to the array of skins.
+    I32     offsetTexCoords;        /// Offset from the start of the file to the array of texture coordinates.
+    I32     offsetTriangles;        /// Offset from the start of the file to the array of triangles.
+    I32     offsetFrames;           /// Offset from the start of the file to the array of frames.
+    I32     offsetGlCommands;       /// Offset from the start of the file to the array of Gl commands.
+    I32     offsetEnd;              /// Offset from the start of the file to the end of the file (the file size).
+}
+md2Header_t;
+
+
+/// Represents a texture coordinate index.
+typedef struct
+{
+    I16 s;
+    I16 t;
+}
+texCoord_t;
+
+
+/// Represents a frame point.
+typedef struct
+{
+    U8 x, y, z;
+    U8 lightNormalIndex;
+}
+vertex_t;
+
+
+/// Represents a single frame.
+typedef struct
+{
+    vec3     scale;
+    vec3     translate;
+    I8        name[16];
+    vertex_t vertices[1];
+}
+frame_t;
+
+
+static void normalise (vec3* v)
+{
+    float x = v->x;
+    float y = v->y;
+    float z = v->z;
+    float mag = sqrt (x*x + y*y + z*z);
+    mag = mag == 0 ? 1 : mag;
+    v->x = x / mag;
+    v->y = y / mag;
+    v->z = z / mag;
+}
+
+
+// Left handed cross product.
+// a x b = c.
+// (0,1,0) x (1,0,0) = (0,0,-1).
+static void cross (const vec3* a, const vec3* b, vec3* c)
+{
+    c->x = a->y * b->z - a->z * b->y;
+    c->y = a->z * b->x - a->x * b->z;
+    c->z = a->x * b->y - a->y * b->x;
+}
+
+
+static void vec3_sub (const vec3* a, const vec3* b, vec3* out)
+{
+    out->x = a->x - b->x;
+    out->y = a->y - b->y;
+    out->z = a->z - b->z;
+}
+
+
+static void normal (char clockwise, const vec3* p1, const vec3* p2, const vec3* p3, vec3* n)
+{
+    vec3 v1, v2;
+    if (clockwise)
+    {
+        vec3_sub (p3, p2, &v1);
+        vec3_sub (p1, p2, &v2);
+    }
+    else
+    {
+        vec3_sub (p1, p2, &v1);
+        vec3_sub (p3, p2, &v2);
+    }
+    cross (&v1, &v2, n);
+    normalise (n);
+}
+
+
+typedef struct
+{
+    vec3* normals;
+    vec3* base;
+    unsigned int N;
+}
+normal_map;
+
+
+static void normal_map_initialise (normal_map* m, unsigned int N)
+{
+    m->N = N;
+}
+
+
+static void normal_map_clear (normal_map* m, vec3* normals, vec3* base)
+{
+    memset (normals, 0, m->N * sizeof(vec3));
+    m->normals = normals;
+    m->base    = base;
+}
+
+
+static void normal_map_insert (normal_map* m, vec3* vec, vec3 normal)
+{
+    unsigned int i = vec - m->base;
+    vec3* n = m->normals + i;
+    n->x += normal.x;
+    n->y += normal.y;
+    n->z += normal.z;
+}
+
+
+static void compute_normals (normal_map* m, char left_handed)
+{
+    vec3* n = m->normals;
+    unsigned int i;
+    for (i = 0; i < m->N; ++i)
+    {
+        if (!left_handed)
+        {
+            n->x = -n->x;
+            n->y = -n->y;
+            n->z = -n->z;
+        }
+        normalise (n);
+        n++;
+    }
+}
+
+
+static void safe_free (void* ptr)
+{
+    if (ptr) free (ptr);
+}
+
+
+static char frame_equal (const char* name1, const char* name2)
+{
+    char equal = 1;
+    int i;
+
+    if (((name1 == 0) && (name2 != 0)) || ((name1 != 0) && (name2 == 0)))
+    {
+        return 0;
+    }
+
+    for (i = 0; i < 16; ++i)
+    {
+        char c1 = *name1;
+        char c2 = *name2;
+        if ((c1 >= '0' && c1 <= '9') || (c2 >= '0' && c2 <= '9')) break;
+        if (c1 != c2)
+        {
+            equal = 0;
+            break;
+        }
+        if (c1 == '_' || c2 == '_') break;
+        name1++;
+        name2++;
+    }
+    return equal;
+}
+
+
+static void animation_remove_numbers (char* name)
+{
+    int i;
+    for (i = 0; i < 16; ++i)
+    {
+        char c = *name;
+        if (c == 0) break;
+        if (c >= '0' && c <= '9') *name = 0;
+        name++;
+    }
+}
+
+
+Model_error_code MD2_load (const char* filename, char clockwise, char left_handed, Model* model)
+{
+    FILE*       filePtr;
+    vec3*       vertices;
+    vec3*       normals;
+    texCoord*   texCoords;
+    triangle*   triangles;
+    skin*       skins;
+    animation* animations;
+    int i;
+
+    // Open the file for reading.
+    filePtr = fopen(filename, "rb");
+    if (!filePtr) return Model_File_Not_Found;
+
+    // Make sure it is an MD2 file.
+    int magic;
+    if ((fread(&magic, 4, 1, filePtr)) != 1)
+    {
+        fclose(filePtr);
+        return Model_Read_Error;
+    }
+
+    if (magic != MD2_ID) return Model_File_Mismatch;
+
+    // Find out the file size.
+    long int fileSize;
+    fseek(filePtr, 0, SEEK_END);
+    fileSize = ftell(filePtr);
+    fseek(filePtr, 0, SEEK_SET);
+
+    // Allocate a chunk of data to store the file in.
+    char *buffer = (char*) malloc(fileSize);
+    if (!buffer)
+    {
+        fclose(filePtr);
+        return Model_Memory_Allocation_Error;
+    }
+
+    // Read the entire file into memory.
+    if ((fread(buffer, 1, fileSize, filePtr)) != (unsigned int)fileSize)
+    {
+        fclose(filePtr);
+        free(buffer);
+        return Model_Read_Error;
+    }
+
+    // File stream is no longer needed.
+    fclose(filePtr);
+
+    // Set a pointer to the header for parsing.
+    md2Header_t* header = (md2Header_t*) buffer;
+
+    // Compute the number of animations.
+    unsigned numAnimations = 1;
+    int currentFrame;
+    const char* name = 0;
+    for (currentFrame = 0; currentFrame < header->numFrames; ++currentFrame)
+    {
+        frame_t* frame = (frame_t*) &buffer[header->offsetFrames + currentFrame * header->frameSize];
+        if (name == 0)
+        {
+            name = frame->name;
+        }
+        else if (!frame_equal(name, frame->name))
+        {
+            numAnimations++;
+            name = frame->name;
+        }
+    }
+
+    // Allocate memory for arrays.
+    vertices   = (vec3*) malloc(sizeof(vec3) * header->numVertices * header->numFrames);
+    normals    = (vec3*) malloc(sizeof(vec3) * header->numVertices * header->numFrames);
+    texCoords  = (texCoord*) malloc(sizeof(texCoord) * header->numTexCoords);
+    triangles  = (triangle*) malloc(sizeof(triangle) * header->numTriangles);
+    skins      = (skin*) malloc(sizeof(skin) * header->numSkins);
+    animations = (animation*) malloc (numAnimations * sizeof(animation));
+
+    if (!vertices || !normals || !texCoords || !triangles || !skins || !animations)
+    {
+        safe_free (animations);
+        safe_free (skins);
+        safe_free (triangles);
+        safe_free (texCoords);
+        safe_free (normals);
+        safe_free (vertices);
+        free (buffer);
+        return Model_Memory_Allocation_Error;
+    }
+
+    // Load the model's vertices.
+    // Loop through each frame, grab the vertices that make it up, transform them back
+    // to their real coordinates and store them in the model's vertex array.
+    for (currentFrame = 0; currentFrame < header->numFrames; ++currentFrame)
+    {
+        // Set a frame pointer to the current frame.
+        frame_t* frame = (frame_t*) &buffer[header->offsetFrames + currentFrame * header->frameSize];
+
+        // Set a vertex pointer to the model's vertex array, at the appropiate position.
+        vec3* vert = &vertices[currentFrame * header->numVertices];
+
+        // Now parse those vertices and transform them back.
+        int currentVertex;
+        for (currentVertex = 0; currentVertex != header->numVertices; ++currentVertex)
+        {
+            vert[currentVertex].x = frame->vertices[currentVertex].x * frame->scale.x + frame->translate.x;
+            vert[currentVertex].y = frame->vertices[currentVertex].y * frame->scale.y + frame->translate.y;
+            vert[currentVertex].z = frame->vertices[currentVertex].z * frame->scale.z + frame->translate.z;
+        }
+    }
+
+    // Load the model's triangles.
+
+    // Set a pointer to the triangles array in the buffer.
+    triangle* t = (triangle*) &buffer[header->offsetTriangles];
+
+    if (clockwise)
+    {
+        for (i = 0; i < header->numTriangles; ++i)
+        {
+            triangles[i].vertexIndices[0]  = t[i].vertexIndices[0];
+            triangles[i].vertexIndices[1]  = t[i].vertexIndices[1];
+            triangles[i].vertexIndices[2]  = t[i].vertexIndices[2];
+
+            triangles[i].textureIndices[0] = t[i].textureIndices[0];
+            triangles[i].textureIndices[1] = t[i].textureIndices[1];
+            triangles[i].textureIndices[2] = t[i].textureIndices[2];
+        }
+    }
+    else
+    {
+        for (i = 0; i < header->numTriangles; ++i)
+        {
+            triangles[i].vertexIndices[0]  = t[i].vertexIndices[0];
+            triangles[i].vertexIndices[1]  = t[i].vertexIndices[2];
+            triangles[i].vertexIndices[2]  = t[i].vertexIndices[1];
+
+            triangles[i].textureIndices[0] = t[i].textureIndices[0];
+            triangles[i].textureIndices[1] = t[i].textureIndices[2];
+            triangles[i].textureIndices[2] = t[i].textureIndices[1];
+        }
+    }
+
+    // Load the texture coordinates.
+    float sw = (float) header->skinWidth;
+    float sh = (float) header->skinHeight;
+    texCoord_t* texc = (texCoord_t*) &buffer[header->offsetTexCoords];
+    for (i = 0; i < header->numTexCoords; ++i)
+    {
+        texCoords[i].s  = (float)texc->s / sw;
+        texCoords[i].t  = 1.0f - (float)texc->t / sh;
+        texc++;
+    }
+
+    // Iterate over every frame and compute normals for every triangle.
+    vec3 n;
+
+    normal_map map;
+    normal_map_initialise (&map, header->numVertices);
+
+    for (currentFrame = 0; currentFrame < header->numFrames; ++currentFrame)
+    {
+        // Set a pointer to the triangle array.
+        triangle* t = triangles;
+
+        // Set a pointer to the vertex array at the appropiate position.
+        vec3* vertex_array = vertices + header->numVertices * currentFrame;
+
+        // Set a pointer to the normals array at the appropiate position.
+        vec3* normals_ptr = normals + header->numVertices * currentFrame;
+
+        normal_map_clear (&map, normals_ptr, vertex_array);
+
+        for (i = 0; i < header->numTriangles; ++i)
+        {
+            // Compute face normal.
+            vec3* v0 = &vertex_array[t->vertexIndices[0]];
+            vec3* v1 = &vertex_array[t->vertexIndices[1]];
+            vec3* v2 = &vertex_array[t->vertexIndices[2]];
+            normal (clockwise, v0, v1, v2, &n);
+
+            // Add face normal to each of the face's vertices.
+            normal_map_insert (&map, v0, n);
+            normal_map_insert (&map, v1, n);
+            normal_map_insert (&map, v2, n);
+
+            t++;
+        }
+
+        compute_normals (&map, left_handed);
+    }
+
+    // Load the model's skins.
+    const skin* s = (const skin*) &buffer[header->offsetSkins];
+    for (i = 0; i < header->numSkins; ++i)
+    {
+        memcpy (skins[i].name, s->name, 64);
+        s++;
+    }
+
+    // Load the model's animations.
+    unsigned start = 0;
+    name = 0;
+    animation* currentAnimation = animations;
+    for (currentFrame = 0; currentFrame < header->numFrames; ++currentFrame)
+    {
+        frame_t* frame = (frame_t*) &buffer[header->offsetFrames + currentFrame * header->frameSize];
+        if (name == 0)
+        {
+            name = frame->name;
+        }
+        else if (!frame_equal(name, frame->name))
+        {
+            memcpy (currentAnimation->name, name, 16);
+            animation_remove_numbers (currentAnimation->name);
+            currentAnimation->start = start;
+            currentAnimation->end   = currentFrame-1;
+            if (currentAnimation != animations)
+            {
+                animation* prev = currentAnimation;
+                prev--;
+                prev->end = start-1;
+            }
+            name = frame->name;
+            currentAnimation++;
+            start = currentFrame;
+        }
+    }
+    currentAnimation = animations + numAnimations - 1;
+    memcpy (currentAnimation->name, name, 16);
+    animation_remove_numbers (currentAnimation->name);
+    currentAnimation->start = start;
+    currentAnimation->end   = header->numFrames-1;
+
+    printf ("finished loading model %s\n", filename);
+    printf ("numAnimations: %u\n", numAnimations);
+    printf ("animations: %p\n", animations);
+
+    currentAnimation = animations;
+    for (i = 0; i < numAnimations; ++i)
+    {
+        printf ("Animation %d, name: %s, start: %d, end %d\n",
+            i, currentAnimation->name, currentAnimation->start, currentAnimation->end);
+        currentAnimation++;
+    }
+
+    model->vertices   = vertices;
+    model->normals    = normals;
+    model->texCoords  = texCoords;
+    model->triangles  = triangles;
+    model->skins      = skins;
+    model->animations = animations;
+
+    model->numFrames     = header->numFrames;
+    model->numVertices   = header->numVertices;
+    model->numTriangles  = header->numTriangles;
+    model->numTexCoords  = header->numTexCoords;
+    model->numSkins      = header->numSkins;
+    model->numAnimations = numAnimations;
+
+    free(buffer);
+
+    return Model_Success;
+}
diff --git a/Spear/Assets/Model/MD2/MD2_load.h b/Spear/Assets/Model/MD2/MD2_load.h
new file mode 100644
index 0000000..75e1b26
--- /dev/null
+++ b/Spear/Assets/Model/MD2/MD2_load.h
@@ -0,0 +1,23 @@
+#ifndef _MD2_LOAD_H

+#define _MD2_LOAD_H

+

+#include "../Model.h"

+#include "../Model_error_code.h"

+

+

+#ifdef __cplusplus

+extern "C" {

+#endif

+

+/// Loads the MD2 file specified by the given string.

+/// 'clockwise' should be 1 if you plan to render the model in a clockwise environment, 0 otherwise.

+/// 'smooth_normals' should be 1 if you want the loader to compute smooth normals, 0 otherwise.

+Model_error_code MD2_load (const char* filename, char clockwise, char left_handed, Model* model);

+

+#ifdef __cplusplus

+}

+#endif

+

+

+#endif // _MD2_LOAD_H

+

diff --git a/Spear/Assets/Model/Model.c b/Spear/Assets/Model/Model.c
new file mode 100644
index 0000000..94959e9
--- /dev/null
+++ b/Spear/Assets/Model/Model.c
@@ -0,0 +1,73 @@
+#include "Model.h"
+#include <stdlib.h> // free
+#include <math.h>
+
+
+#define TO_RAD M_PI / 180.0
+
+
+static void safe_free (void* ptr)
+{
+    if (ptr)
+    {
+        free (ptr);
+        ptr = 0;
+    }
+}
+
+
+void model_free (Model* model)
+{
+    safe_free (model->vertices);
+    safe_free (model->normals);
+    safe_free (model->texCoords);
+    safe_free (model->triangles);
+    safe_free (model->skins);
+}
+
+
+static void mul (float m[16], vec3* v)
+{
+    float x = v->x;
+    float y = v->y;
+    float z = v->z;
+    v->x = x*m[0] + y*m[4] + z*m[8]  + m[12];
+    v->y = x*m[1] + y*m[5] + z*m[9]  + m[13];
+    v->z = x*m[2] + y*m[6] + z*m[10] + m[14];
+}
+
+
+static void mul_normal (float m[9], vec3* n)
+{
+    float x = n->x;
+    float y = n->y;
+    float z = n->z;
+    n->x = x*m[0] + y*m[3] + z*m[6];
+    n->y = x*m[1] + y*m[4] + z*m[7];
+    n->z = x*m[2] + y*m[5] + z*m[8];
+    x = n->x;
+    y = n->y;
+    z = n->z;
+    float mag = sqrt(x*x + y*y + z*z);
+    mag = mag == 0.0 ? 1.0 : mag;
+    n->x /= mag;
+    n->y /= mag;
+    n->z /= mag;
+}
+
+
+void model_transform (Model* model, float mat[16], float normal[9])
+{
+    unsigned i = 0;
+    unsigned j = model->numVertices * model->numFrames;
+    vec3* v = model->vertices;
+    vec3* n = model->normals;
+    
+    for (; i < j; ++i)
+    {
+        mul (mat, v);
+        mul_normal (normal, n);
+        v++;
+        n++;
+    }
+}
diff --git a/Spear/Assets/Model/Model.h b/Spear/Assets/Model/Model.h
new file mode 100644
index 0000000..f23377a
--- /dev/null
+++ b/Spear/Assets/Model/Model.h
@@ -0,0 +1,79 @@
+#ifndef _SPEAR_MODEL_H
+#define _SPEAR_MODEL_H
+
+#include "sys_types.h"
+
+
+typedef struct
+{
+    char name[64];
+}
+skin;
+
+
+typedef struct
+{
+    float x, y, z;
+}
+vec3;
+
+
+typedef struct
+{
+    float s, t;
+}
+texCoord;
+
+
+typedef struct
+{
+    U16 vertexIndices[3];
+    U16 textureIndices[3];
+}
+triangle;
+
+
+typedef struct
+{
+    char name[16];
+    unsigned int start;
+    unsigned int end;
+}
+animation;
+
+
+typedef struct
+{
+    vec3*       vertices;   // One array per frame.
+    vec3*       normals;    // One array per frame. One normal per vertex per frame.
+    texCoord*   texCoords;  // One array for all frames.
+    triangle*   triangles;  // One array for all frames.
+    skin*       skins;      // Holds the model's texture files.
+    animation* animations; // Holds the model's animations.
+    
+    unsigned int numFrames;
+    unsigned int numVertices;   // Number of vertices per frame.
+    unsigned int numTriangles;  // Number of triangles in one frame.
+    unsigned int numTexCoords;  // Number of texture coordinates in one frame.
+    unsigned int numSkins;
+    unsigned int numAnimations;
+}
+Model;
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/// Frees the given Model from memory.
+/// The 'model' pointer itself is not freed.
+void model_free (Model* model);
+
+/// Transform the given Model's vertices by the given matrix.
+void model_transform (Model* model, float mat[16], float normal[9]);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif // _SPEAR_MODEL_H
diff --git a/Spear/Assets/Model/Model_error_code.h b/Spear/Assets/Model/Model_error_code.h
new file mode 100644
index 0000000..a94a31b
--- /dev/null
+++ b/Spear/Assets/Model/Model_error_code.h
@@ -0,0 +1,16 @@
+#ifndef _SPEAR_MODEL_ERROR_CODE_H
+#define _SPEAR_MODEL_ERROR_CODE_H
+
+typedef enum
+{
+    Model_Success,
+    Model_Read_Error,
+    Model_Memory_Allocation_Error,
+    Model_File_Not_Found,
+    Model_File_Mismatch,
+    Model_No_Suitable_Loader,
+}
+Model_error_code;
+
+#endif // _SPEAR_MODEL_ERROR_CODE_H
+
diff --git a/Spear/Assets/Model/OBJ/Makefile b/Spear/Assets/Model/OBJ/Makefile
new file mode 100644
index 0000000..6f9556f
--- /dev/null
+++ b/Spear/Assets/Model/OBJ/Makefile
@@ -0,0 +1,10 @@
+all: OBJ_load.h OBJ_load.cc test.cc ../Model.c
+        g++ -g -c OBJ_load.cc
+        g++ -g -c test.cc
+        g++ -g -c ../Model.c -o Model.o
+        g++ -o test *.o
+
+clean:
+        @rm -f test
+        @rm -f *.o
+        
diff --git a/Spear/Assets/Model/OBJ/OBJ_load.cc b/Spear/Assets/Model/OBJ/OBJ_load.cc
new file mode 100644
index 0000000..bf409b1
--- /dev/null
+++ b/Spear/Assets/Model/OBJ/OBJ_load.cc
@@ -0,0 +1,273 @@
+#include "OBJ_load.h"
+#include <cstdio>
+#include <cstdlib> // free
+#include <cstring> // memcpy
+#include <cmath> // sqrt
+#include <vector>
+
+
+char lastError [128];
+
+
+static void safe_free (void* ptr)
+{
+    if (ptr)
+    {
+        free (ptr);
+        ptr = 0;
+    }
+}
+
+
+// Cross product.
+// (0,1,0) x (1,0,0) = (0,0,-1).
+static void cross (const vec3& a, const vec3& b, vec3& c)
+{
+    c.x = a.y * b.z - a.z * b.y;
+    c.y = a.z * b.x - a.x * b.z;
+    c.z = a.x * b.y - a.y * b.x;
+}
+
+
+static void vec3_sub (const vec3& a, const vec3& b, vec3& out)
+{
+    out.x = a.x - b.x;
+    out.y = a.y - b.y;
+    out.z = a.z - b.z;
+}
+
+
+static void compute_normal (char clockwise, const vec3& p1, const vec3& p2, const vec3& p3, vec3& n)
+{
+    vec3 v1, v2;
+    if (clockwise)
+    {
+        vec3_sub (p3, p2, v1);
+        vec3_sub (p1, p2, v2);
+    }
+    else
+    {
+        vec3_sub (p1, p2, v1);
+        vec3_sub (p3, p2, v2);
+    }
+    cross (v1, v2, n);
+}
+
+
+static void normalise (vec3& v)
+{
+    float x = v.x;
+    float y = v.y;
+    float z = v.z;
+    float mag = sqrt (x*x + y*y + z*z);
+    mag = mag == 0.0f ? 1.0f : mag;
+    v.x /= mag;
+    v.y /= mag;
+    v.z /= mag;
+}
+
+
+static void vec3_add (const vec3& a, vec3& b)
+{
+    b.x += a.x;
+    b.y += a.y;
+    b.z += a.z;
+}
+
+
+static void read_vertex (FILE* file, vec3& vert)
+{
+    fscanf (file, "%f %f", &vert.x, &vert.y);
+    if (fscanf(file, "%f", &vert.z) == 0) vert.z = 0.0f;
+}
+
+
+static void read_normal (FILE* file, vec3& normal)
+{
+    fscanf (file, "%f %f %f", &normal.x, &normal.y, &normal.z);
+}
+
+
+static void read_tex_coord (FILE* file, texCoord& texc)
+{
+    fscanf (file, "%f %f", &texc.s, &texc.t);
+}
+
+
+static void read_face (FILE* file, char clockwise,
+                       const std::vector<vec3>& vertices,
+                       std::vector<vec3>& normals,
+                       std::vector<triangle>& triangles)
+{
+    std::vector<unsigned int> idxs;
+    std::vector<unsigned int> texCoords;
+    
+    unsigned int index;
+    unsigned int normal;
+    unsigned int texc;
+    
+    fscanf (file, "f");
+    
+    while (!feof(file) && fscanf(file, "%d", &index) > 0)
+    {
+        idxs.push_back(index);
+        
+        if (fgetc (file) == '/')
+        {
+            fscanf (file, "%d", &texc);
+            texCoords.push_back(texc);
+        }
+        else fseek (file, -1, SEEK_CUR);
+        
+        if (fgetc (file) == '/')
+        {
+            fscanf (file, "%d", &normal);
+        }
+        else fseek (file, -1, SEEK_CUR);
+    }
+    
+    // Triangulate the face and add its triangles to the triangles vector.
+    triangle tri;
+    tri.vertexIndices[0] = idxs[0] - 1;
+    tri.textureIndices[0] = texCoords[0] - 1;
+    
+    for (int i = 1; i < idxs.size()-1; i++)
+    {
+        tri.vertexIndices[1]  = idxs[i] - 1;
+        tri.textureIndices[1] = texCoords[i] - 1;
+        tri.vertexIndices[2]  = idxs[i+1] - 1;
+        tri.textureIndices[2] = texCoords[i+1] - 1;
+        triangles.push_back(tri);
+    }
+    
+    // Compute face normal and add contribution to each of the face's vertices.
+    unsigned int i0 = tri.vertexIndices[0];
+    unsigned int i1 = tri.vertexIndices[1];
+    unsigned int i2 = tri.vertexIndices[2];
+    
+    vec3 n;
+    compute_normal (clockwise, vertices[i0], vertices[i1], vertices[i2], n);
+    
+    for (int i = 0; i < idxs.size(); i++)
+    {
+        vec3_add (n, normals[idxs[i]-1]);
+    }
+}
+
+
+Model_error_code OBJ_load (const char* filename, char clockwise, char left_handed, Model* model)
+{
+    vec3* norms     = 0;
+    vec3* verts     = 0;
+    texCoord* texcs = 0;
+    triangle* tris  = 0;
+    FILE* file      = 0;
+    
+    try
+    {
+        file = fopen (filename, "r");
+        
+        vec3 vert;
+        vec3 normal;
+        texCoord texc;
+        
+        std::vector<vec3>     vertices;
+        std::vector<vec3>     normals;
+        std::vector<texCoord> texCoords;
+        std::vector<triangle> triangles;
+        
+        while (!feof(file))
+        {
+            switch (fgetc(file))
+            {
+            case 'v':
+                switch (fgetc(file))
+                {
+                case 't':
+                    read_tex_coord (file, texc);
+                    texCoords.push_back(texc);
+                    break;
+                    
+                case 'n':
+                    read_normal (file, normal);
+                    break;
+                    
+                default:
+                    read_vertex (file, vert);
+                    vertices.push_back(vert);
+                    break;
+                }
+                break;
+                
+            case 'f':
+                // If the normals vector has no size, initialise it.
+                if (normals.size() == 0)
+                {
+                    vec3 zero;
+                    zero.x = 0.0f; zero.y = 0.0f; zero.z = 0.0f;
+                    normals = std::vector<vec3>(vertices.size(), zero);
+                }
+                read_face (file, clockwise, vertices, normals, triangles);
+                break;
+            
+            case '#':
+            {
+                int x = 17;
+                while (x != '\n' && x != EOF) x = fgetc(file);
+                break;
+            }
+                
+            default: break;
+            }
+        }
+        
+        fclose (file);
+        
+        unsigned int numVertices  = vertices.size();
+        unsigned int numTexCoords = texCoords.size();
+        unsigned int numTriangles = triangles.size();
+        
+        verts = new vec3 [numVertices];
+        norms = new vec3 [numVertices];
+        texcs = new texCoord [numTexCoords];
+        tris  = new triangle [numTriangles];
+        
+        memcpy (verts, &vertices[0],  numVertices  * sizeof(vec3));
+        memcpy (norms, &normals[0],   numVertices  * sizeof(vec3));
+        memcpy (texcs, &texCoords[0], numTexCoords * sizeof(texCoord));
+        memcpy (tris,  &triangles[0], numTriangles * sizeof(triangle));
+        
+        // Copy normals if the model file specified them.
+        
+        
+        
+        // Otherwise normalise the normals that have been previously computed.
+        
+        for (size_t i = 0; i < numVertices; ++i)
+        {
+            normalise(norms[i]);
+        }
+        
+        model->vertices      = verts;
+        model->normals       = norms;
+        model->texCoords     = texcs;
+        model->triangles     = tris;
+        model->skins         = 0;
+        model->animations    = 0;
+        model->numFrames     = 1;
+        model->numVertices   = numVertices;
+        model->numTriangles  = numTriangles;
+        model->numTexCoords  = numTexCoords;
+        model->numSkins      = 0;
+        model->numAnimations = 0;
+        
+        return Model_Success;
+    }
+    catch (std::bad_alloc)
+    {
+        safe_free (verts);
+        safe_free (texcs);
+        safe_free (tris);
+        return Model_Memory_Allocation_Error;
+    }
+}
diff --git a/Spear/Assets/Model/OBJ/OBJ_load.h b/Spear/Assets/Model/OBJ/OBJ_load.h
new file mode 100644
index 0000000..f1de6c7
--- /dev/null
+++ b/Spear/Assets/Model/OBJ/OBJ_load.h
@@ -0,0 +1,25 @@
+#ifndef _OBJ_LOAD_H
+#define _OBJ_LOAD_H
+
+#include "../Model.h"
+#include "../Model_error_code.h"
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/// Loads the OBJ file specified by the given string.
+/// 'clockwise' should be 1 if you plan to render the model in a clockwise environment, 0 otherwise.
+/// 'smooth_normals' should be 1 if you want the loader to compute smooth normals, 0 otherwise.
+Model_error_code OBJ_load (const char* filename, char clockwise, char left_handed, Model* model);
+
+/// Gets the last error generated by the OBJ loader.
+char* get_last_error ();
+
+#ifdef __cplusplus
+}
+#endif
+
+
+#endif // _OBJ_LOAD_H
diff --git a/Spear/Assets/Model/OBJ/test.cc b/Spear/Assets/Model/OBJ/test.cc
new file mode 100644
index 0000000..31e0e39
--- /dev/null
+++ b/Spear/Assets/Model/OBJ/test.cc
@@ -0,0 +1,47 @@
+#include "OBJ_load.h"
+#include <cstdio>
+
+
+int main (void)
+{
+    Model model;
+    OBJ_load ("/home/jeanne/assets/box.obj", 1, 1, &model);
+    
+    printf("Vertices:\n");
+    
+    for (size_t i = 0; i < model.numVertices; ++i)
+    {
+        vec3 v = model.vertices[i];
+        printf ("%f, %f, %f\n", v.x, v.y, v.z);
+    }
+    
+    printf("\nNormals:\n");
+    
+    for (size_t i = 0; i < model.numVertices; ++i)
+    {
+        vec3 n = model.normals[i];
+        printf ("%f, %f, %f\n", n.x, n.y, n.z);
+    }
+    
+    printf("\nTex coords:\n");
+    
+    for (size_t i = 0; i < model.numTexCoords; ++i)
+    {
+        texCoord tex = model.texCoords[i];
+        printf("%f, %f\n", tex.s, tex.t);
+    }
+    
+    printf("\nTriangles:\n");
+    
+    for (size_t i = 0; i < model.numTriangles; ++i)
+    {
+        triangle t = model.triangles[i];
+        printf ("%d, %d, %d - %d, %d, %d\n",
+            t.vertexIndices[0]+1,  t.vertexIndices[1]+1,  t.vertexIndices[2]+1,
+            t.textureIndices[0]+1, t.textureIndices[1]+1, t.textureIndices[2]+1);
+    }
+    
+    model_free (&model);
+    
+    return 0;
+}
diff --git a/Spear/Assets/Model/sys_types.h b/Spear/Assets/Model/sys_types.h
new file mode 100644
index 0000000..e4eb251
--- /dev/null
+++ b/Spear/Assets/Model/sys_types.h
@@ -0,0 +1,16 @@
+#ifndef _SPEAR_SYS_TYPES_H
+#define _SPEAR_SYS_TYPES_H
+
+#include <stdint.h>
+
+typedef int8_t   I8;
+typedef int16_t  I16;
+typedef int32_t  I32;
+typedef int64_t  I64;
+typedef uint8_t  U8;
+typedef uint16_t U16;
+typedef uint32_t U32;
+typedef uint64_t U64;
+
+#endif // _SPEAR_SYS_TYPES_H
+
diff --git a/Spear/Collision.hs b/Spear/Collision.hs
new file mode 100644
index 0000000..d2de02d
--- /dev/null
+++ b/Spear/Collision.hs
@@ -0,0 +1,19 @@
+module Spear.Collision
+(
+    module Spear.Collision.AABB
+,   module Spear.Collision.Collision
+,   module Spear.Collision.Sphere
+,   module Spear.Collision.Triangle
+,   module Spear.Collision.Types
+)
+where
+
+
+import Spear.Collision.AABB hiding (contains)
+import Spear.Collision.Collision
+import Spear.Collision.Sphere hiding (contains)
+import Spear.Collision.Triangle
+import Spear.Collision.Types
+
+import qualified Spear.Collision.AABB as AABB (contains)
+import qualified Spear.Collision.Sphere as Sphere (contains)
diff --git a/Spear/Collision/AABB.hs b/Spear/Collision/AABB.hs
new file mode 100644
index 0000000..2676af0
--- /dev/null
+++ b/Spear/Collision/AABB.hs
@@ -0,0 +1,32 @@
+module Spear.Collision.AABB
+(
+    AABB(..)
+,   aabb
+,   contains
+)
+where
+
+
+import Spear.Math.Vector3 as Vector
+
+
+-- | An axis-aligned bounding box.
+data AABB = AABB
+    { min :: !Vector3
+    , max :: !Vector3
+    }
+    deriving Eq
+
+
+-- | Create a 'AABB' from the given points.
+aabb :: [Vector3] -> AABB
+
+aabb [] = error "Attempting to build a BoundingVolume from an empty list!"
+
+aabb (x:xs) = foldr update (AABB x x) xs
+    where update p (AABB min max) = AABB (Vector.min p min) (Vector.max p max)
+
+
+-- | Return 'True' if the given 'AABB' contains the given point, 'False' otherwise.         
+contains :: AABB -> Vector3 -> Bool
+(AABB min max) `contains` v = v >= min && v <= max
diff --git a/Spear/Collision/Collision.hs b/Spear/Collision/Collision.hs
new file mode 100644
index 0000000..50be0d7
--- /dev/null
+++ b/Spear/Collision/Collision.hs
@@ -0,0 +1,119 @@
+module Spear.Collision.Collision
+(
+    Collisionable(..)
+,   collidePlane
+,   aabbFromSphere
+)
+where
+
+
+import Spear.Collision.AABB as AABB
+import Spear.Collision.Sphere as Sphere
+import Spear.Collision.Types
+import Spear.Math.Plane
+import Spear.Math.Vector3
+
+
+class Collisionable a where
+    collideBox    :: AABB   -> a -> CollisionType
+    collideSphere :: Sphere -> a -> CollisionType
+    collidePlane  :: Plane  -> a -> CollisionType
+
+
+instance Collisionable AABB where
+    
+    collideBox box1@(AABB min1 max1) box2@(AABB min2 max2)
+        | box1 == box2  = Equal
+        | min1 > max2   = NoCollision
+        | max1 < min2   = NoCollision
+        | box1 `AABB.contains` min2 && box1 `AABB.contains` max2 = FullyContains
+        | box2 `AABB.contains` min1 && box2 `AABB.contains` max1 = FullyContainedBy
+        | (x max1) < (x min2) = NoCollision
+        | (x min1) > (x max2) = NoCollision
+        | (y max1) < (y min2) = NoCollision
+        | (y min1) > (y max2) = NoCollision
+        | (z max1) < (z min2) = NoCollision
+        | (z min1) > (z max2) = NoCollision
+        | otherwise           = Collision
+    
+    collideSphere sphere@(Sphere c r) aabb@(AABB min max)
+        | test == FullyContains || test == FullyContainedBy = test
+        | normSq (c - boxC) > (l + r)^2 = NoCollision
+        | otherwise = Collision
+            where
+                test = aabb `collideBox` aabbFromSphere sphere
+                boxC = min + (max-min)/2
+                l = norm $ min + (vec3 (x boxC) (y min) (z min)) - min
+    
+    collidePlane pl aabb@(AABB {})
+        | sameSide tests = NoCollision
+        | otherwise      = Collision
+        where
+            tests = fmap (classify pl) $ aabbPoints aabb
+            sameSide (x:xs) = all (==x) xs
+
+
+instance Collisionable Sphere where
+    
+    collideBox box sphere = case collideSphere sphere box of
+        FullyContains -> FullyContainedBy
+        FullyContainedBy -> FullyContains
+        x -> x
+    
+    collideSphere s1@(Sphere c1 r1) s2@(Sphere c2 r2)
+        | s1 == s2 = Equal
+        | 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
+    
+    collidePlane pl s = NoCollision
+
+
+aabbPoints :: AABB -> [Vector3]
+aabbPoints (AABB min max) = [p1,p2,p3,p4,p5,p6,p7,p8]
+    where
+        p1 = vec3 (x min) (y min) (z min)
+        p2 = vec3 (x min) (y min) (z max)
+        p3 = vec3 (x min) (y max) (z min)
+        p4 = vec3 (x min) (y max) (z max)
+        p5 = vec3 (x max) (y min) (z min)
+        p6 = vec3 (x max) (y min) (z max)
+        p7 = vec3 (x max) (y max) (z min)
+        p8 = vec3 (x max) (y max) (z max)
+
+
+-- | Create the minimal AABB fully containing the specified Sphere.
+aabbFromSphere :: Sphere -> AABB
+aabbFromSphere (Sphere c r) = AABB bot top
+    where
+        bot = c - (vec3 r r r)
+        top = c + (vec3 r r r)
+
+
+-- | Create the minimal AABB fully containing the specified 'BoundingVolume's.
+{-aabb :: [BoundingVolume] -> BoundingVolume
+aabb = Spear.Collision.BoundingVolume.fromList BoundingBox . foldr generate []
+    where
+        generate (AABB min max) acc = p1:p2:p3:p4:p5:p6:p7:p8:acc
+            where
+                p1 = vec3 (x min) (y min) (z min)
+                p2 = vec3 (x min) (y min) (z max)
+                p3 = vec3 (x min) (y max) (z min)
+                p4 = vec3 (x min) (y max) (z max)
+                p5 = vec3 (x max) (y min) (z min)
+                p6 = vec3 (x max) (y min) (z max)
+                p7 = vec3 (x max) (y max) (z min)
+                p8 = vec3 (x max) (y max) (z max)
+        
+        generate (Sphere c r) acc = p1:p2:p3:p4:p5:p6:acc
+            where
+                p1 = c + unitX * (vec3 r r r)
+                p2 = c - unitX * (vec3 r r r)
+                p3 = c + unitY * (vec3 r r r)
+                p4 = c - unitY * (vec3 r r r)
+                p5 = c + unitZ * (vec3 r r r)
+                p6 = c - unitZ * (vec3 r r r)-}
diff --git a/Spear/Collision/Collisioner.hs b/Spear/Collision/Collisioner.hs
new file mode 100644
index 0000000..c0194bd
--- /dev/null
+++ b/Spear/Collision/Collisioner.hs
@@ -0,0 +1,80 @@
+module Spear.Collision.Collisioner

+(

+    Collisioner

+,   CollisionType(..)

+,   aabbCollisioner

+,   sphereCollisioner

+,   buildAABB

+,   collide

+)

+where

+

+

+import Spear.Math.Vector3 as Vector

+import qualified Spear.Collision.AABB as Box

+import qualified Spear.Collision.Sphere as Sphere

+import Spear.Collision.Collision as C

+import Spear.Collision.Types

+

+

+-- | A collisioner component.

+-- Wraps collision primitives so that one can collide them without being aware of

+-- the underlying type.

+data Collisioner

+    -- | An axis-aligned bounding box.

+    = AABB {getBox :: !(Box.AABB)}

+    -- | A bounding sphere.

+    | Sphere {getSphere :: !(Sphere.Sphere)

+    }

+

+

+-- | Create a 'Collisioner' from the specified 'AABB'.  

+aabbCollisioner :: Box.AABB -> Collisioner

+aabbCollisioner = AABB

+

+

+-- | Create a 'Collisioner' from the specified 'BSphere'.

+sphereCollisioner :: Sphere.Sphere -> Collisioner

+sphereCollisioner = Sphere

+

+

+-- | Create the minimal 'AABB' fully containing the specified collisioners.

+buildAABB :: [Collisioner] -> Box.AABB

+buildAABB cols = Box.aabb $ Spear.Collision.Collisioner.generatePoints cols

+

+

+-- | Create the minimal 'AABB' collisioner fully containing the specified 'BSphere'.

+boxFromSphere :: Sphere.Sphere -> Collisioner

+boxFromSphere = AABB . aabbFromSphere

+

+

+generatePoints :: [Collisioner] -> [Vector3]

+generatePoints = foldr generate []

+    where

+        generate (AABB (Box.AABB min max)) acc = p1:p2:p3:p4:p5:p6:p7:p8:acc

+            where

+                p1 = vec3 (x min) (y min) (z min)

+                p2 = vec3 (x min) (y min) (z max)

+                p3 = vec3 (x min) (y max) (z min)

+                p4 = vec3 (x min) (y max) (z max)

+                p5 = vec3 (x max) (y min) (z min)

+                p6 = vec3 (x max) (y min) (z max)

+                p7 = vec3 (x max) (y max) (z min)

+                p8 = vec3 (x max) (y max) (z max)

+    

+        generate (Sphere (Sphere.Sphere c r)) acc = p1:p2:p3:p4:p5:p6:acc

+            where

+                p1 = c + unitX * (vec3 r r r)

+                p2 = c - unitX * (vec3 r r r)

+                p3 = c + unitY * (vec3 r r r)

+                p4 = c - unitY * (vec3 r r r)

+                p5 = c + unitZ * (vec3 r r r)

+                p6 = c - unitZ * (vec3 r r r)

+

+

+-- | Collide the given collisioners.

+collide :: Collisioner -> Collisioner -> CollisionType

+collide (AABB box1) (AABB box2)    = collideBox    box1 box2

+collide (Sphere s1) (Sphere s2)    = collideSphere s1 s2

+collide (AABB box) (Sphere sphere) = collideBox    box sphere

+collide (Sphere sphere) (AABB box) = collideSphere sphere box

diff --git a/Spear/Collision/Sphere.hs b/Spear/Collision/Sphere.hs
new file mode 100644
index 0000000..de670bc
--- /dev/null
+++ b/Spear/Collision/Sphere.hs
@@ -0,0 +1,36 @@
+module Spear.Collision.Sphere
+(
+    Sphere(..)
+,   sphere
+,   contains
+)
+where
+
+
+import Spear.Math.Vector3 as Vector
+
+
+-- | A bounding volume.
+data Sphere = Sphere
+    { center :: !Vector3
+    , radius :: !Float
+    }
+    deriving Eq
+
+
+-- | Create a 'Sphere' from the given points.
+sphere :: [Vector3] -> Sphere
+
+sphere [] = error "Attempting to build a BoundingVolume from an empty list!"
+
+sphere (x:xs) = Sphere c r
+    where
+        c = min + (max-min)/2
+        r = norm $ max - c
+        (min,max) = foldr update (x,x) xs
+        update p (min,max) = (Vector.min p min, Vector.max p max)
+
+
+-- | Return 'True' if the given 'Sphere' contains the given point, 'False' otherwise.         
+contains :: Sphere -> Vector3 -> Bool
+(Sphere center radius) `contains` p = radius*radius >= normSq (p - center)
diff --git a/Spear/Collision/Triangle.hs b/Spear/Collision/Triangle.hs
new file mode 100644
index 0000000..2391e9f
--- /dev/null
+++ b/Spear/Collision/Triangle.hs
@@ -0,0 +1,40 @@
+module Spear.Collision.Triangle
+(
+    Triangle(..)
+)
+where
+
+
+import Spear.Math.Vector3
+
+import Foreign.C.Types
+import Foreign.Storable
+
+
+data Triangle = Triangle
+    { p0 :: Vector3
+    , p1 :: Vector3
+    , p2 :: Vector3
+    }
+
+
+sizeVector3 = 3 * sizeOf (undefined :: CFloat)
+
+
+instance Storable Triangle where
+    
+    sizeOf _    = 3 * sizeVector3
+    alignment _ = alignment (undefined :: CFloat)
+    
+    peek ptr = do
+        p0 <- peekByteOff ptr 0
+        p1 <- peekByteOff ptr $ 1 * sizeVector3
+        p2 <- peekByteOff ptr $ 2 * sizeVector3
+        
+        return $ Triangle p0 p1 p2
+    
+    
+    poke ptr (Triangle p0 p1 p2) = do
+        pokeByteOff ptr 0 p0
+        pokeByteOff ptr (1*sizeVector3) p1
+        pokeByteOff ptr (2*sizeVector3) p2
diff --git a/Spear/Collision/Types.hs b/Spear/Collision/Types.hs
new file mode 100644
index 0000000..efbf7f9
--- /dev/null
+++ b/Spear/Collision/Types.hs
@@ -0,0 +1,6 @@
+module Spear.Collision.Types
+where
+
+-- | Encodes several collision situations.
+data CollisionType = NoCollision | Collision | FullyContains | FullyContainedBy | Equal
+    deriving (Eq, Ord, Show)
diff --git a/Spear/GLSL.hs b/Spear/GLSL.hs
new file mode 100644
index 0000000..4d81a73
--- /dev/null
+++ b/Spear/GLSL.hs
@@ -0,0 +1,20 @@
+module Spear.GLSL
+(
+    module Spear.GLSL.Buffer
+,   module Spear.GLSL.Error
+,   module Spear.GLSL.Management
+,   module Spear.GLSL.Texture
+,   module Spear.GLSL.Uniform
+,   module Spear.GLSL.VAO
+,   module Graphics.Rendering.OpenGL.Raw.Core31
+)
+where
+
+
+import Spear.GLSL.Buffer
+import Spear.GLSL.Error
+import Spear.GLSL.Management
+import Spear.GLSL.Texture
+import Spear.GLSL.Uniform
+import Spear.GLSL.VAO
+import Graphics.Rendering.OpenGL.Raw.Core31
diff --git a/Spear/GLSL/Buffer.hs b/Spear/GLSL/Buffer.hs
new file mode 100644
index 0000000..0f43d66
--- /dev/null
+++ b/Spear/GLSL/Buffer.hs
@@ -0,0 +1,111 @@
+module Spear.GLSL.Buffer
+(
+    GLBuffer
+,   TargetBuffer(..)
+,   BufferUsage(..)
+,   newBuffer
+,   releaseBuffer
+,   bindBuffer
+,   bufferData
+,   withGLBuffer
+)
+where
+
+
+import Spear.Setup
+import Spear.GLSL.Management
+
+import Graphics.Rendering.OpenGL.Raw.Core31
+import Control.Monad.Trans.Class (lift)
+import Data.StateVar
+import Foreign.Ptr
+import Foreign.Marshal.Utils as Foreign (with)
+import Foreign.Marshal.Alloc (alloca)
+import Foreign.Storable (peek)
+import Unsafe.Coerce
+
+
+-- | Represents an OpenGL buffer.
+data GLBuffer = GLBuffer
+    { getBuffer :: GLuint
+    , rkey      :: Resource
+    }
+
+
+-- | Represents a target buffer.
+data TargetBuffer
+    = ArrayBuffer
+    | ElementArrayBuffer
+    | PixelPackBuffer
+    | PixelUnpackBuffer
+    deriving (Eq, Show)
+    
+    
+fromTarget :: TargetBuffer -> GLenum
+fromTarget ArrayBuffer        = gl_ARRAY_BUFFER
+fromTarget ElementArrayBuffer = gl_ELEMENT_ARRAY_BUFFER
+fromTarget PixelPackBuffer    = gl_PIXEL_PACK_BUFFER
+fromTarget PixelUnpackBuffer  = gl_PIXEL_UNPACK_BUFFER
+
+
+-- | Represents a type of buffer usage.
+data BufferUsage
+    = StreamDraw
+    | StreamRead
+    | StreamCopy
+    | StaticDraw
+    | StaticRead
+    | StaticCopy
+    | DynamicDraw
+    | DynamicRead
+    | DynamicCopy
+    deriving (Eq, Show)
+
+
+fromUsage :: BufferUsage -> GLenum
+fromUsage StreamDraw  = gl_STREAM_DRAW
+fromUsage StreamRead  = gl_STREAM_READ
+fromUsage StreamCopy  = gl_STREAM_COPY
+fromUsage StaticDraw  = gl_STATIC_DRAW
+fromUsage StaticRead  = gl_STATIC_READ
+fromUsage StaticCopy  = gl_STATIC_COPY
+fromUsage DynamicDraw = gl_DYNAMIC_DRAW
+fromUsage DynamicRead = gl_DYNAMIC_READ
+fromUsage DynamicCopy = gl_DYNAMIC_COPY
+
+
+-- | Create a 'GLBuffer'.
+newBuffer :: Setup GLBuffer
+newBuffer = do
+    h <- setupIO . alloca $ \ptr -> do
+        glGenBuffers 1 ptr
+        peek ptr
+    
+    rkey <- register $ deleteBuffer h
+    return $ GLBuffer h rkey
+
+
+-- | Release the given 'GLBuffer'.
+releaseBuffer :: GLBuffer -> Setup ()
+releaseBuffer = release . rkey
+
+
+-- | Delete the given 'GLBuffer'.
+deleteBuffer :: GLuint -> IO ()
+deleteBuffer buf = Foreign.with buf $ glDeleteBuffers 1
+
+
+-- | Bind the given 'GLBuffer'.
+bindBuffer :: GLBuffer -> TargetBuffer -> IO ()
+bindBuffer buf target = glBindBuffer (fromTarget target) $ getBuffer buf
+
+
+-- | Set buffer data.
+bufferData :: TargetBuffer -> Int -> Ptr a -> BufferUsage -> IO ()
+bufferData target n bufData usage = glBufferData (fromTarget target) (unsafeCoerce n) bufData (fromUsage usage)
+
+
+-- | Apply the given function the 'GLBuffer''s id.
+withGLBuffer :: GLBuffer -> (GLuint -> a) -> a
+withGLBuffer buf f = f $ getBuffer buf
+
diff --git a/Spear/GLSL/Error.hs b/Spear/GLSL/Error.hs
new file mode 100644
index 0000000..7865996
--- /dev/null
+++ b/Spear/GLSL/Error.hs
@@ -0,0 +1,45 @@
+module Spear.GLSL.Error
+(
+    getGLError
+,   printGLError
+,   assertGL
+)
+where
+
+
+import Spear.Setup
+
+import Graphics.Rendering.OpenGL.Raw.Core31
+import System.IO (hPutStrLn, stderr)
+
+
+-- | Get the last OpenGL error.
+getGLError :: IO (Maybe String)
+getGLError = fmap translate glGetError
+    where
+        translate err
+            | err == gl_NO_ERROR          = Nothing
+            | err == gl_INVALID_ENUM      = Just "Invalid enum"
+            | err == gl_INVALID_VALUE     = Just "Invalid value"
+            | err == gl_INVALID_OPERATION = Just "Invalid operation"
+            | err == gl_OUT_OF_MEMORY     = Just "Out of memory"
+            | otherwise                   = Just "Unknown error"
+
+
+-- | Print the last OpenGL error.
+printGLError :: IO ()
+printGLError = getGLError >>= \err -> case err of
+    Nothing  -> return ()
+    Just str -> hPutStrLn stderr str
+
+
+-- | Run the given 'Setup' action and check for OpenGL errors.
+-- If an OpenGL error is produced, an exception is thrown
+-- containing the given string and the OpenGL error.
+assertGL :: Setup a -> String -> Setup a
+assertGL action err = do
+    result <- action
+    status <- setupIO getGLError
+    case status of
+        Just str -> setupError $ "OpenGL error raised: " ++ err ++ "; " ++ str
+        Nothing  -> return result
diff --git a/Spear/GLSL/Management.hs b/Spear/GLSL/Management.hs
new file mode 100644
index 0000000..81cf45f
--- /dev/null
+++ b/Spear/GLSL/Management.hs
@@ -0,0 +1,297 @@
+module Spear.GLSL.Management
+(
+    -- * Data types
+    GLSLShader
+,   GLSLProgram
+,   ShaderType(..)
+    -- * Program manipulation
+,   newProgram
+,   releaseProgram
+,   linkProgram
+,   useProgram
+,   withGLSLProgram
+    -- * Shader manipulation
+,   attachShader
+,   detachShader
+,   loadShader
+,   newShader
+,   releaseShader
+    -- ** Source loading
+,   loadSource
+,   shaderSource
+,   readSource
+,   compile
+    -- * Location
+,   attribLocation
+,   fragLocation
+,   uniformLocation
+    -- * Helper functions
+,   ($=)
+,   Data.StateVar.get
+)
+where
+
+
+import Spear.Setup
+
+import Control.Monad ((<=<), forM)
+import Control.Monad.Trans.State as State
+import Control.Monad.Trans.Error
+import Control.Monad.Trans.Class
+import Control.Monad (mapM_, when)
+import qualified Data.ByteString.Char8 as B
+import Data.StateVar
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.C.String
+import Foreign.Marshal.Alloc (alloca)
+import Foreign.Marshal.Array (withArray)
+import Graphics.Rendering.OpenGL.Raw.Core31
+import System.Directory (doesFileExist, getCurrentDirectory, setCurrentDirectory)
+import Unsafe.Coerce
+
+
+-- | Represents a GLSL shader handle.
+data GLSLShader  = GLSLShader
+    { getShader    :: GLuint
+    , getShaderKey :: Resource
+    }
+
+
+-- | Represents a GLSL program handle.
+data GLSLProgram = GLSLProgram
+    { getProgram    :: GLuint
+    , getProgramKey :: Resource
+    }
+    
+    
+-- | Encodes several shader types.
+data ShaderType = VertexShader | FragmentShader deriving (Eq, Show)
+
+
+toGLShader :: ShaderType -> GLenum
+toGLShader VertexShader   = gl_VERTEX_SHADER
+toGLShader FragmentShader = gl_FRAGMENT_SHADER
+
+
+-- | Apply the given function to the GLSLProgram's id.
+withGLSLProgram :: GLSLProgram -> (GLuint -> a) -> a
+withGLSLProgram prog f = f $ getProgram prog
+
+
+-- | Get the location of the given uniform variable within the given program.
+uniformLocation :: GLSLProgram -> String -> GettableStateVar GLint
+uniformLocation prog var = makeGettableStateVar get
+    where
+        get = withCString var $ \str -> glGetUniformLocation (getProgram prog) (unsafeCoerce str)
+
+
+-- | Get or set the location of the given variable to a fragment shader colour number.
+fragLocation :: GLSLProgram -> String -> StateVar GLint
+fragLocation prog var = makeStateVar get set
+    where
+        get     = withCString var $ \str -> glGetFragDataLocation (getProgram prog) (unsafeCoerce str)
+        set idx = withCString var $ \str ->
+            glBindFragDataLocation (getProgram prog) (unsafeCoerce idx) (unsafeCoerce str)
+
+
+-- | Get or set the location of the given attribute within the given program.
+attribLocation :: GLSLProgram -> String -> StateVar GLint
+attribLocation prog var = makeStateVar get set
+    where
+        get     = withCString var $ \str -> glGetAttribLocation  (getProgram prog) (unsafeCoerce str)
+        set idx = withCString var $ \str ->
+            glBindAttribLocation (getProgram prog) (unsafeCoerce idx) (unsafeCoerce str)
+
+
+-- | Create a 'GLSLProgram'.
+newProgram :: [GLSLShader] -> Setup GLSLProgram
+newProgram shaders = do
+    h <- setupIO glCreateProgram
+    when (h == 0) $ setupError "glCreateProgram failed"
+    rkey <- register $ deleteProgram h
+    let program = GLSLProgram h rkey
+    
+    mapM_ (setupIO . attachShader program) shaders
+    linkProgram program
+    
+    return program
+
+
+-- | Release the given 'GLSLProgram'.
+releaseProgram :: GLSLProgram -> Setup ()
+releaseProgram = release . getProgramKey
+
+
+-- | Delete the given 'GLSLProgram'.
+deleteProgram :: GLuint -> IO ()
+--deleteProgram = glDeleteProgram
+deleteProgram prog = do
+    putStrLn $ "Deleting shader program " ++ show prog
+    glDeleteProgram prog
+
+
+-- | Link the given GLSL program.
+linkProgram :: GLSLProgram -> Setup ()
+linkProgram prog = do
+    let h = getProgram prog
+    err <- setupIO $ do
+        glLinkProgram h
+        alloca $ \statptr -> do
+            glGetProgramiv h gl_LINK_STATUS statptr
+            status <- peek statptr
+            case status of
+                0 -> getStatus glGetProgramiv glGetProgramInfoLog h
+                _ -> return ""
+    
+    case length err of
+        0 -> return ()
+        _ -> setupError err
+
+
+-- | Use the given GLSL program.
+useProgram :: GLSLProgram -> IO ()
+useProgram prog = glUseProgram $ getProgram prog
+
+
+-- | Attach the given GLSL shader to the given GLSL program.
+attachShader :: GLSLProgram -> GLSLShader -> IO ()
+attachShader prog shader = glAttachShader (getProgram prog) (getShader shader)
+
+
+-- | Detach the given GLSL shader from the given GLSL program.
+detachShader :: GLSLProgram -> GLSLShader -> IO ()
+detachShader prog shader = glDetachShader (getProgram prog) (getShader shader)
+
+
+-- | Load a shader from the file specified by the given string.
+--
+-- This function creates a new shader. To load source code into an existing shader,
+-- see 'loadSource', 'shaderSource' and 'readSource'.
+loadShader :: FilePath -> ShaderType -> Setup GLSLShader
+loadShader file shaderType = do
+    shader <- newShader shaderType
+    loadSource file shader
+    compile file shader
+    return shader
+
+
+-- | Create a new shader.
+newShader :: ShaderType -> Setup GLSLShader
+newShader shaderType = do
+    h <- setupIO $ glCreateShader (toGLShader shaderType)
+    case h of
+        0 -> setupError "glCreateShader failed"
+        _ -> do
+            rkey <- register $ deleteShader h
+            return $ GLSLShader h rkey
+
+
+-- | Release the given 'GLSLShader'.
+releaseShader :: GLSLShader -> Setup ()
+releaseShader = release . getShaderKey
+
+
+-- | Free the given shader.
+deleteShader :: GLuint -> IO ()
+--deleteShader = glDeleteShader
+deleteShader shader = do
+    putStrLn $ "Deleting shader " ++ show shader
+    glDeleteShader shader
+
+
+-- | Load a shader source from the file specified by the given string into the given shader.
+loadSource :: FilePath -> GLSLShader -> Setup ()
+loadSource file h = do
+    exists <- setupIO $ doesFileExist file
+    case exists of
+        False -> setupError "the specified shader file does not exist"
+        True  -> setupIO $ do
+            code <- readSource file
+            withCString code $ shaderSource h
+
+
+-- | Load the given shader source into the given shader.
+shaderSource :: GLSLShader -> CString -> IO ()
+shaderSource shader str =
+    let ptr = unsafeCoerce str
+    in  withArray [ptr] $ flip (glShaderSource (getShader shader) 1) nullPtr
+
+
+-- | Compile the given shader.
+compile :: FilePath -> GLSLShader -> Setup ()
+compile file shader = do
+    let h = getShader shader
+    
+    -- Compile
+    setupIO $ glCompileShader h
+    
+    -- Verify status
+    err <- setupIO $ alloca $ \statusPtr -> do
+        glGetShaderiv h gl_COMPILE_STATUS statusPtr
+        result <- peek statusPtr
+        case result of
+            0 -> getStatus glGetShaderiv glGetShaderInfoLog h
+            _ -> return ""
+    
+    case length err of
+        0 -> return ()
+        _ -> setupError $ "Unable to compile shader " ++ file ++ ":\n" ++ err
+        
+        
+type StatusCall = GLuint -> GLenum -> Ptr GLint -> IO ()
+type LogCall    = GLuint -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ()
+
+
+getStatus :: StatusCall -> LogCall -> GLuint -> IO String
+getStatus getStatus getLog h = do
+    alloca $ \lenPtr -> do
+        getStatus h gl_INFO_LOG_LENGTH lenPtr
+        len <- peek lenPtr
+        case len of
+            0 -> return ""
+            _ -> withCString (replicate (unsafeCoerce len) '\0') $ getErrorString getLog h (unsafeCoerce len)
+
+
+getErrorString :: LogCall -> GLuint -> GLsizei -> CString -> IO String
+getErrorString getLog h len str = do
+    let ptr = unsafeCoerce str
+    getLog h len nullPtr ptr
+    peekCString str
+
+
+-- | Load the shader source specified by the given file.
+--
+-- This function implements an #include mechanism, so the given file can
+-- refer to other files.
+readSource :: FilePath -> IO String
+readSource = fmap B.unpack . readSource'
+
+
+readSource' :: FilePath -> IO B.ByteString
+readSource' file = do
+    let includeB      = B.pack "#include"
+        newLineB      = B.pack "\n"
+        isInclude     = ((==) includeB) . B.take 8
+        clean         = B.dropWhile (\c -> c == ' ')
+        cleanInclude  = B.filter (\c -> c /= '"') . B.dropWhile (\c -> c /= ' ')
+        toLines       = B.splitWith (\c -> c == '\n' || c == '\r')
+        addNewLine s  = if (B.last s /= '\n') then B.append s newLineB else s
+        parse         = fmap B.concat . (fmap . fmap $ flip B.append newLineB) . sequence .
+                        fmap (processLine . clean) . toLines
+        processLine l =
+            if isInclude l
+            then readSource' $ B.unpack . clean . cleanInclude $ l
+            else return l
+    
+    contents <- B.readFile file
+    
+    dir <- getCurrentDirectory
+    let dir' = dir ++ "/" ++ (reverse . dropWhile (\c -> c /= '/') . reverse) file
+    
+    setCurrentDirectory dir'
+    code <- parse contents
+    setCurrentDirectory dir
+    
+    return code
+
diff --git a/Spear/GLSL/Texture.hs b/Spear/GLSL/Texture.hs
new file mode 100644
index 0000000..8d361a1
--- /dev/null
+++ b/Spear/GLSL/Texture.hs
@@ -0,0 +1,110 @@
+module Spear.GLSL.Texture
+(
+    Texture
+,   SettableStateVar
+,   GLenum
+,   ($)
+    -- * Creation and destruction
+,   newTexture
+,   releaseTexture
+    -- * Manipulation
+,   bindTexture
+,   loadTextureData
+,   texParami
+,   texParamf
+,   activeTexture
+)
+where
+
+
+import Spear.Setup
+
+import Data.StateVar
+import Foreign.Marshal.Alloc (alloca)
+import Foreign.Marshal.Utils (with)
+import Foreign.Ptr
+import Foreign.Storable (peek)
+import Graphics.Rendering.OpenGL.Raw.Core31
+import Unsafe.Coerce (unsafeCoerce)
+
+
+-- | Represents a texture resource.
+data Texture = Texture
+    { getTex :: GLuint
+    , rkey   :: Resource
+    }
+
+
+instance Eq Texture where
+    t1 == t2 = getTex t1 == getTex t2
+
+
+instance Ord Texture where
+    t1 < t2 = getTex t1 < getTex t2
+
+
+-- | Create a new 'Texture'.
+newTexture :: Setup Texture
+newTexture = do
+    tex <- setupIO . alloca $ \ptr -> do
+        glGenTextures 1 ptr
+        peek ptr
+    
+    rkey <- register $ deleteTexture tex
+    return $ Texture tex rkey
+
+
+-- | Release the given 'Texture'.
+releaseTexture :: Texture -> Setup ()
+releaseTexture = release . rkey
+
+
+-- | Delete the given 'Texture'.
+deleteTexture :: GLuint -> IO ()
+--deleteTexture tex = with tex $ glDeleteTextures 1
+deleteTexture tex = do
+    putStrLn $ "Releasing texture " ++ show tex
+    with tex $ glDeleteTextures 1
+
+
+-- | Bind the given 'Texture'.
+bindTexture :: Texture -> IO ()
+bindTexture = glBindTexture gl_TEXTURE_2D . getTex
+
+
+-- | Load data onto the bound 'Texture'.
+loadTextureData :: GLenum
+                -> Int -- ^ Target
+                -> Int -- ^ Level
+                -> Int -- ^ Internal format
+                -> Int -- ^ Width
+                -> Int -- ^ Height
+                -> GLenum -- ^ Border
+                -> GLenum -- ^ Texture type
+                -> Ptr a -- ^ Texture data
+                -> IO ()
+loadTextureData target level internalFormat width height border format texType texData = do
+    glTexImage2D target
+                 (fromIntegral level)
+                 (fromIntegral internalFormat)
+                 (fromIntegral width)
+                 (fromIntegral height)
+                 (fromIntegral border)
+                 (fromIntegral format)
+                 texType
+                 texData
+
+
+-- | Set the bound texture's given parameter to the given value.
+texParami :: GLenum -> GLenum -> SettableStateVar GLenum
+texParami target param = makeSettableStateVar $ \val -> glTexParameteri target param $ fromIntegral . fromEnum $ val
+
+
+-- | Set the bound texture's given parameter to the given value.
+texParamf :: GLenum -> GLenum -> SettableStateVar Float
+texParamf target param = makeSettableStateVar $ \val -> glTexParameterf target param (unsafeCoerce val)
+
+
+-- | Set the active texture unit.
+activeTexture :: SettableStateVar GLenum
+activeTexture = makeSettableStateVar glActiveTexture
diff --git a/Spear/GLSL/Uniform.hs b/Spear/GLSL/Uniform.hs
new file mode 100644
index 0000000..f186333
--- /dev/null
+++ b/Spear/GLSL/Uniform.hs
@@ -0,0 +1,67 @@
+module Spear.GLSL.Uniform
+(
+    uniformVec3
+,   uniformVec4
+,   uniformMat3
+,   uniformMat4
+,   uniformfl
+,   uniformil
+)
+where
+
+
+import Spear.GLSL.Management
+import Spear.Math.Matrix3 (Matrix3)
+import Spear.Math.Matrix4 (Matrix4)
+import Spear.Math.Vector3 as V3
+import Spear.Math.Vector4 as V4
+
+import Foreign.Marshal.Array (withArray)
+import Foreign.Marshal.Utils
+import Graphics.Rendering.OpenGL.Raw.Core31
+import Unsafe.Coerce
+
+
+uniformVec3 :: GLint -> Vector3 -> IO ()
+uniformVec3 loc v = glUniform3f loc x' y' z'
+    where x' = unsafeCoerce $ V3.x v
+          y' = unsafeCoerce $ V3.y v
+          z' = unsafeCoerce $ V3.z v
+    
+
+uniformVec4 :: GLint -> Vector4 -> IO ()
+uniformVec4 loc v = glUniform4f loc x' y' z' w'
+    where x' = unsafeCoerce $ V4.x v
+          y' = unsafeCoerce $ V4.y v
+          z' = unsafeCoerce $ V4.z v
+          w' = unsafeCoerce $ V4.w v
+
+
+uniformMat3 :: GLint -> Matrix3 -> IO ()
+uniformMat3 loc mat =
+    with mat $ \ptrMat ->
+        glUniformMatrix3fv loc 1 (toEnum 0) (unsafeCoerce ptrMat)
+
+
+uniformMat4 :: GLint -> Matrix4 -> IO ()
+uniformMat4 loc mat =
+    with mat $ \ptrMat ->
+        glUniformMatrix4fv loc 1 (toEnum 0) (unsafeCoerce ptrMat)
+
+
+uniformfl :: GLint -> [GLfloat] -> IO ()
+uniformfl loc vals = withArray vals $ \ptr ->
+    case length vals of
+        1 -> glUniform1fv loc 1 ptr
+        2 -> glUniform2fv loc 1 ptr
+        3 -> glUniform3fv loc 1 ptr
+        4 -> glUniform4fv loc 1 ptr
+
+
+uniformil :: GLint -> [GLint] -> IO ()
+uniformil loc vals = withArray vals $ \ptr ->
+    case length vals of
+        1 -> glUniform1iv loc 1 ptr
+        2 -> glUniform2iv loc 1 ptr
+        3 -> glUniform3iv loc 1 ptr
+        4 -> glUniform4iv loc 1 ptr
diff --git a/Spear/GLSL/VAO.hs b/Spear/GLSL/VAO.hs
new file mode 100644
index 0000000..f121636
--- /dev/null
+++ b/Spear/GLSL/VAO.hs
@@ -0,0 +1,88 @@
+module Spear.GLSL.VAO
+(
+    VAO
+    -- * Creation and destruction
+,   newVAO
+,   releaseVAO
+    -- * Manipulation
+,   bindVAO
+,   enableVAOAttrib
+,   attribVAOPointer
+    -- * Rendering
+,   drawArrays
+,   drawElements
+)
+where
+
+
+import Spear.Setup
+import Control.Monad.Trans.Class (lift)
+import Foreign.Marshal.Utils as Foreign (with)
+import Foreign.Marshal.Alloc (alloca)
+import Foreign.Storable (peek)
+import Foreign.Ptr
+import Unsafe.Coerce
+import Graphics.Rendering.OpenGL.Raw.Core31
+
+
+-- | Represents a vertex array object.
+data VAO = VAO
+    { getVAO :: GLuint
+    , rkey   :: Resource
+    }
+
+
+instance Eq VAO where
+    vao1 == vao2 = getVAO vao1 == getVAO vao2
+
+
+instance Ord VAO where
+    vao1 < vao2 = getVAO vao1 < getVAO vao2
+
+
+-- | Create a new 'VAO'.
+newVAO :: Setup VAO
+newVAO = do
+    h <- setupIO . alloca $ \ptr -> do
+        glGenVertexArrays 1 ptr
+        peek ptr
+    
+    rkey <- register $ deleteVAO h
+    return $ VAO h rkey
+
+
+-- | Release the given 'VAO'.
+releaseVAO :: VAO -> Setup ()
+releaseVAO = release . rkey
+
+
+-- | Delete the given 'VAO'.
+deleteVAO :: GLuint -> IO ()
+deleteVAO vao = Foreign.with vao $ glDeleteVertexArrays 1
+
+
+-- | Bind the given 'VAO'.
+bindVAO :: VAO -> IO ()
+bindVAO = glBindVertexArray . getVAO
+
+
+-- | Enable the given vertex attribute of the bound 'VAO'.
+enableVAOAttrib :: GLuint -> IO ()
+enableVAOAttrib = glEnableVertexAttribArray
+
+
+-- | Bind the bound buffer to the given point.
+attribVAOPointer :: GLuint -> GLint -> GLenum -> Bool -> GLsizei -> Int -> IO ()
+attribVAOPointer idx ncomp dattype normalise stride off =
+    glVertexAttribPointer idx ncomp dattype (unsafeCoerce normalise) stride (unsafeCoerce off)
+
+
+-- | Draw the bound 'VAO'.
+drawArrays :: GLenum -> Int -> Int -> IO ()
+drawArrays mode first count = glDrawArrays mode (unsafeCoerce first) (unsafeCoerce count)
+
+
+-- | Draw the bound 'VAO', indexed mode.
+drawElements :: GLenum -> Int -> GLenum -> Ptr a -> IO ()
+drawElements mode count t idxs = glDrawElements mode (unsafeCoerce count) t idxs
+
diff --git a/Spear/Game.hs b/Spear/Game.hs
new file mode 100644
index 0000000..08fc460
--- /dev/null
+++ b/Spear/Game.hs
@@ -0,0 +1,42 @@
+module Spear.Game
+(
+    Game
+,   gameIO
+,   getGameState
+,   saveGameState
+,   modifyGameState
+,   runGame
+)
+where
+
+
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.State.Strict
+
+
+type Game s = StateT s IO
+
+
+-- | Perform the given IO action in the 'Game' monad.
+gameIO :: IO a -> Game s a
+gameIO = lift
+
+
+-- | Retrieve the game state.
+getGameState :: Game s s
+getGameState = get
+
+
+-- | Save the game state.
+saveGameState :: s -> Game s ()
+saveGameState = put
+
+
+-- | Modify the game state.
+modifyGameState :: (s -> s) -> Game s ()
+modifyGameState = modify
+
+
+-- | Run the given game.
+runGame :: Game s a -> s -> IO ()
+runGame game state = runStateT game state >> return ()
diff --git a/Spear/Math/Camera.hs b/Spear/Math/Camera.hs
new file mode 100644
index 0000000..118997a
--- /dev/null
+++ b/Spear/Math/Camera.hs
@@ -0,0 +1,69 @@
+module Spear.Math.Camera
+where
+
+
+import qualified Spear.Math.Matrix4 as M
+import qualified Spear.Math.Spatial as S
+import Spear.Math.Vector3
+
+
+data Camera = Camera
+    { projection :: M.Matrix4
+    , transform  :: M.Matrix4
+    }
+
+
+-- | Build a perspective camera.
+perspective :: Float -- ^ Fovy - Vertical field of view angle in degrees.
+            -> Float -- ^ Aspect ratio.
+            -> Float -- ^ Near clip.
+            -> Float -- ^ Far clip.
+            -> Vector3 -- ^ Right vector.
+            -> Vector3 -- ^ Up vector.
+            -> Vector3 -- ^ Forward vector.
+            -> Vector3 -- ^ Position vector.
+            -> Camera
+
+perspective fovy r n f right up fwd pos =
+    Camera
+    { projection = M.perspective fovy r n f
+    , transform  = M.transform right up fwd pos
+    }
+
+
+-- | Build an orthogonal camera.
+ortho :: Float   -- ^ Left.
+      -> Float   -- ^ Right.
+      -> Float   -- ^ Bottom.
+      -> Float   -- ^ Top.
+      -> Float   -- ^ Near clip.
+      -> Float   -- ^ Far clip.
+      -> Vector3 -- ^ Right vector.
+      -> Vector3 -- ^ Up vector.
+      -> Vector3 -- ^ Forward vector.
+      -> Vector3 -- ^ Position vector.
+      -> Camera
+
+ortho l r b t n f right up fwd pos =
+    Camera
+    { projection = M.ortho l r b t n f
+    , transform  = M.transform right up fwd pos
+    }
+
+
+instance S.Spatial Camera where
+    move        v cam = cam { transform = M.translv v * transform cam }
+    moveFwd     f cam = cam { transform = M.translv (scale f $ S.fwd cam) * transform cam }
+    moveBack    f cam = cam { transform = M.translv (scale (-f) $ S.fwd cam) * transform cam }
+    strafeLeft  f cam = cam { transform = M.translv (scale (-f) $ S.right cam) * transform cam }
+    strafeRight f cam = cam { transform = M.translv (scale f $ S.right cam) * transform cam }
+    pitch       a cam = cam { transform = transform cam * M.axisAngle (S.right cam) a }
+    yaw         a cam = cam { transform = transform cam * M.axisAngle (S.up cam)    a }
+    roll        a cam = cam { transform = transform cam * M.axisAngle (S.fwd cam)   a }
+    pos   = M.position . transform
+    fwd   = M.forward  . transform
+    up    = M.up       . transform
+    right = M.right    . transform
+    transform (Camera _ t) = t
+    setTransform t (Camera proj _) = Camera proj t
+
diff --git a/Spear/Math/Entity.hs b/Spear/Math/Entity.hs
new file mode 100644
index 0000000..298b611
--- /dev/null
+++ b/Spear/Math/Entity.hs
@@ -0,0 +1,31 @@
+module Spear.Math.Entity
+(
+    Entity(..)
+)
+where
+
+
+import qualified Spear.Math.Matrix4 as M
+import qualified Spear.Math.Spatial as S
+import qualified Spear.Math.Vector3 as V
+
+
+-- | An entity in 3D space.
+newtype Entity = Entity { transform :: M.Matrix4 }
+
+
+instance S.Spatial Entity where
+    move        v ent = ent { transform = M.translv v * transform ent }
+    moveFwd     f ent = ent { transform = M.translv (V.scale f $ S.fwd ent) * transform ent }
+    moveBack    f ent = ent { transform = M.translv (V.scale (-f) $ S.fwd ent) * transform ent }
+    strafeLeft  f ent = ent { transform = M.translv (V.scale (-f) $ S.right ent) * transform ent }
+    strafeRight f ent = ent { transform = M.translv (V.scale f $ S.right ent) * transform ent }
+    pitch       a ent = ent { transform = transform ent * M.axisAngle (S.right ent) a }
+    yaw         a ent = ent { transform = transform ent * M.axisAngle (S.up ent) a }
+    roll        a ent = ent { transform = transform ent * M.axisAngle (S.fwd ent) a }
+    pos   = M.position . transform
+    fwd   = M.forward  . transform
+    up    = M.up       . transform
+    right = M.right    . transform
+    transform (Entity t) = t
+    setTransform t (Entity _) = Entity t
diff --git a/Spear/Math/Matrix3.hs b/Spear/Math/Matrix3.hs
new file mode 100644
index 0000000..bc8f149
--- /dev/null
+++ b/Spear/Math/Matrix3.hs
@@ -0,0 +1,295 @@
+module Spear.Math.Matrix3

+(

+    Matrix3

+    -- * Accessors

+,   m00, m01, m02

+,   m10, m11, m12

+,   m20, m21, m22

+,   col0, col1, col2

+,   row0, row1, row2

+    -- * Construction

+,   mat3

+,   mat3fromVec

+,   Spear.Math.Matrix3.id

+    -- * Transformations

+    -- ** Rotation

+,   rotX

+,   rotY

+,   rotZ

+,   axisAngle

+    -- ** Scale

+,   Spear.Math.Matrix3.scale

+,   scalev

+    -- ** Reflection

+,   reflectX

+,   reflectY

+,   reflectZ

+    -- * Operations

+,   transpose

+,   Spear.Math.Matrix3.zipWith

+,   Spear.Math.Matrix3.map

+,   mul

+--,   inverse

+)

+where

+

+

+import Spear.Math.Vector3 as Vector3

+import Spear.Math.Vector4 as Vector4

+

+import Foreign.Storable

+

+

+-- | Represents a 3x3 column major matrix.

+data Matrix3 = Matrix3

+    { m00 :: !Float, m10 :: !Float, m20 :: !Float

+    , m01 :: !Float, m11 :: !Float, m21 :: !Float

+    , m02 :: !Float, m12 :: !Float, m22 :: !Float

+    }

+

+

+instance Show Matrix3 where

+    

+    show (Matrix3 m00 m10 m20 m01 m11 m21 m02 m12 m22) =

+        show' m00 ++ ", " ++ show' m10 ++ ", " ++ show' m20 ++ "\n" ++

+        show' m01 ++ ", " ++ show' m11 ++ ", " ++ show' m21 ++ "\n" ++

+        show' m02 ++ ", " ++ show' m12 ++ ", " ++ show' m22 ++ "\n"

+        where

+            show' f = if abs f < 0.0000001 then "0" else show f

+

+

+instance Num Matrix3 where

+    (Matrix3 a00 a01 a02 a03 a04 a05 a06 a07 a08)

+        + (Matrix3 b00 b01 b02 b03 b04 b05 b06 b07 b08)

+            = Matrix3 (a00 + b00) (a01 + b01) (a02 + b02)

+                      (a03 + b03) (a04 + b04) (a05 + b05)

+                      (a06 + b06) (a07 + b07) (a08 + b08)

+    

+    (Matrix3 a00 a01 a02 a03 a04 a05 a06 a07 a08)

+        - (Matrix3 b00 b01 b02 b03 b04 b05 b06 b07 b08)

+            = Matrix3 (a00 - b00) (a01 - b01) (a02 - b02)

+                      (a03 - b03) (a04 - b04) (a05 - b05)

+                      (a06 - b06) (a07 - b07) (a08 - b08)

+    

+    (Matrix3 a00 a10 a20 a01 a11 a21 a02 a12 a22)

+        * (Matrix3 b00 b10 b20 b01 b11 b21 b02 b12 b22)

+            = Matrix3 (a00 * b00 + a10 * b01 + a20 * b02)

+                      (a00 * b10 + a10 * b11 + a20 * b12)

+                      (a00 * b20 + a10 * b21 + a20 * b22)

+                      

+                      (a01 * b00 + a11 * b01 + a21 * b02)

+                      (a01 * b10 + a11 * b11 + a21 * b12)

+                      (a01 * b20 + a11 * b21 + a21 * b22)

+                      

+                      (a02 * b00 + a12 * b01 + a22 * b02)

+                      (a02 * b10 + a12 * b11 + a22 * b12)

+                      (a02 * b20 + a12 * b21 + a22 * b22)

+    

+    abs = Spear.Math.Matrix3.map abs

+    

+    signum = Spear.Math.Matrix3.map signum

+    

+    fromInteger i = mat3 i' i' i' i' i' i' i' i' i' where i' = fromInteger i

+    

+    

+instance Storable Matrix3 where

+    sizeOf    _ = 36

+    alignment _ = 4

+    

+    peek ptr = do

+        a00 <- peekByteOff ptr 0;  a01 <- peekByteOff ptr 4;  a02 <- peekByteOff ptr 8;

+        a10 <- peekByteOff ptr 12; a11 <- peekByteOff ptr 16; a12 <- peekByteOff ptr 20;

+        a20 <- peekByteOff ptr 24; a21 <- peekByteOff ptr 28; a22 <- peekByteOff ptr 32;

+        

+        return $ Matrix3 a00 a10 a20

+                         a01 a11 a21

+                         a02 a12 a22

+    

+    poke ptr (Matrix3 a00 a01 a02

+                      a10 a11 a12

+                      a20 a21 a22) = do

+        pokeByteOff ptr 0  a00; pokeByteOff ptr 4  a01; pokeByteOff ptr 8  a02;

+        pokeByteOff ptr 12 a10; pokeByteOff ptr 16 a11; pokeByteOff ptr 20 a12;

+        pokeByteOff ptr 24 a20; pokeByteOff ptr 28 a21; pokeByteOff ptr 32 a22;

+

+

+col0 (Matrix3 a00 _   _   a10 _   _   a20 _   _  ) = vec3 a00 a10 a20

+col1 (Matrix3 _   a01 _   _   a11 _   _   a21 _  ) = vec3 a01 a11 a21

+col2 (Matrix3 _   _   a02 _   _   a12 _   _   a22) = vec3 a02 a12 a22

+

+

+row0 (Matrix3 a00 a01 a02 _   _   _   _   _   _  ) = vec3 a00 a01 a02

+row1 (Matrix3 _   _   _   a10 a11 a12 _   _   _  ) = vec3 a10 a11 a12

+row2 (Matrix3 _   _   _   _   _   _   a20 a21 a22) = vec3 a20 a21 a22

+

+

+-- | Build a 'Matrix3' from the specified values.

+mat3 :: Float -> Float -> Float ->

+        Float -> Float -> Float ->

+        Float -> Float -> Float -> Matrix3

+mat3 m00 m01 m02 m10 m11 m12 m20 m21 m22 = Matrix3

+    m00 m10 m20

+    m01 m11 m21

+    m02 m12 m22

+

+

+-- | Build a 'Matrix3' from three vectors in 3D.

+mat3fromVec :: Vector3 -> Vector3 -> Vector3 -> Matrix3

+mat3fromVec v0 v1 v2 = Matrix3

+    (Vector3.x v0) (Vector3.x v1) (Vector3.x v2)

+    (Vector3.y v0) (Vector3.y v1) (Vector3.y v2)

+    (Vector3.z v0) (Vector3.z v1) (Vector3.z v2)

+ 

+

+-- | Zip two 'Matrix3' together with the specified function.

+zipWith :: (Float -> Float -> Float) -> Matrix3 -> Matrix3 -> Matrix3

+zipWith f a b = Matrix3

+    (f (m00 a) (m00 b)) (f (m10 a) (m10 b)) (f (m20 a) (m20 b))

+    (f (m01 a) (m01 b)) (f (m11 a) (m11 b)) (f (m21 a) (m21 b))

+    (f (m02 a) (m02 b)) (f (m12 a) (m12 b)) (f (m22 a) (m22 b))

+

+

+-- | Map the specified function to the specified 'Matrix3'.

+map :: (Float -> Float) -> Matrix3 -> Matrix3

+map f m = Matrix3

+    (f . m00 $ m) (f . m10 $ m) (f . m20 $ m)

+    (f . m01 $ m) (f . m11 $ m) (f . m21 $ m)

+    (f . m02 $ m) (f . m12 $ m) (f . m22 $ m)

+

+

+-- | Return the identity matrix.

+id :: Matrix3

+id = mat3

+    1   0   0

+    0   1   0

+    0   0   1

+

+

+-- | Create a rotation matrix rotating about the X axis.

+-- The given angle must be in degrees.

+rotX :: Float -> Matrix3

+rotX angle = mat3

+    1   0   0

+    0   c   (-s)

+    0   s   c

+    where

+        s = sin . fromDeg $ angle

+        c = cos . fromDeg $ angle

+

+

+-- | Create a rotation matrix rotating about the Y axis.

+-- The given angle must be in degrees.

+rotY :: Float -> Matrix3

+rotY angle = mat3

+    c    0    s

+    0    1    0

+    (-s) 0    c

+    where

+        s = sin . fromDeg $ angle

+        c = cos . fromDeg $ angle

+

+

+-- | Create a rotation matrix rotating about the Z axis.

+-- The given angle must be in degrees.

+rotZ :: Float -> Matrix3

+rotZ angle = mat3

+    c    (-s)  0

+    s    c     0

+    0    0     1

+    where

+        s = sin . fromDeg $ angle

+        c = cos . fromDeg $ angle

+

+

+-- | Create a rotation matrix rotating about the specified axis.

+-- The given angle must be in degrees.

+axisAngle :: Vector3 -> Float -> Matrix3

+axisAngle v angle = mat3

+    (c + omc*x^2) (omc*xy-sz) (omc*xz+sy)

+    (omc*xy+sz)   (c+omc*y^2) (omc*yz-sx)

+    (omc*xz-sy)   (omc*yz+sx) (c+omc*z^2)

+    where

+        x = Vector3.x v

+        y = Vector3.y v

+        z = Vector3.z v

+        s   = sin . fromDeg $ angle

+        c   = cos . fromDeg $ angle

+        xy  = x*y

+        xz  = x*z

+        yz  = y*z

+        sx  = s*x

+        sy  = s*y

+        sz  = s*z

+        omc = 1 - c

+

+

+-- | Create a scale matrix.

+scale :: Float -> Float -> Float -> Matrix3

+scale sx sy sz = mat3

+    sx  0   0

+    0   sy  0

+    0   0   sz

+    

+    

+-- | Create a scale matrix.

+scalev :: Vector3 -> Matrix3

+scalev v = mat3

+    sx  0   0

+    0   sy  0

+    0   0   sz

+        where

+            sx = Vector3.x v

+            sy = Vector3.y v

+            sz = Vector3.z v

+

+

+-- | Create an X reflection matrix.

+reflectX :: Matrix3

+reflectX = mat3

+    (-1)  0   0

+    0     1   0

+    0     0   1

+

+

+-- | Create a Y reflection matrix.

+reflectY :: Matrix3

+reflectY = mat3

+    1   0     0

+    0   (-1)  0

+    0   0     1

+

+

+-- | Create a Z reflection matrix.

+reflectZ :: Matrix3

+reflectZ = mat3

+    1   0   0

+    0   1   0

+    0   0   (-1)

+

+    

+-- | Transpose the specified matrix.

+transpose :: Matrix3 -> Matrix3

+transpose m = mat3

+    (m00 m) (m01 m) (m02 m)

+    (m10 m) (m11 m) (m12 m)

+    (m20 m) (m21 m) (m22 m)

+

+

+-- | Transform the given vector in 3D space with the given matrix.

+mul :: Matrix3 -> Vector3 -> Vector3

+mul m v = vec3 x' y' z'

+    where

+        v' = vec3 (Vector3.x v) (Vector3.y v) (Vector3.z v)

+        x' = row0 m `Vector3.dot` v'

+        y' = row1 m `Vector3.dot` v'

+        z' = row2 m `Vector3.dot` v'

+

+

+-- | Invert the given 'Matrix3'.

+{-inverse :: Matrix3 -> Matrix3

+inverse mat = -}

+

+

+fromDeg :: (Floating a) => a -> a

+fromDeg = (*pi) . (/180)

+

diff --git a/Spear/Math/Matrix4.hs b/Spear/Math/Matrix4.hs
new file mode 100644
index 0000000..a86dc84
--- /dev/null
+++ b/Spear/Math/Matrix4.hs
@@ -0,0 +1,453 @@
+module Spear.Math.Matrix4

+(

+    Matrix4

+    -- * Accessors

+,   m00, m01, m02, m03

+,   m10, m11, m12, m13

+,   m20, m21, m22, m23

+,   m30, m31, m32, m33

+,   col0, col1, col2, col3

+,   row0, row1, row2, row3

+,   right, up, forward, position

+    -- * Construction

+,   mat4

+,   mat4fromVec

+,   transform
+,   lookAt

+,   Spear.Math.Matrix4.id

+    -- * Transformations

+    -- ** Translation

+,   transl

+,   translv

+    -- ** Rotation

+,   rotX

+,   rotY

+,   rotZ

+,   axisAngle

+    -- ** Scale

+,   Spear.Math.Matrix4.scale

+,   scalev

+    -- ** Reflection

+,   reflectX

+,   reflectY

+,   reflectZ

+    -- ** Projection

+,   ortho

+,   perspective

+    -- * Operations

+,   Spear.Math.Matrix4.zipWith

+,   Spear.Math.Matrix4.map

+,   transpose

+,   inverseTransform

+,   mul

+,   mulp

+,   muld

+)

+where

+

+

+import Spear.Math.Vector3 as Vector3

+import Spear.Math.Vector4 as Vector4

+

+import Foreign.Storable

+

+

+-- | Represents a 4x4 column major matrix.

+data Matrix4 = Matrix4

+    { m00 :: !Float, m10 :: !Float, m20 :: !Float, m30 :: !Float

+    , m01 :: !Float, m11 :: !Float, m21 :: !Float, m31 :: !Float

+    , m02 :: !Float, m12 :: !Float, m22 :: !Float, m32 :: !Float

+    , m03 :: !Float, m13 :: !Float, m23 :: !Float, m33 :: !Float

+    }

+

+

+instance Show Matrix4 where

+    

+    show (Matrix4 m00 m10 m20 m30 m01 m11 m21 m31 m02 m12 m22 m32 m03 m13 m23 m33) =

+        show' m00 ++ ", " ++ show' m10 ++ ", " ++ show' m20 ++ ", " ++ show' m30 ++ "\n" ++

+        show' m01 ++ ", " ++ show' m11 ++ ", " ++ show' m21 ++ ", " ++ show' m31 ++ "\n" ++

+        show' m02 ++ ", " ++ show' m12 ++ ", " ++ show' m22 ++ ", " ++ show' m32 ++ "\n" ++

+        show' m03 ++ ", " ++ show' m13 ++ ", " ++ show' m23 ++ ", " ++ show' m33 ++ "\n"

+        where

+            show' f = if abs f < 0.0000001 then "0" else show f

+

+

+instance Num Matrix4 where

+    (Matrix4 a00 a01 a02 a03 a04 a05 a06 a07 a08 a09 a10 a11 a12 a13 a14 a15)

+        + (Matrix4 b00 b01 b02 b03 b04 b05 b06 b07 b08 b09 b10 b11 b12 b13 b14 b15)

+            = Matrix4 (a00 + b00) (a01 + b01) (a02 + b02) (a03 + b03)

+                      (a04 + b04) (a05 + b05) (a06 + b06) (a07 + b07)

+                      (a08 + b08) (a09 + b09) (a10 + b10) (a11 + b11)

+                      (a12 + b12) (a13 + b13) (a14 + b14) (a15 + b15)

+    

+    (Matrix4 a00 a01 a02 a03 a04 a05 a06 a07 a08 a09 a10 a11 a12 a13 a14 a15)

+        - (Matrix4 b00 b01 b02 b03 b04 b05 b06 b07 b08 b09 b10 b11 b12 b13 b14 b15)

+            = Matrix4 (a00 - b00) (a01 - b01) (a02 - b02) (a03 - b03)

+                      (a04 - b04) (a05 - b05) (a06 - b06) (a07 - b07)

+                      (a08 - b08) (a09 - b09) (a10 - b10) (a11 - b11)

+                      (a12 - b12) (a13 - b13) (a14 - b14) (a15 - b15)

+    

+    (Matrix4 a00 a10 a20 a30 a01 a11 a21 a31 a02 a12 a22 a32 a03 a13 a23 a33)

+        * (Matrix4 b00 b10 b20 b30 b01 b11 b21 b31 b02 b12 b22 b32 b03 b13 b23 b33)

+            = Matrix4 (a00 * b00 + a10 * b01 + a20 * b02 + a30 * b03)

+                      (a00 * b10 + a10 * b11 + a20 * b12 + a30 * b13)

+                      (a00 * b20 + a10 * b21 + a20 * b22 + a30 * b23)

+                      (a00 * b30 + a10 * b31 + a20 * b32 + a30 * b33)

+                      

+                      (a01 * b00 + a11 * b01 + a21 * b02 + a31 * b03)

+                      (a01 * b10 + a11 * b11 + a21 * b12 + a31 * b13)

+                      (a01 * b20 + a11 * b21 + a21 * b22 + a31 * b23)

+                      (a01 * b30 + a11 * b31 + a21 * b32 + a31 * b33)

+                      

+                      (a02 * b00 + a12 * b01 + a22 * b02 + a32 * b03)

+                      (a02 * b10 + a12 * b11 + a22 * b12 + a32 * b13)

+                      (a02 * b20 + a12 * b21 + a22 * b22 + a32 * b23)

+                      (a02 * b30 + a12 * b31 + a22 * b32 + a32 * b33)

+                      

+                      (a03 * b00 + a13 * b01 + a23 * b02 + a33 * b03)

+                      (a03 * b10 + a13 * b11 + a23 * b12 + a33 * b13)

+                      (a03 * b20 + a13 * b21 + a23 * b22 + a33 * b23)

+                      (a03 * b30 + a13 * b31 + a23 * b32 + a33 * b33)

+    

+    abs = Spear.Math.Matrix4.map abs

+    

+    signum = Spear.Math.Matrix4.map signum

+    

+    fromInteger i = mat4 i' i' i' i' i' i' i' i' i' i' i' i' i' i' i' i' where i' = fromInteger i

+    

+    

+instance Storable Matrix4 where

+    sizeOf    _ = 64

+    alignment _ = 4

+    

+    peek ptr = do

+        a00 <- peekByteOff ptr 0;  a01 <- peekByteOff ptr 4;  a02 <- peekByteOff ptr 8;  a03 <- peekByteOff ptr 12;

+        a10 <- peekByteOff ptr 16; a11 <- peekByteOff ptr 20; a12 <- peekByteOff ptr 24; a13 <- peekByteOff ptr 28;

+        a20 <- peekByteOff ptr 32; a21 <- peekByteOff ptr 36; a22 <- peekByteOff ptr 40; a23 <- peekByteOff ptr 44;

+        a30 <- peekByteOff ptr 48; a31 <- peekByteOff ptr 52; a32 <- peekByteOff ptr 56; a33 <- peekByteOff ptr 60;

+        

+        return $ Matrix4 a00 a10 a20 a30

+                         a01 a11 a21 a31

+                         a02 a12 a22 a32

+                         a03 a13 a23 a33

+    

+    poke ptr (Matrix4 a00 a10 a20 a30

+                      a01 a11 a21 a31

+                      a02 a12 a22 a32

+                      a03 a13 a23 a33) = do

+        pokeByteOff ptr 0  a00; pokeByteOff ptr 4  a01; pokeByteOff ptr 8  a02; pokeByteOff ptr 12 a03;

+        pokeByteOff ptr 16 a10; pokeByteOff ptr 20 a11; pokeByteOff ptr 24 a12; pokeByteOff ptr 28 a13;

+        pokeByteOff ptr 32 a20; pokeByteOff ptr 36 a21; pokeByteOff ptr 40 a22; pokeByteOff ptr 44 a23;

+        pokeByteOff ptr 48 a30; pokeByteOff ptr 52 a31; pokeByteOff ptr 56 a32; pokeByteOff ptr 60 a33;

+

+

+col0 (Matrix4 a00 _   _   _   a01 _   _   _   a02 _   _   _   a03 _   _   _  ) = vec4 a00 a01 a02 a03

+col1 (Matrix4 _   a10 _   _   _   a11 _   _   _   a12 _   _   _   a13 _   _  ) = vec4 a10 a11 a12 a13

+col2 (Matrix4 _   _   a20 _   _   _   a21 _   _   _   a22 _   _   _   a23 _  ) = vec4 a20 a21 a22 a23

+col3 (Matrix4 _   _   _   a30 _   _   _   a31 _   _   _   a32 _   _   _   a33) = vec4 a30 a31 a32 a33

+

+

+row0 (Matrix4 a00 a01 a02 a03 _   _   _   _   _   _   _   _   _   _   _   _  ) = vec4 a00 a01 a02 a03

+row1 (Matrix4 _   _   _   _   a10 a11 a12 a13 _   _   _   _   _   _   _   _  ) = vec4 a10 a11 a12 a13

+row2 (Matrix4 _   _   _   _   _   _   _   _   a20 a21 a22 a23 _   _   _   _  ) = vec4 a20 a21 a22 a23

+row3 (Matrix4 _   _   _   _   _   _   _   _   _   _   _   _   a30 a31 a32 a33) = vec4 a30 a31 a32 a33

+

+

+right    (Matrix4 a00 _   _   _   a01 _   _   _   a02 _   _   _   _   _   _   _) = vec3 a00 a01 a02

+up       (Matrix4 _   a10 _   _   _   a11 _   _   _   a12 _   _   _   _   _   _) = vec3 a10 a11 a12

+forward  (Matrix4 _   _   a20 _   _   _   a21 _   _   _   a22 _   _   _   _   _) = vec3 a20 a21 a22

+position (Matrix4 _   _   _   a30 _   _   _   a31 _   _   _   a32 _   _   _   _) = vec3 a30 a31 a32

+

+

+-- | Build a matrix from the specified values.

+mat4 :: Float -> Float -> Float -> Float ->

+        Float -> Float -> Float -> Float ->

+        Float -> Float -> Float -> Float ->

+        Float -> Float -> Float -> Float -> Matrix4

+mat4 m00 m10 m20 m30 m01 m11 m21 m31 m02 m12 m22 m32 m03 m13 m23 m33 = Matrix4

+    m00 m10 m20 m30

+    m01 m11 m21 m31

+    m02 m12 m22 m32

+    m03 m13 m23 m33

+

+

+-- | Build a matrix from four vectors in 4D.

+mat4fromVec :: Vector4 -> Vector4 -> Vector4 -> Vector4 -> Matrix4

+mat4fromVec v0 v1 v2 v3 = Matrix4

+    (Vector4.x v0) (Vector4.x v1) (Vector4.x v2) (Vector4.x v3)

+    (Vector4.y v0) (Vector4.y v1) (Vector4.y v2) (Vector4.y v3)

+    (Vector4.z v0) (Vector4.z v1) (Vector4.z v2) (Vector4.z v3)

+    (Vector4.w v0) (Vector4.w v1) (Vector4.w v2) (Vector4.w v3)

+

+

+-- | Build a transformation 'Matrix4' from the given vectors.

+transform :: Vector3 -- ^ Right vector.

+          -> Vector3 -- ^ Up vector.

+          -> Vector3 -- ^ Forward vector.

+          -> Vector3 -- ^ Position.

+          -> Matrix4

+

+transform right up fwd pos = mat4

+    (Vector3.x right) (Vector3.x up) (Vector3.x fwd) (Vector3.x pos)

+    (Vector3.y right) (Vector3.y up) (Vector3.y fwd) (Vector3.y pos)

+    (Vector3.z right) (Vector3.z up) (Vector3.z fwd) (Vector3.z pos)

+    0                 0              0               1

+
+
+-- | Build a transformation 'Matrix4' defined by the given position and target.
+--
+-- This function is essentially like gluLookAt.
+lookAt :: Vector3 -- ^ Eye position.
+       -> Vector3 -- ^ Target point.
+       -> Vector3 -- ^ Up vector.
+       -> Matrix4
+
+lookAt pos target up =
+        let fwd = Vector3.normalise $ target - pos
+            r   = fwd `cross` up
+        in
+            transform r up (-fwd) pos
+

+

+-- | Zip two matrices together with the specified function.

+zipWith :: (Float -> Float -> Float) -> Matrix4 -> Matrix4 -> Matrix4

+zipWith f a b = Matrix4

+    (f (m00 a) (m00 b)) (f (m10 a) (m10 b)) (f (m20 a) (m20 b)) (f (m30 a) (m30 b))

+    (f (m01 a) (m01 b)) (f (m11 a) (m11 b)) (f (m21 a) (m21 b)) (f (m31 a) (m31 b))

+    (f (m02 a) (m02 b)) (f (m12 a) (m12 b)) (f (m22 a) (m22 b)) (f (m32 a) (m32 b))

+    (f (m03 a) (m03 b)) (f (m13 a) (m13 b)) (f (m23 a) (m23 b)) (f (m33 a) (m33 b))

+

+

+-- | Map the specified function to the specified matrix.

+map :: (Float -> Float) -> Matrix4 -> Matrix4

+map f m = Matrix4

+    (f . m00 $ m) (f . m10 $ m) (f . m20 $ m) (f . m30 $ m)

+    (f . m01 $ m) (f . m11 $ m) (f . m21 $ m) (f . m31 $ m)

+    (f . m02 $ m) (f . m12 $ m) (f . m22 $ m) (f . m32 $ m)

+    (f . m03 $ m) (f . m13 $ m) (f . m23 $ m) (f . m33 $ m)

+

+

+-- | Return the identity matrix.

+id :: Matrix4

+id = mat4

+    1   0   0   0

+    0   1   0   0

+    0   0   1   0

+    0   0   0   1

+

+

+-- | Create a translation matrix.

+transl :: Float -> Float -> Float -> Matrix4

+transl x y z = mat4

+    1   0   0   x

+    0   1   0   y

+    0   0   1   z

+    0   0   0   1

+

+

+-- | Create a translation matrix.

+translv :: Vector3 -> Matrix4

+translv v = mat4

+    1    0    0    (Vector3.x v)

+    0    1    0    (Vector3.y v)

+    0    0    1    (Vector3.z v)

+    0    0    0    1

+

+

+-- | Create a rotation matrix rotating about the X axis.

+-- The given angle must be in degrees.

+rotX :: Float -> Matrix4

+rotX angle = mat4

+    1    0    0    0

+    0    c    (-s) 0

+    0    s    c    0

+    0    0    0    1

+    where

+        s = sin . toRAD $ angle

+        c = cos . toRAD $ angle

+

+

+-- | Create a rotation matrix rotating about the Y axis.

+-- The given angle must be in degrees.

+rotY :: Float -> Matrix4

+rotY angle = mat4

+    c    0    s    0

+    0    1    0    0

+    (-s) 0    c    0

+    0    0    0    1

+    where

+        s = sin . toRAD $ angle

+        c = cos . toRAD $ angle

+

+

+-- | Create a rotation matrix rotating about the Z axis.

+-- The given angle must be in degrees.

+rotZ :: Float -> Matrix4

+rotZ angle = mat4

+    c    (-s) 0    0

+    s    c    0    0

+    0    0    1    0

+    0    0    0    1

+    where

+        s = sin . toRAD $ angle

+        c = cos . toRAD $ angle

+

+

+-- | Create a rotation matrix rotating about the specified axis.

+-- The given angle must be in degrees.

+axisAngle :: Vector3 -> Float -> Matrix4

+axisAngle v angle = mat4

+    (c + omc*x^2) (omc*xy-sz) (omc*xz+sy) 0

+    (omc*xy+sz)   (c+omc*y^2) (omc*yz-sx) 0

+    (omc*xz-sy)   (omc*yz+sx) (c+omc*z^2) 0

+     0             0           0          1

+    where

+        x = Vector3.x v

+        y = Vector3.y v

+        z = Vector3.z v

+        s   = sin . toRAD $ angle

+        c   = cos . toRAD $ angle

+        xy  = x*y

+        xz  = x*z

+        yz  = y*z

+        sx  = s*x

+        sy  = s*y

+        sz  = s*z

+        omc = 1 - c

+

+

+-- | Create a scale matrix.

+scale :: Float -> Float -> Float -> Matrix4

+scale sx sy sz = mat4

+    sx  0   0   0

+    0   sy  0   0

+    0   0   sz  0

+    0   0   0   1

+    

+    

+-- | Create a scale matrix.

+scalev :: Vector3 -> Matrix4

+scalev v = mat4

+    sx  0   0   0

+    0   sy  0   0

+    0   0   sz  0

+    0   0   0   1

+        where

+            sx = Vector3.x v

+            sy = Vector3.y v

+            sz = Vector3.z v

+

+

+-- | Create an X reflection matrix.

+reflectX :: Matrix4

+reflectX = mat4

+    (-1)  0   0   0

+    0     1   0   0

+    0     0   1   0

+    0     0   0   1

+

+

+-- | Create a Y reflection matrix.

+reflectY :: Matrix4

+reflectY = mat4

+    1   0     0   0

+    0   (-1)  0   0

+    0   0     1   0

+    0   0     0   1

+

+

+-- | Create a Z reflection matrix.

+reflectZ :: Matrix4

+reflectZ = mat4

+    1   0   0     0

+    0   1   0     0

+    0   0   (-1)  0

+    0   0   0     1

+

+

+-- | Create an orthogonal projection matrix.

+ortho :: Float -- ^ Left.

+      -> Float -- ^ Right.

+      -> Float -- ^ Bottom.

+      -> Float -- ^ Top.

+      -> Float -- ^ Near clip.

+      -> Float -- ^ Far clip.

+      -> Matrix4

+

+ortho l r b t n f =

+    let tx = (-(r+l)/(r-l))

+        ty = (-(t+b)/(t-b))

+        tz = (-(f+n)/(f-n))

+    in mat4

+        (2/(r-l)) 0         0            tx

+        0         (2/(t-b)) 0            ty

+        0         0         ((-2)/(f-n)) tz

+        0         0         0            1

+

+

+-- | Create a perspective projection matrix.

+perspective :: Float -- ^ Fovy - Vertical field of view angle in degrees.

+            -> Float -- ^ Aspect ratio.

+            -> Float -- ^ Near clip distance.

+            -> Float -- ^ Far clip distance

+            -> Matrix4

+perspective fovy r near far =

+    let f = 1 / tan (toRAD fovy / 2)

+        a = near - far

+    in mat4

+        (f/r) 0    0              0

+        0     f    0              0

+        0     0    ((near+far)/a) (2*near*far/a)

+        0     0    (-1)           0

+

+    

+-- | Transpose the specified matrix.

+transpose :: Matrix4 -> Matrix4

+transpose m = mat4

+    (m00 m) (m01 m) (m02 m) (m03 m)

+    (m10 m) (m11 m) (m12 m) (m13 m)

+    (m20 m) (m21 m) (m22 m) (m23 m)

+    (m30 m) (m31 m) (m32 m) (m33 m)

+

+

+-- | Invert the given transformation matrix.

+inverseTransform :: Matrix4 -> Matrix4

+inverseTransform mat = mat4fromVec u v w p where

+    u = vec4 (Vector4.x $ col0 mat) (Vector4.y $ col0 mat) (Vector4.z $ col0 mat) 0

+    v = vec4 (Vector4.x $ col1 mat) (Vector4.y $ col1 mat) (Vector4.z $ col1 mat) 0

+    w = vec4 (Vector4.x $ col2 mat) (Vector4.y $ col2 mat) (Vector4.z $ col2 mat) 0

+    p = vec4 tdotu tdotv tdotw 1

+    t = -(col3 mat)

+    tdotu = t `Vector4.dot` u

+    tdotv = t `Vector4.dot` v

+    tdotw = t `Vector4.dot` w

+

+

+-- | Invert the given matrix.

+{-inverse :: Matrix4 -> Matrix4

+inverse mat = mat4 i0 i1 i2 i3 i4 i5 i6 i7 i8 i9 i10 i11 i12 i13 i14 i15

+    where

+        i0 = -}

+

+

+-- | Transform the given vector in 3D space with the given matrix.

+mul :: Float -> Matrix4 -> Vector3 -> Vector3

+mul w m v = vec3 x' y' z'

+    where

+        v' = vec4 (Vector3.x v) (Vector3.y v) (Vector3.z v) w

+        x' = row0 m `Vector4.dot` v'

+        y' = row1 m `Vector4.dot` v'

+        z' = row2 m `Vector4.dot` v'

+

+

+-- | Transform the given point vector in 3D space with the given matrix.

+mulp :: Matrix4 -> Vector3 -> Vector3

+mulp = mul 1

+

+

+-- | Transform the given directional vector in 3D space with the given matrix.

+muld :: Matrix4 -> Vector3 -> Vector3

+muld = mul 0

+

+

+toRAD = (*pi) . (/180)

diff --git a/Spear/Math/MatrixUtils.hs b/Spear/Math/MatrixUtils.hs
new file mode 100644
index 0000000..88ad3b1
--- /dev/null
+++ b/Spear/Math/MatrixUtils.hs
@@ -0,0 +1,18 @@
+module Spear.Math.MatrixUtils
+(
+    fastNormalMatrix
+)
+where
+
+
+import Spear.Math.Matrix3 as M3
+import Spear.Math.Matrix4 as M4
+
+
+fastNormalMatrix :: Matrix4 -> Matrix3
+fastNormalMatrix m =
+    let m' = M4.transpose . M4.inverseTransform $ m
+    in  M3.mat3
+        (M4.m00 m') (M4.m10 m') (M4.m20 m')
+        (M4.m01 m') (M4.m11 m') (M4.m21 m')
+        (M4.m02 m') (M4.m12 m') (M4.m22 m')
diff --git a/Spear/Math/Octree.hs b/Spear/Math/Octree.hs
new file mode 100644
index 0000000..74689a0
--- /dev/null
+++ b/Spear/Math/Octree.hs
@@ -0,0 +1,282 @@
+module Spear.Math.Octree
+(
+    Octree
+,   makeOctree
+,   clone
+,   Spear.Math.Octree.insert
+,   insertl
+,   Spear.Math.Octree.map
+,   gmap
+,   population
+)
+where
+
+import Spear.Collision.AABB as AABB
+import Spear.Collision.Types
+import Spear.Math.Vector3 as Vector
+
+import Control.Applicative ((<*>))
+import Data.List
+import Data.Functor
+import Data.Monoid
+import qualified Data.Foldable as F
+
+
+-- | Represents an Octree.
+data Octree e
+    = Octree
+    {
+        root    :: AABB,
+        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 :: AABB,
+        ents :: [e]
+    }
+
+
+-- | Builds an Octree using the specified AABB as the root and having the specified depth.
+makeOctree :: Int -> AABB -> Octree e
+makeOctree d root@(AABB 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 :: AABB -> [AABB]
+subdivide (AABB min max) = [a1, a2, a3, a4, a5, a6, a7, a8]
+    where
+        v = (max-min) / 2
+        c = vec3 (x min + x v) (y min + y v) (z min + z v)
+        a1 = AABB min c
+        a2 = AABB ( vec3 (x min) (y min) (z c)   ) ( vec3 (x c)   (y c)   (z max) )
+        a3 = AABB ( vec3 (x min) (y c)   (z min) ) ( vec3 (x c)   (y max) (z c)   )
+        a4 = AABB ( vec3 (x min) (y c)   (z c)   ) ( vec3 (x c)   (y max) (z max) )
+        a5 = AABB ( vec3 (x c)   (y min) (z min) ) ( vec3 (x max) (y c)   (z c)   )
+        a6 = AABB ( vec3 (x c)   (y min) (z c)   ) ( vec3 (x max) (y c)   (z max) )
+        a7 = AABB ( vec3 (x c)   (y c)   (z min) ) ( vec3 (x max) (y max) (z c)   )
+        a8 = AABB c max
+
+
+-- | Clones the structure of an 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 -> AABB -> CollisionType) -> AABB -> e -> Bool
+keep testAABB aabb e = test == FullyContainedBy || test == Equal
+    where test = e `testAABB` aabb
+
+
+-- | Inserts an entity into the given octree.
+insert :: (e -> AABB -> CollisionType) -> Octree e -> e -> Octree e
+insert testAABB octree e = octree' where (octree', _) = insert' testAABB e octree
+
+
+insert' :: (e -> AABB -> CollisionType) -> e -> Octree e -> (Octree e, Bool)
+
+
+insert' testAABB e l@(Leaf root ents)
+    | test == True = (Leaf root (e:ents), True)
+    | otherwise    = (l, False)
+    where
+        test  = keep testAABB root e
+
+
+insert' testAABB e o@(Octree root ents c1 c2 c3 c4 c5 c6 c7 c8)
+    | test == False = (o, False)
+    | otherwise =
+        if isContainedInChild then (Octree root ents c1' c2' c3' c4' c5' c6' c7' c8', True)
+        else (Octree root (e:ents) c1 c2 c3 c4 c5 c6 c7 c8, True)
+        where
+            children = [c1,c2,c3,c4,c5,c6,c7,c8]
+            test    = keep testAABB root e
+            descend = fmap (Spear.Math.Octree.insert' testAABB e) children
+            (children', results) = unzip descend
+            isContainedInChild = or results
+            c1' = children' !! 0
+            c2' = children' !! 1
+            c3' = children' !! 2
+            c4' = children' !! 3
+            c5' = children' !! 4
+            c6' = children' !! 5
+            c7' = children' !! 6
+            c8' = children' !! 7
+            
+            
+-- | Inserts a list of entities into the given octree.
+insertl :: (e -> AABB -> CollisionType) -> Octree e -> [e] -> Octree e
+insertl testAABB octree es = octree' where (octree', _) = insertl' testAABB es octree
+
+
+insertl' :: (e -> AABB -> CollisionType) -> [e] -> Octree e -> (Octree e, [e])
+
+insertl' 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
+        
+insertl' testAABB 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 testAABB root) new_ents
+        outliers     = filter (not . keep testAABB root) new_ents
+        (c1', ents1) = insertl' testAABB es c1
+        (c2', ents2) = insertl' testAABB es c2
+        (c3', ents3) = insertl' testAABB es c3
+        (c4', ents4) = insertl' testAABB es c4
+        (c5', ents5) = insertl' testAABB es c5
+        (c6', ents6) = insertl' testAABB es c6
+        (c7', ents7) = insertl' testAABB es c7
+        (c8', ents8) = insertl' testAABB es c8
+
+
+-- | Extracts all entities from an 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
+
+
+-- | Applies the given function to the entities in the octree.
+-- Entities that break out of their cell are reallocated appropiately.
+map :: (e -> AABB -> CollisionType) -> (e -> e) -> Octree e -> Octree e
+map testAABB f o = let (o', outliers) = map' testAABB f o in insertl testAABB o' outliers
+
+
+map' :: (e -> AABB -> CollisionType) -> (e -> e) -> Octree e -> (Octree 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 (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 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 appropiately.
+gmap :: (e -> AABB -> CollisionType) -> (e -> e -> e) -> Octree e -> Octree e
+gmap testAABB f o = let (o', outliers) = gmap' testAABB f o in insertl testAABB o' outliers
+
+
+gmap' :: (e -> AABB -> CollisionType) -> (e -> e -> e) -> Octree e -> (Octree 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 (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 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 :: Octree e -> Int
+population = F.foldr (\_ acc -> acc+1) 0
+
+
+
+
+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/Plane.hs b/Spear/Math/Plane.hs
new file mode 100644
index 0000000..0f5829b
--- /dev/null
+++ b/Spear/Math/Plane.hs
@@ -0,0 +1,33 @@
+module Spear.Math.Plane
+(
+        Plane
+,       plane
+,       classify
+)
+where
+
+
+import Spear.Math.Vector3 as Vector
+
+
+data PointPlanePos = Front | Back | Contained deriving (Eq, Ord, Show)
+
+
+data Plane = Plane {
+        n :: !Vector3,
+        d :: !Float
+} deriving(Eq, Show)
+
+
+-- | Create a plane given 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.
+classify :: Plane -> Vector3 -> PointPlanePos
+classify (Plane n d) pt = case (n `dot` pt - d) `compare` 0 of
+        GT -> Front
+        LT -> Back
+        EQ -> Contained
+        
\ No newline at end of file
diff --git a/Spear/Math/Quaternion.hs b/Spear/Math/Quaternion.hs
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/Spear/Math/Quaternion.hs
diff --git a/Spear/Math/Spatial.hs b/Spear/Math/Spatial.hs
new file mode 100644
index 0000000..d925f6f
--- /dev/null
+++ b/Spear/Math/Spatial.hs
@@ -0,0 +1,84 @@
+module Spear.Math.Spatial
+where
+
+
+import Spear.Math.Vector3
+import Spear.Math.Matrix4 as M
+
+
+class Spatial s where
+    -- | Move the 'Spatial'.
+    move :: Vector3 -> s -> s
+    
+    -- | Move the 'Spatial' forwards.
+    moveFwd :: Float -> s -> s
+    
+    -- | Move the 'Spatial' backwards.
+    moveBack :: Float -> s -> s
+    
+    -- | Make the 'Spatial' strafe left.
+    strafeLeft :: Float -> s -> s
+    
+    -- | Make the 'Spatial' Strafe right.
+    strafeRight :: Float -> s -> s
+    
+    -- | Rotate the 'Spatial' about its local X axis.
+    pitch :: Float -> s -> s
+    
+    -- | Rotate the 'Spatial' about its local Y axis.
+    yaw :: Float -> s -> s
+    
+    -- | Rotate the 'Spatial' about its local Z axis.
+    roll :: Float -> s -> s
+    
+    -- | Get the 'Spatial''s position.
+    pos :: s -> Vector3
+    
+    -- | Get the 'Spatial''s forward vector.
+    fwd :: s -> Vector3
+    
+    -- | Get the 'Spatial''s up vector.
+    up :: s -> Vector3
+    
+    -- | Get the 'Spatial''s right vector.
+    right :: s -> Vector3
+    
+    -- | Get the 'Spatial''s transform.
+    transform :: s -> Matrix4
+    
+    -- | Set the 'Spatial''s transform.
+    setTransform :: Matrix4 -> s -> s
+    
+    -- | Make the 'Spatial' look at the given point.
+    lookAt :: Vector3 -> s -> s
+    lookAt pt s =
+        let position = pos s
+            fwd      = normalise $ pt - position
+            r        = fwd `cross` unitY
+            u        = r `cross` fwd
+        in
+            setTransform (M.transform r u (-fwd) position) s
+    
+    -- | Make the 'Spatial' orbit around the given point
+    orbit :: Vector3 -- ^ Target point
+          -> Float   -- ^ Horizontal angle
+          -> Float   -- ^ Vertical angle
+          -> Float   -- ^ Orbit radius.
+          -> s
+          -> s
+    
+    orbit pt anglex angley radius s =
+        let ax = anglex * pi / 180
+            ay = angley * pi / 180
+            sx = sin ax
+            sy = sin ay
+            cx = cos ax
+            cy = cos ay
+            px = (x pt) + radius*cy*sx
+            py = (y pt) + radius*sy
+            pz = (z pt) + radius*cx*cy
+            r = Spear.Math.Spatial.right s
+            u = Spear.Math.Spatial.up s
+            f = Spear.Math.Spatial.fwd s
+        in
+            setTransform (M.transform u r f (vec3 px py pz)) s
diff --git a/Spear/Math/Vector3.hs b/Spear/Math/Vector3.hs
new file mode 100644
index 0000000..fad6e01
--- /dev/null
+++ b/Spear/Math/Vector3.hs
@@ -0,0 +1,217 @@
+module Spear.Math.Vector3

+(

+    Vector3

+    -- * Accessors

+,   x

+,   y

+,   z

+    -- * Construction

+,   unitX

+,   unitY

+,   unitZ

+,   zero

+,   fromList

+,   vec3
+,   orbit

+    -- * Operations

+,   Spear.Math.Vector3.min

+,   Spear.Math.Vector3.max

+,   Spear.Math.Vector3.zipWith

+,   Spear.Math.Vector3.map

+,   dot

+,   cross

+,   normSq

+,   norm

+,   scale

+,   normalise

+,   neg

+)

+where

+

+import Foreign.C.Types (CFloat)

+import Foreign.Storable

+

+

+-- | Represents a vector in 3D.

+data Vector3 = Vector3 !Float !Float !Float deriving (Eq, Show)

+

+

+instance Num Vector3 where

+    Vector3 ax ay az + Vector3 bx by bz = Vector3 (ax + bx) (ay + by) (az + bz)

+    Vector3 ax ay az - Vector3 bx by bz = Vector3 (ax - bx) (ay - by) (az - bz)

+    Vector3 ax ay az * Vector3 bx by bz = Vector3 (ax * bx) (ay * by) (az * bz)

+    abs (Vector3 ax ay az) = Vector3 (abs ax) (abs ay) (abs az)

+    signum (Vector3 ax ay az) = Vector3 (signum ax) (signum ay) (signum az)

+    fromInteger i = Vector3 i' i' i' where i' = fromInteger i

+    

+    

+instance Fractional Vector3 where

+    Vector3 ax ay az / Vector3 bx by bz = Vector3 (ax / bx) (ay / by) (az / bz)

+    fromRational r = Vector3 r' r' r' where r' = fromRational r

+    

+    

+instance Ord Vector3 where

+    Vector3 ax ay az <= Vector3 bx by bz

+        =  (ax <= bx)

+        || (az == bx && ay <= by)

+        || (ax == bx && ay == by && az <= bz)

+    

+    Vector3 ax ay az >= Vector3 bx by bz

+        =  (ax >= bx)

+        || (ax == bx && ay >= by)

+        || (ax == bx && ay == by && az >= bz)

+    

+    Vector3 ax ay az < Vector3 bx by bz

+        =  (ax < bx)

+        || (az == bx && ay < by)

+        || (ax == bx && ay == by && az < bz)

+    

+    Vector3 ax ay az > Vector3 bx by bz

+        =  (ax > bx)

+        || (ax == bx && ay > by)

+        || (ax == bx && ay == by && az > bz)

+

+

+sizeFloat = sizeOf (undefined :: CFloat)

+

+

+instance Storable Vector3 where

+    sizeOf _    = 3*sizeFloat

+    alignment _ = alignment (undefined :: CFloat)

+    

+    peek ptr = do

+        ax <- peekByteOff ptr 0

+        ay <- peekByteOff ptr $ 1*sizeFloat

+        az <- peekByteOff ptr $ 2*sizeFloat

+        return (Vector3 ax ay az)

+    

+    poke ptr (Vector3 ax ay az) = do

+        pokeByteOff ptr 0 ax

+        pokeByteOff ptr (1*sizeFloat) ay

+        pokeByteOff ptr (2*sizeFloat) az

+    

+    

+x (Vector3 ax _  _ ) = ax

+y (Vector3 _  ay _ ) = ay

+z (Vector3 _  _  az) = az

+

+

+-- | Unit vector along the X axis.

+unitX :: Vector3

+unitX = Vector3 1 0 0

+

+

+-- | Unit vector along the Y axis.

+unitY :: Vector3

+unitY = Vector3 0 1 0

+

+

+-- | Unit vector along the Z axis.

+unitZ :: Vector3

+unitZ = Vector3 0 0 1

+

+

+-- | Zero vector.

+zero :: Vector3

+zero = Vector3 0 0 0

+

+

+-- | Create a vector from the given list.

+fromList :: [Float] -> Vector3

+fromList (ax:ay:az:_) = Vector3 ax ay az

+

+

+-- | Create a 3D vector from the given values.

+vec3 :: Float -> Float -> Float -> Vector3

+vec3 ax ay az = Vector3 ax ay az
+
+
+-- | Create a 3D vector as a point on a sphere.
+orbit :: Vector3 -- ^ Sphere center.
+      -> Float -- ^ Sphere radius
+      -> Float -- ^ Azimuth angle.
+      -> Float -- ^ Zenith angle.
+      -> Vector3
+
+orbit center radius anglex angley =
+    let ax = anglex * pi / 180
+        ay = angley * pi / 180
+        sx = sin ax
+        sy = sin ay
+        cx = cos ax
+        cy = cos ay
+        px = (x center) + radius*cy*sx
+        py = (y center) + radius*sy
+        pz = (z center) + radius*cx*cy
+    in
+        vec3 px py pz

+

+

+-- | Create a vector with components set to the minimum of each of the given vectors'.

+min :: Vector3 -> Vector3 -> Vector3

+min (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (Prelude.min ax bx) (Prelude.min ay by) (Prelude.min az bz)

+

+

+-- | Create a vector with components set to the maximum of each of the given vectors'.

+max :: Vector3 -> Vector3 -> Vector3

+max (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (Prelude.max ax bx) (Prelude.max ay by) (Prelude.max az bz)

+

+

+-- | Zip two vectors with the given function.

+zipWith :: (Float -> Float -> Float) -> Vector3 -> Vector3 -> Vector3

+zipWith f (Vector3 ax ay az) (Vector3 bx by bz) = Vector3 (f ax bx) (f ay by) (f az bz)

+

+

+-- | Folds a vector from the left.

+{-foldl :: (UV.Unbox b) => (a -> b -> a) -> a -> Vector3 b -> a

+foldl f acc (Vector3 v) = UV.foldl f acc v

+

+

+-- | Folds a vector from the right.

+foldr :: (UV.Unbox b) => (b -> a -> a) -> a -> Vector3 b -> a

+foldr f acc (Vector3 v) = UV.foldr f acc v-}

+

+

+-- | Map the given function over the given vector.

+map :: (Float -> Float) -> Vector3 -> Vector3

+map f (Vector3 ax ay az) = Vector3 (f ax) (f ay) (f az)

+

+

+-- | Compute the given vectors' dot product.

+dot :: Vector3 -> Vector3 -> Float

+Vector3 ax ay az `dot` Vector3 bx by bz = ax*bx + ay*by + az*bz

+

+

+-- | Compute the given vectors' cross product.

+cross :: Vector3 -> Vector3 -> Vector3

+(Vector3 ax ay az) `cross` (Vector3 bx by bz) =

+    Vector3 (ay * bz - az * by) (az * bx - ax * bz) (ax * by - ay * bx)

+    

+    

+-- | Compute the given vector's squared norm.

+normSq :: Vector3 -> Float

+normSq (Vector3 ax ay az) = ax*ax + ay*ay + az*az

+    

+

+-- | Compute the given vector's norm.

+norm :: Vector3 -> Float

+norm = sqrt . normSq

+

+

+-- | Multiply the given vector with the given scalar.

+scale :: Float -> Vector3 -> Vector3

+scale s (Vector3 ax ay az) = Vector3 (s*ax) (s*ay) (s*az)

+

+

+-- | Normalise the given vector.

+normalise :: Vector3 -> Vector3

+normalise v =

+    let n' = norm v

+        n = if n' == 0 then 1 else n'

+    in

+        scale (1.0 / n) v

+

+

+-- | Negate the given vector.

+neg :: Vector3 -> Vector3

+neg (Vector3 ax ay az) = Vector3 (-ax) (-ay) (-az)

diff --git a/Spear/Math/Vector4.hs b/Spear/Math/Vector4.hs
new file mode 100644
index 0000000..2dd852a
--- /dev/null
+++ b/Spear/Math/Vector4.hs
@@ -0,0 +1,200 @@
+module Spear.Math.Vector4

+(

+    Vector4

+    -- * Accessors

+,   x

+,   y

+,   z

+,   w

+    -- * Construction

+,   unitX

+,   unitY

+,   unitZ

+,   fromList

+,   vec4

+    -- * Operations

+,   Spear.Math.Vector4.min

+,   Spear.Math.Vector4.max

+,   Spear.Math.Vector4.zipWith

+,   Spear.Math.Vector4.map

+,   dot

+,   normSq

+,   norm

+,   scale

+,   normalise

+,   neg

+)

+where

+

+

+import Foreign.C.Types (CFloat)

+import Foreign.Storable

+

+

+-- | Represents a vector in 3D.

+data Vector4 = Vector4 !Float !Float !Float !Float deriving (Eq, Show)

+

+

+instance Num Vector4 where

+    Vector4 ax ay az aw + Vector4 bx by bz bw = Vector4 (ax + bx) (ay + by) (az + bz) (aw + bw)

+    Vector4 ax ay az aw - Vector4 bx by bz bw = Vector4 (ax - bx) (ay - by) (az - bz) (aw - bw)

+    Vector4 ax ay az aw * Vector4 bx by bz bw = Vector4 (ax * bx) (ay * by) (az * bz) (aw * bw)

+    abs (Vector4 ax ay az aw) = Vector4 (abs ax) (abs ay) (abs az) (abs aw)

+    signum (Vector4 ax ay az aw) = Vector4 (signum ax) (signum ay) (signum az) (signum aw)

+    fromInteger i = Vector4 i' i' i' i' where i' = fromInteger i

+    

+    

+instance Fractional Vector4 where

+    Vector4 ax ay az aw / Vector4 bx by bz bw = Vector4 (ax / bx) (ay / by) (az / bz) (aw / bw)

+    fromRational r = Vector4 r' r' r' r' where r' = fromRational r

+    

+    

+instance Ord Vector4 where

+    Vector4 ax ay az aw <= Vector4 bx by bz bw

+        =  (ax <= bx)

+        || (az == bx && ay <= by)

+        || (ax == bx && ay == by && az <= bz)

+        || (ax == bx && ay == by && az == bz && aw <= bw)

+    

+    Vector4 ax ay az aw >= Vector4 bx by bz bw

+        =  (ax >= bx)

+        || (ax == bx && ay >= by)

+        || (ax == bx && ay == by && az >= bz)

+        || (ax == bx && ay == by && az == bz && aw >= bw)

+    

+    Vector4 ax ay az aw < Vector4 bx by bz bw

+        =  (ax < bx)

+        || (az == bx && ay < by)

+        || (ax == bx && ay == by && az < bz)

+        || (ax == bx && ay == by && az == bz && aw < bw)

+    

+    Vector4 ax ay az aw > Vector4 bx by bz bw

+        =  (ax > bx)

+        || (ax == bx && ay > by)

+        || (ax == bx && ay == by && az > bz)

+        || (ax == bx && ay == by && az == bz && aw > bw)

+

+

+sizeFloat = sizeOf (undefined :: CFloat)

+

+

+instance Storable Vector4 where

+    sizeOf _    = 4*sizeFloat

+    alignment _ = alignment (undefined :: CFloat)

+    

+    peek ptr = do

+        ax <- peekByteOff ptr 0

+        ay <- peekByteOff ptr $ 1 * sizeFloat

+        az <- peekByteOff ptr $ 2 * sizeFloat

+        aw <- peekByteOff ptr $ 3 * sizeFloat

+        return (Vector4 ax ay az aw)

+        

+    poke ptr (Vector4 ax ay az aw) = do

+        pokeByteOff ptr 0 ax

+        pokeByteOff ptr (1 * sizeFloat) ay

+        pokeByteOff ptr (2 * sizeFloat) az

+        pokeByteOff ptr (3 * sizeFloat) aw

+    

+    

+x (Vector4 ax _  _  _ ) = ax

+y (Vector4 _  ay _  _ ) = ay

+z (Vector4 _  _  az _ ) = az

+w (Vector4 _  _  _  aw) = aw

+

+

+-- | Unit vector along the X axis.

+unitX :: Vector4

+unitX = Vector4 1 0 0 0

+

+

+-- | Unit vector along the Y axis.

+unitY :: Vector4

+unitY = Vector4 0 1 0 0

+

+

+-- | Unit vector along the Z axis.

+unitZ :: Vector4

+unitZ = Vector4 0 0 1 0

+

+

+-- | Create a vector from the given list.

+fromList :: [Float] -> Vector4

+fromList (ax:ay:az:aw:_) = Vector4 ax ay az aw

+

+

+-- | Create a 4D vector from the given values.

+vec4 :: Float -> Float -> Float -> Float -> Vector4

+vec4 ax ay az aw = Vector4 ax ay az aw

+

+

+-- | Create a vector whose components are the minimum of each of the given vectors'.

+min :: Vector4 -> Vector4 -> Vector4

+min (Vector4 ax ay az aw) (Vector4 bx by bz bw) =

+    Vector4 (Prelude.min ax bx) (Prelude.min ay by) (Prelude.min az bz) (Prelude.min aw bw)

+

+

+-- | Create a vector whose components are the maximum of each of the given vectors'.

+max :: Vector4 -> Vector4 -> Vector4

+max (Vector4 ax ay az aw) (Vector4 bx by bz bw) =

+    Vector4 (Prelude.max ax bx) (Prelude.max ay by) (Prelude.max az bz) (Prelude.min aw bw)

+

+

+-- | Zip two vectors with the given function.

+zipWith :: (Float -> Float -> Float) -> Vector4 -> Vector4 -> Vector4

+zipWith f (Vector4 ax ay az aw) (Vector4 bx by bz bw) = Vector4 (f ax bx) (f ay by) (f az bz) (f aw bw)

+

+

+-- | Folds a vector from the left.

+{-foldl :: (UV.Unbox b) => (a -> b -> a) -> a -> Vector4 b -> a

+foldl f acc (Vector4 v) = UV.foldl f acc v

+

+

+-- | Folds a vector from the right.

+foldr :: (UV.Unbox b) => (b -> a -> a) -> a -> Vector4 b -> a

+foldr f acc (Vector4 v) = UV.foldr f acc v-}

+

+

+-- | Map the given function over the given vector.

+map :: (Float -> Float) -> Vector4 -> Vector4

+map f (Vector4 ax ay az aw) = Vector4 (f ax) (f ay) (f az) (f aw)

+

+

+-- | Compute the given vectors' dot product.

+dot :: Vector4 -> Vector4 -> Float

+Vector4 ax ay az aw `dot` Vector4 bx by bz bw = ax*bx + ay*by + az*bz + aw*bw

+

+

+-- | Compute the given vectors' cross product.

+-- The vectors are projected to 3D space. The resulting vector is the cross product of the vectors' projections with w=0.

+cross :: Vector4 -> Vector4 -> Vector4

+(Vector4 ax ay az _) `cross` (Vector4 bx by bz _) =

+    Vector4 (ay * bz - az * by) (az * bx - ax * bz) (ax * by - ay * bx) 0

+    

+    

+-- | Compute the given vector's squared norm.

+normSq :: Vector4 -> Float

+normSq (Vector4 ax ay az aw) = ax*ax + ay*ay + az*az + aw*aw

+    

+

+-- | Compute the given vector's norm.

+norm :: Vector4 -> Float

+norm = sqrt . normSq

+

+

+-- | Multiply the given vector with the given scalar.

+scale :: Float -> Vector4 -> Vector4

+scale s (Vector4 ax ay az aw) = Vector4 (s*ax) (s*ay) (s*az) (s*aw)

+

+

+-- | Normalise the given vector.

+normalise :: Vector4 -> Vector4

+normalise v =

+    let n' = norm v

+        n = if n' == 0 then 1 else n'

+    in

+        scale (1.0 / n) v

+

+

+-- | Negate the given vector.

+neg :: Vector4 -> Vector4

+neg (Vector4 ax ay az aw) = Vector4 (-ax) (-ay) (-az) (-aw)

diff --git a/Spear/Render/AnimatedModel.hs b/Spear/Render/AnimatedModel.hs
new file mode 100644
index 0000000..cc31f12
--- /dev/null
+++ b/Spear/Render/AnimatedModel.hs
@@ -0,0 +1,183 @@
+module Spear.Render.AnimatedModel
+(
+    AnimatedModelResource
+,   AnimatedModelRenderer
+,   animatedModelResource
+,   animatedModelRenderer
+,   Spear.Render.AnimatedModel.release
+,   setAnimation
+,   currentAnimation
+,   bind
+,   render
+)
+where
+
+
+import Spear.Assets.Model
+import Spear.Render.Model
+import Spear.GLSL
+import Spear.Render.Material
+import Spear.Render.Program
+import Spear.Updatable
+import Spear.Setup as Setup
+
+import Control.Applicative ((<$>), (<*>))
+import Graphics.Rendering.OpenGL.Raw.Core31
+import Unsafe.Coerce (unsafeCoerce)
+
+
+-- | An animated model resource.
+--
+-- Contains model data necessary to render an animated model.
+data AnimatedModelResource = AnimatedModelResource
+    { model     :: Model
+    , vao       :: VAO
+    , nFrames   :: Int
+    , nVertices :: Int
+    , material  :: Material
+    , texture   :: Texture
+    , rkey      :: Resource
+    }
+
+
+instance Eq AnimatedModelResource where
+    m1 == m2 = vao m1 == vao m2
+
+
+instance Ord AnimatedModelResource where
+    m1 < m2 = vao m1 < vao m2
+
+
+-- | An animated model renderer.
+--
+-- Holds animation data necessary to render an animated model and a reference
+-- to an 'AnimatedModelResource'.
+--
+-- Model data is kept separate from animation data. This allows instances
+-- of 'AnimatedModelRenderer' to share the underlying 'AnimatedModelResource',
+-- minimising the amount of data in memory and allowing one to minimise OpenGL
+-- state changes by sorting 'AnimatedModelRenderer's by their underlying
+-- 'AnimatedModelResource' when rendering the scene.
+data AnimatedModelRenderer = AnimatedModelRenderer
+    { modelResource :: AnimatedModelResource
+    , currentAnim   :: Int
+    , frameStart    :: Int
+    , frameEnd      :: Int
+    , currentFrame  :: Int
+    , frameProgress :: Float
+    }
+
+
+instance Eq AnimatedModelRenderer where
+    m1 == m2 = modelResource m1 == modelResource m2
+
+
+instance Ord AnimatedModelRenderer where
+    m1 < m2 = modelResource m1 < modelResource m2
+
+
+-- | Create an 'AnimatedModelResource' from the given 'Model'.
+animatedModelResource :: AnimatedProgramChannels
+                      -> Material
+                      -> Texture
+                      -> Model
+                      -> Setup AnimatedModelResource
+
+animatedModelResource
+    (AnimatedProgramChannels vertChan1 vertChan2 normChan1 normChan2 texChan)
+    material texture model = do
+        RenderModel elements numFrames numVertices <- setupIO . renderModelFromModel $ model
+        elementBuf <- newBuffer
+        vao        <- newVAO
+        
+        setupIO $ do
+        
+            let elemSize  = 56
+                elemSize' = fromIntegral elemSize
+                n         = numVertices * numFrames            
+            
+            bindVAO vao
+            
+            bindBuffer elementBuf ArrayBuffer
+            bufferData ArrayBuffer (unsafeCoerce $ elemSize * n) elements StaticDraw
+            
+            attribVAOPointer vertChan1 3 gl_FLOAT False elemSize' 0
+            attribVAOPointer vertChan2 3 gl_FLOAT False elemSize' 12
+            attribVAOPointer normChan1 3 gl_FLOAT False elemSize' 24
+            attribVAOPointer normChan2 3 gl_FLOAT False elemSize' 36
+            attribVAOPointer texChan   2 gl_FLOAT False elemSize' 48
+            
+            enableVAOAttrib vertChan1
+            enableVAOAttrib vertChan2
+            enableVAOAttrib normChan1
+            enableVAOAttrib normChan2
+            enableVAOAttrib texChan
+            
+        rkey <- register . runSetup_ $ do
+            setupIO $ putStrLn "Releasing animated model resource"
+            releaseVAO vao
+            releaseBuffer elementBuf        
+        
+        return $ AnimatedModelResource
+            model vao (unsafeCoerce numFrames) (unsafeCoerce numVertices) material texture rkey
+
+
+-- | Release the given 'AnimatedModelResource'.
+release :: AnimatedModelResource -> Setup ()
+release = Setup.release . rkey
+
+
+-- | Create an 'AnimatedModelRenderer' from the given 'AnimatedModelResource'.
+animatedModelRenderer :: AnimatedModelResource -> AnimatedModelRenderer
+animatedModelRenderer modelResource = AnimatedModelRenderer modelResource 0 0 0 0 0
+
+
+instance Updatable AnimatedModelRenderer where
+    
+    update dt (AnimatedModelRenderer model curAnim startFrame endFrame curFrame fp) =
+        AnimatedModelRenderer model curAnim startFrame endFrame curFrame' fp'
+            where f = fp + dt
+                  nextFrame = f >= 1.0
+                  fp' = if nextFrame then f - 1.0 else f
+                  curFrame' = if nextFrame
+                              then let x = curFrame + 1 in if x > endFrame then startFrame else x
+                              else curFrame
+
+
+-- | Set the active animation to the given one.
+setAnimation :: Enum a => a -> AnimatedModelRenderer -> AnimatedModelRenderer
+setAnimation anim modelRend =
+    let (Animation _ f1 f2) = animation (model . modelResource $ modelRend) anim'
+        anim' = fromEnum anim
+    in
+        modelRend { currentAnim = anim', frameStart = f1, frameEnd = f2, currentFrame = f1 }
+
+
+-- | Get the renderer's current animation.
+currentAnimation :: Enum a => AnimatedModelRenderer -> a
+currentAnimation = toEnum . currentAnim
+
+
+-- | Bind the given 'AnimatedModelRenderer' to prepare it for rendering.
+bind :: AnimatedProgramUniforms -> AnimatedModelRenderer -> IO ()
+bind (AnimatedProgramUniforms kaLoc kdLoc ksLoc shiLoc texLoc _ _ _ _) modelRend =
+    let model' = modelResource modelRend
+    in do
+        bindVAO . vao $ model'
+        bindTexture $ texture model'
+        activeTexture $= gl_TEXTURE0
+        glUniform1i texLoc 0
+
+
+-- | Render the model described by the given 'AnimatedModelRenderer'.
+render :: AnimatedProgramUniforms -> AnimatedModelRenderer -> IO ()
+render uniforms (AnimatedModelRenderer model _ _ _ curFrame fp) =
+    let n = nVertices model
+        (Material _ ka kd ks shi) = material model
+    in do
+        uniformVec4 (kaLoc uniforms) ka
+        uniformVec4 (kdLoc uniforms) kd
+        uniformVec4 (ksLoc uniforms) ks
+        glUniform1f (shiLoc uniforms) $ unsafeCoerce shi
+        glUniform1f (fpLoc uniforms) (unsafeCoerce fp)
+        drawArrays gl_TRIANGLES (n*curFrame) n
diff --git a/Spear/Render/Box.hs b/Spear/Render/Box.hs
new file mode 100644
index 0000000..5da6fa8
--- /dev/null
+++ b/Spear/Render/Box.hs
@@ -0,0 +1,193 @@
+module Spear.Render.Box
+(
+        render
+,       renderOutwards
+,       renderInwards
+,       renderEdges
+)
+where
+
+
+import Spear.Math.Vector3
+import Spear.Math.Matrix
+import Graphics.Rendering.OpenGL.Raw
+import Unsafe.Coerce
+import Control.Monad.Instances
+
+type Center = Vector3
+type Colour = Vector4
+type Length = Float
+type Normals = [Vector3]
+type GenerateTexCoords = Bool
+
+
+applyColour :: Colour -> IO ()
+--applyColour col = glColor4f (unsafeCoerce $ x col) (unsafeCoerce $ y col) (unsafeCoerce $ z col) (unsafeCoerce $ w col)
+applyColour = do
+    ax <- unsafeCoerce . x
+    ay <- unsafeCoerce . y
+    az <- unsafeCoerce . z
+    aw <- unsafeCoerce . w
+    glColor4f ax ay az aw
+
+
+applyNormal :: Vector3 -> IO ()
+--applyNormal v = glNormal3f (unsafeCoerce $ x v) (unsafeCoerce $ y v) (unsafeCoerce $ z v)
+applyNormal = do
+    nx <- unsafeCoerce . x
+    ny <- unsafeCoerce . y
+    nz <- unsafeCoerce . z
+    glNormal3f nx ny nz
+
+
+-- | Renders a box.
+render :: Center  -- ^ The box's center.
+       -> Length  -- ^ The perpendicular distance from the box's center to any of its sides.
+       -> Colour  -- ^ The box's colour.
+       -> Normals -- ^ The box's normals, of the form [front, back, right, left, top, bottom].
+       -> IO ()
+render c l col normals = do
+        glPushMatrix
+        glTranslatef (unsafeCoerce $ x c) (unsafeCoerce $ y c) (unsafeCoerce $ z c)
+        applyColour col
+        
+        let d = unsafeCoerce l
+        glBegin gl_QUADS
+        
+       --Front
+        --glNormal3f 0 0 (-1)
+        applyNormal $ normals !! 0
+        glVertex3f        d     (-d)    (-d)
+        glVertex3f        d     d       (-d)
+        glVertex3f      (-d)    d       (-d)
+        glVertex3f      (-d)    (-d)    (-d)
+        
+        --Back
+        --glNormal3f 0 0 1
+        applyNormal $ normals !! 1
+        glVertex3f      (-d)    (-d)    d
+        glVertex3f      (-d)    d       d
+        glVertex3f      d       d       d
+        glVertex3f      d       (-d)    d
+        
+        --Right
+        --glNormal3f 1 0 0
+        applyNormal $ normals !! 2
+        glVertex3f      d       (-d)    (-d)
+        glVertex3f      d       (-d)    d
+        glVertex3f      d       d       d
+        glVertex3f      d       d       (-d)
+        
+        --Left
+        --glNormal3f (-1) 0 0
+        applyNormal $ normals !! 3
+        glVertex3f      (-d)    (-d)    (-d)
+        glVertex3f      (-d)    d       (-d)
+        glVertex3f      (-d)    d       d
+        glVertex3f      (-d)    (-d)    d
+        
+        --Top
+        --glNormal3f 0 1 0
+        applyNormal $ normals !! 4
+        glVertex3f      (-d)    d       (-d)
+        glVertex3f      d       d       (-d)
+        glVertex3f      d       d       d
+        glVertex3f      (-d)    d       d
+        
+        --Bottom
+        --glNormal3f 0 (-1) 0
+        applyNormal $ normals !! 5
+        glVertex3f      d       (-d)    d
+        glVertex3f      d       (-d)    (-d)
+        glVertex3f      (-d)    (-d)    (-d)
+        glVertex3f      (-d)    (-d)    d
+        
+        glEnd
+        
+        glPopMatrix
+        
+        
+normals = [vec3 0 0 (-1), vec3 0 0 1, vec3 1 0 0, vec3 (-1) 0 0, vec3 0 1 0, vec3 0 (-1) 0]
+
+
+-- | Renders a box with normals facing outwards.
+renderOutwards :: Center  -- ^ The box's center.
+                -> Length -- ^ The perpendicular distance from the box's center to any of its sides.
+                -> Colour -- ^ The box's colour.
+                -> IO ()
+renderOutwards c l col = render c l col normals
+        
+        
+-- | Renders a box with normals facing inwards.
+renderInwards :: Center  -- ^ The box's center.
+              -> Length -- ^ The perpendicular distance from the box's center to any of its sides.
+              -> Colour -- ^ The box's colour.
+              -> IO ()
+renderInwards c l col = do
+        glFrontFace gl_CW
+        render c l col $ Prelude.map neg normals
+        glFrontFace gl_CCW
+        
+        
+renderEdges :: Center -- ^ The box's center.
+            -> Length -- ^ The perpendicular distance from the box's center to any of its sides.
+            -> Colour -- ^ The box's colour.
+            -> IO ()
+renderEdges c l col = do
+        glPushMatrix
+        glTranslatef (unsafeCoerce $ x c) (unsafeCoerce $ y c) (unsafeCoerce $ z c)
+        applyColour col
+        
+        let d = unsafeCoerce l
+        
+        --Front
+        glBegin gl_LINE_STRIP
+        glVertex3f        d     (-d)    (-d)
+        glVertex3f        d     d       (-d)
+        glVertex3f      (-d)    d       (-d)
+        glVertex3f      (-d)    (-d)    (-d)
+        glEnd
+        
+        --Back
+        glBegin gl_LINE_STRIP
+        glVertex3f      (-d)    (-d)    d
+        glVertex3f      (-d)    d       d
+        glVertex3f      d       d       d
+        glVertex3f      d       (-d)    d
+        glVertex3f      (-d)    (-d)    d
+        glEnd
+        
+        --Right
+        glBegin gl_LINE_STRIP
+        glVertex3f      d       (-d)    (-d)
+        glVertex3f      d       (-d)    d
+        glVertex3f      d       d       d
+        glVertex3f      d       d       (-d)
+        glEnd
+        
+        --Left
+        glBegin gl_LINE_STRIP
+        glVertex3f      (-d)    (-d)    (-d)
+        glVertex3f      (-d)    d       (-d)
+        glVertex3f      (-d)    d       d
+        glVertex3f      (-d)    (-d)    d
+        glEnd
+        
+        --Top
+        glBegin gl_LINE_STRIP
+        glVertex3f      (-d)    d       (-d)
+        glVertex3f      d       d       (-d)
+        glVertex3f      d       d       d
+        glVertex3f      (-d)    d       d
+        glEnd
+        
+        --Bottom
+        glBegin gl_LINE_STRIP
+        glVertex3f      d       (-d)    d
+        glVertex3f      d       (-d)    (-d)
+        glVertex3f      (-d)    (-d)    (-d)
+        glVertex3f      (-d)    (-d)    d
+        glEnd
+        
+        glPopMatrix
+        
\ No newline at end of file
diff --git a/Spear/Render/Light.hs b/Spear/Render/Light.hs
new file mode 100644
index 0000000..cc1de1f
--- /dev/null
+++ b/Spear/Render/Light.hs
@@ -0,0 +1,25 @@
+module Spear.Render.Light

+where

+

+

+import Spear.Vector

+import Graphics.Rendering.OpenGL.Raw

+

+

+data LightData = LightData {

+        ambient :: Vector Float,

+        diffuse :: Vector Float,

+        spec    :: Vector Float

+}

+

+

+data Light =

+        ParallelLight {

+                ld :: LightData

+        }

+|       PointLight {

+                ld :: LightData

+        }

+|       SpotLight {

+                ld :: LightData

+        }

diff --git a/Spear/Render/Material.hs b/Spear/Render/Material.hs
new file mode 100644
index 0000000..f504036
--- /dev/null
+++ b/Spear/Render/Material.hs
@@ -0,0 +1,16 @@
+module Spear.Render.Material
+( Material(..)
+)
+where
+
+
+import Spear.Math.Vector4
+
+
+data Material = Material
+    { ke :: Vector4
+    , ka :: Vector4
+    , kd :: Vector4
+    , ks :: Vector4
+    , shininess :: Float
+    }
diff --git a/Spear/Render/Model.hsc b/Spear/Render/Model.hsc
new file mode 100644
index 0000000..02a37ae
--- /dev/null
+++ b/Spear/Render/Model.hsc
@@ -0,0 +1,61 @@
+{-# LANGUAGE CPP, ForeignFunctionInterface #-}
+
+module Spear.Render.Model
+(
+    RenderModel(..)
+,   renderModelFromModel
+)
+where
+
+
+import qualified Spear.Assets.Model as Assets
+import Spear.Setup
+
+import Foreign.Ptr
+import Foreign.C.Types
+import Foreign.Marshal.Alloc
+import Foreign.Marshal.Array
+import Foreign.Marshal.Utils (with)
+import Foreign.Storable
+
+
+#include "RenderModel.h"
+
+
+data Vec3 = Vec3 !CFloat !CFloat !CFloat
+
+data TexCoord = TexCoord !CFloat !CFloat
+
+
+data RenderModel = RenderModel
+    { elements    :: Ptr CChar
+    , numFrames   :: CUInt
+    , numVertices :: CUInt -- ^ Number of vertices per frame.
+    }
+
+
+instance Storable RenderModel where
+    sizeOf _    = #{size RenderModel}
+    alignment _ = alignment (undefined :: CUInt)
+
+    peek ptr = do
+        elements    <- #{peek RenderModel, elements}    ptr
+        numFrames   <- #{peek RenderModel, numFrames}   ptr
+        numVertices <- #{peek RenderModel, numVertices} ptr
+        return $ RenderModel elements numFrames numVertices
+
+    poke ptr (RenderModel elements numFrames numVertices) = do
+        #{poke RenderModel, elements}    ptr elements
+        #{poke RenderModel, numFrames}   ptr numFrames
+        #{poke RenderModel, numVertices} ptr numVertices
+
+
+foreign import ccall "RenderModel.h render_model_from_model_asset"
+    render_model_from_model_asset :: Ptr Assets.CModel -> Ptr RenderModel -> IO Int
+
+
+-- | Convert the given 'Model' to a 'ModelData' instance.
+renderModelFromModel :: Assets.Model -> IO RenderModel
+renderModelFromModel m = with (Assets.cmodel m) $ \mPtr -> alloca $ \mdPtr -> do
+    render_model_from_model_asset mPtr mdPtr
+    peek mdPtr
diff --git a/Spear/Render/Program.hs b/Spear/Render/Program.hs
new file mode 100644
index 0000000..9755aa3
--- /dev/null
+++ b/Spear/Render/Program.hs
@@ -0,0 +1,119 @@
+module Spear.Render.Program
+(
+    StaticProgram(..)
+,   AnimatedProgram(..)
+,   Program(..)
+,   ProgramUniforms(..)
+,   StaticProgramChannels(..)
+,   StaticProgramUniforms(..)
+,   AnimatedProgramChannels(..)
+,   AnimatedProgramUniforms(..)
+)
+where
+
+
+import Spear.GLSL.Management (GLSLProgram)
+
+
+import Graphics.Rendering.OpenGL.Raw.Core31
+
+
+data StaticProgram = StaticProgram
+    { staticProgram         :: GLSLProgram
+    , staticProgramChannels :: StaticProgramChannels
+    , staticProgramUniforms :: StaticProgramUniforms
+    }
+
+
+data AnimatedProgram = AnimatedProgram
+    { animatedProgram         :: GLSLProgram
+    , animatedProgramChannels :: AnimatedProgramChannels
+    , animatedProgramUniforms :: AnimatedProgramUniforms
+    }
+
+
+data StaticProgramChannels = StaticProgramChannels
+    { vertexChannel  :: GLuint -- ^ Vertex channel.
+    , normalChannel  :: GLuint -- ^ Normal channel.
+    , stexChannel    :: GLuint -- ^ Texture channel.
+    }
+
+
+data AnimatedProgramChannels = AnimatedProgramChannels
+    { vertexChannel1 :: GLuint -- ^ Vertex channel 1.
+    , vertexChannel2 :: GLuint -- ^ Vertex channel 2.
+    , normalChannel1 :: GLuint -- ^ Normal channel 1.
+    , normalChannel2 :: GLuint -- ^ Normal channel 2.
+    , atexChannel    :: GLuint -- ^ Texture channel.
+    }
+
+
+data StaticProgramUniforms = StaticProgramUniforms
+    { skaLoc         :: GLint -- ^ Material ambient uniform location.
+    , skdLoc         :: GLint -- ^ Material diffuse uniform location.
+    , sksLoc         :: GLint -- ^ Material specular uniform location.
+    , sshiLoc        :: GLint -- ^ Material shininess uniform location.
+    , stexLoc        :: GLint -- ^ Texture sampler location.
+    , smodelviewLoc  :: GLint -- ^ Modelview matrix location.
+    , snormalmatLoc  :: GLint -- ^ Normal matrix location.
+    , sprojLoc       :: GLint -- ^ Projection matrix location.
+    }
+
+
+data AnimatedProgramUniforms = AnimatedProgramUniforms
+    { akaLoc         :: GLint -- ^ Material ambient uniform location.
+    , akdLoc         :: GLint -- ^ Material diffuse uniform location.
+    , aksLoc         :: GLint -- ^ Material specular uniform location.
+    , ashiLoc        :: GLint -- ^ Material shininess uniform location.
+    , atexLoc        :: GLint -- ^ Texture sampler location.
+    , fpLoc          :: GLint -- ^ Frame progress uniform location.
+    , amodelviewLoc  :: GLint -- ^ Modelview matrix location.
+    , anormalmatLoc  :: GLint -- ^ Normal matrix location.
+    , aprojLoc       :: GLint -- ^ Projection matrix location.
+    }
+
+
+class Program a where
+    program :: a -> GLSLProgram
+
+
+instance Program StaticProgram where
+    program = staticProgram
+
+
+instance Program AnimatedProgram where
+    program = animatedProgram
+
+
+class ProgramUniforms a where
+    kaLoc        :: a -> GLint
+    kdLoc        :: a -> GLint
+    ksLoc        :: a -> GLint
+    shiLoc       :: a -> GLint
+    texLoc       :: a -> GLint
+    modelviewLoc :: a -> GLint
+    normalmatLoc :: a -> GLint
+    projLoc      :: a -> GLint
+
+
+instance ProgramUniforms StaticProgramUniforms where
+    kaLoc        = skaLoc
+    kdLoc        = skdLoc
+    ksLoc        = sksLoc
+    shiLoc       = sshiLoc
+    texLoc       = stexLoc
+    modelviewLoc = smodelviewLoc
+    normalmatLoc = snormalmatLoc
+    projLoc      = sprojLoc
+    
+
+
+instance ProgramUniforms AnimatedProgramUniforms where
+    kaLoc        = akaLoc
+    kdLoc        = akdLoc
+    ksLoc        = aksLoc
+    shiLoc       = ashiLoc
+    texLoc       = atexLoc
+    modelviewLoc = amodelviewLoc
+    normalmatLoc = anormalmatLoc
+    projLoc      = aprojLoc
diff --git a/Spear/Render/RenderModel.c b/Spear/Render/RenderModel.c
new file mode 100644
index 0000000..3d18a4b
--- /dev/null
+++ b/Spear/Render/RenderModel.c
@@ -0,0 +1,232 @@
+#include "RenderModel.h"
+#include <stdlib.h> // free
+#include <string.h> // memcpy
+#include <stdio.h>
+
+
+static void safe_free (void* ptr)
+{
+    if (ptr)
+    {
+        free (ptr);
+        ptr = 0;
+    }
+}
+
+
+/// Populate elements of an animated model to be rendered from
+/// start to end in a loop.
+/*int populate_elements_animated (Model* model_asset, RenderModel* model)
+{
+    size_t nverts     = model_asset->numVertices;
+    size_t ntriangles = model_asset->numTriangles;
+    size_t nframes    = model_asset->numFrames;
+    size_t n          = nframes * ntriangles * 3;
+    
+    model->elements = malloc (56 * n);
+    if (!model->elements) return -1;
+    
+    // Populate elements.
+    
+    size_t f, i;
+    
+    char* elem      = (char*) model->elements;
+    vec3* v1        = model_asset->vertices;
+    vec3* v2        = v1 + nverts;
+    vec3* n1        = model_asset->normals;
+    vec3* n2        = n1 + nverts;
+    texCoord* tex   = model_asset->texCoords;
+    
+    for (f = 0; f < nframes; ++f)
+    {
+        triangle* t = model_asset->triangles;
+        
+        for (i = 0; i < ntriangles; ++i)
+        {
+            *((vec3*)     elem)        = v1[t->vertexIndices[0]];
+            *((vec3*)     (elem + 12)) = v2[t->vertexIndices[0]];
+            *((vec3*)     (elem + 24)) = n1[t->vertexIndices[0]];
+            *((vec3*)     (elem + 36)) = n2[t->vertexIndices[0]];
+            *((texCoord*) (elem + 48)) = tex[t->textureIndices[0]];
+            elem += 56;
+            
+            *((vec3*)     elem)        = v1[t->vertexIndices[1]];
+            *((vec3*)     (elem + 12)) = v2[t->vertexIndices[1]];
+            *((vec3*)     (elem + 24)) = n1[t->vertexIndices[1]];
+            *((vec3*)     (elem + 36)) = n2[t->vertexIndices[1]];
+            *((texCoord*) (elem + 48)) = tex[t->textureIndices[1]];
+            elem += 56;
+            
+            *((vec3*)     elem)        = v1[t->vertexIndices[2]];
+            *((vec3*)     (elem + 12)) = v2[t->vertexIndices[2]];
+            *((vec3*)     (elem + 24)) = n1[t->vertexIndices[2]];
+            *((vec3*)     (elem + 36)) = n2[t->vertexIndices[2]];
+            *((texCoord*) (elem + 48)) = tex[t->textureIndices[2]];
+            elem += 56;
+            
+            t++;
+        }
+        
+        v1 += nverts;
+        v2 += nverts;
+        n1 += nverts;
+        n2 += nverts;
+        
+        if (f == nframes-2)
+        {
+            v2 = model_asset->vertices;
+            n2 = model_asset->normals;
+        }
+    }
+    
+    return 0;
+}*/
+
+
+/// Populate elements of an animated model according to its frames
+/// of animation.
+int populate_elements_animated (Model* model_asset, RenderModel* model)
+{
+    size_t nverts     = model_asset->numVertices;
+    size_t ntriangles = model_asset->numTriangles;
+    size_t nframes    = model_asset->numFrames;
+    size_t n          = nframes * ntriangles * 3;
+    
+    model->elements = malloc (56 * n);
+    if (!model->elements) return -1;
+    
+    // Populate elements.
+    
+    unsigned f, i, j, u;
+    
+    char* elem      = (char*) model->elements;
+    animation* anim  = model_asset->animations;
+    
+    for (i = 0; i < model_asset->numAnimations; ++i, anim++)
+    {
+        unsigned start = anim->start;
+        unsigned end   = anim->end;
+        
+        char singleFrameAnim = start == end;
+        
+        vec3* v1      = model_asset->vertices + start*nverts;
+        vec3* v2      = singleFrameAnim ? v1 : v1 + nverts;
+        vec3* n1      = model_asset->normals + start*nverts;
+        vec3* n2      = singleFrameAnim ? n1 : n1 + nverts;
+        texCoord* tex = model_asset->texCoords;
+        
+        for (u = start; u <= end; ++u)
+        {
+            triangle* t = model_asset->triangles;
+            
+            for (j = 0; j < ntriangles; ++j, t++)
+            {
+                *((vec3*)     elem)        = v1[t->vertexIndices[0]];
+                *((vec3*)     (elem + 12)) = v2[t->vertexIndices[0]];
+                *((vec3*)     (elem + 24)) = n1[t->vertexIndices[0]];
+                *((vec3*)     (elem + 36)) = n2[t->vertexIndices[0]];
+                *((texCoord*) (elem + 48)) = tex[t->textureIndices[0]];
+                elem += 56;
+                
+                *((vec3*)     elem)        = v1[t->vertexIndices[1]];
+                *((vec3*)     (elem + 12)) = v2[t->vertexIndices[1]];
+                *((vec3*)     (elem + 24)) = n1[t->vertexIndices[1]];
+                *((vec3*)     (elem + 36)) = n2[t->vertexIndices[1]];
+                *((texCoord*) (elem + 48)) = tex[t->textureIndices[1]];
+                elem += 56;
+                
+                *((vec3*)     elem)        = v1[t->vertexIndices[2]];
+                *((vec3*)     (elem + 12)) = v2[t->vertexIndices[2]];
+                *((vec3*)     (elem + 24)) = n1[t->vertexIndices[2]];
+                *((vec3*)     (elem + 36)) = n2[t->vertexIndices[2]];
+                *((texCoord*) (elem + 48)) = tex[t->textureIndices[2]];
+                elem += 56;
+            }
+            
+            // Advance to the next frame of animation of the current
+            // animation.
+            v1 += nverts;
+            v2 += nverts;
+            n1 += nverts;
+            n2 += nverts;
+            
+            // Reset the secondary pointers to the beginning of the
+            // animation when we are about to reach the last frame.
+            if (u == end-1)
+            {
+                v2 = model_asset->vertices + start*nverts;
+                n2 = model_asset->normals  + start*nverts;
+            }
+        }
+    }
+    
+    return 0;
+}
+
+
+int populate_elements_static (Model* model_asset, RenderModel* model)
+{
+    size_t nverts     = model_asset->numVertices;
+    size_t ntriangles = model_asset->numTriangles;
+    size_t n          = ntriangles * 3;
+    
+    model->elements = malloc (32 * n);
+    if (!model->elements) return -1;
+    
+    // Populate elements.
+    
+    size_t f, i;
+    
+    char* elem     = (char*) model->elements;
+    vec3* vert     = model_asset->vertices;
+    vec3* norm     = model_asset->normals;
+    texCoord* tex  = model_asset->texCoords;
+    
+    triangle* t = model_asset->triangles;
+    
+    for (i = 0; i < ntriangles; ++i)
+    {
+        *((vec3*)     elem)        = vert[t->vertexIndices[0]];
+        *((vec3*)     (elem + 12)) = norm[t->vertexIndices[0]];
+        *((texCoord*) (elem + 24)) = tex[t->textureIndices[0]];
+        elem += 32;
+        
+        *((vec3*)     elem)        = vert[t->vertexIndices[1]];
+        *((vec3*)     (elem + 12)) = norm[t->vertexIndices[1]];
+        *((texCoord*) (elem + 24)) = tex[t->textureIndices[1]];
+        elem += 32;
+        
+        *((vec3*)     elem)        = vert[t->vertexIndices[2]];
+        *((vec3*)     (elem + 12)) = norm[t->vertexIndices[2]];
+         *((texCoord*) (elem + 24)) = tex[t->textureIndices[2]];
+        elem += 32;
+        
+        t++;
+    }
+    
+    return 0;
+}
+
+
+int render_model_from_model_asset (Model* model_asset, RenderModel* model)
+{
+    U32 ntriangles = model_asset->numTriangles;
+    U32 nframes    = model_asset->numFrames;
+    
+    int result;
+    if (nframes > 1) result = populate_elements_animated (model_asset, model);
+    else             result = populate_elements_static   (model_asset, model);
+    
+    if (result != 0) return result;
+    
+    model->numFrames   = nframes;
+    model->numVertices = ntriangles * 3; // Number of vertices per frame.
+    
+    return 0;
+}
+
+
+void render_model_free (RenderModel* model)
+{
+    safe_free (model->elements);
+}
diff --git a/Spear/Render/RenderModel.h b/Spear/Render/RenderModel.h
new file mode 100644
index 0000000..cb70a19
--- /dev/null
+++ b/Spear/Render/RenderModel.h
@@ -0,0 +1,49 @@
+#ifndef _SPEAR_RENDER_MODEL_H
+#define _SPEAR_RENDER_MODEL_H
+
+#include "Model.h"
+
+
+/// Represents a renderable model.
+/**
+ * If the model is animated:
+ * 
+ *      Buffer layout:
+ *          vert1 vert2 norm1 norm2 texc
+ *          
+ *          element size = (3 + 3 + 3 + 3 + 2)*4 = 56 B
+ *          buffer  size = element size * num vertices = 56n
+ * 
+ * If the model is static:
+ * 
+ *      Buffer layout:
+ *          vert norm texc
+ *          
+ *          element size = (3 + 3 + 2)*4 = 32 B
+ *          buffer  size = element size * num vertices = 32n
+ * 
+ **/
+typedef struct
+{
+    void*  elements;
+    U32    numFrames;
+    U32    numVertices; // Number of vertices per frame.
+}
+RenderModel;
+
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+int render_model_from_model_asset (Model* model_asset, RenderModel* render_model);
+
+void render_model_free (RenderModel* model);
+
+#ifdef __cplusplus
+}
+#endif
+
+
+#endif // _SPEAR_RENDER_MODEL_H
+
diff --git a/Spear/Render/Renderable.hs b/Spear/Render/Renderable.hs
new file mode 100644
index 0000000..a3d08f9
--- /dev/null
+++ b/Spear/Render/Renderable.hs
@@ -0,0 +1,8 @@
+module Spear.Render.Renderable
+where
+
+
+class Renderable a where
+    
+    -- | Renders the given 'Renderable'.
+    render :: a -> IO ()
diff --git a/Spear/Render/Sphere.hs b/Spear/Render/Sphere.hs
new file mode 100644
index 0000000..25d775a
--- /dev/null
+++ b/Spear/Render/Sphere.hs
@@ -0,0 +1,45 @@
+module Spear.Render.Sphere
+(
+        render
+)
+where
+
+
+import Spear.Math.Vector as Vector
+import Spear.Math.Matrix
+import Graphics.Rendering.OpenGL.Raw
+import Graphics.Rendering.OpenGL.GL.Colors
+import qualified Graphics.Rendering.OpenGL.GLU as GLU
+import Unsafe.Coerce
+
+
+type Center = Vector R
+type Radius = R
+type Colour = Vector R
+
+
+applyColour :: Colour -> IO ()
+applyColour col =
+        if Vector.length col == 4 then
+                glColor4f (unsafeCoerce $ x col) (unsafeCoerce $ y col) (unsafeCoerce $ z col)
+                          (unsafeCoerce $ w col)
+        else
+                glColor3f (unsafeCoerce $ x col) (unsafeCoerce $ y col) (unsafeCoerce $ z col)
+
+
+-- | Renders a sphere.
+-- Center is the sphere's center.
+-- Radius is the sphere's radius.
+-- Colour is a Vector representing the sphere's colour. Colour may hold an alpha channel.
+render :: Center -> Radius -> Colour -> IO ()
+render c radius col = do
+        glPushMatrix
+        glTranslatef (unsafeCoerce $ x c) (unsafeCoerce $ y c) (unsafeCoerce $ z c)
+        applyColour col
+        
+        let r = unsafeCoerce $ (realToFrac radius :: Double)
+        let style = GLU.QuadricStyle (Just Smooth) GLU.NoTextureCoordinates GLU.Outside GLU.FillStyle
+        GLU.renderQuadric style $ GLU.Sphere r 16 16
+        
+        glPopMatrix
+        
\ No newline at end of file
diff --git a/Spear/Render/StaticModel.hs b/Spear/Render/StaticModel.hs
new file mode 100644
index 0000000..05e80e4
--- /dev/null
+++ b/Spear/Render/StaticModel.hs
@@ -0,0 +1,123 @@
+module Spear.Render.StaticModel
+(
+    StaticModelResource
+,   StaticModelRenderer
+,   staticModelResource
+,   staticModelRenderer
+,   Spear.Render.StaticModel.release
+,   bind
+,   render
+)
+where
+
+
+import Spear.Assets.Model
+import Spear.Render.Model
+import Spear.GLSL
+import Spear.Render.Material
+import Spear.Render.Program
+import Spear.Setup as Setup
+
+import Graphics.Rendering.OpenGL.Raw.Core31
+import Unsafe.Coerce (unsafeCoerce)
+
+
+data StaticModelResource = StaticModelResource
+    { vao       :: VAO
+    , nVertices :: Int
+    , material  :: Material
+    , texture   :: Texture
+    , rkey      :: Resource
+    }
+
+
+instance Eq StaticModelResource where
+    m1 == m2 = vao m1 == vao m2
+
+
+instance Ord StaticModelResource where
+    m1 < m2 = vao m1 < vao m2
+
+
+data StaticModelRenderer = StaticModelRenderer { model :: StaticModelResource }
+
+
+instance Eq StaticModelRenderer where
+    m1 == m2 = model m1 == model m2
+
+
+instance Ord StaticModelRenderer where
+    m1 < m2 = model m1 < model m2
+
+
+-- | Create a 'StaticModelResource' from the given 'Model'.
+staticModelResource :: StaticProgramChannels
+                    -> Material
+                    -> Texture
+                    -> Model
+                    -> Setup StaticModelResource
+
+staticModelResource (StaticProgramChannels vertChan normChan texChan) material texture model = do
+    RenderModel elements _ numVertices <- setupIO . renderModelFromModel $ model
+    elementBuf <- newBuffer
+    vao        <- newVAO
+    
+    setupIO $ do
+        
+        let elemSize  = 32
+            elemSize' = fromIntegral elemSize
+            n         = numVertices
+        
+        bindVAO vao
+        
+        bindBuffer elementBuf ArrayBuffer
+        bufferData ArrayBuffer (fromIntegral $ elemSize*n) elements StaticDraw
+    
+        attribVAOPointer vertChan 3 gl_FLOAT False elemSize' 0
+        attribVAOPointer normChan 3 gl_FLOAT False elemSize' 12
+        attribVAOPointer texChan  2 gl_FLOAT False elemSize' 24
+        
+        enableVAOAttrib vertChan
+        enableVAOAttrib normChan
+        enableVAOAttrib texChan
+    
+    rkey <- register . runSetup_ $ do
+        setupIO $ putStrLn "Releasing static model resource"
+        releaseVAO vao
+        releaseBuffer elementBuf
+        --sequence_ . fmap releaseBuffer $ [elementBuf, indexBuf]
+    
+    return $ StaticModelResource vao (unsafeCoerce numVertices) material texture rkey
+
+
+-- | Release the given 'StaticModelResource'.
+release :: StaticModelResource -> Setup ()
+release = Setup.release . rkey
+
+
+-- | Create a 'StaticModelRenderer' from the given 'StaticModelResource'.
+staticModelRenderer :: StaticModelResource -> StaticModelRenderer
+staticModelRenderer = StaticModelRenderer
+
+
+-- | Bind the given 'StaticModelRenderer' to prepare it for rendering.
+bind :: StaticProgramUniforms -> StaticModelRenderer -> IO ()
+bind (StaticProgramUniforms kaLoc kdLoc ksLoc shiLoc texLoc _ _ _) (StaticModelRenderer model) =
+    let (Material _ ka kd ks shi) = material model
+    in do
+        bindVAO . vao $ model
+        bindTexture $ texture model
+        activeTexture $= gl_TEXTURE0
+        glUniform1i texLoc 0
+
+
+-- | Render the given 'StaticModelRenderer'.
+render :: StaticProgramUniforms -> StaticModelRenderer -> IO ()
+render uniforms (StaticModelRenderer model) =
+    let (Material _ ka kd ks shi) = material model
+    in do
+        uniformVec4 (kaLoc uniforms) ka
+        uniformVec4 (kdLoc uniforms) kd
+        uniformVec4 (ksLoc uniforms) ks
+        glUniform1f (shiLoc uniforms) $ unsafeCoerce shi
+        drawArrays gl_TRIANGLES 0 $ nVertices model
diff --git a/Spear/Render/Texture.hs b/Spear/Render/Texture.hs
new file mode 100644
index 0000000..59e7797
--- /dev/null
+++ b/Spear/Render/Texture.hs
@@ -0,0 +1,34 @@
+module Spear.Render.Texture
+(
+    loadTextureImage
+)
+where
+
+
+import Spear.Setup
+import Spear.Assets.Image
+import Spear.GLSL.Texture
+import Data.StateVar (($=))
+import Graphics.Rendering.OpenGL.Raw.Core31
+
+
+-- | Load the 'Texture' specified by the given file.
+loadTextureImage :: FilePath
+                 -> GLenum          -- ^ Texture's min filter.
+                 -> GLenum          -- ^ Texture's mag filter.
+                 -> Setup Texture
+loadTextureImage file minFilter magFilter = do
+    image <- loadImage file
+    tex   <- newTexture
+    setupIO $ do
+        let w    = width  image
+            h    = height image
+            pix  = pixels image
+            rgb  = fromIntegral . fromEnum $ gl_RGB
+        
+        bindTexture tex
+        loadTextureData gl_TEXTURE_2D 0 rgb w h 0 gl_RGB gl_UNSIGNED_BYTE pix
+        texParami gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER $= minFilter
+        texParami gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER $= magFilter
+    
+    return tex
diff --git a/Spear/Render/Triangle.hs b/Spear/Render/Triangle.hs
new file mode 100644
index 0000000..296349a
--- /dev/null
+++ b/Spear/Render/Triangle.hs
@@ -0,0 +1,10 @@
+module Spear.Render.Triangle
+(
+)
+where
+
+
+import Graphics.Rendering.OpenGL.Raw.Core31
+
+
+
diff --git a/Spear/Scene/Graph.hs b/Spear/Scene/Graph.hs
new file mode 100644
index 0000000..a91fc89
--- /dev/null
+++ b/Spear/Scene/Graph.hs
@@ -0,0 +1,143 @@
+module Spear.Scene.Graph
+(
+    Property
+,   SceneGraph(..)
+,   ParseError
+,   loadSceneGraph
+,   loadSceneGraphFromFile
+,   node
+)
+where
+
+
+import qualified Data.ByteString.Char8 as B
+import Data.List (find, intersperse)
+import Data.Maybe (isJust)
+import Text.Parsec.Char
+import Text.Parsec.Combinator
+import Text.Parsec.Error
+import Text.Parsec.Prim
+import qualified Text.Parsec.ByteString as P
+import qualified Text.Parsec.Token as PT
+
+
+type Property = (String, [String])
+
+
+data SceneGraph
+    = SceneNode
+    { nodeID     :: String
+    , properties :: [Property]
+    , children   :: [SceneGraph]
+    }
+    | SceneLeaf
+    { nodeID     :: String
+    , properties :: [Property]
+    }
+
+
+instance Show SceneGraph where
+    show sceneGraph = show' "" sceneGraph
+        where
+            show' tab (SceneNode nid props children) =
+                tab ++ nid ++ "\n" ++ tab ++ "{\n" ++ (printProps tab props) ++
+                (concat . fmap (show' $ "   " ++ tab) $ children) ++ '\n':tab ++ "}\n"
+            
+            show' tab (SceneLeaf nid props) =
+                tab ++ nid ++ '\n':tab ++ "{\n" ++ tab ++ (printProps tab props) ++ '\n':tab ++ "}\n"
+
+
+printProp :: Property -> String
+printProp (key, vals) = key ++ " = " ++ (concat $ intersperse ", " vals)
+
+
+printProps :: String -> [Property] -> String
+printProps tab props =
+    let
+        tab' = '\n':(tab ++ tab)
+        longestKeyLen = maximum . fmap (length . fst) $ props
+        
+        align :: Int -> String -> String
+        align len str =
+            let (key, vals) = break ((==) '=') str
+                thisLen     = length key
+                padLen      = len - thisLen + 1
+                pad         = replicate padLen ' '
+            in
+                key ++ pad ++ vals
+    in
+        case concat . intersperse tab' . fmap (align longestKeyLen . printProp) $ props of
+            [] -> []
+            xs -> tab ++ xs
+
+
+-- | Load the scene graph from the given string.
+loadSceneGraph :: String -> Either ParseError SceneGraph
+loadSceneGraph str = parse sceneGraph "(unknown)" $ B.pack str
+
+
+-- | Load the scene graph specified by the given file.
+loadSceneGraphFromFile :: FilePath -> IO (Either ParseError SceneGraph)
+loadSceneGraphFromFile = P.parseFromFile sceneGraph
+
+
+-- | Get the node identified by the given string from the given scene graph.
+node :: String -> SceneGraph -> Maybe SceneGraph
+node str SceneLeaf {} = Nothing
+node str n@(SceneNode nid _ children)
+    | str == nid = Just n
+    | otherwise  = case find isJust $ fmap (node str) children of
+        Nothing -> Nothing
+        Just x  -> x
+
+
+sceneGraph :: P.Parser SceneGraph
+sceneGraph = do
+    g <- graph
+    whitespace
+    eof
+    return g
+
+
+graph :: P.Parser SceneGraph
+graph = do
+    nid <- name
+    whitespace
+    char '{'
+    props    <- many . try $ whitespace >> property
+    children <- many . try $ whitespace >> graph
+    whitespace
+    char '}'
+    
+    return $ case null children of
+        True  -> SceneLeaf nid props
+        False -> SceneNode nid props children
+
+
+property :: P.Parser Property
+property = do
+    key <- name
+    spaces >> char '=' >> spaces
+    vals <- cells name
+    return (key, vals)
+
+
+cells :: P.Parser String -> P.Parser [String]
+cells p = do
+    val  <- p
+    vals <- remainingCells p
+    return $ val:vals
+
+
+remainingCells :: P.Parser String -> P.Parser [String]
+remainingCells p =
+    try (whitespace >> char ',' >> whitespace >> cells p)
+    <|> (return [])
+
+
+name :: P.Parser String
+name = many1 $ choice [oneOf "-/.()?_", alphaNum]
+
+
+whitespace :: P.Parser ()
+whitespace = skipMany $ choice [space, newline]
diff --git a/Spear/Scene/Light.hs b/Spear/Scene/Light.hs
new file mode 100644
index 0000000..76ff074
--- /dev/null
+++ b/Spear/Scene/Light.hs
@@ -0,0 +1,82 @@
+module Spear.Scene.Light
+(
+    Light(..)
+)
+where
+
+
+import qualified Spear.Math.Matrix4 as M
+import qualified Spear.Math.Spatial as S
+import Spear.Math.Vector3
+import qualified Spear.Math.Vector4 as V4
+
+
+data Light
+    = PointLight
+    { ambient   :: Vector3
+    , diffuse   :: Vector3
+    , specular  :: Vector3
+    , transform :: M.Matrix4
+    }
+    | DirectionalLight
+    { ambient   :: Vector3
+    , diffuse   :: Vector3
+    , specular  :: Vector3
+    , direction :: Vector3
+    }
+    | SpotLight
+    { ambient   :: Vector3
+    , diffuse   :: Vector3
+    , specular  :: Vector3
+    , transform :: M.Matrix4
+    }
+
+
+instance S.Spatial Light where
+    move _ l@DirectionalLight {} = l
+    move v l = l { transform = M.translv v * transform l}
+    
+    moveFwd _ l@DirectionalLight {} = l
+    moveFwd f l = l { transform = M.translv (scale f $ S.fwd l) * transform l }
+    
+    moveBack _ l@DirectionalLight {} = l
+    moveBack f l = l { transform = M.translv (scale (-f) $ S.fwd l) * transform l }
+    
+    strafeLeft _ l@DirectionalLight {} = l
+    strafeLeft f l = l { transform = M.translv (scale (-f) $ S.right l) * transform l }
+    
+    strafeRight _ l@DirectionalLight {} = l
+    strafeRight f l = l { transform = M.translv (scale f $ S.right l) * transform l }
+    
+    pitch _ l@DirectionalLight {} = l
+    pitch a l = l { transform = transform l * M.axisAngle (S.right l) a }
+    
+    yaw _ l@DirectionalLight {} = l
+    yaw a l = l { transform = transform l * M.axisAngle (S.up l) a }
+    
+    roll _ l@DirectionalLight {} = l
+    roll a l = l { transform = transform l * M.axisAngle (S.fwd l) a }
+    
+    pos l@DirectionalLight {} = vec3 0 0 0
+    pos l = M.position . transform $ l
+    
+    fwd (DirectionalLight _ _ _ f) = f
+    fwd l = M.forward . transform $ l
+    
+    up l@DirectionalLight {} = vec3 0 1 0
+    up l = M.up . transform $ l
+    
+    right l@DirectionalLight {} = vec3 1 0 0
+    right l = M.right . transform $ l
+    
+    transform (PointLight _ _ _ transf) = transf
+    transform (DirectionalLight _ _ _ fwd) =
+        let up'   = vec3 0 1 0
+            right = up `cross` fwd
+            up    = fwd `cross` right
+        in
+            M.transform up right fwd (vec3 0 0 0)
+    transform (SpotLight _ _ _ transf) = transf
+    
+    setTransform _ l@DirectionalLight {} = l
+    setTransform t l = l { Spear.Scene.Light.transform = t }
diff --git a/Spear/Scene/Loader.hs b/Spear/Scene/Loader.hs
new file mode 100644
index 0000000..32aba45
--- /dev/null
+++ b/Spear/Scene/Loader.hs
@@ -0,0 +1,414 @@
+module Spear.Scene.Loader
+(
+    SceneResources(..)
+,   CreateStaticObject
+,   CreateAnimatedObject
+,   loadScene
+,   validate
+,   resourceMap
+,   loadObjects
+)
+where
+
+
+import Spear.Assets.Model as Model
+import qualified Spear.GLSL as GLSL
+import Spear.Math.Matrix4 as M4
+import Spear.Math.Vector3 as V3
+import Spear.Math.Vector4
+import Spear.Render.AnimatedModel
+import Spear.Render.Material
+import Spear.Render.Program
+import Spear.Render.StaticModel
+import Spear.Render.Texture
+import Spear.Scene.Light
+import Spear.Scene.Graph
+import Spear.Scene.SceneResources
+import Spear.Setup
+
+import Control.Monad.State.Strict
+import Control.Monad.Trans (lift)
+import Data.List as L (find)
+import Data.Map as M
+import qualified Data.StateVar as SV (get)
+import Graphics.Rendering.OpenGL.Raw.Core31
+import Text.Printf (printf)
+
+
+type Loader = StateT SceneResources Setup
+
+
+loaderSetup = lift
+loaderIO    = loaderSetup . setupIO
+loaderError = loaderSetup . setupError
+
+
+type CreateStaticObject   a = String -> Matrix4 -> StaticModelResource   -> a
+type CreateAnimatedObject a = String -> Matrix4 -> AnimatedModelResource -> a
+
+
+-- | Load the scene specified by the given file.
+loadScene :: FilePath -> Setup (SceneResources, SceneGraph)
+loadScene file = do
+    result <- setupIO $ loadSceneGraphFromFile file
+    case result of
+        Left err -> setupError $ show err
+        Right g  -> case validate g of
+            Nothing  -> do
+                sceneRes <- resourceMap g
+                return (sceneRes, g)
+            Just err -> setupError err
+
+
+-- | Validate the given SceneGraph.
+validate :: SceneGraph -> Maybe String
+validate _ = Nothing
+
+
+-- | Load the scene described by the given 'SceneGraph'.
+resourceMap :: SceneGraph -> Setup SceneResources
+resourceMap g = execStateT (resourceMap' g) emptySceneResources
+
+
+resourceMap' :: SceneGraph -> Loader ()
+resourceMap' node@(SceneLeaf nid props) = do
+    case nid of
+        "shader-program" -> newShaderProgram node
+        "model"          -> newModel         node
+        "light"          -> newLight         node
+        x                -> return ()
+
+resourceMap' node@(SceneNode nid props children) = do
+    mapM_ resourceMap' children
+
+
+-- Lookup the given resource in the data pool. Load it if it is not present, otherwise return it.
+loadResource :: String -- ^ Resource name.
+             -> (SceneResources -> Map String a) -- ^ Map getter.
+             -> (String -> a -> Loader ()) -- ^ Function to modify resources.
+             -> Setup a -- ^ Resource loader.
+             -> Loader a
+loadResource key field modifyResources load = do
+    sceneData <- get
+    case M.lookup key $ field sceneData of
+        Just val -> return val
+        Nothing  -> do
+            loaderIO $ printf "Loading %s..." key
+            resource <- loaderSetup load
+            loaderIO $ printf "done\n"
+            modifyResources key resource
+            return resource
+
+
+addShader name shader =
+    modify $ \sceneData -> sceneData { shaders = M.insert name shader $ shaders sceneData }
+
+
+addStaticProgram name prog =
+    modify $ \sceneData -> sceneData { staticPrograms = M.insert name prog $ staticPrograms sceneData }
+
+
+addAnimatedProgram name prog =
+    modify $ \sceneData -> sceneData { animatedPrograms = M.insert name prog $ animatedPrograms sceneData }
+
+
+addTexture name tex =
+    modify $ \sceneData -> sceneData { textures = M.insert name tex $ textures sceneData }
+
+
+addStaticModel name model =
+    modify $ \sceneData -> sceneData { staticModels = M.insert name model $ staticModels sceneData }
+
+
+addAnimatedModel name model =
+    modify $ \sceneData -> sceneData { animatedModels = M.insert name model $ animatedModels sceneData }
+
+
+-- Get the given resource from the data pool.
+getResource :: (SceneResources -> Map String a) -> String -> Loader a
+getResource field key = do
+    sceneData <- get
+    case M.lookup key $ field sceneData of
+        Just val -> return val
+        Nothing  -> loaderSetup . setupError $ "Oops, the given resource has not been loaded: " ++ key
+
+
+
+
+----------------------
+-- Resource Loading --
+----------------------
+
+newModel :: SceneGraph -> Loader ()
+newModel (SceneLeaf _ props) = do
+    name <- asString $ mandatory "name"           props
+    file <- asString $ mandatory "file"           props
+    tex  <- asString $ mandatory "texture"        props
+    prog <- asString $ mandatory "shader-program" props
+    ke   <- asVec4   $ mandatory "ke"             props
+    ka   <- asVec4   $ mandatory "ka"             props
+    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
+    
+    loaderIO $ printf "Loading model %s..." name
+    model    <- loaderSetup $ loadModel' file rotation scale
+    loaderIO . 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
+                Nothing -> (loaderError $ "Static shader program " ++ prog ++ " does not exist") >> return ()
+                Just p  ->
+                    let StaticProgram _ channels _ = p
+                    in do
+                        model' <- loaderSetup $ staticModelResource channels material texture model
+                        loadResource name staticModels addStaticModel (return model')
+                        return ()
+        True ->
+            case M.lookup prog $ animatedPrograms sceneRes of
+                Nothing -> (loaderError $ "Animated shader program " ++ prog ++ " does not exist") >> return ()
+                Just p  ->
+                    let AnimatedProgram _ channels _ = p
+                    in do
+                        model' <- loaderSetup $ animatedModelResource channels material texture model
+                        loadResource name animatedModels addAnimatedModel (return model')
+                        return ()
+
+
+loadModel' :: FilePath -> Maybe Rotation -> Maybe Vector3 -> Setup Model
+loadModel' file rotation scale = do
+    model <- Model.loadModel file
+    case rotation of
+        Just rot -> setupIO $ rotateModel model rot
+        Nothing  -> return ()
+    case scale of
+        Just s  -> setupIO $ Model.transform (scalev s) model
+        Nothing -> return ()
+    return model
+
+
+rotateModel :: Model -> Rotation -> IO ()
+rotateModel model (Rotation x y z order) = case order of
+    XYZ -> Model.transform (rotZ z * rotY y * rotX x) model
+    XZY -> Model.transform (rotY y * rotZ z * rotX x) model
+    YXZ -> Model.transform (rotZ z * rotX x * rotY y) model
+    YZX -> Model.transform (rotX x * rotZ z * rotY y) model
+    ZXY -> Model.transform (rotY y * rotX x * rotZ z) model
+    ZYX -> Model.transform (rotX x * rotY y * rotZ z) model
+
+
+loadTexture :: FilePath -> Loader GLSL.Texture
+loadTexture file = loadResource file textures addTexture $ loadTextureImage file gl_LINEAR gl_LINEAR
+
+
+newShaderProgram :: SceneGraph -> Loader ()
+newShaderProgram (SceneLeaf _ props) = do
+    (vsName, vertShader) <- Spear.Scene.Loader.loadShader GLSL.VertexShader props
+    (fsName, fragShader) <- Spear.Scene.Loader.loadShader GLSL.FragmentShader props
+    name       <- asString $ mandatory "name" props
+    stype      <- asString $ mandatory "type" props
+    texChan    <- fmap read $ asString $ mandatory "texture-channel" props
+    ambient    <- asString $ mandatory "ambient"    props
+    diffuse    <- asString $ mandatory "diffuse"    props
+    specular   <- asString $ mandatory "specular"   props
+    shininess  <- asString $ mandatory "shininess"  props
+    texture    <- asString $ mandatory "texture"    props
+    modelview  <- asString $ mandatory "modelview"  props
+    normalmat  <- asString $ mandatory "normalmat"  props
+    projection <- asString $ mandatory "projection" props
+    prog       <- loaderSetup $ GLSL.newProgram [vertShader, fragShader]
+    
+    let getUniformLoc name =
+            loaderSetup $ (setupIO . SV.get $ GLSL.uniformLocation prog name) `GLSL.assertGL` name
+    
+    ka    <- getUniformLoc ambient
+    kd    <- getUniformLoc diffuse
+    ks    <- getUniformLoc specular
+    shi   <- getUniformLoc shininess
+    tex   <- getUniformLoc texture
+    mview <- getUniformLoc modelview
+    nmat  <- getUniformLoc normalmat
+    proj  <- getUniformLoc projection
+    
+    case stype of
+        "static" -> do
+            vertChan  <- fmap read $ asString $ mandatory "vertex-channel" props
+            normChan  <- fmap read $ asString $ mandatory "normal-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
+            vertChan1  <- fmap read $ asString $ mandatory "vertex-channel1" props
+            vertChan2  <- fmap read $ asString $ mandatory "vertex-channel2" props
+            normChan1  <- fmap read $ asString $ mandatory "normal-channel1" props
+            normChan2  <- fmap read $ asString $ mandatory "normal-channel2" 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 ()
+
+
+loadShader :: GLSL.ShaderType -> [Property] -> Loader (String, GLSL.GLSLShader)
+loadShader _ [] = loaderSetup . setupError $ "Loader::vertexShader: empty list"
+loadShader shaderType ((stype, file):xs) =
+    if shaderType == GLSL.VertexShader   && stype == "vertex-shader" ||
+       shaderType == GLSL.FragmentShader && stype == "fragment-shader"
+    then let f = concat file
+         in loadShader' f shaderType >>= \shader -> return (f, shader)
+    else Spear.Scene.Loader.loadShader shaderType xs
+
+
+loadShader' :: String -> GLSL.ShaderType -> Loader GLSL.GLSLShader
+loadShader' file shaderType = loadResource file shaders addShader $ GLSL.loadShader file shaderType
+
+
+newLight :: SceneGraph -> Loader ()
+newLight _ = return ()
+
+
+
+
+--------------------
+-- Object Loading --
+--------------------
+
+
+-- | Load objects from the given 'SceneGraph'.
+loadObjects :: CreateStaticObject a -> CreateAnimatedObject a -> SceneResources -> SceneGraph -> Setup [a]
+loadObjects newSO newAO sceneRes g =
+    case node "layout" g of
+        Nothing -> return []
+        Just n  -> do
+            let gos = concat . fmap (newObject newSO newAO sceneRes) $ children n
+            forM gos $ \go -> case go of
+                Left err -> setupError err
+                Right go -> return go
+
+
+-- to-do: use a strict accumulator and make loadObjects tail recursive.
+newObject :: CreateStaticObject a -> CreateAnimatedObject a -> SceneResources -> SceneGraph -> [Either String a]
+newObject newSO newAO sceneRes (SceneNode nid props children) =
+    let o = newObject' newSO newAO sceneRes nid props
+    in o : (concat $ fmap (newObject newSO newAO sceneRes) children)
+
+newObject newSO newAO sceneRes (SceneLeaf nid props) = [newObject' newSO newAO sceneRes nid props]
+
+
+newObject' :: CreateStaticObject a -> CreateAnimatedObject a -> SceneResources
+           -> String -> [Property] -> Either String a
+newObject' newSO newAO sceneRes nid props = do
+    -- Optional properties.
+    let name     = (asString $ value "name"     props) `unspecified` "unknown"
+        model    = (asString $ value "model"    props) `unspecified` "ghost"
+        position = (asVec3   $ value "position" props) `unspecified` vec3 0 0 0
+        rotation = (asVec3   $ value "rotation" props) `unspecified` vec3 0 0 0
+        right'   = (asVec3   $ value "right"    props) `unspecified` vec3 1 0 0
+        up'      = (asVec3   $ value "up"       props) `unspecified` vec3 0 1 0
+        forward' =  asVec3   $ value "forward"  props
+        scale    = (asVec3   $ value "scale"    props) `unspecified` vec3 1 1 1
+    
+    -- Compute the object's vectors if a forward vector has been specified.
+    let (right, up, forward) = vectors forward'
+    
+    case M.lookup model $ staticModels sceneRes of
+        Just m  -> Right $ newSO name (M4.transform right up forward position) m
+        Nothing -> case M.lookup model $ animatedModels sceneRes of
+            Just m  -> Right $ newAO name (M4.transform right up forward position) m
+            Nothing -> Left $ "Loader::newObject: model " ++ model ++ " has not been loaded."
+
+
+vectors :: Maybe Vector3 -> (Vector3, Vector3, Vector3)
+vectors forward = case forward of
+    Nothing -> (V3.unitX, V3.unitY, V3.unitZ)
+    Just f  ->
+        let r = f `cross` V3.unitY
+            u = r `cross` f
+        in
+            (r, u, f)
+
+
+
+
+----------------------
+-- Helper functions --
+----------------------
+
+-- Get the value of the given key.
+value :: String -> [Property] -> Maybe [String]
+value name props = case L.find ((==) name . fst) props of
+    Nothing   -> Nothing
+    Just prop -> Just . snd $ prop
+
+
+unspecified :: Maybe a -> a -> a
+unspecified (Just x) _ = x
+unspecified Nothing  x = x
+
+
+mandatory :: String -> [Property] -> Loader [String]
+mandatory name props = case value name props of
+    Nothing -> loaderError $ "Loader::mandatory: key not found: " ++ name
+    Just x  -> return x
+
+
+asString :: Functor f => f [String] -> f String
+asString = fmap concat
+
+
+asFloat :: Functor f => f [String] -> f Float
+asFloat = fmap (read . concat)
+
+
+asVec4 :: Functor f => f [String] -> f Vector4
+asVec4 val = fmap toVec4 val
+    where toVec4 (x:y:z:w:_) = vec4 (read x) (read y) (read z) (read w)
+          toVec4 (x:[])      = let x' = read x in vec4 x' x' x' x'
+
+
+asVec3 :: Functor f => f [String] -> f Vector3
+asVec3 val = fmap toVec3 val
+    where toVec3 (x:y:z:_) = vec3 (read x) (read y) (read z)
+          toVec3 (x:[])    = let x' = read x in vec3 x' x' x'
+
+
+asRotation :: Functor f => f [String] -> f Rotation
+asRotation val = fmap parseRotation val
+    where parseRotation (ax:ay:az:order:_) = Rotation (read ax) (read ay) (read az) (readOrder order)
+
+
+data Rotation = Rotation
+    { ax    :: Float
+    , ay    :: Float
+    , az    :: Float
+    , order :: RotationOrder
+    }
+
+
+data RotationOrder = XYZ | XZY | YXZ | YZX | ZXY | ZYX deriving Eq
+
+
+readOrder :: String -> RotationOrder
+readOrder "xyz" = XYZ
+readOrder "xzy" = XZY
+readOrder "yxz" = YXZ
+readOrder "yzx" = YZX
+readOrder "zxy" = ZXY
+readOrder "zyx" = ZYX
diff --git a/Spear/Scene/Scene.hs b/Spear/Scene/Scene.hs
new file mode 100644
index 0000000..94c2f6f
--- /dev/null
+++ b/Spear/Scene/Scene.hs
@@ -0,0 +1,152 @@
+module Spear.Scene.Scene
+(
+    -- * Data types
+    Scene
+    -- * Construction
+,   listScene
+    -- * Insertion and deletion
+,   add
+,   addl
+,   remove
+,   Spear.Scene.Scene.filter
+    -- * Queries
+,   find
+    -- * Update and render
+,   update
+,   updateM
+,   collide
+,   collideM
+,   render
+)
+where
+
+
+import Spear.Collision.AABB
+import Spear.Collision.Types
+import Spear.Game (Game)
+import Spear.Math.Octree as Octree
+
+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]
+    }
+    |
+    OctreeScene
+    { collideAABB    :: obj -> AABB -> CollisionType
+    , world          :: Octree 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 game object to the given 'Scene'.
+add :: Scene obj -> obj -> Scene obj
+add (scene@ListScene {})   o = scene { objects = o : objects scene }
+add (scene@OctreeScene {}) o = scene { world = insert (collideAABB scene) (world scene) o }
+
+
+-- | Add a list of game objects to the given 'Scene'.
+addl :: Scene obj -> [obj] -> Scene obj
+addl (scene@ListScene {})   l = scene { objects = l ++ objects scene }
+addl (scene@OctreeScene {}) l = scene { world = insertl (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
+
+
+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@OctreeScene {}) = scene { world   = Octree.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
+        col' o = foldl' col o objs
+    in
+        scene { objects = objs' }
+
+collide col scene@OctreeScene {} =
+    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@OctreeScene {}) = F.mapM_ rend $ world scene
diff --git a/Spear/Scene/SceneResources.hs b/Spear/Scene/SceneResources.hs
new file mode 100644
index 0000000..e54f385
--- /dev/null
+++ b/Spear/Scene/SceneResources.hs
@@ -0,0 +1,72 @@
+module Spear.Scene.SceneResources
+(
+    SceneResources(..)
+,   StaticProgram(..)
+,   AnimatedProgram(..)
+,   emptySceneResources
+,   getShader
+,   getStaticProgram
+,   getAnimatedProgram
+,   getTexture
+,   getStaticModel
+,   getAnimatedModel
+)
+where
+
+
+import Spear.Assets.Model as Model
+import Spear.GLSL as GLSL
+import Spear.Math.Vector3
+import Spear.Render.AnimatedModel
+import Spear.Render.Material
+import Spear.Render.Program
+import Spear.Render.StaticModel
+import Spear.Render.Texture
+import Spear.Scene.Light
+
+import Data.Map as M
+
+
+data SceneResources = SceneResources
+    { shaders          :: Map String GLSLShader
+    , staticPrograms   :: Map String StaticProgram
+    , animatedPrograms :: Map String AnimatedProgram
+    , textures         :: Map String Texture
+    , staticModels     :: Map String StaticModelResource
+    , animatedModels   :: Map String AnimatedModelResource
+    , lights           :: [Light]
+    }
+
+
+-- | Build an empty instance of 'SceneResources'.
+emptySceneResources = SceneResources M.empty M.empty M.empty M.empty M.empty M.empty []
+
+
+-- | Get the 'GLSLShader' specified by the given 'String' from the given 'SceneResources'.
+getShader :: SceneResources -> String -> Maybe GLSLShader
+getShader res key = M.lookup key $ shaders res
+
+
+-- | Get the 'StaticProgram' specified by the given 'String' from the given 'SceneResources'.
+getStaticProgram :: SceneResources -> String -> Maybe StaticProgram
+getStaticProgram res key = M.lookup key $ staticPrograms res
+
+
+-- | Get the 'AnimatedProgram' specified by the given 'String' from the given 'SceneResources'.
+getAnimatedProgram :: SceneResources -> String -> Maybe AnimatedProgram
+getAnimatedProgram res key = M.lookup key $ animatedPrograms res
+
+
+-- | Get the 'Texture' specified by the given 'String' from the given 'SceneResources'.
+getTexture :: SceneResources -> String -> Maybe Texture
+getTexture res key = M.lookup key $ textures res
+
+
+-- | Get the 'StaticModelResource' specified by the given 'String' from the given 'SceneResources'.
+getStaticModel :: SceneResources -> String -> Maybe StaticModelResource
+getStaticModel res key = M.lookup key $ staticModels res
+
+
+-- | Get the 'AnimatedModelResource' specified by the given 'String' from the given 'SceneResources'.
+getAnimatedModel :: SceneResources -> String -> Maybe AnimatedModelResource
+getAnimatedModel res key = M.lookup key $ animatedModels res
diff --git a/Spear/Setup.hs b/Spear/Setup.hs
new file mode 100644
index 0000000..2f16c54
--- /dev/null
+++ b/Spear/Setup.hs
@@ -0,0 +1,52 @@
+module Spear.Setup
+(
+    Setup
+,   Resource
+,   register
+,   release
+,   runSetup
+,   runSetup_
+,   setupError
+,   setupIO
+)
+where
+
+
+import Control.Monad.Error
+import qualified Control.Monad.Resource as R
+import qualified Control.Monad.Trans.Class as MT (lift)
+
+
+type Setup = R.ResourceT (ErrorT String IO)
+
+type Resource = R.ReleaseKey
+
+
+-- | Register the given cleaner.
+register :: IO () -> Setup Resource
+register = R.register
+
+
+-- | Release the given 'Resource'.
+release :: Resource -> Setup ()
+release = R.release
+
+
+-- | Run the given 'Setup', freeing all of its allocated resources.
+runSetup :: Setup a -> IO (Either String a)
+runSetup = runErrorT . R.runResourceT
+
+
+-- | Run the given 'Setup', freeing all of its allocated resources.
+runSetup_ :: Setup a -> IO ()
+runSetup_ s = (runErrorT . R.runResourceT) s >> return ()
+
+
+-- | Throw an error from the 'Setup' monad.
+setupError :: String -> Setup a
+setupError = MT.lift . throwError
+
+
+-- | Lift the given IO action into the 'Setup' monad.
+setupIO :: IO a -> Setup a
+setupIO = MT.lift . MT.lift
diff --git a/Spear/Sys/Timer.hs b/Spear/Sys/Timer.hs
new file mode 100644
index 0000000..a44f7f9
--- /dev/null
+++ b/Spear/Sys/Timer.hs
@@ -0,0 +1,194 @@
+{-# INCLUDE "Timer/Timer.h" #-}
+{-# LINE 1 "Timer.hsc" #-}
+{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns #-}
+{-# LINE 2 "Timer.hsc" #-}
+module Spear.Sys.Timer
+(
+        Timer
+,       initialiseTimingSubsystem
+,       newTimer
+,       tick
+,       reset
+,       stop
+,       start
+,       sleep
+,       getTime
+,       getDelta
+,       isRunning
+)
+where
+
+
+import Foreign
+import Foreign.C.Types
+import Control.Monad
+import System.IO.Unsafe
+
+
+
+{-# LINE 28 "Timer.hsc" #-}
+type TimeReading = CDouble
+
+{-# LINE 30 "Timer.hsc" #-}
+
+data Timer = Timer {
+    getBaseTime     :: TimeReading
+,   getPausedTime   :: TimeReading
+,   getStopTime     :: TimeReading
+,   getPrevTime     :: TimeReading
+,   getCurTime      :: TimeReading
+,   getDeltaTime    :: CFloat
+,   getRunning      :: CChar
+}
+
+
+
+{-# LINE 43 "Timer.hsc" #-}
+
+
+instance Storable Timer where
+    sizeOf _    = (48)
+{-# LINE 47 "Timer.hsc" #-}
+        alignment _     = alignment (undefined :: TimeReading)
+        
+        peek ptr = do
+                baseTime <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
+{-# LINE 51 "Timer.hsc" #-}
+                pausedTime <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
+{-# LINE 52 "Timer.hsc" #-}
+                stopTime <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
+{-# LINE 53 "Timer.hsc" #-}
+                prevTime <- (\hsc_ptr -> peekByteOff hsc_ptr 24) ptr
+{-# LINE 54 "Timer.hsc" #-}
+                curTime <- (\hsc_ptr -> peekByteOff hsc_ptr 32) ptr
+{-# LINE 55 "Timer.hsc" #-}
+                deltaTime <- (\hsc_ptr -> peekByteOff hsc_ptr 40) ptr
+{-# LINE 56 "Timer.hsc" #-}
+                stopped <- (\hsc_ptr -> peekByteOff hsc_ptr 44) ptr
+{-# LINE 57 "Timer.hsc" #-}
+                return $ Timer baseTime pausedTime stopTime prevTime curTime deltaTime stopped
+                
+        poke ptr (Timer baseTime pausedTime stopTime prevTime curTime deltaTime stopped) = do
+                (\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr baseTime
+{-# LINE 61 "Timer.hsc" #-}
+                (\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr pausedTime
+{-# LINE 62 "Timer.hsc" #-}
+                (\hsc_ptr -> pokeByteOff hsc_ptr 16) ptr stopTime
+{-# LINE 63 "Timer.hsc" #-}
+                (\hsc_ptr -> pokeByteOff hsc_ptr 24) ptr prevTime
+{-# LINE 64 "Timer.hsc" #-}
+                (\hsc_ptr -> pokeByteOff hsc_ptr 32) ptr curTime
+{-# LINE 65 "Timer.hsc" #-}
+                (\hsc_ptr -> pokeByteOff hsc_ptr 40) ptr deltaTime
+{-# LINE 66 "Timer.hsc" #-}
+                (\hsc_ptr -> pokeByteOff hsc_ptr 44) ptr stopped
+{-# LINE 67 "Timer.hsc" #-}
+
+
+foreign import ccall "Timer.h timer_initialise_subsystem"
+        c_timer_initialise_subsystem :: IO ()
+        
+foreign import ccall "Timer.h timer_initialise_timer"
+        c_timer_initialise_timer :: Ptr Timer -> IO ()
+
+foreign import ccall "Timer.h timer_tick"
+        c_timer_tick :: Ptr Timer -> IO ()
+
+foreign import ccall "Timer.h timer_reset"
+        c_timer_reset :: Ptr Timer -> IO ()
+
+foreign import ccall "Timer.h timer_stop"
+        c_timer_stop :: Ptr Timer -> IO ()
+
+foreign import ccall "Timer.h timer_start"
+        c_timer_start :: Ptr Timer -> IO ()
+
+foreign import ccall "Timer.h timer_sleep"
+        c_timer_sleep :: CFloat -> IO ()
+
+foreign import ccall "Timer.h timer_get_time"
+        c_timer_get_time :: Ptr Timer -> IO (CFloat)
+
+foreign import ccall "Timer.h timer_get_delta"
+        c_timer_get_delta :: Ptr Timer -> IO (CFloat)
+
+foreign import ccall "Timer.h timer_is_running"
+        c_timer_is_running :: Ptr Timer -> IO (CChar)
+
+
+-- | Initialises the timing subsystem.
+initialiseTimingSubsystem :: IO ()
+initialiseTimingSubsystem = c_timer_initialise_subsystem
+
+
+-- | Creates a timer.
+newTimer :: Timer
+newTimer = unsafePerformIO . alloca $ \tptr -> do
+        c_timer_initialise_timer tptr
+        t <- peek tptr
+        return t
+
+
+-- | Updates the timer.
+tick :: Timer -> IO (Timer)
+tick t = alloca $ \tptr -> do
+        poke tptr t
+        c_timer_tick tptr
+        t' <- peek tptr
+        return t'
+
+
+-- | Resets the timer.
+reset :: Timer -> IO (Timer)
+reset t = alloca $ \tptr -> do
+        poke tptr t
+        c_timer_reset tptr
+        t' <- peek tptr
+        return t'
+
+
+-- | Stops the timer.
+stop :: Timer -> IO (Timer)
+stop t = alloca $ \tptr -> do
+        poke tptr t
+        c_timer_stop tptr
+        t' <- peek tptr
+        return t'
+
+
+-- | Starts the timer.
+start :: Timer -> IO (Timer)
+start t = alloca $ \tptr -> do
+        poke tptr t
+        c_timer_start tptr
+        t' <- peek tptr
+        return t'
+
+
+-- | Puts the caller thread to sleep for the given number of seconds.
+sleep :: Float -> IO ()
+sleep = c_timer_sleep . realToFrac
+
+
+-- | Gets the timer's total running time.
+getTime :: Timer -> Float
+getTime t = unsafePerformIO . alloca $ \tptr -> do
+        poke tptr t
+        time <- c_timer_get_time tptr
+        return (realToFrac time)
+
+
+-- | Gets the timer's delta since the last tick.
+getDelta :: Timer -> Float
+getDelta t = unsafePerformIO . alloca $ \tptr -> do
+        poke tptr t
+        dt <- c_timer_get_delta tptr
+        return (realToFrac dt)
+
+
+-- | Returns true if the timer is running, false otherwise.
+isRunning :: Timer -> Bool
+isRunning t = unsafePerformIO . alloca $ \tptr -> do
+        poke tptr t
+        running <- c_timer_is_running tptr
+        return (running /= 0)
diff --git a/Spear/Sys/Timer.hsc b/Spear/Sys/Timer.hsc
new file mode 100644
index 0000000..c800c8d
--- /dev/null
+++ b/Spear/Sys/Timer.hsc
@@ -0,0 +1,175 @@
+{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns #-}
+module Spear.Sys.Timer
+(
+        Timer
+,       initialiseTimingSubsystem
+,       newTimer
+,       tick
+,       reset
+,       stop
+,       start
+,       sleep
+,       getTime
+,       getDelta
+,       isRunning
+)
+where
+
+
+import Foreign hiding (unsafePerformIO)
+import Foreign.C.Types
+import Control.Monad
+import System.IO.Unsafe
+
+
+#ifdef WIN32
+type TimeReading = CULLong
+#else
+type TimeReading = CDouble
+#endif
+
+data Timer = Timer {
+        getBaseTime             :: TimeReading
+,       getPausedTime   :: TimeReading
+,       getStopTime             :: TimeReading
+,       getPrevTime             :: TimeReading
+,       getCurTime              :: TimeReading
+,       getDeltaTime    :: CFloat
+,       getRunning              :: CChar
+}
+
+
+#include "Timer/Timer.h"
+
+
+instance Storable Timer where
+        sizeOf _        = #{size timer}
+        alignment _     = alignment (undefined :: TimeReading)
+        
+        peek ptr = do
+                baseTime <- #{peek timer, baseTime} ptr
+                pausedTime <- #{peek timer, pausedTime} ptr
+                stopTime <- #{peek timer, stopTime} ptr
+                prevTime <- #{peek timer, prevTime} ptr
+                curTime <- #{peek timer, curTime} ptr
+                deltaTime <- #{peek timer, deltaTime} ptr
+                stopped <- #{peek timer, stopped} ptr
+                return $ Timer baseTime pausedTime stopTime prevTime curTime deltaTime stopped
+                
+        poke ptr (Timer baseTime pausedTime stopTime prevTime curTime deltaTime stopped) = do
+                #{poke timer, baseTime} ptr baseTime
+                #{poke timer, pausedTime} ptr pausedTime
+                #{poke timer, stopTime} ptr stopTime
+                #{poke timer, prevTime} ptr prevTime
+                #{poke timer, curTime} ptr curTime
+                #{poke timer, deltaTime} ptr deltaTime
+                #{poke timer, stopped} ptr stopped
+
+
+foreign import ccall "Timer.h timer_initialise_subsystem"
+        c_timer_initialise_subsystem :: IO ()
+        
+foreign import ccall "Timer.h timer_initialise_timer"
+        c_timer_initialise_timer :: Ptr Timer -> IO ()
+
+foreign import ccall "Timer.h timer_tick"
+        c_timer_tick :: Ptr Timer -> IO ()
+
+foreign import ccall "Timer.h timer_reset"
+        c_timer_reset :: Ptr Timer -> IO ()
+
+foreign import ccall "Timer.h timer_stop"
+        c_timer_stop :: Ptr Timer -> IO ()
+
+foreign import ccall "Timer.h timer_start"
+        c_timer_start :: Ptr Timer -> IO ()
+
+foreign import ccall "Timer.h timer_sleep"
+        c_timer_sleep :: CFloat -> IO ()
+
+foreign import ccall "Timer.h timer_get_time"
+        c_timer_get_time :: Ptr Timer -> IO (CFloat)
+
+foreign import ccall "Timer.h timer_get_delta"
+        c_timer_get_delta :: Ptr Timer -> IO (CFloat)
+
+foreign import ccall "Timer.h timer_is_running"
+        c_timer_is_running :: Ptr Timer -> IO (CChar)
+
+
+-- | Initialises the timing subsystem.
+initialiseTimingSubsystem :: IO ()
+initialiseTimingSubsystem = c_timer_initialise_subsystem
+
+
+-- | Creates a timer.
+newTimer :: Timer
+newTimer = unsafePerformIO . alloca $ \tptr -> do
+        c_timer_initialise_timer tptr
+        t <- peek tptr
+        return t
+
+
+-- | Updates the timer.
+tick :: Timer -> IO (Timer)
+tick t = alloca $ \tptr -> do
+        poke tptr t
+        c_timer_tick tptr
+        t' <- peek tptr
+        return t'
+
+
+-- | Resets the timer.
+reset :: Timer -> IO (Timer)
+reset t = alloca $ \tptr -> do
+        poke tptr t
+        c_timer_reset tptr
+        t' <- peek tptr
+        return t'
+
+
+-- | Stops the timer.
+stop :: Timer -> IO (Timer)
+stop t = alloca $ \tptr -> do
+        poke tptr t
+        c_timer_stop tptr
+        t' <- peek tptr
+        return t'
+
+
+-- | Starts the timer.
+start :: Timer -> IO (Timer)
+start t = alloca $ \tptr -> do
+        poke tptr t
+        c_timer_start tptr
+        t' <- peek tptr
+        return t'
+
+
+-- | Puts the caller thread to sleep for the given number of seconds.
+sleep :: Float -> IO ()
+sleep = c_timer_sleep . realToFrac
+
+
+-- | Gets the timer's total running time.
+getTime :: Timer -> Float
+getTime t = unsafePerformIO . alloca $ \tptr -> do
+        poke tptr t
+        time <- c_timer_get_time tptr
+        return (realToFrac time)
+
+
+-- | Gets the timer's delta since the last tick.
+getDelta :: Timer -> Float
+getDelta t = unsafePerformIO . alloca $ \tptr -> do
+        poke tptr t
+        dt <- c_timer_get_delta tptr
+        return (realToFrac dt)
+
+
+-- | Returns true if the timer is running, false otherwise.
+isRunning :: Timer -> Bool
+isRunning t = unsafePerformIO . alloca $ \tptr -> do
+        poke tptr t
+        running <- c_timer_is_running tptr
+        return (running /= 0)
diff --git a/Spear/Sys/Timer/Timer.h b/Spear/Sys/Timer/Timer.h
new file mode 100644
index 0000000..60b81f7
--- /dev/null
+++ b/Spear/Sys/Timer/Timer.h
@@ -0,0 +1,73 @@
+#ifndef _SPEAR_TIMER_H
+#define _SPEAR_TIMER_H
+
+#ifdef _MSC_VER
+        #ifdef DLL_EXPORT
+                #define DECLDIR __declspec(dllexport)
+        #else
+                #define DECLDIR __declspec(dllimport)
+        #endif
+#else
+        #define DECLDIR
+#endif
+
+#ifdef WIN32
+        #ifdef _MSC_VER
+                typedef __int64 timeReading;
+        #else
+                typedef __UINT64_TYPE__ timeReading;
+        #endif
+#else
+        typedef double timeReading;
+#endif
+
+#ifdef __cplusplus
+extern C {
+#endif
+        
+typedef struct
+{       
+        timeReading baseTime;
+        timeReading pausedTime;
+        timeReading stopTime;
+        timeReading prevTime;
+        timeReading curTime;
+        float deltaTime;
+        char stopped;
+} timer;
+
+/// Initialises the timing subsystem.
+void DECLDIR timer_initialise_subsystem ();
+
+/// Initialises a timer.
+void DECLDIR timer_initialise_timer (timer* t);
+
+/// Call every frame.
+void DECLDIR timer_tick (timer* t);
+
+/// Call before message loop.
+void DECLDIR timer_reset (timer* t);
+
+/// Call when paused.
+void DECLDIR timer_stop (timer* t);
+
+/// Call when unpaused.
+void DECLDIR timer_start (timer* t);
+
+/// Puts the caller thread to sleep for the given number of seconds.
+void DECLDIR timer_sleep (float seconds);
+
+/// Returns total running time in seconds.
+float DECLDIR timer_get_time (timer* t);
+
+/// Returns the elapsed time in seconds.
+float DECLDIR timer_get_delta (timer* t);
+
+/// Gets the timer's running state.
+char DECLDIR timer_is_running (timer* t);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif // _SPEAR_TIMER_H
diff --git a/Spear/Sys/Timer/ctimer.c b/Spear/Sys/Timer/ctimer.c
new file mode 100644
index 0000000..7f7ffe0
--- /dev/null
+++ b/Spear/Sys/Timer/ctimer.c
@@ -0,0 +1,172 @@
+#include "Timer.h"
+#include <stdlib.h>
+
+#ifdef __APPLE__
+        #include <mach/mach_time.h>
+#elif WIN32
+        #define WIN32_LEAN_AND_MEAN
+        #include <Windows.h>
+#else // Linux
+        #include <time.h>
+        const double NSEC_TO_SEC = 1.0f/1000000000.0f;
+        const double SEC_TO_NSEC = 1000000000.0f;
+#endif
+
+
+static double secondsPerCount;
+
+
+void timer_initialise_subsystem ()
+{
+#ifdef WIN32
+        __int64 countsPerSec;
+        QueryPerformanceFrequency((LARGE_INTEGER*)&countsPerSec);
+        secondsPerCount = 1.0 / (double)countsPerSec;
+#else
+        /*struct timespec ts;
+        clock_getres(CLOCK_REALTIME, &ts);
+        secondsPerCount = (double)ts.tv_sec + ((double)ts.tv_nsec * NSEC_TO_SEC);*/
+        secondsPerCount = 1.0f;
+#endif
+}
+
+
+timeReading now ()
+{
+        timeReading t;
+        
+#ifdef __APPLE__
+        t = mach_absolute_time();
+#elif WIN32
+        QueryPerformanceCounter((LARGE_INTEGER*)&t);
+#else
+        struct timespec ts;
+        clock_gettime(CLOCK_REALTIME, &ts);
+        t = ts.tv_sec + ((double)ts.tv_nsec * NSEC_TO_SEC);
+#endif
+        
+        return t;
+}
+
+
+void DECLDIR timer_initialise_timer (timer* t)
+{
+        t->baseTime             = 0;
+        t->pausedTime   = 0;
+        t->stopTime             = 0;
+        t->prevTime             = 0;
+        t->curTime              = 0;
+        t->deltaTime    = 0;
+        t->stopped              = 1;
+}
+
+
+void timer_tick (timer* t)
+{
+        if (t->stopped)
+        {
+                t->deltaTime = 0.0;
+                return;
+        }
+
+        //Get the time on this frame.
+        t->curTime = now();
+
+        //Time delta between the current frame and the previous.
+        t->deltaTime = (float) ((t->curTime - t->prevTime) * secondsPerCount);
+
+        //Update for next frame.
+        t->prevTime = t->curTime;
+
+        // Force nonnegative. The DXSDK's CDXUTTimer mentions that if the
+        // processor goes into a power save mode or we get shuffled to
+        // another processor, then mDeltaTime can be negative.
+        if(t->deltaTime < 0.0)
+        {
+                t->deltaTime = 0.0;
+        }
+}
+
+
+void timer_reset (timer* t)
+{
+        t->curTime = now();
+        t->baseTime = t->curTime;
+        t->prevTime = t->curTime;
+        t->stopTime = 0;
+        t->stopped = 0;
+}
+
+
+void timer_stop (timer* t)
+{
+        // Don't do anything if we are already stopped.
+        if (!t->stopped)
+        {
+                // Grab the stop time.
+                t->stopTime = now();
+
+                // Now we are stopped.
+                t->stopped = 1;
+        }
+}
+
+
+void timer_start (timer* t)
+{
+        // Only start if we are stopped.
+        if (t->stopped)
+        {
+                timeReading startTime = now();
+
+                // Accumulate the paused time.
+                t->pausedTime = t->pausedTime + startTime - t->stopTime;
+
+                // Make the previous time valid.
+                t->prevTime = startTime;
+
+                //Now we are running.
+                t->stopTime = 0;
+                t->stopped = 0;
+        }
+}
+
+
+void timer_sleep (float seconds)
+{
+#ifdef WIN32
+        Sleep((DWORD)(seconds * 1000));
+#else
+        struct timespec ts;
+        ts.tv_sec  = 0;
+        ts.tv_nsec = seconds * SEC_TO_NSEC;
+        nanosleep(&ts, NULL);
+#endif
+}
+
+
+float timer_get_time (timer* t)
+{
+        // If we are stopped, we do not count the time we have been stopped for.
+        if (t->stopped)
+        {
+                return (float)((t->stopTime - t->baseTime) * secondsPerCount);
+        }
+        // Otherwise return the time elapsed since the start of the game without counting the time we have been paused for.
+        else
+        {
+                return (float)((t->curTime - t->baseTime - t->pausedTime) * secondsPerCount);
+        }
+}
+
+
+float timer_get_delta (timer* t)
+{
+        return t->deltaTime;
+}
+
+
+char timer_is_running (timer* t)
+{
+        return !t->stopped;
+}
diff --git a/Spear/Sys/Timer/main.hs b/Spear/Sys/Timer/main.hs
new file mode 100644
index 0000000..8cf1a76
--- /dev/null
+++ b/Spear/Sys/Timer/main.hs
@@ -0,0 +1,22 @@
+import Spear.Sys.Timer

+

+main = do

+        initialiseTimingSubsystem

+        wait 3

+        putStrLn "Done"

+        

+        

+wait secs = do

+        timer <- start newTimer

+        wait' secs timer

+        

+        

+wait' secs timer = do

+        timer' <- tick timer

+        let t = getTime timer'

+        

+        putStrLn $ show t

+        

+        if t >= secs then return ()

+        else wait' secs timer'

+        
\ No newline at end of file
diff --git a/Spear/Updatable.hs b/Spear/Updatable.hs
new file mode 100644
index 0000000..2c7a7e9
--- /dev/null
+++ b/Spear/Updatable.hs
@@ -0,0 +1,9 @@
+module Spear.Updatable
+where
+
+
+-- | A type class for types that can update themselves given a time delta.
+class Updatable a where
+    
+    -- | Updates the given 'Updatable'.
+    update :: Float -> a -> a