From 8ee967cf30940b864fedde28ed3375bf3a0cb44b Mon Sep 17 00:00:00 2001 From: Karl Ostmo Date: Sun, 15 Jan 2023 00:30:30 -0800 Subject: [PATCH] Scenario launch configuration dialog Towards #358 --- src/Swarm/Game/State.hs | 24 ++--- src/Swarm/TUI/Attr.hs | 6 ++ src/Swarm/TUI/Controller.hs | 41 +++++++-- src/Swarm/TUI/Launch/Controller.hs | 74 +++++++++++++++ src/Swarm/TUI/Launch/Model.hs | 44 +++++++++ src/Swarm/TUI/Launch/Prep.hs | 58 ++++++++++++ src/Swarm/TUI/Launch/View.hs | 140 +++++++++++++++++++++++++++++ src/Swarm/TUI/Model/Menu.hs | 15 +++- src/Swarm/TUI/Model/Name.hs | 14 +++ src/Swarm/TUI/Model/StateUpdate.hs | 13 +-- src/Swarm/TUI/Model/UI.hs | 9 ++ src/Swarm/TUI/View.hs | 59 ++++++++---- swarm.cabal | 4 + 13 files changed, 458 insertions(+), 43 deletions(-) create mode 100644 src/Swarm/TUI/Launch/Controller.hs create mode 100644 src/Swarm/TUI/Launch/Model.hs create mode 100644 src/Swarm/TUI/Launch/Prep.hs create mode 100644 src/Swarm/TUI/Launch/View.hs diff --git a/src/Swarm/Game/State.hs b/src/Swarm/Game/State.hs index b1daaed4c3..080c8ef726 100644 --- a/src/Swarm/Game/State.hs +++ b/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 ------------------------------------------------------------ diff --git a/src/Swarm/TUI/Attr.hs b/src/Swarm/TUI/Attr.hs index 7ab64990b4..9251afd151 100644 --- a/src/Swarm/TUI/Attr.hs +++ b/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" diff --git a/src/Swarm/TUI/Controller.hs b/src/Swarm/TUI/Controller.hs index 7b9a4ba378..9335db37e1 100644 --- a/src/Swarm/TUI/Controller.hs +++ b/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,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 . controls . 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 @@ -231,6 +251,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 +487,7 @@ saveScenarioInfoOnFinish = do getNormalizedCurrentScenarioPath >>= \case Nothing -> return () Just p -> do - initialCode <- use $ gameState . initiallyRunCode + initialRunCode <- use $ gameState . initiallyRunCode t <- liftIO getZonedTime wc <- use $ gameState . winCondition let won = case wc of @@ -475,7 +498,7 @@ saveScenarioInfoOnFinish = 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 @@ -503,7 +526,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 diff --git a/src/Swarm/TUI/Launch/Controller.hs b/src/Swarm/TUI/Launch/Controller.hs new file mode 100644 index 0000000000..d03a531247 --- /dev/null +++ b/src/Swarm/TUI/Launch/Controller.hs @@ -0,0 +1,74 @@ +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 + +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 = uiState . uiLaunchConfig . controls . fileBrowser . fbIsDisplayed .= False + +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)) -> + Brick.zoom (uiState . uiLaunchConfig . controls . seedValueEditor) (handleEditorEvent ev) + _ -> 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 + launchControls <- use $ uiState . uiLaunchConfig . controls + eitherLaunchParams <- liftIO $ toValidatedParms launchControls + case eitherLaunchParams of + Left errMsg -> return () -- TODO FIXME + Right launchParams -> do + closeModal + startGameWithSeed siPair launchParams + _ -> return () + + closeModal = uiState . uiLaunchConfig . controls . isDisplayedFor .= Nothing diff --git a/src/Swarm/TUI/Launch/Model.hs b/src/Swarm/TUI/Launch/Model.hs new file mode 100644 index 0000000000..1d1d9e97df --- /dev/null +++ b/src/Swarm/TUI/Launch/Model.hs @@ -0,0 +1,44 @@ +{-# 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 + +-- | UI elements to configure scenario launch options +data LaunchOptions = LaunchOptions + { _controls :: LaunchControls + , _validatedParams :: ValidatedLaunchParms + } + +makeLenses ''LaunchOptions diff --git a/src/Swarm/TUI/Launch/Prep.hs b/src/Swarm/TUI/Launch/Prep.hs new file mode 100644 index 0000000000..6908114742 --- /dev/null +++ b/src/Swarm/TUI/Launch/Prep.hs @@ -0,0 +1,58 @@ +{-# 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) +import Data.Maybe (listToMaybe) +import Data.Text (Text) +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 Text ValidatedLaunchParms) +toValidatedParms (LaunchControls (FileBrowserControl fb _) seedEditor _ _) = runExceptT $ do + maybeParsedCode <- case maybeSelectedFile of + Nothing -> return Nothing + Just filePath -> do + code <- ExceptT $ parseCodeFile filePath + return $ Just code + + maybeSeed <- + if T.null seedFieldText + then return Nothing + else do + val <- 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) (ValidatedLaunchParms Nothing Nothing) + where + myForm = + editorText + (ScenarioConfigControl $ ScenarioConfigPanelControl SeedSelector) + (Just 1) + "" + ring = Focus.focusRing $ map (ScenarioConfigControl . ScenarioConfigPanelControl) listEnums diff --git a/src/Swarm/TUI/Launch/View.hs b/src/Swarm/TUI/Launch/View.hs new file mode 100644 index 0000000000..e7d6fcfde9 --- /dev/null +++ b/src/Swarm/TUI/Launch/View.hs @@ -0,0 +1,140 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Swarm.TUI.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 Control.Lens +import Data.Maybe (listToMaybe) +import Data.Text (Text) +import Data.Text qualified as T +import Swarm.Game.Scenario (scenarioSeed) +import Swarm.TUI.Attr +import Swarm.TUI.Launch.Model +import Swarm.TUI.Model.Name + +drawFileBrowser :: FB.FileBrowser Name -> Widget Name +drawFileBrowser b = + centerLayer $ hLimit 50 $ ui <=> help + where + ui = + vLimit 15 $ + borderWithLabel (txt "Choose a file") $ + FB.renderFileBrowser True b + + footerRows = + map + (hCenter . txt) + [ "Up/Down: select" + , "/: search, Ctrl-C or Esc: cancel search" + , "Enter: change directory or select file" + , "Esc: quit" + ] + + help = + padTop (Pad 1) $ + vBox $ + [ case FB.fileBrowserException b of + Nothing -> emptyWidget + Just e -> + hCenter $ + withDefAttr BF.invalidFormInputAttr $ + txt $ + T.pack $ + E.displayException e + ] + <> footerRows + +optionDescription :: ScenarioConfigPanelFocusable -> Maybe Text +optionDescription = \case + SeedSelector -> Just "Leaving this field blank will use the default seed for the scenario." + ScriptSelector -> Just "Selecting a script to be run upon start permits eligibility for code size scoring." + StartGameButton -> Nothing + +drawLaunchConfigPanel :: LaunchOptions -> [Widget Name] +drawLaunchConfigPanel (LaunchOptions (LaunchControls (FileBrowserControl fb isFbDisplayed) seedEditor ring displayedFor) _validatedOptions) = + addFileBrowser [panelWidget] + where + addFileBrowser = + if isFbDisplayed + then (drawFileBrowser fb :) + else id + + getFocusedConfigPanel :: Maybe ScenarioConfigPanelFocusable + getFocusedConfigPanel = case focusGetCurrent ring of + Just (ScenarioConfigControl (ScenarioConfigPanelControl x)) -> Just x + _ -> Nothing + + isFocused = (== getFocusedConfigPanel) . Just + + highlightIfFocused x = + if isFocused x + then withDefAttr highlightAttr + else id + + mkButton name label = highlightIfFocused name $ withAttr boldAttr $ str label + + seedEntryContent = mconcat $ getEditContents seedEditor + scenarioSeedText = maybe "random" show $ view scenarioSeed . fst =<< displayedFor + seedEntryWidget = + if T.null seedEntryContent && not (isFocused SeedSelector) + then str $ unwords ["scenario default", "(" <> scenarioSeedText <> ")"] + else + hLimit 10 $ + overrideAttr E.editFocusedAttr customEditFocusedAttr $ + renderEditor (txt . mconcat) (isFocused SeedSelector) seedEditor + + unspecifiedFileMessage = + if isFocused ScriptSelector + then withAttr highlightAttr $ str "<[Enter] to select>" + else str "" + fileEntryWidget = + maybe unspecifiedFileMessage (str . FB.fileInfoSanitizedFilename) $ + listToMaybe $ + FB.fileBrowserSelection fb + + panelWidget = + centerLayer $ + borderWithLabel (str " Configure scenario launch ") $ + hLimit 60 $ + padAll 1 $ + vBox + [ controlsBox + , descriptionBox + , hCenter $ mkButton StartGameButton ">> Launch with these settings <<" + ] + where + descriptionBox = vLimit 4 $ + padBottom Max $ + padRight (Pad 2) $ + case optionDescription =<< getFocusedConfigPanel of + Just desc -> + withDefAttr dimAttr $ + hBox + [ padLeft (Pad 6) $ withAttr boldAttr $ str "[Info]" + , padLeft (Pad 1) $ txtWrap desc + ] + Nothing -> str " " + + controlsBox = + vBox + [ padBottom (Pad 1) $ + padLeft (Pad 2) $ + hBox + [ mkButton SeedSelector "Seed: " + , seedEntryWidget + ] + , padBottom (Pad 1) $ + padLeft (Pad 2) $ + hBox + [ mkButton ScriptSelector "Script: " + , fileEntryWidget + ] + ] diff --git a/src/Swarm/TUI/Model/Menu.hs b/src/Swarm/TUI/Model/Menu.hs index be9afccb82..7294896119 100644 --- a/src/Swarm/TUI/Model/Menu.hs +++ b/src/Swarm/TUI/Model/Menu.hs @@ -76,9 +76,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. @@ -102,9 +103,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) diff --git a/src/Swarm/TUI/Model/Name.hs b/src/Swarm/TUI/Model/Name.hs index 688a16e48e..f654103be3 100644 --- a/src/Swarm/TUI/Model/Name.hs +++ b/src/Swarm/TUI/Model/Name.hs @@ -13,6 +13,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 @@ -46,6 +58,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. diff --git a/src/Swarm/TUI/Model/StateUpdate.hs b/src/Swarm/TUI/Model/StateUpdate.hs index d895a01d73..bb175fbd8e 100644 --- a/src/Swarm/TUI/Model/StateUpdate.hs +++ b/src/Swarm/TUI/Model/StateUpdate.hs @@ -6,6 +6,7 @@ module Swarm.TUI.Model.StateUpdate ( initAppState, startGame, + startGameWithSeed, restartGame, attainAchievement, attainAchievement', @@ -42,6 +43,7 @@ import Swarm.Game.ScenarioInfo ( import Swarm.Game.State import Swarm.TUI.Attr (swarmAttrMap) import Swarm.TUI.Inventory.Sorting +import Swarm.TUI.Launch.Model (ValidatedLaunchParms (..)) import Swarm.TUI.Model import Swarm.TUI.Model.Goal (emptyGoalDisplay) import Swarm.TUI.Model.Repl @@ -76,12 +78,12 @@ initAppState AppOpts {..} = do Right x -> (x, rs) Left e -> (ScenarioInfo path NotStarted, addWarnings rs e) execStateT - (startGameWithSeed userSeed (scenario, si) codeToRun) + (startGameWithSeed (scenario, si) $ ValidatedLaunchParms userSeed codeToRun) (AppState gs ui newRs) -- | Load a 'Scenario' and start playing the game. startGame :: (MonadIO m, MonadState AppState m) => ScenarioInfoPair -> Maybe CodeToRun -> m () -startGame = startGameWithSeed Nothing +startGame siPair = startGameWithSeed siPair . ValidatedLaunchParms Nothing -- | Re-initialize the game from the stored reference to the current scenario. -- @@ -93,7 +95,7 @@ startGame = startGameWithSeed Nothing -- Since scenarios are stored as a Maybe in the UI state, we handle the Nothing -- case upstream so that the Scenario passed to this function definitely exists. restartGame :: (MonadIO m, MonadState AppState m) => Seed -> ScenarioInfoPair -> m () -restartGame currentSeed siPair = startGameWithSeed (Just currentSeed) siPair Nothing +restartGame currentSeed siPair = startGameWithSeed siPair $ ValidatedLaunchParms (Just currentSeed) Nothing -- | Load a 'Scenario' and start playing the game, with the -- possibility for the user to override the seed. @@ -102,11 +104,10 @@ restartGame currentSeed siPair = startGameWithSeed (Just currentSeed) siPair Not -- with "initGameStateForScenario". startGameWithSeed :: (MonadIO m, MonadState AppState m) => - Maybe Seed -> ScenarioInfoPair -> - Maybe CodeToRun -> + ValidatedLaunchParms -> m () -startGameWithSeed userSeed siPair@(_scene, si) toRun = do +startGameWithSeed siPair@(_scene, si) (ValidatedLaunchParms userSeed toRun) = do t <- liftIO getZonedTime ss <- use $ gameState . scenarios p <- liftIO $ normalizeScenarioPath ss (si ^. scenarioPath) diff --git a/src/Swarm/TUI/Model/UI.hs b/src/Swarm/TUI/Model/UI.hs index 03027c3bba..be260784a4 100644 --- a/src/Swarm/TUI/Model/UI.hs +++ b/src/Swarm/TUI/Model/UI.hs @@ -13,6 +13,7 @@ module Swarm.TUI.Model.UI ( uiPlaying, uiCheatMode, uiFocusRing, + uiLaunchConfig, uiWorldCursor, uiREPL, uiInventory, @@ -72,6 +73,8 @@ import Swarm.Game.ScenarioInfo ( import Swarm.Game.World qualified as W import Swarm.TUI.Attr (swarmAttrMap) import Swarm.TUI.Inventory.Sorting +import Swarm.TUI.Launch.Model +import Swarm.TUI.Launch.Prep import Swarm.TUI.Model.Goal import Swarm.TUI.Model.Menu import Swarm.TUI.Model.Name @@ -90,6 +93,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) @@ -143,6 +147,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) @@ -286,11 +293,13 @@ initUIState showMainMenu cheatMode = do let history = maybe [] (map REPLEntry . T.lines) historyT startTime <- liftIO $ getTime Monotonic (warnings, achievements) <- liftIO loadAchievementsInfo + launchConfigPanel <- liftIO initConfigPanel let out = UIState { _uiMenu = if showMainMenu then MainMenu (mainMenu NewGame) else NoMenu , _uiPlaying = not showMainMenu , _uiCheatMode = cheatMode + , _uiLaunchConfig = launchConfigPanel , _uiFocusRing = initFocusRing , _uiWorldCursor = Nothing , _uiREPL = initREPLState $ newREPLHistory history diff --git a/src/Swarm/TUI/View.hs b/src/Swarm/TUI/View.hs index c7a99746ca..a0580e4a9f 100644 --- a/src/Swarm/TUI/View.hs +++ b/src/Swarm/TUI/View.hs @@ -37,7 +37,12 @@ module Swarm.TUI.View ( import Brick hiding (Direction, Location) import Brick.Focus import Brick.Forms -import Brick.Widgets.Border (hBorder, hBorderWithLabel, joinableBorder, vBorder) +import Brick.Widgets.Border ( + hBorder, + hBorderWithLabel, + joinableBorder, + vBorder, + ) import Brick.Widgets.Center (center, centerLayer, hCenter) import Brick.Widgets.Dialog import Brick.Widgets.Edit (getEditContents, renderEditor) @@ -91,6 +96,8 @@ import Swarm.Language.Typecheck (inferConst) import Swarm.TUI.Attr import Swarm.TUI.Border import Swarm.TUI.Inventory.Sorting (renderSortMethod) +import Swarm.TUI.Launch.Model +import Swarm.TUI.Launch.View import Swarm.TUI.Model import Swarm.TUI.Model.Goal (goalsContent, hasAnythingToShow) import Swarm.TUI.Model.Repl (lastEntry) @@ -117,7 +124,9 @@ drawUI s -- quit the app instead. But just in case, we display the main menu anyway. NoMenu -> [drawMainMenuUI s (mainMenu NewGame)] MainMenu l -> [drawMainMenuUI s l] - NewGameMenu stk -> [drawNewGameMenuUI stk] + NewGameMenu stk -> do + let launchOptions = s ^. uiState . uiLaunchConfig + drawNewGameMenuUI stk launchOptions AchievementsMenu l -> [drawAchievementsMenuUI s l] MessagesMenu -> [drawMainMessages s] AboutMenu -> [drawAboutMenuUI (s ^. uiState . appData . at "about")] @@ -165,22 +174,38 @@ drawLogo = centerLayer . vBox . map (hBox . T.foldr (\c ws -> drawThing c : ws) attrFor '▒' = dirtAttr attrFor _ = defAttr -drawNewGameMenuUI :: NonEmpty (BL.List Name ScenarioItem) -> Widget Name -drawNewGameMenuUI (l :| ls) = - padLeftRight 20 - . centerLayer - $ hBox - [ vBox - [ withAttr boldAttr . txt $ breadcrumbs ls - , txt " " - , vLimit 20 - . hLimit 35 - . BL.renderList (const $ padRight Max . drawScenarioItem) True - $ l - ] - , padLeft (Pad 5) (maybe (txt "") (drawDescription . snd) (BL.listSelectedElement l)) - ] +-- | When launching a game, a modal prompt may appear on another layer +-- to input seed and/or a script to run. +drawNewGameMenuUI :: + NonEmpty (BL.List Name ScenarioItem) -> + LaunchOptions -> + [Widget Name] +drawNewGameMenuUI (l :| ls) launchOptions = case launchOptions ^. controls . isDisplayedFor of + Nothing -> pure mainWidget + Just _ -> drawLaunchConfigPanel launchOptions <> pure mainWidget where + mainWidget = + vBox + [ padLeftRight 20 + . centerLayer + $ hBox + [ vBox + [ withAttr boldAttr . txt $ breadcrumbs ls + , txt " " + , vLimit 20 + . hLimit 35 + . BL.renderList (const $ padRight Max . drawScenarioItem) True + $ l + ] + , padLeft (Pad 5) (maybe (txt "") (drawDescription . snd) (BL.listSelectedElement l)) + ] + , launchOptionsMessage + ] + + launchOptionsMessage = case (launchOptions ^. controls . isDisplayedFor, snd <$> BL.listSelectedElement l) of + (Nothing, Just (SISingle _)) -> hCenter $ txt "Press 'o' for launch options" + _ -> emptyWidget + drawScenarioItem (SISingle (s, si)) = padRight (Pad 1) (drawStatusInfo s si) <+> txt (s ^. scenarioName) drawScenarioItem (SICollection nm _) = padRight (Pad 1) (withAttr boldAttr $ txt " > ") <+> txt nm drawStatusInfo s si = case si ^. scenarioStatus of diff --git a/swarm.cabal b/swarm.cabal index 2fdd616939..4b4fbdb3f2 100644 --- a/swarm.cabal +++ b/swarm.cabal @@ -103,6 +103,10 @@ library Swarm.Game.Robot Swarm.Game.Scenario Swarm.Game.Scenario.Cell + Swarm.TUI.Launch.Controller + Swarm.TUI.Launch.Model + Swarm.TUI.Launch.Prep + Swarm.TUI.Launch.View Swarm.Game.Scenario.Objective Swarm.Game.Scenario.Objective.Graph Swarm.Game.Scenario.Objective.Logic