justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Implement more scrolling arguments in terminal

Browse Source
This commit is contained in:
justin
2023-05-03 19:06:29 +01:00
parent 727e5af2a6
commit 2a39497805
1 changed files with 18 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Update/Scroll.hs
+18 -11
View File
@@ -65,11 +65,12 @@ guardDisconnectedID tmid w w' = case w ^? cWorld . lWorld . terminals . ix tmid
terminalWheelEvent :: Int -> Int -> World -> World terminalWheelEvent :: Int -> Int -> World -> World
terminalWheelEvent yi tmid w terminalWheelEvent yi tmid w
-- | isJust $ w ^? cWorld . lWorld . terminals . ix tmid . tmPartialCommand . _Just = w
| rbDown && inTermFocus w = | rbDown && inTermFocus w =
guardDisconnectedID tmid w $ guardDisconnectedID tmid w $
w w
& cWorld . lWorld . terminals . ix tmid %~ updatetermsubsel & cWorld . lWorld . terminals . ix tmid %~ updatetermsubsel
| inTermFocus w = | inTermFocus w = guardDisconnectedID tmid w $
w w
& cWorld . lWorld . terminals . ix tmid %~ updatetermsel & cWorld . lWorld . terminals . ix tmid %~ updatetermsel
| otherwise = w | otherwise = w
@@ -78,20 +79,21 @@ terminalWheelEvent yi tmid w
updatetermsel tm = case tm ^? tmInput . tiSel of updatetermsel tm = case tm ^? tmInput . tiSel of
Nothing -> tm & tmInput . tiSel .~ (0, 0) Nothing -> tm & tmInput . tiSel .~ (0, 0)
Just (i, _) -> Just (i, _) ->
let newi = (i - yi) `mod` length (scrollCommands tm) let newi = (i - yi) `mod` length (scrollCommandStrings w tm)
in tm & setInput newi 0 w in tm & setInput newi 0
updatetermsubsel tm = case tm ^? tmInput . tiSel of updatetermsubsel tm = case tm ^? tmInput . tiSel of
Nothing -> tm & tmInput . tiSel .~ (0, 0) Nothing -> tm & tmInput . tiSel .~ (0, 0)
Just (i, j) -> Just (i, j) ->
let newj = (j - yi) `mod` length (getArguments' (scrollCommands tm !! i) tm w) let newj = (j - yi) `mod` length (getArguments' (scrollCommands tm !! i) tm w)
in tm & setInput i newj w in tm & setInput i newj
setInput i j w' tm = setInput i j tm =
tm tm
& tmInput . tiSel .~ (i, j) & tmInput . tiSel .~ (i, j)
& tmInput . tiText .~ (_tcString tc ++ " " ++ arg) & tmInput . tiText .~ (comstr ++ arg)
where where
comstr = scrollCommandStrings w tm !! i
tc = scrollCommands tm !! i tc = scrollCommands tm !! i
arg = getArguments' tc tm w' !! j arg = getArguments' tc tm w !! j
scrollRBOption :: Int -> RightButtonOptions -> RightButtonOptions scrollRBOption :: Int -> RightButtonOptions -> RightButtonOptions
scrollRBOption y w scrollRBOption y w
@@ -117,9 +119,14 @@ changeTweakParam mi i w = fromMaybe w $ do
) )
scrollCommands :: Terminal -> [TerminalCommand] scrollCommands :: Terminal -> [TerminalCommand]
scrollCommands tm scrollCommands tm = (nullCommand :) $ _tmScrollCommands tm
| null $ _tmPartialCommand tm = (nullCommand :) $ _tmScrollCommands tm -- | null $ _tmPartialCommand tm = (nullCommand :) $ _tmScrollCommands tm
| otherwise = [nullCommand] -- | otherwise = [nullCommand]
scrollCommandStrings :: World -> Terminal -> [String]
scrollCommandStrings w tm = case tm ^? tmPartialCommand . _Just of
Nothing -> map _tcString $ scrollCommands tm
Just tc -> "": map tail (getArguments tc tm w)
getArguments' :: TerminalCommand -> Terminal -> World -> [String] getArguments' :: TerminalCommand -> Terminal -> World -> [String]
getArguments' tc tm = ("" :) . getArguments tc tm getArguments' tc tm = ("" :) . getArguments tc tm
@@ -136,4 +143,4 @@ nullCommand =
getArguments :: TerminalCommand -> Terminal -> World -> [String] getArguments :: TerminalCommand -> Terminal -> World -> [String]
getArguments tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of getArguments tc tm w = case doTerminalCommandEffect (_tcEffect tc) tm w of
NoArguments{} -> [] NoArguments{} -> []
OneArgument _ m -> M.keys m OneArgument _ m -> map (' ':) $ M.keys m