Revert to foldMap-ing worldSPic

src/Dodge/Render.hs

@@ -49,9 +49,15 @@ doDrawing pdata u = do
     -- count mutable vectors setup
     layerCounts  <- UMV.replicate (numLayers*6) 0
     -- attempt to poke in parallel
---    let (ws,wp) = wallSPics <> worldSPic cfig w
+    let (ws,wp) = wallSPics <> worldSPic cfig w
+    --( (nWalls, nWins , nFls),(nShapeVs, nIndices, nSilIndices) )
     ( (nWalls, nWins , nFls),(nShapeVs, nIndices, nSilIndices) )
-        <- MP.bindM2 (curry return)
+        <- MP.bindM3 (\_ a b -> return (a,b))
+            ( pokeLayVerxs
+                shadV 
+                layerCounts
+                wp
+            )
             ( pokeWallsWindowsFloor
                 (shadVBOptr $ _wallTextureShader pdata) 
                 (shadVBOptr $ _windowShader pdata) 
@@ -60,14 +66,21 @@ doDrawing pdata u = do
                 windowPoints
                 (_floorTiles w)
             )
-            ( pokeSPics
+            ( pokeShape'
-                shadV 
-                layerCounts
                 (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata)
                 (_eboPtr $ _shapeEBO pdata)
                 (_eboPtr $ _silhouetteEBO pdata)
-                (S.cons wallSPics $ worldSPic cfig w)
+                (0,0,0)
+                ws
             )
+--            ( pokeSPics
+--                shadV 
+--                layerCounts
+--                (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata)
+--                (_eboPtr $ _shapeEBO pdata)
+--                (_eboPtr $ _silhouetteEBO pdata)
+--                (S.cons wallSPics $ worldSPic cfig w)
+--            )
 --        <- MP.bindM3 (\ _ wlwifl counts -> return (wlwifl,counts))
 --            ( pokeBindFoldableLayer shadV layerCounts wp)
 --            ( pokeWallsWindowsFloor

src/Dodge/Render/ShapePicture.hs

@@ -41,21 +41,24 @@ import qualified Data.Set as Set
 import Padding
 --import Data.Foldable
 
-worldSPic :: Configuration -> World -> Stream (Of SPic) IO ()
+singleSPic = id
+
+worldSPic :: Configuration -> World -> SPic
 worldSPic cfig w 
-    =  S.yield (mempty, extraPics cfig w)
+    =  singleSPic (mempty, extraPics cfig w)
-    <> S.map (dbArg _prDraw) (filtOn' _prPos _props)                             
+    <> f (dbArg _prDraw) (filtOn' _prPos _props)                             
-    <> S.map (shiftDraw _blPos _blDir _blDraw) (filtOn' _blPos _blocks)           
+    <> f (shiftDraw _blPos _blDir _blDraw) (filtOn' _blPos _blocks)           
-    <> S.map (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn' _fsPos _shapes)   
+    <> f (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn' _fsPos _shapes)   
-    <> S.map (dbArg _cpPict) (filtOn' _cpPos _corpses)                            
+    <> f (dbArg _cpPict) (filtOn' _cpPos _corpses)                            
-    <> S.map (dbArg _crPict) (filtOn' _crPos _creatures)                          
+    <> f (dbArg _crPict) (filtOn' _crPos _creatures)                          
-    <> S.map floorItemSPic (filtOn' _flItPos _floorItems)                         
+    <> f floorItemSPic (filtOn' _flItPos _floorItems)                         
-    <> S.map btSPic (filtOn' _btPos _buttons)                                     
+    <> f btSPic (filtOn' _btPos _buttons)                                     
-    <> S.map mcSPic (filtOn' _mcPos _machines)                                    
+    <> f mcSPic (filtOn' _mcPos _machines)                                    
-    <> S.yield (anyTargeting cfig w)
+    <> singleSPic (anyTargeting cfig w)
   where
-    --filtOn f g = IM.filter (pointIsClose . f) (g w)
+    f = foldMap
-    filtOn' f g = S.filter (pointIsClose . f) $ S.each (g w)
+    filtOn' f g = IM.filter (pointIsClose . f) (g w)
+    --filtOn' f g = S.filter (pointIsClose . f) $ S.each (g w)
     pointIsClose = cullPoint cfig w
 
 anyTargeting :: Configuration -> World -> SPic

src/Shader/Poke.hs

@@ -5,6 +5,7 @@ module Shader.Poke
     , pokeArrayOff
 --    , pokePoint33s
     , pokeShape
+    , pokeShape'
     , pokeWallsWindowsFloor
     ) where
 import Shader.Data