diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index c409af121..dc71e56fe 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -4,6 +4,7 @@ module Dodge.Event.Keyboard , handleTextInput , guardDisconnectedID ) where +import Dodge.Event.Keyboard import Dodge.WorldPos import Dodge.Button.Event import Dodge.Terminal diff --git a/src/Dodge/Room/LongDoor.hs b/src/Dodge/Room/LongDoor.hs index c202a4e5f..5ab865375 100644 --- a/src/Dodge/Room/LongDoor.hs +++ b/src/Dodge/Room/LongDoor.hs @@ -2,6 +2,7 @@ {- | Rooms containing long doors, probably with a big reveal behind them. -} module Dodge.Room.LongDoor where +import Dodge.Terminal import Dodge.Data import Dodge.Default.Door import Dodge.Cleat diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index 468eb15d9..3194c6856 100644 --- a/src/Dodge/Terminal.hs +++ b/src/Dodge/Terminal.hs @@ -121,3 +121,112 @@ makeColorTermLine col str = TerminalLineDisplay 0 $ TerminalLineConst str col commandColor :: Color commandColor = yellow + +doTerminalCommandEffect :: TerminalCommandEffect -> Terminal -> World -> EffectArguments +doTerminalCommandEffect tce = case tce of + TerminalCommandArguments eas -> \_ _ -> eas + TerminalCommandEffectDamageCoding -> \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding + TerminalCommandEffectSensorParameter -> \tm -> OneArgument "A SENSOR PARAMETER" . sensorInfoMap tm + TerminalCommandEffectLinkedObject -> \tm _ -> OneArgument "A LINKED OBJECT" (togglesToEffects tm) + TerminalCommandEffectHelp -> \tm -> OneArgument "AN AVAILABLE COMMAND" . getCommandsHelp tm + TerminalCommandEffectNoArgumentsStr str -> \_ _ -> NoArguments (makeTermPara str) + TerminalCommandEffectCommands -> \tm _ -> NoArguments + ( makeTermLine "AVAILABLE COMMANDS:" + : makeColorTermPara commandColor (unwords (map _tcString $ getCommands tm)) + ) + TerminalCommandEffectSingleCommand eff followingLines -> \_ _ -> NoArguments $ TerminalLineEffect 0 (TmWdWdfromWdWd eff) : map makeTermLine followingLines + TerminalCommandEffectNone -> \_ _ -> NoArguments [] + +argumentHelp :: TerminalCommand -> Terminal -> World -> (String,Maybe [String]) +argumentHelp tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of + NoArguments {} -> ("ANY ARGUMENTS PROVIDED TO THIS COMMAND ARE IGNORED.",Nothing) + OneArgument argtype argm -> ("EXPECTS " ++ argtype ++ " AS ARGUMENT. AVAILABLE ARGUMENTS: " + , Just (M.keys argm) ) + + +infoCommand :: String -> TerminalCommand +infoCommand str = TerminalCommand + { _tcString = "INFORMATION" + , _tcAlias = ["INFO","I"] + , _tcHelp = "DISPLAYS INFORMATION CONCERNING THE TERMINAL." + , _tcEffect = TerminalCommandEffectNoArgumentsStr str -- \_ _ -> NoArguments (makeTermPara str) + } + +singleCommand :: [String] -> String -> [String] -> String -> WdWd -> TerminalCommand +singleCommand followingLines command aliases htext eff = TerminalCommand + {_tcString = command + ,_tcAlias = aliases + ,_tcHelp = htext + ,_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 . _genParams + +sensorInfoMap :: Terminal -> World -> M.Map String [TerminalLine] +sensorInfoMap tm w = M.fromList + [("REQUIREMENT", getSensor _proxRequirement tm w) + ,("DISTANCE", getSensor _proxDist tm w) + ,("CURRENTSTATUS", getSensor _proxStatus tm w) + ,("PASTSTATUS", getSensor _sensToggle tm w) + ] +getSensor :: Show a => (Sensor -> a) -> Terminal -> World -> [TerminalLine] +getSensor f tm w = maybe [] (makeTermPara . map toUpper . show . f) + (w ^? machines . ix (_tmMachineID tm) . mcSensor) + +toggleCommand :: TerminalCommand +toggleCommand = TerminalCommand + { _tcString = "TOGGLE" + , _tcAlias = ["TOG"] + , _tcHelp = "PERFORMS A REVERSABLE EFFECT." + , _tcEffect = TerminalCommandEffectLinkedObject -- \tm _ -> OneArgument "A LINKED OBJECT" (togglesToEffects tm) + } +decodedtmap :: M.Map DamageType (PaletteColor,DecorationShape) -> M.Map String [TerminalLine] +decodedtmap = M.mapKeys show . M.map ((:[]) . makeTermLine . show) + +sensorCommand :: TerminalCommand +sensorCommand = TerminalCommand + { _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 + & terminals . ix (_tmID tm) . tmStatus .~ TerminalOff + & exitTerminalSubInv + & terminals . ix (_tmID tm) . tmFutureLines .~ + [ TerminalLineTerminalEffect 0 TmTmClearDisplayedLines ] + +exitTerminalSubInv :: World -> World +exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of + Just _ -> w & hud . hudElement . subInventory .~ NoSubInventory + _ -> w + +damageCodeCommand :: TerminalCommand +damageCodeCommand = TerminalCommand + { _tcString = "DAMAGECODE" + , _tcAlias = ["DCODE","DC"] + , _tcHelp = "DISPLAYS THE SHAPE AND COLOR ASSOCIATED WITH A GIVEN DAMAGE TYPE." + , _tcEffect = TerminalCommandEffectDamageCoding -- \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding + } + + +infoClearInput :: Terminal -> [TerminalLine] -> World -> World +infoClearInput tm tls = terminals . ix (_tmID tm) %~ + ( (tmInput .~ TerminalInput T.empty True (0,0)) + . (tmFutureLines ++.~ tls) + ) + +togglesToEffects :: Terminal -> M.Map String [TerminalLine] +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 diff --git a/src/Dodge/Update/UsingInput.hs b/src/Dodge/Update/UsingInput.hs index fe3639f4d..6d62a861d 100644 --- a/src/Dodge/Update/UsingInput.hs +++ b/src/Dodge/Update/UsingInput.hs @@ -2,6 +2,7 @@ module Dodge.Update.UsingInput ( updateUsingInput ) where +import Dodge.WorldEffect import Dodge.Data import Dodge.Base.You import Dodge.Creature.Impulse.UseItem diff --git a/src/Dodge/WorldEffect.hs b/src/Dodge/WorldEffect.hs index 97d6fc0dd..2eedd58a4 100644 --- a/src/Dodge/WorldEffect.hs +++ b/src/Dodge/WorldEffect.hs @@ -61,96 +61,8 @@ torqueCr x cid w where (rot, g) = randomR (-x,x) $ _randGen w -disconnectTerminal :: Terminal -> World -> World -disconnectTerminal tm w = w - & terminals . ix (_tmID tm) . tmStatus .~ TerminalOff - & exitTerminalSubInv - & terminals . ix (_tmID tm) . tmFutureLines .~ - [ TerminalLineTerminalEffect 0 TmTmClearDisplayedLines ] -exitTerminalSubInv :: World -> World -exitTerminalSubInv w = case w ^? hud . hudElement . subInventory . termID of - Just _ -> w & hud . hudElement . subInventory .~ NoSubInventory - _ -> w - -damageCodeCommand :: TerminalCommand -damageCodeCommand = TerminalCommand - { _tcString = "DAMAGECODE" - , _tcAlias = ["DCODE","DC"] - , _tcHelp = "DISPLAYS THE SHAPE AND COLOR ASSOCIATED WITH A GIVEN DAMAGE TYPE." - , _tcEffect = TerminalCommandEffectDamageCoding -- \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding - } -getDamageCoding :: World -> M.Map String [TerminalLine] -getDamageCoding = decodedtmap . _sensorCoding . _genParams - -decodedtmap :: M.Map DamageType (PaletteColor,DecorationShape) -> M.Map String [TerminalLine] -decodedtmap = M.mapKeys show . M.map ((:[]) . makeTermLine . show) - -sensorCommand :: TerminalCommand -sensorCommand = TerminalCommand - { _tcString = "SENSOR" - , _tcAlias = ["SEN"] - , _tcHelp = "ACCESS INFORMATION CONCERNING THE CONNECTED SENSOR." - , _tcEffect = TerminalCommandEffectSensorParameter -- \tm -> OneArgument "A SENSOR PARAMETER" . sensorInfoMap tm - } -sensorInfoMap :: Terminal -> World -> M.Map String [TerminalLine] -sensorInfoMap tm w = M.fromList - [("REQUIREMENT", getSensor _proxRequirement tm w) - ,("DISTANCE", getSensor _proxDist tm w) - ,("CURRENTSTATUS", getSensor _proxStatus tm w) - ,("PASTSTATUS", getSensor _sensToggle tm w) - ] -getSensor :: Show a => (Sensor -> a) -> Terminal -> World -> [TerminalLine] -getSensor f tm w = maybe [] (makeTermPara . map toUpper . show . f) - (w ^? machines . ix (_tmMachineID tm) . mcSensor) - -toggleCommand :: TerminalCommand -toggleCommand = TerminalCommand - { _tcString = "TOGGLE" - , _tcAlias = ["TOG"] - , _tcHelp = "PERFORMS A REVERSABLE EFFECT." - , _tcEffect = TerminalCommandEffectLinkedObject -- \tm _ -> OneArgument "A LINKED OBJECT" (togglesToEffects tm) - } -togglesToEffects :: Terminal -> M.Map String [TerminalLine] -togglesToEffects = fmap f . _tmToggles - where - f tt = [TerminalLineEffect 0 $ TmWdWdfromWdWd $ WdWdNegateTrig (_ttTriggerID tt)] - -- \_ -> triggers . ix (_ttTriggerID tt) %~ not] - -infoClearInput :: Terminal -> [TerminalLine] -> World -> World -infoClearInput tm tls = terminals . ix (_tmID tm) %~ - ( (tmInput .~ TerminalInput T.empty True (0,0)) - . (tmFutureLines ++.~ tls) - ) - -argumentHelp :: TerminalCommand -> Terminal -> World -> (String,Maybe [String]) -argumentHelp tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of - NoArguments {} -> ("ANY ARGUMENTS PROVIDED TO THIS COMMAND ARE IGNORED.",Nothing) - OneArgument argtype argm -> ("EXPECTS " ++ argtype ++ " AS ARGUMENT. AVAILABLE ARGUMENTS: " - , Just (M.keys argm) ) - - -infoCommand :: String -> TerminalCommand -infoCommand str = TerminalCommand - { _tcString = "INFORMATION" - , _tcAlias = ["INFO","I"] - , _tcHelp = "DISPLAYS INFORMATION CONCERNING THE TERMINAL." - , _tcEffect = TerminalCommandEffectNoArgumentsStr str -- \_ _ -> NoArguments (makeTermPara str) - } - -singleCommand :: [String] -> String -> [String] -> String -> WdWd -> TerminalCommand -singleCommand followingLines command aliases htext eff = TerminalCommand - {_tcString = command - ,_tcAlias = aliases - ,_tcHelp = htext - ,_tcEffect = TerminalCommandEffectSingleCommand eff followingLines } - -guardDisconnected :: Terminal -> World -> World -> World -guardDisconnected tm w w' = case _tmStatus tm of - TerminalOff -> w - TerminalBusy -> w - TerminalReady -> w' doTerminalEffectLB :: Terminal -> World -> World doTerminalEffectLB tm w = guardDisconnected tm w $ fromMaybe w $ do @@ -234,20 +146,6 @@ doTerminalBootProgram tbp = case tbp of TerminalBootLines ls -> \_ _ -> ls -doTerminalCommandEffect :: TerminalCommandEffect -> Terminal -> World -> EffectArguments -doTerminalCommandEffect tce = case tce of - TerminalCommandArguments eas -> \_ _ -> eas - TerminalCommandEffectDamageCoding -> \_ -> OneArgument "A DAMAGE TYPE" . getDamageCoding - TerminalCommandEffectSensorParameter -> \tm -> OneArgument "A SENSOR PARAMETER" . sensorInfoMap tm - TerminalCommandEffectLinkedObject -> \tm _ -> OneArgument "A LINKED OBJECT" (togglesToEffects tm) - TerminalCommandEffectHelp -> \tm -> OneArgument "AN AVAILABLE COMMAND" . getCommandsHelp tm - TerminalCommandEffectNoArgumentsStr str -> \_ _ -> NoArguments (makeTermPara str) - TerminalCommandEffectCommands -> \tm _ -> NoArguments - ( makeTermLine "AVAILABLE COMMANDS:" - : makeColorTermPara commandColor (unwords (map _tcString $ getCommands tm)) - ) - TerminalCommandEffectSingleCommand eff followingLines -> \_ _ -> NoArguments $ TerminalLineEffect 0 (TmWdWdfromWdWd eff) : map makeTermLine followingLines - TerminalCommandEffectNone -> \_ _ -> NoArguments [] doTmWdWd :: TmWdWd -> Terminal -> World -> World doTmWdWd tmwdwd = case tmwdwd of @@ -258,5 +156,3 @@ doTmWdWd tmwdwd = case tmwdwd of TmWdWdDoDeathTriggers -> doDeathTriggers --TmWdWdfromWdWd f -> \_ -> doWorldEffect f -simpleTermMessage :: [String] -> Terminal -simpleTermMessage strs = defaultTerminal & tmFutureLines .~ map makeTermLine strs