Fix left clicks in terminals

This commit is contained in:
2023-05-03 16:45:39 +01:00
parent 1d5f982fcc
commit 727e5af2a6
7 changed files with 33 additions and 24 deletions
+16 -14
View File
@@ -46,7 +46,7 @@ data Terminal = Terminal
, _tmStatus :: TerminalStatus , _tmStatus :: TerminalStatus
, _tmCommandHistory :: [String] , _tmCommandHistory :: [String]
, _tmToggles :: M.Map String TerminalToggle , _tmToggles :: M.Map String TerminalToggle
, _tmPartialCommand :: Maybe String , _tmPartialCommand :: Maybe TerminalCommand
} }
--deriving (Eq, Show, Read) --, Generic) --deriving (Eq, Show, Read) --, Generic)
--h--deriving (Eq, Show, Read) --Generic, Flat) --h--deriving (Eq, Show, Read) --Generic, Flat)
@@ -58,7 +58,7 @@ data TmTm
= TmId = TmId
| TmTmClearDisplayedLines | TmTmClearDisplayedLines
| TmTmSetStatus TerminalStatus | TmTmSetStatus TerminalStatus
| TmTmSetPartialCommand (Maybe String) | TmTmSetPartialCommand (Maybe TerminalCommand)
--deriving (Eq, Ord, Show, Read) --Generic, Flat) --deriving (Eq, Ord, Show, Read) --Generic, Flat)
data TerminalLine data TerminalLine
@@ -126,15 +126,17 @@ makeLenses ''TerminalLine
makeLenses ''TerminalToggle makeLenses ''TerminalToggle
makeLenses ''EffectArguments makeLenses ''EffectArguments
makeLenses ''TerminalCommand makeLenses ''TerminalCommand
deriveJSON defaultOptions ''TerminalStatus concat <$> mapM (deriveJSON defaultOptions)
deriveJSON defaultOptions ''TerminalInput [ ''TerminalStatus
deriveJSON defaultOptions ''TerminalLineString , ''TerminalInput
deriveJSON defaultOptions ''TmTm , ''TerminalLineString
deriveJSON defaultOptions ''TerminalLine , ''TmTm
deriveJSON defaultOptions ''TerminalBootProgram , ''TerminalLine
deriveJSON defaultOptions ''BlBl , ''TerminalBootProgram
deriveJSON defaultOptions ''TerminalToggle , ''BlBl
deriveJSON defaultOptions ''EffectArguments , ''TerminalToggle
deriveJSON defaultOptions ''TerminalCommandEffect , ''EffectArguments
deriveJSON defaultOptions ''TerminalCommand , ''TerminalCommandEffect
deriveJSON defaultOptions ''Terminal , ''TerminalCommand
, ''Terminal
]
+1 -1
View File
@@ -24,7 +24,7 @@ defaultTerminal =
, _tmStatus = TerminalOff , _tmStatus = TerminalOff
, _tmCommandHistory = [] , _tmCommandHistory = []
, _tmToggles = mempty , _tmToggles = mempty
, _tmPartialCommand = mempty , _tmPartialCommand = Nothing
} }
defaultTerminalInput :: TerminalInput defaultTerminalInput :: TerminalInput
+3 -2
View File
@@ -214,8 +214,9 @@ displayTerminal tid cfig w = fromMaybe mempty $ do
. take (_tmMaxLines tm) . take (_tmMaxLines tm)
$ _tmDisplayedLines tm $ _tmDisplayedLines tm
displayTermInput tm = case _tmInput tm of displayTermInput tm = case _tmInput tm of
TerminalInput s hasfoc _ -> (++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)]) TerminalInput {_tiText = s, _tiFocus = hasfoc}
partcommand tm = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just -> (++ [(displayInputText tm s ++ displayBlinkCursor hasfoc, white)])
partcommand tm = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just . tcString
displayInputText tm s displayInputText tm s
| _tmStatus tm == TerminalReady = partcommand tm ++ "> " ++ s | _tmStatus tm == TerminalReady = partcommand tm ++ "> " ++ s
| otherwise = "" | otherwise = ""
+7 -3
View File
@@ -256,9 +256,13 @@ commandFutureLines s tm w = fromMaybe [errline "^ Invalid command"] $ do
case doTerminalCommandEffect (_tcEffect command) tm w of case doTerminalCommandEffect (_tcEffect command) tm w of
NoArguments tls -> Just tls NoArguments tls -> Just tls
OneArgument argtype m -> OneArgument argtype m ->
let setpartial = let setpartial
TerminalLineTerminalEffect 0 (TmTmSetPartialCommand (Just str)) : | null (_tmPartialCommand tm)
makeTermPara ("expects " ++ argtype ++ " as an argument") = TerminalLineTerminalEffect 0 (TmTmSetPartialCommand (Just command)) :
makeTermPara ("Expects " ++ argtype ++ " as an argument")
| otherwise =
TerminalLineTerminalEffect 0 (TmTmSetPartialCommand Nothing) :
makeTermPara ("No argument input, cancelling")
in Just $ in Just $
fromMaybe setpartial $ fromMaybe setpartial $
safeHead args >>= (m M.!?) safeHead args >>= (m M.!?)
+1 -1
View File
@@ -13,7 +13,7 @@ doTerminalEffectLB :: Terminal -> World -> World
doTerminalEffectLB tm w = fromMaybe w $ do doTerminalEffectLB tm w = fromMaybe w $ do
guard (_tmStatus tm == TerminalReady) guard (_tmStatus tm == TerminalReady)
s <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText 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 then Just $ defocusTerminalInput w
else return $ terminalReturnEffect tm w else return $ terminalReturnEffect tm w
+2 -2
View File
@@ -11,7 +11,7 @@ terminalReturnEffect :: Terminal -> World -> World
terminalReturnEffect tm w = fromMaybe w $ do terminalReturnEffect tm w = fromMaybe w $ do
guard $ _tmStatus tm == TerminalReady guard $ _tmStatus tm == TerminalReady
s <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText s <- w ^? cWorld . lWorld . terminals . ix (_tmID tm) . tmInput . tiText
let pc = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just let pc = maybe "" (++ " ") $ tm ^? tmPartialCommand . _Just . tcString
return $ return $
runTerminalString (pc ++ s) tm $ runTerminalString (pc ++ s) tm $
w w
@@ -22,7 +22,7 @@ terminalReturnEffect tm w = fromMaybe w $ do
runTerminalString :: String -> Terminal -> World -> World runTerminalString :: String -> Terminal -> World -> World
runTerminalString s tm w = runTerminalString s tm w =
w & cWorld . lWorld . terminals . ix (_tmID tm) 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) . (tmFutureLines ++.~ commandFutureLines s tm w)
. (tmCommandHistory %~ take 10 . (s :)) . (tmCommandHistory %~ take 10 . (s :))
) )
+3 -1
View File
@@ -117,7 +117,9 @@ changeTweakParam mi i w = fromMaybe w $ do
) )
scrollCommands :: Terminal -> [TerminalCommand] scrollCommands :: Terminal -> [TerminalCommand]
scrollCommands = (nullCommand :) . _tmScrollCommands scrollCommands tm
| null $ _tmPartialCommand tm = (nullCommand :) $ _tmScrollCommands tm
| otherwise = [nullCommand]
getArguments' :: TerminalCommand -> Terminal -> World -> [String] getArguments' :: TerminalCommand -> Terminal -> World -> [String]
getArguments' tc tm = ("" :) . getArguments tc tm getArguments' tc tm = ("" :) . getArguments tc tm