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

Commit before changing TerminalCommand to produce [TerminalLine]

Browse Source
This commit is contained in:
justin
2022-06-06 20:25:38 +01:00
parent b20502bc35
commit 1fe41889fe
8 changed files with 32 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Terminal.hs
+8 -9
View File
@@ -27,7 +27,6 @@ quitCommand = TerminalCommand
disconnectTerminal :: Terminal -> World -> World
disconnectTerminal tm w = w
& terminals . ix (_tmID tm) . tmStatus .~ Disconnected
& terminals . ix (_tmID tm) . tmInput .~ Nothing
& exitTerminalSubInv
& terminals . ix (_tmID tm) . tmFutureLines .~
[ TerminalLineTerminalEffect 0 (tmDisplayedLines .~ [])
@@ -105,7 +104,7 @@ getCommands tm w = do
infoClearInput :: Terminal -> [TerminalLine] -> World -> World
infoClearInput tm tls = terminals . ix (_tmID tm) %~
( (tmInput ?~ TerminalInput T.empty True (0,0))
( (tmInput .~ TerminalInput T.empty True (0,0))
. (tmFutureLines ++.~ tls
)
)
@@ -163,19 +162,19 @@ singleCommand followingLines command aliases htext eff = TerminalCommand
,_tcArgumentType = Nothing
, _tcArguments = const $ const []
,_tcEffect = \_ tm w -> Right $ eff $ w
& terminals . ix (_tmID tm) . tmInput . _Just . tiText .~ T.pack ""
& 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 . _Just . tiText
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 . _Just . tiText
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)]
@@ -190,7 +189,7 @@ doTerminalEffect' s tm w = fromMaybe (w & badinput) $ do
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))
( (tmInput .~ TerminalInput T.empty True (0,0))
. (tmFutureLines ++.~
[makeColorTermLine red
("^ INVALID ARGUMENT: EXPECTS "++fromJust (_tcArgumentType command)++ err)
@@ -199,7 +198,7 @@ doTerminalEffect' s tm w = fromMaybe (w & badinput) $ do
)
where
badinput = terminals . ix (_tmID tm) %~
( (tmInput ?~ TerminalInput T.empty True (0,0))
( (tmInput .~ TerminalInput T.empty True (0,0))
. (tmFutureLines ++.~ [makeColorTermLine red "^ INVALID INPUT" ]
)
)
@@ -207,7 +206,7 @@ doTerminalEffect' s tm w = fromMaybe (w & badinput) $ do
defocusTerminalInput :: World -> World
defocusTerminalInput w = fromMaybe w $ do
tmid <- w ^? hud . hudElement . subInventory . termID
return $ w & terminals . ix tmid . tmInput . _Just . tiFocus %~ const False
return $ w & terminals . ix tmid . tmInput . tiFocus %~ const False
addInputLine :: [TerminalCommand] -> [TerminalCommand] -> Terminal -> Terminal
addInputLine searchablecommands hiddencommands =
@@ -221,7 +220,7 @@ defaultTermParams = defaultTerminal
,_tmFutureLines = []
,_tmMaxLines = 14
,_tmTitle = "TERMINAL"
,_tmInput = Nothing
,_tmInput = defaultTerminalInput
,_tmScrollCommands = []
,_tmWriteCommands = [helpCommand,commandsCommand]
,_tmProgram = \_ _ -> termSoundLine computerBeepingS