From 5cc73f417c15b8e697c3887b7553088b3ad6a0b0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ondr=CC=8Cej=20S=CC=8Cebek?= Date: Sun, 4 Aug 2024 22:35:22 +0200 Subject: [PATCH 1/9] Pause on objective completion --- app/game/Main.hs | 3 ++ src/swarm-engine/Swarm/Game/State.hs | 4 ++- src/swarm-engine/Swarm/Game/State/Runtime.hs | 33 ++++++++++++------- src/swarm-engine/Swarm/Game/State/Substate.hs | 12 ++++++- src/swarm-engine/Swarm/Game/Step.hs | 19 ++++++++++- src/swarm-scenario/Swarm/Game/State/Config.hs | 2 ++ .../Swarm/Web/Tournament/Validate.hs | 2 +- .../Swarm/TUI/Controller/UpdateUI.hs | 9 ++--- src/swarm-tui/Swarm/TUI/Model.hs | 3 ++ src/swarm-tui/Swarm/TUI/Model/DebugOption.hs | 3 -- src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs | 8 ++++- src/swarm-tui/Swarm/TUI/Model/UI.hs | 11 +++++-- test/bench/Benchmark.hs | 4 +-- 13 files changed, 83 insertions(+), 30 deletions(-) diff --git a/app/game/Main.hs b/app/game/Main.hs index d43a88a4e..91ffbad8e 100644 --- a/app/game/Main.hs +++ b/app/game/Main.hs @@ -67,6 +67,7 @@ cliParser = scriptToRun <- run pausedAtStart <- paused autoPlay <- autoplay + showGoal <- 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..801f2b7c6 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) + & pauseOnCompletion .~ (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..5ef9d42dd 100644 --- a/src/swarm-engine/Swarm/Game/State/Runtime.hs +++ b/src/swarm-engine/Swarm/Game/State/Runtime.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} @@ -79,21 +80,32 @@ 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) +instance Semigroup RuntimeOptions where + a <> b = + RuntimeOptions + (a.startPaused || b.startPaused) + (a.pauseOnObjectiveCompletion || b.pauseOnObjectiveCompletion) + (a.loadTestScenarios || b.loadTestScenarios) + +instance Monoid RuntimeOptions where + mempty = RuntimeOptions False False False + initRuntimeState :: ( Has (Throw SystemFailure) sig m , Has (Accum (Seq SystemFailure)) sig m @@ -101,10 +113,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..723a7c41a 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, + pauseOnCompletion, -- *** 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 + , _pauseOnCompletion :: 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. +pauseOnCompletion :: 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 + , _pauseOnCompletion = PauseOnAnyObjective } initGameControls :: GameControls diff --git a/src/swarm-engine/Swarm/Game/Step.hs b/src/swarm-engine/Swarm/Game/Step.hs index aadb22d9c..ab3855643 100644 --- a/src/swarm-engine/Swarm/Game/Step.hs +++ b/src/swarm-engine/Swarm/Game/Step.hs @@ -28,9 +28,11 @@ 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 +import Data.List (intercalate) import Data.Map qualified as M import Data.Maybe (fromMaybe) import Data.Sequence ((><)) @@ -338,7 +340,22 @@ 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 . pauseOnCompletion + -- TODO: remove this debug ouput + sendIO $ + appendFile "log_win.txt" $ + intercalate + " \t" + [ show $ getTickNumber ts + , if newWinState == Ongoing then "ongoing" else "won" + , if (notNull queue) then "queued" else "empty" + , show shouldPause <> "\n" + ] + + when (newWinState /= Ongoing || (notNull queue && 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..437f21029 100644 --- a/src/swarm-tournament/Swarm/Web/Tournament/Validate.hs +++ b/src/swarm-tournament/Swarm/Web/Tournament/Validate.hs @@ -184,7 +184,7 @@ gamestateFromScenarioText content = do . ExceptT . runThrow . evalAccum (mempty :: Seq SystemFailure) - $ initGameStateConfig False + $ initGameStateConfig mempty 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 5083e1d5b..399cc9f23 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 . 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 + hideObjectives <- use $ uiState . uiGameplay . uiHideObjectives + unless hideObjectives $ 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..674af407f 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 + , showGoal :: Bool + -- ^ Show goal dialogs. , speed :: Int -- ^ Initial game speed (logarithm) , debugOptions :: Set DebugOption @@ -275,6 +277,7 @@ defaultAppOpts = , userScenario = Nothing , scriptToRun = Nothing , pausedAtStart = False + , showGoal = 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 ab6c9f493..f1e4fb3fe 100644 --- a/src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs +++ b/src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs @@ -127,7 +127,13 @@ 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) + rs <- + initRuntimeState + RuntimeOptions + { startPaused = pausedAtStart + , pauseOnObjectiveCompletion = showGoal + , loadTestScenarios = Set.member LoadTestingScenarios debugOptions + } ui <- initUIState speed (not (skipMenu opts)) debugOptions ks <- initKeyHandlingState return (rs, ui, ks) diff --git a/src/swarm-tui/Swarm/TUI/Model/UI.hs b/src/swarm-tui/Swarm/TUI/Model/UI.hs index 26faf7cda..9c5c58542 100644 --- a/src/swarm-tui/Swarm/TUI/Model/UI.hs +++ b/src/swarm-tui/Swarm/TUI/Model/UI.hs @@ -32,6 +32,7 @@ module Swarm.TUI.Model.UI ( uiGoal, uiStructure, uiIsAutoPlay, + uiHideObjectives, uiAchievements, lgTicksPerSecond, lastFrameTime, @@ -207,6 +208,7 @@ data UIGameplay = UIGameplay , _uiGoal :: GoalDisplay , _uiStructure :: StructureDisplay , _uiIsAutoPlay :: Bool + , _uiHideObjectives :: Bool , _uiShowREPL :: Bool , _uiShowDebug :: Bool , _uiHideRobotsUntil :: TimeSpec @@ -252,11 +254,12 @@ uiGoal :: Lens' UIGameplay GoalDisplay -- | Definition and status of a recognizable structure uiStructure :: Lens' UIGameplay StructureDisplay --- | 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. +uiHideObjectives :: Lens' UIGameplay Bool + -- | A toggle to expand or collapse the REPL by pressing @Ctrl-k@ uiShowREPL :: Lens' UIGameplay Bool @@ -350,6 +353,7 @@ initUIState :: Set DebugOption -> m UIState initUIState speedFactor showMainMenu debug = do + -- TODO: ondra - add ui config for silence historyT <- sendIO $ readFileMayT =<< getSwarmHistoryPath False let history = maybe [] (map mkREPLSubmission . T.lines) historyT startTime <- sendIO $ getTime Monotonic @@ -383,6 +387,7 @@ initUIState speedFactor showMainMenu debug = do , _uiGoal = emptyGoalDisplay , _uiStructure = emptyStructureDisplay , _uiIsAutoPlay = False + , _uiHideObjectives = True , _uiTiming = UITiming { _uiShowFPS = False diff --git a/test/bench/Benchmark.hs b/test/bench/Benchmark.hs index e0cbabae3..778111922 100644 --- a/test/bench/Benchmark.hs +++ b/test/bench/Benchmark.hs @@ -25,7 +25,7 @@ import Swarm.Game.State (GameState, creativeMode, landscape, zoomRobots) import Swarm.Game.State.Initialize (pureScenarioToGameState) import Swarm.Game.State.Landscape (multiWorld) import Swarm.Game.State.Robot (addTRobot) -import Swarm.Game.State.Runtime (RuntimeOptions (..), initRuntimeState, stdGameConfigInputs) +import Swarm.Game.State.Runtime (initRuntimeState, stdGameConfigInputs) import Swarm.Game.Step (gameTick) import Swarm.Game.Terrain (blankTerrainIndex) import Swarm.Game.Universe (Cosmic (..), SubworldName (DefaultRootSubworld)) @@ -142,7 +142,7 @@ 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 mempty (scenario, _) <- loadStandaloneScenario "classic" return $ pureScenarioToGameState scenario 0 0 Nothing $ view stdGameConfigInputs initRS From 10c0af12d646f4cb0c8793052f2173e1fcb518c0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ondr=CC=8Cej=20S=CC=8Cebek?= Date: Sun, 8 Sep 2024 18:07:18 +0200 Subject: [PATCH 2/9] Renaming and fixups --- app/game/Main.hs | 2 +- src/swarm-engine/Swarm/Game/Step.hs | 10 ++++--- .../Swarm/TUI/Controller/UpdateUI.hs | 4 +-- src/swarm-tui/Swarm/TUI/Model.hs | 6 ++-- src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs | 6 ++-- src/swarm-tui/Swarm/TUI/Model/UI.hs | 28 +++++++++++-------- 6 files changed, 33 insertions(+), 23 deletions(-) diff --git a/app/game/Main.hs b/app/game/Main.hs index 91ffbad8e..cde368d9c 100644 --- a/app/game/Main.hs +++ b/app/game/Main.hs @@ -67,7 +67,7 @@ cliParser = scriptToRun <- run pausedAtStart <- paused autoPlay <- autoplay - showGoal <- not <$> hideGoal + autoShowObjectives <- not <$> hideGoal speed <- speedFactor debugOptions <- debug cheatMode <- cheat diff --git a/src/swarm-engine/Swarm/Game/Step.hs b/src/swarm-engine/Swarm/Game/Step.hs index ab3855643..4636f010d 100644 --- a/src/swarm-engine/Swarm/Game/Step.hs +++ b/src/swarm-engine/Swarm/Game/Step.hs @@ -343,6 +343,7 @@ hypotheticalWinCheck em g ws oc = do queue <- messageInfo . announcementQueue Swarm.Util.<%= (>< Seq.fromList (map ObjectiveCompleted $ completionAnnouncementQueue finalAccumulator)) shouldPause <- use $ temporal . pauseOnCompletion + let willPause = newWinState /= Ongoing || (notNull queue && shouldPause == PauseOnAnyObjective) -- TODO: remove this debug ouput sendIO $ appendFile "log_win.txt" $ @@ -350,11 +351,12 @@ hypotheticalWinCheck em g ws oc = do " \t" [ show $ getTickNumber ts , if newWinState == Ongoing then "ongoing" else "won" - , if (notNull queue) then "queued" else "empty" - , show shouldPause <> "\n" - ] + , if notNull queue then "queued" else "empty" + , show shouldPause + , if willPause then "AutoPause" else "Running" + ] <> "\n" - when (newWinState /= Ongoing || (notNull queue && shouldPause == PauseOnAnyObjective)) $ + when willPause $ temporal . runStatus .= AutoPause mapM_ handleException $ exceptions finalAccumulator diff --git a/src/swarm-tui/Swarm/TUI/Controller/UpdateUI.hs b/src/swarm-tui/Swarm/TUI/Controller/UpdateUI.hs index 399cc9f23..4019ddae3 100644 --- a/src/swarm-tui/Swarm/TUI/Controller/UpdateUI.hs +++ b/src/swarm-tui/Swarm/TUI/Controller/UpdateUI.hs @@ -237,8 +237,8 @@ doGoalUpdates = do -- automatically popped up. gameState . messageInfo . announcementQueue .= mempty - hideObjectives <- use $ uiState . uiGameplay . uiHideObjectives - unless hideObjectives $ 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 674af407f..ce15747a6 100644 --- a/src/swarm-tui/Swarm/TUI/Model.hs +++ b/src/swarm-tui/Swarm/TUI/Model.hs @@ -255,8 +255,8 @@ data AppOpts = AppOpts -- ^ Pause the game on start by default. , autoPlay :: Bool -- ^ Automatically run the solution defined in the scenario file - , showGoal :: Bool - -- ^ Show goal dialogs. + , autoShowObjectives :: Bool + -- ^ Show objectives dialogs when an objective is achieved/failed. , speed :: Int -- ^ Initial game speed (logarithm) , debugOptions :: Set DebugOption @@ -277,7 +277,7 @@ defaultAppOpts = , userScenario = Nothing , scriptToRun = Nothing , pausedAtStart = False - , showGoal = True + , autoShowObjectives = True , autoPlay = False , speed = defaultInitLgTicksPerSecond , debugOptions = mempty diff --git a/src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs b/src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs index f1e4fb3fe..9fb654625 100644 --- a/src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs +++ b/src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs @@ -131,10 +131,12 @@ initPersistentState opts@(AppOpts {..}) = do initRuntimeState RuntimeOptions { startPaused = pausedAtStart - , pauseOnObjectiveCompletion = showGoal + , pauseOnObjectiveCompletion = autoShowObjectives , loadTestScenarios = Set.member LoadTestingScenarios debugOptions } - ui <- initUIState speed (not (skipMenu opts)) debugOptions + let showMainMenu = not (skipMenu opts) + ui <- initUIState UIInitOptions {..} + -- \$ speed (not (skipMenu opts)) debugOptions 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 9c5c58542..f82027755 100644 --- a/src/swarm-tui/Swarm/TUI/Model/UI.hs +++ b/src/swarm-tui/Swarm/TUI/Model/UI.hs @@ -32,7 +32,7 @@ module Swarm.TUI.Model.UI ( uiGoal, uiStructure, uiIsAutoPlay, - uiHideObjectives, + uiAutoShowObjectives, uiAchievements, lgTicksPerSecond, lastFrameTime, @@ -57,6 +57,7 @@ module Swarm.TUI.Model.UI ( initFocusRing, defaultInitLgTicksPerSecond, initUIState, + UIInitOptions (..), ) where import Brick (AttrMap) @@ -208,7 +209,7 @@ data UIGameplay = UIGameplay , _uiGoal :: GoalDisplay , _uiStructure :: StructureDisplay , _uiIsAutoPlay :: Bool - , _uiHideObjectives :: Bool + , _uiAutoShowObjectives :: Bool , _uiShowREPL :: Bool , _uiShowDebug :: Bool , _uiHideRobotsUntil :: TimeSpec @@ -258,7 +259,7 @@ uiStructure :: Lens' UIGameplay StructureDisplay uiIsAutoPlay :: Lens' UIGameplay Bool -- | Do not open objectives modals on objective completion. -uiHideObjectives :: Lens' UIGameplay Bool +uiAutoShowObjectives :: Lens' UIGameplay Bool -- | A toggle to expand or collapse the REPL by pressing @Ctrl-k@ uiShowREPL :: Lens' UIGameplay Bool @@ -339,6 +340,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@ @@ -348,12 +357,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 - -- TODO: ondra - add ui config for silence +initUIState UIInitOptions {..} = do historyT <- sendIO $ readFileMayT =<< getSwarmHistoryPath False let history = maybe [] (map mkREPLSubmission . T.lines) historyT startTime <- sendIO $ getTime Monotonic @@ -363,7 +369,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 @@ -387,13 +393,13 @@ initUIState speedFactor showMainMenu debug = do , _uiGoal = emptyGoalDisplay , _uiStructure = emptyStructureDisplay , _uiIsAutoPlay = False - , _uiHideObjectives = True + , _uiAutoShowObjectives = autoShowObjectives , _uiTiming = UITiming { _uiShowFPS = False , _uiTPF = 0 , _uiFPS = 0 - , _lgTicksPerSecond = speedFactor + , _lgTicksPerSecond = speed , _lastFrameTime = startTime , _accumulatedTime = 0 , _lastInfoTime = 0 From 43c9879af4cedd25730b71ad0456890fb023258c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ondr=CC=8Cej=20S=CC=8Cebek?= Date: Sun, 8 Sep 2024 18:15:50 +0200 Subject: [PATCH 3/9] Remove debug output --- src/swarm-engine/Swarm/Game/Step.hs | 18 ++---------------- 1 file changed, 2 insertions(+), 16 deletions(-) diff --git a/src/swarm-engine/Swarm/Game/Step.hs b/src/swarm-engine/Swarm/Game/Step.hs index 4636f010d..5074035b4 100644 --- a/src/swarm-engine/Swarm/Game/Step.hs +++ b/src/swarm-engine/Swarm/Game/Step.hs @@ -32,7 +32,6 @@ import Data.Foldable.Extra (notNull) import Data.Functor (void) import Data.IntMap qualified as IM import Data.IntSet qualified as IS -import Data.List (intercalate) import Data.Map qualified as M import Data.Maybe (fromMaybe) import Data.Sequence ((><)) @@ -341,22 +340,9 @@ hypotheticalWinCheck em g ws oc = do _ -> return () queue <- messageInfo . announcementQueue Swarm.Util.<%= (>< Seq.fromList (map ObjectiveCompleted $ completionAnnouncementQueue finalAccumulator)) - shouldPause <- use $ temporal . pauseOnCompletion - let willPause = newWinState /= Ongoing || (notNull queue && shouldPause == PauseOnAnyObjective) - -- TODO: remove this debug ouput - sendIO $ - appendFile "log_win.txt" $ - intercalate - " \t" - [ show $ getTickNumber ts - , if newWinState == Ongoing then "ongoing" else "won" - , if notNull queue then "queued" else "empty" - , show shouldPause - , if willPause then "AutoPause" else "Running" - ] <> "\n" - - when willPause $ + + when (newWinState /= Ongoing || (notNull queue && shouldPause == PauseOnAnyObjective)) $ temporal . runStatus .= AutoPause mapM_ handleException $ exceptions finalAccumulator From 95dbef8805e853a59a4876a31e3b9ae091bcc5c9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ondr=CC=8Cej=20S=CC=8Cebek?= Date: Mon, 9 Sep 2024 10:11:24 +0200 Subject: [PATCH 4/9] Rename option --- src/swarm-engine/Swarm/Game/State.hs | 2 +- src/swarm-engine/Swarm/Game/State/Substate.hs | 8 ++++---- src/swarm-engine/Swarm/Game/Step.hs | 2 +- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/swarm-engine/Swarm/Game/State.hs b/src/swarm-engine/Swarm/Game/State.hs index 801f2b7c6..04d517e6e 100644 --- a/src/swarm-engine/Swarm/Game/State.hs +++ b/src/swarm-engine/Swarm/Game/State.hs @@ -463,7 +463,7 @@ initGameState gsc = { _creativeMode = False , _temporal = initTemporalState (startPaused gsc) - & pauseOnCompletion .~ (if pauseOnObjectiveCompletion gsc then PauseOnAnyObjective else PauseOnWin) + & pauseOnObjective .~ (if pauseOnObjectiveCompletion gsc then PauseOnAnyObjective else PauseOnWin) , _winCondition = NoWinCondition , _winSolution = Nothing , _robotInfo = initRobots gsc diff --git a/src/swarm-engine/Swarm/Game/State/Substate.hs b/src/swarm-engine/Swarm/Game/State/Substate.hs index 723a7c41a..85305ab0b 100644 --- a/src/swarm-engine/Swarm/Game/State/Substate.hs +++ b/src/swarm-engine/Swarm/Game/State/Substate.hs @@ -34,7 +34,7 @@ module Swarm.Game.State.Substate ( ticks, robotStepsPerTick, paused, - pauseOnCompletion, + pauseOnObjective, -- *** Recipes Recipes, @@ -284,7 +284,7 @@ data TemporalState = TemporalState , _runStatus :: RunStatus , _ticks :: TickNumber , _robotStepsPerTick :: Int - , _pauseOnCompletion :: PauseOnObjective + , _pauseOnObjective :: PauseOnObjective } makeLensesNoSigs ''TemporalState @@ -307,7 +307,7 @@ ticks :: Lens' TemporalState TickNumber robotStepsPerTick :: Lens' TemporalState Int -- | Whether to pause the game after an objective is completed. -pauseOnCompletion :: Lens' TemporalState PauseOnObjective +pauseOnObjective :: Lens' TemporalState PauseOnObjective data GameControls = GameControls { _replStatus :: REPLStatus @@ -415,7 +415,7 @@ initTemporalState pausedAtStart = , _runStatus = if pausedAtStart then ManualPause else Running , _ticks = TickNumber 0 , _robotStepsPerTick = defaultRobotStepsPerTick - , _pauseOnCompletion = PauseOnAnyObjective + , _pauseOnObjective = PauseOnAnyObjective } initGameControls :: GameControls diff --git a/src/swarm-engine/Swarm/Game/Step.hs b/src/swarm-engine/Swarm/Game/Step.hs index 5074035b4..5f4792a63 100644 --- a/src/swarm-engine/Swarm/Game/Step.hs +++ b/src/swarm-engine/Swarm/Game/Step.hs @@ -340,7 +340,7 @@ hypotheticalWinCheck em g ws oc = do _ -> return () queue <- messageInfo . announcementQueue Swarm.Util.<%= (>< Seq.fromList (map ObjectiveCompleted $ completionAnnouncementQueue finalAccumulator)) - shouldPause <- use $ temporal . pauseOnCompletion + shouldPause <- use $ temporal . pauseOnObjective when (newWinState /= Ongoing || (notNull queue && shouldPause == PauseOnAnyObjective)) $ temporal . runStatus .= AutoPause From 8ea3d27245faf08fe5b3992425816130bde40a25 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ondr=CC=8Cej=20S=CC=8Cebek?= Date: Mon, 9 Sep 2024 10:16:35 +0200 Subject: [PATCH 5/9] Remove monoid instance --- src/swarm-engine/Swarm/Game/State/Runtime.hs | 11 ----------- src/swarm-tournament/Swarm/Web/Tournament/Validate.hs | 9 +++++++-- 2 files changed, 7 insertions(+), 13 deletions(-) diff --git a/src/swarm-engine/Swarm/Game/State/Runtime.hs b/src/swarm-engine/Swarm/Game/State/Runtime.hs index 5ef9d42dd..f48f53c84 100644 --- a/src/swarm-engine/Swarm/Game/State/Runtime.hs +++ b/src/swarm-engine/Swarm/Game/State/Runtime.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} @@ -96,16 +95,6 @@ data RuntimeOptions = RuntimeOptions } deriving (Eq, Show) -instance Semigroup RuntimeOptions where - a <> b = - RuntimeOptions - (a.startPaused || b.startPaused) - (a.pauseOnObjectiveCompletion || b.pauseOnObjectiveCompletion) - (a.loadTestScenarios || b.loadTestScenarios) - -instance Monoid RuntimeOptions where - mempty = RuntimeOptions False False False - initRuntimeState :: ( Has (Throw SystemFailure) sig m , Has (Accum (Seq SystemFailure)) sig m diff --git a/src/swarm-tournament/Swarm/Web/Tournament/Validate.hs b/src/swarm-tournament/Swarm/Web/Tournament/Validate.hs index 437f21029..4e6b53800 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 (initGameStateConfig, initScenarioInputs, pauseOnObjectiveCompletion, RuntimeOptions (..)) 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 mempty + . initGameStateConfig + $ RuntimeOptions + { startPaused = False + , pauseOnObjectiveCompletion = False + , loadTestScenarios = False + } let scenarioInputs = gsiScenarioInputs $ initState gsc scenarioObject <- initScenarioObject scenarioInputs content From 3d00effeb8f771e81b867b488f8d5e62b60d3521 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ondr=CC=8Cej=20S=CC=8Cebek?= Date: Mon, 9 Sep 2024 10:17:05 +0200 Subject: [PATCH 6/9] Clarify pause condition --- src/swarm-engine/Swarm/Game/Step.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/swarm-engine/Swarm/Game/Step.hs b/src/swarm-engine/Swarm/Game/Step.hs index 5f4792a63..266c7cae0 100644 --- a/src/swarm-engine/Swarm/Game/Step.hs +++ b/src/swarm-engine/Swarm/Game/Step.hs @@ -342,7 +342,9 @@ hypotheticalWinCheck em g ws oc = do queue <- messageInfo . announcementQueue Swarm.Util.<%= (>< Seq.fromList (map ObjectiveCompleted $ completionAnnouncementQueue finalAccumulator)) shouldPause <- use $ temporal . pauseOnObjective - when (newWinState /= Ongoing || (notNull queue && shouldPause == PauseOnAnyObjective)) $ + let gameFinished = newWinState /= Ongoing + let finishedObjectives = notNull queue + when (gameFinished || (finishedObjectives && shouldPause == PauseOnAnyObjective)) $ temporal . runStatus .= AutoPause mapM_ handleException $ exceptions finalAccumulator From 5a4665e38c221f9b34cc6032674899f2fbdb0b1a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ondr=CC=8Cej=20S=CC=8Cebek?= Date: Mon, 9 Sep 2024 10:17:31 +0200 Subject: [PATCH 7/9] Restyle --- src/swarm-tournament/Swarm/Web/Tournament/Validate.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/swarm-tournament/Swarm/Web/Tournament/Validate.hs b/src/swarm-tournament/Swarm/Web/Tournament/Validate.hs index 4e6b53800..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, pauseOnObjectiveCompletion, RuntimeOptions (..)) +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 From 21f5401926c4839efa212393dc84dc73b4c7e9a7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ondr=CC=8Cej=20S=CC=8Cebek?= Date: Mon, 9 Sep 2024 10:23:39 +0200 Subject: [PATCH 8/9] Remove commented out code --- src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs b/src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs index 9fb654625..f2f4bd1ab 100644 --- a/src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs +++ b/src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs @@ -136,7 +136,6 @@ initPersistentState opts@(AppOpts {..}) = do } let showMainMenu = not (skipMenu opts) ui <- initUIState UIInitOptions {..} - -- \$ speed (not (skipMenu opts)) debugOptions ks <- initKeyHandlingState return (rs, ui, ks) let initRS' = addWarnings initRS (F.toList warnings) From 19e0cfc39e0730ccfdecdb9e8eba12af39c584a4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ondr=CC=8Cej=20S=CC=8Cebek?= Date: Mon, 9 Sep 2024 10:48:42 +0200 Subject: [PATCH 9/9] Fixup benchmark --- test/bench/Benchmark.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/test/bench/Benchmark.hs b/test/bench/Benchmark.hs index 778111922..9e139d83b 100644 --- a/test/bench/Benchmark.hs +++ b/test/bench/Benchmark.hs @@ -25,7 +25,7 @@ import Swarm.Game.State (GameState, creativeMode, landscape, zoomRobots) import Swarm.Game.State.Initialize (pureScenarioToGameState) import Swarm.Game.State.Landscape (multiWorld) import Swarm.Game.State.Robot (addTRobot) -import Swarm.Game.State.Runtime (initRuntimeState, stdGameConfigInputs) +import Swarm.Game.State.Runtime (RuntimeOptions (..), initRuntimeState, stdGameConfigInputs) import Swarm.Game.Step (gameTick) import Swarm.Game.Terrain (blankTerrainIndex) import Swarm.Game.Universe (Cosmic (..), SubworldName (DefaultRootSubworld)) @@ -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 mempty + (_ :: 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