diff --git a/app/game/Main.hs b/app/game/Main.hs index d43a88a4e..cde368d9c 100644 --- a/app/game/Main.hs +++ b/app/game/Main.hs @@ -67,6 +67,7 @@ cliParser = scriptToRun <- run pausedAtStart <- paused autoPlay <- autoplay + autoShowObjectives <- not <$> hideGoal speed <- speedFactor debugOptions <- debug cheatMode <- cheat @@ -127,6 +128,8 @@ cliParser = paused = switch (long "paused" <> short 'p' <> help "Pause the game at start.") autoplay :: Parser Bool autoplay = switch (long "autoplay" <> short 'a' <> help "Automatically run the solution defined in the scenario, if there is one. Mutually exclusive with --run.") + hideGoal :: Parser Bool + hideGoal = switch (long "hide-goal" <> help "Do not show goal modal window that pauses the game.") speedFactor :: Parser Int speedFactor = option auto (long "speed" <> short 'm' <> metavar "N" <> value defaultInitLgTicksPerSecond <> help speedFactorHelp) speedFactorHelp = diff --git a/src/swarm-engine/Swarm/Game/State.hs b/src/swarm-engine/Swarm/Game/State.hs index 883ba8dd4..04d517e6e 100644 --- a/src/swarm-engine/Swarm/Game/State.hs +++ b/src/swarm-engine/Swarm/Game/State.hs @@ -461,7 +461,9 @@ initGameState :: GameStateConfig -> GameState initGameState gsc = GameState { _creativeMode = False - , _temporal = initTemporalState $ startPaused gsc + , _temporal = + initTemporalState (startPaused gsc) + & pauseOnObjective .~ (if pauseOnObjectiveCompletion gsc then PauseOnAnyObjective else PauseOnWin) , _winCondition = NoWinCondition , _winSolution = Nothing , _robotInfo = initRobots gsc diff --git a/src/swarm-engine/Swarm/Game/State/Runtime.hs b/src/swarm-engine/Swarm/Game/State/Runtime.hs index 411153d47..f48f53c84 100644 --- a/src/swarm-engine/Swarm/Game/State/Runtime.hs +++ b/src/swarm-engine/Swarm/Game/State/Runtime.hs @@ -79,17 +79,18 @@ initGameStateConfig :: , Has (Accum (Seq SystemFailure)) sig m , Has (Lift IO) sig m ) => - Bool -> + RuntimeOptions -> m GameStateConfig -initGameStateConfig pause = do - gsi <- initGameStateInputs - appDataMap <- readAppData - nameGen <- initNameGenerator appDataMap - return $ GameStateConfig appDataMap nameGen pause gsi +initGameStateConfig RuntimeOptions {..} = do + initAppDataMap <- readAppData + nameParts <- initNameGenerator initAppDataMap + initState <- initGameStateInputs + return $ GameStateConfig {..} -- | Runtime state initialization options. data RuntimeOptions = RuntimeOptions - { gamePausedAtStart :: Bool + { startPaused :: Bool + , pauseOnObjectiveCompletion :: Bool , loadTestScenarios :: Bool } deriving (Eq, Show) @@ -101,10 +102,9 @@ initRuntimeState :: ) => RuntimeOptions -> m RuntimeState -initRuntimeState RuntimeOptions {..} = do - gsc <- initGameStateConfig gamePausedAtStart - scenarios <- loadScenarios (gsiScenarioInputs $ initState gsc) loadTestScenarios - +initRuntimeState opts = do + gsc <- initGameStateConfig opts + scenarios <- loadScenarios (gsiScenarioInputs $ initState gsc) (loadTestScenarios opts) return $ RuntimeState { _webPort = Nothing diff --git a/src/swarm-engine/Swarm/Game/State/Substate.hs b/src/swarm-engine/Swarm/Game/State/Substate.hs index f271b33fe..85305ab0b 100644 --- a/src/swarm-engine/Swarm/Game/State/Substate.hs +++ b/src/swarm-engine/Swarm/Game/State/Substate.hs @@ -27,12 +27,14 @@ module Swarm.Game.State.Substate ( -- *** Temporal state TemporalState, + PauseOnObjective (..), initTemporalState, gameStep, runStatus, ticks, robotStepsPerTick, paused, + pauseOnObjective, -- *** Recipes Recipes, @@ -146,7 +148,7 @@ data WinStatus -- The boolean indicates whether they have -- already been informed. Unwinnable Bool - deriving (Show, Generic, FromJSON, ToJSON) + deriving (Eq, Show, Generic, FromJSON, ToJSON) data WinCondition = -- | There is no winning condition. @@ -274,11 +276,15 @@ data SingleStep -- | Game step mode - we use the single step mode when debugging robot 'CESK' machine. data Step = WorldTick | RobotStep SingleStep +data PauseOnObjective = PauseOnWin | PauseOnAnyObjective + deriving (Eq, Ord, Show, Enum, Bounded) + data TemporalState = TemporalState { _gameStep :: Step , _runStatus :: RunStatus , _ticks :: TickNumber , _robotStepsPerTick :: Int + , _pauseOnObjective :: PauseOnObjective } makeLensesNoSigs ''TemporalState @@ -300,6 +306,9 @@ ticks :: Lens' TemporalState TickNumber -- a single tick. robotStepsPerTick :: Lens' TemporalState Int +-- | Whether to pause the game after an objective is completed. +pauseOnObjective :: Lens' TemporalState PauseOnObjective + data GameControls = GameControls { _replStatus :: REPLStatus , _replNextValueIndex :: Integer @@ -406,6 +415,7 @@ initTemporalState pausedAtStart = , _runStatus = if pausedAtStart then ManualPause else Running , _ticks = TickNumber 0 , _robotStepsPerTick = defaultRobotStepsPerTick + , _pauseOnObjective = PauseOnAnyObjective } initGameControls :: GameControls diff --git a/src/swarm-engine/Swarm/Game/Step.hs b/src/swarm-engine/Swarm/Game/Step.hs index aadb22d9c..266c7cae0 100644 --- a/src/swarm-engine/Swarm/Game/Step.hs +++ b/src/swarm-engine/Swarm/Game/Step.hs @@ -28,6 +28,7 @@ import Control.Effect.Lens import Control.Effect.Lift import Control.Lens as Lens hiding (Const, distrib, from, parts, use, uses, view, (%=), (+=), (.=), (<+=), (<>=)) import Control.Monad (foldM, forM_, unless, when) +import Data.Foldable.Extra (notNull) import Data.Functor (void) import Data.IntMap qualified as IM import Data.IntSet qualified as IS @@ -338,7 +339,13 @@ hypotheticalWinCheck em g ws oc = do Unwinnable _ -> grantAchievement LoseScenario _ -> return () - messageInfo . announcementQueue %= (>< Seq.fromList (map ObjectiveCompleted $ completionAnnouncementQueue finalAccumulator)) + queue <- messageInfo . announcementQueue Swarm.Util.<%= (>< Seq.fromList (map ObjectiveCompleted $ completionAnnouncementQueue finalAccumulator)) + shouldPause <- use $ temporal . pauseOnObjective + + let gameFinished = newWinState /= Ongoing + let finishedObjectives = notNull queue + when (gameFinished || (finishedObjectives && shouldPause == PauseOnAnyObjective)) $ + temporal . runStatus .= AutoPause mapM_ handleException $ exceptions finalAccumulator where diff --git a/src/swarm-scenario/Swarm/Game/State/Config.hs b/src/swarm-scenario/Swarm/Game/State/Config.hs index 03978f64b..f2e71322c 100644 --- a/src/swarm-scenario/Swarm/Game/State/Config.hs +++ b/src/swarm-scenario/Swarm/Game/State/Config.hs @@ -18,5 +18,7 @@ data GameStateConfig = GameStateConfig -- ^ Lists of words/adjectives for use in building random robot names. , startPaused :: Bool -- ^ Start the game paused - useful for debugging or competitive play. + , pauseOnObjectiveCompletion :: Bool + -- ^ Pause the game when any objective is completed. , initState :: GameStateInputs } diff --git a/src/swarm-tournament/Swarm/Web/Tournament/Validate.hs b/src/swarm-tournament/Swarm/Web/Tournament/Validate.hs index e8913a4d9..36f8674c4 100644 --- a/src/swarm-tournament/Swarm/Web/Tournament/Validate.hs +++ b/src/swarm-tournament/Swarm/Web/Tournament/Validate.hs @@ -30,7 +30,7 @@ import Swarm.Game.Scenario.Scoring.CodeSize (codeMetricsFromSyntax) import Swarm.Game.Scenario.Status (emptyLaunchParams) import Swarm.Game.State import Swarm.Game.State.Initialize (scenarioToGameState) -import Swarm.Game.State.Runtime (initGameStateConfig, initScenarioInputs) +import Swarm.Game.State.Runtime (RuntimeOptions (..), initGameStateConfig, initScenarioInputs, pauseOnObjectiveCompletion) import Swarm.Game.State.Substate (initState, seed) import Swarm.Game.Step.Validate (playUntilWin) import Swarm.Language.Pipeline @@ -184,7 +184,12 @@ gamestateFromScenarioText content = do . ExceptT . runThrow . evalAccum (mempty :: Seq SystemFailure) - $ initGameStateConfig False + . initGameStateConfig + $ RuntimeOptions + { startPaused = False + , pauseOnObjectiveCompletion = False + , loadTestScenarios = False + } let scenarioInputs = gsiScenarioInputs $ initState gsc scenarioObject <- initScenarioObject scenarioInputs content diff --git a/src/swarm-tui/Swarm/TUI/Controller/UpdateUI.hs b/src/swarm-tui/Swarm/TUI/Controller/UpdateUI.hs index d9a22e9b6..a2e30d42b 100644 --- a/src/swarm-tui/Swarm/TUI/Controller/UpdateUI.hs +++ b/src/swarm-tui/Swarm/TUI/Controller/UpdateUI.hs @@ -190,8 +190,7 @@ doGoalUpdates :: EventM Name AppState Bool doGoalUpdates = do curGoal <- use (uiState . uiGameplay . uiDialogs . uiGoal . goalsContent) curWinCondition <- use (gameState . winCondition) - announcementsSeq <- use (gameState . messageInfo . announcementQueue) - let announcementsList = toList announcementsSeq + announcementsList <- use (gameState . messageInfo . announcementQueue . to toList) -- Decide whether we need to update the current goal text and pop -- up a modal dialog. @@ -238,10 +237,8 @@ doGoalUpdates = do -- automatically popped up. gameState . messageInfo . announcementQueue .= mempty - isAutoPlay <- use $ uiState . uiGameplay . uiIsAutoPlay - showGoalsAnyway <- use $ uiState . uiDebugOptions . Lens.contains ShowGoalDialogsInAutoPlay - unless (isAutoPlay && not showGoalsAnyway) $ - openModal GoalModal + showObjectives <- use $ uiState . uiGameplay . uiAutoShowObjectives + when showObjectives $ openModal GoalModal return goalWasUpdated where diff --git a/src/swarm-tui/Swarm/TUI/Model.hs b/src/swarm-tui/Swarm/TUI/Model.hs index 821932c67..ce15747a6 100644 --- a/src/swarm-tui/Swarm/TUI/Model.hs +++ b/src/swarm-tui/Swarm/TUI/Model.hs @@ -255,6 +255,8 @@ data AppOpts = AppOpts -- ^ Pause the game on start by default. , autoPlay :: Bool -- ^ Automatically run the solution defined in the scenario file + , autoShowObjectives :: Bool + -- ^ Show objectives dialogs when an objective is achieved/failed. , speed :: Int -- ^ Initial game speed (logarithm) , debugOptions :: Set DebugOption @@ -275,6 +277,7 @@ defaultAppOpts = , userScenario = Nothing , scriptToRun = Nothing , pausedAtStart = False + , autoShowObjectives = True , autoPlay = False , speed = defaultInitLgTicksPerSecond , debugOptions = mempty diff --git a/src/swarm-tui/Swarm/TUI/Model/DebugOption.hs b/src/swarm-tui/Swarm/TUI/Model/DebugOption.hs index a3faaa981..5a7e12d14 100644 --- a/src/swarm-tui/Swarm/TUI/Model/DebugOption.hs +++ b/src/swarm-tui/Swarm/TUI/Model/DebugOption.hs @@ -20,7 +20,6 @@ data DebugOption | ListAllRobots | ListRobotIDs | ShowHiddenGoals - | ShowGoalDialogsInAutoPlay | LoadTestingScenarios deriving (Eq, Ord, Show, Enum, Bounded) @@ -32,7 +31,6 @@ debugOptionName = \case ListAllRobots -> "all_robots" ListRobotIDs -> "robot_id" ShowHiddenGoals -> "hidden_goals" - ShowGoalDialogsInAutoPlay -> "autoplay_goals" LoadTestingScenarios -> "testing" debugOptionDescription :: DebugOption -> String @@ -43,7 +41,6 @@ debugOptionDescription = \case ListAllRobots -> "list all robots (including system robots) in the robot panel" ListRobotIDs -> "list robot IDs in the robot panel" ShowHiddenGoals -> "show hidden objectives in the goal dialog" - ShowGoalDialogsInAutoPlay -> "show goal dialogs when running in autoplay" LoadTestingScenarios -> "load Testing folder in scenarios menu" readDebugOption :: String -> Maybe DebugOption diff --git a/src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs b/src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs index f519e411d..6b8361d73 100644 --- a/src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs +++ b/src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs @@ -126,8 +126,15 @@ initPersistentState :: m (RuntimeState, UIState, KeyEventHandlingState) initPersistentState opts@(AppOpts {..}) = do (warnings :: Seq SystemFailure, (initRS, initUI, initKs)) <- runAccum mempty $ do - rs <- initRuntimeState $ RuntimeOptions pausedAtStart (Set.member LoadTestingScenarios debugOptions) - ui <- initUIState speed (not (skipMenu opts)) debugOptions + rs <- + initRuntimeState + RuntimeOptions + { startPaused = pausedAtStart + , pauseOnObjectiveCompletion = autoShowObjectives + , loadTestScenarios = Set.member LoadTestingScenarios debugOptions + } + let showMainMenu = not (skipMenu opts) + ui <- initUIState UIInitOptions {..} ks <- initKeyHandlingState return (rs, ui, ks) let initRS' = addWarnings initRS (F.toList warnings) diff --git a/src/swarm-tui/Swarm/TUI/Model/UI.hs b/src/swarm-tui/Swarm/TUI/Model/UI.hs index 4fcddcc8b..72ef5d12f 100644 --- a/src/swarm-tui/Swarm/TUI/Model/UI.hs +++ b/src/swarm-tui/Swarm/TUI/Model/UI.hs @@ -33,6 +33,7 @@ module Swarm.TUI.Model.UI ( uiStructure, uiDialogs, uiIsAutoPlay, + uiAutoShowObjectives, uiAchievements, lgTicksPerSecond, lastFrameTime, @@ -57,6 +58,7 @@ module Swarm.TUI.Model.UI ( initFocusRing, defaultInitLgTicksPerSecond, initUIState, + UIInitOptions (..), ) where import Brick (AttrMap) @@ -226,6 +228,7 @@ data UIGameplay = UIGameplay , _uiScrollToEnd :: Bool , _uiDialogs :: UIDialogs , _uiIsAutoPlay :: Bool + , _uiAutoShowObjectives :: Bool , _uiShowREPL :: Bool , _uiShowDebug :: Bool , _uiHideRobotsUntil :: TimeSpec @@ -263,11 +266,12 @@ uiScrollToEnd :: Lens' UIGameplay Bool -- | State that backs various modal dialogs uiDialogs :: Lens' UIGameplay UIDialogs --- | When running with @--autoplay@, suppress the goal dialogs. --- --- For development, the @--cheat@ flag shows goals again. +-- | When running with @--autoplay@ the progress will not be saved. uiIsAutoPlay :: Lens' UIGameplay Bool +-- | Do not open objectives modals on objective completion. +uiAutoShowObjectives :: Lens' UIGameplay Bool + -- | A toggle to expand or collapse the REPL by pressing @Ctrl-k@ uiShowREPL :: Lens' UIGameplay Bool @@ -347,6 +351,14 @@ initFocusRing = focusRing $ map FocusablePanel enumerate defaultInitLgTicksPerSecond :: Int defaultInitLgTicksPerSecond = 4 -- 2^4 = 16 ticks / second +data UIInitOptions = UIInitOptions + { speed :: Int + , showMainMenu :: Bool + , autoShowObjectives :: Bool + , debugOptions :: Set DebugOption + } + deriving (Eq, Show) + -- | Initialize the UI state. This needs to be in the IO monad since -- it involves reading a REPL history file, getting the current -- time, and loading text files from the data directory. The @Bool@ @@ -356,11 +368,9 @@ initUIState :: ( Has (Accum (Seq SystemFailure)) sig m , Has (Lift IO) sig m ) => - Int -> - Bool -> - Set DebugOption -> + UIInitOptions -> m UIState -initUIState speedFactor showMainMenu debug = do +initUIState UIInitOptions {..} = do historyT <- sendIO $ readFileMayT =<< getSwarmHistoryPath False let history = maybe [] (map mkREPLSubmission . T.lines) historyT startTime <- sendIO $ getTime Monotonic @@ -370,7 +380,7 @@ initUIState speedFactor showMainMenu debug = do UIState { _uiMenu = if showMainMenu then MainMenu (mainMenu NewGame) else NoMenu , _uiPlaying = not showMainMenu - , _uiDebugOptions = debug + , _uiDebugOptions = debugOptions , _uiLaunchConfig = launchConfigPanel , _uiAchievements = M.fromList $ map (view achievement &&& id) achievements , _uiAttrMap = swarmAttrMap @@ -397,12 +407,13 @@ initUIState speedFactor showMainMenu debug = do , _uiStructure = emptyStructureDisplay } , _uiIsAutoPlay = False + , _uiAutoShowObjectives = autoShowObjectives , _uiTiming = UITiming { _uiShowFPS = False , _uiTPF = 0 , _uiFPS = 0 - , _lgTicksPerSecond = speedFactor + , _lgTicksPerSecond = speed , _lastFrameTime = startTime , _accumulatedTime = 0 , _lastInfoTime = 0 diff --git a/test/bench/Benchmark.hs b/test/bench/Benchmark.hs index e0cbabae3..9e139d83b 100644 --- a/test/bench/Benchmark.hs +++ b/test/bench/Benchmark.hs @@ -142,7 +142,9 @@ mkGameState prog robotMaker numRobots = do -- NOTE: This replaces "classicGame0", which is still used by unit tests. gs <- simpleErrorHandle $ do - (_ :: Seq SystemFailure, initRS) <- runAccum mempty $ initRuntimeState $ RuntimeOptions False False + (_ :: Seq SystemFailure, initRS) <- + runAccum mempty . initRuntimeState $ + RuntimeOptions {startPaused = False, pauseOnObjectiveCompletion = False, loadTestScenarios = False} (scenario, _) <- loadStandaloneScenario "classic" return $ pureScenarioToGameState scenario 0 0 Nothing $ view stdGameConfigInputs initRS