Move towards uploading certain vbos less than once per frame (floor)

src/Data/Preload/Render.hs

@@ -56,6 +56,8 @@ data RenderData = RenderData
     , _vboWalls :: VBO
     , _vboWindows :: VBO
     , _vboShapes :: VBO
+    , _floorVBO :: VBO
+    , _floorShader :: FullShader
     , _toNormalMaps :: TO
     }
 

src/Dodge/Data/World.hs

@@ -48,6 +48,7 @@ data World = World
     , _pnZoning :: IntMap (IntMap [(Int, Point2)]) --Zoning IM.IntMap Creature
     , _peZoning :: IntMap (IntMap (Set PathEdgeNodes))
     , _gsZoning :: IntMap (IntMap IntSet)
+    , _numberFloorVerxs :: Int
     }
 
 --    deriving (Eq, Ord, Show, Read) --Generic, Flat)

src/Dodge/Default/World.hs

@@ -48,6 +48,7 @@ defaultWorld =
         , _pnZoning = mempty
         , _peZoning = mempty
         , _gsZoning = mempty --Zoning IM.empty clZoneSize (zonePos _guPos)
+        , _numberFloorVerxs = 0
         }
 
 defaultCWGen :: CWGen

src/Dodge/LevelGen.hs

@@ -24,14 +24,14 @@ generateWorldFromSeed i = do
     writeFile "log/aGeneratedRoomLayout" ""
     generateGraphs
     (roomList, bounds) <- layoutLevelFromSeed 0 i
-    return $!
-        postGenerationProcessing $!
+    postGenerationProcessing $!
             _gwWorld (generateLevelFromRoomList roomList initialWorld{_randGen = mkStdGen i})
                 & cWorld . cwGen . cwgRoomClipping .~ bounds
                 & cWorld . cwGen . cwgSeed .~ i
 
-postGenerationProcessing :: World -> World
-postGenerationProcessing w = foldl' assignPushDoors w (w ^. cWorld . lWorld . doors)
+postGenerationProcessing :: World -> IO World
+postGenerationProcessing w =
+    return $ foldl' assignPushDoors w (w ^. cWorld . lWorld . doors)
 
 generateGraphs :: IO ()
 generateGraphs = TIO.writeFile "graph/itemCombinations.gv" combinationsDotGraph

src/Dodge/StartNewGame.hs

@@ -3,6 +3,9 @@ module Dodge.StartNewGame (
     startSeedGame,
 ) where
 
+import Data.Preload.Render
+import Shader.Data
+import Shader.Poke -- it would be very nice to remove/rework the poking dependencies
 import Dodge.Menu.Loading
 import Dodge.Concurrent
 --import Dodge.Menu.Option
@@ -23,11 +26,14 @@ blockingLoad str f u = u & uvScreenLayers .:~ loadingScreen str
     & addSideEffect f str
 
 startSeedGame :: Int -> Int -> Universe -> Universe
-startSeedGame _ i = blockingLoad "LOADING" (startSeedGameConc i)
+startSeedGame _ i u = blockingLoad "LOADING" (startSeedGameConc i $ u ^. preloadData) u
 
-startSeedGameConc :: Int -> IO (Universe -> Maybe Universe)
-startSeedGameConc seed = do
-    w <- generateWorldFromSeed seed
+startSeedGameConc :: Int -> PreloadData -> IO (Universe -> Maybe Universe)
+startSeedGameConc seed pdata = do
+    w' <- generateWorldFromSeed seed
+    nfloorvxs <- pokeFloors (pdata ^?! renderData . textureArrayShader . _2 . vboPtr)
+        (w' ^. cWorld . floorTiles)
+    let w = w' & numberFloorVerxs .~ nfloorvxs
     writeFile "saveSlot/seed" $ show seed
     return $ Just
         . saveWorldInSlot (LevelStartSlot 0)

src/Preload/Render.hs

@@ -170,6 +170,9 @@ preloadRender = do
     textArrayShad <-
         makeShader "texture/arrayPos" [vert, frag] [3, 3] ETriangles
             >>= addTextureArray "data/texture/ayene_wooden_floor_transformed.png"
+    let floorverxstrd = 8
+    vbofloor <- setupVBO floorverxstrd
+    floorshader <- makeShader4 "floor/arrayPos" [vert, frag] [4,4] floorverxstrd ETriangles vbofloor
     -- bind fixed vertex data
     bufferPokedVBO (snd fsShad) 4
     framebuf2 <- setupTextureFramebuffer 800 600
@@ -254,6 +257,8 @@ preloadRender = do
             , _vboWalls = wpVBO
             , _vboWindows = winVBO
             , _vboShapes = shVBO
+            , _floorVBO = vbofloor
+            , _floorShader = floorshader
             , _toNormalMaps = tonormalmap
             }
 

src/Shader/Poke.hs

@@ -5,6 +5,7 @@ module Shader.Poke (
     pokeShape,
     pokeWallsWindowsFloor,
     memoTopPrismEdgeIndices,
+    pokeFloors
 ) where
 
 import Control.Monad.Primitive
@@ -54,6 +55,11 @@ pokeWallsWindowsFloor wlptr wiptr flptr wls wis fls = do
     flcounts <- VFSM.foldlM' (pokeF flptr) 0 (VFSM.fromList fls)
     return (wlcounts1, wlcounts2, flcounts)
 
+pokeFloors :: Ptr Float ->
+    [(Point3, Point3)] ->
+    IO Int
+pokeFloors flptr fls = VFSM.foldlM' (pokeF flptr) 0 (VFSM.fromList fls)
+
 pokeF :: Ptr Float -> Int -> (Point3, Point3) -> IO Int
 pokeF ptr i' (V3 a b c, V3 d e f) = do
     let i = i' * 6