Fix resetting of immutable chasm/floor data storage on new world load

src/Dodge/Render.hs

@@ -44,7 +44,6 @@ doTestDrawing _ _ = do
 doDrawing' :: SDL.Window -> RenderData -> Universe -> IO ()
 doDrawing' win pdata u = do
     --sTicks <- SDL.ticks
-    checkGLError "during drawing"
     let w = _uvWorld u
         cfig = _uvConfig u
         (windowPoints, wallSPics, wallsToPoke) = wallsToDraw w
@@ -383,6 +382,7 @@ doDrawing' win pdata u = do
     glDepthMask GL_TRUE
     with (-1) $ glClearNamedFramebufferfv 0 GL_DEPTH 0
     renderLayer FixedCoordLayer shadV pokeCounts
+    checkGLError "during doDrawing'"
     SDL.glSwapWindow win
 
 rdToVec2s :: Distortion -> [Point2]

src/Dodge/Render/ShapePicture.hs

@@ -57,7 +57,7 @@ drawCliff x y =
     noPic
         . translateSHz (-500.01)
         . colorSH (dark orange)
-        $ upperPrismPoly Large Important 500 
+        $ upperPrismPoly Large Superfluous 500 
             [x, 0.5 * (x + y) + normalizeV (vNormal (y - x)), y]
 
 drawPulseBall :: PulseBall -> SPic

src/Dodge/Room/Tutorial.hs

@@ -48,31 +48,6 @@ tutAnoTree = do
     foldMTRS
         [ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
         , corDoor
-        , return . tToBTree "asdf" . return . cleatOnward $ airlockCrystal
---        , tToBTree "x" . return . cleatOnward <$> airlockSimple
---        , tToBTree "lastun" . return . cleatOnward <$> tanksRoom [] []
-        , return $ tToBTree "cor" $ return $ cleatOnward corridor
---        , return $ tToBTree "cor" $ return $ cleatOnward corridor
---        , tToBTree "lastun" . return . cleatOnward <$> cenLasTur
---        , return $ tToBTree "cor" $ return $ cleatOnward corridor
---        , return $ tToBTree "cor" $ return $ cleatOnward corridor
---        , return $ tToBTree "cor" $ return $ cleatOnward corridor
---        , return $ tToBTree "cor" $ return $ cleatOnward airlockSimple
---        , return $ tToBTree "cor" $ return $ cleatOnward corridor
---        , return $ tToBTree "cor" $ return $ cleatOnward corridor
---        , return $ tToBTree "cor" $ return $ cleatOnward corridor
---        , return $ tToBTree "cor" $ return $ cleatOnward corridor
---        , return $ tToBTree "cor" $ return $ cleatOnward corridor
---        , return $ tToBTree "cor" $ return $ cleatOnward corridor
---        , tToBTree "asdf" . return . cleatOnward <$> airlockZ
---        , return $ tToBTree "cor" $ return $ cleatOnward corridor
---        , return $ tToBTree "cor" $ return $ cleatOnward corridor
-        , tToBTree "t" . return . cleatOnward <$> slowDoorRoom
-        , return $ tToBTree "cor" $ return $ cleatOnward corridor
-        , return $ tToBTree "cor" $ return $ cleatOnward corridor
-        , return $ tToBTree "cor" $ return $ cleatOnward corridor
-        , corDoor
-        , return $ tToBTree "cor" $ return $ cleatOnward corridor
         , tutHub
         , tutLight
         , tutDrop

src/Dodge/WorldLoad.hs

@@ -1,5 +1,6 @@
 module Dodge.WorldLoad (postUniverseLoadSideEffect) where
 
+import GLHelp
 import Control.Lens
 import Control.Monad
 import Data.Preload.Render
@@ -8,26 +9,32 @@ import Graphics.GL.Core45
 import Shader.Data
 import Shader.Parameters
 import Shader.Poke.Floor
+import Foreign.Marshal
 
 postUniverseLoadSideEffect :: Universe -> Universe
 postUniverseLoadSideEffect =
     uvIOEffects
-        %~ (\f uv -> (uvWorld . cWorld) (postWorldLoad (uv ^. preloadData . renderData)) uv >>= f)
+        %~ (\f uv -> (postWorldLoad (uv ^. preloadData . renderData) uv) >>= f)
 
-postWorldLoad :: RenderData -> CWorld -> IO CWorld
+postWorldLoad :: RenderData -> Universe -> IO Universe
 postWorldLoad rdata cw = do
     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
+        chbo = rdata ^. chasmVBO . vboName
         chptr = rdata ^. chasmVBO . vboPtr
-    nchasmvxs <- foldM (pokeChasm chptr) 0 (cw ^. chasms)
+    glInvalidateBufferData floorbo
     glInvalidateBufferData chbo
-    glNamedBufferStorage chbo (fromIntegral $ 2 * nchasmvxs * floatSize) chptr 0
-    glBindBufferBase GL_SHADER_STORAGE_BUFFER 7 chbo
+    withArray [floorbo,chbo] $ glDeleteBuffers 2
+    [newfloorbo,newchbo] <- glCreate glGenBuffers 2
+    nfloorvxs <- foldM (pokeTile floorptr) 0 (cw ^. uvWorld . cWorld . cwTiles)
+    glBindBufferBase GL_SHADER_STORAGE_BUFFER 8 newfloorbo
+    glNamedBufferStorage newfloorbo (fromIntegral $ 8 * nfloorvxs * floatSize) floorptr 0
+    nchasmvxs <- foldM (pokeChasm chptr) 0 (cw ^. uvWorld . cWorld . chasms)
+    glBindBufferBase GL_SHADER_STORAGE_BUFFER 7 newchbo
+    glNamedBufferStorage newchbo (fromIntegral $ 2 * nchasmvxs * floatSize) chptr 0
+    checkGLError "during postWorldLoad"
     return $
-        cw & numberFloorVerxs .~ nfloorvxs
-            & numberChasmVerxs .~ nchasmvxs
+        cw & uvWorld . cWorld . numberFloorVerxs .~ nfloorvxs
+            & uvWorld . cWorld . numberChasmVerxs .~ nchasmvxs
+            & preloadData . renderData . floorVBO . vboName .~ newfloorbo
+            & preloadData . renderData . chasmVBO . vboName .~ newchbo

src/GLHelp.hs

@@ -1,4 +1,4 @@
-module GLHelp (mglCreate,mglDelete,checkGLError) where
+module GLHelp (mglCreate,mglDelete,checkGLError,glCreate) where
 
 import Foreign.Marshal
 import Foreign.Ptr
@@ -8,6 +8,9 @@ import Graphics.GL.Core45
 mglCreate :: (GLsizei -> Ptr GLuint -> IO ()) -> IO GLuint
 mglCreate f = alloca $ \ptr -> f 1 ptr >> peek ptr
 
+glCreate :: (GLsizei -> Ptr GLuint -> IO ()) -> Int -> IO [GLuint]
+glCreate f n = alloca $ \ptr -> f (fromIntegral n) ptr >> peekArray n ptr
+
 mglDelete :: (GLsizei -> Ptr GLuint -> IO ()) -> GLuint -> IO ()
 mglDelete f i = with i $ f 1