Vaious improvements to rendering performance, now runs at ok speed

2021-03-02 01:28:53 +01:00
parent 18492f00d2
commit 81f5385710
2 changed files with 44 additions and 44 deletions
@@ -34,8 +34,6 @@ data RenderData = RenderData
    , _backVAO :: VAO
    , _wallVAO :: VAO
    , _fadeCircVAO :: VAO
-    , _posVBO :: BufferObject
-    , _colVBO :: BufferObject
    , _texVBO :: BufferObject
    , _wssLightPos :: UniformLocation
    , _dummyVBO :: BufferObject
@@ -51,33 +49,35 @@ 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
-    ptrs <- forM ps setupVBOPointers
+    vbos <- forM ps setupArrayBuffer
+    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 (vbo,_,vsize) = do
+setupVBOPointers :: (BufferObject,Int) -> IO (BufferObject,Ptr Float,Int)
+setupVBOPointers (vbo,vsize) = do
    thePtr <- mallocArray (vsize * numDrawableElements)
    return (vbo,thePtr,vsize)

-setupArrayBuffer :: (BufferObject,GLuint,Int) -> IO ()
-setupArrayBuffer (vbo,aloc,i) = do
-        bindBuffer ArrayBuffer $= Just vbo
-        vertexAttribPointer (AttribLocation aloc) $=
-            ( ToFloat
-            , VertexArrayDescriptor (fromIntegral i) 
-                                    Float 
-                                    (fromIntegral $ floatSize * i) 
-                                    (bufferOffset 0)
-            )
-        vertexAttribArray (AttribLocation aloc) $= Enabled
+setupArrayBuffer :: (GLuint,Int) -> IO BufferObject
+setupArrayBuffer (aloc,i) = do
+    vbo <- genObjectName
+    bindBuffer ArrayBuffer $= Just vbo
+    vertexAttribPointer (AttribLocation aloc) $=
+        ( ToFloat
+        , VertexArrayDescriptor (fromIntegral i) 
+                                Float 
+                                (fromIntegral $ floatSize * i) 
+                                (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)]
-    linevao <- setupVAO [(posVBO,0,3),(colVBO,1,4)]
-    textvao <- setupVAO [(posVBO,0,3),(colVBO,1,4),(texVBO,2,2)]
-    circvao <- setupVAO [(posVBO,0,3),(colVBO,1,4),(texVBO,2,1)]
-    arcvao  <- setupVAO [(posVBO,0,3),(colVBO,1,4),(texVBO,2,4)]
-    backgroundvao <- setupVAO [(posVBO,0,4),(colVBO,1,2)]
-    wallvao <- setupVAO [(posVBO,0,4)]--,(colVBO,1,4)]
-    fadecircvao <- setupVAO [(posVBO,0,4)]
+    trivao  <- setupVAO [(0,3),(1,4)]
+    linevao <- setupVAO [(0,3),(1,4)]
+    textvao <- setupVAO [(0,3),(1,4),(2,2)]
+    circvao <- setupVAO [(0,3),(1,4),(2,1)]
+    arcvao  <- setupVAO [(0,3),(1,4),(2,4)]
+    backgroundvao <- setupVAO [(0,4),(1,2)]
+    wallvao <- setupVAO [(0,4)]--,(colVBO,1,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
@@ -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)