Scenario launch configuration dialog

Towards #358

src/Swarm/Game/Scenario/Launch/Controller.hs

@@ -0,0 +1,57 @@
+module Swarm.Game.Scenario.Launch.Controller where
+
+import Brick hiding (Direction, Location)
+import Brick.Focus
+import Brick.Widgets.Edit (handleEditorEvent)
+import Brick.Widgets.FileBrowser
+import Control.Lens
+import Control.Monad.Except
+import Graphics.Vty qualified as V
+import Swarm.Game.Scenario.Launch.Model
+import Swarm.Game.ScenarioInfo
+import Swarm.TUI.Controller.Util
+import Swarm.TUI.Model
+import Swarm.TUI.Model.Name
+import Swarm.TUI.Model.StateUpdate
+import Swarm.TUI.Model.UI
+
+handleLaunchOptionsEvent ::
+  ScenarioInfoPair ->
+  BrickEvent Name AppEvent ->
+  EventM Name AppState ()
+handleLaunchOptionsEvent siPair = \case
+  CharKey '\t' -> do
+    uiState . uiLaunchConfig . scenarioConfigFocusRing %= focusNext
+  Key V.KEnter -> do
+    fr <- use $ uiState . uiLaunchConfig . scenarioConfigFocusRing
+    case focusGetCurrent fr of
+      Just (ScenarioConfigControl (ScenarioConfigPanelControl item)) -> case item of
+        SeedSelector -> return ()
+        ScriptSelector -> do
+          fb <-
+            liftIO $
+              newFileBrowser
+                selectNonDirectories
+                (ScenarioConfigControl $ ScenarioConfigPanelControl ScriptSelector)
+                Nothing
+          uiState . uiLaunchConfig . fileBrowser .= Just fb
+        StartGameButton -> do
+          closeModal
+          startGame siPair Nothing
+      _ -> return ()
+  Key V.KEsc -> closeModal
+  CharKey 'q' -> closeModal
+  ControlChar 'q' -> closeModal
+  ev -> do
+    fr <- use $ uiState . uiLaunchConfig . scenarioConfigFocusRing
+    case focusGetCurrent fr of
+      Just (ScenarioConfigControl (ScenarioConfigPanelControl item)) -> case item of
+        SeedSelector -> Brick.zoom (uiState . uiLaunchConfig . seedValueEditor) (handleEditorEvent ev)
+        ScriptSelector -> case ev of
+          VtyEvent e ->
+            Brick.zoom (uiState . uiLaunchConfig . fileBrowser . _Just) (handleFileBrowserEvent e)
+          _ -> return ()
+        StartGameButton -> return ()
+      _ -> return ()
+ where
+  closeModal = uiState . uiLaunchConfig . isDisplayedFor .= Nothing

src/Swarm/Game/Scenario/Launch/Model.hs

@@ -0,0 +1,40 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Swarm.Game.Scenario.Launch.Model where
+
+import Brick.Focus qualified as Focus
+import Brick.Widgets.Edit
+import Brick.Widgets.FileBrowser qualified as FB
+import Control.Lens (makeLenses)
+import Data.Text (Text)
+import Swarm.Game.ScenarioInfo
+import Swarm.TUI.Model.Name
+import Swarm.Util (listEnums)
+
+newtype SeedSelection = SeedSelection
+  { _seedVal :: Int
+  }
+
+makeLenses ''SeedSelection
+
+-- | UI elements to configure scenario launch options
+data LaunchOptions = LaunchOptions
+  { _fileBrowser :: Maybe (FB.FileBrowser Name)
+  , _seedValueEditor :: Editor Text Name
+  , _scenarioConfigFocusRing :: Focus.FocusRing Name
+  , _isDisplayedFor :: Maybe ScenarioInfoPair
+  }
+
+makeLenses ''LaunchOptions
+
+initConfigPanel :: LaunchOptions
+initConfigPanel =
+  LaunchOptions Nothing myForm ring Nothing
+ where
+  myForm =
+    editorText
+      (ScenarioConfigControl $ ScenarioConfigPanelControl SeedSelector)
+      (Just 1)
+      "0"
+  ring = Focus.focusRing $ map (ScenarioConfigControl . ScenarioConfigPanelControl) listEnums

src/Swarm/Game/Scenario/Launch/View.hs

@@ -0,0 +1,65 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Swarm.Game.Scenario.Launch.View where
+
+import Brick
+import Brick.Focus
+import Brick.Forms qualified as BF
+import Brick.Widgets.Border
+import Brick.Widgets.Center (centerLayer, hCenter)
+import Brick.Widgets.Edit
+import Brick.Widgets.Edit qualified as E
+import Brick.Widgets.FileBrowser qualified as FB
+import Control.Exception qualified as E
+import Data.Text qualified as T
+import Swarm.Game.Scenario.Launch.Model
+import Swarm.TUI.Attr
+import Swarm.TUI.Model.Name
+
+drawFileBrowser :: FB.FileBrowser Name -> Widget Name
+drawFileBrowser b =
+  centerLayer $ ui <=> help
+ where
+  ui =
+    hCenter $
+      vLimit 15 $
+        hLimit 50 $
+          borderWithLabel (txt "Choose a file") $
+            FB.renderFileBrowser True b
+  help =
+    padTop (Pad 1) $
+      vBox
+        [ case FB.fileBrowserException b of
+            Nothing -> emptyWidget
+            Just e ->
+              hCenter $
+                withDefAttr BF.invalidFormInputAttr $
+                  txt $
+                    T.pack $
+                      E.displayException e
+        , hCenter $ txt "Up/Down: select"
+        , hCenter $ txt "/: search, Ctrl-C or Esc: cancel search"
+        , hCenter $ txt "Enter: change directory or select file"
+        , hCenter $ txt "Esc: quit"
+        ]
+
+drawLaunchConfigPanel :: LaunchOptions -> [Widget Name]
+drawLaunchConfigPanel (LaunchOptions maybeFileBrowser seedEditor ring _isDisplayedFor) = case maybeFileBrowser of
+  Nothing -> [panelWidget]
+  Just fb -> [drawFileBrowser fb, panelWidget]
+ where
+  seedEditorHasFocus = case focusGetCurrent ring of
+    Just (ScenarioConfigControl (ScenarioConfigPanelControl SeedSelector)) -> True
+    _ -> False
+
+  panelWidget =
+    centerLayer $
+      borderWithLabel (str "Configure scenario") $
+        hLimit 50 $
+          vBox
+            [ padAll 1 $ txt "Hello there!"
+            , overrideAttr E.editFocusedAttr customEditFocusedAttr $
+                renderEditor (txt . mconcat) seedEditorHasFocus seedEditor
+            , hCenter $ str "Select script"
+            , hCenter $ str "Launch"
+            ]

src/Swarm/TUI/Attr.hs

@@ -48,11 +48,13 @@ module Swarm.TUI.Attr (
   greenAttr,
   redAttr,
   defAttr,
+  customEditFocusedAttr,
 ) where
 
 import Brick
 import Brick.Forms
 import Brick.Widgets.Dialog
+import Brick.Widgets.Edit qualified as E
 import Brick.Widgets.List
 import Data.Bifunctor (bimap)
 import Data.Yaml
@@ -73,6 +75,7 @@ swarmAttrMap =
            (highlightAttr, fg V.cyan)
          , (invalidFormInputAttr, fg V.red)
          , (focusedFormInputAttr, V.defAttr)
+         , (customEditFocusedAttr, V.black `on` V.yellow)
          , (listSelectedFocusedAttr, bg V.blue)
          , (infoAttr, fg (V.rgbColor @Int 50 50 50))
          , (buttonSelectedAttr, bg V.blue)
@@ -174,6 +177,9 @@ cyanAttr = attrName "cyan"
 lightCyanAttr = attrName "lightCyan"
 magentaAttr = attrName "magenta"
 
+customEditFocusedAttr :: AttrName
+customEditFocusedAttr = attrName "custom" <> E.editFocusedAttr
+
 instance ToJSON AttrName where
   toJSON = toJSON . head . attrNameComponents
 

src/Swarm/TUI/Controller.hs

@@ -70,6 +70,8 @@ import Linear
 import Swarm.Game.CESK (cancel, emptyStore, initMachine)
 import Swarm.Game.Entity hiding (empty)
 import Swarm.Game.Robot
+import Swarm.Game.Scenario.Launch.Controller
+import Swarm.Game.Scenario.Launch.Model
 import Swarm.Game.Scenario.Objective.Presentation.Model
 import Swarm.Game.Scenario.Objective.Presentation.Render qualified as GR
 import Swarm.Game.ScenarioInfo
@@ -131,7 +133,9 @@ handleEvent = \case
           -- quitGame function would have already halted the app).
           NoMenu -> const halt
           MainMenu l -> handleMainMenuEvent l
-          NewGameMenu l -> handleNewGameMenuEvent l
+          NewGameMenu l -> case s ^. uiState . uiLaunchConfig . isDisplayedFor of
+            Nothing -> handleNewGameMenuEvent l
+            Just siPair -> handleLaunchOptionsEvent siPair
           MessagesMenu -> handleMainMessagesEvent
           AchievementsMenu l -> handleMainAchievementsEvent l
           AboutMenu -> pressAnyKey (MainMenu (mainMenu About))
@@ -194,7 +198,9 @@ getTutorials sc = case M.lookup tutorialsDirname (scMap sc) of
 --   menu item is always the same as the currently played scenario!  `quitGame`
 --   is the only place this function should be called.
 advanceMenu :: Menu -> Menu
-advanceMenu = _NewGameMenu . ix 0 %~ BL.listMoveDown
+advanceMenu m = case m of
+  NewGameMenu (z :| zs) -> NewGameMenu (BL.listMoveDown z :| zs)
+  _ -> m
 
 handleMainAchievementsEvent ::
   BL.List Name CategorizedAchievement ->
@@ -220,7 +226,18 @@ handleMainMessagesEvent = \case
  where
   returnToMainMenu = uiState . uiMenu .= MainMenu (mainMenu Messages)
 
-handleNewGameMenuEvent :: NonEmpty (BL.List Name ScenarioItem) -> BrickEvent Name AppEvent -> EventM Name AppState ()
+-- | TODO: Don't prompt if the scenario is a tutorial.
+prepareGameStart ::
+  ScenarioInfoPair ->
+  EventM Name AppState ()
+prepareGameStart siPair = do
+  uiState . uiLaunchConfig . isDisplayedFor .= Just siPair
+  return ()
+
+handleNewGameMenuEvent ::
+  NonEmpty (BL.List Name ScenarioItem) ->
+  BrickEvent Name AppEvent ->
+  EventM Name AppState ()
 handleNewGameMenuEvent scenarioStack@(curMenu :| rest) = \case
   Key V.KEnter ->
     case snd <$> BL.listSelectedElement curMenu of
@@ -229,6 +246,9 @@ handleNewGameMenuEvent scenarioStack@(curMenu :| rest) = \case
       Just (SICollection _ c) -> do
         cheat <- use $ uiState . uiCheatMode
         uiState . uiMenu .= NewGameMenu (NE.cons (mkScenarioList cheat c) scenarioStack)
+  CharKey 'o' -> case snd <$> BL.listSelectedElement curMenu of
+    Just (SISingle siPair) -> prepareGameStart siPair
+    _ -> continueWithoutRedraw
   Key V.KEsc -> exitNewGameMenu scenarioStack
   CharKey 'q' -> exitNewGameMenu scenarioStack
   ControlChar 'q' -> halt
@@ -464,7 +484,13 @@ saveScenarioInfoOnQuit = do
         -- See what scenario is currently focused in the menu.  Depending on how the
         -- previous scenario ended (via quit vs. via win), it might be the same as
         -- currentScenarioPath or it might be different.
-        curPath <- preuse $ uiState . uiMenu . _NewGameMenu . ix 0 . BL.listSelectedElementL . _SISingle . _2 . scenarioPath
+        uim <- preuse $ uiState . uiMenu
+        let curPath = case uim of
+              Just (NewGameMenu (z :| _)) ->
+                case BL.listSelectedElement z of
+                  Just (_, SISingle (_, sInfo)) -> Just $ _scenarioPath sInfo
+                  _ -> Nothing
+              _ -> Nothing
         -- Now rebuild the NewGameMenu so it gets the updated ScenarioInfo,
         -- being sure to preserve the same focused scenario.
         sc <- use $ gameState . scenarios

src/Swarm/TUI/Model/Menu.hs

@@ -72,9 +72,10 @@ data MainMenuEntry
   deriving (Eq, Ord, Show, Read, Bounded, Enum)
 
 data Menu
-  = NoMenu -- We started playing directly from command line, no menu to show
+  = -- | We started playing directly from command line, no menu to show
+    NoMenu
   | MainMenu (BL.List Name MainMenuEntry)
-  | -- Stack of scenario item lists. INVARIANT: the currently selected
+  | -- | Stack of scenario item lists. INVARIANT: the currently selected
     -- menu item is ALWAYS the same as the scenario currently being played.
     -- See https://github.com/swarm-game/swarm/issues/1064 and
     -- https://github.com/swarm-game/swarm/pull/1065.
@@ -98,9 +99,15 @@ mkScenarioList cheat = flip (BL.list ScenarioList) 1 . V.fromList . filterTest .
 --   path to some folder or scenario, construct a 'NewGameMenu' stack
 --   focused on the given item, if possible.
 mkNewGameMenu :: Bool -> ScenarioCollection -> FilePath -> Maybe Menu
-mkNewGameMenu cheat sc path = NewGameMenu . NE.fromList <$> go (Just sc) (splitPath path) []
+mkNewGameMenu cheat sc path = do
+  theList <- NE.fromList <$> go (Just sc) (splitPath path) []
+  return $ NewGameMenu theList
  where
-  go :: Maybe ScenarioCollection -> [FilePath] -> [BL.List Name ScenarioItem] -> Maybe [BL.List Name ScenarioItem]
+  go ::
+    Maybe ScenarioCollection ->
+    [FilePath] ->
+    [BL.List Name ScenarioItem] ->
+    Maybe [BL.List Name ScenarioItem]
   go _ [] stk = Just stk
   go Nothing _ _ = Nothing
   go (Just curSC) (thing : rest) stk = go nextSC rest (lst : stk)

src/Swarm/TUI/Model/Name.hs

@@ -11,6 +11,18 @@ data FocusablePanel
     InfoPanel
   deriving (Eq, Ord, Show, Read, Bounded, Enum)
 
+data ScenarioConfigPanel
+  = ScenarioConfigFileSelector
+  | ScenarioConfigPanelControl ScenarioConfigPanelFocusable
+  deriving (Eq, Ord, Show, Read)
+
+data ScenarioConfigPanelFocusable
+  = SeedSelector
+  | -- | The file selector for launching a scenario with a script
+    ScriptSelector
+  | StartGameButton
+  deriving (Eq, Ord, Show, Read, Bounded, Enum)
+
 data GoalWidget
   = ObjectivesList
   | GoalSummary
@@ -44,6 +56,8 @@ data Name
     MenuList
   | -- | The list of achievements.
     AchievementList
+  | -- | An individual control within the scenario launch config panel
+    ScenarioConfigControl ScenarioConfigPanel
   | -- | The list of goals/objectives.
     GoalWidgets GoalWidget
   | -- | The list of scenario choices.

src/Swarm/TUI/Model/UI.hs

@@ -11,6 +11,7 @@ module Swarm.TUI.Model.UI (
   uiPlaying,
   uiCheatMode,
   uiFocusRing,
+  uiLaunchConfig,
   uiWorldCursor,
   uiREPL,
   uiInventory,
@@ -57,6 +58,7 @@ import Data.Map (Map)
 import Data.Map qualified as M
 import Data.Text (Text)
 import Data.Text qualified as T
+import Swarm.Game.Scenario.Launch.Model
 import Swarm.Game.Scenario.Objective.Presentation.Model
 import Swarm.Game.ScenarioInfo (
   ScenarioInfoPair,
@@ -85,6 +87,7 @@ data UIState = UIState
   , _uiPlaying :: Bool
   , _uiCheatMode :: Bool
   , _uiFocusRing :: FocusRing Name
+  , _uiLaunchConfig :: LaunchOptions
   , _uiWorldCursor :: Maybe W.Coords
   , _uiREPL :: REPLState
   , _uiInventory :: Maybe (Int, BL.List Name InventoryListEntry)
@@ -137,6 +140,9 @@ uiPlaying :: Lens' UIState Bool
 -- | Cheat mode, i.e. are we allowed to turn creative mode on and off?
 uiCheatMode :: Lens' UIState Bool
 
+-- | Configuration modal when launching a scenario
+uiLaunchConfig :: Lens' UIState LaunchOptions
+
 -- | The focus ring is the set of UI panels we can cycle among using
 --   the Tab key.
 uiFocusRing :: Lens' UIState (FocusRing Name)
@@ -280,6 +286,7 @@ initUIState showMainMenu cheatMode = do
           { _uiMenu = if showMainMenu then MainMenu (mainMenu NewGame) else NoMenu
           , _uiPlaying = not showMainMenu
           , _uiCheatMode = cheatMode
+          , _uiLaunchConfig = initConfigPanel
           , _uiFocusRing = initFocusRing
           , _uiWorldCursor = Nothing
           , _uiREPL = initREPLState $ newREPLHistory history