Simplify block/wall destruction
This uses a right fold, so might be slower than a strict left fold
This commit is contained in:
@@ -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 =
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user