Improve pathing debugging, work on door pathing

src/Dodge/Placement/Instance/Door.hs

@@ -33,7 +33,7 @@ putDoubleDoorThen wl cond soff a b speed cont
 doorBetween :: Wall -> (World -> Bool) -> Float -> Point2 -> Point2 -> Float ->
     (Placement -> Maybe Placement) -> Placement
 doorBetween wl cond soff pa pb speed g = case divideLine 40 pa pb of
-    [x,y] -> ptCont (PutSlideDr adoor wl soff x y) g
+    [x,y] -> ptCont (PutSlideDr adoor wl DoorObstacle soff x y) g
     (x:y:zs) -> divideDoorPane Nothing wl cond (soff - dist y pb) speed (zip (x:y:zs) (y:zs)) g
     _ -> undefined
   where
@@ -48,7 +48,7 @@ divideDoorPane mid wl cond soff speed ppairs g = case ppairs of
     (p:ps) -> ptCont (adoor p) $ \pl -> Just $ divideDoorPane (_plMID pl) wl cond soff speed ps g
     _ -> undefined
   where
-    adoor (x,y) = PutSlideDr thedoor wl soff x y
+    adoor (x,y) = PutSlideDr thedoor wl DoorObstacle soff x y
     thedoor = defaultDoor & drSpeed .~ speed & drTrigger .~ cond
         & drPushedBy .~ maybe PushesItself PushedBy mid
 
@@ -67,7 +67,7 @@ switchDoor btpos btrot dra drb col = pContID (PS btpos btrot) (PutButton $ makeS
     $ \btid -> jsps0J (doorbetween btid dra drc)
     $          sps0   (doorbetween btid drb drc)
   where
-    doorbetween btid a b = PutSlideDr thedoor (switchWallCol col) 1 a b
+    doorbetween btid a b = PutSlideDr thedoor (switchWallCol col) DoorObstacle 1 a b
       where
         thedoor = defaultDoor
             & drTrigger .~ cond btid

src/Dodge/Placement/PlaceSpot.hs

@@ -95,10 +95,10 @@ placeSpotID ps pt w = case pt of
     PutLS       ls          -> plNewUpID lightSources lsID (mvLS p' rot ls) w
     PutPPlate   pp          -> plNewUpID pressPlates ppID (mvPP p rot pp) w
     RandPS      rgn         -> evaluateRandPS rgn ps w
-    PutDoor     col f   pss -> plDoor col f (map (bimap doShift doShift) pss) w
+    PutDoor     col eo f   pss -> plDoor col eo f (map (bimap doShift doShift) pss) w
     PutCoord    cp          -> plNewID   coordinates (doShift cp) w
-    PutSlideDr  wl dr off  a   b 
-                            -> plSlideDoor wl dr off (doShift a) (doShift b) w
+    PutSlideDr  wl dr eo off  a   b 
+                            -> plSlideDoor wl dr eo off (doShift a) (doShift b) w
     PutBlock    bl wl  ps'  -> plBlock (map doShift ps') (bl & blPos %~ doShift & blDir .~ rot)
                                     wl w
     PutLineBlock wl wdth a b     -> plLineBlock wl wdth (doShift a) (doShift b) w

src/Dodge/Placement/PlaceSpot/TriggerDoor.hs

@@ -23,12 +23,13 @@ import qualified Data.IntSet as IS
 import qualified Data.Graph.Inductive as FGL
 import qualified Streaming.Prelude as S
 plDoor :: Color
+    -> EdgeObstacle
     -> (World -> Bool)      -- ^ Opening condition
     -> [(Point2,Point2)]   -- ^ Door positions, closed to open.
                     -- Bumped out up and down by 9, not widened
     -> World
     -> (Int,World)
-plDoor col cond pss gw = (drid, addWalls $ gw & doors %~ addDoor) -- carefull with the ordering of addWalls
+plDoor col eo 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
@@ -40,14 +41,15 @@ plDoor col cond pss gw = (drid, addWalls $ gw & doors %~ addDoor) -- carefull wi
         , _drPos = head pss
         , _drOpenPos = head pss
         , _drClosePos = last pss
+        , _drObstacleType = eo
         }
     nsteps = length pss - 1
     wlids = take 4 [IM.newKey $ _walls gw ..]
     wlps' = uncurry (rectanglePairs 9) $ head pss
-    addWalls w' = foldl' (addDoorWall drid $ switchWallCol col) w' $ zip wlids wlps'
+    addWalls w' = foldl' (addDoorWall eo drid $ switchWallCol col) w' $ zip wlids wlps'
 
-addDoorWall :: Int -> Wall -> World -> (Int,(Point2,Point2)) -> World
-addDoorWall drid wl w (wlid,wlps) = w' 
+addDoorWall :: EdgeObstacle -> Int -> Wall -> World -> (Int,(Point2,Point2)) -> World
+addDoorWall eo drid wl w (wlid,wlps) = w' 
     & walls %~ IM.insert wlid wl
         { _wlLine = wlps
         , _wlID = wlid
@@ -55,7 +57,7 @@ addDoorWall drid wl w (wlid,wlps) = w'
         }
     & doors . ix drid . drObstructs .++~ es
   where
-    (w',es) = uncurry (obstructPathsCrossing DoorObstacle) wlps w
+    (w',es) = uncurry (obstructPathsCrossing eo) 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
@@ -121,12 +123,13 @@ maybeClearDoorPath eo w (x,y,pe)
 plSlideDoor 
     :: Door 
     -> Wall
+    -> EdgeObstacle
     -> Float
     -> Point2 
     -> Point2 
     -> World
     -> (Int, World)
-plSlideDoor dr wl shiftOffset a b gw 
+plSlideDoor dr wl eo shiftOffset a b gw 
     = (drid, addDoorWalls $ gw & doors %~ addDoor)
   where
     drid = IM.newKey $ _doors gw
@@ -138,9 +141,9 @@ plSlideDoor dr wl shiftOffset a b gw
         , _drPos = (a,b)
         , _drOpenPos = (shiftLeft a,shiftLeft b)
         , _drClosePos = (a,b)
-        , _drObstacleType = DoorObstacle
+        , _drObstacleType = eo
         }
-    addDoorWalls w' = foldl' (addDoorWall drid wl) w' $ zip wlids pairs
+    addDoorWalls w' = foldl' (addDoorWall eo drid wl) w' $ zip wlids pairs
     pairs = rectanglePairs 9 a b
     shiftLeft  = (+.+ (a -.- b +.+ shiftOffset *.* normalizeV (b -.- a)))
     wlids = take 4 [IM.newKey $ _walls gw ..]