Revert "Continue transfer to mutable vectors"

This reverts commit 1f2f5431c0.

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)

src/Dodge/Render.hs

@@ -76,12 +76,10 @@ doDrawing pdata w = do
         then renderTextureWalls pdata nWalls
         else renderBlankWalls pdata nWalls
 
-    let shads = _pictureShaders pdata
+    _ <- renderFoldable pdata $ polysToPic $ foregroundPics w
-    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)
@@ -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

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
+    :: PicShads VShader
-    -> UMV.MVector (PrimState IO) Int
     -> [Verx]
-    -> IO ()
+    -> IO (PicShads Int)
-pokeBindFoldable shads counts m = do
+pokeBindFoldable shads m = do
-    pokeVerxs shads counts m
+    counts <- UMV.replicate 6 0
-    bindShader shads counts
+    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
+    let shads = _pictureShaders pdata
-    pokeBindFoldable shads counts struct
+    count <- pokeBindFoldable shads struct
-    MV.imapM_ (drawShaderLay' 0 counts) shads
+    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 

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

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 
+    :: 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