Cleanup
This commit is contained in:
@@ -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
@@ -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 =
|
||||
|
||||
Reference in New Issue
Block a user