Interleave vertex buffer data

src/Dodge/Render.hs

@@ -136,7 +136,7 @@ renderBlankWalls
     -> GLmatrix GLfloat 
     -> IO ()
 renderBlankWalls pdata wps pmat = do
-    n <- F.foldM (pokeShader $ _wallBlankShader pdata) (map Render22x4 wps)
+    n <- F.foldM (pokeShader' $ _wallBlankShader pdata) (map Render22x4 wps)
     bindShaderBuffers [_wallBlankShader pdata] [n]
     currentProgram $= Just (_shaderProgram $ _wallBlankShader pdata)
     uniform (_shaderMatrixUniform $ _wallBlankShader pdata) $= pmat
@@ -150,7 +150,7 @@ renderTextureWalls
     -> GLmatrix GLfloat 
     -> IO ()
 renderTextureWalls pdata wps pmat = do
-    n <- F.foldM (pokeShader $ _wallTextureShader pdata) (map Render22x4 wps)
+    n <- F.foldM (pokeShader' $ _wallTextureShader pdata) (map Render22x4 wps)
     bindShaderBuffers [_wallTextureShader pdata] [n]
     currentProgram $= Just (_shaderProgram $ _wallTextureShader pdata)
     uniform (_shaderMatrixUniform $ _wallTextureShader pdata) $= pmat

src/Picture/Preload.hs

@@ -38,8 +38,8 @@ makeLenses ''RenderData
 preloadRender :: IO RenderData
 preloadRender = do
 -- lighting shaders
-    lightningFloorShad <- makeShader "lighting/floor" [vert,geom,frag] [4] Points 
+    lightingFloorShad <- makeShader "lighting/floor" [vert,geom,frag] [4] Points 
-                    (return . return . flat4 . _unRender1111)
+                    pokeLightingFloorStrat
     wsShad <- makeShader "lighting/occlude" [vert,geom,frag] [4] Points pokeWPStrat
                 >>= addUniforms ["lightPos"]
     wlLightShad 
@@ -62,21 +62,21 @@ preloadRender = do
         ,[[-1,-1],[0,0]]
         ,[[ 1,-1],[1,0]]
         ]
-    _ <- F.foldM (pokeShader fsShad) [RenderConst] -- fix fullscreen vertex positions now
+    _ <- F.foldM (pokeShader' fsShad) [RenderConst] -- fix fullscreen vertex positions now
     boxBlurShad <- makeShader "texture/boxBlur" [vert,frag] [2,2] TriangleStrip $ const
         [[[-1, 1],[0,1]]
         ,[[ 1, 1],[1,1]]
         ,[[-1,-1],[0,0]]
         ,[[ 1,-1],[1,0]]
         ]
-    _ <- F.foldM (pokeShader boxBlurShad) [RenderConst] -- fix fullscreen vertex positions now
+    _ <- F.foldM (pokeShader' boxBlurShad) [RenderConst] -- fix fullscreen vertex positions now
     grayscaleShad <- makeShader "texture/grayscale" [vert,frag] [2,2] TriangleStrip $ const
         [[[-1, 1],[0,1]]
         ,[[ 1, 1],[1,1]]
         ,[[-1,-1],[0,0]]
         ,[[ 1,-1],[1,0]]
         ]
-    _ <- F.foldM (pokeShader grayscaleShad) [RenderConst] -- fix fullscreen vertex positions now
+    _ <- F.foldM (pokeShader' grayscaleShad) [RenderConst] -- fix fullscreen vertex positions now
 -- background shader
     bgShad <- makeShader "background" [vert,geom,frag] [4,2] Points pokeBGStrat
                 >>= addTexture "data/texture/marbleSlabs.png"
@@ -99,7 +99,7 @@ preloadRender = do
     bindFramebuffer Framebuffer $= defaultFramebufferObject
     return $ RenderData
         { _pictureShaders           = [bslist,lslist,cslist,aslist,eslist,bezierQuadShader]
-        , _lightingFloorShader      = lightningFloorShad
+        , _lightingFloorShader      = lightingFloorShad
         , _lightingOccludeShader    = wsShad
         , _lightingWallShader       = wlLightShad
         , _wallBlankShader          = wlBlank
@@ -193,6 +193,10 @@ pokeTriStrat,pokeCharStrat,pokeArcStrat,pokeLineStrat,pokeEllStrat :: RenderType
 pokeTriStrat (RenderPoly vs) = fmap (\(p,co) -> [flat3 p,flat4 co]) vs
 pokeTriStrat _ = []
 
+pokeLightingFloorStrat :: RenderType -> [[[Float]]]
+pokeLightingFloorStrat Render1111{_unRender1111=x} = [[flat4 x]]
+pokeLightingFloorStrat _ = undefined
+
 pokeCharStrat (RenderText vs) = fmap (\(a,b,c) -> [flat3 a, flat4 b, flat3 c]) vs
 pokeCharStrat _ = []
 

src/Picture/Render.hs

@@ -34,7 +34,7 @@ setWallDepth
 setWallDepth pdata wallPoints (viewFromx,viewFromy) _ = do
     startTicks <- SDL.ticks
     colorMask $= Color4 Disabled Disabled Disabled Disabled
-    nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) (map Render22 wallPoints)
+    nWalls <- F.foldM (pokeShader' $ _lightingOccludeShader pdata) (map Render22 wallPoints)
     bindShaderBuffers [_lightingOccludeShader pdata] [nWalls]
 
     currentProgram $= Just (_shaderProgram $ _lightingOccludeShader pdata)
@@ -76,9 +76,9 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat _
     bindFramebuffer Framebuffer $= _spareFBO pdata
 
 -- store wall and light positions into buffer
-    nWallLights <- F.foldM (pokeShader $ _lightingWallShader pdata) (map Render22 wallPoints)
+    nWallLights <- F.foldM (pokeShader' $ _lightingWallShader pdata) (map Render22 wallPoints)
     bindShaderBuffers [_lightingWallShader pdata] [nWallLights]
-    nWalls <- F.foldM (pokeShader $ _lightingOccludeShader pdata) (map Render22 wallPoints)
+    nWalls <- F.foldM (pokeShader' $ _lightingOccludeShader pdata) (map Render22 wallPoints)
     bindShaderBuffers [_lightingOccludeShader pdata] [nWalls]
 -- set uniforms for shader that draws lights
     currentProgram $= Just (_shaderProgram $ _lightingWallShader pdata)
@@ -114,8 +114,7 @@ createLightMap pdata resDiv wallPoints lightPoints (viewFromx,viewFromy) pmat _
     stencilTest $= Enabled
     forM_ lightPoints $ \(x,y,r,lum) -> do
 -- bind buffer for floor light circle
-        let lightPtr = (\(_,ptr,_) -> ptr) $ head 
+        let lightPtr = _vboPointer $ _vaoVBO $ _shaderVAO $ _lightingFloorShader pdata
-                            $ _vaoBufferTargets $ _shaderVAO $ _lightingFloorShader pdata
         pokeFourOff lightPtr 0 (x,y,r,lum)
 -- stencil out walls
         colorMask $= Color4 Disabled Disabled Disabled Disabled
@@ -200,7 +199,8 @@ renderBackground pdata rot camZoom (tranx,trany) (winx,winy) = do
 -- set drawing for on top
     --blendFuncSeparate    $= ((SrcAlphaSaturate, OneMinusSrcAlpha), (Zero,One))
 -- draw background
-    bindArrayBuffers 1 $ _vaoBufferTargets $ _shaderVAO $ _backgroundShader pdata
+    --bindArrayBuffers 1 $ _vaoBufferTargets $ _shaderVAO $ _backgroundShader pdata
+    bindArrayBuffers' 1 $ _vaoVBO $ _shaderVAO $ _backgroundShader pdata
     currentProgram $= Just (_shaderProgram $ _backgroundShader pdata)
     bindVertexArrayObject $= Just (_vao $ _shaderVAO $ _backgroundShader pdata)
     let backPtr = (\(_,x,_) -> x) $ head $ _vaoBufferTargets $ _shaderVAO $ _backgroundShader pdata
@@ -248,7 +248,7 @@ renderShader
     -> IO Word32
 renderShader shad dat = do
     sticks <- SDL.ticks
-    i <- F.foldM  (pokeShader shad) dat
+    i <- F.foldM  (pokeShader' shad) dat
     bindShaderBuffers [shad] [i]
     drawShader shad i
     eticks <- SDL.ticks

src/Shader.hs

@@ -3,8 +3,10 @@ module Shader
     , addTexture
     , addUniforms
     , pokeShaders
-    , pokeShader
+    --, pokeShader
-    , bindArrayBuffers
+    , pokeShader'
+    --, bindArrayBuffers
+    , bindArrayBuffers'
     , bindShaderBuffers
     , makeSourcedShader
     , setupVAO
@@ -41,7 +43,8 @@ extractProgAndUnis :: FullShader -> (Program,UniformLocation)
 extractProgAndUnis s = (_shaderProgram s, _shaderMatrixUniform s)
 
 pokeShaders :: [FullShader] -> F.FoldM IO RenderType [Int]
-pokeShaders = traverse pokeShader
+pokeShaders = traverse pokeShader'
+--pokeShaders = traverse pokeShader
 
 pokeShader :: FullShader -> F.FoldM IO RenderType Int
 pokeShader fs = F.FoldM (pokeRender fls (zip ptrs nAtss))  (return 0) return
@@ -49,13 +52,39 @@ pokeShader fs = F.FoldM (pokeRender fls (zip ptrs nAtss))  (return 0) return
     (_,ptrs,nAtss) = unzip3 $ _vaoBufferTargets $ _shaderVAO fs
     fls = _shaderPokeStrategy fs
 
+pokeShader' :: FullShader -> F.FoldM IO RenderType Int
+pokeShader' fs = F.FoldM (pokeRender' fls ptr stride)  (return 0) return
+  where 
+    theVBO = _vaoVBO $ _shaderVAO fs
+    ptr = _vboPointer theVBO
+    stride = sum $ _vboAttribSizes theVBO
+    fls = _shaderPokeStrategy fs
+
 pokeRender :: (RenderType -> [[[Float]]])
                 -> [(Ptr Float,Int)] -> Int -> RenderType -> IO Int
 pokeRender toFs ptrs n rt = pokeList ptrs n (toFs rt)
 
+pokeRender' 
+    :: (RenderType 
+    -> [[[Float]]])
+    -> Ptr Float
+    -> Int  -- ^ stride
+    -> Int 
+    -> RenderType 
+    -> IO Int
+pokeRender' toFs ptr stride n rt = pokeList' ptr stride n (toFs rt)
+
 pokeList :: [(Ptr Float,Int)] -> Int -> [[[Float]]] -> IO Int
 pokeList ptrs = foldM (pokePtrs ptrs)
 
+pokeList' :: Ptr Float -> Int -> Int -> [[[Float]]] -> IO Int
+pokeList' ptr stride = foldM (pokePtrs' ptr stride)
+
+pokePtrs' :: Ptr Float -> Int -> Int -> [[Float]] -> IO Int
+pokePtrs' ptr stride n fss = do
+    pokeArrayOff ptr (stride * n) (concat fss)
+    return $ n + 1
+
 pokePtrs :: [(Ptr Float,Int)] -> Int -> [[Float]] -> IO Int
 pokePtrs ptrIs n fss = do
     zipWithM_ f ptrIs fss
@@ -73,10 +102,18 @@ bindArrayBuffers numVs ps = do
         bindBuffer ArrayBuffer $= Just bo
         bufferData ArrayBuffer $= (fromIntegral $ floatSize * numVs * i, ptr, DynamicDraw)
 
+bindArrayBuffers' :: Int -> VBO -> IO ()
+bindArrayBuffers' numVs theVBO = do
+    bindBuffer ArrayBuffer $= Just (_vbo theVBO)
+    bufferData ArrayBuffer $= 
+        (fromIntegral $ floatSize * numVs * (sum $ _vboAttribSizes theVBO), _vboPointer theVBO, DynamicDraw)
+    
+
 bindShaderBuffers :: [FullShader] -> [Int] -> IO ()
 bindShaderBuffers = zipWithM_ f
   where 
-    f fs i = bindArrayBuffers i $ _vaoBufferTargets $ _shaderVAO fs
+    --f fs i = bindArrayBuffers i $ _vaoBufferTargets $ _shaderVAO fs
+    f fs i = bindArrayBuffers' i $ _vaoVBO $ _shaderVAO fs
 
 drawShaders :: [FullShader] -> [Int] -> IO ()
 drawShaders = zipWithM_ drawShader
@@ -137,7 +174,7 @@ floatSize = sizeOf (0.5 :: GLfloat)
 {-# INLINE floatSize #-}
 
 bufferOffset :: Integral a => a -> Ptr b
-bufferOffset = plusPtr nullPtr . fromIntegral
+bufferOffset = plusPtr nullPtr . (* floatSize) . fromIntegral
 
 numDrawableElements :: Int
 {-# INLINE numDrawableElements #-}
@@ -147,9 +184,9 @@ setupVAO :: [Int] -> IO VAO
 setupVAO sizes = do
     theVAO <- genObjectName
     bindVertexArrayObject $= Just theVAO
-    theVBO <- setupVBO $ sizes
     vbos <- forM (zip (map fromIntegral [(0::Int)..]) sizes) setupArrayBuffer
     ptrs <- forM (zip vbos sizes) setupVBOPointers
+    theVBO <- setupVBO $ sizes
     return $ VAO 
         { _vao = theVAO
         , _vaoBufferTargets = ptrs