justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Work on terminals

Browse Source
This commit is contained in:
justin
2023-05-03 11:19:47 +01:00
parent 61f88aeb4a
commit ed8d8f0e93
8 changed files with 79 additions and 107 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Terminal.hs
+39 -46
View File
@@ -1,6 +1,5 @@
module Dodge.Terminal (
doTerminalCommandEffect,
guardDisconnected,
makeTermLine,
commandFutureLines,
quitCommand,
@@ -46,9 +45,9 @@ basicTerminal =
connectionBlurbLines :: [TerminalLine] -> [TerminalLine]
connectionBlurbLines tls =
[ termSoundLine computerBeepingS
, TerminalLineDisplay 0 (TerminalLineConst "CONNECTING" termTextColor)
, TerminalLineDisplay 0 (TerminalLineConst "Connecting" termTextColor)
, TerminalLineDisplay 10 (TerminalLineConst "..." termTextColor)
, TerminalLineDisplay 10 (TerminalLineConst "CONNECTED" termTextColor)
, TerminalLineDisplay 10 (TerminalLineConst "Connected" termTextColor)
]
++ tls
++ [TerminalLineTerminalEffect 0 (TmTmSetStatus TerminalReady)]
@@ -56,18 +55,18 @@ connectionBlurbLines tls =
quitCommand :: TerminalCommand
quitCommand =
TerminalCommand
{ _tcString = "QUIT"
, _tcAlias = ["Q", "EXIT", "X", "SHUTDOWN", ""]
, _tcHelp = "DISCONNECTS THE TERMINAL."
{ _tcString = "quit"
, _tcAlias = ["q", "exit", "x", "shutdown", ""]
, _tcHelp = "Disconnects the terminal."
, _tcEffect = TerminalCommandArguments $ NoArguments [TerminalLineEffect 0 TmWdWdDisconnectTerminal]
}
helpCommand :: TerminalCommand
helpCommand =
TerminalCommand
{ _tcString = "HELP"
, _tcAlias = ["H", "MAN"]
, _tcHelp = "DISPLAYS HELP FOR A SPECIFIC COMMAND."
{ _tcString = "help"
, _tcAlias = ["h", "man"]
, _tcHelp = "Displays help for a specific command."
, _tcEffect = TerminalCommandEffectHelp -- \tm -> OneArgument "AN AVAILABLE COMMAND" . getCommandsHelp tm
}
@@ -77,9 +76,9 @@ getCommandsHelp tm w = foldr f mempty $ getCommands tm
f tc =
M.insert
(_tcString tc)
( [ makeTermLine "COMMAND:"
( [ makeTermLine "Command:"
, makeColorTermLine commandColor (_tcString tc)
, makeTermLine "ALIASES:"
, makeTermLine "Aliases:"
, makeColorTermLine commandColor (unwords (_tcAlias tc))
]
++ case argumentHelp tc tm w of
@@ -92,18 +91,18 @@ getCommandsHelp tm w = foldr f mempty $ getCommands tm
commandsCommand :: TerminalCommand
commandsCommand =
TerminalCommand
{ _tcString = "COMMANDS"
, _tcAlias = ["COMMAND", "COM"]
, _tcHelp = "DISPLAYS AVAILABLE COMMANDS."
{ _tcString = "commands"
, _tcAlias = ["command", "com"]
, _tcHelp = "Displays available commands."
, _tcEffect = TerminalCommandEffectCommands
}
connectionBlurb :: [TerminalLine]
connectionBlurb =
[ termSoundLine computerBeepingS
, TerminalLineDisplay 0 (TerminalLineConst "CONNECTING" termTextColor)
, TerminalLineDisplay 0 (TerminalLineConst "Connecting" termTextColor)
, TerminalLineDisplay 10 (TerminalLineConst "..." termTextColor)
, TerminalLineDisplay 10 (TerminalLineConst "CONNECTED" termTextColor)
, TerminalLineDisplay 10 (TerminalLineConst "Connected" termTextColor)
, TerminalLineTerminalEffect 0 (TmTmSetStatus TerminalReady)
]
@@ -173,12 +172,6 @@ argumentHelp tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of
-- , _tcEffect = TerminalCommandEffectSingleCommand eff followingLines
-- }
guardDisconnected :: Terminal -> World -> World -> World
guardDisconnected tm w w' = case _tmStatus tm of
TerminalOff -> w
TerminalBusy -> w
TerminalReady -> w'
getDamageCoding :: World -> M.Map String [TerminalLine]
getDamageCoding = decodedtmap . _sensorCoding . _cwgParams . _cwGen . _cWorld
@@ -195,15 +188,15 @@ getSensor :: Show a => (Sensor -> a) -> Terminal -> World -> [TerminalLine]
getSensor f tm w =
maybe
[]
(makeTermPara . map toUpper . show . f)
(makeTermPara . map toLower . show . f)
(w ^? cWorld . lWorld . machines . ix (_tmMachineID tm) . mcType . _McSensor)
toggleCommand :: TerminalCommand
toggleCommand =
TerminalCommand
{ _tcString = "TOGGLE"
, _tcAlias = ["TOG"]
, _tcHelp = "PERFORMS A REVERSABLE EFFECT."
{ _tcString = "toggle"
, _tcAlias = ["tog"]
, _tcHelp = "Performs a reversable effect."
, _tcEffect = TerminalCommandEffectLinkedObject -- \tm _ -> OneArgument "A LINKED OBJECT" (togglesToEffects tm)
}
@@ -213,19 +206,19 @@ decodedtmap = M.mapKeys show . M.map ((: []) . makeTermLine . show)
sensorCommand :: TerminalCommand
sensorCommand =
TerminalCommand
{ _tcString = "SENSOR"
, _tcAlias = ["SEN"]
, _tcHelp = "ACCESS INFORMATION CONCERNING THE CONNECTED SENSOR."
{ _tcString = "sensor"
, _tcAlias = ["sen"]
, _tcHelp = "Access information concerning the connected sensor."
, _tcEffect = TerminalCommandEffectSensorParameter -- \tm -> OneArgument "A SENSOR PARAMETER" . sensorInfoMap tm
}
disconnectTerminal :: Terminal -> World -> World
disconnectTerminal tm w =
w
& cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff
& exitTerminalSubInv
& cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines
.~ [TerminalLineTerminalEffect 0 TmTmClearDisplayedLines]
disconnectTerminal tm =
(cWorld . lWorld . terminals . ix (_tmID tm) . tmStatus .~ TerminalOff)
. exitTerminalSubInv
. ( cWorld . lWorld . terminals . ix (_tmID tm) . tmFutureLines
.~ [TerminalLineTerminalEffect 0 TmTmClearDisplayedLines]
)
exitTerminalSubInv :: World -> World
exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
@@ -235,9 +228,9 @@ exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of
damageCodeCommand :: TerminalCommand
damageCodeCommand =
TerminalCommand
{ _tcString = "DAMAGECODE"
, _tcAlias = ["DCODE", "DC"]
, _tcHelp = "DISPLAYS THE SHAPE AND COLOR ASSOCIATED WITH A GIVEN DAMAGE TYPE."
{ _tcString = "damagecode"
, _tcAlias = ["dcode", "dc"]
, _tcHelp = "Displays the shape and color associated with a given damage type."
, _tcEffect = TerminalCommandEffectDamageCoding -- \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding
}
@@ -253,21 +246,21 @@ togglesToEffects = fmap f . _tmToggles
where
f tt = [TerminalLineEffect 0 $ TmWdWdfromWdWd $ WdWdNegateTrig (_ttTriggerID tt)]
-- \_ -> triggers . ix (_ttTriggerID tt) %~ not]
simpleTermMessage :: [String] -> Terminal
simpleTermMessage strs = defaultTerminal & tmFutureLines .~ map makeTermLine strs
commandFutureLines :: String -> Terminal -> World -> [TerminalLine]
commandFutureLines s tm w = fromMaybe [errline "^ INVALID COMMAND"] $ do
commandFutureLines s tm w = fromMaybe [errline "^ Invalid command"] $ do
(str, args) <- safeUncons $ words s
command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) (getCommands tm)
case doTerminalCommandEffect (_tcEffect command) tm w of
NoArguments tls -> Just tls
OneArgument argtype m ->
let setpartial = TerminalLineTerminalEffect 0 (TmTmSetPartialCommand (Just str))
: makeTermPara ("expects " ++ argtype ++ " as an argument")
in Just $
fromMaybe setpartial $
safeHead args >>= (m M.!?)
OneArgument argtype m ->
let setpartial =
TerminalLineTerminalEffect 0 (TmTmSetPartialCommand (Just str)) :
makeTermPara ("expects " ++ argtype ++ " as an argument")
in Just $
fromMaybe setpartial $
safeHead args >>= (m M.!?)
where
errline = makeColorTermLine red