Implement (partially) updating pathing grid when opening doors

src/Dodge/Placement/PlaceSpot/Block.hs

@@ -74,7 +74,6 @@ plLineBlock basePane blwidth a b gw = ( 0
         , _blDir = 0    -- THIS IS NOT SENSIBLE. TODO rethink block positioning
         , _blFootprint = cornersAt p -- TODO check winding (clockwise, anticlockwise)
         , _blObstructs = []
-        , _blPaths = []
         , _blPos = p, _blDraw = const mempty , _blDeath = makeBlockDebris}
         )
     insertBlocks = flip (foldr insertBlock) $ zip is blockCenPs
@@ -97,10 +96,10 @@ plLineBlock basePane blwidth a b gw = ( 0
 
 -- | Must be done after inserting the block
 insertWalls :: Int -> [Wall] -> World -> World
-insertWalls blid wls w = w' & blocks . ix blid . blPaths .~ concat paths
+insertWalls blid wls w = w' & blocks . ix blid . blObstructs .~ concat paths
   where
     (w',paths) = mapAccumR (flip insertWall) w wls
 
 insertWall :: Wall -> World -> (World,[(Int,Int,PathEdge)])
-insertWall wl = uncurry obstructPathsCrossing (_wlLine wl)
+insertWall wl = uncurry (obstructPathsCrossing BlockObstacle) (_wlLine wl)
     . (walls . at (_wlID wl) ?~ wl)

src/Dodge/Placement/PlaceSpot/TriggerDoor.hs

@@ -4,7 +4,9 @@ module Dodge.Placement.PlaceSpot.TriggerDoor
     , plSlideDoor
     ) where
 import Dodge.Data
+import Dodge.Zone
 import Dodge.Base
+import Dodge.Path
 import Dodge.Default.Door
 import Dodge.Wall.Move
 import Dodge.LevelGen.DoorPane
@@ -17,15 +19,16 @@ import Dodge.SoundLogic
 --import Data.Maybe
 import Data.List
 import Control.Lens
---import Data.Graph.Inductive hiding ((&))
 import qualified Data.IntSet as IS
-plDoor :: Color 
+import qualified Data.Graph.Inductive as FGL
+import qualified Streaming.Prelude as S
+plDoor :: Color
     -> (World -> Bool)      -- ^ Opening condition
     -> [(Point2,Point2)]   -- ^ Door positions, closed to open.
                     -- Bumped out up and down by 9, not widened
-    -> World 
+    -> World
     -> (Int,World)
-plDoor col cond pss gw = (drid, addWalls gw & doors %~ addDoor)
+plDoor col cond pss gw = (drid, addWalls $ gw & doors %~ addDoor) -- carefull with the ordering of addWalls
   where
     drid = IM.newKey $ _doors gw
     addDoor = IM.insert drid $ defaultDoor
@@ -44,11 +47,15 @@ plDoor col cond pss gw = (drid, addWalls gw & doors %~ addDoor)
     addWalls w' = foldl' (addDoorWall drid $ switchWallCol col) w' $ zip wlids wlps'
 
 addDoorWall :: Int -> Wall -> World -> (Int,(Point2,Point2)) -> World
-addDoorWall drid wl w (wlid,wlps) = w & walls %~ IM.insert wlid wl
-    { _wlLine = wlps
-    , _wlID = wlid
-    , _wlStructure = DoorPart drid
-    }
+addDoorWall drid wl w (wlid,wlps) = w' 
+    & walls %~ IM.insert wlid wl
+        { _wlLine = wlps
+        , _wlID = wlid
+        , _wlStructure = DoorPart drid
+        }
+    & doors . ix drid . drObstructs .~ es
+  where
+    (w',es) = uncurry (obstructPathsCrossing DoorObstacle) wlps w
 -- TODO use vector instead of list, perhaps also memoisation of rectanglePairs
 -- TODO update _drPos
 -- perhaps also remove use of DoorInt in favour of DoorOpen/DoorClosed
@@ -80,6 +87,7 @@ doorMechanism dr w = case mvDir of
         & flip (IS.foldl' (flip (`translateWallID` d))) (_drWallIDs dr)
         & moveUpdate 
         & doors . ix drid . drPos . each %~ (+.+ d)
+        & maybeClearDoorPaths (_drObstacleType dr) (_drObstructs dr)
     Nothing -> w
   where
     toOpen = _drTrigger dr w
@@ -100,7 +108,16 @@ doorMechanism dr w = case mvDir of
         | dist dpos dcp < 1 = doors . ix drid . drStatus .~ DoorClosed
         | otherwise                       = doors . ix drid . drStatus .~ DoorHalfway
 
--- TODO cut pathing if not pathable, reset when opened
+maybeClearDoorPaths :: EdgeObstacle -> [(Int,Int,PathEdge)] -> World -> World
+maybeClearDoorPaths eo es w = foldl' (maybeClearDoorPath eo) w es
+
+maybeClearDoorPath :: EdgeObstacle -> World -> (Int,Int,PathEdge) -> World
+maybeClearDoorPath eo w (x,y,pe)
+    | runIdentity . S.any_ (const True) $ overlapSegWalls (_peStart pe) (_peEnd pe) $ wlsNearSeg (_peStart pe) (_peEnd pe) w 
+        = w & pathGraph %~ FGL.insEdge (x,y,pe & peObstacles . at eo ?~ ()) . FGL.delEdge (x,y)
+    | otherwise 
+        = w & pathGraph %~ FGL.insEdge (x,y,pe & peObstacles . at eo .~ Nothing) . FGL.delEdge (x,y) 
+
 plSlideDoor 
     :: Door 
     -> Wall
@@ -110,7 +127,7 @@ plSlideDoor
     -> World
     -> (Int, World)
 plSlideDoor dr wl shiftOffset a b gw 
-    = (drid, addDoorWalls gw & doors %~ addDoor)
+    = (drid, addDoorWalls $ gw & doors %~ addDoor)
   where
     drid = IM.newKey $ _doors gw
     addDoor = IM.insert drid $ dr
@@ -121,6 +138,7 @@ plSlideDoor dr wl shiftOffset a b gw
         , _drPos = (a,b)
         , _drOpenPos = (shiftLeft a,shiftLeft b)
         , _drClosePos = (a,b)
+        , _drObstacleType = DoorObstacle
         }
     addDoorWalls w' = foldl' (addDoorWall drid wl) w' $ zip wlids pairs
     pairs = rectanglePairs 9 a b