From 591e64b7d8c6e858a038a8bc37121dea00c6164e Mon Sep 17 00:00:00 2001
From: Jeanne-Kamikaze <jeannekamikaze@gmail.com>
Date: Tue, 12 Mar 2013 16:28:16 +0100
Subject: Prettified uniform
---
Spear/GL.hs | 104 ++++++++++++++++++++++++------------------
Spear/Render/AnimatedModel.hs | 6 +--
Spear/Render/StaticModel.hs | 6 +--
Spear/Scene/GameObject.hs | 40 ++++++++--------
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
--
cgit v1.2.3