Work towards using mutable vectors for storing parameters

src/Render.hs

@@ -24,6 +24,7 @@ import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,Polygo
 --import Data.Tuple.Extra
 import qualified Data.IntMap.Strict as IM
 import qualified SDL
+import qualified Data.Vector.Unboxed.Mutable as UMV
 
 divideSize :: Int -> Size -> Size
 divideSize i (Size x y) = Size (div x $ fromIntegral i) (div y $ fromIntegral i)
@@ -148,8 +149,11 @@ pokeBindFoldable
     -> IO (PicShads Int)
 pokeBindFoldable pdata m = do
     let shads = _pictureShaders pdata
-    elist <- pokeVerxs (fmap (_vaoVBO . _vshaderVAO) shads) m
+    counts <- UMV.replicate 6 0
-    bindShader shads elist
+    pokeVerxs (fmap (_vaoVBO . _vshaderVAO) shads) counts m
+    shads' <- picShadToMV shads
+    bindShader shads' counts
+    elist <- vToPicShad counts
     return elist
 
 zeroCounts :: PicShads Int

src/Shader.hs

@@ -11,9 +11,13 @@ module Shader
 import Shader.Data
 import Shader.Parameters
 import Shader.ExtraPrimitive
+import Shader.Poke
 --import Layers
 --import MatrixHelper
 
+import qualified Data.Vector.Unboxed.Mutable as UMV
+import qualified Data.Vector.Mutable as MV
+import Control.Monad.Primitive
 import Foreign
 import Control.Monad
 import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
@@ -53,8 +57,18 @@ bindShaderLay shads = mapM_ (uncurry f) . IM.toList
   where
     f lay counts = sequence_ $ bindArrayBuffersLayer lay <$> counts <*> (_vaoVBO . _vshaderVAO <$> shads)
 
-bindShader :: PicShads VShader -> PicShads Int -> IO ()
+--bindShader :: PicShads VShader -> PicShads Int -> IO ()
-bindShader shads counts = sequence_ $ bindArrayBuffers <$> counts <*> (_vaoVBO . _vshaderVAO <$> shads)
+----bindShader shads counts = sequence_ $ bindArrayBuffers <$> counts <*> (_vaoVBO . _vshaderVAO <$> shads)
+--bindShader shads count = do
+--    s <- picShadToMV shads
+--    c <- picShadToUMV count
+--    bindShader' s c
+
+bindShader :: MV.MVector (PrimState IO) VShader -> UMV.MVector (PrimState IO) Int -> IO ()
+bindShader shads counts = MV.imapM_ f shads
+  where
+    f i shad = UMV.read counts i >>= flip bindArrayBuffers (_vaoVBO . _vshaderVAO $ shad)
+
 
 bindShaderBuffers :: [FullShader] -> [Int] -> IO ()
 bindShaderBuffers = zipWithM_ f

src/Shader/Poke.hs

@@ -7,6 +7,10 @@ module Shader.Poke
     , pokeVerxs
     , pokeLayVerxs
     , poke224s
+    , picShadToUMV
+    , picShadToMV
+    , vToPicShad
+    , vToPicShadMV
     ) where
 import Shader.Data
 import Shader.Parameters
@@ -22,35 +26,62 @@ import Control.Monad
 --import qualified Control.Foldl as F
 import qualified Data.IntMap.Strict as IM
 --import Control.Lens
-import qualified Data.Vector.Unboxed.Mutable as MV
+import qualified Data.Vector.Unboxed.Mutable as UMV
+import qualified Data.Vector.Mutable as MV
 import qualified Data.Vector.Fusion.Stream.Monadic as VS
 import Control.Monad.Primitive
 
-pokeVerxs :: PicShads VBO -> [Verx] -> IO (PicShads Int)
+pokeVerxs 
-pokeVerxs vbos vxs = do
+    :: PicShads VBO 
-    count <- MV.replicate 6 0
+    -> UMV.MVector (PrimState IO) Int 
-    --SP.mapM_ (pokeVerx vbos count) $ SP.each vxs
+    -> [Verx] 
+    -> IO ()
+pokeVerxs vbos count vxs = do
+    --count <- UMV.replicate 6 0
     VS.mapM_ (pokeVerx vbos count) $ VS.fromList vxs
-    vToPicShad count
+    --vToPicShad count
-   -- F.foldM (F.FoldM 
-   --     (\_ vx -> pokeVerx vbos count vx >> addCountVerx count vx)
-   --     (return ())
-   --     (const (vToPicShad count))
-   --     )
-   --     vxs
 
-vToPicShad :: MV.MVector (PrimState IO) Int -> IO (PicShads Int)
+vToPicShad :: UMV.MVector (PrimState IO) Int -> IO (PicShads Int)
 {-# INLINE vToPicShad #-}
-vToPicShad mv = mapM (MV.unsafeRead mv) $ PicShads 0 1 2 3 4 5
+vToPicShad mv = mapM (UMV.unsafeRead mv) $ PicShads 0 1 2 3 4 5
 
-pokeVerx :: PicShads VBO -> MV.MVector (PrimState IO) Int -> Verx -> IO ()
+vToPicShadMV :: MV.MVector (PrimState IO) Int -> IO (PicShads Int)
+{-# INLINE vToPicShadMV #-}
+vToPicShadMV mv = mapM (MV.unsafeRead mv) $ PicShads 0 1 2 3 4 5
+
+picShadToUMV :: PicShads Int -> IO (UMV.MVector (PrimState IO) Int)
+{-# INLINE picShadToUMV #-}
+picShadToUMV (PicShads a b c d e f) = do
+    theVec <- UMV.new 6
+    UMV.write theVec 0 a
+    UMV.write theVec 1 b
+    UMV.write theVec 2 c
+    UMV.write theVec 3 d
+    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
+    theVec <- MV.new 6
+    MV.write theVec 0 a
+    MV.write theVec 1 b
+    MV.write theVec 2 c
+    MV.write theVec 3 d
+    MV.write theVec 4 e
+    MV.write theVec 5 f
+    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 <- MV.unsafeRead offsets sn
+    typeOff <- UMV.unsafeRead offsets sn
     let thePtr = plusPtr (_vboPtr $ vboFromType vbos sn) (typeOff * pokeStride sn * floatSize)
     poke34 thePtr thePos theCol
     pokeArrayOff thePtr 7 ext
-    MV.unsafeModify offsets (+1) sn
+    UMV.unsafeModify offsets (+1) sn
   where
     sn = _unShadNum theShadNum
 
@@ -96,14 +127,14 @@ pokePoint3s ptr vals0 = go vals0 0
       where
         off i = n*3 + i
 
-pokeLayVerx :: PicShads VBO -> MV.MVector (PrimState IO) Int -> Verx -> IO ()
+pokeLayVerx :: PicShads VBO -> UMV.MVector (PrimState IO) Int -> Verx -> IO ()
 --{-# INLINE pokeLayVerx #-}
 pokeLayVerx vbos counts vx = do
-    theOff <- MV.unsafeRead counts vecPos
+    theOff <- UMV.unsafeRead counts vecPos
     let thePtr = plusPtr basePtr ((theOff + layOff) * theStride * floatSize)
     poke34 thePtr thePos theCol
     pokeArrayOff thePtr 7 (_vxExt vx)
-    MV.unsafeModify counts (+ 1) vecPos
+    UMV.unsafeModify counts (+ 1) vecPos
   where
     sn = _unShadNum (_vxShadNum vx)
     vecPos = theLayer * 6 + sn
@@ -128,16 +159,16 @@ vboFromType ps sn = case sn of
 
 pokeLayVerxs :: PicShads VBO -> [Verx] -> IO (IM.IntMap (PicShads Int))
 pokeLayVerxs vbos vxs = do
-    counts <- MV.replicate (6*6) 0
+    counts <- UMV.replicate (6*6) 0
     --SP.mapM_ (pokeLayVerx vbos counts) $ SP.each vxs
     VS.mapM_ (pokeLayVerx vbos counts) $ VS.fromList vxs
     vToLayPicShad counts
 
-vToLayPicShad :: MV.MVector RealWorld Int -> IO (IM.IntMap (PicShads Int))
+vToLayPicShad :: UMV.MVector RealWorld Int -> IO (IM.IntMap (PicShads Int))
 {-# INLINE vToLayPicShad #-}
 vToLayPicShad mv = foldM f IM.empty [0..5]
   where
-    f m i = fmap (\ps -> IM.insert i ps m) (vToPicShad $ MV.unsafeSlice (i * 6) 6 mv)
+    f m i = fmap (\ps -> IM.insert i ps m) (vToPicShad $ UMV.unsafeSlice (i * 6) 6 mv)
 
 pokeStride :: Int -> Int
 {-# INLINE pokeStride #-}

stack.yaml

@@ -17,7 +17,8 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-17.1
+#resolver: lts-17.1
+resolver: lts-18.5
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.