Make zoning more universal

src/Dodge/Zone/Object.hs

@@ -0,0 +1,16 @@
+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
+
+zoneOfCreature :: Float -> Creature -> StreamOf Int2
+zoneOfCreature x cr = zoneInsideCirc x (_crPos cr) (_crRad cr)
+
+zoneOfWall :: Float -> Wall -> StreamOf Int2
+zoneOfWall x = uncurry (zoneOfSeg x) . _wlLine
+
+zonePos :: (a -> Point2) -> Float -> a -> StreamOf Int2
+zonePos f x = S.yield . zoneOfPoint x . f

src/Dodge/Zone/Update.hs

@@ -0,0 +1,32 @@
+module Dodge.Zone.Update where
+import Dodge.Data.Zoning
+import StreamingHelp
+import qualified Streaming.Prelude as S
+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))
+  where
+    doinsert znobs vxy = insertInZoneWith vxy (\_ -> f obj) (f obj mempty) znobs
+
+--alterInZone :: (a -> Maybe (t a) -> Maybe (t a)) -> a -> Zoning 
+
+updateInZoning' :: Applicative t => (t a -> t a -> t a) -> a -> Zoning t a -> Zoning t a
+updateInZoning' f obj zn = runIdentity (S.fold_ doinsert zn id (_znFunc zn (_znSize zn) obj))
+  where
+    doinsert znobs vxy = insertInZoneWith vxy f (pure obj) znobs
+
+imInsert :: (a -> Int) -> a -> IM.IntMap a -> IM.IntMap a
+imInsert getID x = IM.insert (getID x) x
+
+insertInZoneWith
+    :: Int2
+    -> (t a -> t a -> t a) -- ^ Combining function
+    -> t a            -- ^ Value to insert
+    -> Zoning t a 
+    -> Zoning t a
+insertInZoneWith (V2 x y) fun obj = over znObjects $ IM.insertWith f x $ IM.singleton y obj
+  where
+    f _ = IM.insertWith fun y obj