Refactor creature zoning

2022-07-22 17:53:08 +01:00
parent 43e7d20b21
commit 39f4555697
17 changed files with 209 additions and 85 deletions
@@ -1,7 +1,54 @@
 module Dodge.Zoning.Creature where
+import FoldableHelp
+import Dodge.Data
+import Geometry
+import Dodge.Zoning.Base
+import qualified FoldlHelp as L
+import qualified IntMapHelp as IM

--zoneOfCr :: Creature -> [Int2]
--zoneOfCr cr = zoneOfCirc crZoneSize (_crPos cr) (_crRad cr)
+import Data.Maybe
+import Data.Function
+import qualified Data.IntSet as IS
+import Control.Lens
+
+crIXsNearPoint :: Point2 -> World -> IS.IntSet
+crIXsNearPoint p w = zoneExtract (zoneOfPoint' crZoneSize p) (w ^. crZoning . getCrZoning)
+
+crsNearPoint :: Point2 -> World -> [Creature]
+crsNearPoint p w = mapMaybe (\cid -> w ^? creatures . ix cid) . IS.toList $ crIXsNearPoint p w
+
+crsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
+crsNearSeg sp ep w = zonesExtract (w ^. crZoning . getCrZoning) (zoneOfSeg' crZoneSize sp ep)
+
+crIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet
+crIXsNearCirc p r = crsNearRect (p +.+ V2 r r) (p -.- V2 r r)
+
+crsNearCirc :: Point2 -> Float -> World -> [Creature]
+crsNearCirc p r w = mapMaybe (\cid -> w ^? creatures . ix cid) . IS.toList $ crIXsNearCirc p r w
+
+crsNearRect :: Point2 -> Point2 -> World -> IS.IntSet
+crsNearRect sp ep w = zonesExtract (w ^. crZoning . getCrZoning) $ zoneOfRect' crZoneSize sp ep
+
+crZoneSize :: Float
+crZoneSize = 15
+
+zoneOfCr :: Creature -> [Int2]
+zoneOfCr cr = zoneOfCirc crZoneSize (_crPos cr) (_crRad cr)
+
+minCrIXOn :: Ord a => (Creature -> a) -> IS.IntSet -> World -> Maybe Creature
+minCrIXOn f is w = fmap fst $ IS.foldl' (g w) Nothing is
+  where
+    g w mcrx cid = minOn snd <$> getpair cid <*> mcrx
+    getpair cid = fmap h $ w ^? creatures . ix cid
+    h cr = (cr, f cr)
+
+zoneCreature :: Creature -> CrZoning -> CrZoning
+zoneCreature cr = over getCrZoning (zoneCr' cr)
+
+zoneCr' :: Creature -> IM.IntMap (IM.IntMap IS.IntSet) -> IM.IntMap (IM.IntMap IS.IntSet)
+zoneCr' cr im = foldl' f im (zoneOfCr cr)
+  where
+    f im i2 = zoneMonoid i2 (IS.singleton $ _crID cr) im

 --crsInZones :: [Int2] -> CrZoning -> IS.IntSet
 --crsInZones is