Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Pause on objective completion #2096

Merged
merged 10 commits into from
Sep 9, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 3 additions & 0 deletions app/game/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -67,6 +67,7 @@ cliParser =
scriptToRun <- run
pausedAtStart <- paused
autoPlay <- autoplay
autoShowObjectives <- not <$> hideGoal
speed <- speedFactor
debugOptions <- debug
cheatMode <- cheat
Expand Down Expand Up @@ -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 =
Expand Down
4 changes: 3 additions & 1 deletion src/swarm-engine/Swarm/Game/State.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
22 changes: 11 additions & 11 deletions src/swarm-engine/Swarm/Game/State/Runtime.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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
Expand Down
12 changes: 11 additions & 1 deletion src/swarm-engine/Swarm/Game/State/Substate.hs
Original file line number Diff line number Diff line change
Expand Up @@ -27,12 +27,14 @@ module Swarm.Game.State.Substate (

-- *** Temporal state
TemporalState,
PauseOnObjective (..),
initTemporalState,
gameStep,
runStatus,
ticks,
robotStepsPerTick,
paused,
pauseOnObjective,

-- *** Recipes
Recipes,
Expand Down Expand Up @@ -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.
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -406,6 +415,7 @@ initTemporalState pausedAtStart =
, _runStatus = if pausedAtStart then ManualPause else Running
, _ticks = TickNumber 0
, _robotStepsPerTick = defaultRobotStepsPerTick
, _pauseOnObjective = PauseOnAnyObjective
}

initGameControls :: GameControls
Expand Down
9 changes: 8 additions & 1 deletion src/swarm-engine/Swarm/Game/Step.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
2 changes: 2 additions & 0 deletions src/swarm-scenario/Swarm/Game/State/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
}
9 changes: 7 additions & 2 deletions src/swarm-tournament/Swarm/Web/Tournament/Validate.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
9 changes: 3 additions & 6 deletions src/swarm-tui/Swarm/TUI/Controller/UpdateUI.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -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
Expand Down
3 changes: 3 additions & 0 deletions src/swarm-tui/Swarm/TUI/Model.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -275,6 +277,7 @@ defaultAppOpts =
, userScenario = Nothing
, scriptToRun = Nothing
, pausedAtStart = False
, autoShowObjectives = True
, autoPlay = False
, speed = defaultInitLgTicksPerSecond
, debugOptions = mempty
Expand Down
3 changes: 0 additions & 3 deletions src/swarm-tui/Swarm/TUI/Model/DebugOption.hs
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,6 @@ data DebugOption
| ListAllRobots
| ListRobotIDs
| ShowHiddenGoals
| ShowGoalDialogsInAutoPlay
| LoadTestingScenarios
deriving (Eq, Ord, Show, Enum, Bounded)

Expand All @@ -32,7 +31,6 @@ debugOptionName = \case
ListAllRobots -> "all_robots"
ListRobotIDs -> "robot_id"
ShowHiddenGoals -> "hidden_goals"
ShowGoalDialogsInAutoPlay -> "autoplay_goals"
LoadTestingScenarios -> "testing"

debugOptionDescription :: DebugOption -> String
Expand All @@ -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
Expand Down
11 changes: 9 additions & 2 deletions src/swarm-tui/Swarm/TUI/Model/StateUpdate.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
29 changes: 20 additions & 9 deletions src/swarm-tui/Swarm/TUI/Model/UI.hs
Original file line number Diff line number Diff line change
Expand Up @@ -33,6 +33,7 @@ module Swarm.TUI.Model.UI (
uiStructure,
uiDialogs,
uiIsAutoPlay,
uiAutoShowObjectives,
uiAchievements,
lgTicksPerSecond,
lastFrameTime,
Expand All @@ -57,6 +58,7 @@ module Swarm.TUI.Model.UI (
initFocusRing,
defaultInitLgTicksPerSecond,
initUIState,
UIInitOptions (..),
) where

import Brick (AttrMap)
Expand Down Expand Up @@ -226,6 +228,7 @@ data UIGameplay = UIGameplay
, _uiScrollToEnd :: Bool
, _uiDialogs :: UIDialogs
, _uiIsAutoPlay :: Bool
, _uiAutoShowObjectives :: Bool
, _uiShowREPL :: Bool
, _uiShowDebug :: Bool
, _uiHideRobotsUntil :: TimeSpec
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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@
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down
4 changes: 3 additions & 1 deletion test/bench/Benchmark.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down