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

Cleanup

Browse Source
This commit is contained in:
justin
2022-06-06 16:22:47 +01:00
parent 27a5b9b774
commit b92305798f
11 changed files with 116 additions and 77 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Terminal.hs
+23 -9
View File
@@ -73,7 +73,7 @@ getCommands tm w = do
infoClearInput :: Terminal -> [TerminalLine] -> World -> World
infoClearInput tm tls = terminals . ix (_tmID tm) %~
( (tmInput ?~ T.empty)
( (tmInput ?~ TerminalInput T.empty True)
. (tmFutureLines ++.~ tls
)
)
@@ -130,26 +130,33 @@ singleCommand command aliases htext eff = TerminalCommand
,_tcHelp = htext
,_tcArgumentType = Nothing
, _tcArguments = const $ const []
,_tcEffect = \_ tm w -> Right $ eff $ disconnectTerminal tm w
,_tcEffect = \_ tm w -> Right $ eff $ w & terminals . ix (_tmID tm) . tmInput .~ Nothing
-- & 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 . _Just . 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 . _Just
s <- fmap T.unpack $ w ^? terminals . ix (_tmID tm) . tmInput . _Just . 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 $ disconnectTerminal tm w else do
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 ?~ T.empty)
( (tmInput ?~ TerminalInput T.empty True)
. (tmFutureLines ++.~
[makeColorTermLine red
("^ INVALID ARGUMENT: EXPECTS "++fromJust (_tcArgumentType command)++ err)
@@ -158,28 +165,35 @@ doTerminalEffect' s tm w = fromMaybe (w & badinput) $ do
)
where
badinput = terminals . ix (_tmID tm) %~
( (tmInput ?~ T.empty)
( (tmInput ?~ TerminalInput T.empty True)
. (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 . _Just . tiFocus %~ const False
addInputLine :: [TerminalCommand] -> [TerminalCommand] -> Terminal -> Terminal
addInputLine searchablecommands hiddencommands =
(tmFutureLines ++.~ [TerminalLineInput 0])
(tmProgram %~ \f t w -> f t w ++ [TerminalLineInput 0])
. (tmScrollCommands .~ searchablecommands)
. (tmWriteCommands .~ hiddencommands)
defaultTermParams :: Terminal
defaultTermParams = defaultTerminal
{_tmDisplayedLines = []
,_tmFutureLines = termSoundLine computerBeepingS
: map makeTermLine connectionBlurb
,_tmFutureLines = []
,_tmMaxLines = 14
,_tmTitle = "TERMINAL"
,_tmSel = Nothing
,_tmInput = Nothing
,_tmScrollCommands = []
,_tmWriteCommands = []
,_tmProgram = \_ _ -> termSoundLine computerBeepingS
: TerminalLineTerminalEffect 0 (tmStatus .~ Connected)
: map makeTermLine connectionBlurb
}
connectionBlurb :: [String]