Refactor path zoning

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'