Fix left clicks in terminals
This commit is contained in:
+16
-14
@@ -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
|
||||
]
|
||||
|
||||
@@ -24,7 +24,7 @@ defaultTerminal =
|
||||
, _tmStatus = TerminalOff
|
||||
, _tmCommandHistory = []
|
||||
, _tmToggles = mempty
|
||||
, _tmPartialCommand = mempty
|
||||
, _tmPartialCommand = Nothing
|
||||
}
|
||||
|
||||
defaultTerminalInput :: TerminalInput
|
||||
|
||||
@@ -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 = ""
|
||||
|
||||
@@ -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.!?)
|
||||
|
||||
@@ -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
|
||||
|
||||
|
||||
@@ -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 :))
|
||||
)
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user