Broken binding of central picture in one pass

src/Shader/Compile.hs

@@ -1,5 +1,6 @@
 module Shader.Compile
     ( makeShader
+    , makeShaderSized
     , makeShaderUsingShaderVAO
     , makeSourcedShader
     , setupVAO
@@ -52,6 +53,29 @@ makeShader s shaderlist sizes pm renStrat = do
         , _shaderTexture = Nothing
         , _shaderCustomUnis = []
         }
+{- | 
+Compiles a full shader found within the shader directory.
+The shader is made up of files begining with the inputted string with extensions .vert, .geom etc.
+-}
+makeShaderSized
+    :: String       -- ^ First part of the name of the shader
+    -> [ShaderType] -- ^ Filetype extensions
+    -> [Int]   -- ^ The input vertex sizes
+    -> Int          -- ^ Number of vertexes that can be poked
+    -> EPrimitiveMode
+    -> (RenderType -> [[Float]])   -- ^ Poke strategy: method for creating a list of vertex data to be bound
+    -> IO FullShader
+makeShaderSized s shaderlist sizes ndraw pm renStrat = do
+    prog <- makeSourcedShader s shaderlist
+    vaob <- setupVAOSized sizes ndraw
+    return $ FullShader 
+        { _shaderProgram = prog
+        , _shaderVAO = vaob
+        , _shaderPokeStrategy = renStrat
+        , _shaderDrawPrimitive = pm
+        , _shaderTexture = Nothing
+        , _shaderCustomUnis = []
+        }
 
 -- | Compile shader and get its uniform locations.
 -- supposes the shader code is in the shader folder, with the string names
@@ -76,6 +100,15 @@ setupVAO sizes = do
         { _vao = theVAO
         , _vaoVBO = theVBO
         }
+setupVAOSized :: [Int] -> Int -> IO VAO
+setupVAOSized sizes ndraw = do
+    theVAO <- genObjectName
+    bindVertexArrayObject $= Just theVAO
+    theVBO <- setupVBOSized sizes ndraw
+    return $ VAO 
+        { _vao = theVAO
+        , _vaoVBO = theVBO
+        }
 
 setupVBO :: [Int] -> IO VBO
 setupVBO sizes = do
@@ -98,6 +131,28 @@ setupVBO sizes = do
   where
     strd = sum sizes
     offs = scanl (+) 0 sizes
+
+setupVBOSized :: [Int] -> Int -> IO VBO
+setupVBOSized sizes ndraw = do
+    vboName <- genObjectName
+    bindBuffer ArrayBuffer $= Just vboName
+    forM_ (zip3 [0..] sizes offs) $ \(loc,siz,off) -> do
+        setupVertexAttribPointer loc siz strd off
+    thePtr <- mallocArray (strd * ndraw)
+    -- Allocate space
+    bufferData ArrayBuffer $=
+        (fromIntegral $ floatSize * ndraw * strd
+        , nullPtr
+        , DynamicDraw
+        )
+    return $ VBO
+        { _vbo = vboName
+        , _vboPointer = thePtr
+        , _vboAttribSizes = sizes
+        }
+  where
+    strd = sum sizes
+    offs = scanl (+) 0 sizes
     
 {- | Assumes the correct VBO is bound -}
 setupVertexAttribPointer 

src/Shader/Parameters.hs

@@ -1,6 +1,7 @@
 module Shader.Parameters
     ( floatSize
     , numDrawableElements
+    , numSubElements
     ) where
 import Graphics.Rendering.OpenGL hiding (Point,translate,scale,imageHeight)
 import Foreign
@@ -11,5 +12,8 @@ floatSize = sizeOf (0.5 :: GLfloat)
 
 numDrawableElements :: Int
 {-# INLINE numDrawableElements #-}
-numDrawableElements = 50000
+numDrawableElements = 70000
 
+numSubElements :: Int
+{-# INLINE numSubElements #-}
+numSubElements = 10000

src/Shader/Poke.hs

@@ -1,8 +1,10 @@
 module Shader.Poke
     ( pokeArrayOff
     , pokeShader
+    , pokeShaderLayer
     ) where
 import Shader.Data
+import Shader.Parameters
 import Picture.Data
 
 import Foreign
@@ -17,6 +19,15 @@ pokeShader fs = F.FoldM (pokeVertices fls ptr stride)  (return 0) return
     stride = sum $ _vboAttribSizes theVBO
     fls = _shaderPokeStrategy fs
 
+pokeShaderLayer :: (Int,FullShader) -> F.FoldM IO (Int,RenderType) Int
+pokeShaderLayer (l,fs) = F.FoldM (pokeVerticesOff fls ptr stride l)  (return 0) return
+  where 
+    theVBO = _vaoVBO $ _shaderVAO fs
+    ptr = _vboPointer theVBO
+    stride = sum $ _vboAttribSizes theVBO
+    fls = _shaderPokeStrategy fs
+
+
 pokeVertices 
     :: (RenderType -> [[Float]])
     -> Ptr Float
@@ -26,6 +37,24 @@ pokeVertices
     -> IO Int
 pokeVertices toFs ptr stride n rt = foldM (pokeVertex ptr stride) n (toFs rt)
 
+pokeVerticesOff
+    :: (RenderType -> [[Float]])
+    -> Ptr Float
+    -> Int  -- ^ stride
+    -> Int  -- ^ offset
+    -> Int  -- ^ number of vertices already poked
+    -> (Int,RenderType)
+    -> IO Int
+pokeVerticesOff toFs ptr stride offset n (i,rt) 
+    | offset == i = foldM (pokeVertexOff ptr stride offset) n (toFs rt)
+    | otherwise = return n
+
+pokeVertexOff :: Ptr Float -> Int -> Int -> Int -> [Float] -> IO Int
+pokeVertexOff ptr stride offset n fs = do
+    pokeArrayOff ptr (stride * (n + offset * numSubElements)) fs
+    return $ n + 1
+
+
 pokeVertex :: Ptr Float -> Int -> Int -> [Float] -> IO Int
 pokeVertex ptr stride n fs = do
     pokeArrayOff ptr (stride * n) fs