justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Move towards unifying zoning

Browse Source
This commit is contained in:
justin
2022-10-28 13:14:53 +01:00
parent 7e790b7153
commit d3233c7daa
6 changed files with 36 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Zoning/Base.hs
+4 -3
View File
@@ -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
src/Dodge/Zoning/Cloud.hs
+4 -2
View File
@@ -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
+19
View File
@@ -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
+6 -3
View File
@@ -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
+2 -2
View File
@@ -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
+1 -1
View File
@@ -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)