Fix button not updating bug

This commit is contained in:
2022-06-14 18:47:11 +01:00
parent dafbd8a2da
commit 0957c79e58
10 changed files with 51 additions and 67 deletions
+1
View File
@@ -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
+9 -9
View File
@@ -402,16 +402,16 @@ data CrMvType
, _mvAimSpeed :: Float -> Float
}
data Button = Button
{ _btPict :: Button -> SPic
, _btPos :: Point2
, _btRot :: Float
, _btEvent :: Button -> World -> World
, _btID :: Int
, _btText :: String
, _btState :: ButtonState
-- , _btTerminalParams :: World -> TerminalParams
{ _btPict :: Button -> SPic
, _btPos :: Point2
, _btRot :: Float
, _btEvent :: Button -> World -> World
, _btID :: Int
, _btText :: String
, _btState :: ButtonState
, _btTermMID :: Maybe Int
, _btName :: String
, _btName :: String
, _btColor :: Color
}
data TerminalLine
= TerminalLineDisplay
+1
View File
@@ -250,6 +250,7 @@ defaultButton = Button
, _btState = BtOff
, _btTermMID = Nothing
, _btName = ""
, _btColor = red
}
defaultPP :: PressPlate
defaultPP = PressPlate
+1 -1
View File
@@ -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
+5 -2
View File
@@ -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
+11 -41
View File
@@ -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 col2 . translateSH (V3 0 (-2) 15) . rotateSH a . upperPrismPoly 2 $ rectNSEW 10 0 2 (-2)
[ colorSH col1 . upperPrismPoly 20 $ rectNSEW (-2) (-5) 10 (-10)
, colorSH col2 . translateSH (V3 0 (-2) 20) . rotateSH a . upperPrismPoly 2 $ rectNSEW 10 0 2 (-2)
]
, mempty)
@@ -64,50 +65,19 @@ 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))
BtOn -> effOff . over buttons (IM.adjust turnOff (_btID b))
BtOff -> effOn . (buttons . ix (_btID b) %~ turnOn )
BtOn -> effOff . (buttons . ix (_btID b) %~ turnOff)
_ -> 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/"
}
turnOn = (btState .~ BtOn ) . (btText .~ "SWITCH\\")
turnOff = (btState .~ BtOff) . (btText .~ "SWITCH/")
makeSwitch
makeSwitch
:: Color
-> Color
-> (World -> World) -- ^ Switch on effect
-> (World -> World) -- ^ Switch off effect
-> Button
makeSwitch col1 col2 effOn effOff = defaultButton
{ _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/"
}
makeSwitch col1 col2 f1 = (btColor .~ col1) . makeSwitchSPic (drawSwitch col1 col2) f1
+9 -8
View File
@@ -77,15 +77,16 @@ putTerminal col f = putTerminal'' (mc & mcColor .~ col) f (\_ -> basicMachineUpd
termButton :: Button
termButton = Button
{ _btPict = const mempty
, _btPos = 0
, _btRot = 0
, _btEvent = accessTerminal . _btTermMID
, _btID = 0
, _btText = "TERMINAL"
, _btState = BtOff
{ _btPict = const mempty
, _btPos = 0
, _btRot = 0
, _btEvent = accessTerminal . _btTermMID
, _btID = 0
, _btText = "TERMINAL"
, _btState = BtOff
, _btTermMID = Nothing
, _btName = ""
, _btName = ""
, _btColor = dark magenta
}
terminalColor :: Color
+8
View File
@@ -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
+3 -3
View File
@@ -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)
]
@@ -111,10 +112,9 @@ airlock90 = defaultRoom
,(V2 40 0,V2 0 40)
]
, _rmPmnts =
[pContID (PS (V2 120 120) (3 * pi/4)) (PutButton $ makeSwitch col red id id)
[ 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)
, mntLS vShape (V2 35 35) (V3 70 70 50)
]
, _rmBound =
[map toV2 [ (10,10)
+3 -3
View File
@@ -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'