Move towards unifying zoning

src/Dodge/Zoning/Base.hs

@@ -8,10 +8,10 @@ import Geometry.Zone
 import qualified IntMapHelp as IM
 
 zoneOfCirc :: Float -> Point2 -> Float -> [Int2]
-zoneOfCirc zsize p r = zoneOfRect' zsize (p +.+ V2 r r) (p -.- V2 r r)
+zoneOfCirc zsize p r = zoneOfRect zsize (p +.+ V2 r r) (p -.- V2 r r)
 
-zoneOfRect' :: Float -> Point2 -> Point2 -> [Int2]
+zoneOfRect :: Float -> Point2 -> Point2 -> [Int2]
-zoneOfRect' s sp ep = [V2 x y | x <- makeIntInterval sx ex, y <- makeIntInterval sy ey]
+zoneOfRect s sp ep = [V2 x y | x <- makeIntInterval sx ex, y <- makeIntInterval sy ey]
   where
     V2 sx sy = zoneOfPoint s sp
     V2 ex ey = zoneOfPoint s ep
@@ -33,6 +33,7 @@ zoneOfSeg :: Float -> Point2 -> Point2 -> [Int2]
 zoneOfSeg s sp ep = map (zoneOfPoint s) (sp : xIntercepts s sp ep ++ yIntercepts' s sp ep)
 
 zoneExtract :: Monoid m => Int2 -> IM.IntMap (IM.IntMap m) -> m
+{-# INLINE zoneExtract #-}
 zoneExtract (V2 x y) = fromMaybe mempty . (^? ix x . ix y)
 
 zonesExtract :: Monoid m => IM.IntMap (IM.IntMap m) -> [Int2] -> m

src/Dodge/Zoning/Cloud.hs

@@ -6,15 +6,17 @@ import Dodge.Data.World
 import Dodge.Zoning.Base
 import Geometry
 import qualified IntMapHelp as IM
+import Dodge.Zoning.Common
 
 clsNearPoint :: Point2 -> World -> [Cloud]
-clsNearPoint p w = zoneExtract (zoneOfPoint clZoneSize p) (w ^. cWorld . lWorld . clZoning)
+--clsNearPoint p w = zoneExtract (zoneOfPoint clZoneSize p) (w ^. cWorld . lWorld . clZoning)
+clsNearPoint = nearPoint clZoneSize _clZoning
 
 clsNearSeg :: Point2 -> Point2 -> World -> [Cloud]
 clsNearSeg sp ep w = zonesExtract (w ^. cWorld . lWorld . clZoning) (zoneOfSeg clZoneSize sp ep)
 
 clsNearRect :: Point2 -> Point2 -> World -> [Cloud]
-clsNearRect sp ep w = zonesExtract (w ^. cWorld . lWorld . clZoning) $ zoneOfRect' clZoneSize sp ep
+clsNearRect sp ep w = zonesExtract (w ^. cWorld . lWorld . clZoning) $ zoneOfRect clZoneSize sp ep
 
 clsNearCirc :: Point2 -> Float -> World -> [Cloud]
 clsNearCirc p r = clsNearRect (p +.+ V2 r r) (p -.- V2 r r)

src/Dodge/Zoning/Common.hs

@@ -0,0 +1,19 @@
+module Dodge.Zoning.Common where
+
+import Dodge.Data.World
+import Control.Lens
+import Dodge.Zoning.Base
+import Geometry
+import qualified IntMapHelp as IM
+
+nearPoint :: Monoid m => Float -> (LWorld -> IM.IntMap (IM.IntMap m)) -> Point2 -> World -> m
+{-# INLINE nearPoint #-}
+nearPoint size f p w = zoneExtract (zoneOfPoint size p) (f $ w ^. cWorld . lWorld)
+
+nearSeg :: Monoid m => Float -> (LWorld -> IM.IntMap (IM.IntMap m)) -> Point2 -> Point2 -> World -> m
+{-# INLINE nearSeg #-}
+nearSeg size f sp ep w = zonesExtract (f $ w ^. cWorld . lWorld) (zoneOfSeg size sp ep)
+
+nearRect :: Monoid m => Float -> (LWorld -> IM.IntMap (IM.IntMap m)) -> Point2 -> Point2 -> World -> m
+{-# INLINE nearRect #-}
+nearRect size f sp ep w = zonesExtract (f $ w ^. cWorld . lWorld) (zoneOfSeg size sp ep)

src/Dodge/Zoning/Creature.hs

@@ -8,9 +8,11 @@ import Dodge.Zoning.Base
 import FoldableHelp
 import Geometry
 import qualified IntMapHelp as IM
+import Dodge.Zoning.Common
 
 crIXsNearPoint :: Point2 -> World -> IS.IntSet
-crIXsNearPoint p w = zoneExtract (zoneOfPoint crZoneSize p) (w ^. cWorld . lWorld . crZoning)
+--crIXsNearPoint p w = zoneExtract (zoneOfPoint crZoneSize p) (w ^. cWorld . lWorld . crZoning)
+crIXsNearPoint = nearPoint crZoneSize _crZoning
 
 crsNearPoint :: Point2 -> World -> [Creature]
 crsNearPoint p w = mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid) . IS.toList $ crIXsNearPoint p w
@@ -22,7 +24,8 @@ crsNearSeg sp ep w =
     $ crixsNearSeg sp ep w
 
 crixsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
-crixsNearSeg sp ep w = zonesExtract (w ^. cWorld . lWorld . crZoning) (zoneOfSeg crZoneSize sp ep)
+crixsNearSeg = nearSeg crZoneSize _crZoning
+--crixsNearSeg sp ep w = zonesExtract (w ^. cWorld . lWorld . crZoning) (zoneOfSeg crZoneSize sp ep)
 
 crIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet
 crIXsNearCirc p r = crsNearRect (p +.+ V2 r r) (p -.- V2 r r)
@@ -31,7 +34,7 @@ crsNearCirc :: Point2 -> Float -> World -> [Creature]
 crsNearCirc p r w = mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid) . IS.toList $ crIXsNearCirc p r w
 
 crsNearRect :: Point2 -> Point2 -> World -> IS.IntSet
-crsNearRect sp ep w = zonesExtract (w ^. cWorld . lWorld . crZoning) $ zoneOfRect' crZoneSize sp ep
+crsNearRect sp ep w = zonesExtract (w ^. cWorld . lWorld . crZoning) $ zoneOfRect crZoneSize sp ep
 
 crZoneSize :: Float
 crZoneSize = 15

src/Dodge/Zoning/Pathing.hs

@@ -16,7 +16,7 @@ pnsNearSeg :: Point2 -> Point2 -> World -> [(Int, Point2)]
 pnsNearSeg sp ep w = zonesExtract (w ^. cWorld . lWorld . pnZoning) (zoneOfSeg pnZoneSize sp ep)
 
 pnsNearRect :: Point2 -> Point2 -> World -> [(Int, Point2)]
-pnsNearRect sp ep w = zonesExtract (w ^. cWorld . lWorld . pnZoning) $ zoneOfRect' pnZoneSize sp ep
+pnsNearRect sp ep w = zonesExtract (w ^. cWorld . lWorld . pnZoning) $ zoneOfRect pnZoneSize sp ep
 
 pnsNearCirc :: Point2 -> Float -> World -> [(Int, Point2)]
 pnsNearCirc p r = pnsNearRect (p +.+ V2 r r) (p -.- V2 r r)
@@ -37,7 +37,7 @@ pesNearSeg :: Point2 -> Point2 -> World -> Set PathEdgeNodes
 pesNearSeg sp ep w = zonesExtract (w ^. cWorld . lWorld . peZoning) (zoneOfSeg peZoneSize sp ep)
 
 pesNearRect :: Point2 -> Point2 -> World -> Set PathEdgeNodes
-pesNearRect sp ep w = zonesExtract (w ^. cWorld . lWorld . peZoning) $ zoneOfRect' peZoneSize sp ep
+pesNearRect sp ep w = zonesExtract (w ^. cWorld . lWorld . peZoning) $ zoneOfRect peZoneSize sp ep
 
 pesNearCirc :: Point2 -> Float -> World -> Set PathEdgeNodes
 pesNearCirc p r = pesNearRect (p +.+ V2 r r) (p -.- V2 r r)

src/Dodge/Zoning/Wall.hs

@@ -17,7 +17,7 @@ wlIXsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
 wlIXsNearSeg sp ep w = zonesExtract (w ^. cWorld . lWorld . wlZoning) (zoneOfSeg wlZoneSize sp ep)
 
 wlIXsNearRect :: Point2 -> Point2 -> World -> IS.IntSet
-wlIXsNearRect sp ep w = zonesExtract (w ^. cWorld . lWorld . wlZoning) $ zoneOfRect' wlZoneSize sp ep
+wlIXsNearRect sp ep w = zonesExtract (w ^. cWorld . lWorld . wlZoning) $ zoneOfRect wlZoneSize sp ep
 
 wlIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet
 wlIXsNearCirc p r = wlIXsNearRect (p +.+ V2 r r) (p -.- V2 r r)