Correctly add all obstructed paths to doors

src/Dodge/Placement/PlaceSpot/TriggerDoor.hs

@@ -14,11 +14,11 @@ import Picture
 import Geometry
 import qualified IntMapHelp as IM
 import Dodge.SoundLogic
+import LensHelp
 --import Dodge.LevelGen.LevelStructure
 
 --import Data.Maybe
 import Data.List
-import Control.Lens
 import qualified Data.IntSet as IS
 import qualified Data.Graph.Inductive as FGL
 import qualified Streaming.Prelude as S
@@ -53,7 +53,7 @@ addDoorWall drid wl w (wlid,wlps) = w'
         , _wlID = wlid
         , _wlStructure = DoorPart drid
         }
-    & doors . ix drid . drObstructs .~ es
+    & doors . ix drid . drObstructs .++~ es
   where
     (w',es) = uncurry (obstructPathsCrossing DoorObstacle) wlps w
 -- TODO use vector instead of list, perhaps also memoisation of rectanglePairs

src/Dodge/Render/ShapePicture.hs

@@ -149,15 +149,28 @@ drawInspectWalls w = foldMap (drawInspectWall w)
     (a,b) = _lLine w
 
 drawInspectWall :: World -> Wall -> Picture
-drawInspectWall _ wl = setLayer DebugLayer $ 
+drawInspectWall w wl = setLayer DebugLayer $ 
         color rose (thickLine 3 [a,b])
-    <> foldMap (drawZone wlZoneSize)
+--    <> foldMap (drawZone wlZoneSize)
-        (runIdentity $ S.toList_ $ zoneOfWall wlZoneSize wl)  -- this won't work if wlZoneSize is not consistent
+--        (runIdentity $ S.toList_ $ zoneOfWall wlZoneSize wl)  -- this won't work if wlZoneSize is not consistent
+    <> foldMap (drawDoorPaths w) (wl ^? wlStructure . wsDoor)
   where
     (a,b) = _wlLine wl 
---    $ line [a,b]
+
---  where
+drawDoorPaths :: World -> Int -> Picture
---    (a,b) = _wSelect w
+drawDoorPaths w drid = fromMaybe mempty $ do
+    paths <- w ^? doors . ix drid . drObstructs
+--    path <- listToMaybe paths
+--    undefined
+    return $ foldMap (drawPathEdge . (^. _3)) paths
+--    return $ (drawPathEdge . (^. _3)) path
+
+drawPathEdge :: PathEdge -> Picture
+drawPathEdge pe = setLayer DebugLayer $ color col $ arrow (_peStart pe) (_peEnd pe)
+  where
+    col = case _peObstacles pe of
+        pos | WallObstacle `Set.member` pos -> blue
+            | True -> red
 
 drawWorldSelect :: World -> Picture
 drawWorldSelect w = setLayer DebugLayer