Preserve selection

swarm-game · Sep 9, 2024 · 3a18bb6 · 3a18bb6
1 parent 29b4479
commit 3a18bb6
Show file tree

Hide file tree

Showing 6 changed files with 97 additions and 60 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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