From 591e64b7d8c6e858a038a8bc37121dea00c6164e Mon Sep 17 00:00:00 2001 From: Jeanne-Kamikaze 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