This commit is contained in:
2025-11-09 16:12:17 +00:00
parent cd7a5dcbb5
commit 658da193b7
2 changed files with 36 additions and 60 deletions
+1 -13
View File
@@ -2,7 +2,6 @@ module Dodge.Update.WallDamage (updateWallDamages, updateEdgesWall) where
import Control.Lens
import Data.Foldable
import Data.Maybe
import Data.Monoid
import qualified Data.Set as S
import Dodge.Data.World
@@ -13,23 +12,12 @@ 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 = set (cWorld . lWorld . wallDamages) mempty
. uncurry updateEdgesWall $ foldrM f w
(IM.toList $ w ^. cWorld . lWorld . wallDamages)
where
f (k,dams) w' = fromMaybe (mempty,w') $ do
wl <- w' ^? cWorld . lWorld . walls . ix k
return $ foldrM (damageWall wl) w' dams
f (k,dams) w' = foldrM (damageWall k) w' dams
updateEdgesWall :: S.Set Int2 -> World -> World
updateEdgesWall is w =
+35 -47
View File
@@ -1,67 +1,55 @@
{-# LANGUAGE LambdaCase #-}
{- | 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
import Dodge.LightSource
import Data.Foldable
import Dodge.ShiftPoint
import Dodge.Zoning.Pathing
import Dodge.Zoning.Base
import Dodge.Door.DoorLerp
import Dodge.Wall.Delete
import Dodge.Block.Debris
import qualified Data.IntMap.Strict as IM
import Geometry.Data
import Dodge.Material.Damage
import Dodge.Block
import Dodge.Data.World
import LensHelp
import Data.Maybe
import qualified Data.Set as S
import Dodge.Block
import Dodge.Block.Debris
import Dodge.Data.World
import Dodge.Door.DoorLerp
import Dodge.LightSource
import Dodge.Material.Damage
import Dodge.ShiftPoint
import Dodge.Wall.Delete
import Dodge.Zoning.Base
import Dodge.Zoning.Pathing
import Geometry.Data
import LensHelp
import Linear
---- 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
DoorPart drid _ ->
w' & cWorld . lWorld . doors . ix drid . drHP -~ dmam
& maybeDestroyDoor drid
_ -> (mempty, w')
where
(dmam,w') = damMatSideEffect dt (_wlMaterial wl) (Right wl) w
damageWall :: Int -> Damage -> World -> (S.Set Int2, World)
damageWall wlid dt w = fromMaybe (mempty,w) $ do
wl <- w ^? cWorld . lWorld . walls . ix wlid
let (dmam, w') = damMatSideEffect dt (_wlMaterial wl) (Right wl) w
return $ case wl ^. wlStructure of
MachinePart mcid -> (,) mempty
$ w' & cWorld . lWorld . machines . ix mcid . mcDamage .:~ dt
BlockPart blid ->
w' & cWorld . lWorld . blocks . ix blid . blHP -~ dmam
& maybeDestroyBlock blid
DoorPart drid _ ->
w' & cWorld . lWorld . doors . ix drid . drHP -~ dmam
& maybeDestroyDoor drid
_ -> (mempty, w')
-- block destruction is convoluted...
maybeDestroyBlock :: Int -> World -> (S.Set Int2,World)
maybeDestroyBlock :: Int -> World -> (S.Set Int2, World)
maybeDestroyBlock blid w = case w ^? cWorld . lWorld . blocks . ix blid of
Just bl | _blHP bl < 1 -> destroyBlock bl w
_ -> (mempty,w)
_ -> (mempty, w)
maybeDestroyDoor :: Int -> World -> (S.Set Int2, World)
maybeDestroyDoor drid w = case w ^? cWorld . lWorld . doors . ix drid of
Just dr | _drHP dr < 1 -> destroyDoor dr w
_ -> (mempty,w)
_ -> (mempty, w)
destroyDoor :: Door -> World -> (S.Set Int2, World)
destroyDoor dr w =