Redo mutable changes

src/Dodge/Creature/Rationality.hs

@@ -54,7 +54,7 @@ followImpulses w (f,g) cr
         (f, cr) 
         (_crImpulse $ _crActionPlan cr)
   where
-    g' = snd $ next g
+    g' = snd $ genWord8 g
 
 followImpulse
     :: Creature

src/Render.hs

@@ -150,9 +150,9 @@ pokeBindFoldable
     -> IO (PicShads Int)
 pokeBindFoldable shads m = do
     counts <- UMV.replicate 6 0
-    pokeVerxs (fmap (_vaoVBO . _vshaderVAO) shads) counts m
+    shadV <- picShadToMV shads
-    shads' <- picShadToMV shads
+    pokeVerxs shadV counts m
-    bindShader shads' counts
+    bindShader shadV counts
     elist <- vToPicShad counts
     return elist
 
@@ -165,7 +165,8 @@ pokeBindFoldableLayer
     -> IO (IM.IntMap (PicShads Int))
 pokeBindFoldableLayer pdata m = do
     let shads = _pictureShaders pdata
-    slist'' <- pokeLayVerxs (fmap (_vaoVBO . _vshaderVAO) shads) m
+    shadV <- picShadToMV shads
+    slist'' <- pokeLayVerxs shadV m
     bindShaderLay shads slist''
     return slist''
 

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,8 +82,8 @@ drawShaderLay l fs i = do
 
 drawShaderLay' :: Int -> UMV.MVector (PrimState IO) Int -> Int -> VShader -> IO ()
 {-# INLINE drawShaderLay' #-}
-drawShaderLay' l countsVector index fs = do 
+drawShaderLay' l countsVector shadIn fs = do 
-    i <- UMV.read countsVector index
+    i <- UMV.read countsVector shadIn
     currentProgram $= Just (_vshaderProgram fs)
     bindVertexArrayObject $= Just (_vao $ _vshaderVAO fs)
     case _vshaderTexture fs of 

src/Shader/Poke.hs

@@ -32,13 +32,22 @@ import qualified Data.Vector.Fusion.Stream.Monadic as VS
 import Control.Monad.Primitive
 
 pokeVerxs 
-    :: PicShads VBO 
+    :: MV.MVector (PrimState IO) VShader
     -> UMV.MVector (PrimState IO) Int 
     -> [Verx] 
     -> IO ()
-pokeVerxs vbos count vxs = do
+pokeVerxs vbos count vxs = VS.mapM_ (pokeVerx vbos count) $ VS.fromList vxs
-    s <- picShadToMV vbos
+
-    VS.mapM_ (pokeVerx' s count) $ VS.fromList vxs
+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
+    basePtr <- fmap (_vboPtr . _vaoVBO . _vshaderVAO) $ MV.read vbos sn
+    let thePtr = plusPtr basePtr (typeOff * pokeStride sn * floatSize)
+    poke34 thePtr thePos theCol
+    pokeArrayOff thePtr 7 ext
+    UMV.unsafeModify offsets (+1) sn
+  where
+    sn = _unShadNum theShadNum
 
 vToPicShad :: UMV.MVector (PrimState IO) Int -> IO (PicShads Int)
 {-# INLINE vToPicShad #-}
@@ -59,6 +68,7 @@ picShadToUMV (PicShads a b c d e f) = do
     UMV.write theVec 4 e
     UMV.write theVec 5 f
     return theVec
+
 picShadToMV :: PicShads a -> IO (MV.MVector (PrimState IO) a)
 {-# INLINE picShadToMV #-}
 picShadToMV (PicShads a b c d e f) = do
@@ -72,29 +82,6 @@ picShadToMV (PicShads a b c d e f) = do
     return theVec
 
 
-
-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)
-    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
-    UMV.unsafeModify offsets (+1) sn
-  where
-    sn = _unShadNum theShadNum
-
 poke34 :: Ptr Float -> Point3 -> Point4 -> IO ()
 {-# INLINE poke34 #-}
 poke34 ptr (V3 a b c) (V4 d e f g) = do
@@ -137,23 +124,6 @@ pokePoint3s ptr vals0 = go vals0 0
       where
         off i = n*3 + i
 
-pokeLayVerx :: PicShads VBO -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
---{-# INLINE pokeLayVerx #-}
-pokeLayVerx vbos counts vx = do
-    theOff <- UMV.unsafeRead counts vecPos
-    let thePtr = plusPtr basePtr ((theOff + layOff) * theStride * floatSize)
-    poke34 thePtr thePos theCol
-    pokeArrayOff thePtr 7 (_vxExt vx)
-    UMV.unsafeModify counts (+ 1) vecPos
-  where
-    sn = _unShadNum (_vxShadNum vx)
-    vecPos = theLayer * 6 + sn
-    theLayer = _vxLayer vx
-    thePos = _vxPos vx
-    theCol = _vxCol vx
-    basePtr = _vboPtr $ vboFromType vbos sn
-    layOff = theLayer * numSubElements
-    theStride = pokeStride sn
 
 vboFromType :: PicShads VBO -> Int -> VBO
 {-# INLINE vboFromType #-}
@@ -167,13 +137,31 @@ vboFromType ps sn = case sn of
     _ -> undefined
 
 
-pokeLayVerxs :: PicShads VBO -> [Verx] -> IO (IM.IntMap (PicShads Int))
+pokeLayVerxs :: MV.MVector (PrimState IO) VShader -> [Verx] -> IO (IM.IntMap (PicShads Int))
 pokeLayVerxs vbos vxs = do
     counts <- UMV.replicate (6*6) 0
-    --SP.mapM_ (pokeLayVerx vbos counts) $ SP.each vxs
     VS.mapM_ (pokeLayVerx vbos counts) $ VS.fromList vxs
     vToLayPicShad counts
 
+pokeLayVerx :: MV.MVector (PrimState IO) VShader -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
+--{-# INLINE pokeLayVerx #-}
+pokeLayVerx vbos counts vx = do
+    theOff <- UMV.unsafeRead counts vecPos
+    basePtr <- fmap (_vboPtr . _vaoVBO . _vshaderVAO) $ MV.unsafeRead vbos sn
+    let thePtr = plusPtr basePtr ((theOff + layOff) * theStride * floatSize)
+    poke34 thePtr thePos theCol
+    pokeArrayOff thePtr 7 (_vxExt vx)
+    UMV.unsafeModify counts (+ 1) vecPos
+  where
+    sn = _unShadNum (_vxShadNum vx)
+    vecPos = theLayer * 6 + sn
+    theLayer = _vxLayer vx
+    thePos = _vxPos vx
+    theCol = _vxCol vx
+    --basePtr = _vboPtr $ vboFromType vbos sn
+    layOff = theLayer * numSubElements
+    theStride = pokeStride sn
+
 vToLayPicShad :: UMV.MVector RealWorld Int -> IO (IM.IntMap (PicShads Int))
 {-# INLINE vToLayPicShad #-}
 vToLayPicShad mv = foldM f IM.empty [0..5]