Draw floors using vertex pulling

src/Data/Preload/Render.hs

@@ -42,7 +42,7 @@ data RenderData = RenderData
     , _lightUBO :: GLuint -- BufferObject id
     , _vboShapes :: VBO
     , _floorVBO :: VBO
-    , _floorShader :: Shader
+    , _floorShader :: GLuint
     , _chasmVBO :: VBO
     , _chasmShader :: GLuint
     , _winVBO :: VBO

src/Dodge/Render.hs

@@ -155,13 +155,9 @@ doDrawing' win pdata u = do
         glNamedFramebufferDrawBuffers (pdata ^. fboBase . _1 . unFBO) 3
     glDepthMask GL_TRUE
     --draw floor onto base buffer
-    glUseProgram (pdata ^. floorShader . shaderUINT)
-    glBindVertexArray $ pdata ^. floorShader . shaderVAO . vaoName
+    glUseProgram (pdata ^. floorShader)
     glStencilFunc GL_EQUAL 0 255
-    glDrawArrays
-        (_unPrimitiveMode $ pdata ^. floorShader . shaderPrimitive)
-        0
-        (fromIntegral nFls)
+    glDrawArrays GL_TRIANGLES 0 (fromIntegral nFls)
     --glDisable GL_STENCIL_TEST
     glDisable GL_CULL_FACE
     glEnable GL_BLEND

src/Dodge/WorldLoad.hs

@@ -1,23 +1,27 @@
 module Dodge.WorldLoad (postUniverseLoadSideEffect) where
 
-import Shader.Parameters
-import Graphics.GL.Core45
 import Control.Lens
 import Control.Monad
 import Data.Preload.Render
 import Dodge.Data.Universe
-import Shader.Bind
+import Graphics.GL.Core45
 import Shader.Data
+import Shader.Parameters
 import Shader.Poke.Floor
 
 postUniverseLoadSideEffect :: Universe -> Universe
-postUniverseLoadSideEffect = uvIOEffects %~ 
-    (\f uv -> (uvWorld . cWorld) (postWorldLoad (uv ^. preloadData . renderData)) uv >>= f)
+postUniverseLoadSideEffect =
+    uvIOEffects
+        %~ (\f uv -> (uvWorld . cWorld) (postWorldLoad (uv ^. preloadData . renderData)) uv >>= f)
 
 postWorldLoad :: RenderData -> CWorld -> IO CWorld
 postWorldLoad rdata cw = do
-    nfloorvxs <- foldM (pokeTile (rdata ^. floorVBO . vboPtr)) 0 (cw ^. cwTiles)
-    bufferPokedVBO (rdata ^. floorVBO) nfloorvxs
+    let floorbo = (rdata ^. floorVBO . vboName)
+        floorptr = (rdata ^. floorVBO . vboPtr)
+    nfloorvxs <- foldM (pokeTile floorptr) 0 (cw ^. cwTiles)
+    glInvalidateBufferData floorbo
+    glNamedBufferStorage floorbo (fromIntegral $ 8 * nfloorvxs * floatSize) floorptr 0
+    glBindBufferBase GL_SHADER_STORAGE_BUFFER 8 floorbo
     let chbo = rdata ^. chasmVBO . vboName
         chptr = rdata ^. chasmVBO . vboPtr
     nchasmvxs <- foldM (pokeChasm chptr) 0 (cw ^. chasms)

src/Preload/Render.hs

@@ -130,16 +130,17 @@ preloadRender = do
     barrelShad <- makeShaderVBO "texture/barrel" [vert, geom, frag] (toFloatVAs [2, 2, 2, 1]) pmPoints
     -- blank wallShader
     putStrLn "Setup floor VBO, shader"
-    let floorverxstrd = 8
-    floorvbo <- setupVBOStatic (floatSize * floorverxstrd)
-    floorshader <- makeShaderUsingVBO "floor/arrayPos" [vert, frag] (toFloatVAs [4, 4]) pmTriangles floorvbo
+    flvbo <- mglCreate glCreateBuffers
+    flptr <- mallocArray (8 * 65536)
+    let floorvbo = VBO flvbo flptr (8 * floatSize)
+    floorshader <- makeSourcedShader "floor/arrayPos" [vert, frag]
     initTexture2DArraySquare 40 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR "data/normalMaps/diffuseArray.png"
     initTexture2DArraySquare 41 3 GL_LINEAR_MIPMAP_LINEAR GL_LINEAR "data/normalMaps/normalArray.png"
 
     putStrLn "Setup chasm VBO, shader"
     chvbo <- mglCreate glCreateBuffers
     chptr <- mallocArray (2 * 65536)
-    let chasmvbo = VBO chvbo chptr floatSize
+    let chasmvbo = VBO chvbo chptr (2 * floatSize)
     chasmshader <- makeSourcedShader "chasm" [vert]
     framebuf2 <- newTextureFramebuffer
     framebuf3 <- newTextureFramebuffer

src/Shader/Poke/Floor.hs

@@ -23,7 +23,7 @@ pokeTileVerx tangent tilez ptr i (V2 x y, V2 s t) = do
     return $ i + 1
 
 pokeChasm :: Ptr Float -> Int -> [Point2] -> IO Int
-pokeChasm ptr i ps = foldM (pokeChasmVerx ptr) i $ polyToTris ps
+pokeChasm ptr i = foldM (pokeChasmVerx ptr) i . polyToTris
 
 pokeChasmVerx :: Ptr Float -> Int -> Point2 -> IO Int
 pokeChasmVerx ptr i p = do