module Dodge.Terminal ( doTerminalCommandEffect, guardDisconnected, makeTermLine, commandFutureLines, quitCommand, helpCommand, commandsCommand, connectionBlurbLines, disconnectTerminal, basicTerminal, simpleTermMessage, damageCodeCommand, sensorCommand, makeColorTermLine, makeTermPara, toggleCommand, ) where import Color import Data.Char import Data.Foldable import qualified Data.Map.Strict as M import Data.Maybe --import qualified Data.Text as T import Dodge.Data.World import Dodge.Default import Dodge.SoundLogic import Justify import LensHelp import ListHelp (safeHead, safeUncons) import Sound.Data basicTerminal :: Terminal basicTerminal = defaultTerminal { _tmDisplayedLines = [] , _tmFutureLines = [] , _tmMaxLines = 14 , _tmTitle = "TERMINAL" , _tmInput = defaultTerminalInput , _tmScrollCommands = [quitCommand] , _tmWriteCommands = [helpCommand, commandsCommand] , _tmBootProgram = TerminalBootLines connectionBlurb , _tmDeathEffect = TmWdWdDoDeathTriggers } connectionBlurbLines :: [TerminalLine] -> [TerminalLine] connectionBlurbLines tls = [ termSoundLine computerBeepingS , TerminalLineDisplay 0 (TerminalLineConst "CONNECTING" termTextColor) , TerminalLineDisplay 10 (TerminalLineConst "..." termTextColor) , TerminalLineDisplay 10 (TerminalLineConst "CONNECTED" termTextColor) ] ++ tls ++ [TerminalLineTerminalEffect 0 (TmTmSetStatus TerminalReady)] quitCommand :: TerminalCommand quitCommand = TerminalCommand { _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." , _tcEffect = TerminalCommandEffectHelp -- \tm -> OneArgument "AN AVAILABLE COMMAND" . getCommandsHelp tm } getCommandsHelp :: Terminal -> World -> M.Map String [TerminalLine] getCommandsHelp tm w = foldr f mempty $ getCommands tm where f tc = M.insert (_tcString tc) ( [ makeTermLine "COMMAND:" , makeColorTermLine commandColor (_tcString tc) , makeTermLine "ALIASES:" , makeColorTermLine commandColor (unwords (_tcAlias tc)) ] ++ case argumentHelp tc tm w of (arghelp, Nothing) -> makeTermPara $ _tcHelp tc ++ " " ++ arghelp (arghelp, Just args) -> makeTermPara (_tcHelp tc ++ " " ++ arghelp) ++ [makeColorTermLine commandColor $ unwords args] ) commandsCommand :: TerminalCommand commandsCommand = TerminalCommand { _tcString = "COMMANDS" , _tcAlias = ["COMMAND", "COM"] , _tcHelp = "DISPLAYS AVAILABLE COMMANDS." , _tcEffect = TerminalCommandEffectCommands } connectionBlurb :: [TerminalLine] connectionBlurb = [ termSoundLine computerBeepingS , TerminalLineDisplay 0 (TerminalLineConst "CONNECTING" termTextColor) , TerminalLineDisplay 10 (TerminalLineConst "..." termTextColor) , TerminalLineDisplay 10 (TerminalLineConst "CONNECTED" termTextColor) , TerminalLineTerminalEffect 0 (TmTmSetStatus TerminalReady) ] termSoundLine :: SoundID -> TerminalLine termSoundLine sid = TerminalLineEffect 0 (TmWdWdTermSound sid) -- where -- termsound tm w = soundStart TerminalSound tpos sid Nothing w -- where -- tpos = fromMaybe 0 $ w ^? buttons . ix (_tmButtonID tm) . btPos termTextColor :: Color termTextColor = greyN 0.9 getCommands :: Terminal -> [TerminalCommand] getCommands tm = _tmScrollCommands tm ++ _tmWriteCommands tm makeTermLine :: String -> TerminalLine makeTermLine = makeColorTermLine termTextColor makeTermPara :: String -> [TerminalLine] makeTermPara = map makeTermLine . makeParagraph 60 makeColorTermPara :: Color -> String -> [TerminalLine] makeColorTermPara col = map (makeColorTermLine col) . makeParagraph 60 makeColorTermLine :: Color -> String -> TerminalLine 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 . _cwgParams . _cwGen . _cWorld 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 ^? cWorld . lWorld . machines . ix (_tmMachineID tm) . mcType . _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 & 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 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 = -- cWorld . lWorld . 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 commandFutureLines :: String -> Terminal -> World -> [TerminalLine] 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 -> Just $ fromMaybe [errline $ "^ INVALID ARGUMENT: EXPECTS " ++ argtype] $ safeHead args >>= (m M.!?) where errline = makeColorTermLine red