Refactor path zoning

src/Dodge/Zoning/Base.hs

@@ -65,6 +65,11 @@ zoneMonoid (V2 x y) a = IM.insertWith f x $ IM.singleton y a
 deZoneIX :: Int -> IM.IntMap (IM.IntMap IS.IntSet) -> Int2 ->  IM.IntMap (IM.IntMap IS.IntSet)
 deZoneIX i im (V2 x y) = im & ix x . ix y %~ IS.delete i
 
-zoneOfPoint'' :: Float -> Point2 -> V2 Int
+zoneOfPoint'' :: Float -> Point2 -> Int2
 {-# INLINE zoneOfPoint'' #-}
 zoneOfPoint'' s = fmap (divTo s)
+
+zonesAroundPoint :: Float -> Point2 -> [Int2]
+zonesAroundPoint s p = [V2 a b | a <- [x-1..x+1] , b <- [y-1..y+1] ]
+  where
+    V2 x y = zoneOfPoint' s p

src/Dodge/Zoning/Cloud.hs

@@ -5,7 +5,7 @@ import Dodge.Zoning.Base
 import Dodge.Data
 import Geometry
 
-import Data.Foldable
+--import Data.Foldable
 import Control.Lens
 import qualified IntMapHelp as IM
 

src/Dodge/Zoning/Pathing.hs

@@ -0,0 +1,56 @@
+module Dodge.Zoning.Pathing
+    where
+import Geometry.Vector
+import Dodge.Zoning.Base
+import Dodge.Data
+import Geometry
+
+import Data.Foldable
+import Control.Lens
+import qualified IntMapHelp as IM
+
+pnsNearPoint :: Point2 -> World -> [(Int,Point2)]
+pnsNearPoint p w = zoneExtract (zoneOfPoint' pnZoneSize p) (w ^. pnZoning)
+
+pnsNearSeg :: Point2 -> Point2 -> World -> [(Int,Point2)]
+pnsNearSeg sp ep w = zonesExtract (w ^. pnZoning) (zoneOfSeg' pnZoneSize sp ep)
+
+pnsNearRect :: Point2 -> Point2 -> World -> [(Int,Point2)]
+pnsNearRect sp ep w = zonesExtract (w ^. pnZoning) $ zoneOfRect' pnZoneSize sp ep
+
+pnsNearCirc :: Point2 -> Float -> World -> [(Int,Point2)]
+pnsNearCirc p r = pnsNearRect (p +.+ V2 r r) (p -.- V2 r r)
+
+pnZoneSize :: Float
+pnZoneSize = 50
+
+zoneOfPn :: (Int,Point2) -> Int2
+zoneOfPn = zoneOfPoint'' pnZoneSize . snd
+
+zonePn :: (Int,Point2) -> IM.IntMap (IM.IntMap [(Int,Point2)]) -> IM.IntMap (IM.IntMap [(Int,Point2)])
+zonePn pn = zoneMonoid (zoneOfPn pn) [pn]
+
+
+
+pesNearPoint :: Point2 -> World -> [(Int,Int,PathEdge)]
+pesNearPoint p w = zoneExtract (zoneOfPoint' peZoneSize p) (w ^. peZoning)
+
+pesNearSeg :: Point2 -> Point2 -> World -> [(Int,Int,PathEdge)]
+pesNearSeg sp ep w = zonesExtract (w ^. peZoning) (zoneOfSeg' peZoneSize sp ep)
+
+pesNearRect :: Point2 -> Point2 -> World -> [(Int,Int,PathEdge)]
+pesNearRect sp ep w = zonesExtract (w ^. peZoning) $ zoneOfRect' peZoneSize sp ep
+
+pesNearCirc :: Point2 -> Float -> World -> [(Int,Int,PathEdge)]
+pesNearCirc p r = pesNearRect (p +.+ V2 r r) (p -.- V2 r r)
+
+peZoneSize :: Float
+peZoneSize = 50
+
+zoneOfPe :: (Int,Int,PathEdge) -> [Int2]
+zoneOfPe (_,_,pe) = zoneOfSeg' peZoneSize (_peStart pe) (_peEnd pe)
+
+zonePe :: (Int,Int,PathEdge) -> IM.IntMap (IM.IntMap [(Int,Int,PathEdge)]) -> IM.IntMap (IM.IntMap [(Int,Int,PathEdge)])
+zonePe pe im = foldl' f im (zoneOfPe pe)
+  where
+    f im' i2 = zoneMonoid i2 [pe] im'