From b43ec42a2e88e2c1835a753f38f77ed69c42a9c2 Mon Sep 17 00:00:00 2001 From: justin Date: Sun, 3 Jul 2022 13:12:25 +0100 Subject: [PATCH] Make makePathBetween respect obstacles --- src/Dodge/Path.hs | 8 +++++++- src/Dodge/Render/ShapePicture.hs | 4 ++-- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/src/Dodge/Path.hs b/src/Dodge/Path.hs index d3ead6eb2..80bc19838 100644 --- a/src/Dodge/Path.hs +++ b/src/Dodge/Path.hs @@ -35,7 +35,13 @@ makePathBetween :: Point2 -> Point2 -> World -> Maybe [Int] makePathBetween a b w = do -- join $ sp <$> a' <*> b' <*> return (_pathGraph w) na <- walkableNodeNear w a nb <- walkableNodeNear w b - sp na nb (second _peDist (_pathGraph w)) + sp na nb (second _peDist (efilter (not . pathEdgeObstructed . (^. _3)) $ _pathGraph w)) + +pathEdgeObstructed :: PathEdge -> Bool +pathEdgeObstructed pe = DoorObstacle `Set.member` obs || BlockObstacle `Set.member` obs + where + obs = _peObstacles pe + walkableNodeNear :: World -> Point2 -> Maybe Int {-# INLINE walkableNodeNear #-} diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index a24807fe8..3629065b8 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -79,7 +79,7 @@ extraPics cfig w = pictures (_decorations w) <> concatMapPic clDraw (_clouds w ) <> concatMapPic ppDraw (_pressPlates w ) <> viewClipBounds cfig w - <> debugDraw cfig w +-- <> debugDraw cfig w debugDraw :: Configuration -> World -> Picture {-# INLINE debugDraw #-} @@ -123,7 +123,7 @@ drawCreatureDisplayTexts w = foldMap (creatureDisplayText w) (_creatures w) drawPathBetween :: World -> Picture drawPathBetween w = setLayer DebugLayer - $ color yellow (foldMap (arrowPath . mapMaybe nodepos) nodelist) + $ color rose (foldMap (arrowPath . mapMaybe nodepos) nodelist) <> foldMap (color green . arrow sp) (nodepos =<< walkableNodeNear w sp) <> foldMap (color cyan . flip arrow ep) (nodepos =<< walkableNodeNear w ep) where