Upload wall geometry once per frame (can improve for fixed geometry)

src/Dodge/Render.hs

@@ -54,7 +54,10 @@ doDrawing pdata w = do
         --viewFroms@(viewFromx,viewFromy) = _cameraViewFrom w
         viewFroms = _cameraViewFrom w
         pic = worldPictures w
-        wallPoints = map fst wallPointsCol
+
+    -- bind wall points and colors to vbo
+    nWalls <- F.foldM (pokeShader $ _wallTextureShader pdata) (map Render22x4 wallPointsCol)
+    bindShaderBuffers [_wallTextureShader pdata] [nWalls]
     -- set the coordinate uniform ready for drawing elements using world coordinates
     bufferUBO $ perspectiveMatrixb rot camzoom trans wins viewFroms
     bindFramebuffer Framebuffer $= (fst $ _fboBase pdata)
@@ -62,8 +65,8 @@ doDrawing pdata w = do
     clear [ColorBuffer,DepthBuffer]
     depthFunc $= Just Less
     if w ^. config . wall_textured
-        then renderTextureWalls pdata wallPointsCol
-        else renderBlankWalls pdata wallPointsCol
+        then renderTextureWalls pdata nWalls
+        else renderBlankWalls pdata nWalls
 --    _ <- setWallDepth pdata wallPoints (viewFromx,viewFromy)
     _ <- renderFoldable pdata $ picToLTree (Just 0) (polysToPic $ foregroundPics w)
     _ <- renderFoldable pdata $ picToLTree (Just 0) pic
@@ -108,8 +111,8 @@ doDrawing pdata w = do
 
     bindFramebuffer Framebuffer $= (fst $ _fboLighting pdata)
     let scPol = screenPolygon w
-    createLightMap pdata (w ^. config . shadow_resolution) wallPoints lightPoints
-        (foregroundPics w) scPol
+    createLightMap pdata (w ^. config . shadow_resolution) lightPoints
+        (foregroundPics w) scPol nWalls
     colorMask $= Color4 Enabled Enabled Enabled Enabled
     clearColor $= Color4 0 0 0 0
 
@@ -136,7 +139,7 @@ doDrawing pdata w = do
 
     depthFunc $= Just Lequal
     _ <- renderFoldable pdata $ picToLTree (Just 2) pic
-    renderBlankWalls pdata windowPoints
+    renderWindows pdata windowPoints
 
     depthFunc $= Just Always
     blendFunc $= (One,Zero)
@@ -208,11 +211,21 @@ bufferUBO mat = withArray mat $ \ptr ->
     bufferSubData UniformBuffer WriteToBuffer 0 64 ptr
 
 renderBlankWalls 
+    :: RenderData 
+    -> Int -- ^ number of walls
+--    -> GLmatrix GLfloat 
+    -> IO ()
+renderBlankWalls pdata nWalls = do
+    cullFace $= Just Back
+    drawShader (_wallBlankShader pdata) nWalls
+    cullFace $= Nothing
+
+renderWindows 
     :: RenderData 
     -> [((Point2,Point2),Point4)]   -- ^ List: wall positions and color
 --    -> GLmatrix GLfloat 
     -> IO ()
-renderBlankWalls pdata wps = do
+renderWindows pdata wps = do
     n <- F.foldM (pokeShader $ _wallBlankShader pdata) (map Render22x4 wps)
     bindShaderBuffers [_wallBlankShader pdata] [n]
     currentProgram $= Just (_shaderProgram $ _wallBlankShader pdata)
@@ -222,12 +235,9 @@ renderBlankWalls pdata wps = do
 
 renderTextureWalls 
     :: RenderData 
-    -> [((Point2,Point2),Point4)]   -- ^ List: wall positions and color
+    -> Int   -- ^ number of walls
     -> IO ()
-renderTextureWalls pdata wps = do
-    n <- F.foldM (pokeShader $ _wallTextureShader pdata) (map Render22x4 wps)
-    bindShaderBuffers [_wallTextureShader pdata] [n]
-    currentProgram $= Just (_shaderProgram $ _wallTextureShader pdata)
+renderTextureWalls pdata nWalls = do
     cullFace $= Just Back
-    drawShader (_wallTextureShader pdata) n
+    drawShader (_wallTextureShader pdata) nWalls
     cullFace $= Nothing