Allow for terminals to be deactivated
This commit is contained in:
@@ -11,8 +11,7 @@ drawButton :: Button -> SPic
|
|||||||
drawButton bt = case bt ^. btEvent of
|
drawButton bt = case bt ^. btEvent of
|
||||||
ButtonPress {_bpColor = col} -> defaultDrawButton col bt
|
ButtonPress {_bpColor = col} -> defaultDrawButton col bt
|
||||||
ButtonSwitch {_bsColor1 = col1, _bsColor2 = col2} -> drawSwitch col1 col2 bt
|
ButtonSwitch {_bsColor1 = col1, _bsColor2 = col2} -> drawSwitch col1 col2 bt
|
||||||
ButtonAccessTerminal -> mempty
|
ButtonAccessTerminal _ -> mempty
|
||||||
-- ButtonDoNothing -> mempty
|
|
||||||
|
|
||||||
drawSwitch :: Color -> Color -> Button -> SPic
|
drawSwitch :: Color -> Color -> Button -> SPic
|
||||||
drawSwitch col1 col2 bt
|
drawSwitch col1 col2 bt
|
||||||
|
|||||||
@@ -13,7 +13,7 @@ doButtonEvent = \case
|
|||||||
ButtonPress False f _ -> buttonFlip f
|
ButtonPress False f _ -> buttonFlip f
|
||||||
ButtonSwitch _ f _ _ True -> buttonFlip f
|
ButtonSwitch _ f _ _ True -> buttonFlip f
|
||||||
ButtonSwitch f _ _ _ False -> buttonFlip f
|
ButtonSwitch f _ _ _ False -> buttonFlip f
|
||||||
ButtonAccessTerminal -> accessTerminal . _btTermMID
|
ButtonAccessTerminal tid -> const $ accessTerminal tid
|
||||||
|
|
||||||
buttonFlip :: WdWd -> Button -> World -> World
|
buttonFlip :: WdWd -> Button -> World -> World
|
||||||
buttonFlip f bt =
|
buttonFlip f bt =
|
||||||
|
|||||||
@@ -25,14 +25,14 @@ data ButtonEvent
|
|||||||
, _bsColor2 :: Color
|
, _bsColor2 :: Color
|
||||||
, _btOn :: Bool
|
, _btOn :: Bool
|
||||||
}
|
}
|
||||||
| ButtonAccessTerminal
|
| ButtonAccessTerminal {_btTermID :: Int}
|
||||||
|
|
||||||
data Button = Button
|
data Button = Button
|
||||||
{ _btPos :: Point2
|
{ _btPos :: Point2
|
||||||
, _btRot :: Float
|
, _btRot :: Float
|
||||||
, _btEvent :: ButtonEvent
|
, _btEvent :: ButtonEvent
|
||||||
, _btID :: Int
|
, _btID :: Int
|
||||||
, _btTermMID :: Maybe Int
|
-- , _btTermMID :: Maybe Int
|
||||||
}
|
}
|
||||||
|
|
||||||
makeLenses ''Button
|
makeLenses ''Button
|
||||||
|
|||||||
@@ -22,7 +22,7 @@ data WdWd
|
|||||||
| SetTrigger Bool Int
|
| SetTrigger Bool Int
|
||||||
| WorldEffects [WdWd] -- probably best to avoid recursive types if possible...
|
| WorldEffects [WdWd] -- probably best to avoid recursive types if possible...
|
||||||
| SetLSCol Point3 Int
|
| SetLSCol Point3 Int
|
||||||
| AccessTerminal (Maybe Int)
|
| AccessTerminal Int
|
||||||
| UnlockInv
|
| UnlockInv
|
||||||
| SoundStart SoundOrigin Point2 SoundID (Maybe Int)
|
| SoundStart SoundOrigin Point2 SoundID (Maybe Int)
|
||||||
| MakeStartCloudAt Point3
|
| MakeStartCloudAt Point3
|
||||||
|
|||||||
@@ -53,7 +53,7 @@ defaultButton =
|
|||||||
, _btEvent = ButtonPress False NoWorldEffect (dark red)
|
, _btEvent = ButtonPress False NoWorldEffect (dark red)
|
||||||
, _btID = 0
|
, _btID = 0
|
||||||
-- , _btState = BtOff
|
-- , _btState = BtOff
|
||||||
, _btTermMID = Nothing
|
-- , _btTermMID = Nothing
|
||||||
-- , _btName = ""
|
-- , _btName = ""
|
||||||
-- , _btColor = red
|
-- , _btColor = red
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -137,6 +137,9 @@ updateCloseObjects w =
|
|||||||
activeButtons = filter canpress . IM.elems $ w ^. cWorld . lWorld . buttons
|
activeButtons = filter canpress . IM.elems $ w ^. cWorld . lWorld . buttons
|
||||||
canpress bt = case bt ^. btEvent of
|
canpress bt = case bt ^. btEvent of
|
||||||
ButtonPress {_btOn = t} -> not t
|
ButtonPress {_btOn = t} -> not t
|
||||||
|
ButtonAccessTerminal tid -> fromMaybe False $ do
|
||||||
|
x <- w ^? cWorld . lWorld . terminals . ix tid . tmStatus
|
||||||
|
return (x /= TerminalDeactivated)
|
||||||
_ -> True
|
_ -> True
|
||||||
|
|
||||||
changeSwapSel :: Int -> World -> World
|
changeSwapSel :: Int -> World -> World
|
||||||
|
|||||||
@@ -235,7 +235,7 @@ btText :: Button -> String
|
|||||||
btText bt = case _btEvent bt of
|
btText bt = case _btEvent bt of
|
||||||
ButtonPress {} -> "BUTTON"
|
ButtonPress {} -> "BUTTON"
|
||||||
ButtonSwitch {_btOn = t} -> if t then "SWITCH\\" else "SWITCH/"
|
ButtonSwitch {_btOn = t} -> if t then "SWITCH\\" else "SWITCH/"
|
||||||
ButtonAccessTerminal -> "TERMINAL"
|
ButtonAccessTerminal {} -> "TERMINAL"
|
||||||
|
|
||||||
closeItemToTextPictures :: FloorItem -> ([String], Color)
|
closeItemToTextPictures :: FloorItem -> ([String], Color)
|
||||||
closeItemToTextPictures flit = (basicItemDisplay it, itemInvColor $ baseCI it)
|
closeItemToTextPictures flit = (basicItemDisplay it, itemInvColor $ baseCI it)
|
||||||
|
|||||||
@@ -34,7 +34,7 @@ putTerminal col mc tm =
|
|||||||
& cWorld . lWorld . terminals . ix tmid . tmButtonID .~ btid
|
& cWorld . lWorld . terminals . ix tmid . tmButtonID .~ btid
|
||||||
& cWorld . lWorld . terminals . ix tmid . tmMachineID .~ mcid
|
& cWorld . lWorld . terminals . ix tmid . tmMachineID .~ mcid
|
||||||
& cWorld . lWorld . machines . ix mcid . mcMounts . at OTTerminal ?~ tmid
|
& cWorld . lWorld . machines . ix mcid . mcMounts . at OTTerminal ?~ tmid
|
||||||
& cWorld . lWorld . buttons . ix btid . btTermMID ?~ tmid
|
& cWorld . lWorld . buttons . ix btid . btEvent .~ ButtonAccessTerminal tmid
|
||||||
where
|
where
|
||||||
tmid = fromJust (_plMID tmpl)
|
tmid = fromJust (_plMID tmpl)
|
||||||
btid = fromJust (_plMID btpl)
|
btid = fromJust (_plMID btpl)
|
||||||
@@ -53,9 +53,8 @@ termButton =
|
|||||||
Button
|
Button
|
||||||
{ _btPos = 0
|
{ _btPos = 0
|
||||||
, _btRot = 0
|
, _btRot = 0
|
||||||
, _btEvent = ButtonAccessTerminal
|
, _btEvent = ButtonAccessTerminal 0
|
||||||
, _btID = 0
|
, _btID = 0
|
||||||
, _btTermMID = Nothing
|
|
||||||
}
|
}
|
||||||
|
|
||||||
terminalColor :: Color
|
terminalColor :: Color
|
||||||
|
|||||||
@@ -51,12 +51,11 @@ doWdWd we = case we of
|
|||||||
loc <- invIndents (cr ^. crInv) ^? ix invid . _2
|
loc <- invIndents (cr ^. crInv) ^? ix invid . _2
|
||||||
return $ heldEffectMuzzles loc cr w
|
return $ heldEffectMuzzles loc cr w
|
||||||
|
|
||||||
accessTerminal :: Maybe Int -> World -> World
|
accessTerminal :: Int -> World -> World
|
||||||
accessTerminal mtmid w = fromMaybe w $ do
|
accessTerminal tid w = fromMaybe w $ do -- should possibly check the terminal actually exists
|
||||||
tmid <- mtmid
|
|
||||||
return $
|
return $
|
||||||
w & hud . hudElement . subInventory .~ DisplayTerminal tmid
|
w & hud . hudElement . subInventory .~ DisplayTerminal tid
|
||||||
& cWorld . lWorld . terminals . ix tmid %~ tryToBoot
|
& cWorld . lWorld . terminals . ix tid %~ tryToBoot
|
||||||
where
|
where
|
||||||
tryToBoot tm = case _tmStatus tm of
|
tryToBoot tm = case _tmStatus tm of
|
||||||
TerminalTextInput{} -> tm
|
TerminalTextInput{} -> tm
|
||||||
|
|||||||
Reference in New Issue
Block a user