Crush run-past room

src/Dodge/Button/Draw.hs

@@ -1,16 +1,18 @@
-module Dodge.Button.Draw where
+module Dodge.Button.Draw (drawButton) where
 
+import Data.Maybe
+import Dodge.Data.LWorld
 import Color
-import Dodge.Data.Button
 import Geometry
 import Shape
 import ShapePicture
 import Control.Lens
 
-drawButton :: Button -> SPic
-drawButton bt = case bt ^. btEvent of
+drawButton :: LWorld -> Button -> SPic
+drawButton lw bt = case bt ^. btEvent of
     ButtonPress {_bpColor = col} -> defaultDrawButton col bt
     ButtonSwitch {_bsColor1 = col1, _bsColor2 = col2} -> drawSwitch col1 col2 bt
+    ButtonDumbSwitch i -> drawDumbSwitch (fromMaybe True $ lw ^? triggers . ix i)
     ButtonAccessTerminal _ -> mempty
 
 drawSwitch :: Color -> Color -> Button -> SPic
@@ -26,6 +28,19 @@ drawSwitch col1 col2 bt
             ]
         )
 
+drawDumbSwitch :: Bool -> SPic
+drawDumbSwitch t
+    |  t = flick $ pi / 4
+    | otherwise = flick (negate (pi / 4))
+  where
+    flick a = noPic
+        ( mconcat
+            [ colorSH red . upperBox Small Typical 20 $ rectNSWE (-2) (-5) (-10) 10
+            , colorSH (dim red) . translateSH (V3 0 (-2) 20) . rotateSH a . upperBox Small Typical 2 $
+                    rectNSWE 10 0 (-2) 2
+            ]
+        )
+
 defaultDrawButton :: Color -> Button -> SPic
 defaultDrawButton col bt = noPic
     ( translateSHz 15 . colorSH col $ upperBox Small Typical 5 buttonGeometry

src/Dodge/Button/Event.hs

@@ -12,6 +12,7 @@ doButtonEvent = \case
     ButtonPress False f _ -> buttonFlip f
     ButtonSwitch _ f _ _ True -> buttonFlip f
     ButtonSwitch f _ _ _ False -> buttonFlip f
+    ButtonDumbSwitch i -> \_ -> cWorld . lWorld . triggers . ix i %~ not
     ButtonAccessTerminal tid -> const $ accessTerminal tid
 
 buttonFlip :: WdWd -> Button -> World -> World

src/Dodge/Data/Button.hs

@@ -23,6 +23,7 @@ data ButtonEvent
         , _bsColor2 :: Color
         , _btOn :: Bool
         }
+    | ButtonDumbSwitch { _bdsTrigger :: Int }
     | ButtonAccessTerminal {_btTermID :: Int}
 
 data Button = Button

src/Dodge/Inventory/SelectionList.hs

@@ -237,6 +237,7 @@ btText :: Button -> String
 btText bt = case _btEvent bt of
     ButtonPress {} -> "BUTTON"
     ButtonSwitch {_btOn = t} -> if t then "SWITCH\\" else "SWITCH/"
+    ButtonDumbSwitch {} -> "SWITCH"
     ButtonAccessTerminal i -> "TERMINAL " ++ show i
 
 closeItemToTextPictures :: Item -> ([String], Color)

src/Dodge/Render/ShapePicture.hs

@@ -37,7 +37,7 @@ worldSPic cfig u =
                 (lw ^. items)
                 (filtOn _flItPos _floorItems)
             )
-        <> foldup btSPic (filtOn _btPos _buttons)
+        <> foldup (btSPic (w ^. cWorld . lWorld)) (filtOn _btPos _buttons)
         <> foldup (mcSPic (w ^. cWorld)) (filtOn _mcPos _machines)
 --        <> foldMap' drawChasm (w ^. cWorld . chasms)
         <> foldMap' (Prelude.uncurry drawCliff) (w ^. cWorld . cliffs)
@@ -166,8 +166,8 @@ floorItemSPic itm flit =
             (_flItRot flit)
             (itemSPic itm)
 
-btSPic :: Button -> SPic
-btSPic bt = uncurryV translateSPxy (_btPos bt) $ rotateSP (_btRot bt) (drawButton bt)
+btSPic :: LWorld -> Button -> SPic
+btSPic lw bt = uncurryV translateSPxy (_btPos bt) $ rotateSP (_btRot bt) (drawButton lw bt)
 
 mcSPic :: CWorld -> Machine -> SPic
 mcSPic cw mc = uncurryV translateSPxy (_mcPos mc) $ rotateSP (_mcDir mc) (drawMachine cw mc)

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