Vaious improvements to rendering performance, now runs at ok speed

src/Picture/Preload.hs

@@ -34,8 +34,6 @@ data RenderData = RenderData
     , _backVAO :: VAO
     , _wallVAO :: VAO
     , _fadeCircVAO :: VAO
-    , _posVBO :: BufferObject
-    , _colVBO :: BufferObject
     , _texVBO :: BufferObject
     , _wssLightPos :: UniformLocation
     , _dummyVBO :: BufferObject
@@ -51,24 +49,25 @@ makeLenses ''VAO
 
 floatSize = sizeOf (0.5 :: GLfloat)
 
-setupVAO :: [(BufferObject,GLuint,Int)] -> IO VAO
+setupVAO :: [(GLuint,Int)] -> IO VAO
 setupVAO ps = do
     theVAO <- genObjectName
     bindVertexArrayObject $= Just theVAO
-    forM_ ps setupArrayBuffer
+    vbos <- forM ps setupArrayBuffer
-    ptrs <- forM ps setupVBOPointers
+    ptrs <- forM (zip vbos $ map snd ps) setupVBOPointers
     return $ VAO theVAO ptrs
     
 numDrawableElements :: Int
 numDrawableElements = 50000
 
-setupVBOPointers :: (BufferObject,GLuint,Int) -> IO (BufferObject,Ptr Float,Int)
+setupVBOPointers :: (BufferObject,Int) -> IO (BufferObject,Ptr Float,Int)
-setupVBOPointers (vbo,_,vsize) = do
+setupVBOPointers (vbo,vsize) = do
     thePtr <- mallocArray (vsize * numDrawableElements)
     return (vbo,thePtr,vsize)
 
-setupArrayBuffer :: (BufferObject,GLuint,Int) -> IO ()
+setupArrayBuffer :: (GLuint,Int) -> IO BufferObject
-setupArrayBuffer (vbo,aloc,i) = do
+setupArrayBuffer (aloc,i) = do
+    vbo <- genObjectName
     bindBuffer ArrayBuffer $= Just vbo
     vertexAttribPointer (AttribLocation aloc) $=
         ( ToFloat
@@ -78,6 +77,7 @@ setupArrayBuffer (vbo,aloc,i) = do
                                 (bufferOffset 0)
         )
     vertexAttribArray (AttribLocation aloc) $= Enabled
+    return vbo
 
 
 loadTextures :: IO [Image PixelRGBA8]
@@ -106,13 +106,6 @@ preloadRender = do
     wss <- makeSourcedShader "wallShadow" [VertexShader,GeometryShader,FragmentShader]
 
     wssLightPosUniLoc   <- GL.uniformLocation (fst wss) "lightPos"
--- get uniform locations
-
---setup vbos
---need to be bound before assigning the vertex attribute pointers
-    posVBO <- genObjectName
-    colVBO <- genObjectName
-    texVBO <- genObjectName
 
 --the following vbo is set up to contain one fixed vertex
     dummyvbo <- genObjectName
@@ -151,14 +144,14 @@ preloadRender = do
 
     --textureBinding Texture2D $= Just chartex
 
-    trivao  <- setupVAO [(posVBO,0,3),(colVBO,1,4)]
+    trivao  <- setupVAO [(0,3),(1,4)]
-    linevao <- setupVAO [(posVBO,0,3),(colVBO,1,4)]
+    linevao <- setupVAO [(0,3),(1,4)]
-    textvao <- setupVAO [(posVBO,0,3),(colVBO,1,4),(texVBO,2,2)]
+    textvao <- setupVAO [(0,3),(1,4),(2,2)]
-    circvao <- setupVAO [(posVBO,0,3),(colVBO,1,4),(texVBO,2,1)]
+    circvao <- setupVAO [(0,3),(1,4),(2,1)]
-    arcvao  <- setupVAO [(posVBO,0,3),(colVBO,1,4),(texVBO,2,4)]
+    arcvao  <- setupVAO [(0,3),(1,4),(2,4)]
-    backgroundvao <- setupVAO [(posVBO,0,4),(colVBO,1,2)]
+    backgroundvao <- setupVAO [(0,4),(1,2)]
-    wallvao <- setupVAO [(posVBO,0,4)]--,(colVBO,1,4)]
+    wallvao <- setupVAO [(0,4)]--,(colVBO,1,4)]
-    fadecircvao <- setupVAO [(posVBO,0,4)]
+    fadecircvao <- setupVAO [(0,4)]
     
     return $ RenderData
         { -- _charMap      = convertRGBA8 cmap
@@ -178,9 +171,6 @@ preloadRender = do
         , _backVAO = backgroundvao
         , _wallVAO = wallvao
         , _fadeCircVAO = fadecircvao
-        , _posVBO = posVBO
-        , _colVBO = colVBO
-        , _texVBO = texVBO
         , _dummyVBO = dummyvbo
         , _dummyPtr = dummyptr
         , _wssLightPos = wssLightPosUniLoc

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)