Fix button not updating bug

src/Dodge/Combine/Combinations.hs

@@ -74,6 +74,7 @@ itemCombinations =
     , p [o SPARKGUN,p 2 PIPE] teslaGun
 
     , p [o TELEPORTMODULE,p 2 MICROCHIP] blinkGun
+    , p [o BLINKER, p 2 MICROCHIP] unsafeBlinkGun
 
     , po [MAGNET,TIN] magShield
 

src/Dodge/Data.hs

@@ -409,9 +409,9 @@ data Button = Button
     , _btID     :: Int
     , _btText   :: String
     , _btState  :: ButtonState
---    , _btTerminalParams :: World -> TerminalParams
     , _btTermMID :: Maybe Int
     , _btName   :: String
+    , _btColor  :: Color
     }
 data TerminalLine
     = TerminalLineDisplay

src/Dodge/Default.hs

@@ -250,6 +250,7 @@ defaultButton = Button
     , _btState = BtOff
     , _btTermMID = Nothing
     , _btName = ""
+    , _btColor = red
     }
 defaultPP :: PressPlate
 defaultPP = PressPlate

src/Dodge/Floor.hs

@@ -38,7 +38,7 @@ import Data.List (intersperse)
 
 initialAnoTree :: Annotation
 initialAnoTree = OnwardList 
-        $ intersperse (AnTree $ tToBTree "cori" . pure <$> shuffleLinks (cleatOnward corridor))
+        $ intersperse (AnTree $ tToBTree "door" . pure <$> shuffleLinks (cleatOnward door))
     [ IntAnno $ AnTree . startRoom
 --     ,  (SpecificRoom . return . tToBTree $ treePost [corridor,corridor,cleatOnward corridor])
     , AnTree $ tToBTree "spawners" <$> spawnerRoom

src/Dodge/Inventory.hs

@@ -158,7 +158,8 @@ checkTermDist w = case w ^? hud . hudElement . subInventory . termID of
 
 -- this looks ugly...
 updateCloseObjects :: World -> World
-updateCloseObjects w = w & closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
+updateCloseObjects w = w 
+    & closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
     & creatures . ix (_yourID w) . crInvSel %~ updateinvsel
   where
     updateinvsel curinvsel
@@ -171,8 +172,10 @@ updateCloseObjects w = w & closeObjects .~ unionBy closeObjEq oldCloseFiltered c
         . IM.elems 
         $ _buttons w
     currentClose = filt $ map Left (IM.elems $ _floorItems w) ++ activeButtons
-    oldClose     = filt $ _closeObjects w
+    oldClose     = filt $ mapMaybe updatebyid $ _closeObjects w
     oldCloseFiltered = intersectBy closeObjEq oldClose currentClose
+    updatebyid (Left flid) = fmap Left $ w ^? floorItems . ix (_flItID flid)
+    updatebyid (Right btid) = fmap Right $ w ^? buttons . ix (_btID btid)
 
 updateRBList :: World -> World
 updateRBList w 

src/Dodge/LevelGen/Switch.hs

@@ -32,12 +32,13 @@ makeButton col eff = defaultButton
 
 drawSwitch :: Color -> Color -> Button -> SPic
 drawSwitch col1 col2 bt
-    | _btState bt == BtOff = flick $ pi/4
+    | _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 col1 . upperPrismPoly 20 $ rectNSEW (-2) (-5) 10 (-10)
-        , colorSH col2 . translateSH (V3 0 (-2) 15) . rotateSH a . upperPrismPoly 2 $ rectNSEW 10 0 2 (-2)
+        , colorSH col2 . translateSH (V3 0 (-2) 20) . rotateSH a . upperPrismPoly 2 $ rectNSEW 10 0 2 (-2)
         ]   
         , mempty)
 
@@ -64,23 +65,14 @@ makeSwitchSPic dswitch effOn effOff = defaultButton
     , _btState = BtOff
     }
   where 
-    flipSwitch b w = switchEffect b . soundFromGeneral (LeverSound 0) (bpos b) click1S Nothing $ w
+    flipSwitch b = switchEffect b . soundFromGeneral (LeverSound 0) (bpos b) click1S Nothing
     bpos b w = _btPos $ _buttons w IM.! _btID b
     switchEffect b = case _btState b of
-        BtOff -> effOn  . over buttons (IM.adjust turnOn  (_btID b))
+        BtOff -> effOn  . (buttons . ix (_btID b) %~ turnOn )
-        BtOn  -> effOff . over buttons (IM.adjust turnOff (_btID b))
+        BtOn  -> effOff . (buttons . ix (_btID b) %~ turnOff)
         _ -> error "Trying to switch a button with no label"
-    turnOn :: Button -> Button
+    turnOn  = (btState .~ BtOn ) .  (btText .~ "SWITCH\\")
-    turnOn bt = bt 
+    turnOff = (btState .~ BtOff) .  (btText .~ "SWITCH/")
-        { _btState = BtOn
-        , _btText = "SWITCH\\"
-        }
-    turnOff :: Button -> Button
-    turnOff bt = bt 
-        { _btState = BtOff
-        , _btText = "SWITCH/"
-        }
-    
     
 makeSwitch
     :: Color
@@ -88,26 +80,4 @@ makeSwitch
     -> (World -> World) -- ^ Switch on effect
     -> (World -> World) -- ^ Switch off effect
     -> Button
-makeSwitch col1 col2 effOn effOff = defaultButton
+makeSwitch col1 col2 f1 = (btColor .~ col1) . makeSwitchSPic (drawSwitch col1 col2) f1
-    { _btPict = drawSwitch col1 col2
-    , _btEvent = flipSwitch
-    , _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/"
-        }

src/Dodge/Placement/Instance/Terminal.hs

@@ -86,6 +86,7 @@ termButton = Button
     , _btState  = BtOff
     , _btTermMID = Nothing
     , _btName   = ""
+    , _btColor  = dark magenta
     }
 
 terminalColor :: Color

src/Dodge/Placement/Instance/Wall.hs

@@ -32,6 +32,14 @@ heightWall h ps = ps0j (PutShape . colorSH col $ upperPrismPoly h ps)
         , _wlHeight = h
         }
 
+invisibleWall :: [Point2] -> Placement
+invisibleWall ps = sps0 $ PutWall ps $ defaultWall
+    { _wlOpacity = SeeAbove
+    , _wlDraw = False
+    , _wlHeight = 0
+    , _wlTouchThrough = True
+    }
+
 midWall :: [Point2] -> Placement
 midWall ps = ps0j (PutShape . colorSH col $ upperPrismPoly 50 ps)
     $ sps0 $ PutWall ps theWall

src/Dodge/Room/Airlock.hs

@@ -28,6 +28,7 @@ airlock0 = defaultRoom
         [pContID (PS (V2 (-35) 50) (negate $ pi/2)) (PutButton $ makeSwitch col red id id)
             $ \btid -> Just $ putDoubleDoorThen False col (not . cond' btid) 1 (V2 0 20) (V2 40 20) 2
                 $ \_ _ -> Just $ putDoubleDoor False col (cond' btid) (V2 0 80) (V2 40 80) 2
+        , invisibleWall $ rectNSWE 60 40 (-40) (-30)
         ,spanLightI (V2 (-2) 30) (V2 (-2) 70)
         ,sps0 $ PutShape $ thinHighBar 75 (V2 40 50) (V2 (-1) 50)
         ]
@@ -113,7 +114,6 @@ airlock90 = defaultRoom
     , _rmPmnts    = 
         [ pContID (PS (V2 120 120) (3 * pi/4)) (PutButton $ makeSwitch col red id id)
             $ \btid -> jsps (V2 5 5) 0 $ PutDoor col (cond btid) pss
-        --,mntLS vShape (V2 20 20) (V3 70 70 50)
         , mntLS vShape (V2 35 35) (V3 70 70 50)
         ]
     , _rmBound = 

src/Dodge/Room/Start.hs

@@ -56,12 +56,12 @@ powerFakeout = do
             ,cleatOnward door]
 
 startRoom :: RandomGen g => Int -> State g (MetaTree Room String)
-startRoom i = join (takeOne
+startRoom i = join $ takeOne
     [ attachOnward "startThenWeaponRoom" <$> preCritStart <*> weaponRoom i
     , rezBoxesWpCrit            >>= rToOnward "rezBoxesWpCrit"
     , runPastStart i             >>= rToOnward ("runPastStart " ++ show i)
     , attachOnward "startThenCraft" <$> preCritStart <*> (startCrafts >>= roomsContaining [])
-    ])
+    ]
 randomChallenges :: RandomGen g => State g (MetaTree Room String)
 randomChallenges = shootingRange
 --        join (takeOne
@@ -84,7 +84,7 @@ rezBoxStart = do
 
 preCritStart :: RandomGen g => State g (MetaTree Room String)
 preCritStart = join $ takeOneWeighted 
-    [10,10,1::Float]
+    [100,100,1::Float]
     [rezBoxes
     ,rezBox'
     ,attachOnward "rezBoxPowerFakeout" <$> rezBox' <*> powerFakeout'