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

Make pathedge zoning use sets, probably doesn't help

Browse Source
This commit is contained in:
justin
2022-08-24 14:01:39 +01:00
parent 13b07b53ce
commit 6973663055
16 changed files with 68 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Zoning/Base.hs
+13 -13
View File
@@ -13,8 +13,8 @@ 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]
where
V2 sx sy = zoneOfPoint' s sp
V2 ex ey = zoneOfPoint' s ep
V2 sx sy = zoneOfPoint s sp
V2 ex ey = zoneOfPoint s ep
makeIntInterval :: Int -> Int -> [Int]
makeIntInterval x y
@@ -25,12 +25,12 @@ makeInt2Interval :: Int2 -> Int2 -> [Int2]
makeInt2Interval (V2 x1 y1) (V2 x2 y2) =
[V2 x y | x <- makeIntInterval x1 x2, y <- makeIntInterval y1 y2]
zoneOfPoint' :: Float -> Point2 -> Int2
zoneOfPoint' = fmap . divTo
zoneOfPoint :: Float -> Point2 -> Int2
zoneOfPoint = fmap . divTo
zoneOfSeg' :: Float -> Point2 -> Point2 -> [Int2]
{-# INLINE zoneOfSeg' #-}
zoneOfSeg' s sp ep = map (zoneOfPoint' s) (sp : xIntercepts' s sp ep ++ yIntercepts' s sp ep)
zoneOfSeg :: Float -> Point2 -> Point2 -> [Int2]
{-# INLINE zoneOfSeg #-}
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
zoneExtract (V2 x y) = fromMaybe mempty . (^? ix x . ix y)
@@ -39,9 +39,9 @@ zonesExtract :: Monoid m => IM.IntMap (IM.IntMap m) -> [Int2] -> m
{-# INLINE zonesExtract #-}
zonesExtract = foldMap . flip zoneExtract
xIntercepts' :: Float -> Point2 -> Point2 -> [Point2]
{-# INLINE xIntercepts' #-}
xIntercepts' s (V2 sx sy) (V2 ex ey)
xIntercepts :: Float -> Point2 -> Point2 -> [Point2]
{-# INLINE xIntercepts #-}
xIntercepts s (V2 sx sy) (V2 ex ey)
| xdx == 0 = []
| otherwise = zipWith V2 [halfstep + sx', halfstep + sx' + xdx * s .. ex] ([sy', sy' + ydx * s .. ey] ++ repeat ey)
where
@@ -57,12 +57,12 @@ xIntercepts' s (V2 sx sy) (V2 ex ey)
yIntercepts' :: Float -> Point2 -> Point2 -> [Point2]
{-# INLINE yIntercepts' #-}
yIntercepts' s sp ep = map f $ xIntercepts' s (f sp) (f ep)
yIntercepts' s sp ep = map f $ xIntercepts s (f sp) (f ep)
where
f (V2 x y) = V2 y x
zoneMonoid :: Semigroup m => Int2 -> m -> IM.IntMap (IM.IntMap m) -> IM.IntMap (IM.IntMap m)
zoneMonoid (V2 x y) a = IM.insertWith f x $ IM.singleton y a
zoneMonoid (V2 x y) a = IM.insertWith f x $! IM.singleton y a
where
f _ = IM.insertWith (<>) y a
@@ -76,4 +76,4 @@ 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
V2 x y = zoneOfPoint s p
src/Dodge/Zoning/Cloud.hs
+2 -2
View File
@@ -8,10 +8,10 @@ import Geometry
import qualified IntMapHelp as IM
clsNearPoint :: Point2 -> World -> [Cloud]
clsNearPoint p w = zoneExtract (zoneOfPoint' clZoneSize p) (w ^. cWorld . clZoning)
clsNearPoint p w = zoneExtract (zoneOfPoint clZoneSize p) (w ^. cWorld . clZoning)
clsNearSeg :: Point2 -> Point2 -> World -> [Cloud]
clsNearSeg sp ep w = zonesExtract (w ^. cWorld . clZoning) (zoneOfSeg' clZoneSize sp ep)
clsNearSeg sp ep w = zonesExtract (w ^. cWorld . clZoning) (zoneOfSeg clZoneSize sp ep)
clsNearRect :: Point2 -> Point2 -> World -> [Cloud]
clsNearRect sp ep w = zonesExtract (w ^. cWorld . clZoning) $ zoneOfRect' clZoneSize sp ep
src/Dodge/Zoning/Creature.hs
+2 -2
View File
@@ -10,7 +10,7 @@ import Geometry
import qualified IntMapHelp as IM
crIXsNearPoint :: Point2 -> World -> IS.IntSet
crIXsNearPoint p w = zoneExtract (zoneOfPoint' crZoneSize p) (w ^. cWorld . crZoning)
crIXsNearPoint p w = zoneExtract (zoneOfPoint crZoneSize p) (w ^. cWorld . crZoning)
crsNearPoint :: Point2 -> World -> [Creature]
crsNearPoint p w = mapMaybe (\cid -> w ^? cWorld . creatures . ix cid) . IS.toList $ crIXsNearPoint p w
@@ -22,7 +22,7 @@ crsNearSeg sp ep w =
$ crixsNearSeg sp ep w
crixsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
crixsNearSeg sp ep w = zonesExtract (w ^. cWorld . crZoning) (zoneOfSeg' crZoneSize sp ep)
crixsNearSeg sp ep w = zonesExtract (w ^. cWorld . crZoning) (zoneOfSeg crZoneSize sp ep)
crIXsNearCirc :: Point2 -> Float -> World -> IS.IntSet
crIXsNearCirc p r = crsNearRect (p +.+ V2 r r) (p -.- V2 r r)
src/Dodge/Zoning/Pathing.hs
+13 -11
View File
@@ -6,12 +6,14 @@ import Dodge.Data.World
import Dodge.Zoning.Base
import Geometry
import qualified IntMapHelp as IM
import Data.Set (Set)
import qualified Data.Set as Set
pnsNearPoint :: Point2 -> World -> [(Int, Point2)]
pnsNearPoint p w = zoneExtract (zoneOfPoint' pnZoneSize p) (w ^. cWorld . pnZoning)
pnsNearPoint p w = zoneExtract (zoneOfPoint pnZoneSize p) (w ^. cWorld . pnZoning)
pnsNearSeg :: Point2 -> Point2 -> World -> [(Int, Point2)]
pnsNearSeg sp ep w = zonesExtract (w ^. cWorld . pnZoning) (zoneOfSeg' pnZoneSize sp ep)
pnsNearSeg sp ep w = zonesExtract (w ^. cWorld . pnZoning) (zoneOfSeg pnZoneSize sp ep)
pnsNearRect :: Point2 -> Point2 -> World -> [(Int, Point2)]
pnsNearRect sp ep w = zonesExtract (w ^. cWorld . pnZoning) $ zoneOfRect' pnZoneSize sp ep
@@ -28,25 +30,25 @@ 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 ^. cWorld . peZoning)
pesNearPoint :: Point2 -> World -> Set (Int, Int, PathEdge)
pesNearPoint p w = zoneExtract (zoneOfPoint peZoneSize p) (w ^. cWorld . peZoning)
pesNearSeg :: Point2 -> Point2 -> World -> [(Int, Int, PathEdge)]
pesNearSeg sp ep w = zonesExtract (w ^. cWorld . peZoning) (zoneOfSeg' peZoneSize sp ep)
pesNearSeg :: Point2 -> Point2 -> World -> Set (Int, Int, PathEdge)
pesNearSeg sp ep w = zonesExtract (w ^. cWorld . peZoning) (zoneOfSeg peZoneSize sp ep)
pesNearRect :: Point2 -> Point2 -> World -> [(Int, Int, PathEdge)]
pesNearRect :: Point2 -> Point2 -> World -> Set (Int, Int, PathEdge)
pesNearRect sp ep w = zonesExtract (w ^. cWorld . peZoning) $ zoneOfRect' peZoneSize sp ep
pesNearCirc :: Point2 -> Float -> World -> [(Int, Int, PathEdge)]
pesNearCirc :: Point2 -> Float -> World -> Set (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)
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 :: (Int, Int, PathEdge) -> IM.IntMap (IM.IntMap (Set (Int, Int, PathEdge))) -> IM.IntMap (IM.IntMap (Set (Int, Int, PathEdge)))
zonePe pe im = foldl' f im (zoneOfPe pe)
where
f im' i2 = zoneMonoid i2 [pe] im'
f im' i2 = zoneMonoid i2 (Set.singleton pe) im'
src/Dodge/Zoning/Wall.hs
+3 -3
View File
@@ -10,11 +10,11 @@ import Geometry
import qualified IntMapHelp as IM
wlIXsNearPoint :: Point2 -> World -> IS.IntSet
wlIXsNearPoint p w = zoneExtract (zoneOfPoint' wlZoneSize p) (w ^. cWorld . wlZoning)
wlIXsNearPoint p w = zoneExtract (zoneOfPoint wlZoneSize p) (w ^. cWorld . wlZoning)
wlIXsNearSeg :: Point2 -> Point2 -> World -> IS.IntSet
{-# INLINE wlIXsNearSeg #-}
wlIXsNearSeg sp ep w = zonesExtract (w ^. cWorld . wlZoning) (zoneOfSeg' wlZoneSize sp ep)
wlIXsNearSeg sp ep w = zonesExtract (w ^. cWorld . wlZoning) (zoneOfSeg wlZoneSize sp ep)
wlIXsNearRect :: Point2 -> Point2 -> World -> IS.IntSet
wlIXsNearRect sp ep w = zonesExtract (w ^. cWorld . wlZoning) $ zoneOfRect' wlZoneSize sp ep
@@ -41,7 +41,7 @@ wlZoneSize :: Float
wlZoneSize = 50
zoneOfWl :: Wall -> [Int2]
zoneOfWl = uncurry (zoneOfSeg' wlZoneSize) . _wlLine
zoneOfWl = uncurry (zoneOfSeg wlZoneSize) . _wlLine
--minCrIXOn :: Ord a => (Creature -> a) -> IS.IntSet -> World -> Maybe Creature
--minCrIXOn f is w = fmap fst $ IS.foldl' g Nothing is