diff options
-rw-r--r-- | Spear/GL.hs | 164 | ||||
-rw-r--r-- | Spear/Render/AnimatedModel.hs | 20 | ||||
-rw-r--r-- | Spear/Render/StaticModel.hs | 18 |
3 files changed, 108 insertions, 94 deletions
diff --git a/Spear/GL.hs b/Spear/GL.hs index d3a42f0..65f985b 100644 --- a/Spear/GL.hs +++ b/Spear/GL.hs | |||
@@ -1,24 +1,11 @@ | |||
1 | module Spear.GL | 1 | module Spear.GL |
2 | ( | 2 | ( |
3 | -- * General Management | 3 | -- * Programs |
4 | GLSLShader | 4 | GLSLProgram |
5 | , GLSLProgram | ||
6 | , ShaderType(..) | ||
7 | -- ** Programs | ||
8 | , newProgram | 5 | , newProgram |
9 | , linkProgram | 6 | , linkProgram |
10 | , useProgram | 7 | , useProgram |
11 | , withGLSLProgram | 8 | , withGLSLProgram |
12 | -- ** Shaders | ||
13 | , attachShader | ||
14 | , detachShader | ||
15 | , loadShader | ||
16 | , newShader | ||
17 | -- *** Source loading | ||
18 | , loadSource | ||
19 | , shaderSource | ||
20 | , readSource | ||
21 | , compile | ||
22 | -- ** Locations | 9 | -- ** Locations |
23 | , attribLocation | 10 | , attribLocation |
24 | , fragLocation | 11 | , fragLocation |
@@ -29,16 +16,25 @@ module Spear.GL | |||
29 | , uniformVec4 | 16 | , uniformVec4 |
30 | , uniformMat3 | 17 | , uniformMat3 |
31 | , uniformMat4 | 18 | , uniformMat4 |
32 | , uniformfl | 19 | , LoadUniforms(..) |
33 | , uniformil | 20 | -- * Shaders |
34 | -- ** Helper functions | 21 | , GLSLShader |
22 | , ShaderType(..) | ||
23 | , attachShader | ||
24 | , detachShader | ||
25 | , loadShader | ||
26 | , newShader | ||
27 | -- ** Source loading | ||
28 | , loadSource | ||
29 | , shaderSource | ||
30 | , readSource | ||
31 | , compile | ||
32 | -- * Helper functions | ||
35 | , ($=) | 33 | , ($=) |
36 | , Data.StateVar.get | 34 | , Data.StateVar.get |
37 | -- * VAOs | 35 | -- * VAOs |
38 | , VAO | 36 | , VAO |
39 | -- ** Creation and destruction | ||
40 | , newVAO | 37 | , newVAO |
41 | -- ** Manipulation | ||
42 | , bindVAO | 38 | , bindVAO |
43 | , enableVAOAttrib | 39 | , enableVAOAttrib |
44 | , attribVAOPointer | 40 | , attribVAOPointer |
@@ -49,12 +45,10 @@ module Spear.GL | |||
49 | , GLBuffer | 45 | , GLBuffer |
50 | , TargetBuffer(..) | 46 | , TargetBuffer(..) |
51 | , BufferUsage(..) | 47 | , BufferUsage(..) |
52 | -- ** Creation and destruction | ||
53 | , newBuffer | 48 | , newBuffer |
54 | -- ** Manipulation | ||
55 | , bindBuffer | 49 | , bindBuffer |
56 | , bufferData | 50 | , BufferData(..) |
57 | , bufferDatal | 51 | , bufferData' |
58 | , withGLBuffer | 52 | , withGLBuffer |
59 | -- * Textures | 53 | -- * Textures |
60 | , Texture | 54 | , Texture |
@@ -92,7 +86,9 @@ import Control.Monad.Trans.Error | |||
92 | import Control.Monad.Trans.State as State | 86 | import Control.Monad.Trans.State as State |
93 | import qualified Data.ByteString.Char8 as B | 87 | import qualified Data.ByteString.Char8 as B |
94 | import Data.StateVar | 88 | import Data.StateVar |
89 | import Data.Word | ||
95 | import Foreign.C.String | 90 | import Foreign.C.String |
91 | import Foreign.C.Types | ||
96 | import Foreign.Ptr | 92 | import Foreign.Ptr |
97 | import Foreign.Storable | 93 | import Foreign.Storable |
98 | import Foreign.Marshal.Utils as Foreign (with) | 94 | import Foreign.Marshal.Utils as Foreign (with) |
@@ -140,9 +136,8 @@ withGLSLProgram prog f = f $ getProgram prog | |||
140 | 136 | ||
141 | -- | Get the location of the given uniform variable within the given program. | 137 | -- | Get the location of the given uniform variable within the given program. |
142 | uniformLocation :: GLSLProgram -> String -> GettableStateVar GLint | 138 | uniformLocation :: GLSLProgram -> String -> GettableStateVar GLint |
143 | uniformLocation prog var = makeGettableStateVar get | 139 | uniformLocation prog var = makeGettableStateVar $ |
144 | where | 140 | withCString var $ \str -> glGetUniformLocation (getProgram prog) (unsafeCoerce str) |
145 | get = withCString var $ \str -> glGetUniformLocation (getProgram prog) (unsafeCoerce str) | ||
146 | 141 | ||
147 | -- | Get or set the location of the given variable to a fragment shader colour number. | 142 | -- | Get or set the location of the given variable to a fragment shader colour number. |
148 | fragLocation :: GLSLProgram -> String -> StateVar GLint | 143 | fragLocation :: GLSLProgram -> String -> StateVar GLint |
@@ -167,10 +162,10 @@ newProgram shaders = do | |||
167 | when (h == 0) $ gameError "glCreateProgram failed" | 162 | when (h == 0) $ gameError "glCreateProgram failed" |
168 | rkey <- register $ deleteProgram h | 163 | rkey <- register $ deleteProgram h |
169 | let program = GLSLProgram h rkey | 164 | let program = GLSLProgram h rkey |
170 | 165 | ||
171 | mapM_ (gameIO . attachShader program) shaders | 166 | mapM_ (gameIO . attachShader program) shaders |
172 | linkProgram program | 167 | linkProgram program |
173 | 168 | ||
174 | return program | 169 | return program |
175 | 170 | ||
176 | -- | Delete the program. | 171 | -- | Delete the program. |
@@ -192,7 +187,7 @@ linkProgram prog = do | |||
192 | case status of | 187 | case status of |
193 | 0 -> getStatus glGetProgramiv glGetProgramInfoLog h | 188 | 0 -> getStatus glGetProgramiv glGetProgramInfoLog h |
194 | _ -> return "" | 189 | _ -> return "" |
195 | 190 | ||
196 | case length err of | 191 | case length err of |
197 | 0 -> return () | 192 | 0 -> return () |
198 | _ -> gameError err | 193 | _ -> gameError err |
@@ -258,10 +253,10 @@ shaderSource shader str = | |||
258 | compile :: FilePath -> GLSLShader -> Game s () | 253 | compile :: FilePath -> GLSLShader -> Game s () |
259 | compile file shader = do | 254 | compile file shader = do |
260 | let h = getShader shader | 255 | let h = getShader shader |
261 | 256 | ||
262 | -- Compile | 257 | -- Compile |
263 | gameIO $ glCompileShader h | 258 | gameIO $ glCompileShader h |
264 | 259 | ||
265 | -- Verify status | 260 | -- Verify status |
266 | err <- gameIO $ alloca $ \statusPtr -> do | 261 | err <- gameIO $ alloca $ \statusPtr -> do |
267 | glGetShaderiv h gl_COMPILE_STATUS statusPtr | 262 | glGetShaderiv h gl_COMPILE_STATUS statusPtr |
@@ -269,11 +264,11 @@ compile file shader = do | |||
269 | case result of | 264 | case result of |
270 | 0 -> getStatus glGetShaderiv glGetShaderInfoLog h | 265 | 0 -> getStatus glGetShaderiv glGetShaderInfoLog h |
271 | _ -> return "" | 266 | _ -> return "" |
272 | 267 | ||
273 | case length err of | 268 | case length err of |
274 | 0 -> return () | 269 | 0 -> return () |
275 | _ -> gameError $ "Unable to compile shader " ++ file ++ ":\n" ++ err | 270 | _ -> gameError $ "Unable to compile shader " ++ file ++ ":\n" ++ err |
276 | 271 | ||
277 | type StatusCall = GLuint -> GLenum -> Ptr GLint -> IO () | 272 | type StatusCall = GLuint -> GLenum -> Ptr GLint -> IO () |
278 | type LogCall = GLuint -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO () | 273 | type LogCall = GLuint -> GLsizei -> Ptr GLsizei -> Ptr GLchar -> IO () |
279 | 274 | ||
@@ -314,16 +309,16 @@ readSource' file = do | |||
314 | if isInclude l | 309 | if isInclude l |
315 | then readSource' $ B.unpack . clean . cleanInclude $ l | 310 | then readSource' $ B.unpack . clean . cleanInclude $ l |
316 | else return l | 311 | else return l |
317 | 312 | ||
318 | contents <- B.readFile file | 313 | contents <- B.readFile file |
319 | 314 | ||
320 | dir <- getCurrentDirectory | 315 | dir <- getCurrentDirectory |
321 | let dir' = dir ++ "/" ++ (reverse . dropWhile (\c -> c /= '/') . reverse) file | 316 | let dir' = dir ++ "/" ++ (reverse . dropWhile (\c -> c /= '/') . reverse) file |
322 | 317 | ||
323 | setCurrentDirectory dir' | 318 | setCurrentDirectory dir' |
324 | code <- parse contents | 319 | code <- parse contents |
325 | setCurrentDirectory dir | 320 | setCurrentDirectory dir |
326 | 321 | ||
327 | return code | 322 | return code |
328 | 323 | ||
329 | -- | Load a 2D vector. | 324 | -- | Load a 2D vector. |
@@ -338,7 +333,7 @@ uniformVec3 loc v = glUniform3f loc x' y' z' | |||
338 | where x' = unsafeCoerce $ x v | 333 | where x' = unsafeCoerce $ x v |
339 | y' = unsafeCoerce $ y v | 334 | y' = unsafeCoerce $ y v |
340 | z' = unsafeCoerce $ z v | 335 | z' = unsafeCoerce $ z v |
341 | 336 | ||
342 | -- | Load a 4D vector. | 337 | -- | Load a 4D vector. |
343 | uniformVec4 :: GLint -> Vector4 -> IO () | 338 | uniformVec4 :: GLint -> Vector4 -> IO () |
344 | uniformVec4 loc v = glUniform4f loc x' y' z' w' | 339 | uniformVec4 loc v = glUniform4f loc x' y' z' w' |
@@ -359,23 +354,25 @@ uniformMat4 loc mat = | |||
359 | with mat $ \ptrMat -> | 354 | with mat $ \ptrMat -> |
360 | glUniformMatrix4fv loc 1 (toEnum 0) (unsafeCoerce ptrMat) | 355 | glUniformMatrix4fv loc 1 (toEnum 0) (unsafeCoerce ptrMat) |
361 | 356 | ||
362 | -- | Load a list of floats. | 357 | class LoadUniforms a where |
363 | uniformfl :: GLint -> [GLfloat] -> IO () | 358 | -- | Load a list of uniform values. |
364 | uniformfl loc vals = withArray vals $ \ptr -> | 359 | uniforml :: GLint -> [a] -> IO () |
365 | case length vals of | 360 | |
366 | 1 -> glUniform1fv loc 1 ptr | 361 | instance LoadUniforms Float where |
367 | 2 -> glUniform2fv loc 1 ptr | 362 | uniforml loc vals = withArray (map unsafeCoerce vals) $ \ptr -> |
368 | 3 -> glUniform3fv loc 1 ptr | 363 | case length vals of |
369 | 4 -> glUniform4fv loc 1 ptr | 364 | 1 -> glUniform1fv loc 1 ptr |
370 | 365 | 2 -> glUniform2fv loc 1 ptr | |
371 | -- | Load a list of integers. | 366 | 3 -> glUniform3fv loc 1 ptr |
372 | uniformil :: GLint -> [GLint] -> IO () | 367 | 4 -> glUniform4fv loc 1 ptr |
373 | uniformil loc vals = withArray vals $ \ptr -> | 368 | |
374 | case length vals of | 369 | instance LoadUniforms Int where |
375 | 1 -> glUniform1iv loc 1 ptr | 370 | uniforml loc vals = withArray (map fromIntegral vals) $ \ptr -> |
376 | 2 -> glUniform2iv loc 1 ptr | 371 | case length vals of |
377 | 3 -> glUniform3iv loc 1 ptr | 372 | 1 -> glUniform1iv loc 1 ptr |
378 | 4 -> glUniform4iv loc 1 ptr | 373 | 2 -> glUniform2iv loc 1 ptr |
374 | 3 -> glUniform3iv loc 1 ptr | ||
375 | 4 -> glUniform4iv loc 1 ptr | ||
379 | 376 | ||
380 | -- | 377 | -- |
381 | -- VAOs | 378 | -- VAOs |
@@ -402,7 +399,7 @@ newVAO = do | |||
402 | h <- gameIO . alloca $ \ptr -> do | 399 | h <- gameIO . alloca $ \ptr -> do |
403 | glGenVertexArrays 1 ptr | 400 | glGenVertexArrays 1 ptr |
404 | peek ptr | 401 | peek ptr |
405 | 402 | ||
406 | rkey <- register $ deleteVAO h | 403 | rkey <- register $ deleteVAO h |
407 | return $ VAO h rkey | 404 | return $ VAO h rkey |
408 | 405 | ||
@@ -415,7 +412,7 @@ bindVAO :: VAO -> IO () | |||
415 | bindVAO = glBindVertexArray . getVAO | 412 | bindVAO = glBindVertexArray . getVAO |
416 | 413 | ||
417 | -- | Enable the given vertex attribute of the bound vao. | 414 | -- | Enable the given vertex attribute of the bound vao. |
418 | -- | 415 | -- |
419 | -- See also 'bindVAO'. | 416 | -- See also 'bindVAO'. |
420 | enableVAOAttrib :: GLuint -- ^ Attribute index. | 417 | enableVAOAttrib :: GLuint -- ^ Attribute index. |
421 | -> IO () | 418 | -> IO () |
@@ -445,7 +442,7 @@ drawArrays mode first count = glDrawArrays mode (unsafeCoerce first) (unsafeCoer | |||
445 | drawElements | 442 | drawElements |
446 | :: GLenum -- ^ The kind of primitives to render. | 443 | :: GLenum -- ^ The kind of primitives to render. |
447 | -> Int -- ^ The number of elements to be rendered. | 444 | -> Int -- ^ The number of elements to be rendered. |
448 | -> GLenum -- ^ The type of the index values. Must be one of gl_UNSIGNED_BYTE, gl_UNSIGNED_SHORT, or gl_UNSIGNED_INT. | 445 | -> GLenum -- ^ The type of the index values. Must be one of gl_UNSIGNED_BYTE, gl_UNSIGNED_SHORT, or gl_UNSIGNED_INT. |
449 | -> Ptr a -- ^ Pointer to the location where indices are stored, or offset into the index array when there is a bound ElementArrayBuffer. | 446 | -> Ptr a -- ^ Pointer to the location where indices are stored, or offset into the index array when there is a bound ElementArrayBuffer. |
450 | -> IO () | 447 | -> IO () |
451 | drawElements mode count t idxs = glDrawElements mode (unsafeCoerce count) t idxs | 448 | drawElements mode count t idxs = glDrawElements mode (unsafeCoerce count) t idxs |
@@ -470,7 +467,7 @@ data TargetBuffer | |||
470 | | PixelPackBuffer | 467 | | PixelPackBuffer |
471 | | PixelUnpackBuffer | 468 | | PixelUnpackBuffer |
472 | deriving (Eq, Show) | 469 | deriving (Eq, Show) |
473 | 470 | ||
474 | fromTarget :: TargetBuffer -> GLenum | 471 | fromTarget :: TargetBuffer -> GLenum |
475 | fromTarget ArrayBuffer = gl_ARRAY_BUFFER | 472 | fromTarget ArrayBuffer = gl_ARRAY_BUFFER |
476 | fromTarget ElementArrayBuffer = gl_ELEMENT_ARRAY_BUFFER | 473 | fromTarget ElementArrayBuffer = gl_ELEMENT_ARRAY_BUFFER |
@@ -507,7 +504,7 @@ newBuffer = do | |||
507 | h <- gameIO . alloca $ \ptr -> do | 504 | h <- gameIO . alloca $ \ptr -> do |
508 | glGenBuffers 1 ptr | 505 | glGenBuffers 1 ptr |
509 | peek ptr | 506 | peek ptr |
510 | 507 | ||
511 | rkey <- register $ deleteBuffer h | 508 | rkey <- register $ deleteBuffer h |
512 | return $ GLBuffer h rkey | 509 | return $ GLBuffer h rkey |
513 | 510 | ||
@@ -519,23 +516,40 @@ deleteBuffer buf = Foreign.with buf $ glDeleteBuffers 1 | |||
519 | bindBuffer :: GLBuffer -> TargetBuffer -> IO () | 516 | bindBuffer :: GLBuffer -> TargetBuffer -> IO () |
520 | bindBuffer buf target = glBindBuffer (fromTarget target) $ getBuffer buf | 517 | bindBuffer buf target = glBindBuffer (fromTarget target) $ getBuffer buf |
521 | 518 | ||
522 | -- | Set the buffer's data. | 519 | class Storable a => BufferData a where |
523 | bufferData :: TargetBuffer | 520 | -- | Set the buffer's data. |
524 | -> Int -- ^ Buffer size in bytes. | 521 | bufferData :: TargetBuffer -> [a] -> BufferUsage -> IO () |
525 | -> Ptr a | 522 | bufferData tgt vals usage = |
523 | let n = sizeOf (undefined :: Word8) * length vals | ||
524 | in withArray vals $ \ptr -> bufferData' tgt n ptr usage | ||
525 | |||
526 | instance BufferData Word8 | ||
527 | instance BufferData Word16 | ||
528 | instance BufferData Word32 | ||
529 | instance BufferData CChar | ||
530 | instance BufferData CInt | ||
531 | instance BufferData CFloat | ||
532 | instance BufferData CDouble | ||
533 | instance BufferData Int | ||
534 | instance BufferData Float | ||
535 | instance BufferData Double | ||
536 | |||
537 | {-bufferData :: Storable a | ||
538 | => TargetBuffer | ||
539 | -> Int -- ^ The size in bytes of an element in the data list. | ||
540 | -> [a] -- ^ The data list. | ||
526 | -> BufferUsage | 541 | -> BufferUsage |
527 | -> IO () | 542 | -> IO () |
528 | bufferData target n bufData usage = glBufferData (fromTarget target) (unsafeCoerce n) bufData (fromUsage usage) | 543 | bufferData target n bufData usage = withArray bufData $ |
544 | \ptr -> bufferData target (n * length bufData) ptr usage-} | ||
529 | 545 | ||
530 | -- | Set the buffer's data. | 546 | -- | Set the buffer's data. |
531 | bufferDatal :: Storable a | 547 | bufferData' :: TargetBuffer |
532 | => TargetBuffer | 548 | -> Int -- ^ Buffer size in bytes. |
533 | -> Int -- ^ The size in bytes of an element in the data list. | 549 | -> Ptr a |
534 | -> [a] -- ^ The data list. | ||
535 | -> BufferUsage | 550 | -> BufferUsage |
536 | -> IO () | 551 | -> IO () |
537 | bufferDatal target n bufData usage = withArray bufData $ | 552 | bufferData' target n bufData usage = glBufferData (fromTarget target) (unsafeCoerce n) bufData (fromUsage usage) |
538 | \ptr -> bufferData target (n * length bufData) ptr usage | ||
539 | 553 | ||
540 | -- | Apply the given function the buffer's id. | 554 | -- | Apply the given function the buffer's id. |
541 | withGLBuffer :: GLBuffer -> (GLuint -> a) -> a | 555 | withGLBuffer :: GLBuffer -> (GLuint -> a) -> a |
@@ -566,7 +580,7 @@ newTexture = do | |||
566 | tex <- gameIO . alloca $ \ptr -> do | 580 | tex <- gameIO . alloca $ \ptr -> do |
567 | glGenTextures 1 ptr | 581 | glGenTextures 1 ptr |
568 | peek ptr | 582 | peek ptr |
569 | 583 | ||
570 | rkey <- register $ deleteTexture tex | 584 | rkey <- register $ deleteTexture tex |
571 | return $ Texture tex rkey | 585 | return $ Texture tex rkey |
572 | 586 | ||
@@ -590,12 +604,12 @@ loadTextureImage file minFilter magFilter = do | |||
590 | h = height image | 604 | h = height image |
591 | pix = pixels image | 605 | pix = pixels image |
592 | rgb = fromIntegral . fromEnum $ gl_RGB | 606 | rgb = fromIntegral . fromEnum $ gl_RGB |
593 | 607 | ||
594 | bindTexture tex | 608 | bindTexture tex |
595 | loadTextureData gl_TEXTURE_2D 0 rgb w h 0 gl_RGB gl_UNSIGNED_BYTE pix | 609 | loadTextureData gl_TEXTURE_2D 0 rgb w h 0 gl_RGB gl_UNSIGNED_BYTE pix |
596 | texParami gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER $= minFilter | 610 | texParami gl_TEXTURE_2D gl_TEXTURE_MIN_FILTER $= minFilter |
597 | texParami gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER $= magFilter | 611 | texParami gl_TEXTURE_2D gl_TEXTURE_MAG_FILTER $= magFilter |
598 | 612 | ||
599 | return tex | 613 | return tex |
600 | 614 | ||
601 | -- | Bind the texture. | 615 | -- | Bind the texture. |
diff --git a/Spear/Render/AnimatedModel.hs b/Spear/Render/AnimatedModel.hs index 9c05109..aa202ec 100644 --- a/Spear/Render/AnimatedModel.hs +++ b/Spear/Render/AnimatedModel.hs | |||
@@ -107,35 +107,35 @@ animatedModelResource | |||
107 | elementBuf <- newBuffer | 107 | elementBuf <- newBuffer |
108 | vao <- newVAO | 108 | vao <- newVAO |
109 | boxes <- gameIO $ modelBoxes model | 109 | boxes <- gameIO $ modelBoxes model |
110 | 110 | ||
111 | gameIO $ do | 111 | gameIO $ do |
112 | 112 | ||
113 | let elemSize = 56 | 113 | let elemSize = 56 |
114 | elemSize' = fromIntegral elemSize | 114 | elemSize' = fromIntegral elemSize |
115 | n = numVertices * numFrames | 115 | n = numVertices * numFrames |
116 | 116 | ||
117 | bindVAO vao | 117 | bindVAO vao |
118 | 118 | ||
119 | bindBuffer elementBuf ArrayBuffer | 119 | bindBuffer elementBuf ArrayBuffer |
120 | bufferData ArrayBuffer (unsafeCoerce $ elemSize * n) elements StaticDraw | 120 | bufferData' ArrayBuffer (unsafeCoerce $ elemSize * n) elements StaticDraw |
121 | 121 | ||
122 | attribVAOPointer vertChan1 3 gl_FLOAT False elemSize' 0 | 122 | attribVAOPointer vertChan1 3 gl_FLOAT False elemSize' 0 |
123 | attribVAOPointer vertChan2 3 gl_FLOAT False elemSize' 12 | 123 | attribVAOPointer vertChan2 3 gl_FLOAT False elemSize' 12 |
124 | attribVAOPointer normChan1 3 gl_FLOAT False elemSize' 24 | 124 | attribVAOPointer normChan1 3 gl_FLOAT False elemSize' 24 |
125 | attribVAOPointer normChan2 3 gl_FLOAT False elemSize' 36 | 125 | attribVAOPointer normChan2 3 gl_FLOAT False elemSize' 36 |
126 | attribVAOPointer texChan 2 gl_FLOAT False elemSize' 48 | 126 | attribVAOPointer texChan 2 gl_FLOAT False elemSize' 48 |
127 | 127 | ||
128 | enableVAOAttrib vertChan1 | 128 | enableVAOAttrib vertChan1 |
129 | enableVAOAttrib vertChan2 | 129 | enableVAOAttrib vertChan2 |
130 | enableVAOAttrib normChan1 | 130 | enableVAOAttrib normChan1 |
131 | enableVAOAttrib normChan2 | 131 | enableVAOAttrib normChan2 |
132 | enableVAOAttrib texChan | 132 | enableVAOAttrib texChan |
133 | 133 | ||
134 | rkey <- register $ do | 134 | rkey <- register $ do |
135 | putStrLn "Releasing animated model resource" | 135 | putStrLn "Releasing animated model resource" |
136 | clean vao | 136 | clean vao |
137 | clean elementBuf | 137 | clean elementBuf |
138 | 138 | ||
139 | return $ AnimatedModelResource | 139 | return $ AnimatedModelResource |
140 | model vao (unsafeCoerce numFrames) (unsafeCoerce numVertices) | 140 | model vao (unsafeCoerce numFrames) (unsafeCoerce numVertices) |
141 | material texture boxes rkey | 141 | material texture boxes rkey |
diff --git a/Spear/Render/StaticModel.hs b/Spear/Render/StaticModel.hs index cadf350..700414f 100644 --- a/Spear/Render/StaticModel.hs +++ b/Spear/Render/StaticModel.hs | |||
@@ -69,31 +69,31 @@ staticModelResource (StaticProgramChannels vertChan normChan texChan) material t | |||
69 | elementBuf <- newBuffer | 69 | elementBuf <- newBuffer |
70 | vao <- newVAO | 70 | vao <- newVAO |
71 | boxes <- gameIO $ modelBoxes model | 71 | boxes <- gameIO $ modelBoxes model |
72 | 72 | ||
73 | gameIO $ do | 73 | gameIO $ do |
74 | 74 | ||
75 | let elemSize = 32 | 75 | let elemSize = 32 |
76 | elemSize' = fromIntegral elemSize | 76 | elemSize' = fromIntegral elemSize |
77 | n = numVertices | 77 | n = numVertices |
78 | 78 | ||
79 | bindVAO vao | 79 | bindVAO vao |
80 | 80 | ||
81 | bindBuffer elementBuf ArrayBuffer | 81 | bindBuffer elementBuf ArrayBuffer |
82 | bufferData ArrayBuffer (fromIntegral $ elemSize*n) elements StaticDraw | 82 | bufferData' ArrayBuffer (fromIntegral $ elemSize*n) elements StaticDraw |
83 | 83 | ||
84 | attribVAOPointer vertChan 3 gl_FLOAT False elemSize' 0 | 84 | attribVAOPointer vertChan 3 gl_FLOAT False elemSize' 0 |
85 | attribVAOPointer normChan 3 gl_FLOAT False elemSize' 12 | 85 | attribVAOPointer normChan 3 gl_FLOAT False elemSize' 12 |
86 | attribVAOPointer texChan 2 gl_FLOAT False elemSize' 24 | 86 | attribVAOPointer texChan 2 gl_FLOAT False elemSize' 24 |
87 | 87 | ||
88 | enableVAOAttrib vertChan | 88 | enableVAOAttrib vertChan |
89 | enableVAOAttrib normChan | 89 | enableVAOAttrib normChan |
90 | enableVAOAttrib texChan | 90 | enableVAOAttrib texChan |
91 | 91 | ||
92 | rkey <- register $ do | 92 | rkey <- register $ do |
93 | putStrLn "Releasing static model resource" | 93 | putStrLn "Releasing static model resource" |
94 | clean vao | 94 | clean vao |
95 | clean elementBuf | 95 | clean elementBuf |
96 | 96 | ||
97 | return $ StaticModelResource | 97 | return $ StaticModelResource |
98 | vao (unsafeCoerce numVertices) material texture boxes rkey | 98 | vao (unsafeCoerce numVertices) material texture boxes rkey |
99 | 99 | ||