From 727e5af2a6bd180595f34457629e28322894d69b Mon Sep 17 00:00:00 2001 From: justin Date: Wed, 3 May 2023 16:45:39 +0100 Subject: [PATCH] Fix left clicks in terminals --- src/Dodge/Data/Terminal.hs | 30 ++++++++++++++++-------------- src/Dodge/Default/Terminal.hs | 2 +- src/Dodge/Render/HUD.hs | 5 +++-- src/Dodge/Terminal.hs | 10 +++++++--- src/Dodge/Terminal/LeftButton.hs | 2 +- src/Dodge/Terminal/ReturnEffect.hs | 4 ++-- src/Dodge/Update/Scroll.hs | 4 +++- 7 files changed, 33 insertions(+), 24 deletions(-) diff --git a/src/Dodge/Data/Terminal.hs b/src/Dodge/Data/Terminal.hs index a3f6576b0..f0b33543c 100644 --- a/src/Dodge/Data/Terminal.hs +++ b/src/Dodge/Data/Terminal.hs @@ -46,7 +46,7 @@ data Terminal = Terminal , _tmStatus :: TerminalStatus , _tmCommandHistory :: [String] , _tmToggles :: M.Map String TerminalToggle - , _tmPartialCommand :: Maybe String + , _tmPartialCommand :: Maybe TerminalCommand } --deriving (Eq, Show, Read) --, Generic) --h--deriving (Eq, Show, Read) --Generic, Flat) @@ -58,7 +58,7 @@ data TmTm = TmId | TmTmClearDisplayedLines | TmTmSetStatus TerminalStatus - | TmTmSetPartialCommand (Maybe String) + | TmTmSetPartialCommand (Maybe TerminalCommand) --deriving (Eq, Ord, Show, Read) --Generic, Flat) data TerminalLine @@ -126,15 +126,17 @@ makeLenses ''TerminalLine makeLenses ''TerminalToggle makeLenses ''EffectArguments makeLenses ''TerminalCommand -deriveJSON defaultOptions ''TerminalStatus -deriveJSON defaultOptions ''TerminalInput -deriveJSON defaultOptions ''TerminalLineString -deriveJSON defaultOptions ''TmTm -deriveJSON defaultOptions ''TerminalLine -deriveJSON defaultOptions ''TerminalBootProgram -deriveJSON defaultOptions ''BlBl -deriveJSON defaultOptions ''TerminalToggle -deriveJSON defaultOptions ''EffectArguments -deriveJSON defaultOptions ''TerminalCommandEffect -deriveJSON defaultOptions ''TerminalCommand -deriveJSON defaultOptions ''Terminal +concat <$> mapM (deriveJSON defaultOptions) + [ ''TerminalStatus + , ''TerminalInput + , ''TerminalLineString + , ''TmTm + , ''TerminalLine + , ''TerminalBootProgram + , ''BlBl + , ''TerminalToggle + , ''EffectArguments + , ''TerminalCommandEffect + , ''TerminalCommand + , ''Terminal + ] diff --git a/src/Dodge/Default/Terminal.hs b/src/Dodge/Default/Terminal.hs index 71426d11c..ff5b806f9 100644 --- a/src/Dodge/Default/Terminal.hs +++ b/src/Dodge/Default/Terminal.hs @@ -24,7 +24,7 @@ defaultTerminal = , _tmStatus = TerminalOff , _tmCommandHistory = [] , _tmToggles = mempty - , _tmPartialCommand = mempty + , _tmPartialCommand = Nothing } defaultTerminalInput :: TerminalInput diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 7aac8de50..271eed677 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -214,8 +214,9 @@ displayTerminal tid cfig w = fromMaybe mempty $ do . take (_tmMaxLines tm) $ _tmDisplayedLines tm displayTermInput tm = case _tmInput tm of - TerminalInput s hasfoc _ -> (++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)]) - partcommand tm = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just + TerminalInput {_tiText = s, _tiFocus = hasfoc} + -> (++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)]) + partcommand tm = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just . tcString displayInputText tm s | _tmStatus tm == TerminalReady = partcommand tm ++ "> " ++ s | otherwise = "" diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index 0a5f88a4f..10bac342c 100644 --- a/src/Dodge/Terminal.hs +++ b/src/Dodge/Terminal.hs @@ -256,9 +256,13 @@ commandFutureLines s tm w = fromMaybe [errline "^ Invalid command"] $ do case doTerminalCommandEffect (_tcEffect command) tm w of NoArguments tls -> Just tls OneArgument argtype m -> - let setpartial = - TerminalLineTerminalEffect 0 (TmTmSetPartialCommand (Just str)) : - makeTermPara ("expects " ++ argtype ++ " as an argument") + let setpartial + | null (_tmPartialCommand tm) + = TerminalLineTerminalEffect 0 (TmTmSetPartialCommand (Just command)) : + makeTermPara ("Expects " ++ argtype ++ " as an argument") + | otherwise = + TerminalLineTerminalEffect 0 (TmTmSetPartialCommand Nothing) : + makeTermPara ("No argument input, cancelling") in Just $ fromMaybe setpartial $ safeHead args >>= (m M.!?) diff --git a/src/Dodge/Terminal/LeftButton.hs b/src/Dodge/Terminal/LeftButton.hs index e848d084e..5de65da28 100644 --- a/src/Dodge/Terminal/LeftButton.hs +++ b/src/Dodge/Terminal/LeftButton.hs @@ -13,7 +13,7 @@ doTerminalEffectLB :: Terminal -> World -> World doTerminalEffectLB tm w = fromMaybe w $ do guard (_tmStatus tm == TerminalReady) s <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText - if null (words s) + if null (words s) && null (_tmPartialCommand tm) then Just $ defocusTerminalInput w else return $ terminalReturnEffect tm w diff --git a/src/Dodge/Terminal/ReturnEffect.hs b/src/Dodge/Terminal/ReturnEffect.hs index 4b67d1b8b..de3ee9d39 100644 --- a/src/Dodge/Terminal/ReturnEffect.hs +++ b/src/Dodge/Terminal/ReturnEffect.hs @@ -11,7 +11,7 @@ terminalReturnEffect :: Terminal -> World -> World terminalReturnEffect tm w = fromMaybe w $ do guard $ _tmStatus tm == TerminalReady s <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText - let pc = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just + let pc = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just . tcString return $ runTerminalString (pc ++ s) tm $ w @@ -22,7 +22,7 @@ terminalReturnEffect tm w = fromMaybe w $ do runTerminalString :: String -> Terminal -> World -> World runTerminalString s tm w = w & cWorld . lWorld . terminals . ix (_tmID tm) - %~ ( (tmInput .~ TerminalInput mempty True (0, 0)) + %~ ( (tmInput .~ TerminalInput {_tiText = mempty, _tiFocus = True, _tiSel = (0, 0)}) . (tmFutureLines ++.~ commandFutureLines s tm w) . (tmCommandHistory %~ take 10 . (s :)) ) diff --git a/src/Dodge/Update/Scroll.hs b/src/Dodge/Update/Scroll.hs index abd7b4aa7..e5118c970 100644 --- a/src/Dodge/Update/Scroll.hs +++ b/src/Dodge/Update/Scroll.hs @@ -117,7 +117,9 @@ changeTweakParam mi i w = fromMaybe w $ do ) scrollCommands :: Terminal -> [TerminalCommand] -scrollCommands = (nullCommand :) . _tmScrollCommands +scrollCommands tm + | null $ _tmPartialCommand tm = (nullCommand :) $ _tmScrollCommands tm + | otherwise = [nullCommand] getArguments' :: TerminalCommand -> Terminal -> World -> [String] getArguments' tc tm = ("" :) . getArguments tc tm