From 9209a05d5d61458bf63af1f4b14c03dee934112a Mon Sep 17 00:00:00 2001
From: 3gg <3gg@shellblade.net>
Date: Mon, 2 Oct 2023 09:03:53 -0700
Subject: First pass at render backend.

---
 Demos/Pong/Main.hs             | 110 +++++++++++++--------
 Spear.cabal                    |  13 ++-
 Spear/GL.hs                    |  13 +--
 Spear/Game.hs                  |  53 +++++++---
 Spear/Math/Matrix3.hs          |   6 +-
 Spear/Math/Matrix4.hs          |  30 +++---
 Spear/Math/Spatial3.hs         |   6 +-
 Spear/Math/Vector/Vector3.hs   |   2 +-
 Spear/Render/AnimatedModel.hs  |   4 +-
 Spear/Render/Core.hs           |  17 ++++
 Spear/Render/Core/Buffer.hs    | 122 +++++++++++++++++++++++
 Spear/Render/Core/Constants.hs |  12 +++
 Spear/Render/Core/Geometry.hs  | 150 ++++++++++++++++++++++++++++
 Spear/Render/Core/Pipeline.hs  |  74 ++++++++++++++
 Spear/Render/Core/Shader.hs    | 216 +++++++++++++++++++++++++++++++++++++++++
 Spear/Render/Core/State.hs     | 157 ++++++++++++++++++++++++++++++
 Spear/Render/Immediate.hs      | 166 +++++++++++++++++++++++++++++++
 Spear/Render/StaticModel.hs    |   4 +-
 Spear/Scene/Loader.hs          |  12 +--
 Spear/Window.hs                |  38 +++++---
 20 files changed, 1092 insertions(+), 113 deletions(-)
 create mode 100644 Spear/Render/Core.hs
 create mode 100644 Spear/Render/Core/Buffer.hs
 create mode 100644 Spear/Render/Core/Constants.hs
 create mode 100644 Spear/Render/Core/Geometry.hs
 create mode 100644 Spear/Render/Core/Pipeline.hs
 create mode 100644 Spear/Render/Core/Shader.hs
 create mode 100644 Spear/Render/Core/State.hs
 create mode 100644 Spear/Render/Immediate.hs

diff --git a/Demos/Pong/Main.hs b/Demos/Pong/Main.hs
index ac0feab..c82b67e 100644
--- a/Demos/Pong/Main.hs
+++ b/Demos/Pong/Main.hs
@@ -1,31 +1,49 @@
 module Main where
 
-import           Data.Maybe                              (mapMaybe)
-import           Graphics.Rendering.OpenGL.GL            (($=))
-import qualified Graphics.Rendering.OpenGL.GL            as GL
-import           Graphics.Rendering.OpenGL.GL.VertexSpec (currentColor)
 import           Pong
+
 import           Spear.App
 import           Spear.Game
 import           Spear.Math.AABB
+import           Spear.Math.Matrix4                      as Matrix4 hiding
+                                                                    (position)
 import           Spear.Math.Spatial
 import           Spear.Math.Spatial2
 import           Spear.Math.Vector
+import           Spear.Render.Core.Pipeline
+import           Spear.Render.Core.State
+import           Spear.Render.Immediate
 import           Spear.Window
 
+import           Data.Maybe                              (mapMaybe)
+import           Graphics.Rendering.OpenGL.GL            (($=))
+import qualified Graphics.Rendering.OpenGL.GL            as GL
+import           Graphics.Rendering.OpenGL.GL.VertexSpec (currentColor)
+
+
 data GameState = GameState
-  { window :: Window,
-    world  :: [GameObject]
+  { window          :: Window
+  , renderCoreState :: RenderCoreState
+  , immRenderState  :: ImmRenderState
+  , viewProjection  :: Matrix4
+  , world           :: [GameObject]
   }
 
 app = App step render resize
 
 main =
-  withWindow (900, 600) (2, 0) (Just "Pong") initGame $
+  withWindow (900, 600) (Just "Pong") initGame endGame $
     loop app
 
 initGame :: Window -> Game () GameState
-initGame window = return $ GameState window newWorld
+initGame window = do
+  (immRenderState, renderCoreState) <- runSiblingGame newImmRenderer newRenderCoreState
+  return $ GameState window renderCoreState immRenderState Matrix4.id newWorld
+
+endGame :: Game GameState ()
+endGame = do
+  game <- getGameState
+  runSubGame' (deleteImmRenderer $ immRenderState game) (renderCoreState game)
 
 step :: Elapsed -> Dt -> [InputEvent] -> Game GameState Bool
 step elapsed dt inputEvents = do
@@ -38,47 +56,54 @@ step elapsed dt inputEvents = do
   return (not $ exitRequested inputEvents)
 
 render :: Game GameState ()
-render = getGameState >>= \gs -> gameIO . render' $ world gs
+render = do
+  gameState <- getGameState
+  immRenderState' <- flip execSubGame (immRenderState gameState) $ do
+    immStart
+    immSetViewProjectionMatrix (viewProjection gameState)
+    -- Clear the background to a different colour than the playable area to make
+    -- the latter distinguishable.
+    gameIO $ do
+      setClearColour (0.2, 0.2, 0.2, 0.0)
+      clearBuffers [ColourBuffer]
+    render' $ world gameState
+    immEnd
+  saveGameState $ gameState { immRenderState = immRenderState' }
 
-render' :: [GameObject] -> IO ()
+render' :: [GameObject] -> Game ImmRenderState ()
 render' world = do
-  -- Clear the background to a different colour than the playable area to make
-  -- the latter distinguishable.
-  GL.clearColor $= GL.Color4 0.2 0.2 0.2 0.0
-  GL.clear [GL.ColorBuffer]
-  GL.matrixMode $= GL.Modelview 0
-  GL.loadIdentity
+  immLoadIdentity
   renderBackground
   -- Draw objects.
-  GL.currentColor $= GL.Color4 1.0 1.0 1.0 1.0
+  immSetColour (vec4 1.0 1.0 1.0 1.0)
   mapM_ renderGO world
 
-renderBackground :: IO ()
+renderBackground :: Game ImmRenderState ()
 renderBackground =
   let pmin = 0 :: Float
       pmax = 1 :: Float
   in do
-    GL.currentColor $= GL.Color4 0.7 0.5 0.7 1.0
-    GL.renderPrimitive GL.TriangleStrip $ do
-        GL.vertex (GL.Vertex2 pmin pmax)
-        GL.vertex (GL.Vertex2 pmin pmin)
-        GL.vertex (GL.Vertex2 pmax pmax)
-        GL.vertex (GL.Vertex2 pmax pmin)
-
-renderGO :: GameObject -> IO ()
+    immSetColour (vec4 0.6 0.35 0.6 1.0)
+    immDrawQuads2d [
+      (vec2 pmin pmin
+      ,vec2 pmax pmin
+      ,vec2 pmax pmax
+      ,vec2 pmin pmax)]
+
+renderGO :: GameObject -> Game ImmRenderState ()
 renderGO go = do
-  let (AABB2 (Vector2 xmin' ymin') (Vector2 xmax' ymax')) = aabb go
+  let (AABB2 (Vector2 xmin ymin) (Vector2 xmax ymax)) = aabb go
       (Vector2 xcenter ycenter) = position go
-      (xmin, ymin, xmax, ymax) = (f2d xmin', f2d ymin', f2d xmax', f2d ymax')
-  GL.preservingMatrix $ do
-    GL.translate (GL.Vector3 (f2d xcenter) (f2d ycenter) 0)
-    GL.renderPrimitive GL.TriangleStrip $ do
-      GL.vertex (GL.Vertex2 xmin ymax)
-      GL.vertex (GL.Vertex2 xmin ymin)
-      GL.vertex (GL.Vertex2 xmax ymax)
-      GL.vertex (GL.Vertex2 xmax ymin)
-
-resize :: WindowEvent -> Game s ()
+  immPreservingMatrix $ do
+    immTranslate (vec3 xcenter ycenter 0)
+    immDrawQuads2d [
+      (vec2 xmin ymin
+      ,vec2 xmax ymin
+      ,vec2 xmax ymax
+      ,vec2 xmin ymax)]
+
+-- TODO: Fix the resize hang.
+resize :: WindowEvent -> Game GameState ()
 resize (ResizeEvent w h) =
   let r = fromIntegral w / fromIntegral h
       pad    = if r > 1 then (r-1) / 2 else (1/r - 1) / 2
@@ -86,12 +111,11 @@ resize (ResizeEvent w h) =
       right  = if r > 1 then 1 + pad else 1
       bottom = if r > 1 then 0 else -pad
       top    = if r > 1 then 1 else 1 + pad
-  in gameIO $ do
-    GL.viewport $= (GL.Position 0 0, GL.Size (fromIntegral w) (fromIntegral h))
-    GL.matrixMode $= GL.Projection
-    GL.loadIdentity
-    GL.ortho left right bottom top (-1) 1
-    GL.matrixMode $= GL.Modelview 0
+  in do
+    gameIO $ setViewport 0 0 w h
+    modifyGameState $ \state -> state {
+      viewProjection = Matrix4.ortho left right bottom top (-1) 1
+    }
 
 translateEvents = mapMaybe translateEvents'
   where translateEvents' (KeyDown KEY_LEFT)  = Just MoveLeft
diff --git a/Spear.cabal b/Spear.cabal
index 40b625d..b044ae2 100644
--- a/Spear.cabal
+++ b/Spear.cabal
@@ -21,6 +21,8 @@ library
       bytestring -any,
       directory -any,
       exceptions -any,
+      hashable -any,
+      hashmap -any,
       mtl -any,
       transformers -any,
       resourcet -any,
@@ -62,6 +64,14 @@ library
       Spear.Math.Vector.Vector4
       Spear.Prelude
       Spear.Render.AnimatedModel
+      Spear.Render.Core
+      Spear.Render.Core.Buffer
+      Spear.Render.Core.Constants
+      Spear.Render.Core.Geometry
+      Spear.Render.Core.Pipeline
+      Spear.Render.Core.Shader
+      Spear.Render.Core.State
+      Spear.Render.Immediate
       Spear.Render.Material
       Spear.Render.Model
       Spear.Render.Program
@@ -105,7 +115,7 @@ library
       Spear/Assets/Model/Model_error_code.h
       Spear/Assets/Model/sys_types.h
       Spear/Render/RenderModel.h
-      Timer/timer.h
+      Spear/Sys/Timer/timer.h
 
     include-dirs:
       .
@@ -113,6 +123,7 @@ library
       Spear/Assets/Image
       Spear/Assets/Image/BMP
       Spear/Assets/Model
+      Spear/Contrib/glad/include/
       Spear/Render
       Spear/Sys
 
diff --git a/Spear/GL.hs b/Spear/GL.hs
index 81a433e..f463109 100644
--- a/Spear/GL.hs
+++ b/Spear/GL.hs
@@ -87,6 +87,13 @@ module Spear.GL
   )
 where
 
+import           Spear.Assets.Image
+import           Spear.Game
+import           Spear.Math.Algebra
+import           Spear.Math.Matrix3        (Matrix3)
+import           Spear.Math.Matrix4        (Matrix4)
+import           Spear.Math.Vector
+
 import           Control.Monad
 import           Control.Monad.Trans.Class
 import           Control.Monad.Trans.State as State
@@ -103,12 +110,6 @@ import           Foreign.Storable
 import           Foreign.Storable          (peek)
 import           Graphics.GL.Core46
 import           Prelude                   hiding ((*))
-import           Spear.Assets.Image
-import           Spear.Game
-import           Spear.Math.Algebra
-import           Spear.Math.Matrix3        (Matrix3)
-import           Spear.Math.Matrix4        (Matrix4)
-import           Spear.Math.Vector
 import           System.Directory          (doesFileExist, getCurrentDirectory,
                                             setCurrentDirectory)
 import           System.IO                 (hPutStrLn, stderr)
diff --git a/Spear/Game.hs b/Spear/Game.hs
index e43974f..14e3f20 100644
--- a/Spear/Game.hs
+++ b/Spear/Game.hs
@@ -11,7 +11,8 @@ module Spear.Game
 
     -- * Game resources
     register,
-    unregister,
+    release,
+    release',
 
     -- * Error handling
     gameError,
@@ -21,11 +22,15 @@ module Spear.Game
 
     -- * Running and IO
     runGame,
-    runGame',
+    evalGame,
     runSubGame,
     runSubGame',
     evalSubGame,
     execSubGame,
+    runSiblingGame,
+    runSiblingGame',
+    evalSiblingGame,
+    execSiblingGame,
     gameIO,
   )
 where
@@ -35,23 +40,19 @@ import           Control.Monad.State.Strict
 import           Control.Monad.Trans.Class    (lift)
 import qualified Control.Monad.Trans.Resource as R
 
-type Resource = R.ReleaseKey
 
-type Game s = StateT s (R.ResourceT IO)
+type Resource = R.ReleaseKey
 
 class ResourceClass a where
   getResource :: a -> Resource
 
-  release :: a -> Game s ()
-  release = unregister . getResource
-
-  clean :: a -> IO ()
-  clean = R.release . getResource
+type Game s = StateT s (R.ResourceT IO)
 
 newtype GameException = GameException String deriving (Show)
 
 instance Exception GameException
 
+
 -- | Retrieve the game state.
 getGameState :: Game s s
 getGameState = get
@@ -69,8 +70,12 @@ register :: IO () -> Game s Resource
 register = lift . R.register
 
 -- | Release the given 'Resource'.
-unregister :: Resource -> Game s ()
-unregister = lift . R.release
+release :: ResourceClass a => a -> Game s ()
+release = lift . R.release . getResource
+
+-- | Release the given 'Resource'.
+release' :: ResourceClass a => a -> IO ()
+release' = R.release . getResource
 
 -- | Throw an error from the 'Game' monad.
 gameError :: String -> Game s a
@@ -97,9 +102,9 @@ catchGameErrorFinally game finally = catch game $ \err -> finally >> gameError'
 runGame :: Game s a -> s -> IO (a, s)
 runGame game = R.runResourceT . runStateT game
 
--- | Run the given game and discard its state.
-runGame' :: Game s a -> s -> IO a
-runGame' g s = fst <$> runGame g s
+-- | Run the given game and return its result.
+evalGame :: Game s a -> s -> IO a
+evalGame g s = fst <$> runGame g s
 
 -- | Fully run the given sub game, unrolling the entire monad stack.
 runSubGame :: Game s a -> s -> Game t (a, s)
@@ -109,14 +114,30 @@ runSubGame g s = gameIO $ runGame g s
 runSubGame' :: Game s a -> s -> Game t ()
 runSubGame' g s = void $ runSubGame g s
 
--- | Run the given game and return its result.
+-- | Run the given sub game and return its result.
 evalSubGame :: Game s a -> s -> Game t a
 evalSubGame g s = fst <$> runSubGame g s
 
--- | Run the given game and return its state.
+-- | Run the given sub game and return its state.
 execSubGame :: Game s a -> s -> Game t s
 execSubGame g s = snd <$> runSubGame g s
 
+-- | Run the given sibling game, unrolling StateT but not ResourceT.
+runSiblingGame :: Game s a -> s -> Game t (a, s)
+runSiblingGame g s = lift $ runStateT g s
+
+-- | Like 'runSiblingGame', but discarding the result.
+runSiblingGame' :: Game s a -> s -> Game t ()
+runSiblingGame' g s = void $ runSiblingGame g s
+
+-- | Run the given sibling game and return its result.
+evalSiblingGame :: Game s a -> s -> Game t a
+evalSiblingGame g s = fst <$> runSiblingGame g s
+
+-- | Run the given sibling game and return its state.
+execSiblingGame :: Game s a -> s -> Game t s
+execSiblingGame g s = snd <$> runSiblingGame g s
+
 -- | Perform the given IO action in the 'Game' monad.
 gameIO :: IO a -> Game s a
 gameIO = lift . lift
diff --git a/Spear/Math/Matrix3.hs b/Spear/Math/Matrix3.hs
index c8ed6d2..3493d63 100644
--- a/Spear/Math/Matrix3.hs
+++ b/Spear/Math/Matrix3.hs
@@ -25,7 +25,7 @@ module Spear.Math.Matrix3
 ,   translate
 ,   translatev
     -- ** Rotation
-,   rot
+,   rotate
     -- ** Scale
 ,   Spear.Math.Matrix3.scale
 ,   scalev
@@ -209,8 +209,8 @@ translatev v = mat3
 -- | Create a rotation matrix rotating counter-clockwise about the Z axis.
 --
 -- The given angle must be in degrees.
-rot :: Float -> Matrix3
-rot angle = mat3
+rotate :: Float -> Matrix3
+rotate angle = mat3
     c   (-s) 0
     s   c    0
     0   0    1
diff --git a/Spear/Math/Matrix4.hs b/Spear/Math/Matrix4.hs
index bc74a27..225bb0e 100644
--- a/Spear/Math/Matrix4.hs
+++ b/Spear/Math/Matrix4.hs
@@ -24,12 +24,12 @@ module Spear.Math.Matrix4
 ,   Spear.Math.Matrix4.id
     -- * Transformations
     -- ** Translation
-,   transl
-,   translv
+,   translate
+,   translatev
     -- ** Rotation
-,   rotX
-,   rotY
-,   rotZ
+,   rotateX
+,   rotateY
+,   rotateZ
 ,   axisAngle
     -- ** Scale
 ,   Spear.Math.Matrix4.scale
@@ -261,16 +261,16 @@ id = mat4
     0   0   0   1
 
 -- | Create a translation matrix.
-transl :: Float -> Float -> Float -> Matrix4
-transl x y z = mat4
+translate :: Float -> Float -> Float -> Matrix4
+translate 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
+translatev :: Vector3 -> Matrix4
+translatev v = mat4
     1    0    0    (x v)
     0    1    0    (y v)
     0    0    1    (z v)
@@ -278,8 +278,8 @@ translv v = mat4
 
 -- | Create a rotation matrix rotating about the X axis.
 -- The given angle must be in degrees.
-rotX :: Float -> Matrix4
-rotX angle = mat4
+rotateX :: Float -> Matrix4
+rotateX angle = mat4
     1    0    0    0
     0    c    (-s) 0
     0    s    c    0
@@ -290,8 +290,8 @@ rotX angle = mat4
 
 -- | Create a rotation matrix rotating about the Y axis.
 -- The given angle must be in degrees.
-rotY :: Float -> Matrix4
-rotY angle = mat4
+rotateY :: Float -> Matrix4
+rotateY angle = mat4
     c    0    s    0
     0    1    0    0
     (-s) 0    c    0
@@ -302,8 +302,8 @@ rotY angle = mat4
 
 -- | Create a rotation matrix rotating about the Z axis.
 -- The given angle must be in degrees.
-rotZ :: Float -> Matrix4
-rotZ angle = mat4
+rotateZ :: Float -> Matrix4
+rotateZ angle = mat4
     c    (-s) 0    0
     s    c    0    0
     0    0    1    0
diff --git a/Spear/Math/Spatial3.hs b/Spear/Math/Spatial3.hs
index 0f804cc..5d4d4fb 100644
--- a/Spear/Math/Spatial3.hs
+++ b/Spear/Math/Spatial3.hs
@@ -43,9 +43,9 @@ instance Positional Transform3 Vector3 where
 
 instance Rotational Transform3 Vector3 Rotation3 where
     setRotation rotation _ = Transform3 $ case rotation of
-        Pitch     angle       -> Matrix4.rotX angle
-        Yaw       angle       -> Matrix4.rotY angle
-        Roll      angle       -> Matrix4.rotZ angle
+        Pitch     angle       -> Matrix4.rotateX angle
+        Yaw       angle       -> Matrix4.rotateY angle
+        Roll      angle       -> Matrix4.rotateZ angle
         AxisAngle axis angle  -> Matrix4.axisAngle axis angle
         RotationMatrix matrix -> matrix
 
diff --git a/Spear/Math/Vector/Vector3.hs b/Spear/Math/Vector/Vector3.hs
index 9d44c8b..db5dc45 100644
--- a/Spear/Math/Vector/Vector3.hs
+++ b/Spear/Math/Vector/Vector3.hs
@@ -168,7 +168,7 @@ sizeFloat = sizeOf (undefined :: CFloat)
 
 
 instance Storable Vector3 where
-    sizeOf _    = (3::Int) * sizeFloat
+    sizeOf _    = sizeVector3
     alignment _ = alignment (undefined :: CFloat)
 
     peek ptr = do
diff --git a/Spear/Render/AnimatedModel.hs b/Spear/Render/AnimatedModel.hs
index 966fcc2..8f0d6bd 100644
--- a/Spear/Render/AnimatedModel.hs
+++ b/Spear/Render/AnimatedModel.hs
@@ -150,8 +150,8 @@ animatedModelResource
 
     rkey <- register $ do
       putStrLn "Releasing animated model resource"
-      clean vao
-      clean elementBuf
+      release' vao
+      release' elementBuf
 
     return $
       AnimatedModelResource
diff --git a/Spear/Render/Core.hs b/Spear/Render/Core.hs
new file mode 100644
index 0000000..b5308ce
--- /dev/null
+++ b/Spear/Render/Core.hs
@@ -0,0 +1,17 @@
+module Spear.Render.Core
+(
+  module Spear.Render.Core.Buffer
+, module Spear.Render.Core.Constants
+, module Spear.Render.Core.Geometry
+, module Spear.Render.Core.Pipeline
+, module Spear.Render.Core.Shader
+, module Spear.Render.Core.State
+)
+where
+
+import           Spear.Render.Core.Buffer
+import           Spear.Render.Core.Constants
+import           Spear.Render.Core.Geometry
+import           Spear.Render.Core.Pipeline
+import           Spear.Render.Core.Shader
+import           Spear.Render.Core.State
diff --git a/Spear/Render/Core/Buffer.hs b/Spear/Render/Core/Buffer.hs
new file mode 100644
index 0000000..6f1e355
--- /dev/null
+++ b/Spear/Render/Core/Buffer.hs
@@ -0,0 +1,122 @@
+module Spear.Render.Core.Buffer
+(
+  BufferData(..)
+, BufferDesc(..)
+, makeBufferAndView
+, makeBuffer
+, deleteBuffer
+, updateBuffer
+)
+where
+
+import           Spear.Game
+import           Spear.Math.Vector
+import           Spear.Render.Core.State
+
+import           Control.Monad           (void)
+import           Data.HashMap            as HashMap
+import           Data.Word
+import           Foreign.C.Types
+import           Foreign.Marshal.Alloc
+import           Foreign.Marshal.Array
+import           Foreign.Ptr
+import           Foreign.Storable
+import           Graphics.GL.Core46
+import           Unsafe.Coerce
+
+
+data BufferData
+  = BufferDataUntyped (Ptr Word8) GLuint
+  | BufferDataVec2    [Vector2]
+  | BufferDataVec3    [Vector3]
+  | BufferDataFloat   [Float]
+  | BufferDataU8      [Word8]
+  | BufferDataU16     [Word16]
+  | BufferUninitialized
+
+data BufferDesc = BufferDesc
+  { bufferDescUsage :: BufferUsage
+  , bufferDescType  :: BufferType
+  , bufferDescData  :: BufferData
+  }
+
+
+makeBufferAndView :: BufferDesc -> Game RenderCoreState (BufferView a)
+makeBufferAndView desc = do
+  buffer <- makeBuffer desc
+  return BufferView
+    { bufferViewBuffer      = buffer
+    , bufferViewOffsetBytes = 0
+    , bufferViewSizeBytes   = bufferDataSizeBytes $ bufferDescData desc
+    , bufferViewStrideBytes = 0
+    }
+
+makeBuffer :: BufferDesc -> Game RenderCoreState Buffer
+makeBuffer (BufferDesc usage bufferType bufferData) = do
+  handle <- gameIO $ alloca $ \ptr -> glGenBuffers 1 ptr >> peek ptr
+  resourceKey <- register $ deleteBuffer' handle
+  let buffer = Buffer handle resourceKey bufferType usage
+  gameIO $ updateBuffer buffer bufferData
+  modifyGameState (\state -> state {
+    buffers = HashMap.insert handle buffer (buffers state) })
+  return buffer
+
+deleteBuffer :: Buffer -> Game RenderCoreState ()
+deleteBuffer buffer = do
+  let matches buffer = (==bufferHandle buffer) . bufferHandle
+  modifyGameState (\state -> state {
+    buffers = HashMap.delete (bufferHandle buffer) (buffers state) })
+  release buffer
+
+-- TODO: use glBufferSubData for updates.
+updateBuffer :: Buffer -> BufferData -> IO ()
+updateBuffer buffer bufferData =
+  case bufferData of
+    BufferUninitialized -> return ()
+    _ -> do
+      glBindBuffer GL_ARRAY_BUFFER (bufferHandle buffer)
+      uploadData (bufferUsage buffer) bufferData
+      glBindBuffer GL_ARRAY_BUFFER 0
+
+-- Private
+
+deleteBuffer' :: GLuint -> IO ()
+deleteBuffer' handle = alloca $ \ptr -> do
+  poke ptr handle
+  glDeleteBuffers 1 ptr
+
+uploadData :: BufferUsage -> BufferData -> IO ()
+uploadData usage bufferData = case bufferData of
+  BufferDataUntyped ptr sizeBytes -> do
+    glBufferData GL_ARRAY_BUFFER (fromIntegral sizeBytes) (unsafeCoerce ptr) usage'
+  BufferDataVec2 vec2s -> withArrayLen vec2s $ \numElems ptr -> do
+    let sizeBytes = numElems * sizeOf (undefined :: Vector2)
+    glBufferData GL_ARRAY_BUFFER (fromIntegral sizeBytes) ptr usage'
+  BufferDataVec3 vec3s -> withArrayLen vec3s $ \numElems ptr -> do
+    let sizeBytes = numElems * sizeOf (undefined :: Vector3)
+    glBufferData GL_ARRAY_BUFFER (fromIntegral sizeBytes) ptr usage'
+  BufferDataFloat floats -> withArrayLen floats $ \numElems ptr -> do
+    let sizeBytes = numElems * sizeOf (undefined :: CFloat)
+    glBufferData GL_ARRAY_BUFFER (fromIntegral sizeBytes) ptr usage'
+  BufferDataU8 ints -> withArrayLen ints $ \numElems ptr -> do
+    let sizeBytes = numElems * sizeOf (undefined :: Word8)
+    glBufferData GL_ARRAY_BUFFER (fromIntegral sizeBytes) ptr usage'
+  BufferDataU16 ints -> withArrayLen ints $ \numElems ptr -> do
+    let sizeBytes = numElems * sizeOf (undefined :: Word16)
+    glBufferData GL_ARRAY_BUFFER (fromIntegral sizeBytes) ptr usage'
+  BufferUninitialized ->
+    return ()
+  where usage' = toGLUsage usage
+
+toGLUsage :: BufferUsage -> GLenum
+toGLUsage BufferStatic  = GL_STATIC_DRAW
+toGLUsage BufferDynamic = GL_DYNAMIC_DRAW
+
+bufferDataSizeBytes :: BufferData -> GLuint
+bufferDataSizeBytes bufferData = case bufferData of
+  BufferDataUntyped ptr sizeBytes -> sizeBytes
+  BufferDataVec2    vec2s         -> fromIntegral $ length vec2s  * sizeOf (undefined :: Vector2)
+  BufferDataVec3    vec3s         -> fromIntegral $ length vec3s  * sizeOf (undefined :: Vector3)
+  BufferDataFloat   floats        -> fromIntegral $ length floats * 4
+  BufferDataU8      bytes         -> fromIntegral $ length bytes
+  BufferDataU16     words         -> fromIntegral $ length words  * 2
diff --git a/Spear/Render/Core/Constants.hs b/Spear/Render/Core/Constants.hs
new file mode 100644
index 0000000..befd8ed
--- /dev/null
+++ b/Spear/Render/Core/Constants.hs
@@ -0,0 +1,12 @@
+module Spear.Render.Core.Constants where
+
+
+import           Graphics.GL.Core46
+
+
+positionChannel  = 0 :: GLuint
+normalChannel    = 1 :: GLuint
+tangentChannel   = 2 :: GLuint
+texcoordsChannel = 3 :: GLuint
+jointsChannel    = 4 :: GLuint
+weightsChannel   = 5 :: GLuint
diff --git a/Spear/Render/Core/Geometry.hs b/Spear/Render/Core/Geometry.hs
new file mode 100644
index 0000000..aa0dfe5
--- /dev/null
+++ b/Spear/Render/Core/Geometry.hs
@@ -0,0 +1,150 @@
+module Spear.Render.Core.Geometry
+(
+  newGeometryDesc
+, makeGeometry
+, deleteGeometry
+, renderGeometry
+, setPositions
+)
+where
+
+
+import           Spear.Game
+import           Spear.Math.Vector.Vector3
+import           Spear.Render.Core.Buffer
+import           Spear.Render.Core.Constants
+import           Spear.Render.Core.State
+
+import           Data.HashMap                as HashMap
+import           Data.IORef
+import           Foreign.Marshal.Alloc
+import           Foreign.Storable
+import           Graphics.GL.Core46
+import           Unsafe.Coerce
+
+
+newGeometryDesc :: GeometryDesc
+newGeometryDesc = GeometryDesc
+  { positions     = Nothing
+  , normals       = Nothing
+  , tangents      = Nothing
+  , texcoords     = Nothing
+  , joints        = Nothing
+  , weights       = Nothing
+  , indices       = Nothing
+  , numVerts      = 0
+  , numIndices    = 0
+  , primitiveType = Triangles
+  }
+
+
+makeGeometry :: GeometryDesc -> Game RenderCoreState Geometry
+makeGeometry desc = do
+  handle <- gameIO $ alloca $ \ptr -> glGenVertexArrays 1 ptr >> peek ptr
+  gameIO $ do
+    glBindVertexArray handle
+    configureVertexAttributes desc
+    glBindVertexArray 0
+  descRef <- gameIO $ newIORef desc
+  resourceKey <- register $ deleteGeometry' handle
+  let geometry = Geometry handle resourceKey descRef
+  modifyGameState (\state -> state {
+    geometries = HashMap.insert handle geometry (geometries state) })
+  return geometry
+
+deleteGeometry :: Geometry -> Game RenderCoreState ()
+deleteGeometry geometry = do
+  modifyGameState (\state -> state {
+    geometries = HashMap.delete (geometryVao geometry) (geometries state) })
+  release geometry
+
+renderGeometry :: Geometry -> IO ()
+renderGeometry geometry = do
+  desc <- readIORef (geometryDesc geometry)
+  let mode = toGLPrimitiveType $ primitiveType desc
+  glBindVertexArray (geometryVao geometry)
+  case indices desc of
+    (Just (IndicesU8 view))  -> renderIndexed view mode (numIndices desc) GL_UNSIGNED_BYTE
+    (Just (IndicesU16 view)) -> renderIndexed view mode (numIndices desc) GL_UNSIGNED_SHORT
+    Nothing                  -> glDrawArrays mode 0 (numVerts desc)
+  glBindVertexArray 0
+
+-- Functions for updating dynamic geometry.
+
+setPositions :: Geometry -> [Vector3] -> IO ()
+setPositions geometry vectors = do
+  desc <- readIORef $ geometryDesc geometry
+  case positions desc of
+    Just (Positions3d view) -> do
+      updateBuffer (bufferViewBuffer view) (BufferDataVec3 vectors)
+      updateGeometry geometry $ \desc -> desc {
+        numVerts = fromIntegral . length $ vectors
+      }
+    _ -> putStrLn "setPositions ERROR" -- TODO: handle gracefully
+
+-- Private
+
+deleteGeometry' :: GLenum -> IO ()
+deleteGeometry' handle = alloca $ \ptr -> do
+  poke ptr handle
+  glDeleteVertexArrays 1 ptr
+
+updateGeometry :: Geometry -> (GeometryDesc -> GeometryDesc) -> IO ()
+updateGeometry geometry update = do
+  desc <- readIORef $ geometryDesc geometry
+  writeIORef (geometryDesc geometry) (update desc)
+
+renderIndexed :: BufferView a -> GLenum -> GLsizei -> GLenum -> IO ()
+renderIndexed view mode numIndices indexElemSize = do
+  glBindBuffer GL_ELEMENT_ARRAY_BUFFER (bufferHandle . bufferViewBuffer $ view)
+  glDrawElements mode numIndices GL_UNSIGNED_SHORT (unsafeCoerce $ bufferViewOffsetBytes view)
+  glBindBuffer GL_ELEMENT_ARRAY_BUFFER 0
+
+configureVertexAttributes :: GeometryDesc -> IO ()
+configureVertexAttributes desc = do
+  case positions desc of
+    Just (Positions2d view) -> configureView view positionChannel 2 GL_FLOAT GL_FALSE
+    Just (Positions3d view) -> configureView view positionChannel 3 GL_FLOAT GL_FALSE
+    Nothing                 -> return ()
+  case normals desc of
+    Just view -> configureView view normalChannel 3 GL_FLOAT GL_FALSE
+    Nothing   -> return ()
+  case tangents desc of
+    Just view -> configureView view tangentChannel 4 GL_FLOAT GL_FALSE
+    Nothing   -> return ()
+  case texcoords desc of
+    Just view -> configureView view texcoordsChannel 2 GL_FLOAT GL_FALSE
+    Nothing   -> return ()
+  case joints desc of
+    Just (JointsU8 view)  -> configureView view jointsChannel 4 GL_UNSIGNED_BYTE  GL_FALSE
+    Just (JointsU16 view) -> configureView view jointsChannel 4 GL_UNSIGNED_SHORT GL_FALSE
+    Nothing               -> return ()
+  case weights desc of
+    Just (WeightsU8    view) -> configureView view weightsChannel 4 GL_UNSIGNED_BYTE  GL_TRUE
+    Just (WeightsU16   view) -> configureView view weightsChannel 4 GL_UNSIGNED_SHORT GL_TRUE
+    Just (WeightsFloat view) -> configureView view weightsChannel 4 GL_FLOAT          GL_FALSE
+    Nothing                  -> return ()
+
+-- TODO: Add the assertion:
+--   desc->num_verts <= view->size_bytes / (num_components * component_size_bytes
+configureView :: BufferView a -> GLuint -> GLint -> GLenum -> GLboolean -> IO ()
+configureView view channel numComponents componentType normalized = do
+  glBindBuffer GL_ARRAY_BUFFER (bufferHandle . bufferViewBuffer $ view)
+  glEnableVertexAttribArray channel
+  let strideBytes = bufferViewStrideBytes view
+  let offsetBytes = unsafeCoerce $ bufferViewOffsetBytes view
+  if (componentType == GL_FLOAT) || (normalized == GL_TRUE)
+    then do
+      glVertexAttribPointer channel numComponents componentType normalized
+        strideBytes offsetBytes
+    else
+      -- TODO: Assert component type
+      glVertexAttribIPointer channel numComponents componentType
+        strideBytes offsetBytes
+  glBindBuffer GL_ARRAY_BUFFER 0
+
+toGLPrimitiveType :: PrimitiveType -> GLenum
+toGLPrimitiveType primitiveType = case primitiveType of
+  Triangles     -> GL_TRIANGLES
+  TriangleFan   -> GL_TRIANGLE_FAN
+  TriangleStrip -> GL_TRIANGLE_STRIP
diff --git a/Spear/Render/Core/Pipeline.hs b/Spear/Render/Core/Pipeline.hs
new file mode 100644
index 0000000..724b391
--- /dev/null
+++ b/Spear/Render/Core/Pipeline.hs
@@ -0,0 +1,74 @@
+module Spear.Render.Core.Pipeline
+(
+  BufferTarget(..)
+, clearBuffers
+, setBlending
+, setClearColour
+, setClearDepth
+, setClearStencil
+, setCulling
+, setDepthMask
+, setPolygonOffset
+, setViewport
+)
+where
+
+import           Data.Bits          ((.|.))
+import           Data.List          (foldl')
+import           Graphics.GL.Core46
+
+
+data BufferTarget
+  = ColourBuffer
+  | DepthBuffer
+  | StencilBuffer
+
+
+clearBuffers :: [BufferTarget] -> IO ()
+clearBuffers = glClear . toBufferBitfield
+  where toBufferBitfield = foldl' (.|.) 0 . (<$>) toGLEnum
+        toGLEnum target = case target of
+          ColourBuffer  -> GL_COLOR_BUFFER_BIT
+          DepthBuffer   -> GL_DEPTH_BUFFER_BIT
+          StencilBuffer -> GL_STENCIL_BUFFER_BIT
+
+setBlending :: Bool -> IO ()
+setBlending enable =
+  if enable
+    then glEnable  GL_BLEND >> glBlendFunc GL_SRC_ALPHA GL_ONE_MINUS_SRC_ALPHA
+    else glDisable GL_BLEND
+
+setClearColour :: (Float, Float, Float, Float) -> IO ()
+setClearColour (r,g,b,a) = glClearColor r g b a
+
+setClearDepth :: Double -> IO ()
+setClearDepth = glClearDepth
+
+setClearStencil :: Int -> IO ()
+setClearStencil = glClearStencil . fromIntegral
+
+setCulling :: Bool -> IO ()
+setCulling enable = (if enable then glEnable else glDisable) GL_CULL_FACE
+
+setDepthMask :: Bool -> IO ()
+setDepthMask enable = glDepthMask (if enable then GL_TRUE else GL_FALSE)
+
+setPolygonOffset :: Float -> Float -> IO ()
+setPolygonOffset scale bias = do
+  glPolygonOffset scale bias
+  if scale /= 0 && bias /= 0
+    then glEnable  GL_POLYGON_OFFSET_FILL
+    else glDisable GL_POLYGON_OFFSET_FILL
+
+setViewport ::
+  -- | x
+  Int ->
+  -- | y
+  Int ->
+  -- | width
+  Int ->
+  -- | height
+  Int ->
+  IO ()
+setViewport x y width height =
+  glViewport (fromIntegral x) (fromIntegral y) (fromIntegral width) (fromIntegral height)
diff --git a/Spear/Render/Core/Shader.hs b/Spear/Render/Core/Shader.hs
new file mode 100644
index 0000000..4ed4430
--- /dev/null
+++ b/Spear/Render/Core/Shader.hs
@@ -0,0 +1,216 @@
+module Spear.Render.Core.Shader
+(
+  Define(..)
+, ShaderSource(..)
+, ShaderDesc(..)
+, compileShader
+, compileShaderProgram
+, deleteShader
+, deleteShaderProgram
+, activateShaderProgram
+, deactivateShaderProgram
+, setUniform
+, applyUniforms
+)
+where
+
+import           Spear.Game
+import           Spear.Math.Matrix4
+import           Spear.Math.Vector
+import           Spear.Render.Core.State
+
+import           Control.Monad           (mapM_)
+import           Data.Bits
+import           Data.Hashable
+import           Data.HashMap            as HashMap
+import           Data.IORef
+import           Data.List               (deleteBy, foldl', intercalate)
+import           Foreign.C.String
+import           Foreign.Marshal.Alloc
+import           Foreign.Marshal.Array
+import           Foreign.Marshal.Utils
+import           Foreign.Ptr
+import           Foreign.Storable
+import           Graphics.GL.Core46
+import           Unsafe.Coerce
+
+
+type Define = (String, String)
+
+data ShaderSource
+  = ShaderFromString String
+  | ShaderFromFile   FilePath
+  deriving Show
+
+data ShaderDesc = ShaderDesc
+  { shaderDescType    :: ShaderType
+  , shaderDescSource  :: ShaderSource
+  , shaderDescDefines :: [Define]
+  }
+
+
+compileShader :: ShaderDesc -> Game RenderCoreState Shader
+compileShader (ShaderDesc shaderType source defines) = do
+  code <- case source of
+    ShaderFromString code -> return code
+    ShaderFromFile   file -> gameIO $ readFile file
+  state <- getGameState
+  let shaderHash = hash code -- TODO: Should also include defines.
+  case HashMap.lookup shaderHash (shaders state) of
+    Just shader -> return shader
+    Nothing -> do
+      let definesString = makeDefinesString defines
+      handle <- gameIO $ glCreateShader (toGLShaderType shaderType)
+      gameIO $ withCStringLen code $ \(codeCString, codeLen) ->
+        withCStringLen definesString $ \(definesCString, definesLen) ->
+          withCStringLen header $ \(headerCString, headerLen) ->
+            withArray [headerCString, definesCString, codeCString] $ \strPtrs ->
+              withArray (fromIntegral <$> [headerLen, definesLen, codeLen] :: [GLint])
+                $ \lengths ->
+                  glShaderSource handle 3 strPtrs lengths
+      err <- gameIO $ do
+        glCompileShader handle
+        alloca $ \statusPtr -> do
+          glGetShaderiv handle GL_COMPILE_STATUS statusPtr
+          result <- peek statusPtr
+          case result of
+            0 -> alloca $ \lenPtr -> do
+              glGetShaderiv handle GL_INFO_LOG_LENGTH lenPtr
+              len <- peek lenPtr
+              case len of
+                0 -> return $ Just ""
+                _ -> withCString (replicate (fromIntegral len) '\0') $ \logPtr -> do
+                  glGetShaderInfoLog handle len nullPtr logPtr
+                  Just <$> peekCString logPtr
+            _ -> return Nothing
+      case err of
+        Nothing -> do
+          resourceKey <- register $ deleteShader' handle
+          let shader = Shader handle resourceKey shaderType shaderHash
+          saveGameState $ state {
+            shaders = HashMap.insert shaderHash shader (shaders state)
+          }
+          return shader
+        Just err -> gameError $
+          "Failed to compile shader: [" ++ show source ++ "]: " ++ err
+
+compileShaderProgram :: [Shader] -> Game RenderCoreState ShaderProgram
+compileShaderProgram shaders = do
+  state <- getGameState
+  let programHash = hashShaders shaders
+  case HashMap.lookup programHash (shaderPrograms state) of
+    Just program -> return program
+    Nothing -> do
+      handle <- gameIO glCreateProgram
+      case handle of
+        0 -> gameError "Failed to create shader program"
+        _ -> do
+          mapM_ (gameIO . glAttachShader handle) (shaderHandle <$> shaders)
+          err <- gameIO $ do
+            glLinkProgram handle
+            alloca $ \statusPtr -> do
+              glGetProgramiv handle GL_LINK_STATUS statusPtr
+              status <- peek statusPtr
+              case status of
+                0 -> alloca $ \lenPtr -> do
+                  glGetShaderiv handle GL_INFO_LOG_LENGTH lenPtr
+                  len <- peek lenPtr
+                  case len of
+                    0 -> return $ Just "Unknown error"
+                    _ -> withCString (replicate (fromIntegral len) '\0') $ \logPtr -> do
+                      glGetShaderInfoLog handle len nullPtr logPtr
+                      Just <$> peekCString logPtr
+                _ -> return Nothing
+          case err of
+            Nothing -> do
+              resourceKey <- register $ deleteShaderProgram' handle
+              uniforms <- gameIO $ newIORef []
+              let program = ShaderProgram handle resourceKey programHash uniforms
+              saveGameState $ state {
+                shaderPrograms = HashMap.insert programHash program (shaderPrograms state)
+              }
+              return program
+            Just err -> gameError $
+              "Failed to compile shader program: " ++ err ++ "; shaders: " ++
+                intercalate ", " (show . shaderHandle <$> shaders)
+
+deleteShader :: Shader -> Game RenderCoreState ()
+deleteShader shader = do
+  modifyGameState (\state -> state {
+    shaders = HashMap.delete (shaderHash shader) (shaders state) })
+  release shader
+
+deleteShaderProgram :: ShaderProgram -> Game RenderCoreState ()
+deleteShaderProgram program = do
+  modifyGameState (\state -> state {
+    shaderPrograms = HashMap.delete (shaderProgramHash program) (shaderPrograms state)})
+  release program
+
+activateShaderProgram :: ShaderProgram -> IO ()
+activateShaderProgram program = do
+  glUseProgram . shaderProgramHandle $ program
+  applyUniforms program
+
+deactivateShaderProgram :: ShaderProgram -> IO ()
+deactivateShaderProgram _ = glUseProgram 0
+
+setUniform :: ShaderUniform -> ShaderProgram -> IO ()
+setUniform uniform program =
+  modifyIORef (shaderProgramUniforms program) (setUniform' . removeUniform)
+    where removeUniform = deleteBy matchesUniform uniform
+          matchesUniform uniform u = uniformName u == uniformName uniform
+          setUniform' = (:) uniform
+
+applyUniforms :: ShaderProgram -> IO ()
+applyUniforms program =
+  let update (FloatUniform name value) =
+          glGetUniformLocation' handle name >>=
+            \location -> glUniform1f (fromIntegral location) value
+      update (Vec3Uniform name (Vector3 x y z)) =
+        glGetUniformLocation' handle name >>=
+          \location -> glUniform3f (fromIntegral location) x y z
+      update (Vec4Uniform name (Vector4 x y z w)) =
+        glGetUniformLocation' handle name >>=
+          \location -> glUniform4f (fromIntegral location) x y z w
+      update (Mat4Uniform name mat4) =
+        glGetUniformLocation' handle name >>=
+          \location -> with mat4 $ \ptrMat4 ->
+            glUniformMatrix4fv location 1 GL_FALSE (unsafeCoerce ptrMat4)
+      update (Mat4ArrayUniform name mat4s) =
+        glGetUniformLocation' handle name >>=
+          \location -> withArray mat4s $ \ptrMat4s ->
+            glUniformMatrix4fv location (fromIntegral $ length mat4s) GL_FALSE (unsafeCoerce ptrMat4s)
+      handle = shaderProgramHandle program
+  in do
+    uniforms <- readIORef (shaderProgramUniforms program)
+    mapM_ update uniforms
+    writeIORef (shaderProgramUniforms program) []
+
+-- Private
+
+glGetUniformLocation' :: GLuint -> String -> IO GLint
+glGetUniformLocation' handle name =
+  withCString name $ \nameCStr ->
+    glGetUniformLocation (fromIntegral handle) (unsafeCoerce nameCStr)
+
+deleteShader' :: GLuint -> IO ()
+deleteShader' = glDeleteShader
+
+deleteShaderProgram' :: GLuint -> IO ()
+deleteShaderProgram' = glDeleteProgram
+
+hashShaders :: [Shader] -> Int
+hashShaders = foldl' hashF 0
+  where hashF hash shader = (hash `shiftL` 32) .|. fromIntegral (shaderHandle shader)
+
+toGLShaderType :: ShaderType -> GLenum
+toGLShaderType VertexShader   = GL_VERTEX_SHADER
+toGLShaderType FragmentShader = GL_FRAGMENT_SHADER
+toGLShaderType ComputeShader  = GL_COMPUTE_SHADER
+
+makeDefinesString :: [Define] -> String
+makeDefinesString defines = intercalate "\n" body ++ "\n"
+  where body = (\(name, value) -> "#define " ++ name ++ " " ++ value) <$> defines
+
+-- Header prepended to all shaders.
+header = "#version 400 core\n"
diff --git a/Spear/Render/Core/State.hs b/Spear/Render/Core/State.hs
new file mode 100644
index 0000000..34b0732
--- /dev/null
+++ b/Spear/Render/Core/State.hs
@@ -0,0 +1,157 @@
+module Spear.Render.Core.State where
+
+import           Spear.Game
+import           Spear.Math.Matrix4
+import           Spear.Math.Vector
+
+import           Data.HashMap       as HashMap
+import           Data.IORef
+import           Data.Word
+import           Graphics.GL.Core46
+
+
+
+data BufferType
+  = BufferUntyped
+  | Buffer2d
+  | Buffer3d
+  | Buffer4d
+  | BufferFloat
+  | BufferU8
+  | BufferU16
+
+data BufferUsage
+  = BufferStatic
+  | BufferDynamic
+
+-- | A data buffer (e.g., vertex attributes, indices).
+data Buffer = Buffer
+  { bufferHandle   :: GLuint
+  , bufferResource :: Resource
+  , bufferType     :: BufferType
+  , bufferUsage    :: BufferUsage
+  }
+
+-- | A buffer view.
+data BufferView a = BufferView
+  { bufferViewBuffer      :: Buffer
+  , bufferViewOffsetBytes :: GLuint
+  , bufferViewSizeBytes   :: GLuint
+  , bufferViewStrideBytes :: GLsizei
+  }
+
+
+data Positions
+  = Positions2d (BufferView Vector2)
+  | Positions3d (BufferView Vector3)
+
+data Joints
+  = JointsU8  (BufferView Word8)
+  | JointsU16 (BufferView Word16)
+
+data Weights
+  = WeightsU8    (BufferView Word8)
+  | WeightsU16   (BufferView Word16)
+  | WeightsFloat (BufferView Float)
+
+data Indices
+  = IndicesU8  (BufferView Word8)
+  | IndicesU16 (BufferView Word16)
+
+data PrimitiveType
+  = Triangles
+  | TriangleFan
+  | TriangleStrip
+
+-- | A geometry descriptor.
+data GeometryDesc = GeometryDesc
+  { positions     :: Maybe Positions -- Convenient for the empty descriptor.
+  , normals       :: Maybe (BufferView Vector3)
+  , tangents      :: Maybe (BufferView Vector4)
+  , texcoords     :: Maybe (BufferView Vector4)
+  , joints        :: Maybe Joints
+  , weights       :: Maybe Weights
+  , indices       :: Maybe Indices
+  , numVerts      :: GLsizei
+  , numIndices    :: GLsizei
+  , primitiveType :: PrimitiveType
+  }
+
+-- | A piece of renderable geometry.
+--
+-- Since dynamic geometry can be mutated, the descriptor is stored as an IORef
+-- so that its state cannot become stale after an update.
+data Geometry = Geometry
+  { geometryVao      :: GLuint
+  , geometryResource :: Resource
+  , geometryDesc     :: IORef GeometryDesc
+  }
+
+
+-- | A shader.
+data Shader = Shader
+  { shaderHandle   :: GLuint
+  , shaderResource :: Resource
+  , shaderType     :: ShaderType
+  , shaderHash     :: Int
+  }
+
+data ShaderType
+  = VertexShader
+  | FragmentShader
+  | ComputeShader
+  deriving (Eq, Show)
+
+-- | A shader uniform.
+data ShaderUniform
+  = FloatUniform     { uniformName :: String, uniformFloat :: Float }
+  | Vec3Uniform      { uniformName :: String, uniformVec3  :: Vector3 }
+  | Vec4Uniform      { uniformName :: String, uniformVec4  :: Vector4 }
+  | Mat4Uniform      { uniformName :: String, uniformMat4  :: Matrix4 }
+  | Mat4ArrayUniform { uniformName :: String, uniformMat4s :: [Matrix4] }
+
+-- | A shader program.
+data ShaderProgram = ShaderProgram
+  { shaderProgramHandle   :: GLuint
+  , shaderProgramResource :: Resource
+  , shaderProgramHash     :: Int
+  -- Dirty set of uniforms that have been set since the last time uniforms were
+  -- applied. OpenGL retains the values of uniforms for a program until the
+  -- program is linked again, so we only need to store the updates here.
+  , shaderProgramUniforms :: IORef [ShaderUniform]
+  }
+
+
+-- | Core render state.
+data RenderCoreState = RenderCoreState
+  { buffers        :: Map GLuint Buffer
+  , geometries     :: Map GLuint Geometry
+  , shaders        :: Map ShaderHash Shader
+  , shaderPrograms :: Map ShaderProgramHash ShaderProgram
+  }
+
+type ShaderHash = Int
+type ShaderProgramHash = Int
+
+
+
+instance ResourceClass Buffer where
+  getResource = bufferResource
+
+instance ResourceClass Geometry where
+  getResource = geometryResource
+
+instance ResourceClass Shader where
+  getResource = shaderResource
+
+instance ResourceClass ShaderProgram where
+  getResource = shaderProgramResource
+
+
+newRenderCoreState :: RenderCoreState
+newRenderCoreState = RenderCoreState
+  { buffers        = HashMap.empty
+  , geometries     = HashMap.empty
+  , shaders        = HashMap.empty
+  , shaderPrograms = HashMap.empty
+  }
diff --git a/Spear/Render/Immediate.hs b/Spear/Render/Immediate.hs
new file mode 100644
index 0000000..ca5d5c5
--- /dev/null
+++ b/Spear/Render/Immediate.hs
@@ -0,0 +1,166 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Spear.Render.Immediate
+(
+  ImmRenderState
+, newImmRenderer
+, deleteImmRenderer
+, immStart
+, immEnd
+, immDrawTriangles
+, immDrawQuads
+, immDrawTriangles2d
+, immDrawQuads2d
+, immLoadIdentity
+, immTranslate
+, immPushMatrix
+, immPopMatrix
+, immPreservingMatrix
+, immSetColour
+, immSetModelMatrix
+, immSetViewProjectionMatrix
+)
+where
+
+
+import           Spear.Game
+import           Spear.Math.Algebra
+import           Spear.Math.Matrix4         as Matrix4
+import           Spear.Math.Vector
+import           Spear.Prelude
+import           Spear.Render.Core.Buffer
+import           Spear.Render.Core.Geometry
+import           Spear.Render.Core.Shader
+import           Spear.Render.Core.State    hiding (shaders)
+
+import           Control.Monad              (unless)
+import           Data.List                  (foldl')
+
+
+data ImmRenderState = ImmRenderState
+  { shaders     :: [Shader]
+  , shader      :: ShaderProgram
+  , triangles   :: Geometry
+  , matrixStack :: [Matrix4] -- Pre-multiplied matrices. Never empty.
+  }
+
+
+newImmRenderer :: Game RenderCoreState ImmRenderState
+newImmRenderer = do
+  -- TODO: Move shaders to Spear project.
+  vs <- compileShader $ ShaderDesc VertexShader
+    (ShaderFromFile "/home/jeanne/src/gfx/gfx/shaders/immediate_mode.vert") []
+  ps <- compileShader $ ShaderDesc FragmentShader
+    (ShaderFromFile "/home/jeanne/src/gfx/gfx/shaders/immediate_mode.frag") []
+  shader <- compileShaderProgram [vs, ps]
+
+  -- TODO: Make 'makeGeometry' easier to use. GeometryDesc should be able to
+  -- take (possibly empty) lists as inputs.
+  positions <- makeBufferAndView $
+    BufferDesc BufferDynamic Buffer3d BufferUninitialized
+  triangles <- makeGeometry $ newGeometryDesc
+    { positions     = Just (Positions3d positions)
+    , primitiveType = Triangles
+    }
+
+  return ImmRenderState
+    { shaders     = [vs, ps]
+    , shader      = shader
+    , triangles   = triangles
+    , matrixStack = [Matrix4.id]
+    }
+
+deleteImmRenderer :: ImmRenderState -> Game RenderCoreState ()
+deleteImmRenderer immState = do
+  deleteShaderProgram (shader immState)
+  mapM_ deleteShader (shaders immState)
+  deleteGeometry (triangles immState)
+
+-- The functions below are all defined inside the Game ImmRenderState monad so
+-- that all of the drawing can conveniently happen inside the monad.
+
+immStart :: Game ImmRenderState ()
+immStart = do
+  state <- getGameState
+  gameIO $ activateShaderProgram (shader state)
+
+immEnd :: Game ImmRenderState ()
+immEnd = do
+  state <- getGameState
+  gameIO $ deactivateShaderProgram (shader state)
+
+immDrawTriangles :: [Vector3] -> Game ImmRenderState ()
+immDrawTriangles vertices = do
+  unless (null vertices) $ do
+    loadMatrixStack
+    state <- getGameState
+    gameIO $ do
+      setPositions (triangles state) vertices
+      applyUniforms (shader state)
+      renderGeometry (triangles state)
+
+-- TODO: use triangle strips for quads. Will need a separate Geometry.
+immDrawQuads :: [(Vector3, Vector3, Vector3, Vector3)] -> Game ImmRenderState ()
+immDrawQuads quads = immDrawTriangles triangles
+  where
+    triangles = concatMap toTriangles quads
+    toTriangles (p0, p1, p2, p3) = [p0, p1, p2, p0, p2, p3]
+
+immDrawTriangles2d :: [Vector2] -> Game ImmRenderState ()
+immDrawTriangles2d = immDrawTriangles . (<$>) to3d
+
+immDrawQuads2d :: [(Vector2, Vector2, Vector2, Vector2)] -> Game ImmRenderState ()
+immDrawQuads2d =
+  immDrawQuads . (<$>) (\(p0, p1, p2, p3) -> (to3d p0, to3d p1, to3d p2, to3d p3))
+
+immLoadIdentity :: Game ImmRenderState ()
+immLoadIdentity = modifyGameState $ \state -> state {
+  matrixStack = [Matrix4.id] }
+
+immTranslate :: Vector3 -> Game ImmRenderState ()
+immTranslate vector = modifyGameState $ pushMatrix (Matrix4.translatev vector)
+
+immPushMatrix :: Matrix4 -> Game ImmRenderState ()
+immPushMatrix matrix = modifyGameState $ pushMatrix matrix
+
+immPopMatrix :: Game ImmRenderState ()
+immPopMatrix = modifyGameState $ \state -> state {
+  matrixStack = case matrixStack state of
+    [x]  -> [x] -- Always keep the identity matrix on the stack.
+    x:xs -> xs }
+
+immPreservingMatrix :: Game ImmRenderState a -> Game ImmRenderState a
+immPreservingMatrix f = do
+  originalStack <- matrixStack <$> getGameState
+  result <- f
+  modifyGameState $ \state -> state { matrixStack = originalStack }
+  return result
+
+immSetColour :: Vector4 -> Game ImmRenderState ()
+immSetColour colour = do
+  state <- getGameState
+  gameIO $ setUniform (Vec4Uniform "Colour" colour) (shader state)
+
+immSetModelMatrix :: Matrix4 -> Game ImmRenderState ()
+immSetModelMatrix model = do
+  state <- getGameState
+  gameIO $ setUniform (Mat4Uniform "Model" model) (shader state)
+
+immSetViewProjectionMatrix :: Matrix4 -> Game ImmRenderState ()
+immSetViewProjectionMatrix viewProjection = do
+  state <- getGameState
+  gameIO $ setUniform (Mat4Uniform "ViewProjection" viewProjection) (shader state)
+
+-- Private
+
+pushMatrix :: Matrix4 -> ImmRenderState -> ImmRenderState
+pushMatrix matrix state = state {
+  matrixStack = matrix * head (matrixStack state) : matrixStack state }
+
+loadMatrixStack :: Game ImmRenderState ()
+loadMatrixStack = do
+  state <- getGameState
+  immSetModelMatrix (head $ matrixStack state)
+
+to3d :: Vector2 -> Vector3
+to3d (Vector2 x y) = vec3 x y 0
diff --git a/Spear/Render/StaticModel.hs b/Spear/Render/StaticModel.hs
index 327e8b0..f4cddf8 100644
--- a/Spear/Render/StaticModel.hs
+++ b/Spear/Render/StaticModel.hs
@@ -99,8 +99,8 @@ staticModelResource (StaticProgramChannels vertChan normChan texChan) material t
 
   rkey <- register $ do
     putStrLn "Releasing static model resource"
-    clean vao
-    clean elementBuf
+    release' vao
+    release' elementBuf
 
   return $
     StaticModelResource
diff --git a/Spear/Scene/Loader.hs b/Spear/Scene/Loader.hs
index 668a495..3cd89f3 100644
--- a/Spear/Scene/Loader.hs
+++ b/Spear/Scene/Loader.hs
@@ -185,12 +185,12 @@ loadModel' file rotation scale = do
 rotateModel :: Rotation -> Model -> Model
 rotateModel (Rotation ax ay az order) model =
   let mat = case order of
-        XYZ -> rotZ az * rotY ay * rotX ax
-        XZY -> rotY ay * rotZ az * rotX ax
-        YXZ -> rotZ az * rotX ax * rotY ay
-        YZX -> rotX ax * rotZ az * rotY ay
-        ZXY -> rotY ay * rotX ax * rotZ az
-        ZYX -> rotX ax * rotY ay * rotZ az
+        XYZ -> rotateZ az * rotateY ay * rotateX ax
+        XZY -> rotateY ay * rotateZ az * rotateX ax
+        YXZ -> rotateZ az * rotateX ax * rotateY ay
+        YZX -> rotateX ax * rotateZ az * rotateY ay
+        ZXY -> rotateY ay * rotateX ax * rotateZ az
+        ZYX -> rotateX ax * rotateY ay * rotateZ az
       normalMat = fastNormalMatrix mat
 
       vTransform (Vec3 x' y' z') =
diff --git a/Spear/Window.hs b/Spear/Window.hs
index cbb9121..3cdc5f5 100644
--- a/Spear/Window.hs
+++ b/Spear/Window.hs
@@ -1,7 +1,6 @@
 module Spear.Window
   ( -- * Setup
     Dimensions,
-    Context,
     WindowTitle,
 
     -- * Window
@@ -31,13 +30,18 @@ module Spear.Window
   )
 where
 
+import           Spear.Game
+
 import           Control.Concurrent.MVar
 import           Control.Exception
 import           Control.Monad           (foldM, unless, void, when)
 import           Data.Functor            ((<&>))
 import           Data.Maybe              (fromJust, fromMaybe, isJust)
 import qualified Graphics.UI.GLFW        as GLFW
-import           Spear.Game
+
+
+-- OpenGL major and minor versions
+(major, minor) = (4, 4)
 
 type Width = Int
 
@@ -46,14 +50,14 @@ type Height = Int
 -- | Window dimensions.
 type Dimensions = (Width, Height)
 
--- | A pair specifying the desired OpenGL context, of the form (Major, Minor).
-type Context = (Int, Int)
-
 type WindowTitle = String
 
 -- | Game initialiser.
 type Init s = Window -> Game () s
 
+-- | Game finalizer.
+type End s = Game s ()
+
 -- | Window exception.
 newtype WindowException = WindowException String deriving (Show)
 
@@ -78,22 +82,23 @@ data Window = Window
   , windowEventsMVar :: MVar [WindowEvent]
   }
 
+
 withWindow ::
   Dimensions ->
-  Context ->
   Maybe WindowTitle ->
   Init s ->
+  End s ->
   (Window -> Game s a) ->
   IO a
-withWindow dim@(w, h) glVersion windowTitle init run = do
-  flip runGame' () $ do
+withWindow dim@(w, h) windowTitle init end run = do
+  flip evalGame () $ do
     window <- gameIO $ do
       success <- GLFW.init
       unless success $ throw (WindowException "GLFW.initialize failed")
-      setup dim glVersion windowTitle
-    gameIO $ GLFW.makeContextCurrent (Just . glfwWindow $ window)
+      setup dim windowTitle
     gameState <- init window
-    result <- evalSubGame (run window) gameState
+    (result, endGameState) <- runSubGame (run window) gameState
+    runSubGame' end endGameState
     gameIO $ do
       GLFW.destroyWindow $ glfwWindow window
       GLFW.terminate
@@ -101,10 +106,9 @@ withWindow dim@(w, h) glVersion windowTitle init run = do
 
 setup ::
   Dimensions ->
-  Context ->
   Maybe WindowTitle ->
   IO Window
-setup (w, h) (major, minor) windowTitle = do
+setup (w, h) windowTitle = do
   closeRequest <- newEmptyMVar
   windowEvents <- newEmptyMVar
   inputEvents  <- newEmptyMVar
@@ -113,12 +117,16 @@ setup (w, h) (major, minor) windowTitle = do
   maybeWindow <- do
     GLFW.windowHint $ GLFW.WindowHint'ContextVersionMajor major
     GLFW.windowHint $ GLFW.WindowHint'ContextVersionMinor minor
-    when (major >= 3) $ GLFW.windowHint $ GLFW.WindowHint'OpenGLProfile GLFW.OpenGLProfile'Compat
+    when (major >= 3) $ GLFW.windowHint $ GLFW.WindowHint'OpenGLProfile GLFW.OpenGLProfile'Core
     GLFW.createWindow w h (fromMaybe "Spear" windowTitle) Nothing Nothing
 
-  unless (isJust maybeWindow) $ throwIO (WindowException "GLFW.openWindow failed")
+  unless (isJust maybeWindow)
+    $ throwIO (WindowException "GLFW.openWindow failed")
+
   let window = fromJust maybeWindow
 
+  GLFW.makeContextCurrent maybeWindow
+
   GLFW.setWindowCloseCallback window . Just $ onWindowClose closeRequest
   GLFW.setWindowSizeCallback  window . Just $ onResize      windowEvents
   GLFW.setKeyCallback         window . Just $ onKey         inputEvents
-- 
cgit v1.2.3