Add picture shader container datatype

src/Shader.hs

@@ -2,6 +2,7 @@ module Shader
     ( bindShaderLayer
     , bindShaderLay
     , bindShaderBuffers
+    , bindShader
     , bindArrayBuffers
     , drawShader
     , freeShaderPointers
@@ -18,6 +19,7 @@ import Control.Monad
 import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
 import Graphics.GL.Core43
 import qualified Data.IntMap.Strict as IM
+import Data.Bifunctor
 --import Text.RawString.QQ
 --import Linear.Matrix
 --import Linear.V4
@@ -32,6 +34,18 @@ bindArrayBuffers numVs theVBO = do
         (fromIntegral $ floatSize * numVs * sum (_vboAttribSizes theVBO)) 
         (_vboPointer theVBO)
 
+bindArrayBuffersLayer' :: Int -> Int -> VBO -> IO ()
+bindArrayBuffersLayer' lay numVs theVBO = do
+    bindBuffer ArrayBuffer $= Just (_vbo theVBO)
+    bufferSubData 
+        ArrayBuffer 
+        WriteToBuffer 
+        (fromIntegral $ floatSize * stride * numSubElements * lay)
+        (fromIntegral $ floatSize * numVs * stride)
+        (_vboPointer theVBO `plusPtr` (floatSize * stride * numSubElements * lay))
+  where
+    stride = sum $ _vboAttribSizes theVBO
+
 bindArrayBuffersLayer :: Int -> Int -> VBO -> IO ()
 bindArrayBuffersLayer numVs lay theVBO = do
     bindBuffer ArrayBuffer $= Just (_vbo theVBO)
@@ -44,11 +58,14 @@ bindArrayBuffersLayer numVs lay theVBO = do
   where
     stride = sum $ _vboAttribSizes theVBO
 
-bindShaderLay :: IM.IntMap [(VShader,Int)] -> IO ()
-bindShaderLay = mapM_ f . IM.toList
+bindShaderLay :: PicShads VShader -> IM.IntMap (PicShads Int) -> IO ()
+bindShaderLay shads = mapM_ f . IM.toList
   where
-    f (lay,ps) = mapM_ (g lay) ps 
-    g l (fs,i) = bindArrayBuffersLayer i l $ _vaoVBO $ _vshaderVAO fs
+    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 = mapM_ (uncurry (flip bindArrayBuffers) . first (_vaoVBO . _vshaderVAO))
 
 bindShaderLayer :: [(Int,VShader)] -> [Int] -> IO ()
 bindShaderLayer = zipWithM_ f
@@ -60,13 +77,6 @@ bindShaderBuffers = zipWithM_ f
   where 
     f fs i = bindArrayBuffers i $ _vaoVBO $ _shaderVAO fs
 
-drawShaderLays :: IM.IntMap [(VShader,Int)] -> IO ()
-{-# INLINE drawShaderLays #-}
-drawShaderLays = mapM_ f . IM.toList
-  where
-    f (lay,ps) = mapM_ (g lay) ps
-    g lay (shad,i) = drawShaderLay lay shad i
-
 drawShaderLay :: Int -> VShader -> Int -> IO ()
 {-# INLINE drawShaderLay #-}
 drawShaderLay l fs i = do