59 lines
2.0 KiB
Haskell
59 lines
2.0 KiB
Haskell
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
|
|
import Dodge.Wall.Damage
|
|
import Dodge.Wall.Pathing
|
|
import Dodge.WorldEvent.ThingsHit
|
|
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
|
|
|
|
updateEdgesWall :: S.Set Int2 -> World -> World
|
|
updateEdgesWall is w =
|
|
hack $
|
|
updateEdgesWall'
|
|
(zonesExtract (w ^. incEdgeZoning & each . each %~ S.fromList) is)
|
|
w
|
|
where
|
|
hack w'
|
|
| null is = w'
|
|
| otherwise =
|
|
foldMap Sum (w' ^.. cWorld . incGraph . each . each . seObstacles . to length)
|
|
`seq` w'
|
|
|
|
updateEdgesWall' :: S.Set (Int, Int) -> World -> World
|
|
updateEdgesWall' = flip $ foldl' updateEdgeWallObs
|
|
|
|
updateEdgeWallObs :: World -> (Int, Int) -> World
|
|
updateEdgeWallObs w (i, j) = w & cWorld . incGraph . ix i . ix j . seObstacles %~ f wlflags
|
|
where
|
|
s = w ^?! cWorld . incNode . ix i
|
|
e = w ^?! cWorld . incNode . ix j
|
|
wlflags = foldMap (^. _2 . to getWallPathing) $ wlsHitUnsorted s e w
|
|
f x =
|
|
(`S.union` S.map WallObstacle x)
|
|
. (S.\\ (S.fromList $ map WallObstacle [minBound .. maxBound]))
|