Crush run-past room

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)