44 lines
1.4 KiB
Haskell
44 lines
1.4 KiB
Haskell
module Dodge.Update.WallDamage (updateWallDamages, updateEdgesWall) where
|
|
|
|
import Dodge.Wall.Pathing
|
|
import Geometry.Data
|
|
import Control.Lens
|
|
import Data.Foldable
|
|
import Data.Maybe
|
|
import qualified Data.Set as S
|
|
import Dodge.Data.World
|
|
import Dodge.Path
|
|
import Dodge.Wall.Damage
|
|
import Dodge.WorldEvent.ThingsHit
|
|
import Dodge.Zoning.Base
|
|
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
|
|
|
|
updateEdgesWall :: S.Set Int2 -> World -> World
|
|
updateEdgesWall is w = updateEdgesWall'
|
|
(zonesExtract (w ^. incEdgeZoning & each . each %~ S.fromList) is) w
|
|
|
|
updateEdgesWall' :: S.Set (Int, Int) -> World -> World
|
|
updateEdgesWall' = flip $ foldl' updateEdgeWallObs
|
|
|
|
updateEdgeWallObs :: World -> (Int, Int) -> World
|
|
updateEdgeWallObs w (i, j) = fromMaybe w $ do
|
|
s <- getNodePos i w
|
|
e <- getNodePos j w
|
|
let wlflags = foldMap (^. _2 . to getWallPathing) $ wlsHitUnsorted s e w
|
|
return $ w & cWorld . incGraph %~ updateEdge (f wlflags) (i, j)
|
|
where
|
|
f x y = (S.map WallObstacle x) `S.union`
|
|
(y S.\\ (S.fromList $ map WallObstacle [minBound..maxBound]))
|