diff --git a/src/Dodge/Render.hs b/src/Dodge/Render.hs
index 8216e277b..f51a4c02a 100644
--- a/src/Dodge/Render.hs
+++ b/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)
diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs
index 9c47340bf..274e6ba55 100644
--- a/src/Shader/Poke.hs
+++ b/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 
-    :: 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 
+pokeShape
     :: Ptr Float 
     -> Ptr GLushort 
-    -> Ptr GLushort -> (Int,Int,Int) -> [ShapeObj] -> IO (Int,Int,Int)
-pokeShapeObjs ptr iptr ieptr count = VS.foldlM' (pokeShapeObj ptr iptr ieptr) count . VS.fromList
+    -> Ptr GLushort 
+    -> 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 
-    -> (Int,Int,Int) -> ShapeObj -> IO (Int,Int,Int)
+pokeShapeObj 
+    :: 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)
-pokeTopPrism size ptr iptr ieptr (nv,ni,nei) svs = do
+    -> Ptr GLushort 
+    -> 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))
-    nei' <- UV.foldM (pokeTopPrismEdgeIndex nv ieptr) nei (memoTopPrismEdgeIndices V.! (size - 2))
-    nv'  <- VS.foldlM' (pokeJustV ptr) nv (VS.fromList svs)
-    return (nv',ni',nei')
+    nv <- UMV.read counts 0
+    UV.mapM_ (pokeTopPrismIndex nv iptr      counts)  (memoTopPrismIndices     V.! (size - 2))
+    UV.mapM_ (pokeTopPrismEdgeIndex nv ieptr counts) (memoTopPrismEdgeIndices V.! (size - 2))
+    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 nv iptr ni ioff = do
-    pokeElemOff iptr ni (fromIntegral $ nv + ioff)
-    return (ni + 1)
+pokeTopPrismEdgeIndex :: Int -> Ptr GLushort 
+    -> UMV.MVector (PrimState IO) Int 
+    -> Int 
+    -> 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 nv iptr ni ioff = do
+pokeTopPrismIndex :: Int -> Ptr GLushort 
+    -> 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 nv sh = do
+pokeJustV :: Ptr Float -> UMV.MVector (PrimState IO) Int -> ShapeV -> IO ()
+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