From 0cb6657f35a8690919154d82ad1d82ae737e7bb1 Mon Sep 17 00:00:00 2001 From: justin Date: Tue, 28 Jun 2022 11:50:53 +0100 Subject: [PATCH] Creature zoning refactor --- src/Dodge/Base/Collide.hs | 4 ++-- src/Dodge/Update.hs | 10 +++++---- src/Dodge/WorldEvent/SpawnParticle.hs | 7 ++++-- src/Dodge/Zone.hs | 31 +++++++++++---------------- 4 files changed, 25 insertions(+), 27 deletions(-) diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs index c9dae8fdf..d8bfd2e9d 100644 --- a/src/Dodge/Base/Collide.hs +++ b/src/Dodge/Base/Collide.hs @@ -252,8 +252,8 @@ circOnSomeWall p rad = runIdentity . S.any_ (uncurry (circOnSeg p rad) . _wlLine -- . wallsNearPoint p {- | Adds the distance to the creature radius, tests whether the center is in the circle of this size centered at the point -} -crsNearPoint :: Float -> Point2 -> World -> Bool -crsNearPoint d p = any (\c -> dist (_crPos c) p < (d + _crRad c)) . _creatures +anyCrNearPoint :: Float -> Point2 -> World -> Bool +anyCrNearPoint d p = any (\c -> dist (_crPos c) p < (d + _crRad c)) . _creatures {- | Produce an unordered list of creatures on a line. -} crsOnLine :: Point2 -> Point2 -> World -> IM.IntMap Creature crsOnLine p1 p2 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 408480771..9f7385423 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -149,7 +149,8 @@ doRewind w = case _maybeWorld w of zoneCreatures :: World -> World zoneCreatures w = w & creaturesZone . znObjects .~ - runIdentity (S.fold_ zoneCreature IM.empty id (S.each $ _creatures w)) + IM.foldl' zoneCreature IM.empty (_creatures w) +-- runIdentity (S.fold_ zoneCreature IM.empty id (S.each $ _creatures w)) zoneCreature :: IM.IntMap (IM.IntMap (IM.IntMap Creature)) -> Creature @@ -347,7 +348,7 @@ updateCloud w c newVel@(V3 _ _ nvz) = (0.95 *.*.* springVels) +.+.+ V3 0 0 (0.001 * vertVel) newVel2 = stripZ newVel vertVel = _clAlt c - opz - springVels = runIdentity $ S.fold_ (clClSpringVel c) (_clVel c) id (cloudsNearPoint oldPos2 w) + springVels = runIdentity $ S.fold_ (clClSpringVel c) (_clVel c) id (clsNearPoint oldPos2 w) oldPos@(V3 _ _ opz) = _clPos c oldPos2 = stripZ oldPos newPos@(V3 _ _ npz) = oldPos +.+.+ newVel @@ -369,10 +370,11 @@ clClSpringVel a v b simpleCrSprings :: World -> World simpleCrSprings w = IM.foldl' (flip crSpring) w $ _creatures w +-- note that this may in rare cases not push creatures away from each other crSpring :: Creature -> World -> World -crSpring c w = IM.foldl' (flip $ crCrSpring c) w cs +crSpring c w = runIdentity $ S.fold_ (flip $ crCrSpring c) w id cs where - cs = creaturesNearPoint (_crPos c) w + cs = crsNearPoint (_crPos c) w crCrSpring :: Creature -> Creature -> World -> World crCrSpring c1 c2 diff --git a/src/Dodge/WorldEvent/SpawnParticle.hs b/src/Dodge/WorldEvent/SpawnParticle.hs index 76052c8a1..0ee2a1340 100644 --- a/src/Dodge/WorldEvent/SpawnParticle.hs +++ b/src/Dodge/WorldEvent/SpawnParticle.hs @@ -240,9 +240,12 @@ makeGasCloud pos vel w = w (col, g) = runState (takeOne [green,yellow]) $ _randGen w {- Attach poison cloud damage to creatures near cloud. -} cloudPoisonDamage :: Cloud -> World -> World -cloudPoisonDamage c w = w & creatures %~ flip (foldl' (flip $ IM.adjust doDam)) damagedCrs +cloudPoisonDamage c w = w & creatures + %~ dodamagesto damagedCrs where - damagedCrs = IM.keys $ IM.filter f $ creaturesNearPoint clpos w + dodamagesto :: StreamOf Creature -> IM.IntMap Creature -> IM.IntMap Creature + dodamagesto = undefined + damagedCrs = S.filter f $ crsNearPoint clpos w f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < _crRad cr + _clRad c + 10 doDam cr = cr & crState . csDamage .:~ Damage POISONDAM 1 clpos clpos clpos NoDamageEffect clpos = stripZ $ _clPos c diff --git a/src/Dodge/Zone.hs b/src/Dodge/Zone.hs index 8e9b9989b..a3b9e0d8a 100644 --- a/src/Dodge/Zone.hs +++ b/src/Dodge/Zone.hs @@ -1,7 +1,6 @@ module Dodge.Zone ( crZoneOfPoint , wallsNearPoint - , wallsNearPoint' , wallsAlongLine , crsNearSeg , wallsInsideCirc @@ -11,12 +10,13 @@ module Dodge.Zone , zoneNearPoint , zoneOfCreature , clZoneOfPoint - , cloudsNearPoint + , clsNearPoint , zoneOfSight , flattenIMIMIM , wlZoneOfPoint + , crsNearPoint , creaturesNearPointI - , creaturesNearPoint +-- , creaturesNearPoint , creatureNearPoint , creatureNearPointI , creaturesAlongLine @@ -90,12 +90,10 @@ lookLookup i j z = case IM.lookup i z of lookLookups :: [(Int,Int)] -> IM.IntMap (IM.IntMap a) -> [a] lookLookups xs z = mapMaybe (flip (uncurry lookLookup) z) xs -cloudsNearPoint :: Point2 -> World -> Stream (Of Cloud) Identity () -cloudsNearPoint p w = S.each . f $ w ^? cloudsZone . znObjects . ix x . ix y +clsNearPoint :: Point2 -> World -> Stream (Of Cloud) Identity () +clsNearPoint p w = S.each . fromMaybe mempty $ w ^? cloudsZone . znObjects . ix x . ix y where V2 x y = clZoneOfPoint p - f Nothing = [] - f (Just l) = l -- TODO check whether/when nubbing of walls is necessary wallsAlongLine :: Point2 -> Point2 -> World -> Stream (Of Wall) Identity () @@ -113,20 +111,10 @@ wallsInsideCirc p r w = S.concat $ S.mapMaybe f $ zoneInsideCirc wlZoneSize p r where f (V2 i j) = w ^? wallsZone . znObjects . ix i . ix j -wallsNearPoint' :: Point2 -> World -> [Wall] -wallsNearPoint' p = runIdentity . S.toList_ . wallsNearPoint p - -wallsNearPoint :: Point2 -> World -> Stream (Of Wall) Identity () -wallsNearPoint p w = S.concat $ S.mapMaybe f $ S.each [V2 a b | a <- [x-1,x,x+1], b <- [y-1,y,y+1]] +wallsNearPoint :: Point2 -> World -> StreamOf Wall +wallsNearPoint p = S.each . fromMaybe mempty . (^? wallsZone . znObjects . ix x . ix y) where V2 x y = wlZoneOfPoint p - f (V2 i j) = w ^? wallsZone . znObjects . ix i . ix j --- IM.unions [f b $ f a $ _znObjects $ _wallsZone w | a<-[x-1,x,x+1] , b<-[y-1,y,y+1]] --- where --- (x,y) = zoneOfPoint p --- f i m = case IM.lookup i m of --- Just val -> val --- _ -> IM.empty flattenIMIMIM :: IM.IntMap (IM.IntMap (IM.IntMap a)) -> IM.IntMap a flattenIMIMIM = IM.unions . fmap IM.unions @@ -137,6 +125,11 @@ creatureNearPoint = creatureNearPointI 1 creatureNearPointI :: Int -> Point2 -> World -> Maybe Creature creatureNearPointI n p = L.fold (L.minimumOn (dist p . _crPos)) . creaturesNearPointI n p +crsNearPoint :: Point2 -> World -> StreamOf Creature +crsNearPoint p = S.each . fromMaybe mempty . (^? creaturesZone . znObjects . ix x . ix y) + where + V2 x y = crZoneOfPoint p + creaturesNearPoint :: Point2 -> World -> IM.IntMap Creature creaturesNearPoint = creaturesNearPointI 1