diff options
| -rw-r--r-- | Spear/GL.hs | 104 | ||||
| -rw-r--r-- | Spear/Render/AnimatedModel.hs | 6 | ||||
| -rw-r--r-- | Spear/Render/StaticModel.hs | 6 | ||||
| -rw-r--r-- | 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 @@ | |||
| 1 | {-# LANGUAGE FlexibleInstances #-} | ||
| 1 | module Spear.GL | 2 | module Spear.GL |
| 2 | ( | 3 | ( |
| 3 | -- * Programs | 4 | -- * Programs |
| @@ -12,12 +13,7 @@ module Spear.GL | |||
| 12 | , fragLocation | 13 | , fragLocation |
| 13 | , uniformLocation | 14 | , uniformLocation |
| 14 | -- ** Uniforms | 15 | -- ** Uniforms |
| 15 | , uniformVec2 | 16 | , Uniform(..) |
| 16 | , uniformVec3 | ||
| 17 | , uniformVec4 | ||
| 18 | , uniformMat3 | ||
| 19 | , uniformMat4 | ||
| 20 | , LoadUniforms(..) | ||
| 21 | -- * Shaders | 17 | -- * Shaders |
| 22 | , GLSLShader | 18 | , GLSLShader |
| 23 | , ShaderType(..) | 19 | , ShaderType(..) |
| @@ -327,53 +323,71 @@ readSource' file = do | |||
| 327 | 323 | ||
| 328 | return code | 324 | return code |
| 329 | 325 | ||
| 330 | -- | Load a 2D vector. | 326 | class Uniform a where |
| 331 | uniformVec2 :: GLint -> Vector2 -> IO () | ||
| 332 | uniformVec2 loc v = glUniform2f loc x' y' | ||
| 333 | where x' = unsafeCoerce $ x v | ||
| 334 | y' = unsafeCoerce $ y v | ||
| 335 | |||
| 336 | -- | Load a 3D vector. | ||
| 337 | uniformVec3 :: GLint -> Vector3 -> IO () | ||
| 338 | uniformVec3 loc v = glUniform3f loc x' y' z' | ||
| 339 | where x' = unsafeCoerce $ x v | ||
| 340 | y' = unsafeCoerce $ y v | ||
| 341 | z' = unsafeCoerce $ z v | ||
| 342 | |||
| 343 | -- | Load a 4D vector. | ||
| 344 | uniformVec4 :: GLint -> Vector4 -> IO () | ||
| 345 | uniformVec4 loc v = glUniform4f loc x' y' z' w' | ||
| 346 | where x' = unsafeCoerce $ x v | ||
| 347 | y' = unsafeCoerce $ y v | ||
| 348 | z' = unsafeCoerce $ z v | ||
| 349 | w' = unsafeCoerce $ w v | ||
| 350 | |||
| 351 | -- | Load a 3x3 matrix. | ||
| 352 | uniformMat3 :: GLint -> Matrix3 -> IO () | ||
| 353 | uniformMat3 loc mat = | ||
| 354 | with mat $ \ptrMat -> | ||
| 355 | glUniformMatrix3fv loc 1 (toEnum 0) (unsafeCoerce ptrMat) | ||
| 356 | |||
| 357 | -- | Load a 4x4 matrix. | ||
| 358 | uniformMat4 :: GLint -> Matrix4 -> IO () | ||
| 359 | uniformMat4 loc mat = | ||
| 360 | with mat $ \ptrMat -> | ||
| 361 | glUniformMatrix4fv loc 1 (toEnum 0) (unsafeCoerce ptrMat) | ||
| 362 | |||
| 363 | class LoadUniforms a where | ||
| 364 | -- | Load a list of uniform values. | 327 | -- | Load a list of uniform values. |
| 365 | uniforml :: GLint -> [a] -> IO () | 328 | uniform :: GLint -> a -> IO () |
| 366 | 329 | ||
| 367 | instance LoadUniforms Float where | 330 | instance Uniform Int where uniform loc a = glUniform1i loc (fromIntegral a) |
| 368 | uniforml loc vals = withArray (map unsafeCoerce vals) $ \ptr -> | 331 | instance Uniform Float where uniform loc a = glUniform1f loc (unsafeCoerce a) |
| 332 | |||
| 333 | instance Uniform (Int,Int) where | ||
| 334 | uniform loc (x,y) = glUniform2i loc (fromIntegral x) (fromIntegral y) | ||
| 335 | |||
| 336 | instance Uniform (Float,Float) where | ||
| 337 | uniform loc (x,y) = glUniform2f loc (unsafeCoerce x) (unsafeCoerce y) | ||
| 338 | |||
| 339 | instance Uniform (Int,Int,Int) where | ||
| 340 | uniform loc (x,y,z) = glUniform3i loc (fromIntegral x) (fromIntegral y) (fromIntegral z) | ||
| 341 | |||
| 342 | instance Uniform (Float,Float,Float) where | ||
| 343 | uniform loc (x,y,z) = glUniform3f loc (unsafeCoerce x) (unsafeCoerce y) (unsafeCoerce z) | ||
| 344 | |||
| 345 | instance Uniform (Int,Int,Int,Int) where | ||
| 346 | uniform loc (x,y,z,w) = glUniform4i loc | ||
| 347 | (fromIntegral x) (fromIntegral y) (fromIntegral z) (fromIntegral w) | ||
| 348 | |||
| 349 | instance Uniform (Float,Float,Float,Float) where | ||
| 350 | uniform loc (x,y,z,w) = glUniform4f loc | ||
| 351 | (unsafeCoerce x) (unsafeCoerce y) (unsafeCoerce z) (unsafeCoerce w) | ||
| 352 | |||
| 353 | instance Uniform Vector2 where | ||
| 354 | uniform loc v = glUniform2f loc x' y' | ||
| 355 | where x' = unsafeCoerce $ x v | ||
| 356 | y' = unsafeCoerce $ y v | ||
| 357 | |||
| 358 | instance Uniform Vector3 where | ||
| 359 | uniform loc v = glUniform3f loc x' y' z' | ||
| 360 | where x' = unsafeCoerce $ x v | ||
| 361 | y' = unsafeCoerce $ y v | ||
| 362 | z' = unsafeCoerce $ z v | ||
| 363 | |||
| 364 | instance Uniform Vector4 where | ||
| 365 | uniform loc v = glUniform4f loc x' y' z' w' | ||
| 366 | where x' = unsafeCoerce $ x v | ||
| 367 | y' = unsafeCoerce $ y v | ||
| 368 | z' = unsafeCoerce $ z v | ||
| 369 | w' = unsafeCoerce $ w v | ||
| 370 | |||
| 371 | instance Uniform Matrix3 where | ||
| 372 | uniform loc mat = | ||
| 373 | with mat $ \ptrMat -> | ||
| 374 | glUniformMatrix3fv loc 1 (toEnum 0) (unsafeCoerce ptrMat) | ||
| 375 | |||
| 376 | instance Uniform Matrix4 where | ||
| 377 | uniform loc mat = | ||
| 378 | with mat $ \ptrMat -> | ||
| 379 | glUniformMatrix4fv loc 1 (toEnum 0) (unsafeCoerce ptrMat) | ||
| 380 | |||
| 381 | instance Uniform [Float] where | ||
| 382 | uniform loc vals = withArray (map unsafeCoerce vals) $ \ptr -> | ||
| 369 | case length vals of | 383 | case length vals of |
| 370 | 1 -> glUniform1fv loc 1 ptr | 384 | 1 -> glUniform1fv loc 1 ptr |
| 371 | 2 -> glUniform2fv loc 1 ptr | 385 | 2 -> glUniform2fv loc 1 ptr |
| 372 | 3 -> glUniform3fv loc 1 ptr | 386 | 3 -> glUniform3fv loc 1 ptr |
| 373 | 4 -> glUniform4fv loc 1 ptr | 387 | 4 -> glUniform4fv loc 1 ptr |
| 374 | 388 | ||
| 375 | instance LoadUniforms Int where | 389 | instance Uniform [Int] where |
| 376 | uniforml loc vals = withArray (map fromIntegral vals) $ \ptr -> | 390 | uniform loc vals = withArray (map fromIntegral vals) $ \ptr -> |
| 377 | case length vals of | 391 | case length vals of |
| 378 | 1 -> glUniform1iv loc 1 ptr | 392 | 1 -> glUniform1iv loc 1 ptr |
| 379 | 2 -> glUniform2iv loc 1 ptr | 393 | 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 _) = | |||
| 205 | let n = nVertices model | 205 | let n = nVertices model |
| 206 | (Material _ ka kd ks shi) = material model | 206 | (Material _ ka kd ks shi) = material model |
| 207 | in do | 207 | in do |
| 208 | uniformVec4 (kaLoc uniforms) ka | 208 | uniform (kaLoc uniforms) ka |
| 209 | uniformVec4 (kdLoc uniforms) kd | 209 | uniform (kdLoc uniforms) kd |
| 210 | uniformVec4 (ksLoc uniforms) ks | 210 | uniform (ksLoc uniforms) ks |
| 211 | glUniform1f (shiLoc uniforms) $ unsafeCoerce shi | 211 | glUniform1f (shiLoc uniforms) $ unsafeCoerce shi |
| 212 | glUniform1f (fpLoc uniforms) (unsafeCoerce fp) | 212 | glUniform1f (fpLoc uniforms) (unsafeCoerce fp) |
| 213 | drawArrays gl_TRIANGLES (n*curFrame) n | 213 | 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 () | |||
| 124 | render uniforms (StaticModelRenderer model) = | 124 | render uniforms (StaticModelRenderer model) = |
| 125 | let (Material _ ka kd ks shi) = material model | 125 | let (Material _ ka kd ks shi) = material model |
| 126 | in do | 126 | in do |
| 127 | uniformVec4 (kaLoc uniforms) ka | 127 | uniform (kaLoc uniforms) ka |
| 128 | uniformVec4 (kdLoc uniforms) kd | 128 | uniform (kdLoc uniforms) kd |
| 129 | uniformVec4 (ksLoc uniforms) ks | 129 | uniform (ksLoc uniforms) ks |
| 130 | glUniform1f (shiLoc uniforms) $ unsafeCoerce shi | 130 | glUniform1f (shiLoc uniforms) $ unsafeCoerce shi |
| 131 | drawArrays gl_TRIANGLES 0 $ nVertices model | 131 | drawArrays gl_TRIANGLES 0 $ nVertices model |
| 132 | 132 | ||
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 | |||
| 81 | 81 | ||
| 82 | 82 | ||
| 83 | instance S2.Spatial2 GameObject where | 83 | instance S2.Spatial2 GameObject where |
| 84 | 84 | ||
| 85 | move v go = go | 85 | move v go = go |
| 86 | { collisioners = fmap (Col.move v) $ collisioners go | 86 | { collisioners = fmap (Col.move v) $ collisioners go |
| 87 | , transform = M3.translv v * transform go | 87 | , transform = M3.translv v * transform go |
| 88 | } | 88 | } |
| 89 | 89 | ||
| 90 | moveFwd s go = | 90 | moveFwd s go = |
| 91 | let m = transform go | 91 | let m = transform go |
| 92 | v = scale s $ M3.forward m | 92 | v = scale s $ M3.forward m |
| @@ -94,7 +94,7 @@ instance S2.Spatial2 GameObject where | |||
| 94 | { collisioners = fmap (Col.move v) $ collisioners go | 94 | { collisioners = fmap (Col.move v) $ collisioners go |
| 95 | , transform = M3.translv v * m | 95 | , transform = M3.translv v * m |
| 96 | } | 96 | } |
| 97 | 97 | ||
| 98 | moveBack s go = | 98 | moveBack s go = |
| 99 | let m = transform go | 99 | let m = transform go |
| 100 | v = scale (-s) $ M3.forward m | 100 | v = scale (-s) $ M3.forward m |
| @@ -102,7 +102,7 @@ instance S2.Spatial2 GameObject where | |||
| 102 | { collisioners = fmap (Col.move v) $ collisioners go | 102 | { collisioners = fmap (Col.move v) $ collisioners go |
| 103 | , transform = M3.translv v * m | 103 | , transform = M3.translv v * m |
| 104 | } | 104 | } |
| 105 | 105 | ||
| 106 | strafeLeft s go = | 106 | strafeLeft s go = |
| 107 | let m = transform go | 107 | let m = transform go |
| 108 | v = scale (-s) $ M3.right m | 108 | v = scale (-s) $ M3.right m |
| @@ -110,7 +110,7 @@ instance S2.Spatial2 GameObject where | |||
| 110 | { collisioners = fmap (Col.move v) $ collisioners go | 110 | { collisioners = fmap (Col.move v) $ collisioners go |
| 111 | , transform = M3.translv v * m | 111 | , transform = M3.translv v * m |
| 112 | } | 112 | } |
| 113 | 113 | ||
| 114 | strafeRight s go = | 114 | strafeRight s go = |
| 115 | let m = transform go | 115 | let m = transform go |
| 116 | v = scale s $ M3.right m | 116 | v = scale s $ M3.right m |
| @@ -118,35 +118,35 @@ instance S2.Spatial2 GameObject where | |||
| 118 | { collisioners = fmap (Col.move v) $ collisioners go | 118 | { collisioners = fmap (Col.move v) $ collisioners go |
| 119 | , transform = M3.translv v * m | 119 | , transform = M3.translv v * m |
| 120 | } | 120 | } |
| 121 | 121 | ||
| 122 | rotate a go = | 122 | rotate a go = |
| 123 | go | 123 | go |
| 124 | { transform = transform go * M3.rot a | 124 | { transform = transform go * M3.rot a |
| 125 | , angle = (angle go + a) `mod'` 360 | 125 | , angle = (angle go + a) `mod'` 360 |
| 126 | } | 126 | } |
| 127 | 127 | ||
| 128 | setRotation a go = | 128 | setRotation a go = |
| 129 | go | 129 | go |
| 130 | { transform = M3.translation (transform go) * M3.rot a | 130 | { transform = M3.translation (transform go) * M3.rot a |
| 131 | , angle = a | 131 | , angle = a |
| 132 | } | 132 | } |
| 133 | 133 | ||
| 134 | pos go = M3.position . transform $ go | 134 | pos go = M3.position . transform $ go |
| 135 | 135 | ||
| 136 | fwd go = M3.forward . transform $ go | 136 | fwd go = M3.forward . transform $ go |
| 137 | 137 | ||
| 138 | up go = M3.up . transform $ go | 138 | up go = M3.up . transform $ go |
| 139 | 139 | ||
| 140 | right go = M3.right . transform $ go | 140 | right go = M3.right . transform $ go |
| 141 | 141 | ||
| 142 | transform go = Spear.Scene.GameObject.transform go | 142 | transform go = Spear.Scene.GameObject.transform go |
| 143 | 143 | ||
| 144 | setTransform mat go = go { transform = mat } | 144 | setTransform mat go = go { transform = mat } |
| 145 | 145 | ||
| 146 | setPos pos go = | 146 | setPos pos go = |
| 147 | let m = transform go | 147 | let m = transform go |
| 148 | in go { transform = M3.transform (M3.right m) (M3.forward m) pos } | 148 | in go { transform = M3.transform (M3.right m) (M3.forward m) pos } |
| 149 | 149 | ||
| 150 | lookAt p go = | 150 | lookAt p go = |
| 151 | let position = S2.pos go | 151 | let position = S2.pos go |
| 152 | fwd = normalise $ p - position | 152 | fwd = normalise $ p - position |
| @@ -213,7 +213,7 @@ goRPGtransform go = | |||
| 213 | currentAnimation :: Enum a => GameObject -> a | 213 | currentAnimation :: Enum a => GameObject -> a |
| 214 | currentAnimation go = case renderer go of | 214 | currentAnimation go = case renderer go of |
| 215 | Left _ -> toEnum 0 | 215 | Left _ -> toEnum 0 |
| 216 | Right amr -> AM.currentAnimation amr | 216 | Right amr -> AM.currentAnimation amr |
| 217 | 217 | ||
| 218 | 218 | ||
| 219 | -- | Return the game object's number of collisioners. | 219 | -- | Return the game object's number of collisioners. |
| @@ -297,12 +297,12 @@ goRender' :: (ProgramUniforms u, Program p) | |||
| 297 | -> Render | 297 | -> Render |
| 298 | -> IO () | 298 | -> IO () |
| 299 | goRender' style a axis prog uniforms modelview proj normal bindRenderer render = | 299 | goRender' style a axis prog uniforms modelview proj normal bindRenderer render = |
| 300 | let | 300 | let |
| 301 | in do | 301 | in do |
| 302 | useProgram . program $ prog | 302 | useProgram . program $ prog |
| 303 | uniformMat4 (projLoc uniforms) proj | 303 | uniform (projLoc uniforms) proj |
| 304 | uniformMat4 (modelviewLoc uniforms) modelview | 304 | uniform (modelviewLoc uniforms) modelview |
| 305 | uniformMat3 (normalmatLoc uniforms) normal | 305 | uniform (normalmatLoc uniforms) normal |
| 306 | bindRenderer | 306 | bindRenderer |
| 307 | render | 307 | render |
| 308 | 308 | ||
