From 1f2f5431c05a965e5cd131b698e2c578c03462d3 Mon Sep 17 00:00:00 2001 From: jgk Date: Wed, 11 Aug 2021 22:02:17 +0200 Subject: [PATCH] Continue transfer to mutable vectors --- appDodge/Main.hs | 5 ++++- src/Dodge/Render.hs | 8 +++++--- src/Render.hs | 40 +++++++++++++++++++++++----------------- src/Shader.hs | 8 ++++---- src/Shader/Poke.hs | 33 ++++++++++++++------------------- 5 files changed, 50 insertions(+), 44 deletions(-) diff --git a/appDodge/Main.hs b/appDodge/Main.hs index 36cb9a8e5..f35882312 100644 --- a/appDodge/Main.hs +++ b/appDodge/Main.hs @@ -12,6 +12,7 @@ import Dodge.Config.Load import Dodge.Config.Update import Dodge.SoundLogic.LoadSound import Dodge.Debug.Flag.Data +import Data.Preload.Render import Picture import Render import Preload.Render @@ -20,6 +21,7 @@ import Preload import Sound.Data import Music import Data.Preload +import Shader.Poke import Control.Lens --import Foreign (Word32) @@ -54,8 +56,9 @@ doSideEffects preData w = do endTicks <- SDL.ticks let lastFrameTicks = _frameTimer preData + shads <- picShadToMV $ _pictureShaders $ _renderData preData when (_displaySecondsPerFrame $ _debugFlags w) $ void $ renderFoldable - (_renderData preData) + shads (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..fa2235036 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -76,10 +76,12 @@ doDrawing pdata w = do then renderTextureWalls pdata nWalls else renderBlankWalls pdata nWalls - _ <- renderFoldable pdata $ polysToPic $ foregroundPics w + let shads = _pictureShaders pdata + vShads <- picShadToMV shads + + _ <- renderFoldable vShads $ polysToPic $ foregroundPics w vnums <- pokeBindFoldableLayer pdata $ worldPictures w - let shads = _pictureShaders pdata renderLayer 0 shads vnums nTextArrayVs <- pokePoint33s (shadVBOptr $ _textureArrayShader pdata) (_floorTiles w) @@ -174,7 +176,7 @@ doDrawing pdata w = do blend $= Enabled blendFunc $= (SrcAlpha,OneMinusSrcAlpha) - _ <- renderFoldable pdata $ fixedCoordPictures w + _ <- renderFoldable vShads $ fixedCoordPictures w depthMask $= Enabled eTicks <- SDL.ticks diff --git a/src/Render.hs b/src/Render.hs index 1df7c37ed..e28f277d9 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -26,6 +26,7 @@ import qualified Data.IntMap.Strict as IM import qualified SDL import qualified Data.Vector.Unboxed.Mutable as UMV import qualified Data.Vector.Mutable as MV +import Control.Monad.Primitive divideSize :: Int -> Size -> Size divideSize i (Size x y) = Size (div x $ fromIntegral i) (div y $ fromIntegral i) @@ -145,16 +146,13 @@ drawTextureOnFramebuffer fs fbo to = do drawShader fs 4 pokeBindFoldable - :: PicShads VShader + :: MV.MVector (PrimState IO) VShader + -> UMV.MVector (PrimState IO) Int -> [Verx] - -> IO (PicShads Int) -pokeBindFoldable shads m = do - counts <- UMV.replicate 6 0 - pokeVerxs (fmap (_vaoVBO . _vshaderVAO) shads) counts m - shads' <- picShadToMV shads - bindShader shads' counts - elist <- vToPicShad counts - return elist + -> IO () +pokeBindFoldable shads counts m = do + pokeVerxs shads counts m + bindShader shads counts zeroCounts :: PicShads Int zeroCounts = PicShads 0 0 0 0 0 0 @@ -170,17 +168,14 @@ pokeBindFoldableLayer pdata m = do return slist'' renderFoldable - :: RenderData + :: MV.MVector (PrimState IO) VShader -> [Verx] -> IO Word32 -renderFoldable pdata struct = do +renderFoldable shads struct = do pokeStartTicks <- SDL.ticks - let shads = _pictureShaders pdata - count <- pokeBindFoldable shads struct - s <- picShadToMV shads - c <- picShadToUMV count - MV.imapM_ (drawShaderLay' 0 c) s - --sequence_ (drawShaderLay 0 <$> shads <*> count) + counts <- UMV.replicate 6 0 + pokeBindFoldable shads counts struct + MV.imapM_ (drawShaderLay' 0 counts) shads pokeEndTicks <- SDL.ticks return $ pokeEndTicks - pokeStartTicks ------------------------------end renderFoldable @@ -188,6 +183,17 @@ renderFoldable pdata struct = do renderLayer :: Int -> PicShads VShader -> IM.IntMap (PicShads Int) -> IO () renderLayer i shads counts = sequence_ $ drawShaderLay i <$> shads <*> counts IM.! i +renderLayer' + :: Int + -> MV.MVector (PrimState IO) VShader + -> IM.IntMap (UMV.MVector (PrimState IO) Int) + -> IO () +renderLayer' theLayer shads counts = MV.imapM_ f shads + where + layCounts = counts IM.! theLayer + f shadIndex theShader = UMV.read layCounts shadIndex >>= drawShaderLay theLayer theShader + --undefined -- sequence_ $ drawShaderLay i <$> shads <*> counts IM.! i + pokeTwoOff :: Ptr Float -> Int diff --git a/src/Shader.hs b/src/Shader.hs index 56fd38c37..d73494028 100644 --- a/src/Shader.hs +++ b/src/Shader.hs @@ -12,7 +12,7 @@ module Shader import Shader.Data import Shader.Parameters import Shader.ExtraPrimitive -import Shader.Poke +--import Shader.Poke --import Layers --import MatrixHelper @@ -82,15 +82,15 @@ drawShaderLay l fs i = do drawShaderLay' :: Int -> UMV.MVector (PrimState IO) Int -> Int -> VShader -> IO () {-# INLINE drawShaderLay' #-} -drawShaderLay' l countsVector index fs = do - i <- UMV.read countsVector index +drawShaderLay' theLayer shaderOffsetsVector shaderIndex fs = do + i <- UMV.read shaderOffsetsVector shaderIndex currentProgram $= Just (_vshaderProgram fs) bindVertexArrayObject $= Just (_vao $ _vshaderVAO fs) case _vshaderTexture fs of Just ShaderTexture{_textureObject = txo} -> textureBinding Texture2D $= Just txo _ -> return () - glDrawArrays (marshalEPrimitiveMode $ _vshaderDrawPrimitive fs) (fromIntegral $ l*numSubElements) (fromIntegral i) + glDrawArrays (marshalEPrimitiveMode $ _vshaderDrawPrimitive fs) (fromIntegral $ theLayer*numSubElements) (fromIntegral i) drawShader :: FullShader -> Int -> IO () {-# INLINE drawShader #-} diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index f94516a44..05d9bf8b1 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -31,14 +31,22 @@ import qualified Data.Vector.Mutable as MV import qualified Data.Vector.Fusion.Stream.Monadic as VS import Control.Monad.Primitive -pokeVerxs - :: PicShads VBO +--pokeVerxs +-- :: PicShads VBO +-- -> UMV.MVector (PrimState IO) Int +-- -> [Verx] +-- -> IO () +--pokeVerxs vbos count vxs = do +-- s <- picShadToMV vbos +-- VS.mapM_ (pokeVerx s count) $ VS.fromList vxs + +pokeVerxs + :: MV.MVector (PrimState IO) VShader -> UMV.MVector (PrimState IO) Int -> [Verx] -> IO () pokeVerxs vbos count vxs = do - s <- picShadToMV vbos - VS.mapM_ (pokeVerx' s count) $ VS.fromList vxs + VS.mapM_ (pokeVerx vbos count) $ VS.fromList vxs vToPicShad :: UMV.MVector (PrimState IO) Int -> IO (PicShads Int) {-# INLINE vToPicShad #-} @@ -71,23 +79,10 @@ picShadToMV (PicShads a b c d e f) = do MV.write theVec 5 f return theVec - - -pokeVerx :: PicShads VBO -> UMV.MVector (PrimState IO) Int -> Verx -> IO () ---{-# INLINE pokeVerx #-} +pokeVerx :: MV.MVector (PrimState IO) VShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO () pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=theShadNum} = do typeOff <- UMV.unsafeRead offsets sn - let thePtr = plusPtr (_vboPtr $ vboFromType vbos sn) (typeOff * pokeStride sn * floatSize) - poke34 thePtr thePos theCol - pokeArrayOff thePtr 7 ext - UMV.unsafeModify offsets (+1) sn - where - sn = _unShadNum theShadNum - -pokeVerx' :: MV.MVector (PrimState IO) VBO -> UMV.MVector (PrimState IO) Int -> Verx -> IO () -pokeVerx' vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=theShadNum} = do - typeOff <- UMV.unsafeRead offsets sn - theShad <- MV.read vbos sn + theShad <- fmap (_vaoVBO . _vshaderVAO) $ MV.read vbos sn let thePtr = plusPtr (_vboPtr theShad) (typeOff * pokeStride sn * floatSize) poke34 thePtr thePos theCol pokeArrayOff thePtr 7 ext