Fix path updating when doors move

This commit is contained in:
2025-10-22 22:27:09 +01:00
parent 59472b16d2
commit 151c037763
3 changed files with 5 additions and 10 deletions
+1 -5
View File
@@ -37,11 +37,7 @@ defaultWall =
}
defaultDoorWall :: Wall
defaultDoorWall =
defaultWall
{ _wlPathable = True
, _wlMaterial = Metal
}
defaultDoorWall = defaultWall { _wlMaterial = Metal }
{- Indestructible see-through wall. -}
defaultCrystalWall :: Wall
+4 -4
View File
@@ -319,13 +319,13 @@ updateEdgesWall = flip $ foldl' updateEdgeWallObs
updateEdgeWallObs :: World -> (Int,Int) -> World
updateEdgeWallObs w (i,j) = fromMaybe w $ do
s <- getNodePos i w
e <- getNodePos i w
e <- getNodePos j w
let wls = snd <$> wlsHitUnsorted s e w
return $ w & cWorld . incGraph %~ updateEdge (f wls) (i,j)
where
f wls = at DoorObstacle ?~ ()
-- | all _wlWalkable wls = (at BlockObstacle .~ Nothing) . (at DoorObstacle .~ Nothing)
-- | otherwise = at DoorObstacle ?~ ()
f wls
| all _wlPathable wls = (at BlockObstacle .~ Nothing) . (at DoorObstacle .~ Nothing)
| otherwise = at DoorObstacle ?~ ()
updateDoors :: World -> World
updateDoors w = let (is,w') = foldrM doDrWdWd' w (w ^. cWorld . lWorld . doors)
-1
View File
@@ -49,7 +49,6 @@ zoneOfPoint = fmap . divTo
zoneOfSeg :: Float -> Point2 -> Point2 -> [Int2]
{-# INLINE zoneOfSeg #-}
zoneOfSeg s sp ep = map (zoneOfPoint s) (sp : xIntercepts s sp ep ++ yIntercepts s sp ep)
--zoneOfSeg s sp ep = map (zoneOfPoint s) (sp : xIntercepts s sp ep )
zoneOfSegSet :: Float -> Point2 -> Point2 -> S.Set Int2
{-# INLINE zoneOfSegSet #-}