module Dodge.Terminal where import Dodge.Data import Dodge.Default import Dodge.Base import Dodge.SoundLogic import Color import Justify import LensHelp import Sound.Data import Data.Char import Data.Maybe import qualified Data.Map as M import qualified Data.Text as T import Text.Read import Data.List (find) quitCommand :: TerminalCommand quitCommand = TerminalCommand { _tcString = "QUIT" , _tcAlias = ["Q","EXIT","X","SHUTDOWN",""] , _tcHelp = "DISCONNECTS THE TERMINAL." , _tcArgumentType = Nothing , _tcArguments = const (const []) , _tcEffect = const $ \tm w -> Right $ w & disconnectTerminal tm } disconnectTerminal :: Terminal -> World -> World disconnectTerminal tm w = w & terminals . ix (_tmID tm) . tmStatus .~ Disconnected & exitTerminalSubInv & terminals . ix (_tmID tm) . tmFutureLines .~ [ TerminalLineTerminalEffect 0 (tmDisplayedLines .~ []) ] 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." , _tcArgumentType = Just "A DAMAGE TYPE" , _tcArguments = \_ -> map (map toUpper . show) . M.keys . _sensorCoding . _genParams , _tcEffect = f } where f args tm w = fromMaybe (Left "") $ do dtype <- safeHead args >>= readMaybe dinfo <- _sensorCoding (_genParams w) M.!? dtype return $ Right $ w & infoClearInput tm [makeTermLine $ show (fst dinfo) ++ " " ++ show (snd dinfo)] sensorCommand :: TerminalCommand sensorCommand = TerminalCommand { _tcString = "SENSOR" , _tcAlias = ["SEN"] , _tcHelp = "ACCESS THE CONNECTED SENSOR" , _tcArgumentType = Just "A SENSOR PARAMETER" , _tcArguments = \tm w -> ["BOOL","VALUE"] , _tcEffect = effectArgMessage sensf } effectArgMessage :: (String -> Terminal -> World -> Maybe [String]) -> [String] -> Terminal -> World -> Either String World effectArgMessage f args tm w = maybe (Left "") Right $ do arg <- safeHead args strs <- f arg tm w return $ w & terminals . ix (_tmID tm) . tmFutureLines ++.~ map makeTermLine strs sensf :: String -> Terminal -> World -> Maybe [String] sensf arg tm w = case arg of "BOOL" -> Just [show $ w ^? machines . ix (_tmMachineID tm) . mcSensor . sensToggle] _ -> Nothing helpCommand :: TerminalCommand helpCommand = TerminalCommand { _tcString = "HELP" , _tcAlias = ["H","MAN"] , _tcHelp = "DISPLAYS HELP FOR A SPECIFIC COMMAND. TO DISPLAY AVAILABLE COMMANDS USE \"COMMANDS\"." , _tcArgumentType = Just "AN AVAILABLE COMMAND" , _tcArguments = \tm w -> fromMaybe [] $ do commands <- getCommands tm w return $ map _tcString commands , _tcEffect = helpf } helpf :: [String] -> Terminal -> World -> Either String World helpf [] tm w = helpf ["HELP"] tm w helpf (str:_) tm w = maybe (Left "") Right $ do commands <- getCommands tm w command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) commands return $ w & infoClearInput tm ([makeTermLine ("COMMAND:" ++ _tcString command) ,makeTermLine ("ALIASES:" ++ unwords (_tcAlias command)) ] ++ makeTermPara (_tcHelp command ++ " " ++ argumentHelp (_tcArgumentType command)) ) getCommands :: Terminal -> World -> Maybe [TerminalCommand] getCommands tm w = do commands1 <- w ^? terminals . ix (_tmID tm) . tmScrollCommands commands2 <- w ^? terminals . ix (_tmID tm) . tmWriteCommands return $ commands1 ++ commands2 infoClearInput :: Terminal -> [TerminalLine] -> World -> World infoClearInput tm tls = terminals . ix (_tmID tm) %~ ( (tmInput .~ TerminalInput T.empty True (0,0)) . (tmFutureLines ++.~ tls ) ) argumentHelp :: Maybe String -> String argumentHelp mstr = case mstr of Nothing -> "ANY ARGUMENTS PROVIDED TO THIS COMMAND ARE IGNORED." Just str -> "EXPECTS " ++ str ++ " AS ARGUMENT." makeTermPara :: String -> [TerminalLine] makeTermPara = map makeTermLine . makeParagraph 60 makeColorTermLine :: Color -> String -> TerminalLine makeColorTermLine col str = TerminalLineDisplay 0 $ const (str,col) makeTermLine :: String -> TerminalLine makeTermLine = makeColorTermLine white termSoundLine :: SoundID -> TerminalLine termSoundLine sid = TerminalLineEffect 0 termsound where termsound tm w = soundStart TerminalSound tpos sid Nothing w where tpos = fromMaybe 0 $ w ^? buttons . ix (_tmButtonID tm) . btPos infoCommand :: String -> TerminalCommand infoCommand str = TerminalCommand { _tcString = "INFORMATION" , _tcAlias = ["INFO","I"] , _tcHelp = "DISPLAYS INFORMATION CONCERNING THE TERMINAL." , _tcArgumentType = Nothing , _tcArguments = const (const []) , _tcEffect = const $ \tm w -> Right $ w & infoClearInput tm ( makeTermPara str) } commandsCommand :: TerminalCommand commandsCommand = TerminalCommand { _tcString = "COMMANDS" , _tcAlias = ["COMMAND","COM"] , _tcHelp = "DISPLAYS AVAILABLE COMMANDS." , _tcArgumentType = Nothing , _tcArguments = const $ const [] , _tcEffect = \_ tm w -> Right $ w & infoClearInput tm ( makeTermLine "AVAILABLE COMMANDS:" : makeTermPara (unwords (maybe [""] (map _tcString) $ getCommands tm w)) ) } singleCommand :: [String] -> String -> [String] -> String -> (World -> World) -> TerminalCommand singleCommand followingLines command aliases htext eff = TerminalCommand {_tcString = command ,_tcAlias = aliases ,_tcHelp = htext ,_tcArgumentType = Nothing , _tcArguments = const $ const [] ,_tcEffect = \_ tm w -> Right $ eff $ w & terminals . ix (_tmID tm) . tmInput . tiText .~ T.pack "" & terminals . ix (_tmID tm) . tmFutureLines ++.~ map makeTermLine followingLines -- & hud . hudElement . subInventory . onInputLine %~ const False } doTerminalEffectLB :: Terminal -> World -> World doTerminalEffectLB tm w = fromMaybe w $ do s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . tiText if null (words s) then Just $ defocusTerminalInput w else return $ doTerminalEffect tm w doTerminalEffect :: Terminal -> World -> World doTerminalEffect tm w = fromMaybe w $ do s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . tiText return $ doTerminalEffect' s tm $ w & terminals . ix (_tmID tm) . tmFutureLines .~ [makeColorTermLine (greyN 0.9) ('>':s)] doTerminalEffect' :: String -> Terminal -> World -> World doTerminalEffect' s tm w = fromMaybe (w & badinput) $ do commands <- getCommands tm w if null (words s) then Just $ defocusTerminalInput w else do let (str:args) = words s command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) commands case _tcEffect command args tm w of Right w' -> return w' Left err -> return $ w & terminals . ix (_tmID tm) %~ ( (tmInput .~ TerminalInput T.empty True (0,0)) . (tmFutureLines ++.~ [makeColorTermLine red ("^ INVALID ARGUMENT: EXPECTS "++fromJust (_tcArgumentType command)++ err) ] ) ) where badinput = terminals . ix (_tmID tm) %~ ( (tmInput .~ TerminalInput T.empty True (0,0)) . (tmFutureLines ++.~ [makeColorTermLine red "^ INVALID INPUT" ] ) ) defocusTerminalInput :: World -> World defocusTerminalInput w = fromMaybe w $ do tmid <- w ^? hud . hudElement . subInventory . termID return $ w & terminals . ix tmid . tmInput . tiFocus %~ const False addInputLine :: [TerminalCommand] -> [TerminalCommand] -> Terminal -> Terminal addInputLine searchablecommands hiddencommands = (tmProgram %~ \f t w -> f t w ++ [TerminalLineInput 0]) . (tmScrollCommands .~ searchablecommands) . (tmWriteCommands .~ hiddencommands) defaultTermParams :: Terminal defaultTermParams = defaultTerminal {_tmDisplayedLines = [] ,_tmFutureLines = [] ,_tmMaxLines = 14 ,_tmTitle = "TERMINAL" ,_tmInput = defaultTerminalInput ,_tmScrollCommands = [] ,_tmWriteCommands = [helpCommand,commandsCommand] ,_tmProgram = \_ _ -> termSoundLine computerBeepingS : TerminalLineTerminalEffect 0 (tmStatus .~ Connected) : map makeTermLine connectionBlurb } connectionBlurb :: [String] connectionBlurb = ["CONNECTING ..." ,"COMPLETE" ]