Improve doors

src/Dodge/Room/Airlock.hs

@@ -44,8 +44,8 @@ decontamRoom i =
         & rmPmnts
             .~ [ pContID (PS (V2 (-35) 50) (negate $ pi / 2)) xSwitch $
                     \btid -> Just $
-                        putDoubleDoorThen defaultDoorWall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $
-                            \_ _ -> Just $ putDoubleDoor defaultDoorWall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
+                        putDoubleDoorThen defaultDoorWall 1 (V2 0 20) (V2 40 20) (dr1 btid) $
+                            \_ _ -> Just $ putDoubleDoor defaultDoorWall (V2 0 80) (V2 40 80) (dr2 btid)
                , invisibleWall $ rectNSWE 60 40 (-40) (-30)
                , spanLightI (V2 (-20) 30) (V2 (-20) 70)
                , analyser (NoItemZone ps) (PS 50 0) (PS mcpos 0) & plExternalID ?~ i
@@ -55,15 +55,16 @@ decontamRoom i =
         & rmInPmnt .~ [(0, return . f)]
         & rmBound .~ [rectNSWE 75 15 0 40, switchcut]
   where
+    dr1 btid = defaultDoor & drTrigger .~ (WdBlNegate $ WdBlBtOn btid)
+    dr2 btid = defaultDoor & drTrigger .~ (WdBlBtOn btid)
     f gw = fromMaybe (error "tried to put a door using an empty placement list") $ do
         pmnt <- gw ^? genPmnt . ix i
         return $
             putDoubleDoor
                 defaultDoorWall
-                (cond pmnt)
                 (V2 (-10) 35)
                 (V2 (-10) 65)
-                2
+                (defaultDoor & drTrigger .~ cond pmnt)
     cond pmnt = WdTrig $ pmnt ^?! plMID . _Just
     mcpos = V2 70 50
     cutps = [rectNSWE 100 0 0 40, switchcut]
@@ -84,8 +85,8 @@ airlock0 =
         , _rmPmnts =
             [ pContID (PS (V2 (-35) 50) (negate $ pi / 2)) xSwitch $
                 \btid -> Just $
-                    putDoubleDoorThen defaultDoorWall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $
-                        \_ _ -> Just $ putDoubleDoor defaultDoorWall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
+                    putDoubleDoorThen defaultDoorWall 1 (V2 0 20) (V2 40 20) (dr1 btid) $
+                        \_ _ -> Just $ putDoubleDoor defaultDoorWall (V2 0 80) (V2 40 80) (dr2 btid)
             , invisibleWall $ rectNSWE 60 40 (-40) (-30)
             , spanLightI (V2 (-2) 30) (V2 (-2) 70)
             , sps0 $ putShape $ thinHighBar 75 (V2 40 50) (V2 (-1) 50)
@@ -93,6 +94,8 @@ airlock0 =
         , _rmBound = [rectNSWE 75 15 0 40, switchcut]
         }
   where
+    dr1 btid = defaultDoor & drTrigger .~ (WdBlNegate $ WdBlBtOn btid)
+    dr2 btid = defaultDoor & drTrigger .~ (WdBlBtOn btid)
     switchcut = rectNSWE 65 35 (-40) 20
     lnks =
         [ (V2 20 95, 0)

src/Dodge/Room/Door.hs

@@ -1,6 +1,7 @@
 {- Rooms that connect other rooms, blocking sight.  -}
 module Dodge.Room.Door where
 
+import Dodge.Default.Door
 import Dodge.Default.Wall
 import Data.Maybe
 import Dodge.Data.GenWorld
@@ -42,5 +43,6 @@ triggerDoorRoom i =
   where
     f gw = return $ fromMaybe (error "tried to put a door using an empty placement list") $ do
         pmnt <- gw ^? genPmnt . ix i
-        return $ putDoubleDoor defaultDoorWall (cond pmnt) (V2 0 20) (V2 40 20) 2
+        return $ putDoubleDoor defaultDoorWall (V2 0 20) (V2 40 20)
+            (defaultDoor & drTrigger .~ (cond pmnt))
     cond pmnt = WdTrig $ fromJust (_plMID pmnt)

src/Dodge/Room/LongDoor.hs

@@ -64,7 +64,6 @@ twinSlowDoorRoom w h x =
   where
     --thewall = switchWallCol red
     thewall = defaultDoorWall
-    wlSpeed = 0.5
     lampheight = 41
     ps =
         [ rectNSWE h 0 (- w) w
@@ -72,7 +71,7 @@ twinSlowDoorRoom w h x =
         ]
     thedoor btid =
         defaultDoor
-            & drUpdate . drLerpSpeed .~ wlSpeed
+            & drUpdate . drLerpSpeed .~ 0.5
             & drTrigger .~ WdBlBtOn btid
     col = dim $ dim $ bright red
 
@@ -116,11 +115,11 @@ addButtonSlowDoor x h =
         $ \btplmnt -> Just
             . putDoubleDoorThen
                 defaultDoorWall
-                (WdBlBtOn $ fromJust $ _plMID btplmnt)
                 30
                 (V2 0 h)
                 (V2 x h)
-                0.5
+                (defaultDoor & drTrigger .~ (WdBlBtOn $ fromJust $ _plMID btplmnt)
+                    & drUpdate . drLerpSpeed .~ 0.5)
             $ \dr1 dr2 ->
                 Just
                     . sps0

src/Dodge/Room/Procedural.hs

@@ -310,7 +310,4 @@ centerVaultRoom w h d =
                     sPS (V2 0 (d -10)) 0 (putSlideDr (thedoor btid) thewall 1 (V2 21 0) (V2 0 0))
         ]
     thewall = defaultDoorWall
-    thedoor btid =
-        defaultDoor
-            & drTrigger .~ WdBlBtOn btid
-            & drUpdate . drLerpSpeed .~ 2
+    thedoor btid = defaultDoor & drTrigger .~ WdBlBtOn btid