Continue adding mutability

appDodge/Main.hs

@@ -20,6 +20,8 @@ import Preload
 import Sound.Data
 import Music
 import Data.Preload
+import Data.Preload.Render
+import Shader.Poke
 
 import Control.Lens
 --import Foreign (Word32)
@@ -54,8 +56,10 @@ doSideEffects preData w = do
     
     endTicks <- SDL.ticks
     let lastFrameTicks = _frameTimer preData
+    
+    shadV <- picShadToMV $ _pictureShaders $ (_renderData preData)
     when (_displaySecondsPerFrame $ _debugFlags w) $ void $ renderFoldable
-                (_renderData preData)
+                shadV
                 (setDepth (-1)
                     . translate (-0.5) (-0.8) . scale 0.0005 0.0005
                     . text $ "ms/frame " ++ show (endTicks - lastFrameTicks)

src/Dodge/Render.hs

@@ -38,6 +38,7 @@ import Control.Monad
 --import qualified Data.Set as S
 import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
 import qualified SDL
+import qualified Data.Vector.Unboxed.Mutable as UMV
 
 doDrawing :: RenderData -> World -> IO Word32
 doDrawing pdata w = do
@@ -76,11 +77,13 @@ doDrawing pdata w = do
         then renderTextureWalls pdata nWalls
         else renderBlankWalls pdata nWalls
 
-    _ <- renderFoldable pdata $ polysToPic $ foregroundPics w
-
-    vnums <- pokeBindFoldableLayer pdata $ worldPictures w
     let shads = _pictureShaders pdata
-    renderLayer 0 shads vnums
+    shadV <- picShadToMV $ _pictureShaders pdata
+    renderFoldable shadV $ polysToPic $ foregroundPics w
+
+    layerCounts <- UMV.replicate (6*6) 0
+    vnums <- pokeBindFoldableLayer shadV layerCounts $ worldPictures w
+    renderLayer' 0 shadV layerCounts
 
     nTextArrayVs <- pokePoint33s (shadVBOptr $ _textureArrayShader pdata) (_floorTiles w)
     bindShaderBuffers [_textureArrayShader pdata] [nTextArrayVs]
@@ -90,14 +93,14 @@ doDrawing pdata w = do
     clear [ColorBuffer]
     blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
 
-    renderLayer 1 shads vnums
+    renderLayer' 1 shadV layerCounts
     bindFramebuffer Framebuffer $= fst (_fboColor pdata)
     clear [ColorBuffer]
     depthMask $= Disabled
 
-    renderLayer 3 shads vnums
+    renderLayer' 3 shadV layerCounts
-    renderLayer 4 shads vnums
+    renderLayer' 4 shadV layerCounts
-    renderLayer 5 shads vnums
+    renderLayer' 5 shadV layerCounts
 
     depthMask $= Enabled
     bindFramebuffer Framebuffer $= fst (_fboFourth1 pdata)
@@ -141,7 +144,7 @@ doDrawing pdata w = do
 
     depthFunc $= Just Lequal
     --mapM_ (uncurry $ drawShaderLay 2) (vnums IM.! 2)
-    renderLayer 2 shads vnums
+    renderLayer' 2 shadV layerCounts
     renderWindows pdata windowPoints
 
     depthFunc $= Just Always
@@ -174,7 +177,7 @@ doDrawing pdata w = do
     blend $= Enabled
     blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
 
-    _ <- renderFoldable pdata $ fixedCoordPictures w
+    renderFoldable shadV $ fixedCoordPictures w
     depthMask $= Enabled
 
     eTicks <- SDL.ticks

src/Render.hs

@@ -146,50 +146,61 @@ drawTextureOnFramebuffer fs fbo to = do
     drawShader fs 4
 
 pokeBindFoldable
-    :: PicShads VShader
+    :: MV.MVector (PrimState IO) VShader
     -> UMV.MVector (PrimState IO) Int
     -> [Verx]
     -> IO ()
-pokeBindFoldable shads counts m = do
+pokeBindFoldable shadV counts m = do
-    shadV <- picShadToMV shads
     pokeVerxs shadV counts m
     bindShader shadV counts
-    --elist <- vToPicShad counts
-    --return elist
 
 zeroCounts :: PicShads Int
 zeroCounts = PicShads 0 0 0 0 0 0
 
 pokeBindFoldableLayer
-    :: RenderData
+    :: MV.MVector (PrimState IO) VShader
+    -> UMV.MVector (PrimState IO) Int
     -> Picture
     -> IO (IM.IntMap (PicShads Int))
-pokeBindFoldableLayer pdata m = do
+pokeBindFoldableLayer shadV counts m = do
-    let shads = _pictureShaders pdata
-    shadV <- picShadToMV shads
-    counts <- UMV.replicate (6*6) 0
     slist'' <- pokeLayVerxs shadV counts m
     bindShaderLayers shadV counts
     return slist''
 
 renderFoldable
-    :: RenderData
+    :: MV.MVector (PrimState IO) VShader
+    -> [Verx]
+    -> IO ()
+renderFoldable shadV struct = do
+    counts <- UMV.replicate 6 0
+    pokeBindFoldable shadV counts struct
+    MV.imapM_ (drawShaderLay' 0 counts) shadV
+
+renderFoldableTimed
+    :: MV.MVector (PrimState IO) VShader
     -> [Verx]
     -> IO Word32
-renderFoldable pdata struct = do
+renderFoldableTimed shadV struct = do
     pokeStartTicks <- SDL.ticks
-    let shads = _pictureShaders pdata
     counts <- UMV.replicate 6 0
-    pokeBindFoldable shads counts struct
+    pokeBindFoldable shadV counts struct
-    s <- picShadToMV shads
+    MV.imapM_ (drawShaderLay' 0 counts) shadV
-    MV.imapM_ (drawShaderLay' 0 counts) s
-    --sequence_ (drawShaderLay 0 <$> shads <*> count)
     pokeEndTicks <- SDL.ticks
     return $ pokeEndTicks - pokeStartTicks
 ------------------------------end renderFoldable
 
 renderLayer :: Int -> PicShads VShader -> IM.IntMap (PicShads Int) -> IO ()
-renderLayer i shads counts = sequence_ $ drawShaderLay i <$> shads <*> counts IM.! i
+renderLayer layer shads counts = sequence_ $ drawShaderLay layer <$> shads <*> counts IM.! layer
+
+renderLayer' 
+    :: Int 
+    -> MV.MVector (PrimState IO) VShader
+    -> UMV.MVector (PrimState IO) Int
+    -> IO ()
+renderLayer' layer shads counts = do
+    let layerCounts = UMV.slice (layer * 6) 6 counts
+    MV.imapM_ (drawShaderLay' layer layerCounts) shads
+    -- sequence_ $ drawShaderLay layer <$> shads <*> counts IM.! layer
 
 pokeTwoOff 
     :: Ptr Float 

src/Shader.hs

@@ -112,4 +112,3 @@ freeShaderPointers fs = free $ _vboPtr $ _vaoVBO $ _shaderVAO fs
 
 shadVBOptr :: FullShader -> Ptr Float
 shadVBOptr = _vboPtr . _vaoVBO . _shaderVAO
-