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 | ||