Scenario launch configuration dialog

Towards #358

src/Swarm/Game/State.hs

@@ -90,6 +90,7 @@ module Swarm.Game.State (
   CodeToRun (..),
   Sha1 (..),
   SolutionSource (..),
+  parseCodeFile,
   getParsedInitialCode,
 
   -- * Utilities
@@ -293,25 +294,28 @@ data SolutionSource
 
 data CodeToRun = CodeToRun SolutionSource ProcessedTerm
 
-getParsedInitialCode :: Maybe FilePath -> ExceptT Text IO (Maybe CodeToRun)
-getParsedInitialCode toRun = case toRun of
-  Nothing -> return Nothing
-  Just filepath -> do
-    contents <- liftIO $ TIO.readFile filepath
+parseCodeFile :: FilePath -> IO (Either Text CodeToRun)
+parseCodeFile filepath = do
+  contents <- TIO.readFile filepath
+  return $ do
     pt@(ProcessedTerm (Module (Syntax' srcLoc _ _) _) _ _) <-
-      ExceptT
-        . return
-        . left T.pack
-        $ processTermEither contents
+      left T.pack $ processTermEither contents
     let strippedText = stripSrc srcLoc contents
         programBytestring = TL.encodeUtf8 $ TL.fromStrict strippedText
         sha1Hash = showDigest $ sha1 programBytestring
-    return $ Just $ CodeToRun (PlayerAuthored $ Sha1 sha1Hash) pt
+    return $ CodeToRun (PlayerAuthored $ Sha1 sha1Hash) pt
  where
   stripSrc :: SrcLoc -> Text -> Text
   stripSrc (SrcLoc start end) txt = T.drop start $ T.take end txt
   stripSrc NoLoc txt = txt
 
+getParsedInitialCode :: Maybe FilePath -> ExceptT Text IO (Maybe CodeToRun)
+getParsedInitialCode toRun = case toRun of
+  Nothing -> return Nothing
+  Just filepath -> do
+    parsedCode <- ExceptT $ parseCodeFile filepath
+    return $ Just parsedCode
+
 ------------------------------------------------------------
 -- The main GameState record type
 ------------------------------------------------------------

src/Swarm/TUI/Attr.hs

@@ -44,11 +44,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.Text (unpack)
@@ -77,6 +79,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)
@@ -168,6 +171,9 @@ boldAttr = attrName "bold"
 dimAttr = attrName "dim"
 defAttr = attrName "def"
 
+customEditFocusedAttr :: AttrName
+customEditFocusedAttr = attrName "custom" <> E.editFocusedAttr
+
 -- | Some basic colors used in TUI.
 redAttr, greenAttr, blueAttr, yellowAttr, cyanAttr, lightCyanAttr, magentaAttr :: AttrName
 redAttr = attrName "red"

src/Swarm/TUI/Controller.hs

@@ -93,6 +93,8 @@ import Swarm.Language.Types
 import Swarm.Language.Value (Value (VKey, VUnit), prettyValue, stripVResult)
 import Swarm.TUI.Controller.Util
 import Swarm.TUI.Inventory.Sorting (cycleSortDirection, cycleSortOrder)
+import Swarm.TUI.Launch.Controller
+import Swarm.TUI.Launch.Model
 import Swarm.TUI.List
 import Swarm.TUI.Model
 import Swarm.TUI.Model.Goal
@@ -133,7 +135,12 @@ handleEvent = \case
           -- quitGame function would have already halted the app).
           NoMenu -> const halt
           MainMenu l -> handleMainMenuEvent l
-          NewGameMenu l -> handleNewGameMenuEvent l
+          NewGameMenu l ->
+            if s ^. uiState . uiLaunchConfig . controls . fileBrowser . fbIsDisplayed
+              then handleFBEvent
+              else case s ^. uiState . uiLaunchConfig . controls . isDisplayedFor of
+                Nothing -> handleNewGameMenuEvent l
+                Just siPair -> handleLaunchOptionsEvent siPair
           MessagesMenu -> handleMainMessagesEvent
           AchievementsMenu l -> handleMainAchievementsEvent l
           AboutMenu -> pressAnyKey (MainMenu (mainMenu About))
@@ -196,7 +203,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 ->
@@ -222,7 +231,16 @@ handleMainMessagesEvent = \case
  where
   returnToMainMenu = uiState . uiMenu .= MainMenu (mainMenu Messages)
 
-handleNewGameMenuEvent :: NonEmpty (BL.List Name ScenarioItem) -> BrickEvent Name AppEvent -> EventM Name AppState ()
+prepareGameStart ::
+  ScenarioInfoPair ->
+  EventM Name AppState ()
+prepareGameStart siPair = do
+  uiState . uiLaunchConfig . controls . isDisplayedFor .= Just siPair
+
+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
@@ -231,6 +249,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
@@ -456,7 +477,7 @@ getNormalizedCurrentScenarioPath =
 
 saveScenarioInfoOnFinish :: (MonadIO m, MonadState AppState m) => FilePath -> m (Maybe ScenarioInfo)
 saveScenarioInfoOnFinish p = do
-  initialCode <- use $ gameState . initiallyRunCode
+  initialRunCode <- use $ gameState . initiallyRunCode
   t <- liftIO getZonedTime
   wc <- use $ gameState . winCondition
   let won = case wc of
@@ -471,7 +492,7 @@ saveScenarioInfoOnFinish p = do
       currentScenarioInfo = gameState . scenarios . scenarioItemByPath p . _SISingle . _2
 
   replHist <- use $ uiState . uiREPL . replHistory
-  let determinator = CodeSizeDeterminators initialCode $ replHist ^. replHasExecutedManualInput
+  let determinator = CodeSizeDeterminators initialRunCode $ replHist ^. replHasExecutedManualInput
   currentScenarioInfo
     %= updateScenarioInfoOnFinish determinator t ts won
   status <- preuse currentScenarioInfo
@@ -527,7 +548,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/Launch/Controller.hs

@@ -0,0 +1,82 @@
+module Swarm.TUI.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 (liftIO)
+import Graphics.Vty qualified as V
+import Swarm.Game.ScenarioInfo
+import Swarm.TUI.Controller.Util
+import Swarm.TUI.Launch.Model
+import Swarm.TUI.Launch.Prep (toValidatedParms)
+import Swarm.TUI.Model
+import Swarm.TUI.Model.Name
+import Swarm.TUI.Model.StateUpdate
+import Swarm.TUI.Model.UI
+
+cacheValidatedInputs :: EventM Name AppState ()
+cacheValidatedInputs = do
+  launchControls <- use $ uiState . uiLaunchConfig . controls
+  eitherLaunchParams <- liftIO $ toValidatedParms launchControls
+  uiState . uiLaunchConfig . validatedParams .= eitherLaunchParams
+
+handleFBEvent ::
+  BrickEvent Name AppEvent ->
+  EventM Name AppState ()
+handleFBEvent = \case
+  Key V.KEsc -> closeModal
+  CharKey 'q' -> closeModal
+  ControlChar 'q' -> closeModal
+  VtyEvent e ->
+    Brick.zoom (uiState . uiLaunchConfig . controls . fileBrowser . fbWidget) (handleFileBrowserEvent e)
+  _ -> return ()
+ where
+  closeModal = do
+    uiState . uiLaunchConfig . controls . fileBrowser . fbIsDisplayed .= False
+    cacheValidatedInputs
+
+handleLaunchOptionsEvent ::
+  ScenarioInfoPair ->
+  BrickEvent Name AppEvent ->
+  EventM Name AppState ()
+handleLaunchOptionsEvent siPair = \case
+  Key V.KBackTab ->
+    uiState . uiLaunchConfig . controls . scenarioConfigFocusRing %= focusPrev
+  Key V.KUp ->
+    uiState . uiLaunchConfig . controls . scenarioConfigFocusRing %= focusPrev
+  CharKey '\t' ->
+    uiState . uiLaunchConfig . controls . scenarioConfigFocusRing %= focusNext
+  Key V.KDown ->
+    uiState . uiLaunchConfig . controls . scenarioConfigFocusRing %= focusNext
+  CharKey ' ' -> activateControl
+  Key V.KEnter -> activateControl
+  Key V.KEsc -> closeModal
+  CharKey 'q' -> closeModal
+  ControlChar 'q' -> closeModal
+  ev -> do
+    fr <- use $ uiState . uiLaunchConfig . controls . scenarioConfigFocusRing
+    case focusGetCurrent fr of
+      Just (ScenarioConfigControl (ScenarioConfigPanelControl SeedSelector)) -> do
+        Brick.zoom (uiState . uiLaunchConfig . controls . seedValueEditor) (handleEditorEvent ev)
+        cacheValidatedInputs
+      _ -> return ()
+ where
+  activateControl = do
+    fr <- use $ uiState . uiLaunchConfig . controls . scenarioConfigFocusRing
+    case focusGetCurrent fr of
+      Just (ScenarioConfigControl (ScenarioConfigPanelControl item)) -> case item of
+        SeedSelector -> return ()
+        ScriptSelector ->
+          uiState . uiLaunchConfig . controls . fileBrowser . fbIsDisplayed .= True
+        StartGameButton -> do
+          eitherLaunchParams <- use $ uiState . uiLaunchConfig . validatedParams
+          case eitherLaunchParams of
+            Left _ -> return ()
+            Right launchParams -> do
+              closeModal
+              startGameWithSeed siPair launchParams
+      _ -> return ()
+
+  closeModal = uiState . uiLaunchConfig . controls . isDisplayedFor .= Nothing

src/Swarm/TUI/Launch/Model.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Swarm.TUI.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.Game.State (CodeToRun)
+import Swarm.Game.WorldGen (Seed)
+import Swarm.TUI.Model.Name
+
+data ValidatedLaunchParms = ValidatedLaunchParms
+  { seedVal :: Maybe Seed
+  , initialCode :: Maybe CodeToRun
+  }
+
+data FileBrowserControl = FileBrowserControl
+  { _fbWidget :: FB.FileBrowser Name
+  , _fbIsDisplayed :: Bool
+  }
+
+makeLenses ''FileBrowserControl
+
+-- | UI elements to configure scenario launch options
+data LaunchControls = LaunchControls
+  { _fileBrowser :: FileBrowserControl
+  , _seedValueEditor :: Editor Text Name
+  , _scenarioConfigFocusRing :: Focus.FocusRing Name
+  , _isDisplayedFor :: Maybe ScenarioInfoPair
+  }
+
+makeLenses ''LaunchControls
+
+data LaunchFormError = LaunchFormError
+  { widget :: ScenarioConfigPanelFocusable
+  , message :: Text
+  }
+
+-- | UI elements to configure scenario launch options
+data LaunchOptions = LaunchOptions
+  { _controls :: LaunchControls
+  , _validatedParams :: Either LaunchFormError ValidatedLaunchParms
+  }
+
+makeLenses ''LaunchOptions

src/Swarm/TUI/Launch/Prep.hs

@@ -0,0 +1,57 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Prepares and validates scenario launch parameters
+module Swarm.TUI.Launch.Prep where
+
+import Brick.Focus qualified as Focus
+import Brick.Widgets.Edit
+import Brick.Widgets.FileBrowser qualified as FB
+import Control.Arrow (left)
+import Control.Monad.Trans.Except (ExceptT (..), except, runExceptT, withExceptT)
+import Data.Maybe (listToMaybe)
+import Data.Text qualified as T
+import Swarm.Game.State (parseCodeFile)
+import Swarm.TUI.Launch.Model
+import Swarm.TUI.Model.Name
+import Swarm.Util (listEnums)
+import Text.Read (readEither)
+
+toValidatedParms :: LaunchControls -> IO (Either LaunchFormError ValidatedLaunchParms)
+toValidatedParms (LaunchControls (FileBrowserControl fb _) seedEditor _ _) = runExceptT $ do
+  maybeParsedCode <- case maybeSelectedFile of
+    Nothing -> return Nothing
+    Just filePath -> do
+      code <- withExceptT (LaunchFormError ScriptSelector) $ ExceptT $ parseCodeFile filePath
+      return $ Just code
+
+  maybeSeed <-
+    if T.null seedFieldText
+      then return Nothing
+      else do
+        val <- withExceptT (LaunchFormError SeedSelector) . except . left T.pack . readEither $ T.unpack seedFieldText
+        return $ Just val
+
+  return $ ValidatedLaunchParms maybeSeed maybeParsedCode
+ where
+  seedFieldText = mconcat $ getEditContents seedEditor
+  maybeSelectedFile =
+    FB.fileInfoFilePath
+      <$> listToMaybe (FB.fileBrowserSelection fb)
+
+initConfigPanel :: IO LaunchOptions
+initConfigPanel = do
+  fb <-
+    FB.newFileBrowser
+      FB.selectNonDirectories
+      -- (const False)
+      (ScenarioConfigControl $ ScenarioConfigPanelControl ScriptSelector)
+      Nothing
+  let configuredFB = FB.setFileBrowserEntryFilter (Just $ FB.fileExtensionMatch "sw") fb
+  return $ LaunchOptions (LaunchControls (FileBrowserControl configuredFB False) myForm ring Nothing) (Right $ ValidatedLaunchParms Nothing Nothing)
+ where
+  myForm =
+    editorText
+      (ScenarioConfigControl $ ScenarioConfigPanelControl SeedSelector)
+      (Just 1)
+      ""
+  ring = Focus.focusRing $ map (ScenarioConfigControl . ScenarioConfigPanelControl) listEnums