Update pathing on block destruction without relying on _blObstructs

src/Dodge/Block.hs

@@ -2,10 +2,14 @@
 
 module Dodge.Block (destroyBlock) where
 
+import ListHelp
+import Dodge.Zoning.Pathing
+import Dodge.Zoning.Base
+import Geometry.Data
 import qualified Data.Set as S
 import Control.Lens
 import Control.Monad
-import Data.Foldable
+--import Data.Foldable
 --import qualified Data.IntSet as IS
 import Data.Maybe
 import Dodge.Base.Collide
@@ -45,15 +49,16 @@ unshadowBlock w wlid = case w ^? cWorld . lWorld . walls . ix wlid of
 --    | _blHP bl < 1 = destroyBlock bl
 --    | otherwise = id
 
-destroyBlock :: Block -> World -> World
-destroyBlock bl w =
-    w
+destroyBlock :: S.Set Int2 -> Block -> World -> (S.Set Int2,World)
+destroyBlock is bl w =
+    (js<>is,w
         & flip (foldl' unshadowBlock) (_blShadows bl)
         & makeBlockDebris bl
         & deleteWallIDs wlids
         & maybeClearPaths (_blObstructs bl) -- must happen after the walls are deleted
-        & cWorld . lWorld . blocks %~ IM.delete (_blID bl)
+        & cWorld . lWorld . blocks %~ IM.delete (_blID bl))
   where
+    js = foldMap (S.fromList . uncurry (zoneOfSeg peZoneSize)) (loopPairs $ bl^.blFootprint)
     --        & muchWlDustAt awl (_blPos bl)
     --        & flip (foldl' $ flip (muchWlDustAt awl)) (map (pos +.+) ps)
 

src/Dodge/Material/Damage.hs

@@ -13,6 +13,10 @@ import RandomHelp
 
 type ECW = Either Creature Wall
 
+-- perhaps rethink this as armour that
+-- transforms damage and passes it on to the interior object 
+-- (block,door,creature,machine)
+-- alongside an external side effect (spark,dust,etc)
 damMatSideEffect :: Damage -> Material -> ECW -> World -> (Int,World)
 damMatSideEffect dm = \case
     Stone -> damageStone dm

src/Dodge/Update.hs

@@ -4,7 +4,7 @@
 module Dodge.Update (updateUniverse) where
 
 import Dodge.Zoning.Base
-import Dodge.Path
+--import Dodge.Path
 import Data.Foldable
 import qualified Data.Set as S
 import Color
@@ -309,17 +309,17 @@ updateAimPos u =
     u & uvWorld . cWorld . lWorld . lAimPos
         .~ mouseWorldPos (u ^. uvWorld . input) (u ^. uvWorld . wCam)
 
-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 . wlPathFlag) $ wlsHitUnsorted s e w
-    return $ w & cWorld . incGraph %~ updateEdge (f wlflags) (i,j)
-  where
-    f x _ = S.map WallObstacle x
+--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 . wlPathFlag) $ wlsHitUnsorted s e w
+--    return $ w & cWorld . incGraph %~ updateEdge (f wlflags) (i,j)
+--  where
+--    f x _ = S.map WallObstacle x
 
 updateDoors :: World -> World
 updateDoors w = let (is,w') = foldrM updateDoor w (w ^. cWorld . lWorld . doors)

src/Dodge/Update/WallDamage.hs

@@ -1,18 +1,35 @@
-module Dodge.Update.WallDamage (updateWallDamages) where
+module Dodge.Update.WallDamage (updateWallDamages,updateEdgesWall) where
 
+import Dodge.WorldEvent.ThingsHit
+import Dodge.Path
+import Dodge.Zoning.Base
 import Control.Lens
 import Data.Maybe
 import Dodge.Data.World
 import Dodge.Wall.Damage
 import qualified IntMapHelp as IM
 import Data.Foldable
+import qualified Data.Set as S
 
 updateWallDamages :: World -> World
-updateWallDamages w =
-    w
-        & cWorld . lWorld . wallDamages .~ IM.empty
-        & flip (IM.foldlWithKey' f) (w ^. cWorld . lWorld . wallDamages)
+updateWallDamages w = 
+    let (is,w') 
+            = IM.foldlWithKey' f (mempty,w) (w ^. cWorld . lWorld . wallDamages)
+    in updateEdgesWall (zonesExtract (w ^. incEdgeZoning & each . each %~ S.fromList) is) w'
+            & cWorld . lWorld . wallDamages .~ IM.empty
   where
-    f w' k dams = fromMaybe w' $ do
-        wl <- w' ^? cWorld . lWorld . walls . ix k
-        return $ foldl' (flip (`damageWall` wl)) w' dams
+    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 (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 . wlPathFlag) $ wlsHitUnsorted s e w
+    return $ w & cWorld . incGraph %~ updateEdge (f wlflags) (i,j)
+  where
+    f x _ = S.map WallObstacle x

src/Dodge/Wall/Damage.hs

@@ -3,33 +3,36 @@
 -}
 module Dodge.Wall.Damage (damageWall) where
 
+import Geometry.Data
 import Dodge.Material.Damage
 import Dodge.Block
 import Dodge.Data.World
 import LensHelp
+import qualified Data.Set as S
 
 -- maybeDestroyDoor should rather happen during the door mechanism update
-damageWall :: Damage -> Wall -> World -> World
-damageWall dt wl w = case _wlStructure wl of
-    MachinePart mcid -> w' & cWorld . lWorld . machines . ix mcid . mcDamage .:~ dt
+damageWall :: Damage -> Wall -> (S.Set Int2,World) -> (S.Set Int2,World)
+damageWall dt wl (is,w) = case _wlStructure wl of
+    MachinePart mcid -> f $ w' & cWorld . lWorld . machines . ix mcid . mcDamage .:~ dt
     BlockPart blid ->
         w' & cWorld . lWorld . blocks . ix blid . blHP -~ dmam
-            & maybeDestroyBlock blid
+            & maybeDestroyBlock is blid
     DoorPart drid ->
-        w' & cWorld . lWorld . doors . ix drid . drHP -~ dmam
+        f $ w' & cWorld . lWorld . doors . ix drid . drHP -~ dmam
 --            & maybeDestroyDoor drid
-    _ -> w'
+    _ -> f $ w'
   where
+    f = (,) is
 --    x = case dt of
 --        Explosive y _ -> y * 100
 --        _ -> dt ^. dmAmount
     (dmam,w') = damMatSideEffect dt (_wlMaterial wl) (Right wl) w
 
 -- block destruction is convoluted...
-maybeDestroyBlock :: Int -> World -> World
-maybeDestroyBlock blid w = case w ^? cWorld . lWorld . blocks . ix blid of
-    Just bl | _blHP bl < 1 -> destroyBlock bl w
-    _ -> w
+maybeDestroyBlock :: S.Set Int2 -> Int -> World -> (S.Set Int2,World)
+maybeDestroyBlock is blid w = case w ^? cWorld . lWorld . blocks . ix blid of
+    Just bl | _blHP bl < 1 -> destroyBlock is bl w
+    _ -> (is,w)
 
 --maybeDestroyDoor :: Int -> World -> World
 --maybeDestroyDoor drid w = case w ^? cWorld . lWorld . doors . ix drid of