Make pictures use Streaming

src/Dodge/Creature/Lamp.hs

@@ -16,6 +16,8 @@ import Polyhedra
 import qualified IntMapHelp as IM
 import LensHelp
 
+import qualified Streaming.Prelude as S
+
 colorLamp 
     :: Point3   -- color of lamp
     -> Float    -- height of lamp
@@ -39,7 +41,7 @@ lamp h = defaultInanimate
 lampCrPic :: Float -> Picture
 lampCrPic h = pictures 
     [ setLayer BloomLayer (setDepth h . color white $ circleSolid 3)
-    , concatMap (polyToTris . map f) $ boxXYZnobase 5 5 (h-1)
+    , foldMap (S.each . polyToTris . map f) $ boxXYZnobase 5 5 (h-1)
     ]
   where
     f pos = Verx (pos -.-.- V3 2.5 2.5 0) blue [] BottomLayer polyNum

src/Dodge/Render/HUD.hs

@@ -235,7 +235,7 @@ combineCounts cfig w = winScale cfig . foldMap f . group
 
 lnkMidPosInvSelsCol :: Configuration -> World -> Int -> Color -> [Int] -> Picture
 lnkMidPosInvSelsCol cfig w i col = winScale cfig 
-    . concatMap (\j -> zConnectCol rp (V2 18 0+selNumMidHeight cfig w j) col white white (selNumCol j w))
+    . foldMap (\j -> zConnectCol rp (V2 18 0+selNumMidHeight cfig w j) col white white (selNumCol j w))
   where
 --    lp ipos = V2 (150 - hw) ( hh - (20 * fromIntegral ipos + 17.5))
     rp = V2 (190 - hw) ( hh - (20 * fromIntegral i + 77.5))

src/Dodge/Render/List.hs

@@ -6,6 +6,7 @@ import Picture
 import Geometry
 --import Control.Monad
 import Data.Maybe
+import Data.Foldable
 
 -- given a list of pictures that are each the size of a "text" call, displays them as
 -- a list on the screen
@@ -30,7 +31,7 @@ listCursorChooseBorder borders xoff yoff cfig yint col cursxsize cursysize = win
     hgt = 20 * fromIntegral cursysize
 -- note we cannot simply scale lines because they are drawn as solid rectangles
 chooseCursorBorders :: Float -> Float -> [Bool] -> Picture
-chooseCursorBorders wth hgt = concat . catMaybes . zipWith f
+chooseCursorBorders wth hgt = fold . catMaybes . zipWith f
     [ line [V2   0 hgt , V2 wth hgt ] 
     , line [V2 wth hgt , V2 wth   0 ] 
     , line [V2 wth   0 , V2   0   0 ]

src/Dodge/Render/ShapePicture.hs

@@ -38,18 +38,19 @@ import qualified Streaming.Prelude as S
 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 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)
+    <> 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)
@@ -81,7 +82,7 @@ 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 #-}
@@ -187,7 +188,7 @@ drawWorldSelect w = setLayer DebugLayer
 drawFarWallDetect :: World -> Picture
 drawFarWallDetect w = setLayer DebugLayer 
     . color yellow 
-    . concatMap (\q -> line 
+    . foldMap (\q -> line 
         [ p
         , fst $ collidePoint p q $ S.filter wlIsOpaque $ wlsNearSeg p q w
         ]   )
@@ -305,7 +306,7 @@ edgeToPic poly pe
 drawPathing :: Configuration -> World -> Picture
 drawPathing cfig w = setLayer DebugLayer
     $  foldMap (edgeToPic (screenPolygon cfig w) . (^?! _3)) (FGL.labEdges gr)
-    <> concatMap dispInc (graphToIncidence gr)
+    <> foldMap dispInc (graphToIncidence gr)
   where
     dispInc (p,n) = setDepth 2 . uncurryV translate p . scale 0.1 0.1 $ text $ show n
     gr = _pathGraph w
@@ -340,8 +341,8 @@ drawCrInfo cfig w = setLayer FixedCoordLayer
     hw = halfWidth cfig
 
 viewBoundaries :: World -> Picture
-viewBoundaries w = setLayer DebugLayer $ color green (concatMap (polygonWire . _grBound) grs)
-    <> color yellow (concatMap (\q -> line [p,q]) $ farWallPoints p w)
+viewBoundaries w = setLayer DebugLayer $ color green (foldMap (polygonWire . _grBound) grs)
+    <> color yellow (foldMap (\q -> line [p,q]) $ farWallPoints p w)
   where
     p = _crPos $ you w
     grs = filter (pointInOrOnPolygon p . _grBound) (_gameRooms w)
@@ -349,10 +350,10 @@ viewBoundaries w = setLayer DebugLayer $ color green (concatMap (polygonWire . _
 viewClipBounds :: Configuration -> World -> Picture
 viewClipBounds cfig w
     | _debug_view_clip_bounds cfig == AllRoomClipBoundaries
-         = setLayer DebugLayer $ color green $ concatMap (polygonWire . _cpPoints) (_roomClipping w)
+         = setLayer DebugLayer $ color green $ foldMap (polygonWire . _cpPoints) (_roomClipping w)
     | _debug_view_clip_bounds cfig == IntersectingRoomClipBoundaries
         = setLayer DebugLayer $ f (_roomClipping w)
-    | otherwise = []
+    | otherwise = mempty
   where
     f (x:xs) = g x xs <> f xs
     f [] = mempty