Crush run-past room

src/Dodge/Room/Airlock.hs

@@ -26,8 +26,7 @@ import ShapePicture
 
 -- | A passage with a switch that opens forward access while closing backwards access.
 airlock :: RandomGen g => State g Room
-airlock =
-    join $
+airlock = join $
         takeOne [return airlock0, return airlock90, return airlockCrystal, airlockZ]
 
 xSwitch :: PSType
@@ -89,7 +88,7 @@ airlock0 =
                         \_ _ -> 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)
+            , sps0 $ putShape $ thinHighBar 95 (V2 40 50) (V2 (-1) 50)
             ]
         , _rmBound = [rectNSWE 75 15 0 40, switchcut]
         }

src/Dodge/Room/LongDoor.hs

@@ -3,6 +3,9 @@
 -- | Rooms containing long doors, probably with a big reveal behind them.
 module Dodge.Room.LongDoor where
 
+import Dodge.Room.Modify
+import qualified Data.IntMap.Strict as IM
+import Dodge.Default
 import Control.Monad
 import Data.Maybe
 import qualified Data.Set as S
@@ -11,7 +14,6 @@ import Dodge.Creature
 import Dodge.Data.GenWorld
 import Dodge.Default.Door
 import Dodge.Default.Room
-import Dodge.Default.Wall
 import Dodge.Door.PutSlideDoor
 import Dodge.LevelGen.PlacementHelper
 import Dodge.LevelGen.Switch
@@ -136,6 +138,41 @@ addButtonSlowDoor x h =
     lsx = 30
     lp@(V2 lx ly) = V2 100 (-20)
 
+makeDumbSwitch :: Int -> Button
+makeDumbSwitch i = defaultButton & btEvent .~ ButtonDumbSwitch i
+
+slowCrushRoom :: RandomGen g => State g Room
+slowCrushRoom = do
+    rm <- shuffleLinks =<< roomRectAutoLights 200 100
+    let rm' = removeLights rm
+            & rmPmnts .~ [spanLightI (V2 0 60) (V2 35 100)
+                , spanLightI (V2 200 60) (V2 165 100)
+                ]
+    return $ rm'
+        & rmLinks %~ setOutLinksByType (OnEdge East)
+        & rmLinks %~ setInLinksByType (OnEdge West)
+        & rmPmnts .:~
+         (ps0 (PutTrigger False) $ \i -> Just $
+            pContID (apos West 5) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
+            pContID (apos East (-5)) (PutButton $ makeDumbSwitch i) $ \_ -> Just $
+        sps0 (PutDoor (dr & drTrigger .~ WdTrig i) defaultDoorWall) & plIDCont . mapped . mapped ?~
+        sps0 (PutDoor (dr1 & drTrigger .~ WdTrig i) defaultDoorWall)
+        )
+        
+  where
+    dr = defaultDoor
+        & drUpdate .~ DoorLerp 0.01
+        & drZeroPos .~ (V2 65 (-40), 0)
+        & drOnePos .~ (V2 65 50, 0)
+        & drFootPrint .~ IM.fromDistinctAscList (zip [0..] (loopPairs . reverse $ rectWH 35 50))
+    dr1 = dr
+        & drOnePos .~ (V2 135 (-40), 0)
+        & drZeroPos .~ (V2 135 50, 0)
+    apos edge x = (rprBool (t edge) & psSelect . mapped . mapped . _Just . _1 %~ (psRot +~ pi) . (psPos +~ V2 x 0))
+    t edge rp _ = case _rpType rp of
+        UnusedLink s -> OnEdge edge `S.member` s
+        _ -> False
+
 slowDoorRoom :: RandomGen g => State g Room
 slowDoorRoom = do
     x <- state $ randomR (400, 800)

src/Dodge/Room/Procedural.hs

@@ -37,7 +37,7 @@ import RandomHelp
 
 --import Control.Lens
 -- This will need a cleanup, but it might change a bit first
-{- A simple rectangular room with a light in the center.
+{- A simple rectangular room with no lights.
 Creates links and pathfinding graph.  -}
 roomRect :: Float -> Float -> Int -> Int -> Room
 roomRect x y xn yn =

src/Dodge/Room/Tutorial.hs

@@ -55,6 +55,8 @@ tutAnoTree = do
     foldMTRS
         [ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
         , corDoor
+        , tToBTree "slowCrush" . return . cleatOnward <$> slowCrushRoom
+        , corDoor
         , chasmSpitTerminal
 --a        , return $ tToBTree "cor" $ return $ cleatOnward corridor
 --a        , corDoor