aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Spear/GL.hs104
-rw-r--r--Spear/Render/AnimatedModel.hs6
-rw-r--r--Spear/Render/StaticModel.hs6
-rw-r--r--Spear/Scene/GameObject.hs40
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 #-}
1module Spear.GL 2module 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. 326class Uniform a where
331uniformVec2 :: GLint -> Vector2 -> IO ()
332uniformVec2 loc v = glUniform2f loc x' y'
333 where x' = unsafeCoerce $ x v
334 y' = unsafeCoerce $ y v
335
336-- | Load a 3D vector.
337uniformVec3 :: GLint -> Vector3 -> IO ()
338uniformVec3 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.
344uniformVec4 :: GLint -> Vector4 -> IO ()
345uniformVec4 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.
352uniformMat3 :: GLint -> Matrix3 -> IO ()
353uniformMat3 loc mat =
354 with mat $ \ptrMat ->
355 glUniformMatrix3fv loc 1 (toEnum 0) (unsafeCoerce ptrMat)
356
357-- | Load a 4x4 matrix.
358uniformMat4 :: GLint -> Matrix4 -> IO ()
359uniformMat4 loc mat =
360 with mat $ \ptrMat ->
361 glUniformMatrix4fv loc 1 (toEnum 0) (unsafeCoerce ptrMat)
362
363class 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
367instance LoadUniforms Float where 330instance Uniform Int where uniform loc a = glUniform1i loc (fromIntegral a)
368 uniforml loc vals = withArray (map unsafeCoerce vals) $ \ptr -> 331instance Uniform Float where uniform loc a = glUniform1f loc (unsafeCoerce a)
332
333instance Uniform (Int,Int) where
334 uniform loc (x,y) = glUniform2i loc (fromIntegral x) (fromIntegral y)
335
336instance Uniform (Float,Float) where
337 uniform loc (x,y) = glUniform2f loc (unsafeCoerce x) (unsafeCoerce y)
338
339instance Uniform (Int,Int,Int) where
340 uniform loc (x,y,z) = glUniform3i loc (fromIntegral x) (fromIntegral y) (fromIntegral z)
341
342instance Uniform (Float,Float,Float) where
343 uniform loc (x,y,z) = glUniform3f loc (unsafeCoerce x) (unsafeCoerce y) (unsafeCoerce z)
344
345instance 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
349instance 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
353instance Uniform Vector2 where
354 uniform loc v = glUniform2f loc x' y'
355 where x' = unsafeCoerce $ x v
356 y' = unsafeCoerce $ y v
357
358instance 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
364instance 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
371instance Uniform Matrix3 where
372 uniform loc mat =
373 with mat $ \ptrMat ->
374 glUniformMatrix3fv loc 1 (toEnum 0) (unsafeCoerce ptrMat)
375
376instance Uniform Matrix4 where
377 uniform loc mat =
378 with mat $ \ptrMat ->
379 glUniformMatrix4fv loc 1 (toEnum 0) (unsafeCoerce ptrMat)
380
381instance 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
375instance LoadUniforms Int where 389instance 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 ()
124render uniforms (StaticModelRenderer model) = 124render 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
83instance S2.Spatial2 GameObject where 83instance 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 =
213currentAnimation :: Enum a => GameObject -> a 213currentAnimation :: Enum a => GameObject -> a
214currentAnimation go = case renderer go of 214currentAnimation 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 ()
299goRender' style a axis prog uniforms modelview proj normal bindRenderer render = 299goRender' 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