Continue transfer to mutable vectors

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)

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

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)
+    -> IO ()
-pokeBindFoldable shads m = do
+pokeBindFoldable shads counts m = do
-    counts <- UMV.replicate 6 0
+    pokeVerxs shads counts m
-    pokeVerxs (fmap (_vaoVBO . _vshaderVAO) shads) counts m
+    bindShader shads counts
-    shads' <- picShadToMV shads
-    bindShader shads' counts
-    elist <- vToPicShad counts
-    return elist
 
 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
+    counts <- UMV.replicate 6 0
-    count <- pokeBindFoldable shads struct
+    pokeBindFoldable shads counts struct
-    s <- picShadToMV shads
+    MV.imapM_ (drawShaderLay' 0 counts) shads
-    c <- picShadToUMV count
-    MV.imapM_ (drawShaderLay' 0 c) s
-    --sequence_ (drawShaderLay 0 <$> shads <*> count)
     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 

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 
+drawShaderLay' theLayer shaderOffsetsVector shaderIndex fs = do 
-    i <- UMV.read countsVector index
+    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 #-}

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 
+--pokeVerxs 
-    :: PicShads VBO 
+--    :: 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 vbos count) $ VS.fromList vxs
-    VS.mapM_ (pokeVerx' s 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 :: 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
-    let thePtr = plusPtr (_vboPtr $ vboFromType vbos sn) (typeOff * pokeStride sn * floatSize)
+    theShad <- fmap (_vaoVBO . _vshaderVAO) $ MV.read vbos sn
-    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