Implement custom poking for vertices--speed regression?

src/Dodge/Render.hs

@@ -18,8 +18,8 @@ import Render
 import Data.Preload.Render
 import Picture.Data
 import Shader
-import Shader.Data
 import Shader.Poke
+import Shader.Data
 import MatrixHelper
 --import Polyhedra.Data
 import Polyhedra
@@ -29,7 +29,7 @@ import Foreign
 --import Control.Monad.State
 import Control.Lens
 import Control.Monad
-import qualified Control.Foldl as F
+--import qualified Control.Foldl as F
 --import Data.Tuple.Extra
 --import Data.List
 --import Data.Bifunctor
@@ -53,26 +53,20 @@ doDrawing pdata w = do
         pic = worldPictures w
     -- bind as much data into vbos as feasible at this point
     -- poke wall points and colors
-    -- _ <- F.foldM (pokeShader $ _wallTextureShader pdata) (map Render22x4 wallPointsCol)
     --pokeArray (_vboPointer . _vaoVBO . _shaderVAO $ _wallTextureShader pdata) $ wallsToList wallPointsCol
     --let nWalls = length wallPointsCol
-    nWalls <- pokeWalls (_vboPointer . _vaoVBO . _shaderVAO $ _wallTextureShader pdata) wallPointsCol
+    nWalls <- pokeWalls (shadVBOptr $ _wallTextureShader pdata) wallPointsCol
     --poke
 
     -- poke silhouette vertex data
-    -- nSils <- F.foldM (pokeShader $ _lightingLineShadowShader pdata) 
-    --             (concatMap polyToRender (foregroundPics w))
-    nSils <- pokePoint3s (_vboPointer . _vaoVBO . _shaderVAO $ _lightingLineShadowShader pdata) 
+    nSils <- pokePoint3s (shadVBOptr $ _lightingLineShadowShader pdata) 
                 (_foregroundEdgeVerx w)
 
     -- poke foreground geometry and floor
     let addC (xx,yy) = (xx,yy,0)
-    nsurfVs <- pokePoint3s (_vboPointer . _vaoVBO . _shaderVAO $ _lightingSurfaceShader pdata)
-        $ (polyToTris $ map addC $ screenPolygon w)
+    nsurfVs <- pokePoint3s (shadVBOptr $ _lightingSurfaceShader pdata)
+        $ polyToTris (map addC $ screenPolygon w)
         ++ concatMap polyToGeoRender' (foregroundPics w)
-    --nsurfVs <- F.foldM (pokeShader (_lightingSurfaceShader pdata)) 
-    --    $ Render3 (polyToTris $ map addC $ screenPolygon w)
-    --    : concatMap polyToGeoRender (foregroundPics w)
 
     -- bind wall points, silhouette data, surface geometry
     uncurry bindShaderBuffers $ unzip
@@ -92,24 +86,23 @@ doDrawing pdata w = do
 
     _ <- renderFoldable pdata $ polysToPic $ foregroundPics w
 
-    vnums <- pokeBindFoldableLayer pdata $ pic
+    vnums <- pokeBindFoldableLayer pdata pic
     let shads = _pictureShaders pdata
-    --mapM_ (uncurry $ drawShaderLay 0) ((,) <$> shads <*> count)
     renderLayer 0 shads vnums
 
-    _ <- renderShader (_textureArrayShader pdata) (_floorTiles w)
+    nTextArrayVs <- pokePoint33s (shadVBOptr $ _textureArrayShader pdata) (map _unRender3x3 $ _floorTiles w)
+    bindShaderBuffers [_textureArrayShader pdata] [nTextArrayVs]
+    drawShader (_textureArrayShader pdata) nTextArrayVs
 
     bindFramebuffer Framebuffer $= fst (_fboBloom pdata)
     clear [ColorBuffer]
     blendFunc $= (SrcAlpha,OneMinusSrcAlpha)
-    --mapM_ (uncurry $ drawShaderLay 1) (vnums IM.! 1)
+
     renderLayer 1 shads vnums
     bindFramebuffer Framebuffer $= fst (_fboColor pdata)
     clear [ColorBuffer]
     depthMask $= Disabled
-    --mapM_ (uncurry $ drawShaderLay 3) (vnums IM.! 3)
-    --mapM_ (uncurry $ drawShaderLay 4) (vnums IM.! 4)
-    --mapM_ (uncurry $ drawShaderLay 5) (vnums IM.! 5)
+
     renderLayer 3 shads vnums
     renderLayer 4 shads vnums
     renderLayer 5 shads vnums
@@ -171,9 +164,7 @@ doDrawing pdata w = do
         rds -> do
             let bindDrawDist :: (Point2,Point2,Point2,Float) -> IO ()
                 bindDrawDist ((a,b),(c,d),(e,f),g) = do
-                --bindDrawDist distParam = do
-                    --_ <- F.foldM (pokeShader $ _barrelShader pdata) [Render2221 distParam]
-                    pokeArray (_vboPointer . _vaoVBO . _shaderVAO $ _barrelShader pdata)
+                    pokeArray (shadVBOptr $ _barrelShader pdata)
                         [a,b,c,d,e,f,g]
                     bindShaderBuffers [_barrelShader pdata] [1]
                     drawShader (_barrelShader pdata) 1
@@ -223,8 +214,7 @@ renderWindows
     -> [((Point2,Point2),Point4)]   -- ^ List: wall positions and color
     -> IO ()
 renderWindows pdata wps = do
-    --n <- F.foldM (pokeShader $ _wallBlankShader pdata) (map Render22x4 wps)
-    n <- pokeWalls (_vboPointer . _vaoVBO . _shaderVAO $ _wallBlankShader pdata) wps
+    n <- pokeWalls (shadVBOptr $ _wallBlankShader pdata) wps
     bindShaderBuffers [_wallBlankShader pdata] [n]
     currentProgram $= Just (_shaderProgram $ _wallBlankShader pdata)
     cullFace $= Just Back

src/Dodge/Render/Picture.hs

@@ -214,17 +214,6 @@ wallsAndWindows w
 wallsToList :: [((Point2,Point2),Point4)] -> [Float]
 wallsToList = concatMap (\(((a,b),(c,d)),(e,f,g,h)) -> [a,b,c,d,e,f,g,h])
 
-pokePoint3s :: Ptr Float -> [Point3] -> IO Int
-pokePoint3s ptr vals0 = go vals0 0
-  where
-    go [] n = return n
-    go ( (a,b,c):vals) n = do
-        pokeElemOff ptr (off 0) a
-        pokeElemOff ptr (off 1) b
-        pokeElemOff ptr (off 2) c
-        go vals (n+1)
-      where
-        off i = n*3 + i
 
 pokeWalls :: Ptr Float -> [((Point2,Point2),Point4)] -> IO Int
 pokeWalls ptr vals0 = go vals0 0