From d3233c7daa5c6c1c1e38975358c5304878fe8c98 Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 28 Oct 2022 13:14:53 +0100 Subject: [PATCH] Move towards unifying zoning --- src/Dodge/Zoning/Base.hs | 7 ++++--- src/Dodge/Zoning/Cloud.hs | 6 ++++-- src/Dodge/Zoning/Common.hs | 19 +++++++++++++++++++ src/Dodge/Zoning/Creature.hs | 9 ++++++--- src/Dodge/Zoning/Pathing.hs | 4 ++-- src/Dodge/Zoning/Wall.hs | 2 +- 6 files changed, 36 insertions(+), 11 deletions(-) create mode 100644 src/Dodge/Zoning/Common.hs diff --git a/src/Dodge/Zoning/Base.hs b/src/Dodge/Zoning/Base.hs index 420af9a22..c754e05f6 100644 --- a/src/Dodge/Zoning/Base.hs +++ b/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' s sp ep = [V2 x y | x <- makeIntInterval sx ex, y <- makeIntInterval sy ey] +zoneOfRect :: Float -> Point2 -> Point2 -> [Int2] +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 diff --git a/src/Dodge/Zoning/Cloud.hs b/src/Dodge/Zoning/Cloud.hs index d17441e18..7b7179288 100644 --- a/src/Dodge/Zoning/Cloud.hs +++ b/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) diff --git a/src/Dodge/Zoning/Common.hs b/src/Dodge/Zoning/Common.hs new file mode 100644 index 000000000..29469c53e --- /dev/null +++ b/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) diff --git a/src/Dodge/Zoning/Creature.hs b/src/Dodge/Zoning/Creature.hs index 97b466c2e..9db2f4c29 100644 --- a/src/Dodge/Zoning/Creature.hs +++ b/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 diff --git a/src/Dodge/Zoning/Pathing.hs b/src/Dodge/Zoning/Pathing.hs index 90375e78f..ced4a3eb0 100644 --- a/src/Dodge/Zoning/Pathing.hs +++ b/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) diff --git a/src/Dodge/Zoning/Wall.hs b/src/Dodge/Zoning/Wall.hs index 2ae7ae28a..95a076f3d 100644 --- a/src/Dodge/Zoning/Wall.hs +++ b/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)