Refactor creature zoning

src/Dodge/Base/Collide.hs

@@ -40,6 +40,7 @@ module Dodge.Base.Collide
     ) where
 import Dodge.Data
 import Dodge.Zone
+import Dodge.Zoning
 import Dodge.Base.Wall
 import Geometry
 
@@ -49,6 +50,7 @@ import Control.Lens
 import Control.Monad
 import StreamingHelp
 import qualified Streaming.Prelude as S
+import qualified Data.IntSet as IS
 
 collidePoint :: Point2 -> Point2 
     -> StreamOf Wall
@@ -59,10 +61,10 @@ collidePoint sp ep = runIdentity . S.fold_ findPoint (ep, Nothing) id
     findPoint (p,mwl) wl = maybe (p,mwl) (,Just wl) . uncurry (intersectSegSeg sp p) . _wlLine $ wl
 
 overlap1SegCrs :: Point2 -> Point2 
-    -> StreamOf Creature
-    -> StreamOf (Point2, Creature)
+    -> [Creature]
+    -> [(Point2, Creature)]
 {-# INLINE overlap1SegCrs #-}
-overlap1SegCrs sp ep = S.mapMaybe 
+overlap1SegCrs sp ep = mapMaybe 
     (\cr -> (,cr) <$> listToMaybe (intersectCircSeg (_crPos cr) (_crRad cr) sp ep ))
 
 overlapSegCrs :: Point2 -> Point2 
@@ -172,8 +174,9 @@ circOnSomeWall p rad = runIdentity . S.any_ (uncurry (circOnSeg p rad) . _wlLine
 
 circOnAnyCr :: Point2 -> Float -> World -> Bool
 {-# INLINE circOnAnyCr #-}
-circOnAnyCr p r = runIdentity . S.any_ (\cr -> dist p (_crPos cr) < r + _crRad cr)
-    . crsNearPoint p
+circOnAnyCr p r w = IS.foldr f False $ crIXsNearPoint p w
+  where
+    f cid bl = maybe False (\cr -> dist p (_crPos cr) < r + _crRad cr) (w ^? creatures . ix cid) || bl
 
 {- | More general collision tests follow -}
 
@@ -218,6 +221,10 @@ canSeeIndirect i j w = hasLOSIndirect ipos jpos w
 anythingHitCirc :: Float -> Point2 -> Point2 -> World -> Bool
 anythingHitCirc rad sp ep w = hitCr || isJust (sequence hitWl)
   where
-    hitCr    = runIdentity $ S.any_ (const True) $ overlap1SegCrs sp ep $ crsNearSeg sp ep w
+    hitCr    = IS.foldr f False $ crsNearSeg sp ep w
+    f cid bl = maybe False (\cr -> null $ intersectCircSeg (_crPos cr) (rad + _crRad cr) sp ep)
+            (w ^? creatures . ix cid)
+        || bl
+
     hitWl    = collideCircWallsStream sp ep rad $ wlsNearPoint ep w
                                                     -- this should probably be wallsOnLine or something