Move streaming data into its own file

src/Dodge/Data.hs

@@ -66,6 +66,7 @@ import Dodge.GameRoom
 import Color
 import Data.Tile
 import MaybeHelp
+--import StreamingHelp.Data
 
 --import qualified Data.Vector as V
 import qualified Linear.Quaternion as Q

src/Dodge/Default/World.hs

@@ -35,7 +35,7 @@ defaultWorld = World
     , _creatures        = IM.empty
     , _crZoning         = Zoning IM.empty crZoneSize zoneOfCreature
     , _creatureGroups   = IM.empty
-    , _clouds = []
+    , _clouds           = mempty
     , _clZoning         = Zoning IM.empty clZoneSize (zonePos (stripZ . _clPos))
     , _gusts = IM.empty
     , _gsZoning         = Zoning IM.empty clZoneSize (zonePos _guPos)

src/Dodge/Path.hs

@@ -93,10 +93,9 @@ removePathsCrossing :: Point2 -> Point2 -> World -> World
 removePathsCrossing a b w = w
     & pathGraph  .~ newGraph 
     & pathGraphP .~ pg'
-    & phZoning   %~ \zn -> foldl' (flip $ insertInZoning (:)) (zn & znObjects .~ mempty)
+    & phZoning   %~ \zn -> foldl' (flip $ updateZoning (:)) (zn & znObjects .~ mempty)
         (labNodes newGraph)
   where 
     pg' = Set.filter (isNothing . uncurry (intersectSegSeg a b)) $ _pathGraphP w
-    insertpoint zn (i,p) = insertInZoneWith (wlZoneOfPoint p) (++) [(i,p)] zn
    -- insertPoint pp@(_,p) = insertInZoneWith (wlZoneOfPoint p) (++) [pp]
     newGraph = pairsToGraph dist pg'

src/Dodge/Render/ShapePicture.hs

@@ -73,6 +73,7 @@ extraPics cfig w = pictures (_decorations w)
     <> concatMapPic (dbArg _lsPict) (_lightSources w)
     <> testPic cfig w
     <> _debugPicture w
+--    <> runIdentity (S.foldMap_ clDraw (_clouds w))
     <> concatMapPic clDraw (_clouds w      )
     <> concatMapPic ppDraw (_pressPlates w )
     <> soundPics cfig w

src/Dodge/Update.hs

@@ -98,11 +98,8 @@ functionalUpdate cfig w = checkEndGame
 
 zoneClouds :: World -> World
 zoneClouds w = w & clZoning %~ \zn ->
-    foldl' (flip $ insertInZoning (:)) (zn & znObjects .~ mempty) (_clouds w)
---  where
---    cloudInZone cl = insertInZoneWith p (++) [cl]
---      where 
---        p = clZoneOfPoint $ stripZ $ _clPos cl
+    foldl' (flip $ updateZoning (:)) (zn & znObjects .~ mempty) (_clouds w)
+    --runIdentity (S.fold_ (flip $ updateZoning (:)) (zn & znObjects .~ mempty) id (_clouds w))
 
 updateWorldSelect :: World -> World
 updateWorldSelect w = case w ^? mouseButtons . ix ButtonLeft of
@@ -150,25 +147,8 @@ doRewind w = case _maybeWorld w of
 
 zoneCreatures :: World -> World
 zoneCreatures w = w & crZoning %~ \zn ->
-    foldl' (flip $ insertInZoning (\cr -> IM.insert (_crID cr) cr)) 
+    foldl' (flip $ updateZoning (\cr -> IM.insert (_crID cr) cr)) 
         (zn & znObjects .~ mempty) (_creatures w)
---        . znObjects .~
---        IM.foldl' zoneCreature IM.empty (_creatures w)
-----        runIdentity (S.fold_ zoneCreature IM.empty id (S.each $ _creatures w))
---
---zoneCreature :: IM.IntMap (IM.IntMap (IM.IntMap Creature)) 
---    -> Creature
---    -> IM.IntMap (IM.IntMap (IM.IntMap Creature)) 
---zoneCreature m cr = runIdentity $ S.fold_ doinsert m id (zoneOfCreature cr)
---  where
---    doinsert m' (V2 x y) = insertIMInZone x y (_crID cr) cr m'
-
---        IM.foldl' (flip creatureInZone) IM.empty (_creatures w)
---  where
---    creatureInZone cr = insertIMInZone x y cid cr
---      where 
---        V2 x y = crZoneOfPoint $ _crPos cr
---        cid = _crID cr
 
 updateCreatureSoundPositions :: World -> World
 updateCreatureSoundPositions w = M.foldlWithKey' insertSound w 
@@ -338,6 +318,7 @@ mvGust _ gu
 updateClouds :: World -> World
 updateClouds w = w' & clouds .~ catMaybes mclouds
   where
+--    cls = _clouds w
     (w',mclouds) = mapAccumR updateCloud w (_clouds w)
 
 updateCloud :: World -> Cloud -> (World,Maybe Cloud)

src/Dodge/Wall/Zone.hs

@@ -1,23 +1,21 @@
 module Dodge.Wall.Zone
     where
 import Dodge.Data
-import Geometry
 import Dodge.Zone
-import Dodge.Base
 
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
 --import Data.Foldable
 --import Streaming
-import qualified Streaming.Prelude as S
+--import qualified Streaming.Prelude as S
 
 insertWallInZones :: Wall -> World -> World
-insertWallInZones wl = wlZoning %~ insertInZoning (IM.insert (_wlID wl)) wl
---insertWallInZones wl = wlZoning . znObjects
+insertWallInZones wl = wlZoning %~ updateZoning (IM.insert (_wlID wl)) wl
+--insertWallInZones wl = wlZoning .updatets
 --    %~ (runIdentity . (\wlzns -> S.fold_ doinsert wlzns id (zoneOfWall wl)))
 --  where
 --    doinsert wlzns (V2 x y) = insertIMInZone x y (_wlID wl) wl wlzns
 
 deleteWallFromZones :: Wall -> World -> World
-deleteWallFromZones wl = wlZoning %~ insertInZoning (const $ IM.delete (_wlID wl)) wl
---    %~ flip (foldl' (flip $ \(a,b) -> deleteIMInZone a b (_wlID wl))) (zoneOfWall wl)
+deleteWallFromZones wl = wlZoning %~ updateZoning (const $ IM.delete (_wlID wl)) wl
+--    %~ flip (foldl' (flip $ \(a,b) updateeIMInZone a b (_wlID wl))) (zoneOfWall wl)

src/Dodge/WorldEvent/Cloud.hs

@@ -13,6 +13,7 @@ import Geometry.Data
 import Picture
 import LensHelp
 
+--import qualified Streaming.Prelude as S
 --import Control.Lens
 import System.Random
 
@@ -25,6 +26,7 @@ makeCloudAt
     -> World 
     -> World
 makeCloudAt drawFunc rad t alt p = clouds .:~ Cloud 
+--makeCloudAt drawFunc rad t alt p = clouds %~ S.cons Cloud 
     { _clPos = p
     , _clVel = V3 0 0 0
     , _clPict = drawFunc

src/Dodge/WorldEvent/SpawnParticle.hs

@@ -225,6 +225,7 @@ makeGasCloud
     -> World
 makeGasCloud pos vel w = w
     & clouds    .:~ theCloud
+--    & clouds    %~ S.cons theCloud
     & randGen   .~ g
   where 
     theCloud = Cloud 

src/Dodge/Zone/Object.hs

@@ -2,7 +2,6 @@ module Dodge.Zone.Object where
 import Dodge.Data
 import Geometry.Zone
 import Geometry.Data
-import Geometry.Vector3D
 import StreamingHelp
 import qualified Streaming.Prelude as S
 

src/Dodge/Zone/Update.hs

@@ -6,8 +6,8 @@ import qualified Data.IntMap.Strict as IM
 import Geometry
 import LensHelp
 
-insertInZoning :: Monoid (t a) => (a -> t a -> t a) -> a -> Zoning t a -> Zoning t a
-insertInZoning f obj zn = runIdentity (S.fold_ doinsert zn id (_znFunc zn (_znSize zn) obj))
+updateZoning :: Monoid (t a) => (a -> t a -> t a) -> a -> Zoning t a -> Zoning t a
+updateZoning f obj zn = runIdentity (S.fold_ doinsert zn id (_znFunc zn (_znSize zn) obj))
   where
     doinsert znobs vxy = insertInZoneWith vxy (\_ -> f obj) (f obj mempty) znobs
 

src/StreamingHelp.hs

@@ -1,15 +1,15 @@
 module StreamingHelp 
     ( minStreamOn
     , sortStreamOn
-    , StreamOf
     , module Streaming
+    , module StreamingHelp.Data
     ) where
 import Streaming
+import StreamingHelp.Data
 import qualified Streaming.Prelude as S
 import qualified Control.Foldl as L
 import Data.Function (on)
 
-type StreamOf a = Stream (Of a) Identity ()
 
 minStreamOn :: Ord a => (b -> a) -> StreamOf b -> Maybe b
 {-# INLINE minStreamOn #-}

src/StreamingHelp/Data.hs

@@ -0,0 +1,5 @@
+module StreamingHelp.Data where
+import Streaming
+type StreamOf a = Stream (Of a) Identity ()
+
+newtype StreamOf' a = StreamOf' (Stream (Of a) Identity ())