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