Partially successful change of terminals to external entities
This commit is contained in:
+65
-66
@@ -1,5 +1,6 @@
|
||||
module Dodge.Terminal where
|
||||
import Dodge.Data
|
||||
import Dodge.Default
|
||||
import Dodge.Base
|
||||
import Dodge.SoundLogic
|
||||
import Color
|
||||
@@ -20,28 +21,28 @@ quitCommand = TerminalCommand
|
||||
, _tcAlias = ["Q","EXIT","X","SHUTDOWN",""]
|
||||
, _tcHelp = "DISCONNECTS THE TERMINAL."
|
||||
, _tcArgumentType = Nothing
|
||||
, _tcArguments = const []
|
||||
, _tcEffect = const $ \w -> Right $ w & disconnectTerminal
|
||||
, _tcArguments = const (const [])
|
||||
, _tcEffect = const $ \tm w -> Right $ w & disconnectTerminal tm
|
||||
}
|
||||
disconnectTerminal :: World -> World
|
||||
disconnectTerminal = hud . hudElement . subInventory . termParams %~
|
||||
( (termInput .~ Nothing)
|
||||
. (termFutureLines ++.~ [makeTermLine "DISCONNECTION COMPLETE"] )
|
||||
)
|
||||
disconnectTerminal :: Terminal -> World -> World
|
||||
disconnectTerminal tm w = w
|
||||
& terminals . ix (_tmID tm) . tmStatus .~ Disconnected
|
||||
& terminals . ix (_tmID tm) . tmFutureLines ++.~ [makeTermLine "DISCONNECTION COMPLETE"]
|
||||
|
||||
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
|
||||
, _tcArguments = \_ -> map (map toUpper . show) . M.keys . _sensorCoding . _genParams
|
||||
, _tcEffect = f
|
||||
}
|
||||
where
|
||||
f args w = fromMaybe (Left "") $ do
|
||||
f args tm w = fromMaybe (Left "") $ do
|
||||
dtype <- safeHead args >>= readMaybe
|
||||
dinfo <- _sensorCoding (_genParams w) M.!? dtype
|
||||
return $ Right $ w & infoClearInput [makeTermLine $ show (fst dinfo) ++ " " ++ show (snd dinfo)]
|
||||
return $ Right $ w & infoClearInput tm [makeTermLine $ show (fst dinfo) ++ " " ++ show (snd dinfo)]
|
||||
|
||||
helpCommand :: TerminalCommand
|
||||
helpCommand = TerminalCommand
|
||||
@@ -49,31 +50,31 @@ helpCommand = TerminalCommand
|
||||
, _tcAlias = ["H","MAN"]
|
||||
, _tcHelp = "DISPLAYS HELP FOR A SPECIFIC COMMAND. TO DISPLAY AVAILABLE COMMANDS USE \"COMMANDS\"."
|
||||
, _tcArgumentType = Just "AN AVAILABLE COMMAND"
|
||||
, _tcArguments = \w -> fromMaybe [] $ do
|
||||
commands <- getCommands w
|
||||
, _tcArguments = \tm w -> fromMaybe [] $ do
|
||||
commands <- getCommands tm w
|
||||
return $ map _tcString commands
|
||||
, _tcEffect = helpf
|
||||
}
|
||||
helpf :: [String] -> World -> Either String World
|
||||
helpf [] w = helpf ["HELP"] w
|
||||
helpf (str:_) w = maybe (Left "") Right $ do
|
||||
commands <- getCommands w
|
||||
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
|
||||
return $ w & infoClearInput tm
|
||||
([makeTermLine ("COMMAND:" ++ _tcString command)
|
||||
,makeTermLine ("ALIASES:" ++ unwords (_tcAlias command)) ]
|
||||
++ makeTermPara (_tcHelp command ++ " " ++ argumentHelp (_tcArgumentType command))
|
||||
)
|
||||
getCommands :: World -> Maybe [TerminalCommand]
|
||||
getCommands w = do
|
||||
commands1 <- w ^? hud . hudElement . subInventory . termParams . termScrollCommands
|
||||
commands2 <- w ^? hud . hudElement . subInventory . termParams . termWriteCommands
|
||||
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 :: [TerminalLine] -> World -> World
|
||||
infoClearInput tls = hud . hudElement . subInventory . termParams %~
|
||||
( (termInput ?~ T.empty)
|
||||
. (termFutureLines ++.~ tls
|
||||
infoClearInput :: Terminal -> [TerminalLine] -> World -> World
|
||||
infoClearInput tm tls = terminals . ix (_tmID tm) %~
|
||||
( (tmInput ?~ T.empty)
|
||||
. (tmFutureLines ++.~ tls
|
||||
)
|
||||
)
|
||||
|
||||
@@ -94,9 +95,9 @@ makeTermLine = makeColorTermLine white
|
||||
termSoundLine :: SoundID -> TerminalLine
|
||||
termSoundLine sid = TerminalLineEffect 0 termsound
|
||||
where
|
||||
termsound subinv w = soundStart TerminalSound tpos sid Nothing w
|
||||
termsound tm w = soundStart TerminalSound tpos sid Nothing w
|
||||
where
|
||||
tpos = fromMaybe 0 $ w ^? buttons . ix (_termID subinv) . btPos
|
||||
tpos = fromMaybe 0 $ w ^? buttons . ix (_tmButtonID tm) . btPos
|
||||
|
||||
infoCommand :: String -> TerminalCommand
|
||||
infoCommand str = TerminalCommand
|
||||
@@ -104,8 +105,8 @@ infoCommand str = TerminalCommand
|
||||
, _tcAlias = ["INFO","I"]
|
||||
, _tcHelp = "DISPLAYS INFORMATION CONCERNING THE TERMINAL."
|
||||
, _tcArgumentType = Nothing
|
||||
, _tcArguments = const []
|
||||
, _tcEffect = const $ \w -> Right $ w & infoClearInput
|
||||
, _tcArguments = const (const [])
|
||||
, _tcEffect = const $ \tm w -> Right $ w & infoClearInput tm
|
||||
( makeTermPara str)
|
||||
}
|
||||
|
||||
@@ -115,10 +116,10 @@ commandsCommand = TerminalCommand
|
||||
, _tcAlias = ["COMMAND","COM"]
|
||||
, _tcHelp = "DISPLAYS AVAILABLE COMMANDS."
|
||||
, _tcArgumentType = Nothing
|
||||
, _tcArguments = const []
|
||||
, _tcEffect = const $ \w -> Right $ w & infoClearInput
|
||||
, _tcArguments = const $ const []
|
||||
, _tcEffect = \_ tm w -> Right $ w & infoClearInput tm
|
||||
( makeTermLine "AVAILABLE COMMANDS:"
|
||||
: makeTermPara (unwords (maybe [""] (map _tcString) $ getCommands w))
|
||||
: makeTermPara (unwords (maybe [""] (map _tcString) $ getCommands tm w))
|
||||
)
|
||||
}
|
||||
|
||||
@@ -128,59 +129,57 @@ singleCommand command aliases htext eff = TerminalCommand
|
||||
,_tcAlias = aliases
|
||||
,_tcHelp = htext
|
||||
,_tcArgumentType = Nothing
|
||||
, _tcArguments = const []
|
||||
,_tcEffect = const $ \w -> Right $ eff $ disconnectTerminal w
|
||||
, _tcArguments = const $ const []
|
||||
,_tcEffect = \_ tm w -> Right $ eff $ disconnectTerminal tm w
|
||||
}
|
||||
|
||||
doTerminalEffect :: World -> World
|
||||
doTerminalEffect w = fromMaybe w $ do
|
||||
s <- fmap T.unpack $ w ^? hud . hudElement . subInventory . termParams . termInput . _Just
|
||||
return $ doTerminalEffect' s $ w
|
||||
& hud . hudElement . subInventory . termParams . termFutureLines
|
||||
doTerminalEffect :: Terminal -> World -> World
|
||||
doTerminalEffect tm w = fromMaybe w $ do
|
||||
s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . _Just
|
||||
return $ doTerminalEffect' s tm $ w
|
||||
& terminals . ix (_tmID tm) . tmFutureLines
|
||||
.~ [makeColorTermLine (greyN 0.9) ('>':s)]
|
||||
|
||||
doTerminalEffect' :: String -> World -> World
|
||||
doTerminalEffect' s w = fromMaybe (w & badinput) $ do
|
||||
commands <- getCommands w
|
||||
if null (words s) then Just $ disconnectTerminal w else do
|
||||
doTerminalEffect' :: String -> Terminal -> World -> World
|
||||
doTerminalEffect' s tm w = fromMaybe (w & badinput) $ do
|
||||
commands <- getCommands tm w
|
||||
if null (words s) then Just $ disconnectTerminal tm w else do
|
||||
let (str:args) = words s
|
||||
command <- find (\tc -> _tcString tc == str || str `elem` _tcAlias tc) commands
|
||||
case _tcEffect command args w of
|
||||
case _tcEffect command args tm w of
|
||||
Right w' -> return w'
|
||||
Left err -> return $ w & hud . hudElement . subInventory . termParams %~
|
||||
( (termInput ?~ T.empty)
|
||||
. (termFutureLines ++.~
|
||||
Left err -> return $ w & terminals . ix (_tmID tm) %~
|
||||
( (tmInput ?~ T.empty)
|
||||
. (tmFutureLines ++.~
|
||||
[makeColorTermLine red
|
||||
("^ INVALID ARGUMENT: EXPECTS "++fromJust (_tcArgumentType command)++ err)
|
||||
]
|
||||
)
|
||||
)
|
||||
where
|
||||
badinput = hud . hudElement . subInventory . termParams %~
|
||||
( (termInput ?~ T.empty)
|
||||
. (termFutureLines ++.~ [makeColorTermLine red "^ INVALID INPUT"
|
||||
]
|
||||
badinput = terminals . ix (_tmID tm) %~
|
||||
( (tmInput ?~ T.empty)
|
||||
. (tmFutureLines ++.~ [makeColorTermLine red "^ INVALID INPUT" ]
|
||||
)
|
||||
)
|
||||
|
||||
addInputLine :: [TerminalCommand] -> [TerminalCommand] -> TerminalParams -> TerminalParams
|
||||
addInputLine :: [TerminalCommand] -> [TerminalCommand] -> Terminal -> Terminal
|
||||
addInputLine searchablecommands hiddencommands =
|
||||
(termFutureLines ++.~ [TerminalLineInput 0])
|
||||
. (termScrollCommands ++.~ searchablecommands)
|
||||
. (termWriteCommands ++.~ hiddencommands)
|
||||
(tmFutureLines ++.~ [TerminalLineInput 0])
|
||||
. (tmScrollCommands .~ searchablecommands)
|
||||
. (tmWriteCommands .~ hiddencommands)
|
||||
|
||||
defaultTermParams :: TerminalParams
|
||||
defaultTermParams = TerminalParams
|
||||
{_termDisplayedLines = []
|
||||
,_termFutureLines = termSoundLine computerBeepingS
|
||||
defaultTermParams :: Terminal
|
||||
defaultTermParams = defaultTerminal
|
||||
{_tmDisplayedLines = []
|
||||
,_tmFutureLines = termSoundLine computerBeepingS
|
||||
: map makeTermLine connectionBlurb
|
||||
,_termMaxLines = 14
|
||||
,_termTitle = "TERMINAL"
|
||||
,_termSel = Nothing
|
||||
,_termInput = Nothing
|
||||
,_termScrollCommands = []
|
||||
,_termWriteCommands = []
|
||||
,_termDeathCommand = Nothing
|
||||
,_tmMaxLines = 14
|
||||
,_tmTitle = "TERMINAL"
|
||||
,_tmSel = Nothing
|
||||
,_tmInput = Nothing
|
||||
,_tmScrollCommands = []
|
||||
,_tmWriteCommands = []
|
||||
}
|
||||
|
||||
connectionBlurb :: [String]
|
||||
|
||||
Reference in New Issue
Block a user