Add indicator light to switch doors

src/Dodge/LevelGen/Data.hs

@@ -83,6 +83,7 @@ data Room = Room
     }
 data RoomWire
     = RoomWire Point2 Float
+    | WallWire Point2 Float Float
 data RoomPos 
     = OutLink Int    Point2  Float
     | InLink  Point2 Float
@@ -104,20 +105,6 @@ makeLenses ''PSType
 makeLenses ''PlacementSpot
 makeLenses ''Placement
 
--- TODO rename to any unused link facing out
-anyLnkOutPS :: PlacementSpot
-anyLnkOutPS = PSLnk f (const id) Nothing
-  where
-    f (UnusedLink p a) = Just $ PS p a
-    f _ = Nothing
-    
-
-anyLnkInPS :: Float -- ^ amount to shift inward
-    -> PlacementSpot
-anyLnkInPS x = PSLnk f (const id) Nothing
-  where
-    f (UnusedLink v a) = Just $ PS (v -.- x *.* unitVectorAtAngle (a + 0.5 * pi)) (a+ pi)
-    f _ = Nothing
 
 spNoID :: PlacementSpot -> PSType -> Placement
 spNoID ps pst = Placement ps pst Nothing (const Nothing)

src/Dodge/LevelGen/Switch.hs

@@ -1,6 +1,8 @@
 module Dodge.LevelGen.Switch
     ( makeSwitch
     , makeButton
+    , makeSwitchSPic
+    , drawSwitchWire
     ) where
 import Dodge.Data
 import Dodge.Default
@@ -44,6 +46,50 @@ drawSwitch col1 col2 bt
         ]   
         , mempty)
 
+drawSwitchWire :: Color -> Color -> Button -> SPic
+drawSwitchWire col1 col2 bt
+    | _btState bt == BtOff = flick $ pi/4
+    | otherwise = flick (negate (pi/4))
+  where
+    flick a = ( mconcat
+        [ colorSH col1 . translateSHz 10 . upperPrismPoly 10 $ rectNSEW (-2) (-5) 10 (-10)
+        , colorSH col2 . translateSH (V3 0 (-2) 15) . rotateSH a . upperPrismPoly 2 $ rectNSEW 10 0 2 (-2)
+        ]   
+        , mempty)
+
+makeSwitchSPic
+    :: (Button -> SPic)
+    -> (World -> World) -- ^ Switch on effect
+    -> (World -> World) -- ^ Switch off effect
+    -> Button
+makeSwitchSPic dswitch effOn effOff = Button
+    { _btPict = dswitch
+    , _btPos = V2 0 0
+    , _btRot = 0
+    , _btEvent = flipSwitch
+    , _btID = 0
+    , _btText = "SWITCH/"
+    , _btState = BtOff
+    }
+  where 
+    flipSwitch b w = switchEffect b . soundFromGeneral (LeverSound 0) (bpos b) click1S Nothing $ w
+    bpos b w = _btPos $ _buttons w IM.! _btID b
+    switchEffect b = case _btState b of
+        BtOff -> effOn  . over buttons (IM.adjust turnOn  (_btID b))
+        BtOn  -> effOff . over buttons (IM.adjust turnOff (_btID b))
+        _ -> error "Trying to switch a button with no label"
+    turnOn :: Button -> Button
+    turnOn bt = bt 
+        { _btState = BtOn
+        , _btText = "SWITCH\\"
+        }
+    turnOff :: Button -> Button
+    turnOff bt = bt 
+        { _btState = BtOff
+        , _btText = "SWITCH/"
+        }
+    
+
 makeSwitch 
     :: Color
     -> Color