diff --git a/src/Dodge/Update/WallDamage.hs b/src/Dodge/Update/WallDamage.hs index be5b5ce30..590f72323 100644 --- a/src/Dodge/Update/WallDamage.hs +++ b/src/Dodge/Update/WallDamage.hs @@ -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 = diff --git a/src/Dodge/Wall/Damage.hs b/src/Dodge/Wall/Damage.hs index d69a7e801..e818f3cea 100644 --- a/src/Dodge/Wall/Damage.hs +++ b/src/Dodge/Wall/Damage.hs @@ -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 =