Attempt to stream SPics, not sure if this improves speed

src/Dodge/Render.hs

@@ -27,6 +27,7 @@ import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
 import qualified SDL
 import qualified Data.Vector.Unboxed.Mutable as UMV
 import Graphics.GL.Core43
+import qualified Streaming.Prelude as S
 
 doDrawing :: RenderData -> Universe -> IO Word32
 doDrawing pdata u = do
@@ -48,10 +49,9 @@ 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) )
-        <- MP.bindM3 (\ _ wlwifl counts -> return (wlwifl,counts))
-            ( pokeBindFoldableLayer shadV layerCounts wp)
+        <- MP.bindM2 (\ wlwifl counts -> return (wlwifl,counts))
             ( pokeWallsWindowsFloor
                 (shadVBOptr $ _wallTextureShader pdata) 
                 (shadVBOptr $ _windowShader pdata) 
@@ -60,13 +60,32 @@ doDrawing pdata u = do
                 windowPoints
                 (_floorTiles w)
             )
-            ( pokeShape
+            ( pokeSPics
+                shadV 
+                layerCounts
                 (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata)
                 (_eboPtr $ _shapeEBO pdata)
                 (_eboPtr $ _silhouetteEBO pdata)
-                ws
+                (S.cons wallSPics $ worldSPic cfig w)
             )
+--        <- MP.bindM3 (\ _ wlwifl counts -> return (wlwifl,counts))
+--            ( pokeBindFoldableLayer shadV layerCounts wp)
+--            ( pokeWallsWindowsFloor
+--                (shadVBOptr $ _wallTextureShader pdata) 
+--                (shadVBOptr $ _windowShader pdata) 
+--                (shadVBOptr $ _textureArrayShader pdata)
+--                wallPointsCol
+--                windowPoints
+--                (_floorTiles w)
+--            )
+--            ( pokeShape
+--                (_vboPtr $ _vaoVBO $ _shadVAO $ _shapeShader pdata)
+--                (_eboPtr $ _shapeEBO pdata)
+--                (_eboPtr $ _silhouetteEBO pdata)
+--                ws
+--            )
     -- bind wall points, silhouette data, surface geometry
+    bindShaderLayers shadV layerCounts
     uncurry bindShaderBuffers $ unzip
         [ ( _wallTextureShader pdata, nWalls)
         , (_shapeShader pdata, nShapeVs)

src/Dodge/Render/ShapePicture.hs

@@ -26,9 +26,9 @@ import Picture
 import Sound.Data
 import Geometry.ConvexPoly
 import ShortShow
-import Shape.Data
 --import Dodge.Base.Collide
 
+import StreamingHelp
 --import Data.Foldable
 import qualified Data.IntMap.Strict as IM -- Lazy?
 import qualified Data.Map.Strict as M
@@ -36,31 +36,28 @@ import qualified Data.Map.Strict as M
 import Control.Lens
 import Data.Maybe
 import qualified Streaming.Prelude as S
-import Streaming
 import qualified Data.Graph.Inductive as FGL
 import qualified Data.Set as Set
 import Padding
 --import Data.Foldable
 
 -- TODO only filter out shapes outside the range of the furthest shown light source
-worldSPic :: Configuration -> World -> SPic
+worldSPic :: Configuration -> World -> Stream (Of SPic) IO ()
 worldSPic cfig w 
-    =  ((mempty, extraPics cfig w)                                                  )
-    <> (foldMap (dbArg _prDraw) (filtOn _prPos _props)                              )
-    <> (foldMap (shiftDraw _blPos _blDir _blDraw) (filtOn _blPos _blocks)           )
-    <> (foldMap (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _shapes)   )
-    <> (foldMap (dbArg _cpPict) (filtOn _cpPos _corpses)                            )
-    <> (foldMap (dbArg _crPict) (filtOn _crPos _creatures)                          )
-    <> (foldMap floorItemSPic (filtOn _flItPos _floorItems)                         )
-    <> (foldMap btSPic (filtOn _btPos _buttons)                                     )
-    <> (foldMap mcSPic (filtOn _mcPos _machines)                                    )
-    <> (anyTargeting cfig w                                                         )
+    =  (S.yield (mempty, extraPics cfig w)                                                  )
+    <> (S.each $ fmap (dbArg _prDraw) (filtOn _prPos _props)                              )
+    <> (S.each $ fmap (shiftDraw _blPos _blDir _blDraw) (filtOn _blPos _blocks)           )
+    <> (S.each $ fmap (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _shapes)   )
+    <> (S.each $ fmap (dbArg _cpPict) (filtOn _cpPos _corpses)                            )
+    <> (S.each $ fmap (dbArg _crPict) (filtOn _crPos _creatures)                          )
+    <> (S.each $ fmap floorItemSPic (filtOn _flItPos _floorItems)                         )
+    <> (S.each $ fmap btSPic (filtOn _btPos _buttons)                                     )
+    <> (S.each $ fmap mcSPic (filtOn _mcPos _machines)                                    )
+    <> S.yield (anyTargeting cfig w                                                         )
   where
     filtOn f g = IM.filter (pointIsClose . f) (g w)
     pointIsClose = cullPoint cfig w
 
-type SPicStream = Stream (Of ShapeObj) (Stream (Of Verx) IO) ()
-
 anyTargeting :: Configuration -> World -> SPic
 anyTargeting cfig w = (mempty,pictures $ IM.elems $ IM.mapMaybe f $ _crInv cr)
   where

src/Shader/Poke.hs

@@ -1,5 +1,6 @@
 module Shader.Poke
     ( pokeVerxs
+    , pokeSPics
     , pokeLayVerxs
     , pokeArrayOff
 --    , pokePoint33s
@@ -11,6 +12,7 @@ import Shader.Parameters
 import Picture.Data
 import Shape.Data
 import Geometry.Data
+import ShapePicture
 
 import Graphics.Rendering.OpenGL hiding (color,scale,translate,rotate)
 import Foreign
@@ -27,7 +29,7 @@ import Streaming
 pokeVerxs 
     :: MV.MVector (PrimState IO) FullShader
     -> UMV.MVector (PrimState IO) Int 
-    -> Picture 
+    -> Picture
     -> IO ()
 pokeVerxs vbos count = S.mapM_ (pokeVerx vbos count)
 
@@ -80,11 +82,28 @@ pokeW ptr i' ((V2 a b,V2 c d),V4 e f g h) = do
     pokeElemOff ptr (i + 7) h
     return $ i' + 1
 
+pokeSPics
+    :: MV.MVector (PrimState IO) FullShader 
+    -> UMV.MVector (PrimState IO) Int
+    -> Ptr Float -> Ptr GLushort -> Ptr GLushort 
+    -> Stream (Of SPic) IO ()
+    -> IO (Int,Int,Int)
+pokeSPics vbos counts ptr iptr ieptr = 
+    S.foldM_ (\is (sh,pic) -> pokeLayVerxs vbos counts pic >> pokeShape' ptr iptr ieptr is sh)
+    (return (0,0,0)) return
+    
+
 pokeShape :: Ptr Float -> Ptr GLushort -> Ptr GLushort 
     -> Stream (Of ShapeObj) IO ()
     -> IO (Int,Int,Int)
 pokeShape ptr iptr ieptr = S.foldM_ (pokeShapeObj ptr iptr ieptr) (return (0,0,0)) return
 
+pokeShape' :: Ptr Float -> Ptr GLushort -> Ptr GLushort 
+    -> (Int,Int,Int)
+    -> Stream (Of ShapeObj) IO ()
+    -> IO (Int,Int,Int)
+pokeShape' ptr iptr ieptr is = S.foldM_ (pokeShapeObj ptr iptr ieptr) (return is) return
+
 pokeShapeObj
     :: Ptr Float 
     -> Ptr GLushort 

src/Shape/Data.hs

@@ -26,7 +26,6 @@ shVfromList = id
 --shVfromList = DL.fromList
 {-# INLINE shEfromList #-}
 shEfromList = id
---shEfromList = DL.fromList
 
 data ShapeObj = ShapeObj 
     { _shType :: ShapeType 

src/StreamingHelp.hs

@@ -23,3 +23,11 @@ sortStreamOn :: Ord a => (b -> a) -> StreamOf b -> Stream (Of b) Identity ()
 sortStreamOn f = S.each . runIdentity . L.purely S.fold_ L.map . S.map g
   where
     g x = (f x,x)
+
+--applyUnzip 
+--    :: (Stream (Of a) IO () -> IO r) 
+--    -> (Stream (Of b) IO () -> IO ())
+--    -> Stream (Of a) (Stream g IO) () 
+--    -> IO r
+--applyUnzip f g s = h s
+