Use mutable vectors to store shape vertex counts

src/Dodge/Render.hs

@@ -45,8 +45,9 @@ doDrawing pdata w = do
     -- bind as much data into vbos as feasible at this point
     -- pictures setup
     layerCounts <- UMV.replicate (6*6) 0
+    shapeCounts <- UMV.replicate 3 (0 :: Int)
     -- attempt to do this poking in parallel
-    (nWalls,(nShapeVs,nIndices,nSilIndices)) <- MP.bindM3 (\ _ a b -> return (a,b))
+    nWalls <- MP.bindM3 (\ _ a _ -> return a)
         -- pictures poking
         ( pokeBindFoldableLayer shadV layerCounts $ worldPictures w )
         -- poke wall points and colors
@@ -55,8 +56,12 @@ doDrawing pdata w = do
             (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata)
             (_eboPtr $ _shapeEBO pdata)
             (_eboPtr $ _silhouetteEBO pdata)
+            shapeCounts
             $ worldShape w
         )
+    nShapeVs    <- UMV.read shapeCounts 0
+    nIndices    <- UMV.read shapeCounts 1
+    nSilIndices <- UMV.read shapeCounts 2
     -- bind wall points, silhouette data, surface geometry
     uncurry bindShaderBuffers $ unzip
         [ ( _wallTextureShader pdata, nWalls)

src/Shader/Poke.hs

@@ -47,46 +47,61 @@ pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=the
   where
     sn = _unShadNum theShadNum
 
-pokeShape 
+pokeShape
-    :: Ptr Float    -- ^ vertex data pointer
-    -> Ptr GLushort -- ^ vertex indices pointer
-    -> Ptr GLushort -- ^ edge indices pointer
-    -> Shape 
-    -> IO (Int,Int,Int)
-pokeShape vptr iptr ieptr = pokeShapeObjs vptr iptr ieptr (0,0,0)
-
-pokeShapeObjs 
     :: Ptr Float 
     -> Ptr GLushort 
-    -> Ptr GLushort -> (Int,Int,Int) -> [ShapeObj] -> IO (Int,Int,Int)
+    -> Ptr GLushort 
-pokeShapeObjs ptr iptr ieptr count = VS.foldlM' (pokeShapeObj ptr iptr ieptr) count . VS.fromList
+    -> UMV.MVector (PrimState IO) Int 
+    -> [ShapeObj] 
+    -> IO ()
+pokeShape ptr iptr ieptr counts = VS.mapM_ (pokeShapeObj ptr iptr ieptr counts) . VS.fromList
 
-pokeShapeObj :: Ptr Float -> Ptr GLushort -> Ptr GLushort 
+pokeShapeObj 
-    -> (Int,Int,Int) -> ShapeObj -> IO (Int,Int,Int)
+    :: Ptr Float 
+    -> Ptr GLushort 
+    -> Ptr GLushort 
+    -> UMV.MVector (PrimState IO) Int 
+    -> ShapeObj 
+    -> IO ()
 pokeShapeObj ptr iptr ieptr counts (ShapeObj shType shVerts) = case shType of
     TopPrism size -> pokeTopPrism size ptr iptr ieptr counts shVerts
 
 pokeTopPrism :: Int -> Ptr Float -> Ptr GLushort 
-    -> Ptr GLushort -> (Int,Int,Int) -> [ShapeV] -> IO (Int,Int,Int)
+    -> Ptr GLushort 
-pokeTopPrism size ptr iptr ieptr (nv,ni,nei) svs = do
+    -> UMV.MVector (PrimState IO) Int
+    -> [ShapeV] 
+    -> IO ()
+pokeTopPrism size ptr iptr ieptr counts svs = do
 --    MP.bindM3 (\a b c -> return (a,b,c))
 --        (VS.foldlM' (pokeJustV ptr) nv (VS.fromList svs) )
 --        (UV.foldM (pokeTopPrismIndex nv iptr)      ni  (memoTopPrismIndices     V.! (size - 2)) )
 --        (UV.foldM (pokeTopPrismEdgeIndex nv ieptr) nei (memoTopPrismEdgeIndices V.! (size - 2)) )
-    ni'  <- UV.foldM (pokeTopPrismIndex nv iptr)      ni  (memoTopPrismIndices     V.! (size - 2))
+    nv <- UMV.read counts 0
-    nei' <- UV.foldM (pokeTopPrismEdgeIndex nv ieptr) nei (memoTopPrismEdgeIndices V.! (size - 2))
+    UV.mapM_ (pokeTopPrismIndex nv iptr      counts)  (memoTopPrismIndices     V.! (size - 2))
-    nv'  <- VS.foldlM' (pokeJustV ptr) nv (VS.fromList svs)
+    UV.mapM_ (pokeTopPrismEdgeIndex nv ieptr counts) (memoTopPrismEdgeIndices V.! (size - 2))
-    return (nv',ni',nei')
+    VS.mapM_ (pokeJustV ptr counts) (VS.fromList svs)
+--    UMV.modify counts (+ nv') 0
+--    UMV.modify counts (+ ni') 1
+--    UMV.modify counts (+ nei') 2
+    --return (nv',ni',nei')
 
-pokeTopPrismEdgeIndex :: Int -> Ptr GLushort -> Int -> Int -> IO Int
+pokeTopPrismEdgeIndex :: Int -> Ptr GLushort 
-pokeTopPrismEdgeIndex nv iptr ni ioff = do
+    -> UMV.MVector (PrimState IO) Int 
-    pokeElemOff iptr ni (fromIntegral $ nv + ioff)
+    -> Int 
-    return (ni + 1)
+    -> IO ()
+pokeTopPrismEdgeIndex nv eiptr counts ioff = do
+    nei <- UMV.read counts 2
+    pokeElemOff eiptr nei (fromIntegral $ nv + ioff)
+    UMV.modify counts (+1) 2
 
-pokeTopPrismIndex :: Int -> Ptr GLushort -> Int -> Int -> IO Int
+pokeTopPrismIndex :: Int -> Ptr GLushort 
-pokeTopPrismIndex nv iptr ni ioff = do
+    -> UMV.MVector (PrimState IO) Int 
+    -> Int 
+    -> IO ()
+pokeTopPrismIndex nv iptr counts ioff = do
+    ni <- UMV.read counts 1
     pokeElemOff iptr ni (fromIntegral $ nv + ioff)
-    return (ni + 1)
+    UMV.modify counts (+1) 1
 
 memoTopPrismEdgeIndices :: V.Vector (UV.Vector Int)
 memoTopPrismEdgeIndices = V.generate 6 f
@@ -119,8 +134,10 @@ topPrismIndices n = concatMap f [1..n-2]    -- triangles on top face
     g x = [2*x,2*x+1,2*x+3
             ,2*x,2*x+3,2*x+2]
 
-pokeJustV :: Ptr Float -> Int -> ShapeV -> IO Int
+pokeJustV :: Ptr Float -> UMV.MVector (PrimState IO) Int -> ShapeV -> IO ()
-pokeJustV ptr nv sh = do
+pokeJustV ptr counts sh = do
+    nv <- UMV.read counts 0
+    let off i = nv*7 + i
     pokeElemOff ptr (off 0) a
     pokeElemOff ptr (off 1) b
     pokeElemOff ptr (off 2) c
@@ -128,9 +145,8 @@ pokeJustV ptr nv sh = do
     pokeElemOff ptr (off 4) e
     pokeElemOff ptr (off 5) f
     pokeElemOff ptr (off 6) g
-    return (nv+1)
+    UMV.modify counts (+1) 0
   where
-    off i = nv*7 + i
     V3 a b c    = _svPos sh
     V4 d e f g  = _svCol sh