diff --git a/appDodge/Main.hs b/appDodge/Main.hs index f35882312..36cb9a8e5 100644 --- a/appDodge/Main.hs +++ b/appDodge/Main.hs @@ -12,7 +12,6 @@ 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 @@ -21,7 +20,6 @@ import Preload import Sound.Data import Music import Data.Preload -import Shader.Poke import Control.Lens --import Foreign (Word32) @@ -56,9 +54,8 @@ doSideEffects preData w = do endTicks <- SDL.ticks let lastFrameTicks = _frameTimer preData - shads <- picShadToMV $ _pictureShaders $ _renderData preData when (_displaySecondsPerFrame $ _debugFlags w) $ void $ renderFoldable - shads + (_renderData preData) (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 fa2235036..8a56f1047 100644 --- a/src/Dodge/Render.hs +++ b/src/Dodge/Render.hs @@ -76,12 +76,10 @@ doDrawing pdata w = do then renderTextureWalls pdata nWalls else renderBlankWalls pdata nWalls - let shads = _pictureShaders pdata - vShads <- picShadToMV shads - - _ <- renderFoldable vShads $ polysToPic $ foregroundPics w + _ <- renderFoldable pdata $ polysToPic $ foregroundPics w vnums <- pokeBindFoldableLayer pdata $ worldPictures w + let shads = _pictureShaders pdata renderLayer 0 shads vnums nTextArrayVs <- pokePoint33s (shadVBOptr $ _textureArrayShader pdata) (_floorTiles w) @@ -176,7 +174,7 @@ doDrawing pdata w = do blend $= Enabled blendFunc $= (SrcAlpha,OneMinusSrcAlpha) - _ <- renderFoldable vShads $ fixedCoordPictures w + _ <- renderFoldable pdata $ fixedCoordPictures w depthMask $= Enabled eTicks <- SDL.ticks diff --git a/src/Render.hs b/src/Render.hs index e28f277d9..1df7c37ed 100644 --- a/src/Render.hs +++ b/src/Render.hs @@ -26,7 +26,6 @@ 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) @@ -146,13 +145,16 @@ drawTextureOnFramebuffer fs fbo to = do drawShader fs 4 pokeBindFoldable - :: MV.MVector (PrimState IO) VShader - -> UMV.MVector (PrimState IO) Int + :: PicShads VShader -> [Verx] - -> IO () -pokeBindFoldable shads counts m = do - pokeVerxs shads counts m - bindShader shads counts + -> 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 zeroCounts :: PicShads Int zeroCounts = PicShads 0 0 0 0 0 0 @@ -168,14 +170,17 @@ pokeBindFoldableLayer pdata m = do return slist'' renderFoldable - :: MV.MVector (PrimState IO) VShader + :: RenderData -> [Verx] -> IO Word32 -renderFoldable shads struct = do +renderFoldable pdata struct = do pokeStartTicks <- SDL.ticks - counts <- UMV.replicate 6 0 - pokeBindFoldable shads counts struct - MV.imapM_ (drawShaderLay' 0 counts) shads + 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) pokeEndTicks <- SDL.ticks return $ pokeEndTicks - pokeStartTicks ------------------------------end renderFoldable @@ -183,17 +188,6 @@ renderFoldable shads 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 d73494028..56fd38c37 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' theLayer shaderOffsetsVector shaderIndex fs = do - i <- UMV.read shaderOffsetsVector shaderIndex +drawShaderLay' l countsVector index fs = do + i <- UMV.read countsVector index 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 $ theLayer*numSubElements) (fromIntegral i) + glDrawArrays (marshalEPrimitiveMode $ _vshaderDrawPrimitive fs) (fromIntegral $ l*numSubElements) (fromIntegral i) drawShader :: FullShader -> Int -> IO () {-# INLINE drawShader #-} diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index 05d9bf8b1..f94516a44 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -31,22 +31,14 @@ import qualified Data.Vector.Mutable as MV import qualified Data.Vector.Fusion.Stream.Monadic as VS import Control.Monad.Primitive ---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 +pokeVerxs + :: PicShads VBO -> UMV.MVector (PrimState IO) Int -> [Verx] -> IO () pokeVerxs vbos count vxs = do - VS.mapM_ (pokeVerx vbos count) $ VS.fromList vxs + s <- picShadToMV vbos + VS.mapM_ (pokeVerx' s count) $ VS.fromList vxs vToPicShad :: UMV.MVector (PrimState IO) Int -> IO (PicShads Int) {-# INLINE vToPicShad #-} @@ -79,10 +71,23 @@ picShadToMV (PicShads a b c d e f) = do MV.write theVec 5 f return theVec -pokeVerx :: MV.MVector (PrimState IO) VShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO () + + +pokeVerx :: PicShads VBO -> UMV.MVector (PrimState IO) Int -> Verx -> IO () +--{-# INLINE pokeVerx #-} pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=theShadNum} = do typeOff <- UMV.unsafeRead offsets sn - theShad <- fmap (_vaoVBO . _vshaderVAO) $ MV.read vbos 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 let thePtr = plusPtr (_vboPtr theShad) (typeOff * pokeStride sn * floatSize) poke34 thePtr thePos theCol pokeArrayOff thePtr 7 ext