From 4c9a3c8b3c3fa01b7e325d5280f2a75977b998e9 Mon Sep 17 00:00:00 2001 From: jgk Date: Thu, 12 Aug 2021 05:49:25 +0200 Subject: [PATCH] Continue adding mutability --- appDodge/Main.hs | 6 +++++- src/Dodge/Render.hs | 23 ++++++++++++---------- src/Render.hs | 47 ++++++++++++++++++++++++++++----------------- src/Shader.hs | 1 - 4 files changed, 47 insertions(+), 30 deletions(-) diff --git a/appDodge/Main.hs b/appDodge/Main.hs index 36cb9a8e5..63b35f8cc 100644 --- a/appDodge/Main.hs +++ b/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) diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs index 8a56f1047..12b7aaa72 100644 --- a/src/Dodge/Render.hs +++ b/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 4 shads vnums - renderLayer 5 shads vnums + renderLayer' 3 shadV layerCounts + renderLayer' 4 shadV layerCounts + 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 diff --git a/src/Render.hs b/src/Render.hs index af6fa2c98..4294fb3ce 100644 --- a/src/Render.hs +++ b/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 - shadV <- picShadToMV shads +pokeBindFoldable shadV counts m = do 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 - let shads = _pictureShaders pdata - shadV <- picShadToMV shads - counts <- UMV.replicate (6*6) 0 +pokeBindFoldableLayer shadV counts m = do 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 - s <- picShadToMV shads - MV.imapM_ (drawShaderLay' 0 counts) s - --sequence_ (drawShaderLay 0 <$> shads <*> count) + pokeBindFoldable shadV counts struct + MV.imapM_ (drawShaderLay' 0 counts) shadV 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 diff --git a/src/Shader.hs b/src/Shader.hs index f3576b9c9..6452474fc 100644 --- a/src/Shader.hs +++ b/src/Shader.hs @@ -112,4 +112,3 @@ freeShaderPointers fs = free $ _vboPtr $ _vaoVBO $ _shaderVAO fs shadVBOptr :: FullShader -> Ptr Float shadVBOptr = _vboPtr . _vaoVBO . _shaderVAO -