From 0c4c83abb53b9218fe76481d61aa7f171937a051 Mon Sep 17 00:00:00 2001
From: jgk <justin.g.kruger@gmail.com>
Date: Wed, 11 Aug 2021 20:34:34 +0200
Subject: [PATCH] Add more mutability

---
 src/Render.hs      | 13 ++++++++-----
 src/Shader.hs      | 20 +++++++++++++-------
 src/Shader/Poke.hs | 16 +++++++++++++---
 3 files changed, 34 insertions(+), 15 deletions(-)

diff --git a/src/Render.hs b/src/Render.hs
index 645d98ca4..1df7c37ed 100644
--- a/src/Render.hs
+++ b/src/Render.hs
@@ -25,6 +25,7 @@ import Graphics.Rendering.OpenGL hiding (Line,translate,scale,imageHeight,Polygo
 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
 
 divideSize :: Int -> Size -> Size
 divideSize i (Size x y) = Size (div x $ fromIntegral i) (div y $ fromIntegral i)
@@ -144,11 +145,10 @@ drawTextureOnFramebuffer fs fbo to = do
     drawShader fs 4
 
 pokeBindFoldable
-    :: RenderData
+    :: PicShads VShader
     -> [Verx]
     -> IO (PicShads Int)
-pokeBindFoldable pdata m = do
-    let shads = _pictureShaders pdata
+pokeBindFoldable shads m = do
     counts <- UMV.replicate 6 0
     pokeVerxs (fmap (_vaoVBO . _vshaderVAO) shads) counts m
     shads' <- picShadToMV shads
@@ -175,9 +175,12 @@ renderFoldable
     -> IO Word32
 renderFoldable pdata struct = do
     pokeStartTicks <- SDL.ticks
-    count <- pokeBindFoldable pdata struct
     let shads = _pictureShaders pdata
-    sequence_ (drawShaderLay 0 <$> shads <*> count)
+    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
diff --git a/src/Shader.hs b/src/Shader.hs
index ac131dce4..56fd38c37 100644
--- a/src/Shader.hs
+++ b/src/Shader.hs
@@ -5,6 +5,7 @@ module Shader
     , drawShader
     , freeShaderPointers
     , drawShaderLay
+    , drawShaderLay'
     , shadVBOptr
     ) where
 --import Geometry.Data
@@ -57,13 +58,6 @@ 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 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
@@ -86,6 +80,18 @@ drawShaderLay l fs i = do
         _   -> return ()
     glDrawArrays (marshalEPrimitiveMode $ _vshaderDrawPrimitive fs) (fromIntegral $ l*numSubElements) (fromIntegral i)
 
+drawShaderLay' :: Int -> UMV.MVector (PrimState IO) Int -> Int -> VShader -> IO ()
+{-# INLINE drawShaderLay' #-}
+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 $ l*numSubElements) (fromIntegral i)
+
 drawShader :: FullShader -> Int -> IO ()
 {-# INLINE drawShader #-}
 drawShader fs i = do 
diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs
index efe9f53a1..f94516a44 100644
--- a/src/Shader/Poke.hs
+++ b/src/Shader/Poke.hs
@@ -37,9 +37,8 @@ pokeVerxs
     -> [Verx] 
     -> IO ()
 pokeVerxs vbos count vxs = do
-    --count <- UMV.replicate 6 0
-    VS.mapM_ (pokeVerx vbos count) $ VS.fromList vxs
-    --vToPicShad count
+    s <- picShadToMV vbos
+    VS.mapM_ (pokeVerx' s count) $ VS.fromList vxs
 
 vToPicShad :: UMV.MVector (PrimState IO) Int -> IO (PicShads Int)
 {-# INLINE vToPicShad #-}
@@ -85,6 +84,17 @@ pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=the
   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