From 3a18bb64853c18d95dafdc54afd83c3f9f032d0b Mon Sep 17 00:00:00 2001 From: Karl Ostmo Date: Sun, 8 Sep 2024 19:06:17 -0700 Subject: [PATCH] Preserve selection --- src/swarm-tui/Swarm/TUI/Controller.hs | 4 +- .../Swarm/TUI/Controller/UpdateUI.hs | 28 ++++++++ src/swarm-tui/Swarm/TUI/Model/Dialog/Robot.hs | 69 +++++++++---------- .../Swarm/TUI/Model/Dialog/RobotDisplay.hs | 25 +++++-- src/swarm-tui/Swarm/TUI/Model/UI.hs | 7 +- src/swarm-tui/Swarm/TUI/View.hs | 24 +++---- 6 files changed, 97 insertions(+), 60 deletions(-) diff --git a/src/swarm-tui/Swarm/TUI/Controller.hs b/src/swarm-tui/Swarm/TUI/Controller.hs index f7963a4e4..b0fe368d9 100644 --- a/src/swarm-tui/Swarm/TUI/Controller.hs +++ b/src/swarm-tui/Swarm/TUI/Controller.hs @@ -422,8 +422,8 @@ handleModalEvent = \case _ -> handleInfoPanelEvent modalScroll (VtyEvent ev) Just RobotsModal -> case ev of V.EvKey (V.KChar '\t') [] -> uiState . uiGameplay . uiDialogs . uiRobot . robotsDisplayMode %= cycleEnum - _ -> do - Brick.zoom (uiState . uiGameplay . uiDialogs . uiRobot . libList) $ + _ -> + Brick.zoom (uiState . uiGameplay . uiDialogs . uiRobot . robotListContent . libList) $ handleMixedListEvent ev _ -> handleInfoPanelEvent modalScroll (VtyEvent ev) where diff --git a/src/swarm-tui/Swarm/TUI/Controller/UpdateUI.hs b/src/swarm-tui/Swarm/TUI/Controller/UpdateUI.hs index d9a22e9b6..9cac49859 100644 --- a/src/swarm-tui/Swarm/TUI/Controller/UpdateUI.hs +++ b/src/swarm-tui/Swarm/TUI/Controller/UpdateUI.hs @@ -13,7 +13,9 @@ import Brick hiding (Direction, Location) import Brick.Focus -- See Note [liftA2 re-export from Prelude] + import Brick.Widgets.List qualified as BL +import Brick.Widgets.TabularList.Mixed (MixedTabularList (..)) import Control.Applicative (liftA2, pure) import Control.Lens as Lens import Control.Monad (unless, when) @@ -39,6 +41,8 @@ import Swarm.TUI.Model import Swarm.TUI.Model.DebugOption (DebugOption (..)) import Swarm.TUI.Model.Dialog.Goal import Swarm.TUI.Model.Dialog.Popup (Popup (..), addPopup) +import Swarm.TUI.Model.Dialog.Robot +import Swarm.TUI.Model.Dialog.RobotDisplay (libList, robID, robotListContent) import Swarm.TUI.Model.Name import Swarm.TUI.Model.Repl import Swarm.TUI.Model.UI @@ -165,6 +169,8 @@ updateUI = do newPopups <- generateNotificationPopups + doRobotListUpdate g + let redraw = g ^. needsRedraw || inventoryUpdated @@ -174,6 +180,28 @@ updateUI = do || newPopups pure redraw +doRobotListUpdate :: GameState -> EventM Name AppState () +doRobotListUpdate g = do + gp <- use $ uiState . uiGameplay + dOps <- use $ uiState . uiDebugOptions + + let rd = + mkRobotDisplay + ( RobotRenderingContext + { _mygs = g + , _gameplay = gp + , _timing = gp ^. uiTiming + , _uiDbg = dOps + } + ) + + let MixedTabularList oldList _ _ = gp ^. uiDialogs . uiRobot . robotListContent . libList + maybeOldSelectedRID = robID . snd <$> BL.listSelectedElement oldList + rd' = case maybeOldSelectedRID of + Nothing -> rd + Just oldSelectedRID -> rd & libList %~ (\(MixedTabularList ls a b) -> MixedTabularList (BL.listFindBy ((== oldSelectedRID) . robID) ls) a b) + uiState . uiGameplay . uiDialogs . uiRobot . robotListContent .= rd' + -- | Either pops up the updated Goals modal -- or pops up the Congratulations (Win) modal, or pops -- up the Condolences (Lose) modal. diff --git a/src/swarm-tui/Swarm/TUI/Model/Dialog/Robot.hs b/src/swarm-tui/Swarm/TUI/Model/Dialog/Robot.hs index 875c4242f..ddf8bf3a1 100644 --- a/src/swarm-tui/Swarm/TUI/Model/Dialog/Robot.hs +++ b/src/swarm-tui/Swarm/TUI/Model/Dialog/Robot.hs @@ -60,12 +60,10 @@ data RobotRenderingContext = RobotRenderingContext makeLenses ''RobotRenderingContext -mkRobotDisplay :: RobotRenderingContext -> RobotDisplay +mkRobotDisplay :: RobotRenderingContext -> RobotListContent mkRobotDisplay c = - RobotDisplay - { _robotsDisplayMode = RobotList - , _lastFocusedRobotId = Nothing - , _libList = mixedTabularList RobotsList (mkLibraryEntries c) (LstItmH 1) (wprk uiDebug) wpr + RobotListContent + { _libList = mixedTabularList RobotsList (mkLibraryEntries c) (LstItmH 1) (wprk uiDebug) wpr , _libRenderers = MixedRenderers { cell = dc uiDebug @@ -74,15 +72,13 @@ mkRobotDisplay c = , colHdrRowHdr = Just $ ColHdrRowHdr $ \_ _ -> vLimit 1 (fill ' ') <=> hBorder } } - where - uiDebug = c ^. uiDbg + where + uiDebug = c ^. uiDbg -emptyRobotDisplay :: Set DebugOption -> RobotDisplay +emptyRobotDisplay :: Set DebugOption -> RobotListContent emptyRobotDisplay uiDebug = - RobotDisplay - { _robotsDisplayMode = RobotList - , _lastFocusedRobotId = Nothing - , _libList = mixedTabularList RobotsList mempty (LstItmH 1) (wprk uiDebug) wpr + RobotListContent + { _libList = mixedTabularList RobotsList mempty (LstItmH 1) (wprk uiDebug) wpr , _libRenderers = MixedRenderers { cell = dc uiDebug @@ -92,7 +88,7 @@ emptyRobotDisplay uiDebug = } } -renderTheRobots :: RobotDisplay -> Widget Name +renderTheRobots :: RobotListContent -> Widget Name renderTheRobots rd = renderMixedTabularList (rd ^. libRenderers) (LstFcs True) (rd ^. libList) @@ -173,7 +169,7 @@ accessorList = dc :: Set DebugOption -> ListFocused -> MixedCtxt -> RobotWidgetRow -> Widget Name dc uiDebug _ (MxdCtxt _ (MColC (Ix ci))) r = - maybe emptyWidget (renderPlainCell . wWidget . ($ r)) (indexedAccessors V.!? ci) + maybe emptyWidget (renderPlainCell . wWidget . ($ rPayload r)) (indexedAccessors V.!? ci) where indexedAccessors = V.fromList accessors accessors = dropFirstColumn uiDebug accessorList @@ -192,7 +188,7 @@ wprk uiDebug = WsPerRK $ \(AvlW aW) allRows -> mkWidths = map (ColW . (+ 1) . maximum0) . transpose . (colHeaderRowLengths :) . map getColWidthsForRow where getColWidthsForRow :: RobotWidgetRow -> [Int] - getColWidthsForRow r = map (wWidth . ($ r)) $ dropFirstColumn uiDebug accessorList + getColWidthsForRow r = map (wWidth . ($ rPayload r)) $ dropFirstColumn uiDebug accessorList mkLibraryEntries :: RobotRenderingContext -> Seq RobotWidgetRow mkLibraryEntries c = @@ -214,27 +210,28 @@ mkLibraryEntries c = g = c ^. mygs mkRobotRow robot = - LibRobotRow - { _fID = - let tx = show $ robot ^. robotID - in WidthWidget (length tx) (str tx) - , _fName = nameWidget - , _fAge = WidthWidget (length ageStr) (str ageStr) - , _fPos = locWidget - , _fItems = - let tx = show rInvCount - in WidthWidget (length tx) (padRight (Pad 1) (str tx)) - , _fStatus = statusWidget - , _fActns = - let tx = show $ robot ^. activityCounts . tangibleCommandCount - in WidthWidget (length tx) (str tx) - , -- TODO(#1341): May want to expose the details of this histogram in - -- a per-robot pop-up - _fCmds = strWidget $ show . sum . M.elems $ robot ^. activityCounts . commandsHistogram - , _fCycles = strWidget $ show $ robot ^. activityCounts . lifetimeStepCount - , _fActivity = renderDutyCycle (c ^. mygs . temporal) robot - , _fLog = WidthWidget (T.length rLog) (txt rLog) - } + RobotRowPayload (robot ^. robotID) $ + LibRobotRow + { _fID = + let tx = show $ robot ^. robotID + in WidthWidget (length tx) (str tx) + , _fName = nameWidget + , _fAge = WidthWidget (length ageStr) (str ageStr) + , _fPos = locWidget + , _fItems = + let tx = show rInvCount + in WidthWidget (length tx) (padRight (Pad 1) (str tx)) + , _fStatus = statusWidget + , _fActns = + let tx = show $ robot ^. activityCounts . tangibleCommandCount + in WidthWidget (length tx) (str tx) + , -- TODO(#1341): May want to expose the details of this histogram in + -- a per-robot pop-up + _fCmds = strWidget $ show . sum . M.elems $ robot ^. activityCounts . commandsHistogram + , _fCycles = strWidget $ show $ robot ^. activityCounts . lifetimeStepCount + , _fActivity = renderDutyCycle (c ^. mygs . temporal) robot + , _fLog = WidthWidget (T.length rLog) (txt rLog) + } where strWidget tx = WidthWidget (length tx) (str tx) diff --git a/src/swarm-tui/Swarm/TUI/Model/Dialog/RobotDisplay.hs b/src/swarm-tui/Swarm/TUI/Model/Dialog/RobotDisplay.hs index 1a235cce4..6b7d217b3 100644 --- a/src/swarm-tui/Swarm/TUI/Model/Dialog/RobotDisplay.hs +++ b/src/swarm-tui/Swarm/TUI/Model/Dialog/RobotDisplay.hs @@ -12,6 +12,12 @@ import GHC.Generics (Generic) import Swarm.Game.Robot import Swarm.TUI.Model.Name +data RobotRowPayload a = RobotRowPayload + { robID :: RID + , rPayload :: LibRobotRow a + } + deriving (Functor) + data WidthWidget = WidthWidget { wWidth :: Int , wWidget :: Widget Name @@ -22,7 +28,7 @@ newtype Widths = Widths } deriving (Generic) -type RobotWidgetRow = LibRobotRow WidthWidget +type RobotWidgetRow = RobotRowPayload WidthWidget type RobotHeaderRow = LibRobotRow String data LibRobotRow a = LibRobotRow @@ -40,19 +46,24 @@ data LibRobotRow a = LibRobotRow } deriving (Functor) -data RobotsDisplayMode = RobotList | SingleRobotDetails +data RobotsDisplayMode + = RobotList + | SingleRobotDetails deriving (Eq, Show, Enum, Bounded) type LibraryList = MixedTabularList Name RobotWidgetRow Widths type LibraryRenderers = MixedRenderers Name RobotWidgetRow Widths +data RobotListContent = RobotListContent + { _libList :: LibraryList + , _libRenderers :: LibraryRenderers + } + +makeLenses ''RobotListContent + data RobotDisplay = RobotDisplay { _robotsDisplayMode :: RobotsDisplayMode - -- ^ required for maintaining the selection/navigation - -- state among list items - , _lastFocusedRobotId :: Maybe RID - , _libList :: LibraryList - , _libRenderers :: LibraryRenderers + , _robotListContent :: RobotListContent } makeLenses ''RobotDisplay diff --git a/src/swarm-tui/Swarm/TUI/Model/UI.hs b/src/swarm-tui/Swarm/TUI/Model/UI.hs index 7b7cb2371..923ccb686 100644 --- a/src/swarm-tui/Swarm/TUI/Model/UI.hs +++ b/src/swarm-tui/Swarm/TUI/Model/UI.hs @@ -84,6 +84,7 @@ import Swarm.TUI.Launch.Prep import Swarm.TUI.Model.DebugOption (DebugOption) import Swarm.TUI.Model.Dialog import Swarm.TUI.Model.Dialog.Robot +import Swarm.TUI.Model.Dialog.RobotDisplay import Swarm.TUI.Model.Menu import Swarm.TUI.Model.Name import Swarm.TUI.Model.Repl @@ -200,7 +201,11 @@ initUIState speedFactor showMainMenu debug = do { _uiModal = Nothing , _uiGoal = emptyGoalDisplay , _uiStructure = emptyStructureDisplay - , _uiRobot = emptyRobotDisplay debug + , _uiRobot = + RobotDisplay + { _robotsDisplayMode = RobotList + , _robotListContent = emptyRobotDisplay debug + } } , _uiIsAutoPlay = False , _uiTiming = diff --git a/src/swarm-tui/Swarm/TUI/View.hs b/src/swarm-tui/Swarm/TUI/View.hs index 28814e2de..c5f1970cc 100644 --- a/src/swarm-tui/Swarm/TUI/View.hs +++ b/src/swarm-tui/Swarm/TUI/View.hs @@ -33,7 +33,6 @@ module Swarm.TUI.View ( drawREPL, ) where -import Brick.Widgets.TabularList.Mixed (list) import Brick hiding (Direction, Location) import Brick.Focus import Brick.Forms @@ -48,6 +47,7 @@ import Brick.Widgets.Dialog import Brick.Widgets.Edit (getEditContents, renderEditor) import Brick.Widgets.List qualified as BL import Brick.Widgets.Table qualified as BT +import Brick.Widgets.TabularList.Mixed (MixedTabularList (..)) import Control.Lens as Lens hiding (Const, from) import Control.Monad (guard) import Data.Array (range) @@ -132,6 +132,7 @@ import Swarm.TUI.Model import Swarm.TUI.Model.DebugOption (DebugOption (..)) import Swarm.TUI.Model.Dialog.Goal (goalsContent, hasAnythingToShow) import Swarm.TUI.Model.Dialog.Robot +import Swarm.TUI.Model.Dialog.RobotDisplay import Swarm.TUI.Model.Event qualified as SE import Swarm.TUI.Model.KeyBindings (handlerNameKeysDescription) import Swarm.TUI.Model.Name @@ -617,19 +618,14 @@ drawDialog s = case s ^. uiState . uiGameplay . uiDialogs . uiModal of drawModal :: AppState -> ModalType -> Widget Name drawModal s = \case HelpModal -> helpWidget (s ^. gameState . randomness . seed) (s ^. runtimeState . webPort) (s ^. keyEventHandling) - RobotsModal -> do - let rd = - mkRobotDisplay $ - RobotRenderingContext - { _mygs = s ^. gameState - , _gameplay = s ^. uiState . uiGameplay - , _timing = s ^. uiState . uiGameplay . uiTiming - , _uiDbg = s ^. uiState . uiDebugOptions - } - -- let rd = s ^. uiState . uiGameplay . uiDialogs . uiRobot - -- rd' = rd & libList . list .~ - let rd' = rd & libList . list . BL.listSelectedL .~ Just 1 - renderTheRobots rd' + RobotsModal -> case s ^. uiState . uiGameplay . uiDialogs . uiRobot . robotsDisplayMode of + RobotList -> renderTheRobots $ s ^. uiState . uiGameplay . uiDialogs . uiRobot . robotListContent + SingleRobotDetails -> case maybeSelectedRID of + Nothing -> str "No selection" + Just selectedRID -> str $ unwords ["Selected robot", show selectedRID] + where + MixedTabularList oldList _ _ = s ^. uiState . uiGameplay . uiDialogs . uiRobot . robotListContent . libList + maybeSelectedRID = robID . snd <$> BL.listSelectedElement oldList RecipesModal -> availableListWidget (s ^. gameState) RecipeList CommandsModal -> commandsListWidget (s ^. gameState) MessagesModal -> availableListWidget (s ^. gameState) MessageList