From cd7a5dcbb5a7900b4298fbe75ca24fa4730e251f Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 9 Nov 2025 16:00:46 +0000 Subject: [PATCH] Simplify block/wall destruction This uses a right fold, so might be slower than a strict left fold --- src/Dodge/Update/WallDamage.hs | 21 +++++++++++++++------ src/Dodge/Wall/Damage.hs | 30 ++++++++++++++++++++++-------- tags | 22 +++++++++++----------- 3 files changed, 48 insertions(+), 25 deletions(-) diff --git a/src/Dodge/Update/WallDamage.hs b/src/Dodge/Update/WallDamage.hs index ea4854e4d..be5b5ce30 100644 --- a/src/Dodge/Update/WallDamage.hs +++ b/src/Dodge/Update/WallDamage.hs @@ -13,14 +13,23 @@ import Dodge.Zoning.Base import Geometry.Data import qualified IntMapHelp as IM +--updateWallDamages :: World -> World +--updateWallDamages w = +-- let (is, w') = IM.foldlWithKey' f (mempty, w) (w ^. cWorld . lWorld . wallDamages) +-- in updateEdgesWall is w' & cWorld . lWorld . wallDamages .~ IM.empty +-- where +-- f isw k dams = fromMaybe isw $ do +-- wl <- isw ^? _2 . cWorld . lWorld . walls . ix k +-- return $ foldl' (flip (`damageWall` wl)) isw dams + updateWallDamages :: World -> World -updateWallDamages w = - let (is, w') = IM.foldlWithKey' f (mempty, w) (w ^. cWorld . lWorld . wallDamages) - in updateEdgesWall is w' & cWorld . lWorld . wallDamages .~ IM.empty +updateWallDamages w = set (cWorld . lWorld . wallDamages) mempty + . uncurry updateEdgesWall $ foldrM f w + (IM.toList $ w ^. cWorld . lWorld . wallDamages) where - f isw k dams = fromMaybe isw $ do - wl <- isw ^? _2 . cWorld . lWorld . walls . ix k - return $ foldl' (flip (`damageWall` wl)) isw dams + f (k,dams) w' = fromMaybe (mempty,w') $ do + wl <- w' ^? cWorld . lWorld . walls . ix k + return $ foldrM (damageWall wl) w' dams updateEdgesWall :: S.Set Int2 -> World -> World updateEdgesWall is w = diff --git a/src/Dodge/Wall/Damage.hs b/src/Dodge/Wall/Damage.hs index 81fb1e0d1..d69a7e801 100644 --- a/src/Dodge/Wall/Damage.hs +++ b/src/Dodge/Wall/Damage.hs @@ -2,7 +2,8 @@ {- | Controls a walls response to external damage. - Indestructible walls may still produce sparks, dust etc -} -module Dodge.Wall.Damage (damageWall) where +module Dodge.Wall.Damage (damageWall + ) where import Linear import Data.Maybe @@ -22,19 +23,32 @@ import Dodge.Data.World import LensHelp import qualified Data.Set as S --- maybeDestroyDoor should rather happen during the door mechanism update -damageWall :: Damage -> Wall -> (S.Set Int2,World) -> (S.Set Int2,World) -damageWall dt wl (is,w) = case _wlStructure wl of - MachinePart mcid -> (,) is $ w' & cWorld . lWorld . machines . ix mcid . mcDamage .:~ dt +---- maybeDestroyDoor should rather happen during the door mechanism update +--damageWall :: Damage -> Wall -> (S.Set Int2,World) -> (S.Set Int2,World) +--damageWall dt wl (is,w) = case _wlStructure wl of +-- MachinePart mcid -> (,) is $ w' & cWorld . lWorld . machines . ix mcid . mcDamage .:~ dt +-- BlockPart blid -> +-- w' & cWorld . lWorld . blocks . ix blid . blHP -~ dmam +-- & maybeDestroyBlock blid +-- & _1 <>~ is +-- DoorPart drid _ -> +-- w' & cWorld . lWorld . doors . ix drid . drHP -~ dmam +-- & maybeDestroyDoor drid +-- & _1 <>~ is +-- _ -> (is, w') +-- where +-- (dmam,w') = damMatSideEffect dt (_wlMaterial wl) (Right wl) w + +damageWall :: Wall -> Damage ->World -> (S.Set Int2,World) +damageWall wl dt w = case _wlStructure wl of + MachinePart mcid -> (,) mempty $ w' & cWorld . lWorld . machines . ix mcid . mcDamage .:~ dt BlockPart blid -> w' & cWorld . lWorld . blocks . ix blid . blHP -~ dmam & maybeDestroyBlock blid - & _1 <>~ is DoorPart drid _ -> w' & cWorld . lWorld . doors . ix drid . drHP -~ dmam & maybeDestroyDoor drid - & _1 <>~ is - _ -> (is, w') + _ -> (mempty, w') where (dmam,w') = damMatSideEffect dt (_wlMaterial wl) (Right wl) w diff --git a/tags b/tags index 18c128078..ef1749c9d 100644 --- a/tags +++ b/tags @@ -2995,7 +2995,7 @@ damageSensor src/Dodge/Placement/Instance/Sensor.hs 14;" f damageStone src/Dodge/Material/Damage.hs 33;" f damageThingHit src/Dodge/Bullet.hs 180;" f damageTypeThreshold src/Dodge/Placement/Instance/Sensor.hs 34;" f -damageWall src/Dodge/Wall/Damage.hs 26;" f +damageWall src/Dodge/Wall/Damage.hs 42;" f damsToExpBarrel src/Dodge/Barreloid.hs 50;" f dark src/Color.hs 108;" f darkenBackground src/Dodge/Render/MenuScreen.hs 32;" f @@ -3092,15 +3092,15 @@ deleteWallIDs src/Dodge/Wall/Delete.hs 27;" f denormalEdges src/Polyhedra.hs 136;" f destroyAllInvItems src/Dodge/Inventory.hs 53;" f destroyBlock src/Dodge/Block.hs 17;" f -destroyDoor src/Dodge/Wall/Damage.hs 52;" f +destroyDoor src/Dodge/Wall/Damage.hs 66;" f destroyInvItem src/Dodge/Inventory.hs 40;" f destroyItem src/Dodge/Inventory.hs 62;" f destroyLSFlashAt src/Dodge/LightSource.hs 44;" f destroyMachine src/Dodge/Machine/Destroy.hs 13;" f destroyMatS src/Dodge/Material/Sound.hs 7;" f destroyMcType src/Dodge/Machine/Destroy.hs 22;" f -destroyMount src/Dodge/Wall/Damage.hs 73;" f -destroyMounts src/Dodge/Wall/Damage.hs 70;" f +destroyMount src/Dodge/Wall/Damage.hs 87;" f +destroyMounts src/Dodge/Wall/Damage.hs 84;" f destroyProjectile src/Dodge/Projectile/Update.hs 109;" f detV src/Geometry/Vector.hs 94;" f detector src/Dodge/Item/Held/Utility.hs 27;" f @@ -4068,8 +4068,8 @@ maxInvSlots src/Dodge/Inventory/CheckSlots.hs 30;" f maxShowX src/Dodge/Combine/Graph.hs 48;" f maxViewDistance src/Dodge/Viewpoints.hs 26;" f maybeBlockedPassage src/Dodge/Room/RezBox.hs 80;" f -maybeDestroyBlock src/Dodge/Wall/Damage.hs 42;" f -maybeDestroyDoor src/Dodge/Wall/Damage.hs 47;" f +maybeDestroyBlock src/Dodge/Wall/Damage.hs 56;" f +maybeDestroyDoor src/Dodge/Wall/Damage.hs 61;" f maybeExitCombine src/Dodge/Update/Input/InGame.hs 562;" f maybeOpenConsole src/Dodge/Update.hs 126;" f maybeReadFile src/Dodge/LoadSeed.hs 10;" f @@ -5028,7 +5028,7 @@ stone4S src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs 484;" f stone5S src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs 626;" f stopAllSounds src/Sound.hs 125;" f stopBulletAt src/Dodge/Bullet.hs 200;" f -stopPushing src/Dodge/Wall/Damage.hs 78;" f +stopPushing src/Dodge/Wall/Damage.hs 92;" f stopSoundFrom src/Dodge/SoundLogic.hs 220;" f strFromEquipment src/Dodge/Creature/Statistics.hs 53;" f strFromHeldItem src/Dodge/Creature/Statistics.hs 67;" f @@ -5310,9 +5310,9 @@ updateDoors src/Dodge/Update.hs 308;" f updateDust src/Dodge/Update.hs 820;" f updateDusts src/Dodge/Update.hs 670;" f updateEdge src/Dodge/Path.hs 43;" f -updateEdgeWallObs src/Dodge/Update/WallDamage.hs 41;" f -updateEdgesWall src/Dodge/Update/WallDamage.hs 25;" f -updateEdgesWall' src/Dodge/Update/WallDamage.hs 38;" f +updateEdgeWallObs src/Dodge/Update/WallDamage.hs 50;" f +updateEdgesWall src/Dodge/Update/WallDamage.hs 34;" f +updateEdgesWall' src/Dodge/Update/WallDamage.hs 47;" f updateEnergyBall src/Dodge/EnergyBall.hs 31;" f updateEnergyBalls src/Dodge/Update.hs 658;" f updateEnterRegex src/Dodge/Update/Input/InGame.hs 505;" f @@ -5393,7 +5393,7 @@ updateUniverseMid src/Dodge/Update.hs 156;" f updateUseInputInGame src/Dodge/Update/Input/InGame.hs 45;" f updateUseInputOnScreen src/Dodge/Update/Input/ScreenLayer.hs 23;" f updateWalkCycle src/Dodge/Creature/State/WalkCycle.hs 11;" f -updateWallDamages src/Dodge/Update/WallDamage.hs 16;" f +updateWallDamages src/Dodge/Update/WallDamage.hs 25;" f updateWheelEvent src/Dodge/Update/Scroll.hs 25;" f updateWheelEvents src/Dodge/Update.hs 412;" f updateWorldEventFlag src/Dodge/Update.hs 120;" f