Working element buffer object

src/Dodge/Render.hs

@@ -20,7 +20,8 @@ import Shader.Data
 import MatrixHelper
 --import Polyhedra.Data
 import Polyhedra
-import Shape.Data
+import Shader.ExtraPrimitive
+import Shader.Parameters
 
 import Foreign
 --import Control.Applicative
@@ -38,7 +39,7 @@ import Control.Monad
 import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
 import qualified SDL
 import qualified Data.Vector.Unboxed.Mutable as UMV
-import qualified Data.Vector.Fusion.Stream.Monadic as VS
+import Graphics.GL.Core43
 
 doDrawing :: RenderData -> World -> IO Word32
 doDrawing pdata w = do
@@ -56,21 +57,15 @@ doDrawing pdata w = do
     -- bind as much data into vbos as feasible at this point
     -- poke wall points and colors
     nWalls <- poke224s (shadVBOptr $ _wallTextureShader pdata) wallPointsCol
-    nSils <- pokePoint3s (shadVBOptr $ _lightingLineShadowShader pdata) 
-        $  VS.fromList
-        $ (shEList $ worldShape w)
---    -- poke foreground geometry for caps
---    nCaps <- pokePoint3s (shadVBOptr $ _lightingCapShader pdata)
---        $ VS.fromList
---            (fmap _svPos (shVList $ worldShape w))
-    numShapeVs <- pokeShapeVs (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata) 
-        $ VS.fromList $ shVList $ worldShape w
-    let nCaps = numShapeVs
+    (numShapeVs,nSils) <- pokeShape
+        (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata)
+        (shadVBOptr $ _lightingLineShadowShader pdata) 
+        (_eboPtr $ _shapeEBO pdata)
+        $ worldShape w
     -- bind wall points, silhouette data, surface geometry
     uncurry bindShaderBuffers $ unzip
         [ ( _wallTextureShader pdata, nWalls)
         , (_lightingLineShadowShader pdata, nSils)
---        , (_lightingCapShader pdata, nCaps)
         , (_shapeShader pdata, numShapeVs)
         ]
     -- set the coordinate uniform ready for drawing elements using world coordinates
@@ -95,7 +90,22 @@ doDrawing pdata w = do
     pokeBindFoldableLayer shadV layerCounts $ worldPictures w
     renderLayer 0 shadV layerCounts
 
-    drawShader (_shapeShader pdata) numShapeVs
+--    drawShader (_shapeShader pdata) numShapeVs
+    let fs = _shapeShader pdata
+    currentProgram $= Just (_shadProg fs)
+    bindVertexArrayObject $= Just (_vao $ _shadVAO fs)
+    bindBuffer ElementArrayBuffer $= Just (_ebo $ _shapeEBO pdata)
+    bufferSubData
+        ElementArrayBuffer
+        WriteToBuffer
+        0
+        (fromIntegral $ glushortSize * numShapeVs)
+        (_eboPtr $ _shapeEBO pdata)
+    glDrawElements
+        (marshalEPrimitiveMode $ _shadPrim fs) 
+        (fromIntegral numShapeVs)
+        (GL_UNSIGNED_SHORT)
+        nullPtr
 
     --draw floor onto base buffer
     nTextArrayVs <- pokePoint33s (shadVBOptr $ _textureArrayShader pdata) (_floorTiles w)
@@ -103,7 +113,8 @@ doDrawing pdata w = do
     drawShader (_textureArrayShader pdata) nTextArrayVs
     --draw lightmap for base buffer
     bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
-    createLightMap pdata lightPoints nWalls nSils nCaps (snd $ snd $ _fboBase pdata)
+    --createLightMap pdata lightPoints nWalls nSils numShapeVs (snd $ snd $ _fboBase pdata)
+    createLightMap pdata lightPoints nWalls 0 0 (snd $ snd $ _fboBase pdata)
     colorMask $= Color4 Enabled Enabled Enabled Enabled
     clearColor $= Color4 0 0 0 0
     --apply lightmap to base buffer
@@ -157,7 +168,7 @@ doDrawing pdata w = do
         depthMask $= Disabled
         blend $= Enabled
         bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
-        createLightMap pdata lightPoints nWalls nSils nCaps (snd $ snd $ _fboCloud pdata)
+        createLightMap pdata lightPoints nWalls nSils numShapeVs (snd $ snd $ _fboCloud pdata)
         colorMask $= Color4 Enabled Enabled Enabled Enabled
         clearColor $= Color4 0 0 0 0
     --apply lightmap to cloud buffer