Add new files

src/Shader.hs

@@ -1,91 +1,28 @@
 module Shader
-    ( bindShaderLayers
-    , bindShaderBuffers
-    , bindShader
-    , drawShader
-    , freeShaderPointers
+    ( freeShaderPointers
     , drawShaderLay
-    , drawShaderLay'
     , shadVBOptr
+    , drawShader
+    , pokeBindFoldable
+    , pokeBindFoldableLayer
     ) where
---import Geometry.Data
 import Shader.Data
 import Shader.Parameters
 import Shader.ExtraPrimitive
---import Shader.Poke
---import Layers
---import MatrixHelper
+import Shader.Poke
+import Shader.Bind
+import Picture.Data
 
 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)
 import Graphics.GL.Core43
---import qualified Data.IntMap.Strict as IM
---import Data.Bifunctor
---import Text.RawString.QQ
---import Linear.Matrix
---import Linear.V4
---import qualified Data.Vector.Unboxed.Mutable as MV
---import Control.Monad.Primitive
 
-bindArrayBuffers :: Int -> VBO -> IO ()
-bindArrayBuffers numVs theVBO = do
-    bindBuffer ArrayBuffer $= Just (_vbo theVBO)
-    bufferSubData 
-        ArrayBuffer 
-        WriteToBuffer 
-        0 
-        (fromIntegral $ floatSize * numVs * sum (_vboAttribSizes theVBO)) 
-        (_vboPtr theVBO)
-
-bindShaderLayers :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> IO ()
-bindShaderLayers shads counts = MV.imapM_ f shads
-  where
-    f i shad = do
-        let theVBO = _vaoVBO $ _shaderVAO shad
-            stride = sum $ _vboAttribSizes theVBO
-        bindBuffer ArrayBuffer $= (Just . _vbo $ theVBO)
-        mapM_ (g stride theVBO) [0..5]
-      where
-        g stride theVBO lay = do
-            numVs <- UMV.unsafeRead counts $ lay * 6 + i
-            bufferSubData
-                ArrayBuffer 
-                WriteToBuffer 
-                (fromIntegral $ floatSize * stride * numSubElements * lay)
-                (fromIntegral $ floatSize * numVs * stride)
-                (_vboPtr theVBO `plusPtr` (floatSize * stride * numSubElements * lay))
-            
-
-
-bindShader :: MV.MVector (PrimState IO) FullShader -> UMV.MVector (PrimState IO) Int -> IO ()
-bindShader shads counts = MV.imapM_ f shads
-  where
-    f i shad = UMV.read counts i >>= flip bindArrayBuffers (_vaoVBO . _shaderVAO $ shad)
-
-
-bindShaderBuffers :: [FullShader] -> [Int] -> IO ()
-bindShaderBuffers = zipWithM_ f
-  where 
-    f fs i = bindArrayBuffers i $ _vaoVBO $ _shaderVAO fs
-
-drawShaderLay :: Int -> FullShader -> Int -> IO ()
+drawShaderLay :: Int -> UMV.MVector (PrimState IO) Int -> Int -> FullShader -> IO ()
 {-# INLINE drawShaderLay #-}
-drawShaderLay l fs i = do 
-    currentProgram $= Just (_shaderProgram fs)
-    bindVertexArrayObject $= Just (_vao $ _shaderVAO fs)
-    case _shaderTexture fs of 
-        Just ShaderTexture{_textureObject = txo}
-            -> textureBinding Texture2D $= Just txo
-        _   -> return ()
-    glDrawArrays (marshalEPrimitiveMode $ _shaderDrawPrimitive fs) (fromIntegral $ l*numSubElements) (fromIntegral i)
-
-drawShaderLay' :: Int -> UMV.MVector (PrimState IO) Int -> Int -> FullShader -> IO ()
-{-# INLINE drawShaderLay' #-}
-drawShaderLay' l countsVector shadIn fs = do 
+drawShaderLay l countsVector shadIn fs = do 
     i <- UMV.read countsVector shadIn
     currentProgram $= Just (_shaderProgram fs)
     bindVertexArrayObject $= Just (_vao $ _shaderVAO fs)
@@ -109,5 +46,24 @@ drawShader fs i = do
 freeShaderPointers :: FullShader -> IO ()
 freeShaderPointers fs = free $ _vboPtr $ _vaoVBO $ _shaderVAO fs
 
+pokeBindFoldable
+    :: MV.MVector (PrimState IO) FullShader
+    -> UMV.MVector (PrimState IO) Int
+    -> Picture
+    -> IO ()
+pokeBindFoldable shadV counts m = do
+    pokeVerxs shadV counts m
+    bindShader shadV counts
+
+pokeBindFoldableLayer
+    :: MV.MVector (PrimState IO) FullShader
+    -> UMV.MVector (PrimState IO) Int
+    -> Picture
+    -> IO ()
+pokeBindFoldableLayer shadV counts m = do
+    pokeLayVerxs shadV counts m
+    bindShaderLayers shadV counts
+
 shadVBOptr :: FullShader -> Ptr Float
+{-# INLINE shadVBOptr #-}
 shadVBOptr = _vboPtr . _vaoVBO . _shaderVAO