Improve door pathing update

src/Dodge/Placement/Instance/Door.hs

@@ -15,25 +15,25 @@ import Dodge.LevelGen.Switch
 import Control.Lens
 import qualified Data.IntMap.Strict as IM
 
-putDoubleDoor :: Wall -> (World -> Bool)  -> Point2 -> Point2 -> Float -> Placement
-putDoubleDoor wl cond a b speed 
-    = putDoubleDoorThen wl cond 1 a b speed (const $ const Nothing)
+putDoubleDoor :: EdgeObstacle -> Wall -> (World -> Bool)  -> Point2 -> Point2 -> Float -> Placement
+putDoubleDoor eo wl cond a b speed 
+    = putDoubleDoorThen eo wl cond 1 a b speed (const $ const Nothing)
 
-putDoubleDoorThen :: Wall -> (World -> Bool) 
+putDoubleDoorThen ::EdgeObstacle ->  Wall -> (World -> Bool) 
     -> Float -> Point2 -> Point2 -> Float 
     -> (Placement -> Placement -> Maybe Placement)
     -> Placement
-putDoubleDoorThen wl cond soff a b speed cont 
-     = doorBetween wl cond soff a half speed
-    $ \pl1 -> Just $ doorBetween wl cond soff b half speed
+putDoubleDoorThen eo wl cond soff a b speed cont 
+     = doorBetween eo wl cond soff a half speed
+    $ \pl1 -> Just $ doorBetween eo wl cond soff b half speed
     $ \pl2 -> cont pl1 pl2
   where
     half = 0.5 *.* (a +.+ b)
 
-doorBetween :: Wall -> (World -> Bool) -> Float -> Point2 -> Point2 -> Float ->
+doorBetween :: EdgeObstacle -> 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 DoorObstacle soff x y) g
+doorBetween eo wl cond soff pa pb speed g = case divideLine 40 pa pb of
+    [x,y] -> ptCont (PutSlideDr adoor wl eo 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
@@ -55,7 +55,7 @@ divideDoorPane mid wl cond soff speed ppairs g = case ppairs of
 putAutoDoor :: Point2 -> Point2 -> Placement
 putAutoDoor a b = PlacementUsingPos (addZ 0 a)
     $ \az -> PlacementUsingPos (addZ 0 b)
-    $ \bz -> putDoubleDoor defaultAutoWall
+    $ \bz -> putDoubleDoor AutoDoorObstacle defaultAutoWall
         (cond az bz) a b 3
   where
     --cond az bz = any (crNearSeg 40 (stripZ az) (stripZ bz)) . IM.filter isAnimate . _creatures

src/Dodge/Room/Airlock.hs

@@ -27,8 +27,8 @@ airlock0 = defaultRoom
     , _rmPath  = foldMap doublePairSet [(V2 20 95,V2 20 45) ,(V2 20 45,V2 20  5) ]
     , _rmPmnts    = 
         [pContID (PS (V2 (-35) 50) (negate $ pi/2)) (PutButton $ makeSwitch col red id id)
-            $ \btid -> Just $ putDoubleDoorThen thewall (not . cond' btid) 1 (V2 0 20) (V2 40 20) 2
-                $ \_ _ -> Just $ putDoubleDoor thewall (cond' btid) (V2 0 80) (V2 40 80) 2
+            $ \btid -> Just $ putDoubleDoorThen DoorObstacle thewall (not . cond' btid) 1 (V2 0 20) (V2 40 20) 2
+                $ \_ _ -> Just $ putDoubleDoor DoorObstacle thewall (cond' btid) (V2 0 80) (V2 40 80) 2
         , invisibleWall $ rectNSWE 60 40 (-40) (-30)
         ,spanLightI (V2 (-2) 30) (V2 (-2) 70)
         ,sps0 $ putShape $ thinHighBar 75 (V2 40 50) (V2 (-1) 50)

src/Dodge/Room/Door.hs

@@ -40,6 +40,6 @@ triggerDoorRoom inplid = defaultRoom
 -- note no bounds
     }
   where 
-    f (pmnt:_) = putDoubleDoor (switchWallCol red) (cond pmnt) (V2 0 20) (V2 40 20) 2
+    f (pmnt:_) = putDoubleDoor DoorObstacle (switchWallCol red) (cond pmnt) (V2 0 20) (V2 40 20) 2
     f _ = error "tried to put a door using an empty placement list"
     cond pmnt w = w & _triggers w IM.! fromJust (_plMID pmnt)

src/Dodge/Room/LongDoor.hs

@@ -118,7 +118,7 @@ addButtonSlowDoor x h rm = do
     thewall = switchWallCol red
     butDoor = putLitButOnPos col 
         (rprBool (isUnusedLnkType InLink))
-        $  \btplmnt -> Just $ putDoubleDoorThen thewall (cond' $ fromJust $ _plMID btplmnt) 
+        $  \btplmnt -> Just $ putDoubleDoorThen DoorObstacle thewall (cond' $ fromJust $ _plMID btplmnt) 
                             30 (V2 0 h) (V2 x h) 2
         $ \dr1 dr2 -> 
             amountedlight dr1 50