Vaious improvements to rendering performance, now runs at ok speed

src/Picture/Render.hs

@@ -378,7 +378,11 @@ renderPicture' :: RenderData -> Float -> Float -> (Float,Float) -> (Float,Float)
                     [(Point2,Point2)] -> [Point4] -> Picture -> IO (Word32,Word32)
 renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints pic = do
     wallPokeStart <- SDL.ticks
-    depthFunc $= Just Lequal
+
+-- setting the depth function to less, instead of lequal, 
+-- seems to stop a lot of unecessary drawing
+-- of wall shadows when creating the light map
+    depthFunc $= Just Less
 
 -- calculate world transformation matrix
     let scalMat = Linear.Matrix.transpose $
@@ -426,12 +430,12 @@ renderPicture' pdata rot zoom (tranx,trany) (winx,winy) wallPoints lightPoints p
 --                pokeFourOff wallPtr2 n (a,b,c,d)
                 return $ n+1
     nWalls <- foldM foldWalls 0 wallPoints 
+    bindArrayBuffers (length wallPoints) $ _vaoBufferTargets $ _wallVAO pdata
 
     forM_ lightPoints $ \(x,y,r,lum) -> do
 --        cullFace $= Just Front
         clear [DepthBuffer]
         currentProgram $= Just (fst $ _wallShadowShader pdata)
-        bindArrayBuffers (length wallPoints) $ _vaoBufferTargets $ _wallVAO pdata
         bindVertexArrayObject $= Just (_vao $ _wallVAO pdata)
         uniform (_wssLightPos pdata)  $= Vector2 (x) (y)
         blendFunc $= (Zero,One)
@@ -518,6 +522,17 @@ renderTree pdata rot zoom (tranx,trany) (winx,winy) tree = do
                    ) $ tree
 
     pokeEndTicks <-SDL.ticks
+-- bind buffers
+-- the idea of doing as much of this at once, rather than interweaving with draw
+-- calls, is to prevent opengl from waiting for a draw call to finish
+-- before it performs another state change
+    bindArrayBuffers 1 $ _vaoBufferTargets $ _backVAO pdata
+    bindArrayBuffers nTriVs $ _vaoBufferTargets $ _triVAO pdata
+    bindArrayBuffers numCircVs $ _vaoBufferTargets $ _circVAO pdata
+    bindArrayBuffers nArcVs $ _vaoBufferTargets $ _arcVAO pdata
+    bindArrayBuffers nLineVs $ _vaoBufferTargets $ _lineVAO pdata
+    bindArrayBuffers nTextVs $ _vaoBufferTargets $ _textVAO pdata
+
     depthFunc $= Just Less
 
     currentProgram $= Just (fst $ _backShader pdata)
@@ -526,36 +541,31 @@ renderTree pdata rot zoom (tranx,trany) (winx,winy) tree = do
         backPtr2 = (\(_,x,_) -> x) $ (_vaoBufferTargets $ _backVAO pdata) !! 1
     pokeFourOff backPtr 0 (tranx,trany,rot,zoom)
     pokeTwoOff backPtr2 0  (winx,winy)
-    bindArrayBuffers 1 $ _vaoBufferTargets $ _backVAO pdata
     textureBinding Texture2D $= Just (_textures pdata !! 1)
     drawArrays Points (fromIntegral 0) (fromIntegral 1)
 
     depthFunc $= Just Lequal
+
 -- draw triangles
     currentProgram $= Just (fst $ _basicShader pdata)
     bindVertexArrayObject $= Just (_vao $ _triVAO pdata)
-    bindArrayBuffers nTriVs $ _vaoBufferTargets $ _triVAO pdata
     drawArrays Triangles 0 (fromIntegral $ nTriVs)
 -- draw circles
     currentProgram $= Just (fst $ _circShader pdata)
     bindVertexArrayObject $= Just (_vao $ _circVAO pdata)
-    bindArrayBuffers numCircVs $ _vaoBufferTargets $ _circVAO pdata
     drawArrays Points 0 (fromIntegral $ numCircVs)
 -- draw arcs
 -- assumes that the uniforms are set
     currentProgram $= Just (fst $ _arcShader pdata)
     bindVertexArrayObject $= Just (_vao $ _arcVAO pdata)
-    bindArrayBuffers nArcVs $ _vaoBufferTargets $ _arcVAO pdata
     drawArrays Points 0 (fromIntegral $ nArcVs)
 -- draw lines
     currentProgram $= Just (fst $ _basicShader pdata)
     bindVertexArrayObject $= Just (_vao $ _lineVAO pdata)
-    bindArrayBuffers nLineVs $ _vaoBufferTargets $ _lineVAO pdata
     drawArrays Lines 0 (fromIntegral $ nLineVs)
 -- draw text
     currentProgram $= Just (fst $ _textShader pdata)
     bindVertexArrayObject $= Just (_vao $ _textVAO pdata)
-    bindArrayBuffers nTextVs $ _vaoBufferTargets $ _textVAO pdata
     textureBinding Texture2D $= Just (_textures pdata !! 0)
     drawArrays Points 0 (fromIntegral $ nTextVs)
     return (pokeEndTicks - pokeStartTicks)