1 files changed, 729 insertions, 720 deletions
diff --git a/Spear/GL.hs b/Spear/GL.hs
index b5b4dfb..f5cfe4e 100644
--- a/Spear/GL.hs
+++ b/Spear/GL.hs
@@ -1,720 +1,729 @@
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
-module Spear.GL
+module Spear.GL
-(
+(
-    -- * Programs
+    -- * Programs
-    GLSLProgram
+    GLSLProgram
-,   newProgram
+,   newProgram
-,   linkProgram
+,   linkProgram
-,   useProgram
+,   useProgram
-,   unuseProgram
+,   unuseProgram
-,   withGLSLProgram
+,   withGLSLProgram
-    -- ** Locations
+    -- ** Locations
-,   attribLocation
+,   attribLocation
-,   fragLocation
+,   fragLocation
-,   uniformLocation
+,   uniformLocation
-    -- ** Uniforms
+    -- ** Uniforms
-,   Uniform(..)
+,   Uniform(..)
-    -- * Shaders
+    -- * Shaders
-,   GLSLShader
+,   GLSLShader
-,   ShaderType(..)
+,   ShaderType(..)
-,   attachShader
+,   attachShader
-,   detachShader
+,   detachShader
-,   loadShader
+,   loadShader
-,   newShader
+,   newShader
-    -- ** Source loading
+    -- ** Source loading
-,   loadSource
+,   loadSource
-,   shaderSource
+,   shaderSource
-,   readSource
+,   readSource
-,   compile
+,   compile
-    -- * Helper functions
+    -- * Helper functions
-,   ($=)
+,   ($=)
-,   Data.StateVar.get
+,   Data.StateVar.get
-    -- * VAOs
+    -- * VAOs
-,   VAO
+,   VAO
-,   newVAO
+,   newVAO
-,   bindVAO
+,   bindVAO
-,   unbindVAO
+,   unbindVAO
-,   enableVAOAttrib
+,   enableVAOAttrib
-,   attribVAOPointer
+,   attribVAOPointer
-    -- ** Rendering
+    -- ** Rendering
-,   drawArrays
+,   drawArrays
-,   drawElements
+,   drawElements
-    -- * Buffers
+    -- * Buffers
-,   GLBuffer
+,   GLBuffer
-,   TargetBuffer(..)
+,   TargetBuffer(..)
-,   BufferUsage(..)
+,   BufferUsage(..)
-,   newBuffer
+,   newBuffer
-,   bindBuffer
+,   bindBuffer
-,   unbindBuffer
+,   unbindBuffer
-,   BufferData(..)
+,   BufferData(..)
-,   bufferData'
+,   bufferData'
-,   withGLBuffer
+,   withGLBuffer
-    -- * Textures
+    -- * Textures
-,   Texture
+,   Texture
-,   SettableStateVar
+,   SettableStateVar
-,   ($)
+,   ($)
-    -- ** Creation and destruction
+    -- ** Creation and destruction
-,   newTexture
+,   newTexture
-,   loadTextureImage
+,   loadTextureImage
-    -- ** Manipulation
+    -- ** Manipulation
-,   bindTexture
+,   bindTexture
-,   unbindTexture
+,   unbindTexture
-,   loadTextureData
+,   loadTextureData
-,   texParami
+,   texParami
-,   texParamf
+,   texParamf
-,   activeTexture
+,   activeTexture
-    -- * Error Handling
+    -- * Error Handling
-,   getGLError
+,   getGLError
-,   printGLError
+,   printGLError
-,   assertGL
+,   assertGL
-    -- * OpenGL
+    -- * OpenGL
-,   module Graphics.Rendering.OpenGL.Raw.Core32
+,   module Graphics.Rendering.OpenGL.Raw.Core32
-,   Ptr
+,   Ptr
-,   nullPtr
+,   nullPtr
-)
+)
-where
+where
-import Spear.Assets.Image
+import Spear.Assets.Image
-import Spear.Game
+import Spear.Game
-import Spear.Math.Matrix3 (Matrix3)
+import Spear.Math.Matrix3 (Matrix3)
-import Spear.Math.Matrix4 (Matrix4)
+import Spear.Math.Matrix4 (Matrix4)
-import Spear.Math.Vector
+import Spear.Math.Vector
-import Control.Monad
+import Control.Monad
-import Control.Monad.Trans.Class
+import Control.Monad.Trans.Class
-import Control.Monad.Trans.Error
+import Control.Monad.Trans.Error
-import Control.Monad.Trans.State as State
+import Control.Monad.Trans.State as State
-import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString.Char8 as B
-import Data.StateVar
+import Data.StateVar
-import Data.Word
+import Data.Word
-import Foreign.C.String
+import Foreign.C.String
-import Foreign.C.Types
+import Foreign.C.Types
-import Foreign.Ptr
+import Foreign.Ptr
-import Foreign.Storable
+import Foreign.Storable
-import Foreign.Marshal.Utils as Foreign (with)
+import Foreign.Marshal.Utils as Foreign (with)
-import Foreign.Marshal.Alloc (alloca)
+import Foreign.Marshal.Alloc (alloca)
-import Foreign.Marshal.Array (withArray)
+import Foreign.Marshal.Array (withArray)
-import Foreign.Storable (peek)
+import Foreign.Storable (peek)
-import Graphics.Rendering.OpenGL.Raw.Core32
+import Graphics.Rendering.OpenGL.Raw.Core32
-import System.Directory (doesFileExist, getCurrentDirectory, setCurrentDirectory)
+import System.Directory (doesFileExist, getCurrentDirectory, setCurrentDirectory)
-import System.IO (hPutStrLn, stderr)
+import System.IO (hPutStrLn, stderr)
-import Unsafe.Coerce
+import Unsafe.Coerce
--
+--
-- MANAGEMENT
+-- MANAGEMENT
--
+--
-- | A GLSL shader handle.
+-- | A GLSL shader handle.
-data GLSLShader  = GLSLShader
+data GLSLShader  = GLSLShader
-    { getShader    :: GLuint
+    { getShader    :: GLuint
-    , getShaderKey :: Resource
+    , getShaderKey :: Resource
-    }
+    }
-instance ResourceClass GLSLShader where
+instance ResourceClass GLSLShader where
-         getResource = getShaderKey
+         getResource = getShaderKey
-- | A GLSL program handle.
+-- | A GLSL program handle.
-data GLSLProgram = GLSLProgram
+data GLSLProgram = GLSLProgram
-    { getProgram    :: GLuint
+    { getProgram    :: GLuint
-    , getProgramKey :: Resource
+    , getProgramKey :: Resource
-    }
+    }
-instance ResourceClass GLSLProgram where
+instance ResourceClass GLSLProgram where
-         getResource = getProgramKey
+         getResource = getProgramKey
-- | Supported shader types.
+-- | Supported shader types.
-data ShaderType = VertexShader | FragmentShader | GeometryShader deriving (Eq, Show)
+data ShaderType = VertexShader | FragmentShader | GeometryShader deriving (Eq, Show)
-toGLShader :: ShaderType -> GLenum
+toGLShader :: ShaderType -> GLenum
-toGLShader VertexShader   = gl_VERTEX_SHADER
+toGLShader VertexShader   = gl_VERTEX_SHADER
-toGLShader FragmentShader = gl_FRAGMENT_SHADER
+toGLShader FragmentShader = gl_FRAGMENT_SHADER
-toGLShader GeometryShader = gl_GEOMETRY_SHADER
+toGLShader GeometryShader = gl_GEOMETRY_SHADER
-- | Apply the given function to the program's id.
+-- | Apply the given function to the program's id.
-withGLSLProgram :: GLSLProgram -> (GLuint -> a) -> a
+withGLSLProgram :: GLSLProgram -> (GLuint -> a) -> a
-withGLSLProgram prog f = f $ getProgram prog
+withGLSLProgram prog f = f $ getProgram prog
-- | Get the location of the given uniform variable within the given program.
+-- | Get the location of the given uniform variable within the given program.
-uniformLocation :: GLSLProgram -> String -> GettableStateVar GLint
+uniformLocation :: GLSLProgram -> String -> GettableStateVar GLint
-uniformLocation prog var = makeGettableStateVar $
+uniformLocation prog var = makeGettableStateVar $
-    withCString var $ \str -> glGetUniformLocation (getProgram prog) (unsafeCoerce str)
+    withCString var $ \str -> glGetUniformLocation (getProgram prog) (unsafeCoerce str)
-- | Get or set the location of the given variable to a fragment shader colour number.
+-- | Get or set the location of the given variable to a fragment shader colour number.
-fragLocation :: GLSLProgram -> String -> StateVar GLint
+fragLocation :: GLSLProgram -> String -> StateVar GLint
-fragLocation prog var = makeStateVar get set
+fragLocation prog var = makeStateVar get set
-    where
+    where
-        get     = withCString var $ \str -> glGetFragDataLocation (getProgram prog) (unsafeCoerce str)
+        get     = withCString var $ \str -> glGetFragDataLocation (getProgram prog) (unsafeCoerce str)
-        set idx = withCString var $ \str ->
+        set idx = withCString var $ \str ->
-            glBindFragDataLocation (getProgram prog) (unsafeCoerce idx) (unsafeCoerce str)
+            glBindFragDataLocation (getProgram prog) (unsafeCoerce idx) (unsafeCoerce str)
-- | Get or set the location of the given attribute within the given program.
+-- | Get or set the location of the given attribute within the given program.
-attribLocation :: GLSLProgram -> String -> StateVar GLint
+attribLocation :: GLSLProgram -> String -> StateVar GLint
-attribLocation prog var = makeStateVar get set
+attribLocation prog var = makeStateVar get set
-    where
+    where
-        get     = withCString var $ \str -> glGetAttribLocation  (getProgram prog) (unsafeCoerce str)
+        get     = withCString var $ \str -> glGetAttribLocation  (getProgram prog) (unsafeCoerce str)
-        set idx = withCString var $ \str ->
+        set idx = withCString var $ \str ->
-            glBindAttribLocation (getProgram prog) (unsafeCoerce idx) (unsafeCoerce str)
+            glBindAttribLocation (getProgram prog) (unsafeCoerce idx) (unsafeCoerce str)
-- | Create a new program.
+-- | Create a new program.
-newProgram :: [GLSLShader] -> Game s GLSLProgram
+newProgram :: [GLSLShader] -> Game s GLSLProgram
-newProgram shaders = do
+newProgram shaders = do
-    h <- gameIO glCreateProgram
+    h <- gameIO glCreateProgram
-    when (h == 0) $ gameError "glCreateProgram failed"
+    when (h == 0) $ gameError "glCreateProgram failed"
-    rkey <- register $ deleteProgram h
+    rkey <- register $ deleteProgram h
-    let program = GLSLProgram h rkey
+    let program = GLSLProgram h rkey
-    mapM_ (gameIO . attachShader program) shaders
+    mapM_ (gameIO . attachShader program) shaders
-    linkProgram program
+    linkProgram program
-    return program
+    return program
--  Delete the program.
+--  Delete the program.
-deleteProgram :: GLuint -> IO ()
+deleteProgram :: GLuint -> IO ()
--deleteProgram = glDeleteProgram
+--deleteProgram = glDeleteProgram
-deleteProgram prog = do
+deleteProgram prog = do
-    putStrLn $ "Deleting shader program " ++ show prog
+    putStrLn $ "Deleting shader program " ++ show prog
-    glDeleteProgram prog
+    glDeleteProgram prog
-- | Link the program.
+-- | Link the program.
-linkProgram :: GLSLProgram -> Game s ()
+linkProgram :: GLSLProgram -> Game s ()
-linkProgram prog = do
+linkProgram prog = do
-    let h = getProgram prog
+    let h = getProgram prog
-    err <- gameIO $ do
+    err <- gameIO $ do
-        glLinkProgram h
+        glLinkProgram h
-        alloca $ \statptr -> do
+        alloca $ \statptr -> do
-            glGetProgramiv h gl_LINK_STATUS statptr
+            glGetProgramiv h gl_LINK_STATUS statptr
-            status <- peek statptr
+            status <- peek statptr
-            case status of
+            case status of
-                0 -> getStatus glGetProgramiv glGetProgramInfoLog h
+                0 -> getStatus glGetProgramiv glGetProgramInfoLog h
-                _ -> return ""
+                _ -> return ""
-    case length err of
+    case length err of
-        0 -> return ()
+        0 -> return ()
-        _ -> gameError err
+        _ -> gameError err
-- | Use the program.
+-- | Use the program.
-useProgram :: GLSLProgram -> IO ()
+useProgram :: GLSLProgram -> IO ()
-useProgram prog = glUseProgram $ getProgram prog
+useProgram prog = glUseProgram $ getProgram prog
-- | Deactivate the active program.
+-- | Deactivate the active program.
-unuseProgram :: IO ()
+unuseProgram :: IO ()
-unuseProgram = glUseProgram 0
+unuseProgram = glUseProgram 0
-- | Attach the given shader to the given program.
+-- | Attach the given shader to the given program.
-attachShader :: GLSLProgram -> GLSLShader -> IO ()
+attachShader :: GLSLProgram -> GLSLShader -> IO ()
-attachShader prog shader = glAttachShader (getProgram prog) (getShader shader)
+attachShader prog shader = glAttachShader (getProgram prog) (getShader shader)
-- | Detach the given GLSL from the given program.
+-- | Detach the given GLSL from the given program.
-detachShader :: GLSLProgram -> GLSLShader -> IO ()
+detachShader :: GLSLProgram -> GLSLShader -> IO ()
-detachShader prog shader = glDetachShader (getProgram prog) (getShader shader)
+detachShader prog shader = glDetachShader (getProgram prog) (getShader shader)
-- | Load a shader from the file specified by the given string.
+-- | 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,
+-- This function creates a new shader. To load source code into an existing shader,
-- see 'loadSource', 'shaderSource' and 'readSource'.
+-- see 'loadSource', 'shaderSource' and 'readSource'.
-loadShader :: ShaderType -> FilePath -> Game s GLSLShader
+loadShader :: ShaderType -> FilePath -> Game s GLSLShader
-loadShader shaderType file = do
+loadShader shaderType file = do
-    shader <- newShader shaderType
+    shader <- newShader shaderType
-    loadSource file shader
+    loadSource file shader
-    compile file shader
+    compile file shader
-    return shader
+    return shader
-- | Create a new shader.
+-- | Create a new shader.
-newShader :: ShaderType -> Game s GLSLShader
+newShader :: ShaderType -> Game s GLSLShader
-newShader shaderType = do
+newShader shaderType = do
-    h <- gameIO $ glCreateShader (toGLShader shaderType)
+    h <- gameIO $ glCreateShader (toGLShader shaderType)
-    case h of
+    case h of
-        0 -> gameError "glCreateShader failed"
+        0 -> gameError "glCreateShader failed"
-        _ -> do
+        _ -> do
-            rkey <- register $ deleteShader h
+            rkey <- register $ deleteShader h
-            return $ GLSLShader h rkey
+            return $ GLSLShader h rkey
-- | Free the shader.
+-- | Free the shader.
-deleteShader :: GLuint -> IO ()
+deleteShader :: GLuint -> IO ()
--deleteShader = glDeleteShader
+--deleteShader = glDeleteShader
-deleteShader shader = do
+deleteShader shader = do
-    putStrLn $ "Deleting shader " ++ show shader
+    putStrLn $ "Deleting shader " ++ show shader
-    glDeleteShader shader
+    glDeleteShader shader
-- | Load a shader source from the file specified by the given string
+-- | Load a shader source from the file specified by the given string
-- into the shader.
+-- into the shader.
-loadSource :: FilePath -> GLSLShader -> Game s ()
+loadSource :: FilePath -> GLSLShader -> Game s ()
-loadSource file h = do
+loadSource file h = do
-    exists <- gameIO $ doesFileExist file
+    exists <- gameIO $ doesFileExist file
-    case exists of
+    case exists of
-        False -> gameError "the specified shader file does not exist"
+        False -> gameError "the specified shader file does not exist"
-        True  -> gameIO $ do
+        True  -> gameIO $ do
-            code <- readSource file
+            code <- readSource file
-            withCString code $ shaderSource h
+            withCString code $ shaderSource h
-- | Load the given shader source into the shader.
+-- | Load the given shader source into the shader.
-shaderSource :: GLSLShader -> CString -> IO ()
+shaderSource :: GLSLShader -> CString -> IO ()
-shaderSource shader str =
+shaderSource shader str =
-    let ptr = unsafeCoerce str
+    let ptr = unsafeCoerce str
-    in  withArray [ptr] $ flip (glShaderSource (getShader shader) 1) nullPtr
+    in  withArray [ptr] $ flip (glShaderSource (getShader shader) 1) nullPtr
-- | Compile the shader.
+-- | Compile the shader.
-compile :: FilePath -> GLSLShader -> Game s ()
+compile :: FilePath -> GLSLShader -> Game s ()
-compile file shader = do
+compile file shader = do
-    let h = getShader shader
+    let h = getShader shader
-    -- Compile
+    -- Compile
-    gameIO $ glCompileShader h
+    gameIO $ glCompileShader h
-    -- Verify status
+    -- Verify status
-    err <- gameIO $ alloca $ \statusPtr -> do
+    err <- gameIO $ alloca $ \statusPtr -> do
-        glGetShaderiv h gl_COMPILE_STATUS statusPtr
+        glGetShaderiv h gl_COMPILE_STATUS statusPtr
-        result <- peek statusPtr
+        result <- peek statusPtr
-        case result of
+        case result of
-            0 -> getStatus glGetShaderiv glGetShaderInfoLog h
+            0 -> getStatus glGetShaderiv glGetShaderInfoLog h
-            _ -> return ""
+            _ -> return ""
-    case length err of
+    case length err of
-        0 -> return ()
+        0 -> return ()
-        _ -> gameError $ "Unable to compile shader " ++ file ++ ":\n" ++ err
+        _ -> gameError $ "Unable to compile shader " ++ file ++ ":\n" ++ err
-type StatusCall = GLuint -> GLenum -> Ptr GLint -> IO ()
+type StatusCall = GLuint -> GLenum -> Ptr GLint -> IO ()
-type LogCall    = GLuint -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ()
+type LogCall    = GLuint -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO ()
-getStatus :: StatusCall -> LogCall -> GLuint -> IO String
+getStatus :: StatusCall -> LogCall -> GLuint -> IO String
-getStatus getStatus getLog h = do
+getStatus getStatus getLog h = do
-    alloca $ \lenPtr -> do
+    alloca $ \lenPtr -> do
-        getStatus h gl_INFO_LOG_LENGTH lenPtr
+        getStatus h gl_INFO_LOG_LENGTH lenPtr
-        len <- peek lenPtr
+        len <- peek lenPtr
-        case len of
+        case len of
-            0 -> return ""
+            0 -> return ""
-            _ -> withCString (replicate (unsafeCoerce len) '\0') $ getErrorString getLog h (unsafeCoerce len)
+            _ -> withCString (replicate (unsafeCoerce len) '\0') $ getErrorString getLog h (unsafeCoerce len)
-getErrorString :: LogCall -> GLuint -> GLsizei -> CString -> IO String
+getErrorString :: LogCall -> GLuint -> GLsizei -> CString -> IO String
-getErrorString getLog h len str = do
+getErrorString getLog h len str = do
-    let ptr = unsafeCoerce str
+    let ptr = unsafeCoerce str
-    getLog h len nullPtr ptr
+    getLog h len nullPtr ptr
-    peekCString str
+    peekCString str
-- | Load the shader source specified by the given file.
+-- | Load the shader source specified by the given file.
--
+--
-- This function implements an #include mechanism, so the given file can
+-- This function implements an #include mechanism, so the given file can
-- refer to other files.
+-- refer to other files.
-readSource :: FilePath -> IO String
+readSource :: FilePath -> IO String
-readSource = fmap B.unpack . readSource'
+readSource = fmap B.unpack . readSource'
-readSource' :: FilePath -> IO B.ByteString
+readSource' :: FilePath -> IO B.ByteString
-readSource' file = do
+readSource' file = do
-    let includeB      = B.pack "#include"
+    let includeB      = B.pack "#include"
-        newLineB      = B.pack "\n"
+        newLineB      = B.pack "\n"
-        isInclude     = ((==) includeB) . B.take 8
+        isInclude     = ((==) includeB) . B.take 8
-        clean         = B.dropWhile (\c -> c == ' ')
+        clean         = B.dropWhile (\c -> c == ' ')
-        cleanInclude  = B.filter (\c -> c /= '"') . B.dropWhile (\c -> c /= ' ')
+        cleanInclude  = B.filter (\c -> c /= '"') . B.dropWhile (\c -> c /= ' ')
-        toLines       = B.splitWith (\c -> c == '\n' || c == '\r')
+        toLines       = B.splitWith (\c -> c == '\n' || c == '\r')
-        addNewLine s  = if (B.last s /= '\n') then B.append s newLineB else s
+        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 .
+        parse         = fmap B.concat . (fmap . fmap $ flip B.append newLineB) . sequence .
-                        fmap (processLine . clean) . toLines
+                        fmap (processLine . clean) . toLines
-        processLine l =
+        processLine l =
-            if isInclude l
+            if isInclude l
-            then readSource' $ B.unpack . clean . cleanInclude $ l
+            then readSource' $ B.unpack . clean . cleanInclude $ l
-            else return l
+            else return l
-    contents <- B.readFile file
+    contents <- B.readFile file
-    dir <- getCurrentDirectory
+    dir <- getCurrentDirectory
-    let dir' = dir ++ "/" ++ (reverse . dropWhile (\c -> c /= '/') . reverse) file
+    let dir' = dir ++ "/" ++ (reverse . dropWhile (\c -> c /= '/') . reverse) file
-    setCurrentDirectory dir'
+    setCurrentDirectory dir'
-    code <- parse contents
+    code <- parse contents
-    setCurrentDirectory dir
+    setCurrentDirectory dir
-    return code
+    return code
-class Uniform a where
+class Uniform a where
-      -- | Load a list of uniform values.
+      -- | Load a list of uniform values.
-      uniform :: GLint -> a -> IO ()
+      uniform :: GLint -> a -> IO ()
-instance Uniform Int where uniform loc a = glUniform1i loc (fromIntegral a)
+instance Uniform Int where uniform loc a = glUniform1i loc (fromIntegral a)
-instance Uniform Float where uniform loc a = glUniform1f loc (unsafeCoerce a)
+instance Uniform Float where uniform loc a = glUniform1f loc (unsafeCoerce a)
+instance Uniform CFloat where uniform loc a = glUniform1f loc a
-instance Uniform (Int,Int) where
-         uniform loc (x,y) = glUniform2i loc (fromIntegral x) (fromIntegral y)
+instance Uniform (Int,Int) where
+         uniform loc (x,y) = glUniform2i loc (fromIntegral x) (fromIntegral y)
-instance Uniform (Float,Float) where
-         uniform loc (x,y) = glUniform2f loc (unsafeCoerce x) (unsafeCoerce y)
+instance Uniform (Float,Float) where
+         uniform loc (x,y) = glUniform2f loc (unsafeCoerce x) (unsafeCoerce y)
-instance Uniform (Int,Int,Int) where
-         uniform loc (x,y,z) = glUniform3i loc (fromIntegral x) (fromIntegral y) (fromIntegral z)
+instance Uniform (Int,Int,Int) where
+         uniform loc (x,y,z) = glUniform3i loc (fromIntegral x) (fromIntegral y) (fromIntegral z)
-instance Uniform (Float,Float,Float) where
-         uniform loc (x,y,z) = glUniform3f loc (unsafeCoerce x) (unsafeCoerce y) (unsafeCoerce z)
+instance Uniform (Float,Float,Float) where
+         uniform loc (x,y,z) = glUniform3f loc (unsafeCoerce x) (unsafeCoerce y) (unsafeCoerce z)
-instance Uniform (Int,Int,Int,Int) where
-         uniform loc (x,y,z,w) = glUniform4i loc
+instance Uniform (Int,Int,Int,Int) where
-                 (fromIntegral x) (fromIntegral y) (fromIntegral z) (fromIntegral w)
+         uniform loc (x,y,z,w) = glUniform4i loc
+                 (fromIntegral x) (fromIntegral y) (fromIntegral z) (fromIntegral w)
-instance Uniform (Float,Float,Float,Float) where
-         uniform loc (x,y,z,w) = glUniform4f loc
+instance Uniform (Float,Float,Float,Float) where
-                 (unsafeCoerce x) (unsafeCoerce y) (unsafeCoerce z) (unsafeCoerce w)
+         uniform loc (x,y,z,w) = glUniform4f loc
+                 (unsafeCoerce x) (unsafeCoerce y) (unsafeCoerce z) (unsafeCoerce w)
-instance Uniform Vector2 where
-         uniform loc v = glUniform2f loc x' y'
+instance Uniform Vector2 where
-                 where x' = unsafeCoerce $ x v
+         uniform loc v = glUniform2f loc x' y'
-                       y' = unsafeCoerce $ y v
+                 where x' = unsafeCoerce $ x v
+                       y' = unsafeCoerce $ y v
-instance Uniform Vector3 where
-         uniform loc v = glUniform3f loc x' y' z'
+instance Uniform Vector3 where
-                 where x' = unsafeCoerce $ x v
+         uniform loc v = glUniform3f loc x' y' z'
-                       y' = unsafeCoerce $ y v
+                 where x' = unsafeCoerce $ x v
-                       z' = unsafeCoerce $ z v
+                       y' = unsafeCoerce $ y v
+                       z' = unsafeCoerce $ z v
-instance Uniform Vector4 where
-         uniform loc v = glUniform4f loc x' y' z' w'
+instance Uniform Vector4 where
-                 where x' = unsafeCoerce $ x v
+         uniform loc v = glUniform4f loc x' y' z' w'
-                       y' = unsafeCoerce $ y v
+                 where x' = unsafeCoerce $ x v
-                       z' = unsafeCoerce $ z v
+                       y' = unsafeCoerce $ y v
-                       w' = unsafeCoerce $ w v
+                       z' = unsafeCoerce $ z v
+                       w' = unsafeCoerce $ w v
-instance Uniform Matrix3 where
-         uniform loc mat =
+instance Uniform Matrix3 where
-                 with mat $ \ptrMat ->
+         uniform loc mat =
-                 glUniformMatrix3fv loc 1 (toEnum 0) (unsafeCoerce ptrMat)
+                 with mat $ \ptrMat ->
+                 glUniformMatrix3fv loc 1 (toEnum 0) (unsafeCoerce ptrMat)
-instance Uniform Matrix4 where
-         uniform loc mat =
+instance Uniform Matrix4 where
-                 with mat $ \ptrMat ->
+         uniform loc mat =
-                 glUniformMatrix4fv loc 1 (toEnum 0) (unsafeCoerce ptrMat)
+                 with mat $ \ptrMat ->
+                 glUniformMatrix4fv loc 1 (toEnum 0) (unsafeCoerce ptrMat)
-instance Uniform [Float] where
-         uniform loc vals = withArray (map unsafeCoerce vals) $ \ptr ->
+instance Uniform [Float] where
-                   case length vals of
+         uniform loc vals = withArray (map unsafeCoerce vals) $ \ptr ->
-                        1 -> glUniform1fv loc 1 ptr
+                 case length vals of
-                        2 -> glUniform2fv loc 1 ptr
+                      1 -> glUniform1fv loc 1 ptr
-                        3 -> glUniform3fv loc 1 ptr
+                      2 -> glUniform2fv loc 1 ptr
-                        4 -> glUniform4fv loc 1 ptr
+                      3 -> glUniform3fv loc 1 ptr
+                      4 -> glUniform4fv loc 1 ptr
-instance Uniform [Int] where
-         uniform loc vals = withArray (map fromIntegral vals) $ \ptr ->
+instance Uniform [CFloat] where
-                  case length vals of
+         uniform loc vals = withArray vals $ \ptr ->
-                       1 -> glUniform1iv loc 1 ptr
+                 case length vals of
-                       2 -> glUniform2iv loc 1 ptr
+                      1 -> glUniform1fv loc 1 ptr
-                       3 -> glUniform3iv loc 1 ptr
+                      2 -> glUniform2fv loc 1 ptr
-                       4 -> glUniform4iv loc 1 ptr
+                      3 -> glUniform3fv loc 1 ptr
+                      4 -> glUniform4fv loc 1 ptr
--
-- VAOs
+instance Uniform [Int] where
--
+         uniform loc vals = withArray (map fromIntegral vals) $ \ptr ->
+                 case length vals of
-- | A vertex array object.
+                      1 -> glUniform1iv loc 1 ptr
-data VAO = VAO
+                      2 -> glUniform2iv loc 1 ptr
-    { getVAO :: GLuint
+                      3 -> glUniform3iv loc 1 ptr
-    , vaoKey :: Resource
+                      4 -> glUniform4iv loc 1 ptr
-    }
+--
-instance ResourceClass VAO where
+-- VAOs
-         getResource = vaoKey
+--
-instance Eq VAO where
+-- | A vertex array object.
-    vao1 == vao2 = getVAO vao1 == getVAO vao2
+data VAO = VAO
+    { getVAO :: GLuint
-instance Ord VAO where
+    , vaoKey :: Resource
-    vao1 < vao2 = getVAO vao1 < getVAO vao2
+    }
-- | Create a new vao.
+instance ResourceClass VAO where
-newVAO :: Game s VAO
+         getResource = vaoKey
-newVAO = do
-    h <- gameIO . alloca $ \ptr -> do
+instance Eq VAO where
-        glGenVertexArrays 1 ptr
+    vao1 == vao2 = getVAO vao1 == getVAO vao2
-        peek ptr
+instance Ord VAO where
-    rkey <- register $ deleteVAO h
+    vao1 < vao2 = getVAO vao1 < getVAO vao2
-    return $ VAO h rkey
+-- | Create a new vao.
-- | Delete the vao.
+newVAO :: Game s VAO
-deleteVAO :: GLuint -> IO ()
+newVAO = do
-deleteVAO vao = Foreign.with vao $ glDeleteVertexArrays 1
+    h <- gameIO . alloca $ \ptr -> do
+        glGenVertexArrays 1 ptr
-- | Bind the vao.
+        peek ptr
-bindVAO :: VAO -> IO ()
-bindVAO = glBindVertexArray . getVAO
+    rkey <- register $ deleteVAO h
+    return $ VAO h rkey
-- | Unbind the bound vao.
-unbindVAO :: IO ()
+-- | Delete the vao.
-unbindVAO = glBindVertexArray 0
+deleteVAO :: GLuint -> IO ()
+deleteVAO vao = Foreign.with vao $ glDeleteVertexArrays 1
-- | Enable the given vertex attribute of the bound vao.
--
+-- | Bind the vao.
-- See also 'bindVAO'.
+bindVAO :: VAO -> IO ()
-enableVAOAttrib :: GLuint -- ^ Attribute index.
+bindVAO = glBindVertexArray . getVAO
-                -> IO ()
-enableVAOAttrib = glEnableVertexAttribArray
+-- | Unbind the bound vao.
+unbindVAO :: IO ()
-- | Bind the bound buffer to the given point.
+unbindVAO = glBindVertexArray 0
-attribVAOPointer
-    :: GLuint  -- ^ The index of the generic vertex attribute to be modified.
+-- | Enable the given vertex attribute of the bound vao.
-    -> GLint   -- ^ The number of components per generic vertex attribute. Must be 1,2,3,4.
+--
-    -> GLenum  -- ^ The data type of each component in the array.
+-- See also 'bindVAO'.
-    -> Bool    -- ^ Whether fixed-point data values should be normalized.
+enableVAOAttrib :: GLuint -- ^ Attribute index.
-    -> GLsizei -- ^ Stride. Byte offset between consecutive generic vertex attributes.
+                -> IO ()
-    -> Int     -- ^ Offset to the first component in the array.
+enableVAOAttrib = glEnableVertexAttribArray
-    -> IO ()
-attribVAOPointer idx ncomp dattype normalise stride off =
+-- | Bind the bound buffer to the given point.
-    glVertexAttribPointer idx ncomp dattype normalise' stride (unsafeCoerce off)
+attribVAOPointer
-                          where normalise' = if normalise then 1 else 0
+    :: GLuint  -- ^ The index of the generic vertex attribute to be modified.
+    -> GLint   -- ^ The number of components per generic vertex attribute. Must be 1,2,3,4.
-- | Draw the bound vao.
+    -> GLenum  -- ^ The data type of each component in the array.
-drawArrays
+    -> Bool    -- ^ Whether fixed-point data values should be normalized.
-    :: GLenum -- ^ The kind of primitives to render.
+    -> GLsizei -- ^ Stride. Byte offset between consecutive generic vertex attributes.
-    -> Int    -- ^ Starting index in the enabled arrays.
+    -> Int     -- ^ Offset to the first component in the array.
-    -> Int    -- ^ The number of indices to be rendered.
+    -> IO ()
-    -> IO ()
+attribVAOPointer idx ncomp dattype normalise stride off =
-drawArrays mode first count = glDrawArrays mode (unsafeCoerce first) (unsafeCoerce count)
+    glVertexAttribPointer idx ncomp dattype normalise' stride (unsafeCoerce off)
+                          where normalise' = if normalise then 1 else 0
-- | Draw the bound vao, indexed mode.
-drawElements
+-- | Draw the bound vao.
-    :: GLenum -- ^ The kind of primitives to render.
+drawArrays
-    -> Int    -- ^ The number of elements to be rendered.
+    :: GLenum -- ^ The kind of primitives to render.
-    -> GLenum -- ^ The type of the index values. Must be one of gl_UNSIGNED_BYTE, gl_UNSIGNED_SHORT, or gl_UNSIGNED_INT.
+    -> Int    -- ^ Starting index in the enabled arrays.
-    -> Ptr a  -- ^ Pointer to the location where indices are stored, or offset into the index array when there is a bound ElementArrayBuffer.
+    -> Int    -- ^ The number of indices to be rendered.
-    -> IO ()
+    -> IO ()
-drawElements mode count t idxs = glDrawElements mode (unsafeCoerce count) t idxs
+drawArrays mode first count = glDrawArrays mode (unsafeCoerce first) (unsafeCoerce count)
--
+-- | Draw the bound vao, indexed mode.
-- BUFFER
+drawElements
--
+    :: GLenum -- ^ The kind of primitives to render.
+    -> Int    -- ^ The number of elements to be rendered.
-- | An OpenGL buffer.
+    -> GLenum -- ^ The type of the index values. Must be one of gl_UNSIGNED_BYTE, gl_UNSIGNED_SHORT, or gl_UNSIGNED_INT.
-data GLBuffer = GLBuffer
+    -> Ptr a  -- ^ Pointer to the location where indices are stored, or offset into the index array when there is a bound ElementArrayBuffer.
-    { getBuffer :: GLuint
+    -> IO ()
-    , rkey      :: Resource
+drawElements mode count t idxs = glDrawElements mode (unsafeCoerce count) t idxs
-    }
+--
-instance ResourceClass GLBuffer where
+-- BUFFER
-         getResource = rkey
+--
-- | The type of target buffer.
+-- | An OpenGL buffer.
-data TargetBuffer
+data GLBuffer = GLBuffer
-    = ArrayBuffer
+    { getBuffer :: GLuint
-    | ElementArrayBuffer
+    , rkey      :: Resource
-    | PixelPackBuffer
+    }
-    | PixelUnpackBuffer
-    deriving (Eq, Show)
+instance ResourceClass GLBuffer where
+         getResource = rkey
-fromTarget :: TargetBuffer -> GLenum
-fromTarget ArrayBuffer        = gl_ARRAY_BUFFER
+-- | The type of target buffer.
-fromTarget ElementArrayBuffer = gl_ELEMENT_ARRAY_BUFFER
+data TargetBuffer
-fromTarget PixelPackBuffer    = gl_PIXEL_PACK_BUFFER
+    = ArrayBuffer
-fromTarget PixelUnpackBuffer  = gl_PIXEL_UNPACK_BUFFER
+    | ElementArrayBuffer
+    | PixelPackBuffer
-- | A buffer usage.
+    | PixelUnpackBuffer
-data BufferUsage
+    deriving (Eq, Show)
-    = StreamDraw
-    | StreamRead
+fromTarget :: TargetBuffer -> GLenum
-    | StreamCopy
+fromTarget ArrayBuffer        = gl_ARRAY_BUFFER
-    | StaticDraw
+fromTarget ElementArrayBuffer = gl_ELEMENT_ARRAY_BUFFER
-    | StaticRead
+fromTarget PixelPackBuffer    = gl_PIXEL_PACK_BUFFER
-    | StaticCopy
+fromTarget PixelUnpackBuffer  = gl_PIXEL_UNPACK_BUFFER
-    | DynamicDraw
-    | DynamicRead
+-- | A buffer usage.
-    | DynamicCopy
+data BufferUsage
-    deriving (Eq, Show)
+    = StreamDraw
+    | StreamRead
-fromUsage :: BufferUsage -> GLenum
+    | StreamCopy
-fromUsage StreamDraw  = gl_STREAM_DRAW
+    | StaticDraw
-fromUsage StreamRead  = gl_STREAM_READ
+    | StaticRead
-fromUsage StreamCopy  = gl_STREAM_COPY
+    | StaticCopy
-fromUsage StaticDraw  = gl_STATIC_DRAW
+    | DynamicDraw
-fromUsage StaticRead  = gl_STATIC_READ
+    | DynamicRead
-fromUsage StaticCopy  = gl_STATIC_COPY
+    | DynamicCopy
-fromUsage DynamicDraw = gl_DYNAMIC_DRAW
+    deriving (Eq, Show)
-fromUsage DynamicRead = gl_DYNAMIC_READ
-fromUsage DynamicCopy = gl_DYNAMIC_COPY
+fromUsage :: BufferUsage -> GLenum
+fromUsage StreamDraw  = gl_STREAM_DRAW
-- | Create a new buffer.
+fromUsage StreamRead  = gl_STREAM_READ
-newBuffer :: Game s GLBuffer
+fromUsage StreamCopy  = gl_STREAM_COPY
-newBuffer = do
+fromUsage StaticDraw  = gl_STATIC_DRAW
-    h <- gameIO . alloca $ \ptr -> do
+fromUsage StaticRead  = gl_STATIC_READ
-        glGenBuffers 1 ptr
+fromUsage StaticCopy  = gl_STATIC_COPY
-        peek ptr
+fromUsage DynamicDraw = gl_DYNAMIC_DRAW
+fromUsage DynamicRead = gl_DYNAMIC_READ
-    rkey <- register $ deleteBuffer h
+fromUsage DynamicCopy = gl_DYNAMIC_COPY
-    return $ GLBuffer h rkey
+-- | Create a new buffer.
-- | Delete the buffer.
+newBuffer :: Game s GLBuffer
-deleteBuffer :: GLuint -> IO ()
+newBuffer = do
-deleteBuffer buf = Foreign.with buf $ glDeleteBuffers 1
+    h <- gameIO . alloca $ \ptr -> do
+        glGenBuffers 1 ptr
-- | Bind the buffer.
+        peek ptr
-bindBuffer :: GLBuffer -> TargetBuffer -> IO ()
-bindBuffer buf target = glBindBuffer (fromTarget target) $ getBuffer buf
+    rkey <- register $ deleteBuffer h
+    return $ GLBuffer h rkey
-- | Unbind the bound buffer.
-unbindBuffer :: TargetBuffer -> IO ()
+-- | Delete the buffer.
-unbindBuffer target = glBindBuffer (fromTarget target) 0
+deleteBuffer :: GLuint -> IO ()
+deleteBuffer buf = Foreign.with buf $ glDeleteBuffers 1
-class Storable a => BufferData a where
-      -- | Set the buffer's data.
+-- | Bind the buffer.
-      bufferData :: TargetBuffer -> [a] -> BufferUsage -> IO ()
+bindBuffer :: TargetBuffer -> GLBuffer -> IO ()
-      bufferData tgt vals usage =
+bindBuffer target buf = glBindBuffer (fromTarget target) $ getBuffer buf
-                 let n = sizeOf (head vals) * length vals
-                 in withArray vals $ \ptr -> bufferData' tgt n ptr usage
+-- | Unbind the bound buffer.
+unbindBuffer :: TargetBuffer -> IO ()
-instance BufferData Word8
+unbindBuffer target = glBindBuffer (fromTarget target) 0
-instance BufferData Word16
-instance BufferData Word32
+class Storable a => BufferData a where
-instance BufferData CChar
+      -- | Set the buffer's data.
-instance BufferData CInt
+      bufferData :: TargetBuffer -> [a] -> BufferUsage -> IO ()
-instance BufferData CFloat
+      bufferData tgt vals usage =
-instance BufferData CDouble
+                 let n = sizeOf (head vals) * length vals
-instance BufferData Int
+                 in withArray vals $ \ptr -> bufferData' tgt n ptr usage
-instance BufferData Float
-instance BufferData Double
+instance BufferData Word8
+instance BufferData Word16
-{-bufferData :: Storable a
+instance BufferData Word32
-           => TargetBuffer
+instance BufferData CChar
-           -> Int -- ^ The size in bytes of an element in the data list.
+instance BufferData CInt
-           -> [a] -- ^ The data list.
+instance BufferData CFloat
-           -> BufferUsage
+instance BufferData CDouble
-           -> IO ()
+instance BufferData Int
-bufferData target n bufData usage = withArray bufData $
+instance BufferData Float
-    \ptr -> bufferData target (n * length bufData) ptr usage-}
+instance BufferData Double
-- | Set the buffer's data.
+{-bufferData :: Storable a
-bufferData' :: TargetBuffer
+           => TargetBuffer
-            -> Int -- ^ Buffer size in bytes.
+           -> Int -- ^ The size in bytes of an element in the data list.
-            -> Ptr a
+           -> [a] -- ^ The data list.
-            -> BufferUsage
+           -> BufferUsage
-            -> IO ()
+           -> IO ()
-bufferData' target n bufData usage = glBufferData (fromTarget target) (unsafeCoerce n) bufData (fromUsage usage)
+bufferData target n bufData usage = withArray bufData $
+    \ptr -> bufferData target (n * length bufData) ptr usage-}
-- | Apply the given function the buffer's id.
-withGLBuffer :: GLBuffer -> (GLuint -> a) -> a
+-- | Set the buffer's data.
-withGLBuffer buf f = f $ getBuffer buf
+bufferData' :: TargetBuffer
+            -> Int -- ^ Buffer size in bytes.
--
+            -> Ptr a
-- TEXTURE
+            -> BufferUsage
--
+            -> IO ()
+bufferData' target n bufData usage = glBufferData (fromTarget target) (unsafeCoerce n) bufData (fromUsage usage)
-- | Represents a texture resource.
-data Texture = Texture
+-- | Apply the given function the buffer's id.
-    { getTex :: GLuint
+withGLBuffer :: GLBuffer -> (GLuint -> a) -> a
-    , texKey :: Resource
+withGLBuffer buf f = f $ getBuffer buf
-    }
+--
-instance Eq Texture where
+-- TEXTURE
-    t1 == t2 = getTex t1 == getTex t2
+--
-instance Ord Texture where
+-- | Represents a texture resource.
-    t1 < t2 = getTex t1 < getTex t2
+data Texture = Texture
+    { getTex :: GLuint
-instance ResourceClass Texture where
+    , texKey :: Resource
-         getResource = texKey
+    }
-- | Create a new texture.
+instance Eq Texture where
-newTexture :: Game s Texture
+    t1 == t2 = getTex t1 == getTex t2
-newTexture = do
-    tex <- gameIO . alloca $ \ptr -> do
+instance Ord Texture where
-        glGenTextures 1 ptr
+    t1 < t2 = getTex t1 < getTex t2
-        peek ptr
+instance ResourceClass Texture where
-    rkey <- register $ deleteTexture tex
+         getResource = texKey
-    return $ Texture tex rkey
+-- | Create a new texture.
-- | Delete the texture.
+newTexture :: Game s Texture
-deleteTexture :: GLuint -> IO ()
+newTexture = do
--deleteTexture tex = with tex $ glDeleteTextures 1
+    tex <- gameIO . alloca $ \ptr -> do
-deleteTexture tex = do
+        glGenTextures 1 ptr
-    putStrLn $ "Releasing texture " ++ show tex
+        peek ptr
-    with tex $ glDeleteTextures 1
+    rkey <- register $ deleteTexture tex
-- | Load the 'Texture' specified by the given file.
+    return $ Texture tex rkey
-loadTextureImage :: FilePath
-                 -> GLenum          -- ^ Texture's min filter.
+-- | Delete the texture.
-                 -> GLenum          -- ^ Texture's mag filter.
+deleteTexture :: GLuint -> IO ()
-                 -> Game s Texture
+--deleteTexture tex = with tex $ glDeleteTextures 1
-loadTextureImage file minFilter magFilter = do
+deleteTexture tex = do
-    image <- loadImage file
+    putStrLn $ "Releasing texture " ++ show tex
-    tex   <- newTexture
+    with tex $ glDeleteTextures 1
-    gameIO $ do
-        let w    = width  image
+-- | Load the 'Texture' specified by the given file.
-            h    = height image
+loadTextureImage :: FilePath
-            pix  = pixels image
+                 -> GLenum          -- ^ Texture's min filter.
-            rgb  = fromIntegral . fromEnum $ gl_RGB
+                 -> GLenum          -- ^ Texture's mag filter.
+                 -> Game s Texture
-        bindTexture tex
+loadTextureImage file minFilter magFilter = do
-        loadTextureData gl_TEXTURE_2D 0 rgb w h 0 gl_RGB gl_UNSIGNED_BYTE pix
+    image <- loadImage file
-        texParami gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER $= minFilter
+    tex   <- newTexture
-        texParami gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER $= magFilter
+    gameIO $ do
+        let w    = width  image
-    return tex
+            h    = height image
+            pix  = pixels image
-- | Bind the texture.
+            rgb  = fromIntegral . fromEnum $ gl_RGB
-bindTexture :: Texture -> IO ()
-bindTexture = glBindTexture gl_TEXTURE_2D . getTex
+        bindTexture tex
+        loadTextureData gl_TEXTURE_2D 0 rgb w h 0 gl_RGB gl_UNSIGNED_BYTE pix
-- | Unbind the bound texture.
+        texParami gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER $= minFilter
-unbindTexture :: IO ()
+        texParami gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER $= magFilter
-unbindTexture = glBindTexture gl_TEXTURE_2D 0
+    return tex
-- | Load data onto the bound texture.
--
+-- | Bind the texture.
-- See also 'bindTexture'.
+bindTexture :: Texture -> IO ()
-loadTextureData :: GLenum
+bindTexture = glBindTexture gl_TEXTURE_2D . getTex
-                -> Int -- ^ Target
-                -> Int -- ^ Level
+-- | Unbind the bound texture.
-                -> Int -- ^ Internal format
+unbindTexture :: IO ()
-                -> Int -- ^ Width
+unbindTexture = glBindTexture gl_TEXTURE_2D 0
-                -> Int -- ^ Height
-                -> GLenum -- ^ Border
+-- | Load data onto the bound texture.
-                -> GLenum -- ^ Texture type
+--
-                -> Ptr a -- ^ Texture data
+-- See also 'bindTexture'.
-                -> IO ()
+loadTextureData :: GLenum
-loadTextureData target level internalFormat width height border format texType texData = do
+                -> Int -- ^ Target
-    glTexImage2D target
+                -> Int -- ^ Level
-                 (fromIntegral level)
+                -> Int -- ^ Internal format
-                 (fromIntegral internalFormat)
+                -> Int -- ^ Width
-                 (fromIntegral width)
+                -> Int -- ^ Height
-                 (fromIntegral height)
+                -> GLenum -- ^ Border
-                 (fromIntegral border)
+                -> GLenum -- ^ Texture type
-                 (fromIntegral format)
+                -> Ptr a -- ^ Texture data
-                 texType
+                -> IO ()
-                 texData
+loadTextureData target level internalFormat width height border format texType texData = do
+    glTexImage2D target
-- | Set the bound texture's parameter to the given value.
+                 (fromIntegral level)
-texParami :: GLenum -> GLenum -> SettableStateVar GLenum
+                 (fromIntegral internalFormat)
-texParami target param = makeSettableStateVar $ \val -> glTexParameteri target param $ fromIntegral . fromEnum $ val
+                 (fromIntegral width)
+                 (fromIntegral height)
-- | Set the bound texture's parameter to the given value.
+                 (fromIntegral border)
-texParamf :: GLenum -> GLenum -> SettableStateVar Float
+                 (fromIntegral format)
-texParamf target param = makeSettableStateVar $ \val -> glTexParameterf target param (unsafeCoerce val)
+                 texType
+                 texData
-- | Set the active texture unit.
-activeTexture :: SettableStateVar GLenum
+-- | Set the bound texture's parameter to the given value.
-activeTexture = makeSettableStateVar glActiveTexture
+texParami :: GLenum -> GLenum -> SettableStateVar GLenum
+texParami target param = makeSettableStateVar $ \val -> glTexParameteri target param $ fromIntegral . fromEnum $ val
--
-- ERROR
+-- | Set the bound texture's parameter to the given value.
--
+texParamf :: GLenum -> GLenum -> SettableStateVar Float
+texParamf target param = makeSettableStateVar $ \val -> glTexParameterf target param (unsafeCoerce val)
-- | Get the last OpenGL error.
-getGLError :: IO (Maybe String)
+-- | Set the active texture unit.
-getGLError = fmap translate glGetError
+activeTexture :: SettableStateVar GLenum
-    where
+activeTexture = makeSettableStateVar glActiveTexture
-        translate err
-            | err == gl_NO_ERROR          = Nothing
+--
-            | err == gl_INVALID_ENUM      = Just "Invalid enum"
+-- ERROR
-            | err == gl_INVALID_VALUE     = Just "Invalid value"
+--
-            | err == gl_INVALID_OPERATION = Just "Invalid operation"
-            | err == gl_OUT_OF_MEMORY     = Just "Out of memory"
+-- | Get the last OpenGL error.
-            | otherwise                   = Just "Unknown error"
+getGLError :: IO (Maybe String)
+getGLError = fmap translate glGetError
-- | Print the last OpenGL error.
+    where
-printGLError :: IO ()
+        translate err
-printGLError = getGLError >>= \err -> case err of
+            | err == gl_NO_ERROR          = Nothing
-    Nothing  -> return ()
+            | err == gl_INVALID_ENUM      = Just "Invalid enum"
-    Just str -> hPutStrLn stderr str
+            | err == gl_INVALID_VALUE     = Just "Invalid value"
+            | err == gl_INVALID_OPERATION = Just "Invalid operation"
-- | Run the given setup action and check for OpenGL errors.
+            | err == gl_OUT_OF_MEMORY     = Just "Out of memory"
--
+            | otherwise                   = Just "Unknown error"
-- If an OpenGL error is produced, an exception is thrown containing
-- the given string appended to the string describing the error.
+-- | Print the last OpenGL error.
-assertGL :: Game s a -> String -> Game s a
+printGLError :: IO ()
-assertGL action err = do
+printGLError = getGLError >>= \err -> case err of
-    result <- action
+    Nothing  -> return ()
-    status <- gameIO getGLError
+    Just str -> hPutStrLn stderr str
-    case status of
-        Just str -> gameError $ "OpenGL error raised: " ++ err ++ "; " ++ str
+-- | Run the given setup action and check for OpenGL errors.
-        Nothing  -> return result
+--
+-- If an OpenGL error is produced, an exception is thrown containing
+-- the given string appended to the string describing the error.
+assertGL :: Game s a -> String -> Game s a
+assertGL action err = do
+    result <- action
+    status <- gameIO getGLError
+    case status of
+        Just str -> gameError $ "OpenGL error raised: " ++ err ++ "; " ++ str
+        Nothing  -> return result