From 1fe41889fe30d22af442969ff8dd030abe6063ed Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 6 Jun 2022 20:25:38 +0100 Subject: [PATCH] Commit before changing TerminalCommand to produce [TerminalLine] --- src/Dodge/Data.hs | 2 +- src/Dodge/Default.hs | 8 +++++++- src/Dodge/Event.hs | 18 +++++++++--------- src/Dodge/Event/Keyboard.hs | 8 ++++---- src/Dodge/InputFocus.hs | 2 +- src/Dodge/Render/HUD.hs | 3 +-- src/Dodge/Terminal.hs | 17 ++++++++--------- src/Dodge/Update.hs | 2 +- 8 files changed, 32 insertions(+), 28 deletions(-) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index fd4e23521..7e8692a04 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -955,7 +955,7 @@ data Terminal = Terminal , _tmFutureLines :: [TerminalLine] , _tmMaxLines :: Int , _tmTitle :: String - , _tmInput :: Maybe TerminalInput + , _tmInput :: TerminalInput , _tmScrollCommands :: [TerminalCommand] , _tmWriteCommands :: [TerminalCommand] , _tmDeathEffect :: Terminal -> World -> World diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 0d8a4577b..0ddac42d0 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -18,6 +18,7 @@ import Shape import Control.Lens import qualified Data.IntMap.Strict as IM +import qualified Data.Text as T import qualified Data.Map.Strict as M --import qualified Data.Vector as V --import Data.Monoid @@ -252,12 +253,17 @@ defaultTerminal = Terminal , _tmFutureLines = [] , _tmMaxLines = 14 , _tmTitle = "TERMINAL IN LOCATION" - , _tmInput = Nothing + , _tmInput = defaultTerminalInput , _tmScrollCommands = [] , _tmWriteCommands = [] , _tmDeathEffect = const id , _tmStatus = Disconnected } +defaultTerminalInput = TerminalInput + { _tiText = T.pack "" + , _tiFocus = True + , _tiSel = (0,0) + } defaultButton :: Button defaultButton = Button diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index e431284ed..4d314a8fb 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -97,7 +97,7 @@ handlePressedMouseButton but w = case (_hudElement (_hud w), but) of (_,ButtonMiddle) -> w & clickMousePos .~ _mousePos w ( DisplayInventory (DisplayTerminal tmid) , ButtonLeft) | hasTerminalFocus w -> doTerminalEffectLB (w ^?! terminals . ix tmid) w - | otherwise -> w & terminals . ix tmid . tmInput . _Just . tiFocus %~ const True + | otherwise -> w & terminals . ix tmid . tmInput . tiFocus %~ const True ( DisplayInventory (CombineInventory mi) , ButtonLeft) -> maybe (hud . hudElement .~ DisplayInventory NoSubInventory) doCombine mi w _ -> w @@ -150,17 +150,17 @@ wheelEvent y w = case _hudElement $ _hud w of & terminals . ix tmid %~ updatetermsel _ -> w where - updatetermsel tm = case tm ^? tmInput . _Just . tiSel of - Nothing -> tm & tmInput . _Just . tiSel .~ (0,0) - & tmInput . _Just . tiText %~ replacewith tm 0 + updatetermsel tm = case tm ^? tmInput . tiSel of + Nothing -> tm & tmInput . tiSel .~ (0,0) + & tmInput . tiText %~ replacewith tm 0 Just (i,_) -> let newi = ((`mod` length (scrollCommands tm)) . subtract yi) i - in tm & tmInput . _Just . tiSel .~ (newi,0) - & tmInput . _Just . tiText %~ replacewith tm newi - updatetermsubsel tm = case tm ^? tmInput . _Just . tiSel of + in tm & tmInput . tiSel .~ (newi,0) + & tmInput . tiText %~ replacewith tm newi + updatetermsubsel tm = case tm ^? tmInput . tiSel of Nothing -> tm Just (i,j) -> let newj = (j - yi) `mod` (1 + length (_tcArguments (scrollCommands tm !! i) tm w)) - in tm & tmInput . _Just . tiSel .~ (i,newj) - & tmInput . _Just . tiText %~ replacewith' tm i newj w + in tm & tmInput . tiSel .~ (i,newj) + & tmInput . tiText %~ replacewith' tm i newj w replacewith tp newi _ = T.pack (_tcString (scrollCommands tp !! newi)) replacewith' tp i j w' _ = T.pack $ _tcString tc ++ " " ++ arg-- ++ ((_tcArguments tp) w !! j) where diff --git a/src/Dodge/Event/Keyboard.hs b/src/Dodge/Event/Keyboard.hs index 31a08d495..ab05dcb84 100644 --- a/src/Dodge/Event/Keyboard.hs +++ b/src/Dodge/Event/Keyboard.hs @@ -37,9 +37,9 @@ handleTextInput text u = return . Just $ u where updateTerminalText = case u ^? uvWorld . hud . hudElement . subInventory of Just (DisplayTerminal tmid) | hasfocus tmid - -> uvWorld . terminals . ix tmid . tmInput . _Just . tiText %~ updateText + -> uvWorld . terminals . ix tmid . tmInput . tiText %~ updateText _ -> id - hasfocus tmid = fromMaybe False $ u ^? uvWorld . terminals . ix tmid . tmInput . _Just . tiFocus + hasfocus tmid = fromMaybe False $ u ^? uvWorld . terminals . ix tmid . tmInput . tiFocus updateText s = case T.unpack text of ";" -> s _ -> s `T.append` T.toUpper text @@ -90,10 +90,10 @@ handlePressedKeyInGame scode w = case scode of handlePressedKeyTerminal :: Int -> Scancode -> World -> Maybe World handlePressedKeyTerminal tmid scode w = case scode of - ScancodeEscape -> Just $ w & terminals . ix tmid . tmInput . _Just . tiFocus %~ const False + ScancodeEscape -> Just $ w & terminals . ix tmid . tmInput . tiFocus %~ const False ScancodeReturn -> Just $ w & doTerminalEffect (w ^?! terminals . ix tmid) ScancodeBackspace -> Just $ w - & terminals . ix tmid . tmInput . _Just . tiText %~ doBackspace + & terminals . ix tmid . tmInput . tiText %~ doBackspace & backspaceTimer .~ 5 _ -> Just w where diff --git a/src/Dodge/InputFocus.hs b/src/Dodge/InputFocus.hs index 47ce6b37c..5d35c7a23 100644 --- a/src/Dodge/InputFocus.hs +++ b/src/Dodge/InputFocus.hs @@ -7,5 +7,5 @@ import Data.Maybe hasTerminalFocus :: World -> Bool hasTerminalFocus w = fromMaybe False $ do tmid <- w ^? hud . hudElement . subInventory . termID - w ^? terminals . ix tmid . tmInput . _Just . tiFocus + w ^? terminals . ix tmid . tmInput . tiFocus diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 06edf8cc7..e19d4deec 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -145,8 +145,7 @@ displayTerminal tid cfig w = fromMaybe mempty $ do ] where displayTermInput tp = case _tmInput tp of - Nothing -> id - Just (TerminalInput s inputstatus _) + TerminalInput s inputstatus _ -> (++ [('>':T.unpack s++displayBlinkCursor inputstatus,white)]) displayBlinkCursor inputstatus | inputstatus = clockCycle 10 (V.fromList ["_",""]) w | otherwise = [] diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index af9d95837..1b7b95cca 100644 --- a/src/Dodge/Terminal.hs +++ b/src/Dodge/Terminal.hs @@ -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 diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 03219202c..282a3e476 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -116,7 +116,7 @@ tmUpdate tm w = case w ^? terminals . ix (_tmID tm) . tmFutureLines . ix 0 of Just (TerminalLineInput _) -> w & pointTermParams %~ ( ( tmFutureLines %~ tail ) - . ( tmInput ?~ TerminalInput T.empty True (0,0)) ) + . ( tmInput .~ TerminalInput T.empty True (0,0)) ) where pointTermParams = terminals . ix (_tmID tm)