Unify more doors

src/Dodge/Room/Airlock.hs

@@ -19,8 +19,7 @@ import System.Random
 import Control.Monad.State
 {- | A passage with a switch that opens forward access while closing backwards access. -}
 airlock :: RandomGen g => State g Room
---airlock = takeOne [airlock0,airlock90,airlockCrystal]
-airlock = takeOne [airlock0]
+airlock = takeOne [airlock0,airlock90,airlockCrystal]
 {- | Straight airlock -}
 airlock0 :: Room
 airlock0 = defaultRoom
@@ -29,10 +28,8 @@ airlock0 = defaultRoom
     , _rmPath  = [(V2 20 95,V2 20 45) ,(V2 20 45,V2 20  5) ]
     , _rmPS    = 
         [Placement (PS (V2 (-35) 50) (negate $ pi/2) $ PutButton $ makeSwitch col red id id)
-            $ \btid -> Just $ putDoubleDoorThen col (not . cond' btid) (V2 (-1) 20) (V2 41 20) 2
-                $ Just $ putDoubleDoorThen col (cond' btid) (V2 (-1) 80) (V2 41 80) 2 Nothing
-          --  $ \btid -> jspsJ (V2 0 0) 0 (PutDoubleDoor col (not . cond' btid) (V2 1 20) (V2 39 20) 2)
-          --  $ sPS (V2 0 0) 0 $ PutDoubleDoor col (cond' btid) (V2 1 80) (V2 39 80) 2
+            $ \btid -> Just $ putDoubleDoorThen False col (not . cond' btid) (V2 (-1) 20) (V2 41 20) 2
+                $ Just $ putDoubleDoorThen False col (cond' btid) (V2 (-1) 80) (V2 41 80) 2 Nothing
         ,mountedLightI 70 (V2 (-2) 30) (V2 (-2) 70)
         ,sps0 $ PutForeground $ thinHighBar 75 (V2 40 50) (V2 (-1) 50)
         ]

src/Dodge/Room/LongDoor.hs

@@ -16,6 +16,7 @@ import Dodge.RandomHelp
 import Dodge.Creature.Inanimate
 import Dodge.Creature
 import Dodge.LightSources.Lamp
+import Dodge.Placements
 import Picture
 import Geometry
 
@@ -40,8 +41,8 @@ twinSlowDoorRoom w h x = defaultRoom
     , _rmPath   = []
     , _rmPS     = 
         [ Placement (PS (V2 0 (h-5)) pi $ PutButton $ makeButton col id)
-            $ \btid -> jsps0J (PutSingleDoor col (cond' btid) (V2 x 1) (V2 x h) wlSpeed)
-            $ ps0 (PutSingleDoor col (cond' btid) (V2 (-x) 1) (V2 (-x) h) wlSpeed)
+            $ \btid -> jsps0J (PutSlideDoor False col (cond' btid) (V2 x 1) (V2 x h) wlSpeed)
+            $ ps0 (PutSlideDoor False col (cond' btid) (V2 (-x) 1) (V2 (-x) h) wlSpeed)
             $ \did -> jps0 (PutLS (colorLightAt (V3 0.75 0 0) (V3 0 (h-1) lampHeight) 0))
             $ \lsid -> jsps0 $ PutProp $ addColorChange lsid did $ lampCoverWhen (drmoving did) (V2 0 (h-1)) lampHeight
         ]
@@ -104,15 +105,22 @@ slowDoorRoom = do
      pillars <- takeOne [pillarsa, pillarsb, pillarsc]
      let cond x'  = (sndV2 . fst) x' > h + 40
          cond2 x' = (sndV2 . fst) x' < h - 40
-     but <- takeOne [PutBtDoor (dim $ light red) butPos butRot (V2 0 h) (V2 x h) 2
+     but <- takeOne [butDoor x h butPos butRot
                     ]
      fmap connectRoom 
         (filterLinks cond =<< 
             changeLinkTo cond2 
-                (set rmPS ([sPS (V2 0 0) 0 but] ++ crits ++ pillars ++ barrels ++ lsources) 
+                (set rmPS ([but] ++ crits ++ pillars ++ barrels ++ lsources) 
                 $ roomRectAutoLinks x y
                 )
         )
+  where
+    butDoor x h bpos brot 
+        = ps0 (PutButton $ (makeButton col id) {_btPos = bpos, _btRot = brot})
+        $  \btid -> Just $ putDoubleDoor False col (cond' btid) (V2 0 h) (V2 x h) 2
+    col = dim $ light red
+    cond' btid w = w ^? buttons . ix btid . btState /= Just BtOff
+     --but <- takeOne [PutBtDoor (dim $ light red) butPos butRot (V2 0 h) (V2 x h) 2
 
 randC1 :: PSType
 randC1 = RandPS $ takeOne $ map PutCrit $ armourChaseCrit : replicate 50 chaseCrit

src/Dodge/Room/Placement.hs

@@ -177,8 +177,8 @@ putBlockN a x b y = [ blockLine (V2 a b) (V2 a y)
 
 switchDoor :: Point2 -> Float -> Point2 -> Point2 -> Color -> Placement
 switchDoor btpos btrot dra drb col = Placement (PS btpos btrot $ PutButton $ makeSwitch col red id id)
-    $ \btid -> jsps0J (PutSingleDoor col (cond btid) dra drc 2)
-    $          sps0   (PutSingleDoor col (cond btid) drb drc 2)
+    $ \btid -> jsps0J (PutSlideDoor False col (cond btid) dra drc 2)
+    $          sps0   (PutSlideDoor False col (cond btid) drb drc 2)
   where
     drc = 0.5 *.* (dra +.+ drb)
     cond btid w' = _btState (_buttons w' IM.! btid) == BtOn

src/Dodge/Room/Procedural.hs

@@ -232,7 +232,7 @@ centerVaultRoom w h d = do
     col = dim $ dim $ bright red
     theDoor = 
         [ Placement (PS (V2 35 (d+4)) 0 $ PutButton $ makeSwitch col red id id)
-            $ \btid -> jspsJ (V2 0 (d-10)) 0 (PutSingleDoor col (cond' btid) (V2 (-21) 0) (V2 0 0) 2)
-            $          sPS   (V2 0 (d-10)) 0 (PutSingleDoor col (cond' btid) (V2   21  0) (V2 0 0) 2)
+            $ \btid -> jspsJ (V2 0 (d-10)) 0 (PutSlideDoor False col (cond' btid) (V2 (-21) 0) (V2 0 0) 2)
+            $          sPS   (V2 0 (d-10)) 0 (PutSlideDoor False col (cond' btid) (V2   21  0) (V2 0 0) 2)
         ]
     cond' btid w' = _btState (_buttons w' IM.! btid) == BtOn