Work on airlocks

src/Dodge/Room/Airlock.hs

@@ -3,6 +3,7 @@
 {- Rooms that contain two doors and a switch alternating both.  -}
 module Dodge.Room.Airlock where
 
+import Dodge.Annotation.Data
 import Dodge.Data.GenWorld
 import Dodge.Default.Door
 import Dodge.Default.Room
@@ -14,12 +15,36 @@ import Dodge.RoomLink
 import Geometry
 import Picture
 import RandomHelp
+import Control.Lens
 
 -- | A passage with a switch that opens forward access while closing backwards access.
 airlock :: RandomGen g => State g Room
 airlock = takeOne [airlock0, airlock90, airlockCrystal, airlockZ]
 
 --airlock = takeOne [airlockCrystal]
+decontamRoom :: State LayoutVars Room
+decontamRoom = do
+    return $ defaultRoom
+        & rmPolys .~ [rectNSWE 100 0 0 40, switchcut]
+        & rmLinks .~ muout lnks ++ muin [last lnks]
+        & 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 NoWorldEffect NoWorldEffect) $
+                \btid -> Just $
+                    putDoubleDoorThen DoorObstacle thewall (WdBlNegate $ WdBlBtOn btid) 1 (V2 0 20) (V2 40 20) 2 $
+                        \_ _ -> Just $ putDoubleDoor DoorObstacle thewall (WdBlBtOn btid) (V2 0 80) (V2 40 80) 2
+            , invisibleWall $ rectNSWE 60 40 (-40) (-30)
+            , spanLightI (V2 (-2) 30) (V2 (-2) 70)
+            ]
+        & rmBound .~ [rectNSWE 75 15 0 40, switchcut]
+  where
+    thewall = switchWallCol col
+    switchcut = rectNSWE 65 35 (-40) 80
+    lnks =
+        [ (V2 20 95, 0)
+        , (V2 20 5, pi)
+        ]
+    col = dim $ dim $ bright red
 
 -- | Straight airlock
 airlock0 :: Room
@@ -124,7 +149,7 @@ airlock90 =
     defaultRoom
         { _rmPolys =
             [ rectNSWE 100 10 10 100
-            , rectNSWE 20 0 20 60
+            , rectNSWE 20 (-0.1) 20 60
             , rectNSWE 20 60 20 0
             , map
                 toV2