Focus ring for goals modal (#1055)

Fixes #1054

## Testing

    ./scripts/play.sh --scenario data/scenarios/Testing/795-prerequisite/795-prerequisite-mutually-exclusive.yaml

and

    ./scripts/play.sh --scenario data/scenarios/Tutorials/conditionals.yaml

src/Swarm/Game/Scenario/Objective/Presentation/Model.hs

@@ -4,17 +4,20 @@
 -- A UI-centric model for Objective presentation.
 module Swarm.Game.Scenario.Objective.Presentation.Model where
 
+import Brick.Focus
 import Brick.Widgets.List qualified as BL
 import Control.Lens (makeLenses)
 import Data.Aeson
 import Data.List.NonEmpty (NonEmpty, nonEmpty)
+import Data.List.NonEmpty qualified as NE
 import Data.Map (Map)
 import Data.Map qualified as M
 import Data.Maybe (mapMaybe)
 import GHC.Generics (Generic)
 import Swarm.Game.Scenario.Objective
 import Swarm.Game.Scenario.Objective.WinCheck
 import Swarm.TUI.Model.Name
+import Swarm.Util (listEnums)
 
 -- | These are intended to be used as keys in a map
 -- of lists of goals.
@@ -69,18 +72,27 @@ data GoalDisplay = GoalDisplay
   , _listWidget :: BL.List Name GoalEntry
   -- ^ required for maintaining the selection/navigation
   -- state among list items
+  , _focus :: FocusRing Name
   }
 
 makeLenses ''GoalDisplay
 
 emptyGoalDisplay :: GoalDisplay
 emptyGoalDisplay =
-  GoalDisplay (GoalTracking mempty mempty) $
-    BL.list ObjectivesList mempty 1
+  GoalDisplay
+    (GoalTracking mempty mempty)
+    (BL.list (GoalWidgets ObjectivesList) mempty 1)
+    (focusRing $ map GoalWidgets listEnums)
 
 hasAnythingToShow :: GoalTracking -> Bool
 hasAnythingToShow (GoalTracking ann g) = not (null ann && null g)
 
+hasMultipleGoals :: GoalTracking -> Bool
+hasMultipleGoals gt =
+  goalCount > 1
+ where
+  goalCount = sum . M.elems . M.map NE.length . goals $ gt
+
 constructGoalMap :: Bool -> ObjectiveCompletion -> CategorizedGoals
 constructGoalMap isCheating objectiveCompletion@(ObjectiveCompletion buckets _) =
   M.fromList $

src/Swarm/Game/Scenario/Objective/Presentation/Render.hs

@@ -4,6 +4,7 @@
 module Swarm.Game.Scenario.Objective.Presentation.Render where
 
 import Brick hiding (Direction, Location)
+import Brick.Focus
 import Brick.Widgets.Center
 import Brick.Widgets.List qualified as BL
 import Control.Applicative ((<|>))
@@ -20,54 +21,63 @@ import Swarm.TUI.View.Util
 
 makeListWidget :: GoalTracking -> BL.List Name GoalEntry
 makeListWidget (GoalTracking _announcements categorizedObjs) =
-  BL.listMoveTo 1 $ BL.list ObjectivesList (V.fromList objList) 1
+  BL.listMoveTo 1 $ BL.list (GoalWidgets ObjectivesList) (V.fromList objList) 1
  where
   objList = concatMap f $ M.toList categorizedObjs
   f (h, xs) = Header h : map (Goal h) (NE.toList xs)
 
 renderGoalsDisplay :: GoalDisplay -> Widget Name
 renderGoalsDisplay gd =
-  padAll 1 $
-    if goalsCount > 1
-      then
-        hBox
-          [ leftSide
-          , hLimitPercent 70 goalElaboration
-          ]
-      else goalElaboration
+  if hasMultiple
+    then
+      hBox
+        [ leftSide
+        , hLimitPercent 70 $ padLeft (Pad 2) goalElaboration
+        ]
+    else goalElaboration
  where
+  hasMultiple = hasMultipleGoals $ gd ^. goalsContent
   lw = _listWidget gd
+  fr = _focus gd
   leftSide =
     hLimitPercent 30 $
-      vBox
+      padAll 1 $ vBox
         [ hCenter $ str "Goals"
         , padAll 1 $
             vLimit 10 $
-              BL.renderList (const drawGoalListItem) True lw
+              withFocusRing fr (BL.renderList drawGoalListItem) lw
         ]
-  goalsCount = sum . M.elems . M.map NE.length . goals $ gd ^. goalsContent
 
+  -- Adds very subtle coloring to indicate focus switch
+  highlightIfFocused = case (hasMultiple, focusGetCurrent fr) of
+    (True, Just (GoalWidgets GoalSummary)) -> withAttr lightCyanAttr
+    _ -> id
+
+  -- Note: An extra "padRight" is inserted to account for the vertical scrollbar,
+  -- whether or not it appears.
   goalElaboration =
-    padLeft (Pad 2) $
-      maybe emptyWidget (singleGoalDetails . snd) $
-        BL.listSelectedElement lw
+    clickable (GoalWidgets GoalSummary) $
+      maybeScroll ModalViewport $
+        maybe emptyWidget (padAll 1 . padRight (Pad 1) . highlightIfFocused . singleGoalDetails . snd) $
+          BL.listSelectedElement lw
 
 getCompletionIcon :: Objective -> GoalStatus -> Widget Name
 getCompletionIcon obj = \case
   Upcoming -> withAttr yellowAttr $ txt " ○  "
   Active -> withAttr cyanAttr $ txt " ○  "
   Failed -> withAttr redAttr $ txt " ●  "
-  Completed -> withAttr colorattr $ txt " ●  "
+  Completed -> withAttr colorAttr $ txt " ●  "
    where
-    colorattr =
+    colorAttr =
       if obj ^. objectiveHidden
         then magentaAttr
         else greenAttr
 
 drawGoalListItem ::
+  Bool ->
   GoalEntry ->
   Widget Name
-drawGoalListItem = \case
+drawGoalListItem _isSelected e = case e of
   Header gs -> withAttr boldAttr $ str $ show gs
   Goal gs obj -> getCompletionIcon obj gs <+> titleWidget
    where

src/Swarm/TUI/Attr.hs

@@ -42,6 +42,7 @@ module Swarm.TUI.Attr (
   dimAttr,
   magentaAttr,
   cyanAttr,
+  lightCyanAttr,
   yellowAttr,
   blueAttr,
   greenAttr,
@@ -84,6 +85,7 @@ swarmAttrMap =
          , (blueAttr, fg V.blue)
          , (yellowAttr, fg V.yellow)
          , (cyanAttr, fg V.cyan)
+         , (lightCyanAttr, fg (V.rgbColor @Int 200 255 255))
          , (magentaAttr, fg V.magenta)
          , -- Default attribute
            (defAttr, V.defAttr)
@@ -163,12 +165,13 @@ dimAttr = attrName "dim"
 defAttr = attrName "def"
 
 -- | Some basic colors used in TUI.
-redAttr, greenAttr, blueAttr, yellowAttr, cyanAttr, magentaAttr :: AttrName
+redAttr, greenAttr, blueAttr, yellowAttr, cyanAttr, lightCyanAttr, magentaAttr :: AttrName
 redAttr = attrName "red"
 greenAttr = attrName "green"
 blueAttr = attrName "blue"
 yellowAttr = attrName "yellow"
 cyanAttr = attrName "cyan"
+lightCyanAttr = attrName "lightCyan"
 magentaAttr = attrName "magenta"
 
 instance ToJSON AttrName where

src/Swarm/TUI/Controller.hs

@@ -94,6 +94,7 @@ import Swarm.TUI.List
 import Swarm.TUI.Model
 import Swarm.TUI.Model.Achievement.Definitions
 import Swarm.TUI.Model.Achievement.Persistence
+import Swarm.TUI.Model.Name
 import Swarm.TUI.Model.Repl
 import Swarm.TUI.Model.StateUpdate
 import Swarm.TUI.Model.UI
@@ -406,11 +407,18 @@ handleModalEvent = \case
     Brick.zoom (uiState . uiModal . _Just . modalDialog) (handleDialogEvent ev)
     modal <- preuse $ uiState . uiModal . _Just . modalType
     case modal of
-      Just GoalModal -> do
-        lw <- use $ uiState . uiGoal . listWidget
-        newList <- refreshList lw
-        uiState . uiGoal . listWidget .= newList
-      Just _ -> handleInfoPanelEvent modalScroll (VtyEvent ev)
+      Just GoalModal -> case ev of
+        V.EvKey (V.KChar '\t') [] -> uiState . uiGoal . focus %= focusNext
+        _ -> do
+          focused <- use $ uiState . uiGoal . focus
+          case focusGetCurrent focused of
+            Just (GoalWidgets w) -> case w of
+              ObjectivesList -> do
+                lw <- use $ uiState . uiGoal . listWidget
+                newList <- refreshList lw
+                uiState . uiGoal . listWidget .= newList
+              GoalSummary -> handleInfoPanelEvent modalScroll (VtyEvent ev)
+            _ -> handleInfoPanelEvent modalScroll (VtyEvent ev)
       _ -> return ()
    where
     refreshList lw = nestEventM' lw $ handleListEventWithSeparators ev isHeader
@@ -771,9 +779,26 @@ doGoalUpdates = do
       -- Decide whether to show a pop-up modal congratulating the user on
       -- successfully completing the current challenge.
       when goalWasUpdated $ do
+        let hasMultiple = hasMultipleGoals newGoalTracking
+            defaultFocus =
+              if hasMultiple
+                then ObjectivesList
+                else GoalSummary
+
+            ring =
+              focusRing $
+                map GoalWidgets $
+                  if hasMultiple
+                    then listEnums
+                    else [GoalSummary]
+
         -- The "uiGoal" field is necessary at least to "persist" the data that is needed
         -- if the player chooses to later "recall" the goals dialog with CTRL+g.
-        uiState . uiGoal .= GoalDisplay newGoalTracking (GR.makeListWidget newGoalTracking)
+        uiState . uiGoal
+          .= GoalDisplay
+            newGoalTracking
+            (GR.makeListWidget newGoalTracking)
+            (focusSetCurrent (GoalWidgets defaultFocus) ring)
 
         -- This clears the "flag" that indicate that the goals dialog needs to be
         -- automatically popped up.

src/Swarm/TUI/Model/Name.hs

@@ -11,6 +11,11 @@ data FocusablePanel
     InfoPanel
   deriving (Eq, Ord, Show, Read, Bounded, Enum)
 
+data GoalWidget
+  = ObjectivesList
+  | GoalSummary
+  deriving (Eq, Ord, Show, Read, Bounded, Enum)
+
 -- | 'Name' represents names to uniquely identify various components
 --   of the UI, such as forms, panels, caches, extents, and lists.
 data Name
@@ -30,8 +35,8 @@ data Name
     MenuList
   | -- | The list of achievements.
     AchievementList
-  | -- | The list of goals/ojbectives.
-    ObjectivesList
+  | -- | The list of goals/objectives.
+    GoalWidgets GoalWidget
   | -- | The list of scenario choices.
     ScenarioList
   | -- | The scrollable viewport for the info panel.

src/Swarm/TUI/View.hs

@@ -49,7 +49,6 @@ import Brick.Widgets.List qualified as BL
 import Brick.Widgets.Table qualified as BT
 import Control.Lens hiding (Const, from)
 import Control.Monad (guard)
-import Control.Monad.Reader (withReaderT)
 import Data.Array (range)
 import Data.Bits (shiftL, shiftR, (.&.))
 import Data.Foldable qualified as F
@@ -68,7 +67,6 @@ import Data.Set qualified as Set (toList)
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Time (NominalDiffTime, defaultTimeLocale, formatTime)
-import Graphics.Vty qualified as V
 import Linear
 import Linear.Affine (Point)
 import Network.Wai.Handler.Warp (Port)
@@ -442,25 +440,11 @@ renderErrorDialog err = renderDialog (dialog (Just "Error") Nothing (maxModalWin
 -- | Draw the error dialog window, if it should be displayed right now.
 drawDialog :: AppState -> Widget Name
 drawDialog s = case s ^. uiState . uiModal of
-  Just (Modal mt d) -> renderDialog d (maybeScroll ModalViewport $ drawModal s mt)
+  Just (Modal mt d) -> renderDialog d $ case mt of
+    GoalModal -> drawModal s mt
+    _ -> maybeScroll ModalViewport $ drawModal s mt
   Nothing -> maybe emptyWidget renderErrorDialog (s ^. uiState . uiError)
 
--- | Make a widget scrolling if it is bigger than the available
---   vertical space.  Thanks to jtdaugherty for this code.
-maybeScroll :: (Ord n, Show n) => n -> Widget n -> Widget n
-maybeScroll vpName contents =
-  Widget Greedy Greedy $ do
-    ctx <- getContext
-    result <- withReaderT (availHeightL .~ 10000) (render contents)
-    if V.imageHeight (result ^. imageL) <= ctx ^. availHeightL
-      then return result
-      else
-        render $
-          withVScrollBars OnRight $
-            viewport vpName Vertical $
-              Widget Fixed Fixed $
-                return result
-
 -- | Draw one of the various types of modal dialog.
 drawModal :: AppState -> ModalType -> Widget Name
 drawModal s = \case
@@ -480,7 +464,7 @@ drawModal s = \case
           ]
   DescriptionModal e -> descriptionWidget s e
   QuitModal -> padBottom (Pad 1) $ hCenter $ txt (quitMsg (s ^. uiState . uiMenu))
-  GoalModal -> padLeftRight 1 $ GR.renderGoalsDisplay (s ^. uiState . uiGoal)
+  GoalModal -> GR.renderGoalsDisplay (s ^. uiState . uiGoal)
   KeepPlayingModal -> padLeftRight 1 (displayParagraphs ["Have fun!  Hit Ctrl-Q whenever you're ready to proceed to the next challenge or return to the menu."])
 
 robotsListWidget :: AppState -> Widget Name

src/Swarm/TUI/View/Util.hs

@@ -6,10 +6,12 @@ import Brick hiding (Direction)
 import Brick.Widgets.Dialog
 import Brick.Widgets.List qualified as BL
 import Control.Lens hiding (Const, from)
+import Control.Monad.Reader (withReaderT)
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Maybe (catMaybes, fromMaybe)
 import Data.Text (Text)
 import Data.Text qualified as T
+import Graphics.Vty qualified as V
 import Swarm.Game.Entity as E
 import Swarm.Game.Scenario (scenarioName)
 import Swarm.Game.ScenarioInfo (scenarioItemName)
@@ -135,3 +137,19 @@ withEllipsis t =
             then T.take (w - T.length ellipsis) t <> ellipsis
             else t
     render $ txt newText
+
+-- | Make a widget scrolling if it is bigger than the available
+--   vertical space.  Thanks to jtdaugherty for this code.
+maybeScroll :: (Ord n, Show n) => n -> Widget n -> Widget n
+maybeScroll vpName contents =
+  Widget Greedy Greedy $ do
+    ctx <- getContext
+    result <- withReaderT (availHeightL .~ 10000) (render contents)
+    if V.imageHeight (result ^. imageL) <= ctx ^. availHeightL
+      then return result
+      else
+        render $
+          withVScrollBars OnRight $
+            viewport vpName Vertical $
+              Widget Fixed Fixed $
+                return result