Commit before attempting to stream worldSPic more effectively

src/Dodge/Config/Data.hs

@@ -29,6 +29,7 @@ data Configuration = Configuration
   deriving (Generic, Show)
 data DebugBool
     = Show_ms_frame
+    | Show_debug
     | Show_sound
     | Noclip
     | Cr_status

src/Dodge/Default/World.hs

@@ -20,7 +20,6 @@ import qualified Data.Map as M
 import qualified Data.Set as S
 import Data.Graph.Inductive.Graph hiding ((&))
 --import Data.Graph.Inductive.NodeMap
---import qualified Data.Vector.Fusion.Stream.Monadic as VS
 defaultWorld :: World
 defaultWorld = World
     { _keys = S.empty

src/Dodge/Render/ShapePicture.hs

@@ -26,6 +26,7 @@ import Picture
 import Sound.Data
 import Geometry.ConvexPoly
 import ShortShow
+import Shape.Data
 --import Dodge.Base.Collide
 
 --import Data.Foldable
@@ -35,27 +36,31 @@ 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
+--import Data.Foldable
 
 -- TODO only filter out shapes outside the range of the furthest shown light source
 worldSPic :: Configuration -> World -> SPic
-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
+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                                                         )
   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
@@ -82,20 +87,23 @@ extraPics cfig w = pictures (_decorations w)
     <> concatMapPic clDraw (_clouds w      )
     <> concatMapPic ppDraw (_pressPlates w )
     <> viewClipBounds cfig w
---    <> debugDraw cfig w
+    <> debugDraw cfig w
 
 debugDraw :: Configuration -> World -> Picture
 {-# INLINE debugDraw #-}
-debugDraw cfig w =
-    pic
-    <> 
-    setLayer FixedCoordLayer (listPicturesAt (0.5*halfWidth cfig) 0 cfig $ map text ts)
+debugDraw cfig w 
+    | Show_debug `Set.member` _debug_booleans cfig =
+        pic
+        <> 
+        setLayer FixedCoordLayer (listPicturesAt (0.5*halfWidth cfig) 0 cfig $ map text ts)
+    | otherwise = mempty
   where
     (ts, pic) = foldMap (debugDraw' cfig w) (_debug_booleans cfig)
 
 debugDraw' :: Configuration -> World -> DebugBool -> ([String],Picture)
 {-# INLINE debugDraw' #-}
 debugDraw' cfig w bl = case bl of
+    Show_debug  -> lstring "Show debug"
     Noclip      -> lstring "Noclip"
     Remove_LOS  -> lstring "No line of sight"
     Cull_more_lights    -> lstring "Cull more lights"