This commit is contained in:
2022-06-02 10:31:22 +01:00
parent e112006b46
commit c4fc044845
7 changed files with 37 additions and 37 deletions
+7 -2
View File
@@ -382,6 +382,7 @@ data Button = Button
, _btText :: String
, _btState :: ButtonState
, _btTerminalParams :: World -> TerminalParams
, _btName :: String
}
data TerminalParams = NoTerminalParams | TerminalParams
{ _termDisplayedLines :: [World -> (String,Color)]
@@ -912,8 +913,11 @@ data Block = Block
}
data BlockMaterial = WoodBlock | DirtBlock | StoneBlock | GlassBlock | MetalBlock
data Terminal = Terminal
{ _tmID :: Int
, _tmParams :: TerminalParams
{ _tmID :: Int
, _tmParams :: TerminalParams
, _tmButtonID :: Int
, _tmMachineID :: Int
, _tmName :: String
}
data Machine = Machine
{ _mcID :: Int
@@ -927,6 +931,7 @@ data Machine = Machine
, _mcDamage :: [Damage]
, _mcLSs :: [Int]
, _mcType :: MachineType
, _mcName :: String
}
data Sensor = NoSensor
| SensorToggleAmount
+3
View File
@@ -217,6 +217,7 @@ defaultMachine = Machine
, _mcDamage = []
, _mcLSs = []
, _mcType = StaticMachine
, _mcName = ""
}
defaultMachineUpdate :: Machine -> World -> World
defaultMachineUpdate mc
@@ -248,6 +249,7 @@ defaultButton = Button
, _btText = "Button"
, _btState = BtOff
, _btTerminalParams = const NoTerminalParams
, _btName = ""
}
defaultPT :: Prop
defaultPT = Projectile
@@ -300,3 +302,4 @@ defaultTLS = TLS
upHammer :: HammerType
upHammer = HasHammer HammerUp
+4 -2
View File
@@ -25,8 +25,10 @@ import SDL
--import Data.Text (unpack)
import qualified Data.Text as T
-- annoyingly, the text input event doesn't register backspace, so this has to be
-- dealt with elsewhere
-- annoyingly, the text input event doesn't register backspace, so deletion has to be
-- dealt with using key presses (handlePressedKey)
-- also, note that this currently "doubles" the inputs to both terminals if both
-- are open
handleTextInput :: T.Text -> Universe -> IO (Maybe Universe)
handleTextInput text = return . Just . (menuLayers . ix 0 . scInput %~ updateText)
. (uvWorld . hud . hudElement . subInventory . termParams . termInput . _Just %~ updateText)
+3 -12
View File
@@ -18,14 +18,11 @@ makeButton
:: Color
-> (World -> World) -- ^ Effect when pressed
-> Button
makeButton col eff = Button
makeButton col eff = defaultButton
{ _btPict = defaultDrawButton col
, _btPos = V2 0 0
, _btRot = 0
, _btEvent = \b w -> eff
. over buttons (IM.adjust turnOn (_btID b))
. soundFromGeneral (LeverSound 0) (btpos b) click1S Nothing $ w
, _btID = 0
, _btText = "Button"
, _btState = BtOff
, _btTerminalParams = const NoTerminalParams
@@ -61,12 +58,9 @@ makeSwitchSPic
-> (World -> World) -- ^ Switch on effect
-> (World -> World) -- ^ Switch off effect
-> Button
makeSwitchSPic dswitch effOn effOff = Button
makeSwitchSPic dswitch effOn effOff = defaultButton
{ _btPict = dswitch
, _btPos = V2 0 0
, _btRot = 0
, _btEvent = flipSwitch
, _btID = 0
, _btText = "SWITCH/"
, _btState = BtOff
, _btTerminalParams = const NoTerminalParams
@@ -96,12 +90,9 @@ makeSwitch
-> (World -> World) -- ^ Switch on effect
-> (World -> World) -- ^ Switch off effect
-> Button
makeSwitch col1 col2 effOn effOff = Button
makeSwitch col1 col2 effOn effOff = defaultButton
{ _btPict = drawSwitch col1 col2
, _btPos = V2 0 0
, _btRot = 0
, _btEvent = flipSwitch
, _btID = 0
, _btText = "SWITCH/"
, _btState = BtOff
, _btTerminalParams = const NoTerminalParams
+10 -9
View File
@@ -51,15 +51,16 @@ putTerminal f = plGenUpdate ?~ g $ ps0PushPS (PutButton termButton)
)
termButton :: Button
termButton = Button
{ _btPict = const mempty
, _btPos = 0
, _btRot = 0
, _btEvent = displayTerminalMessage . _btID
, _btID = 0
, _btText = "TERMINAL"
, _btState = BtOff
, _btTerminalParams = const $ TerminalParams [] [] 10 "TERMINAL" Nothing Nothing [] []
}
{ _btPict = const mempty
, _btPos = 0
, _btRot = 0
, _btEvent = displayTerminalMessage . _btID
, _btID = 0
, _btText = "TERMINAL"
, _btState = BtOff
, _btTerminalParams = const $ TerminalParams [] [] 10 "TERMINAL" Nothing Nothing [] []
, _btName = ""
}
terminalColor :: Color
+5 -7
View File
@@ -69,12 +69,10 @@ addWarningTerminal outplid = (rmName .++~ "warningTerm-")
else Just (ltpos, rpdir)
_ -> Nothing
termMessages trid = ops trid (genTermMessage $ const ["OPEN DOOR?"])
-- <&> termFutureLines %~ (++ [TerminalLineChoice 0 (ops trid)])
ops trid f gw w = f gw w & termFutureLines %~
(++ [ TerminalLineInput 0 [unlockCommand trid] [quitCommand,helpCommand,infoCommand theinfo,commandsCommand]])
ops trid f gw w = f gw w & termFutureLines ++.~ [ TerminalLineInput 0
[unlockCommand trid,quitCommand]
[helpCommand,infoCommand theinfo,commandsCommand]
]
unlockCommand trid = singleCommand "OPEN" ["YES","Y"] "OPEN THE CONNECTED DOOR." (toggledoor trid)
-- (++ [ TerminalLineChoice 0 [ ("TOGGLE", toggledoor trid)
-- , ("EXIT", id)
-- ]])
toggledoor trid w' = w' & triggers . ix (fromJust $ _plMID trid) .~ const True
theinfo = "DOOR CONTROLABLE BY ENTERING \"OPEN\". THIS TERMINAL CANNOT CLOSE THE DOOR."
theinfo = "DOOR CONTROLABLE WITH THE \"OPEN\" COMMAND. THIS TERMINAL CANNOT CLOSE THE DOOR."
+5 -5
View File
@@ -41,7 +41,7 @@ helpf (str:_) w = maybe (Left "") Right $ do
return $ w & infoClearInput
([makeTermLine ("COMMAND:" ++ _tcString command)
,makeTermLine ("ALIASES:" ++ unwords (_tcAlias command)) ]
++ stringToTermPara (_tcHelp command ++ " " ++ argumentHelp (_tcArgumentType command))
++ makeTermPara (_tcHelp command ++ " " ++ argumentHelp (_tcArgumentType command))
)
getCommands :: World -> Maybe [TerminalCommand]
getCommands w = do
@@ -61,8 +61,8 @@ argumentHelp mstr = case mstr of
Nothing -> "ANY ARGUMENTS PROVIDED TO THIS COMMAND ARE IGNORED."
Just str -> "EXPECTS " ++ str ++ " AS ARGUMENT."
stringToTermPara :: String -> [TerminalLine]
stringToTermPara = map makeTermLine . makeParagraph 60
makeTermPara :: String -> [TerminalLine]
makeTermPara = map makeTermLine . makeParagraph 60
makeColorTermLine :: Color -> String -> TerminalLine
makeColorTermLine col str = TerminalLineDisplay 0 $ const (str,col)
@@ -79,7 +79,7 @@ infoCommand str = TerminalCommand
, _tcArgumentType = Nothing
, _tcArguments = const []
, _tcEffect = const $ \w -> Right $ w & infoClearInput
( stringToTermPara str)
( makeTermPara str)
}
commandsCommand :: TerminalCommand
@@ -91,7 +91,7 @@ commandsCommand = TerminalCommand
, _tcArguments = const []
, _tcEffect = const $ \w -> Right $ w & infoClearInput
( makeTermLine "AVAILABLE COMMANDS:"
: stringToTermPara (unwords (maybe [""] (map _tcString) $ getCommands w))
: makeTermPara (unwords (maybe [""] (map _tcString) $ getCommands w))
)
}