Fix button not updating bug
This commit is contained in:
@@ -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
@@ -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
|
||||
|
||||
@@ -250,6 +250,7 @@ defaultButton = Button
|
||||
, _btState = BtOff
|
||||
, _btTermMID = Nothing
|
||||
, _btName = ""
|
||||
, _btColor = red
|
||||
}
|
||||
defaultPP :: PressPlate
|
||||
defaultPP = PressPlate
|
||||
|
||||
+1
-1
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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'
|
||||
|
||||
Reference in New Issue
Block a user