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
, _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
]
+1 -1
View File
@@ -24,7 +24,7 @@ defaultTerminal =
, _tmStatus = TerminalOff
, _tmCommandHistory = []
, _tmToggles = mempty
, _tmPartialCommand = mempty
, _tmPartialCommand = Nothing
}
defaultTerminalInput :: TerminalInput
+3 -2
View File
@@ -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 = ""
+7 -3
View File
@@ -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.!?)
+1 -1
View File
@@ -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
+2 -2
View File
@@ -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 :))
)
+3 -1
View File
@@ -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