Complete poke fold change

src/Dodge/Render.hs

@@ -47,11 +47,11 @@ doDrawing pdata u = do
     -- bind as much data into vbos as feasible at this point
     -- count mutable vectors setup
     layerCounts  <- UMV.replicate (numLayers*6) 0
-    shapeCounts  <- UMV.replicate 3 0
+--    shapeCounts  <- UMV.replicate 3 0
     wlwiflCounts <- UMV.replicate 3 0
     -- attempt to poke in parallel
     let (ws,wp) = wallSPics <> worldSPic cfig w
-    MP.bindM3 (\ _ _ _ -> return ())
+    (nShapeVs, nIndices, nSilIndices) <- MP.bindM3 (\ _ _ counts -> return counts)
         ( pokeBindFoldableLayer shadV layerCounts wp)
         ( pokeWallsWindowsFloor
             (shadVBOptr $ _wallTextureShader pdata) 
@@ -62,16 +62,15 @@ doDrawing pdata u = do
             windowPoints
             (_floorTiles w)
         )
-        ( pokeShape 
+        ( pokeShape'
             (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata)
             (_eboPtr $ _shapeEBO pdata)
             (_eboPtr $ _silhouetteEBO pdata)
-            shapeCounts
             ws
         )
-    nShapeVs    <- UMV.read shapeCounts 0
+--    nShapeVs    <- UMV.read shapeCounts 0
-    nIndices    <- UMV.read shapeCounts 1
+--    nIndices    <- UMV.read shapeCounts 1
-    nSilIndices <- UMV.read shapeCounts 2
+--    nSilIndices <- UMV.read shapeCounts 2
     nWalls <- UMV.read wlwiflCounts 0
     nWins  <- UMV.read wlwiflCounts 1
     nFls   <- UMV.read wlwiflCounts 2

src/Shader/Poke.hs

@@ -4,6 +4,7 @@ module Shader.Poke
     , pokeArrayOff
     , pokePoint33s
     , pokeShape
+    , pokeShape'
     , pokeWallsWindowsFloor
     ) where
 import Shader.Data
@@ -89,6 +90,14 @@ pokeShape
     -> IO ()
 pokeShape ptr iptr ieptr counts = VS.mapM_ (pokeShapeObj ptr iptr ieptr counts) . VS.fromList
 
+pokeShape'
+    :: Ptr Float 
+    -> Ptr GLushort 
+    -> Ptr GLushort 
+    -> [ShapeObj] 
+    -> IO (Int,Int,Int)
+pokeShape' ptr iptr ieptr = VS.foldM (pokeShapeObj' ptr iptr ieptr) (0,0,0) . VS.fromList
+
 pokeShapeObj
     :: Ptr Float 
     -> Ptr GLushort 
@@ -99,6 +108,29 @@ pokeShapeObj
 pokeShapeObj ptr iptr ieptr counts (ShapeObj shType shVerts) = case shType of
     TopPrism size -> pokeTopPrism (size - 2) ptr iptr ieptr counts shVerts
 
+pokeShapeObj'
+    :: Ptr Float 
+    -> Ptr GLushort 
+    -> Ptr GLushort 
+    -> (Int,Int,Int)
+    -> ShapeObj
+    -> IO (Int,Int,Int)
+pokeShapeObj' ptr iptr ieptr counts (ShapeObj shType shVerts) = case shType of
+    TopPrism size -> pokeTopPrism' (size - 2) ptr iptr ieptr counts shVerts
+
+pokeTopPrism' :: Int -> Ptr Float -> Ptr GLushort 
+    -> Ptr GLushort 
+    -> (Int,Int,Int)
+    -> [ShapeV] 
+    -> IO (Int,Int,Int)
+pokeTopPrism' size ptr iptr ieptr (nv,nshapeindices,nedgeindices) svs = do
+    nv' <- VS.foldM (pokeJustV' ptr)  nv                (VS.fromList svs)                 
+    nshapeindices' <- UV.foldM (pokeTopPrismIndex' nv iptr) nshapeindices 
+        (memoTopPrismIndices     V.! size)
+    nedgeindices' <- UV.foldM (pokeTopPrismEdgeIndex' nv ieptr) nedgeindices
+        (memoTopPrismEdgeIndices V.! size)
+    return ( nv', nshapeindices', nedgeindices')
+
 pokeTopPrism :: Int -> Ptr Float -> Ptr GLushort 
     -> Ptr GLushort 
     -> UMV.MVector (PrimState IO) Int