diff --git a/src/swarm-tui/Swarm/TUI/Controller.hs b/src/swarm-tui/Swarm/TUI/Controller.hs index 1f2b91fa7..1d99ab134 100644 --- a/src/swarm-tui/Swarm/TUI/Controller.hs +++ b/src/swarm-tui/Swarm/TUI/Controller.hs @@ -444,12 +444,12 @@ handleMainEvent ev = do _ev -> do fring <- use $ uiState . uiGameplay . uiFocusRing case focusGetCurrent fring of - Just (FocusablePanel x) -> ($ ev) $ case x of - REPLPanel -> handleREPLEvent - WorldPanel -> handleWorldEvent - WorldEditorPanel -> EC.handleWorldEditorPanelEvent - RobotPanel -> handleRobotPanelEvent - InfoPanel -> handleInfoPanelEvent infoScroll + Just (FocusablePanel x) -> case x of + REPLPanel -> handleREPLEvent ev + WorldPanel -> handleWorldEvent ev + WorldEditorPanel -> EC.handleWorldEditorPanelEvent ev + RobotPanel -> handleRobotPanelEvent ev + InfoPanel -> handleInfoPanelEvent infoScroll ev _ -> continueWithoutRedraw -- | Set the game to Running if it was (auto) paused otherwise to paused. @@ -1461,6 +1461,7 @@ handleInventoryListEvent ev = do case mList of Nothing -> continueWithoutRedraw Just l -> do + when (isValidListMovement ev) $ resetViewport infoScroll l' <- nestEventM' l (handleListEventWithSeparators ev (is _Separator)) uiState . uiGameplay . uiInventory . uiInventoryList . _Just . _2 .= l' @@ -1480,7 +1481,8 @@ handleInventorySearchEvent = \case uiInventorySearch .= Nothing gets focusedEntity >>= maybe continueWithoutRedraw descriptionModal -- Any old character: append to the current search string - CharKey c -> + CharKey c -> do + resetViewport infoScroll Brick.zoom (uiState . uiGameplay . uiInventory) $ do uiInventoryShouldUpdate .= True uiInventorySearch %= fmap (`snoc` c) @@ -1510,6 +1512,7 @@ makeEntity e = do descriptionModal :: Entity -> EventM Name AppState () descriptionModal e = do s <- get + resetViewport modalScroll uiState . uiGameplay . uiModal ?= generateModal s (DescriptionModal e) ------------------------------------------------------------ diff --git a/src/swarm-tui/Swarm/TUI/Controller/Util.hs b/src/swarm-tui/Swarm/TUI/Controller/Util.hs index 9fcd31e0b..31961b661 100644 --- a/src/swarm-tui/Swarm/TUI/Controller/Util.hs +++ b/src/swarm-tui/Swarm/TUI/Controller/Util.hs @@ -52,6 +52,7 @@ pattern FKey c = VtyEvent (V.EvKey (V.KFun c) []) openModal :: ModalType -> EventM Name AppState () openModal mt = do + resetViewport modalScroll newModal <- gets $ flip generateModal mt ensurePause uiState . uiGameplay . uiModal ?= newModal @@ -110,3 +111,9 @@ hasDebugCapability :: Bool -> AppState -> Bool hasDebugCapability isCreative s = maybe isCreative (S.member CDebug . getCapabilitySet) $ s ^? gameState . to focusedRobot . _Just . robotCapabilities + +-- | Resets the viewport scroll position +resetViewport :: ViewportScroll Name -> EventM Name AppState () +resetViewport n = do + vScrollToBeginning n + hScrollToBeginning n diff --git a/src/swarm-tui/Swarm/TUI/List.hs b/src/swarm-tui/Swarm/TUI/List.hs index a0d1793db..621313a9e 100644 --- a/src/swarm-tui/Swarm/TUI/List.hs +++ b/src/swarm-tui/Swarm/TUI/List.hs @@ -3,7 +3,10 @@ -- -- A special modified version of 'Brick.Widgets.List.handleListEvent' -- to deal with skipping over separators. -module Swarm.TUI.List (handleListEventWithSeparators) where +module Swarm.TUI.List ( + handleListEventWithSeparators, + isValidListMovement, +) where import Brick (EventM) import Brick.Widgets.List qualified as BL @@ -20,15 +23,21 @@ handleListEventWithSeparators :: (e -> Bool) -> EventM n (BL.GenericList n t e) () handleListEventWithSeparators e isSep = - listSkip isSep movement - where - movement = case e of - V.EvKey V.KUp [] -> Move One Bwd - V.EvKey (V.KChar 'k') [] -> Move One Bwd - V.EvKey V.KDown [] -> Move One Fwd - V.EvKey (V.KChar 'j') [] -> Move One Fwd - V.EvKey V.KHome [] -> Move Most Bwd - V.EvKey V.KEnd [] -> Move Most Fwd - V.EvKey V.KPageDown [] -> Move Page Fwd - V.EvKey V.KPageUp [] -> Move Page Bwd - _ -> NoMove + listSkip isSep (movement e) + +-- | A movement is considered legitimate when a key event +-- results in @Move@ action. +isValidListMovement :: V.Event -> Bool +isValidListMovement e = movement e /= NoMove + +movement :: V.Event -> Move +movement = \case + V.EvKey V.KUp [] -> Move One Bwd + V.EvKey (V.KChar 'k') [] -> Move One Bwd + V.EvKey V.KDown [] -> Move One Fwd + V.EvKey (V.KChar 'j') [] -> Move One Fwd + V.EvKey V.KHome [] -> Move Most Bwd + V.EvKey V.KEnd [] -> Move Most Fwd + V.EvKey V.KPageDown [] -> Move Page Fwd + V.EvKey V.KPageUp [] -> Move Page Bwd + _ -> NoMove