Prettified uniform

4 files changed, 85 insertions, 71 deletions

diff --git a/Spear/GL.hs b/Spear/GL.hs
index aa3e930..6792d35 100644
--- a/Spear/GL.hs
+++ b/Spear/GL.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleInstances #-}
 module Spear.GL
 (
     -- * Programs
@@ -12,12 +13,7 @@ module Spear.GL
 ,   fragLocation
 ,   uniformLocation
     -- ** Uniforms
-,   uniformVec2
-,   uniformVec3
-,   uniformVec4
-,   uniformMat3
-,   uniformMat4
-,   LoadUniforms(..)
+,   Uniform(..)
     -- * Shaders
 ,   GLSLShader
 ,   ShaderType(..)
@@ -327,53 +323,71 @@ readSource' file = do
 
     return code
 
--- | Load a 2D vector.
-uniformVec2 :: GLint -> Vector2 -> IO ()
-uniformVec2 loc v = glUniform2f loc x' y'
-    where x' = unsafeCoerce $ x v
-          y' = unsafeCoerce $ y v
-
--- | Load a 3D vector.
-uniformVec3 :: GLint -> Vector3 -> IO ()
-uniformVec3 loc v = glUniform3f loc x' y' z'
-    where x' = unsafeCoerce $ x v
-          y' = unsafeCoerce $ y v
-          z' = unsafeCoerce $ z v
-
--- | Load a 4D vector.
-uniformVec4 :: GLint -> Vector4 -> IO ()
-uniformVec4 loc v = glUniform4f loc x' y' z' w'
-    where x' = unsafeCoerce $ x v
-          y' = unsafeCoerce $ y v
-          z' = unsafeCoerce $ z v
-          w' = unsafeCoerce $ w v
-
--- | Load a 3x3 matrix.
-uniformMat3 :: GLint -> Matrix3 -> IO ()
-uniformMat3 loc mat =
-    with mat $ \ptrMat ->
-        glUniformMatrix3fv loc 1 (toEnum 0) (unsafeCoerce ptrMat)
-
--- | Load a 4x4 matrix.
-uniformMat4 :: GLint -> Matrix4 -> IO ()
-uniformMat4 loc mat =
-    with mat $ \ptrMat ->
-        glUniformMatrix4fv loc 1 (toEnum 0) (unsafeCoerce ptrMat)
-
-class LoadUniforms a where
+class Uniform a where
       -- | Load a list of uniform values.
-      uniforml :: GLint -> [a] -> IO ()
+      uniform :: GLint -> a -> IO ()
 
-instance LoadUniforms Float where
-         uniforml loc vals = withArray (map unsafeCoerce vals) $ \ptr ->
+instance Uniform Int where uniform loc a = glUniform1i loc (fromIntegral a)
+instance Uniform Float where uniform loc a = glUniform1f loc (unsafeCoerce a)
+
+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 (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 (Int,Int,Int,Int) where
+         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
+                 (unsafeCoerce x) (unsafeCoerce y) (unsafeCoerce z) (unsafeCoerce w)
+
+instance Uniform Vector2 where
+         uniform loc v = glUniform2f loc x' y'
+                 where x' = unsafeCoerce $ x v
+                       y' = unsafeCoerce $ y v
+
+instance Uniform Vector3 where
+         uniform loc v = glUniform3f loc x' y' z'
+                 where x' = unsafeCoerce $ x v
+                       y' = unsafeCoerce $ y v
+                       z' = unsafeCoerce $ z v
+
+instance Uniform Vector4 where
+         uniform loc v = glUniform4f loc x' y' z' w'
+                 where x' = unsafeCoerce $ x v
+                       y' = unsafeCoerce $ y v
+                       z' = unsafeCoerce $ z v
+                       w' = unsafeCoerce $ w v
+
+instance Uniform Matrix3 where
+         uniform loc mat =
+                 with mat $ \ptrMat ->
+                 glUniformMatrix3fv loc 1 (toEnum 0) (unsafeCoerce ptrMat)
+
+instance Uniform Matrix4 where
+         uniform loc mat =
+                 with mat $ \ptrMat ->
+                 glUniformMatrix4fv loc 1 (toEnum 0) (unsafeCoerce ptrMat)
+
+instance Uniform [Float] where
+         uniform loc vals = withArray (map unsafeCoerce vals) $ \ptr ->
                    case length vals of
                         1 -> glUniform1fv loc 1 ptr
                         2 -> glUniform2fv loc 1 ptr
                         3 -> glUniform3fv loc 1 ptr
                         4 -> glUniform4fv loc 1 ptr
 
-instance LoadUniforms Int where
-         uniforml loc vals = withArray (map fromIntegral vals) $ \ptr ->
+instance Uniform [Int] where
+         uniform loc vals = withArray (map fromIntegral vals) $ \ptr ->
                   case length vals of
                        1 -> glUniform1iv loc 1 ptr
                        2 -> glUniform2iv loc 1 ptr
diff --git a/Spear/Render/AnimatedModel.hs b/Spear/Render/AnimatedModel.hs
index aa202ec..f8a5960 100644
--- a/Spear/Render/AnimatedModel.hs
+++ b/Spear/Render/AnimatedModel.hs
@@ -205,9 +205,9 @@ render uniforms (AnimatedModelRenderer model _ _ _ curFrame fp _) =
     let n = nVertices model
         (Material _ ka kd ks shi) = material model
     in do
-        uniformVec4 (kaLoc uniforms) ka
-        uniformVec4 (kdLoc uniforms) kd
-        uniformVec4 (ksLoc uniforms) ks
+        uniform (kaLoc uniforms) ka
+        uniform (kdLoc uniforms) kd
+        uniform (ksLoc uniforms) ks
         glUniform1f (shiLoc uniforms) $ unsafeCoerce shi
         glUniform1f (fpLoc uniforms) (unsafeCoerce fp)
         drawArrays gl_TRIANGLES (n*curFrame) n
diff --git a/Spear/Render/StaticModel.hs b/Spear/Render/StaticModel.hs
index 700414f..a57f8fd 100644
--- a/Spear/Render/StaticModel.hs
+++ b/Spear/Render/StaticModel.hs
@@ -124,9 +124,9 @@ render :: StaticProgramUniforms -> StaticModelRenderer -> IO ()
 render uniforms (StaticModelRenderer model) =
     let (Material _ ka kd ks shi) = material model
     in do
-        uniformVec4 (kaLoc uniforms) ka
-        uniformVec4 (kdLoc uniforms) kd
-        uniformVec4 (ksLoc uniforms) ks
+        uniform (kaLoc uniforms) ka
+        uniform (kdLoc uniforms) kd
+        uniform (ksLoc uniforms) ks
         glUniform1f (shiLoc uniforms) $ unsafeCoerce shi
         drawArrays gl_TRIANGLES 0 $ nVertices model
 
diff --git a/Spear/Scene/GameObject.hs b/Spear/Scene/GameObject.hs
index b981c00..ecbe7a1 100644
--- a/Spear/Scene/GameObject.hs
+++ b/Spear/Scene/GameObject.hs
@@ -81,12 +81,12 @@ data GameObject = GameObject
 
 
 instance S2.Spatial2 GameObject where
-    
+
     move v go = go
         { collisioners = fmap (Col.move v) $ collisioners go
         , transform  = M3.translv v * transform go
         }
-    
+
     moveFwd s go =
         let m = transform go
             v = scale s $ M3.forward m
@@ -94,7 +94,7 @@ instance S2.Spatial2 GameObject where
            { collisioners = fmap (Col.move v) $ collisioners go
            , transform = M3.translv v * m
            }
-    
+
     moveBack s go =
         let m = transform go
             v = scale (-s) $ M3.forward m
@@ -102,7 +102,7 @@ instance S2.Spatial2 GameObject where
             { collisioners = fmap (Col.move v) $ collisioners go
             , transform = M3.translv v * m
             }
-    
+
     strafeLeft s go =
         let m = transform go
             v = scale (-s) $ M3.right m
@@ -110,7 +110,7 @@ instance S2.Spatial2 GameObject where
             { collisioners = fmap (Col.move v) $ collisioners go
             , transform = M3.translv v * m
             }
-    
+
     strafeRight s go =
         let m = transform go
             v = scale s $ M3.right m
@@ -118,35 +118,35 @@ instance S2.Spatial2 GameObject where
             { collisioners = fmap (Col.move v) $ collisioners go
             , transform = M3.translv v * m
             }
-    
+
     rotate a go =
         go
         { transform = transform go * M3.rot a
         , angle = (angle go + a) `mod'` 360
         }
-    
+
     setRotation a go =
         go
         { transform = M3.translation (transform go) * M3.rot a
         , angle = a
         }
-    
+
     pos go = M3.position . transform $ go
-    
+
     fwd go = M3.forward . transform $ go
-    
+
     up go = M3.up . transform $ go
-    
+
     right go = M3.right . transform $ go
-    
+
     transform go = Spear.Scene.GameObject.transform go
-    
+
     setTransform mat go = go { transform = mat }
-    
+
     setPos pos go =
         let m = transform go
         in go { transform = M3.transform (M3.right m) (M3.forward m) pos }
-    
+
     lookAt p go =
         let position = S2.pos go
             fwd      = normalise $ p - position
@@ -213,7 +213,7 @@ goRPGtransform go =
 currentAnimation :: Enum a => GameObject -> a
 currentAnimation go = case renderer go of
     Left _ -> toEnum 0
-    Right amr -> AM.currentAnimation amr 
+    Right amr -> AM.currentAnimation amr
 
 
 -- | Return the game object's number of collisioners.
@@ -297,12 +297,12 @@ goRender' :: (ProgramUniforms u, Program p)
           -> Render
           -> IO ()
 goRender' style a axis prog uniforms modelview proj normal bindRenderer render =
-    let 
+    let
     in do
         useProgram . program $ prog
-        uniformMat4 (projLoc uniforms) proj
-        uniformMat4 (modelviewLoc uniforms) modelview
-        uniformMat3 (normalmatLoc uniforms) normal
+        uniform (projLoc uniforms) proj
+        uniform (modelviewLoc uniforms) modelview
+        uniform (normalmatLoc uniforms) normal
         bindRenderer
         render