{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
module Swarm.TUI.Model.StateUpdate (
  initAppState,
  initPersistentState,
  constructAppState,
  initAppStateForScenario,
  classicGame0,
  startGame,
  startGameWithSeed,
  restartGame,
  attainAchievement,
  attainAchievement',
  getScenarioInfoFromPath,
  scenarioToAppState,
  animMgrTickDuration,
  PersistentState (..),
) where

import Brick.Animation (startAnimationManager)
import Brick.AttrMap (applyAttrMappings)
import Brick.BChan (BChan, newBChan)
import Brick.Focus
import Brick.Widgets.List qualified as BL
import Control.Applicative ((<|>))
import Control.Arrow ((&&&))
import Control.Carrier.Accum.Strict (runAccum)
import Control.Effect.Accum
import Control.Effect.Lift
import Control.Effect.Throw
import Control.Lens hiding (from, (<.>))
import Control.Monad (guard, unless, void)
import Control.Monad.Except (ExceptT (..))
import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.State (MonadState, execStateT)
import Data.Bifunctor (first)
import Data.Foldable qualified as F
import Data.List qualified as List
import Data.List.Extra (enumerate)
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as M
import Data.Maybe (fromMaybe, isJust)
import Data.Sequence (Seq)
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Text qualified as T
import Data.Time (getZonedTime)
import Swarm.Failure (SystemFailure (..))
import Swarm.Game.Achievement.Attainment
import Swarm.Game.Achievement.Persistence
import Swarm.Game.Land
import Swarm.Game.Scenario (
  ScenarioInputs (..),
  gsiScenarioInputs,
  loadScenario,
  scenarioAttrs,
  scenarioLandscape,
  scenarioOperation,
  scenarioSolution,
  scenarioWorlds,
 )
import Swarm.Game.Scenario.Scoring.Best
import Swarm.Game.Scenario.Scoring.ConcreteMetrics
import Swarm.Game.Scenario.Scoring.GenericMetrics
import Swarm.Game.Scenario.Status
import Swarm.Game.Scenario.Topography.Structure.Recognition.Type (originalStructureDefinitions)
import Swarm.Game.ScenarioInfo (
  ScenarioCollection,
  loadScenarios,
  normalizeScenarioPath,
  pathifyCollection,
  scenarioItemByPath,
  _SISingle,
 )
import Swarm.Game.State
import Swarm.Game.State.Initialize
import Swarm.Game.State.Landscape
import Swarm.Game.State.Runtime
import Swarm.Game.State.Substate
import Swarm.Game.Tick (TickNumber (TickNumber))
import Swarm.Game.World.Gen (Seed)
import Swarm.Log (LogSource (SystemLog), Severity (..))
import Swarm.Pretty (prettyText)
import Swarm.ResourceLoading (getSwarmHistoryPath)
import Swarm.TUI.Editor.Model
import Swarm.TUI.Editor.Model qualified as EM
import Swarm.TUI.Editor.Util qualified as EU
import Swarm.TUI.Inventory.Sorting
import Swarm.TUI.Launch.Model (toSerializableParams)
import Swarm.TUI.Model
import Swarm.TUI.Model.Achievements
import Swarm.TUI.Model.DebugOption (DebugOption (LoadTestingScenarios))
import Swarm.TUI.Model.Dialog
import Swarm.TUI.Model.KeyBindings
import Swarm.TUI.Model.Name
import Swarm.TUI.Model.Repl
import Swarm.TUI.Model.UI
import Swarm.TUI.Model.UI.Gameplay
import Swarm.TUI.View.Attribute.Attr (getWorldAttrName, swarmAttrMap)
import Swarm.TUI.View.Attribute.CustomStyling (toAttrPair)
import Swarm.TUI.View.Robot
import Swarm.TUI.View.Structure qualified as SR
import Swarm.Util
import Swarm.Util.Effect (asExceptT, withThrow)
import System.Clock

-- | The resolution at which the animation manager checks animations for updates, in miliseconds
animMgrTickDuration :: Int
animMgrTickDuration :: Seed
animMgrTickDuration = Seed
33

-- | Initialize the 'AppState' from scratch.
initAppState ::
  (Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
  AppOpts ->
  Maybe (BChan AppEvent) ->
  m AppState
initAppState :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AppOpts -> Maybe (BChan AppEvent) -> m AppState
initAppState AppOpts
opts Maybe (BChan AppEvent)
mChan = do
  PersistentState
persistentState <- AppOpts -> m PersistentState
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AppOpts -> m PersistentState
initPersistentState AppOpts
opts
  PersistentState -> AppOpts -> Maybe (BChan AppEvent) -> m AppState
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
PersistentState -> AppOpts -> Maybe (BChan AppEvent) -> m AppState
constructAppState PersistentState
persistentState AppOpts
opts Maybe (BChan AppEvent)
mChan

-- | Add some system failures to the list of messages in the
--   'RuntimeState'.
addWarnings :: RuntimeState -> [SystemFailure] -> RuntimeState
addWarnings :: RuntimeState -> [SystemFailure] -> RuntimeState
addWarnings = (RuntimeState -> SystemFailure -> RuntimeState)
-> RuntimeState -> [SystemFailure] -> RuntimeState
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' RuntimeState -> SystemFailure -> RuntimeState
forall {a}. PrettyPrec a => RuntimeState -> a -> RuntimeState
logWarning
 where
  logWarning :: RuntimeState -> a -> RuntimeState
logWarning RuntimeState
rs' a
w = RuntimeState
rs' RuntimeState -> (RuntimeState -> RuntimeState) -> RuntimeState
forall a b. a -> (a -> b) -> b
& (Notifications LogEntry -> Identity (Notifications LogEntry))
-> RuntimeState -> Identity RuntimeState
Lens' RuntimeState (Notifications LogEntry)
eventLog ((Notifications LogEntry -> Identity (Notifications LogEntry))
 -> RuntimeState -> Identity RuntimeState)
-> (Notifications LogEntry -> Notifications LogEntry)
-> RuntimeState
-> RuntimeState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ LogSource
-> Severity
-> Text
-> Text
-> Notifications LogEntry
-> Notifications LogEntry
logEvent LogSource
SystemLog Severity
Error Text
"UI Loading" (a -> Text
forall a. PrettyPrec a => a -> Text
prettyText a
w)

-- | Based on the command line options, should we skip displaying the
--   menu?
skipMenu :: AppOpts -> Bool
skipMenu :: AppOpts -> Bool
skipMenu AppOpts {Bool
Seed
Maybe Seed
Maybe FilePath
Maybe GitInfo
Maybe ColorMode
Set DebugOption
userSeed :: Maybe Seed
userScenario :: Maybe FilePath
scriptToRun :: Maybe FilePath
pausedAtStart :: Bool
autoPlay :: Bool
autoShowObjectives :: Bool
speed :: Seed
debugOptions :: Set DebugOption
colorMode :: Maybe ColorMode
userWebPort :: Maybe Seed
repoGitInfo :: Maybe GitInfo
repoGitInfo :: AppOpts -> Maybe GitInfo
userWebPort :: AppOpts -> Maybe Seed
colorMode :: AppOpts -> Maybe ColorMode
debugOptions :: AppOpts -> Set DebugOption
speed :: AppOpts -> Seed
autoShowObjectives :: AppOpts -> Bool
autoPlay :: AppOpts -> Bool
pausedAtStart :: AppOpts -> Bool
scriptToRun :: AppOpts -> Maybe FilePath
userScenario :: AppOpts -> Maybe FilePath
userSeed :: AppOpts -> Maybe Seed
..} = Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust Maybe FilePath
userScenario Bool -> Bool -> Bool
|| Bool
isRunningInitialProgram Bool -> Bool -> Bool
|| Maybe Seed -> Bool
forall a. Maybe a -> Bool
isJust Maybe Seed
userSeed
 where
  isRunningInitialProgram :: Bool
isRunningInitialProgram = Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust Maybe FilePath
scriptToRun Bool -> Bool -> Bool
|| Bool
autoPlay

mkRuntimeOptions :: AppOpts -> RuntimeOptions
mkRuntimeOptions :: AppOpts -> RuntimeOptions
mkRuntimeOptions AppOpts {Bool
Seed
Maybe Seed
Maybe FilePath
Maybe GitInfo
Maybe ColorMode
Set DebugOption
repoGitInfo :: AppOpts -> Maybe GitInfo
userWebPort :: AppOpts -> Maybe Seed
colorMode :: AppOpts -> Maybe ColorMode
debugOptions :: AppOpts -> Set DebugOption
speed :: AppOpts -> Seed
autoShowObjectives :: AppOpts -> Bool
autoPlay :: AppOpts -> Bool
pausedAtStart :: AppOpts -> Bool
scriptToRun :: AppOpts -> Maybe FilePath
userScenario :: AppOpts -> Maybe FilePath
userSeed :: AppOpts -> Maybe Seed
userSeed :: Maybe Seed
userScenario :: Maybe FilePath
scriptToRun :: Maybe FilePath
pausedAtStart :: Bool
autoPlay :: Bool
autoShowObjectives :: Bool
speed :: Seed
debugOptions :: Set DebugOption
colorMode :: Maybe ColorMode
userWebPort :: Maybe Seed
repoGitInfo :: Maybe GitInfo
..} =
  RuntimeOptions
    { startPaused :: Bool
startPaused = Bool
pausedAtStart
    , pauseOnObjectiveCompletion :: Bool
pauseOnObjectiveCompletion = Bool
autoShowObjectives
    , loadTestScenarios :: Bool
loadTestScenarios = DebugOption -> Set DebugOption -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member DebugOption
LoadTestingScenarios Set DebugOption
debugOptions
    }

data PersistentState
  = PersistentState
      RuntimeState
      UIState
      KeyEventHandlingState
      ProgressionState

-- | Initialize the more persistent parts of the app state, /i.e./ the
--   'RuntimeState' and 'UIState'.  This is split out into a separate
--   function so that in the integration test suite we can call this
--   once and reuse the resulting states for all tests.
initPersistentState ::
  (Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
  AppOpts ->
  m PersistentState
initPersistentState :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AppOpts -> m PersistentState
initPersistentState opts :: AppOpts
opts@(AppOpts {Bool
Seed
Maybe Seed
Maybe FilePath
Maybe GitInfo
Maybe ColorMode
Set DebugOption
repoGitInfo :: AppOpts -> Maybe GitInfo
userWebPort :: AppOpts -> Maybe Seed
colorMode :: AppOpts -> Maybe ColorMode
debugOptions :: AppOpts -> Set DebugOption
speed :: AppOpts -> Seed
autoShowObjectives :: AppOpts -> Bool
autoPlay :: AppOpts -> Bool
pausedAtStart :: AppOpts -> Bool
scriptToRun :: AppOpts -> Maybe FilePath
userScenario :: AppOpts -> Maybe FilePath
userSeed :: AppOpts -> Maybe Seed
userSeed :: Maybe Seed
userScenario :: Maybe FilePath
scriptToRun :: Maybe FilePath
pausedAtStart :: Bool
autoPlay :: Bool
autoShowObjectives :: Bool
speed :: Seed
debugOptions :: Set DebugOption
colorMode :: Maybe ColorMode
userWebPort :: Maybe Seed
repoGitInfo :: Maybe GitInfo
..}) = do
  (Seq SystemFailure
warnings :: Seq SystemFailure, PersistentState RuntimeState
initRS UIState
initUI KeyEventHandlingState
initKs ProgressionState
initProg) <- Seq SystemFailure
-> AccumC (Seq SystemFailure) m PersistentState
-> m (Seq SystemFailure, PersistentState)
forall w (m :: * -> *) a. w -> AccumC w m a -> m (w, a)
runAccum Seq SystemFailure
forall a. Monoid a => a
mempty (AccumC (Seq SystemFailure) m PersistentState
 -> m (Seq SystemFailure, PersistentState))
-> AccumC (Seq SystemFailure) m PersistentState
-> m (Seq SystemFailure, PersistentState)
forall a b. (a -> b) -> a -> b
$ do
    RuntimeState
rs <- RuntimeOptions -> AccumC (Seq SystemFailure) m RuntimeState
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m,
 Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
RuntimeOptions -> m RuntimeState
initRuntimeState (RuntimeOptions -> AccumC (Seq SystemFailure) m RuntimeState)
-> RuntimeOptions -> AccumC (Seq SystemFailure) m RuntimeState
forall a b. (a -> b) -> a -> b
$ AppOpts -> RuntimeOptions
mkRuntimeOptions AppOpts
opts
    let showMainMenu :: Bool
showMainMenu = Bool -> Bool
not (AppOpts -> Bool
skipMenu AppOpts
opts)
    UIState
ui <- UIInitOptions -> AccumC (Seq SystemFailure) m UIState
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
UIInitOptions -> m UIState
initUIState UIInitOptions {Bool
Seed
Set DebugOption
autoShowObjectives :: Bool
speed :: Seed
debugOptions :: Set DebugOption
showMainMenu :: Bool
debugOptions :: Set DebugOption
autoShowObjectives :: Bool
showMainMenu :: Bool
speed :: Seed
..}
    KeyEventHandlingState
ks <- AccumC (Seq SystemFailure) m KeyEventHandlingState
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
m KeyEventHandlingState
initKeyHandlingState

    ScenarioCollection ScenarioInfo
s <-
      ScenarioInputs
-> Bool
-> AccumC (Seq SystemFailure) m (ScenarioCollection ScenarioInfo)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
ScenarioInputs -> Bool -> m (ScenarioCollection ScenarioInfo)
loadScenarios
        (GameStateInputs -> ScenarioInputs
gsiScenarioInputs (GameStateInputs -> ScenarioInputs)
-> GameStateInputs -> ScenarioInputs
forall a b. (a -> b) -> a -> b
$ GameStateConfig -> GameStateInputs
initState (GameStateConfig -> GameStateInputs)
-> GameStateConfig -> GameStateInputs
forall a b. (a -> b) -> a -> b
$ RuntimeState
rs RuntimeState
-> Getting GameStateConfig RuntimeState GameStateConfig
-> GameStateConfig
forall s a. s -> Getting a s a -> a
^. Getting GameStateConfig RuntimeState GameStateConfig
Lens' RuntimeState GameStateConfig
stdGameConfigInputs)
        (RuntimeOptions -> Bool
loadTestScenarios (RuntimeOptions -> Bool) -> RuntimeOptions -> Bool
forall a b. (a -> b) -> a -> b
$ AppOpts -> RuntimeOptions
mkRuntimeOptions AppOpts
opts)
    [Attainment]
achievements <- AccumC (Seq SystemFailure) m [Attainment]
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
m [Attainment]
loadAchievementsInfo

    let animState :: AnimationState
animState = AnimationState
AnimInactive
    let progState :: ProgressionState
progState =
          ProgressionState
            { _scenarios :: ScenarioCollection ScenarioInfo
_scenarios = ScenarioCollection ScenarioInfo
s
            , _attainedAchievements :: Map CategorizedAchievement Attainment
_attainedAchievements = [(CategorizedAchievement, Attainment)]
-> Map CategorizedAchievement Attainment
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(CategorizedAchievement, Attainment)]
 -> Map CategorizedAchievement Attainment)
-> [(CategorizedAchievement, Attainment)]
-> Map CategorizedAchievement Attainment
forall a b. (a -> b) -> a -> b
$ (Attainment -> (CategorizedAchievement, Attainment))
-> [Attainment] -> [(CategorizedAchievement, Attainment)]
forall a b. (a -> b) -> [a] -> [b]
map (Getting CategorizedAchievement Attainment CategorizedAchievement
-> Attainment -> CategorizedAchievement
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting CategorizedAchievement Attainment CategorizedAchievement
Lens' Attainment CategorizedAchievement
achievement (Attainment -> CategorizedAchievement)
-> (Attainment -> Attainment)
-> Attainment
-> (CategorizedAchievement, Attainment)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Attainment -> Attainment
forall a. a -> a
id) [Attainment]
achievements
            , _uiPopups :: PopupState
_uiPopups = PopupState
initPopupState
            , _scenarioSequence :: [ScenarioWith ScenarioPath]
_scenarioSequence = [ScenarioWith ScenarioPath]
forall a. Monoid a => a
mempty
            , _uiPopupAnimationState :: AnimationState
_uiPopupAnimationState = AnimationState
animState
            }
    PersistentState -> AccumC (Seq SystemFailure) m PersistentState
forall a. a -> AccumC (Seq SystemFailure) m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PersistentState -> AccumC (Seq SystemFailure) m PersistentState)
-> PersistentState -> AccumC (Seq SystemFailure) m PersistentState
forall a b. (a -> b) -> a -> b
$ RuntimeState
-> UIState
-> KeyEventHandlingState
-> ProgressionState
-> PersistentState
PersistentState RuntimeState
rs UIState
ui KeyEventHandlingState
ks ProgressionState
progState
  let initRS' :: RuntimeState
initRS' = RuntimeState -> [SystemFailure] -> RuntimeState
addWarnings RuntimeState
initRS (Seq SystemFailure -> [SystemFailure]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList Seq SystemFailure
warnings)
  PersistentState -> m PersistentState
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (PersistentState -> m PersistentState)
-> PersistentState -> m PersistentState
forall a b. (a -> b) -> a -> b
$ RuntimeState
-> UIState
-> KeyEventHandlingState
-> ProgressionState
-> PersistentState
PersistentState RuntimeState
initRS' UIState
initUI KeyEventHandlingState
initKs ProgressionState
initProg

getScenarioInfoFromPath ::
  ScenarioCollection ScenarioInfo ->
  FilePath ->
  ScenarioInfo
getScenarioInfoFromPath :: ScenarioCollection ScenarioInfo -> FilePath -> ScenarioInfo
getScenarioInfoFromPath ScenarioCollection ScenarioInfo
ss FilePath
path =
  ScenarioInfo -> Maybe ScenarioInfo -> ScenarioInfo
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> ScenarioStatus -> ScenarioInfo
forall a. a -> ScenarioStatus -> ScenarioInfoT a
ScenarioInfo FilePath
path ScenarioStatus
NotStarted) Maybe ScenarioInfo
currentScenarioInfo
 where
  currentScenarioInfo :: Maybe ScenarioInfo
currentScenarioInfo = ScenarioCollection ScenarioInfo
ss ScenarioCollection ScenarioInfo
-> Getting
     (First ScenarioInfo) (ScenarioCollection ScenarioInfo) ScenarioInfo
-> Maybe ScenarioInfo
forall s a. s -> Getting (First a) s a -> Maybe a
^? FilePath
-> Traversal'
     (ScenarioCollection ScenarioInfo) (ScenarioItem ScenarioInfo)
forall a.
FilePath -> Traversal' (ScenarioCollection a) (ScenarioItem a)
scenarioItemByPath FilePath
path ((ScenarioItem ScenarioInfo
  -> Const (First ScenarioInfo) (ScenarioItem ScenarioInfo))
 -> ScenarioCollection ScenarioInfo
 -> Const (First ScenarioInfo) (ScenarioCollection ScenarioInfo))
-> ((ScenarioInfo -> Const (First ScenarioInfo) ScenarioInfo)
    -> ScenarioItem ScenarioInfo
    -> Const (First ScenarioInfo) (ScenarioItem ScenarioInfo))
-> Getting
     (First ScenarioInfo) (ScenarioCollection ScenarioInfo) ScenarioInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioWith ScenarioInfo
 -> Const (First ScenarioInfo) (ScenarioWith ScenarioInfo))
-> ScenarioItem ScenarioInfo
-> Const (First ScenarioInfo) (ScenarioItem ScenarioInfo)
forall a (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (ScenarioWith a) (f (ScenarioWith a))
-> p (ScenarioItem a) (f (ScenarioItem a))
_SISingle ((ScenarioWith ScenarioInfo
  -> Const (First ScenarioInfo) (ScenarioWith ScenarioInfo))
 -> ScenarioItem ScenarioInfo
 -> Const (First ScenarioInfo) (ScenarioItem ScenarioInfo))
-> ((ScenarioInfo -> Const (First ScenarioInfo) ScenarioInfo)
    -> ScenarioWith ScenarioInfo
    -> Const (First ScenarioInfo) (ScenarioWith ScenarioInfo))
-> (ScenarioInfo -> Const (First ScenarioInfo) ScenarioInfo)
-> ScenarioItem ScenarioInfo
-> Const (First ScenarioInfo) (ScenarioItem ScenarioInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioInfo -> Const (First ScenarioInfo) ScenarioInfo)
-> ScenarioWith ScenarioInfo
-> Const (First ScenarioInfo) (ScenarioWith ScenarioInfo)
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> ScenarioWith a1 -> f (ScenarioWith a2)
getScenarioInfo

-- | Construct an 'AppState' from an already-loaded 'RuntimeState' and
--   'UIState', given the 'AppOpts' the app was started with.
constructAppState ::
  ( Has (Throw SystemFailure) sig m
  , Has (Lift IO) sig m
  ) =>
  PersistentState ->
  AppOpts ->
  Maybe (BChan AppEvent) ->
  m AppState
constructAppState :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
PersistentState -> AppOpts -> Maybe (BChan AppEvent) -> m AppState
constructAppState (PersistentState RuntimeState
rs UIState
ui KeyEventHandlingState
key ProgressionState
progState) opts :: AppOpts
opts@(AppOpts {Bool
Seed
Maybe Seed
Maybe FilePath
Maybe GitInfo
Maybe ColorMode
Set DebugOption
repoGitInfo :: AppOpts -> Maybe GitInfo
userWebPort :: AppOpts -> Maybe Seed
colorMode :: AppOpts -> Maybe ColorMode
debugOptions :: AppOpts -> Set DebugOption
speed :: AppOpts -> Seed
autoShowObjectives :: AppOpts -> Bool
autoPlay :: AppOpts -> Bool
pausedAtStart :: AppOpts -> Bool
scriptToRun :: AppOpts -> Maybe FilePath
userScenario :: AppOpts -> Maybe FilePath
userSeed :: AppOpts -> Maybe Seed
userSeed :: Maybe Seed
userScenario :: Maybe FilePath
scriptToRun :: Maybe FilePath
pausedAtStart :: Bool
autoPlay :: Bool
autoShowObjectives :: Bool
speed :: Seed
debugOptions :: Set DebugOption
colorMode :: Maybe ColorMode
userWebPort :: Maybe Seed
repoGitInfo :: Maybe GitInfo
..}) Maybe (BChan AppEvent)
mChan = do
  Maybe Text
historyT <- IO (Maybe Text) -> m (Maybe Text)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Maybe Text)
readFileMayT (FilePath -> IO (Maybe Text)) -> IO FilePath -> IO (Maybe Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> IO FilePath
getSwarmHistoryPath Bool
False
  let mkREPLSubmission :: Text -> REPLHistItem
mkREPLSubmission = REPLHistItemType -> TickNumber -> Text -> REPLHistItem
REPLHistItem (REPLEntryType -> REPLHistItemType
REPLEntry REPLEntryType
Submitted) (Int64 -> TickNumber
TickNumber (Int64 -> TickNumber) -> Int64 -> TickNumber
forall a b. (a -> b) -> a -> b
$ -Int64
1)
  let history :: [REPLHistItem]
history = [REPLHistItem]
-> (Text -> [REPLHistItem]) -> Maybe Text -> [REPLHistItem]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Text -> REPLHistItem) -> [Text] -> [REPLHistItem]
forall a b. (a -> b) -> [a] -> [b]
map Text -> REPLHistItem
mkREPLSubmission ([Text] -> [REPLHistItem])
-> (Text -> [Text]) -> Text -> [REPLHistItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines) Maybe Text
historyT
  TimeSpec
startTime <- IO TimeSpec -> m TimeSpec
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO TimeSpec -> m TimeSpec) -> IO TimeSpec -> m TimeSpec
forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
getTime Clock
Monotonic
  BChan AppEvent
chan <- IO (BChan AppEvent) -> m (BChan AppEvent)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO (BChan AppEvent) -> m (BChan AppEvent))
-> IO (BChan AppEvent) -> m (BChan AppEvent)
forall a b. (a -> b) -> a -> b
$ IO (BChan AppEvent)
-> (BChan AppEvent -> IO (BChan AppEvent))
-> Maybe (BChan AppEvent)
-> IO (BChan AppEvent)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO (BChan AppEvent)
initTestChan BChan AppEvent -> IO (BChan AppEvent)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (BChan AppEvent)
mChan
  AnimationManager AppState AppEvent Name
animMgr <- IO (AnimationManager AppState AppEvent Name)
-> m (AnimationManager AppState AppEvent Name)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO (AnimationManager AppState AppEvent Name)
 -> m (AnimationManager AppState AppEvent Name))
-> IO (AnimationManager AppState AppEvent Name)
-> m (AnimationManager AppState AppEvent Name)
forall a b. (a -> b) -> a -> b
$ Seed
-> BChan AppEvent
-> (EventM Name AppState () -> AppEvent)
-> IO (AnimationManager AppState AppEvent Name)
forall (m :: * -> *) e n s.
MonadIO m =>
Seed
-> BChan e -> (EventM n s () -> e) -> m (AnimationManager s e n)
startAnimationManager Seed
animMgrTickDuration BChan AppEvent
chan EventM Name AppState () -> AppEvent
PopupEvent

  let gsc :: GameStateConfig
gsc = RuntimeState
rs RuntimeState
-> Getting GameStateConfig RuntimeState GameStateConfig
-> GameStateConfig
forall s a. s -> Getting a s a -> a
^. Getting GameStateConfig RuntimeState GameStateConfig
Lens' RuntimeState GameStateConfig
stdGameConfigInputs
      gs :: GameState
gs = GameStateConfig -> GameState
initGameState GameStateConfig
gsc
      ps :: PlayState
ps =
        PlayState
          { _scenarioState :: ScenarioState
_scenarioState = GameState -> UIGameplay -> ScenarioState
ScenarioState GameState
gs (UIGameplay -> ScenarioState) -> UIGameplay -> ScenarioState
forall a b. (a -> b) -> a -> b
$ TimeSpec -> [REPLHistItem] -> UIGameplay
initialUiGameplay TimeSpec
startTime [REPLHistItem]
history
          , _progression :: ProgressionState
_progression = ProgressionState
progState
          }

  case AppOpts -> Bool
skipMenu AppOpts
opts of
    Bool
False -> AppState -> m AppState
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (AppState -> m AppState) -> AppState -> m AppState
forall a b. (a -> b) -> a -> b
$ PlayState
-> UIState
-> KeyEventHandlingState
-> RuntimeState
-> AnimationManager AppState AppEvent Name
-> AppState
AppState (PlayState
ps PlayState -> (PlayState -> PlayState) -> PlayState
forall a b. a -> (a -> b) -> b
& (ScenarioState -> Identity ScenarioState)
-> PlayState -> Identity PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Identity ScenarioState)
 -> PlayState -> Identity PlayState)
-> ((Seed -> Identity Seed)
    -> ScenarioState -> Identity ScenarioState)
-> (Seed -> Identity Seed)
-> PlayState
-> Identity PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> ScenarioState -> Identity ScenarioState)
-> ((Seed -> Identity Seed) -> UIGameplay -> Identity UIGameplay)
-> (Seed -> Identity Seed)
-> ScenarioState
-> Identity ScenarioState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UITiming -> Identity UITiming)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay UITiming
uiTiming ((UITiming -> Identity UITiming)
 -> UIGameplay -> Identity UIGameplay)
-> ((Seed -> Identity Seed) -> UITiming -> Identity UITiming)
-> (Seed -> Identity Seed)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seed -> Identity Seed) -> UITiming -> Identity UITiming
Lens' UITiming Seed
lgTicksPerSecond ((Seed -> Identity Seed) -> PlayState -> Identity PlayState)
-> Seed -> PlayState -> PlayState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seed
defaultInitLgTicksPerSecond) UIState
ui KeyEventHandlingState
key RuntimeState
rs AnimationManager AppState AppEvent Name
animMgr
    Bool
True -> do
      let tem :: TerrainEntityMaps
tem = GameState
gs GameState
-> Getting TerrainEntityMaps GameState TerrainEntityMaps
-> TerrainEntityMaps
forall s a. s -> Getting a s a -> a
^. (Landscape -> Const TerrainEntityMaps Landscape)
-> GameState -> Const TerrainEntityMaps GameState
Lens' GameState Landscape
landscape ((Landscape -> Const TerrainEntityMaps Landscape)
 -> GameState -> Const TerrainEntityMaps GameState)
-> ((TerrainEntityMaps
     -> Const TerrainEntityMaps TerrainEntityMaps)
    -> Landscape -> Const TerrainEntityMaps Landscape)
-> Getting TerrainEntityMaps GameState TerrainEntityMaps
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainEntityMaps -> Const TerrainEntityMaps TerrainEntityMaps)
-> Landscape -> Const TerrainEntityMaps Landscape
Lens' Landscape TerrainEntityMaps
terrainAndEntities
      (Scenario
scenario, FilePath
path) <-
        FilePath -> ScenarioInputs -> m (Scenario, FilePath)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
FilePath -> ScenarioInputs -> m (Scenario, FilePath)
loadScenario
          (FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"classic" Maybe FilePath
userScenario)
          (WorldMap -> TerrainEntityMaps -> ScenarioInputs
ScenarioInputs (ScenarioInputs -> WorldMap
initWorldMap (ScenarioInputs -> WorldMap)
-> (GameStateConfig -> ScenarioInputs)
-> GameStateConfig
-> WorldMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameStateInputs -> ScenarioInputs
gsiScenarioInputs (GameStateInputs -> ScenarioInputs)
-> (GameStateConfig -> GameStateInputs)
-> GameStateConfig
-> ScenarioInputs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameStateConfig -> GameStateInputs
initState (GameStateConfig -> WorldMap) -> GameStateConfig -> WorldMap
forall a b. (a -> b) -> a -> b
$ RuntimeState
rs RuntimeState
-> Getting GameStateConfig RuntimeState GameStateConfig
-> GameStateConfig
forall s a. s -> Getting a s a -> a
^. Getting GameStateConfig RuntimeState GameStateConfig
Lens' RuntimeState GameStateConfig
stdGameConfigInputs) TerrainEntityMaps
tem)
      Maybe CodeToRun
maybeRunScript <- (FilePath -> m CodeToRun) -> Maybe FilePath -> m (Maybe CodeToRun)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse FilePath -> m CodeToRun
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
FilePath -> m CodeToRun
parseCodeFile Maybe FilePath
scriptToRun

      let maybeAutoplay :: Maybe CodeToRun
maybeAutoplay = do
            Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
autoPlay
            TSyntax
soln <- Scenario
scenario Scenario
-> Getting (Maybe TSyntax) Scenario (Maybe TSyntax)
-> Maybe TSyntax
forall s a. s -> Getting a s a -> a
^. (ScenarioOperation -> Const (Maybe TSyntax) ScenarioOperation)
-> Scenario -> Const (Maybe TSyntax) Scenario
Lens' Scenario ScenarioOperation
scenarioOperation ((ScenarioOperation -> Const (Maybe TSyntax) ScenarioOperation)
 -> Scenario -> Const (Maybe TSyntax) Scenario)
-> ((Maybe TSyntax -> Const (Maybe TSyntax) (Maybe TSyntax))
    -> ScenarioOperation -> Const (Maybe TSyntax) ScenarioOperation)
-> Getting (Maybe TSyntax) Scenario (Maybe TSyntax)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe TSyntax -> Const (Maybe TSyntax) (Maybe TSyntax))
-> ScenarioOperation -> Const (Maybe TSyntax) ScenarioOperation
Lens' ScenarioOperation (Maybe TSyntax)
scenarioSolution
            CodeToRun -> Maybe CodeToRun
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (CodeToRun -> Maybe CodeToRun) -> CodeToRun -> Maybe CodeToRun
forall a b. (a -> b) -> a -> b
$ SolutionSource -> TSyntax -> CodeToRun
CodeToRun SolutionSource
ScenarioSuggested TSyntax
soln
          codeToRun :: Maybe CodeToRun
codeToRun = Maybe CodeToRun
maybeAutoplay Maybe CodeToRun -> Maybe CodeToRun -> Maybe CodeToRun
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe CodeToRun
maybeRunScript

      let si :: ScenarioInfo
si = ScenarioCollection ScenarioInfo -> FilePath -> ScenarioInfo
getScenarioInfoFromPath (ProgressionState
progState ProgressionState
-> Getting
     (ScenarioCollection ScenarioInfo)
     ProgressionState
     (ScenarioCollection ScenarioInfo)
-> ScenarioCollection ScenarioInfo
forall s a. s -> Getting a s a -> a
^. Getting
  (ScenarioCollection ScenarioInfo)
  ProgressionState
  (ScenarioCollection ScenarioInfo)
Lens' ProgressionState (ScenarioCollection ScenarioInfo)
scenarios) FilePath
path

      IO AppState -> m AppState
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO AppState -> m AppState) -> IO AppState -> m AppState
forall a b. (a -> b) -> a -> b
$
        StateT AppState IO () -> AppState -> IO AppState
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT
          (ScenarioWith ScenarioInfo
-> ValidatedLaunchParams -> StateT AppState IO ()
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioWith ScenarioInfo -> ValidatedLaunchParams -> m ()
startGameWithSeed (Scenario -> ScenarioInfo -> ScenarioWith ScenarioInfo
forall a. Scenario -> a -> ScenarioWith a
ScenarioWith Scenario
scenario ScenarioInfo
si) (ValidatedLaunchParams -> StateT AppState IO ())
-> ValidatedLaunchParams -> StateT AppState IO ()
forall a b. (a -> b) -> a -> b
$ Identity (Maybe Seed)
-> Identity (Maybe CodeToRun) -> ValidatedLaunchParams
forall code (f :: * -> *).
f (Maybe Seed)
-> f (Maybe code) -> ParameterizableLaunchParams code f
LaunchParams (Maybe Seed -> Identity (Maybe Seed)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Seed
userSeed) (Maybe CodeToRun -> Identity (Maybe CodeToRun)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CodeToRun
codeToRun))
          (PlayState
-> UIState
-> KeyEventHandlingState
-> RuntimeState
-> AnimationManager AppState AppEvent Name
-> AppState
AppState PlayState
ps UIState
ui KeyEventHandlingState
key RuntimeState
rs AnimationManager AppState AppEvent Name
animMgr)
 where
  initialUiGameplay :: TimeSpec -> [REPLHistItem] -> UIGameplay
initialUiGameplay TimeSpec
startTime [REPLHistItem]
history =
    UIGameplay
      { _uiFocusRing :: FocusRing Name
_uiFocusRing = FocusRing Name
initFocusRing
      , _uiWorldCursor :: Maybe (Cosmic Coords)
_uiWorldCursor = Maybe (Cosmic Coords)
forall a. Maybe a
Nothing
      , _uiWorldEditor :: WorldEditor Name
_uiWorldEditor = TimeSpec -> WorldEditor Name
initialWorldEditor TimeSpec
startTime
      , _uiREPL :: REPLState
_uiREPL = REPLHistory -> REPLState
initREPLState (REPLHistory -> REPLState) -> REPLHistory -> REPLState
forall a b. (a -> b) -> a -> b
$ [REPLHistItem] -> REPLHistory
newREPLHistory [REPLHistItem]
history
      , _uiInventory :: UIInventory
_uiInventory =
          UIInventory
            { _uiInventoryList :: Maybe (Seed, List Name InventoryListEntry)
_uiInventoryList = Maybe (Seed, List Name InventoryListEntry)
forall a. Maybe a
Nothing
            , _uiInventorySort :: InventorySortOptions
_uiInventorySort = InventorySortOptions
defaultSortOptions
            , _uiInventorySearch :: Maybe Text
_uiInventorySearch = Maybe Text
forall a. Maybe a
Nothing
            , _uiShowZero :: Bool
_uiShowZero = Bool
True
            , _uiInventoryShouldUpdate :: Bool
_uiInventoryShouldUpdate = Bool
False
            }
      , _uiScrollToEnd :: Bool
_uiScrollToEnd = Bool
False
      , _uiDialogs :: UIDialogs
_uiDialogs =
          UIDialogs
            { _uiModal :: Maybe Modal
_uiModal = Maybe Modal
forall a. Maybe a
Nothing
            , _uiGoal :: GoalDisplay
_uiGoal = GoalDisplay
emptyGoalDisplay
            , _uiStructure :: StructureDisplay
_uiStructure = StructureDisplay
emptyStructureDisplay
            , _uiRobot :: RobotDisplay
_uiRobot = Set DebugOption -> RobotDisplay
emptyRobotDisplay Set DebugOption
debugOptions
            }
      , _uiIsAutoPlay :: Bool
_uiIsAutoPlay = Bool
False
      , _uiAutoShowObjectives :: Bool
_uiAutoShowObjectives = Bool
autoShowObjectives
      , _uiTiming :: UITiming
_uiTiming =
          UITiming
            { _uiShowFPS :: Bool
_uiShowFPS = Bool
False
            , _uiTPF :: Double
_uiTPF = Double
0
            , _uiFPS :: Double
_uiFPS = Double
0
            , _lgTicksPerSecond :: Seed
_lgTicksPerSecond = Seed
speed
            , _lastFrameTime :: TimeSpec
_lastFrameTime = TimeSpec
startTime
            , _accumulatedTime :: TimeSpec
_accumulatedTime = TimeSpec
0
            , _lastInfoTime :: TimeSpec
_lastInfoTime = TimeSpec
0
            , _tickCount :: Seed
_tickCount = Seed
0
            , _frameCount :: Seed
_frameCount = Seed
0
            , _frameTickCount :: Seed
_frameTickCount = Seed
0
            }
      , _uiShowREPL :: Bool
_uiShowREPL = Bool
True
      , _uiShowDebug :: Bool
_uiShowDebug = Bool
False
      , _uiHideRobotsUntil :: TimeSpec
_uiHideRobotsUntil = TimeSpec
startTime TimeSpec -> TimeSpec -> TimeSpec
forall a. Num a => a -> a -> a
- TimeSpec
1
      , _scenarioRef :: Maybe (ScenarioWith ScenarioPath)
_scenarioRef = Maybe (ScenarioWith ScenarioPath)
forall a. Maybe a
Nothing
      }

-- | Load a 'Scenario' and start playing the game.
startGame ::
  (MonadIO m, MonadState AppState m) =>
  NonEmpty (ScenarioWith ScenarioPath) ->
  Maybe CodeToRun ->
  m ()
startGame :: forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
NonEmpty (ScenarioWith ScenarioPath) -> Maybe CodeToRun -> m ()
startGame (ScenarioWith Scenario
s (ScenarioPath FilePath
p) :| [ScenarioWith ScenarioPath]
remaining) Maybe CodeToRun
c = do
  (PlayState -> Identity PlayState) -> AppState -> Identity AppState
Lens' AppState PlayState
playState ((PlayState -> Identity PlayState)
 -> AppState -> Identity AppState)
-> (([ScenarioWith ScenarioPath]
     -> Identity [ScenarioWith ScenarioPath])
    -> PlayState -> Identity PlayState)
-> ([ScenarioWith ScenarioPath]
    -> Identity [ScenarioWith ScenarioPath])
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgressionState -> Identity ProgressionState)
-> PlayState -> Identity PlayState
Lens' PlayState ProgressionState
progression ((ProgressionState -> Identity ProgressionState)
 -> PlayState -> Identity PlayState)
-> (([ScenarioWith ScenarioPath]
     -> Identity [ScenarioWith ScenarioPath])
    -> ProgressionState -> Identity ProgressionState)
-> ([ScenarioWith ScenarioPath]
    -> Identity [ScenarioWith ScenarioPath])
-> PlayState
-> Identity PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ScenarioWith ScenarioPath]
 -> Identity [ScenarioWith ScenarioPath])
-> ProgressionState -> Identity ProgressionState
Lens' ProgressionState [ScenarioWith ScenarioPath]
scenarioSequence (([ScenarioWith ScenarioPath]
  -> Identity [ScenarioWith ScenarioPath])
 -> AppState -> Identity AppState)
-> [ScenarioWith ScenarioPath] -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= [ScenarioWith ScenarioPath]
remaining
  ScenarioCollection ScenarioInfo
ss <- Getting
  (ScenarioCollection ScenarioInfo)
  AppState
  (ScenarioCollection ScenarioInfo)
-> m (ScenarioCollection ScenarioInfo)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting
   (ScenarioCollection ScenarioInfo)
   AppState
   (ScenarioCollection ScenarioInfo)
 -> m (ScenarioCollection ScenarioInfo))
-> Getting
     (ScenarioCollection ScenarioInfo)
     AppState
     (ScenarioCollection ScenarioInfo)
-> m (ScenarioCollection ScenarioInfo)
forall a b. (a -> b) -> a -> b
$ (PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
-> AppState -> Const (ScenarioCollection ScenarioInfo) AppState
Lens' AppState PlayState
playState ((PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
 -> AppState -> Const (ScenarioCollection ScenarioInfo) AppState)
-> ((ScenarioCollection ScenarioInfo
     -> Const
          (ScenarioCollection ScenarioInfo)
          (ScenarioCollection ScenarioInfo))
    -> PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
-> Getting
     (ScenarioCollection ScenarioInfo)
     AppState
     (ScenarioCollection ScenarioInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgressionState
 -> Const (ScenarioCollection ScenarioInfo) ProgressionState)
-> PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState
Lens' PlayState ProgressionState
progression ((ProgressionState
  -> Const (ScenarioCollection ScenarioInfo) ProgressionState)
 -> PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
-> Getting
     (ScenarioCollection ScenarioInfo)
     ProgressionState
     (ScenarioCollection ScenarioInfo)
-> (ScenarioCollection ScenarioInfo
    -> Const
         (ScenarioCollection ScenarioInfo)
         (ScenarioCollection ScenarioInfo))
-> PlayState
-> Const (ScenarioCollection ScenarioInfo) PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (ScenarioCollection ScenarioInfo)
  ProgressionState
  (ScenarioCollection ScenarioInfo)
Lens' ProgressionState (ScenarioCollection ScenarioInfo)
scenarios
  let si :: ScenarioInfo
si = ScenarioCollection ScenarioInfo -> FilePath -> ScenarioInfo
getScenarioInfoFromPath ScenarioCollection ScenarioInfo
ss FilePath
p
  ScenarioWith ScenarioInfo -> ValidatedLaunchParams -> m ()
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioWith ScenarioInfo -> ValidatedLaunchParams -> m ()
startGameWithSeed (Scenario -> ScenarioInfo -> ScenarioWith ScenarioInfo
forall a. Scenario -> a -> ScenarioWith a
ScenarioWith Scenario
s ScenarioInfo
si) (ValidatedLaunchParams -> m ())
-> (Identity (Maybe CodeToRun) -> ValidatedLaunchParams)
-> Identity (Maybe CodeToRun)
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (Maybe Seed)
-> Identity (Maybe CodeToRun) -> ValidatedLaunchParams
forall code (f :: * -> *).
f (Maybe Seed)
-> f (Maybe code) -> ParameterizableLaunchParams code f
LaunchParams (Maybe Seed -> Identity (Maybe Seed)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Seed
forall a. Maybe a
Nothing) (Identity (Maybe CodeToRun) -> m ())
-> Identity (Maybe CodeToRun) -> m ()
forall a b. (a -> b) -> a -> b
$ Maybe CodeToRun -> Identity (Maybe CodeToRun)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CodeToRun
c

-- | Re-initialize the game from the stored reference to the current scenario.
--
-- Note that "restarting" is intended only for "scenarios";
-- with some scenarios, it may be possible to get stuck so that it is
-- either impossible or very annoying to win, so being offered an
-- option to restart is more user-friendly.
--
-- 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 ->
  ScenarioWith ScenarioPath ->
  m ()
restartGame :: forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
Seed -> ScenarioWith ScenarioPath -> m ()
restartGame Seed
currentSeed (ScenarioWith Scenario
s (ScenarioPath FilePath
p)) = do
  ScenarioCollection ScenarioInfo
ss <- Getting
  (ScenarioCollection ScenarioInfo)
  AppState
  (ScenarioCollection ScenarioInfo)
-> m (ScenarioCollection ScenarioInfo)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting
   (ScenarioCollection ScenarioInfo)
   AppState
   (ScenarioCollection ScenarioInfo)
 -> m (ScenarioCollection ScenarioInfo))
-> Getting
     (ScenarioCollection ScenarioInfo)
     AppState
     (ScenarioCollection ScenarioInfo)
-> m (ScenarioCollection ScenarioInfo)
forall a b. (a -> b) -> a -> b
$ (PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
-> AppState -> Const (ScenarioCollection ScenarioInfo) AppState
Lens' AppState PlayState
playState ((PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
 -> AppState -> Const (ScenarioCollection ScenarioInfo) AppState)
-> ((ScenarioCollection ScenarioInfo
     -> Const
          (ScenarioCollection ScenarioInfo)
          (ScenarioCollection ScenarioInfo))
    -> PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
-> Getting
     (ScenarioCollection ScenarioInfo)
     AppState
     (ScenarioCollection ScenarioInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgressionState
 -> Const (ScenarioCollection ScenarioInfo) ProgressionState)
-> PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState
Lens' PlayState ProgressionState
progression ((ProgressionState
  -> Const (ScenarioCollection ScenarioInfo) ProgressionState)
 -> PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
-> Getting
     (ScenarioCollection ScenarioInfo)
     ProgressionState
     (ScenarioCollection ScenarioInfo)
-> (ScenarioCollection ScenarioInfo
    -> Const
         (ScenarioCollection ScenarioInfo)
         (ScenarioCollection ScenarioInfo))
-> PlayState
-> Const (ScenarioCollection ScenarioInfo) PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (ScenarioCollection ScenarioInfo)
  ProgressionState
  (ScenarioCollection ScenarioInfo)
Lens' ProgressionState (ScenarioCollection ScenarioInfo)
scenarios
  let si :: ScenarioInfo
si = ScenarioCollection ScenarioInfo -> FilePath -> ScenarioInfo
getScenarioInfoFromPath ScenarioCollection ScenarioInfo
ss FilePath
p
  ScenarioWith ScenarioInfo -> ValidatedLaunchParams -> m ()
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioWith ScenarioInfo -> ValidatedLaunchParams -> m ()
startGameWithSeed (Scenario -> ScenarioInfo -> ScenarioWith ScenarioInfo
forall a. Scenario -> a -> ScenarioWith a
ScenarioWith Scenario
s ScenarioInfo
si) (ValidatedLaunchParams -> m ()) -> ValidatedLaunchParams -> m ()
forall a b. (a -> b) -> a -> b
$ Identity (Maybe Seed)
-> Identity (Maybe CodeToRun) -> ValidatedLaunchParams
forall code (f :: * -> *).
f (Maybe Seed)
-> f (Maybe code) -> ParameterizableLaunchParams code f
LaunchParams (Maybe Seed -> Identity (Maybe Seed)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Seed -> Maybe Seed
forall a. a -> Maybe a
Just Seed
currentSeed)) (Maybe CodeToRun -> Identity (Maybe CodeToRun)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CodeToRun
forall a. Maybe a
Nothing)

-- | Load a 'Scenario' and start playing the game, with the
--   possibility for the user to override the seed.
startGameWithSeed ::
  (MonadIO m, MonadState AppState m) =>
  ScenarioWith ScenarioInfo ->
  ValidatedLaunchParams ->
  m ()
startGameWithSeed :: forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioWith ScenarioInfo -> ValidatedLaunchParams -> m ()
startGameWithSeed siPair :: ScenarioWith ScenarioInfo
siPair@(ScenarioWith Scenario
_scene ScenarioInfo
si) ValidatedLaunchParams
lp = do
  ZonedTime
t <- IO ZonedTime -> m ZonedTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ZonedTime
getZonedTime
  ScenarioCollection ScenarioInfo
ss <- Getting
  (ScenarioCollection ScenarioInfo)
  AppState
  (ScenarioCollection ScenarioInfo)
-> m (ScenarioCollection ScenarioInfo)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting
   (ScenarioCollection ScenarioInfo)
   AppState
   (ScenarioCollection ScenarioInfo)
 -> m (ScenarioCollection ScenarioInfo))
-> Getting
     (ScenarioCollection ScenarioInfo)
     AppState
     (ScenarioCollection ScenarioInfo)
-> m (ScenarioCollection ScenarioInfo)
forall a b. (a -> b) -> a -> b
$ (PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
-> AppState -> Const (ScenarioCollection ScenarioInfo) AppState
Lens' AppState PlayState
playState ((PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
 -> AppState -> Const (ScenarioCollection ScenarioInfo) AppState)
-> ((ScenarioCollection ScenarioInfo
     -> Const
          (ScenarioCollection ScenarioInfo)
          (ScenarioCollection ScenarioInfo))
    -> PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
-> Getting
     (ScenarioCollection ScenarioInfo)
     AppState
     (ScenarioCollection ScenarioInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgressionState
 -> Const (ScenarioCollection ScenarioInfo) ProgressionState)
-> PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState
Lens' PlayState ProgressionState
progression ((ProgressionState
  -> Const (ScenarioCollection ScenarioInfo) ProgressionState)
 -> PlayState -> Const (ScenarioCollection ScenarioInfo) PlayState)
-> Getting
     (ScenarioCollection ScenarioInfo)
     ProgressionState
     (ScenarioCollection ScenarioInfo)
-> (ScenarioCollection ScenarioInfo
    -> Const
         (ScenarioCollection ScenarioInfo)
         (ScenarioCollection ScenarioInfo))
-> PlayState
-> Const (ScenarioCollection ScenarioInfo) PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (ScenarioCollection ScenarioInfo)
  ProgressionState
  (ScenarioCollection ScenarioInfo)
Lens' ProgressionState (ScenarioCollection ScenarioInfo)
scenarios
  FilePath
p <- IO FilePath -> m FilePath
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ ScenarioCollection ScenarioInfo -> FilePath -> IO FilePath
forall (m :: * -> *) a.
MonadIO m =>
ScenarioCollection a -> FilePath -> m FilePath
normalizeScenarioPath ScenarioCollection ScenarioInfo
ss (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ ScenarioInfo
si ScenarioInfo -> Getting FilePath ScenarioInfo FilePath -> FilePath
forall s a. s -> Getting a s a -> a
^. Getting FilePath ScenarioInfo FilePath
Lens' ScenarioInfo FilePath
scenarioPath

  (PlayState -> Identity PlayState) -> AppState -> Identity AppState
Lens' AppState PlayState
playState
    ((PlayState -> Identity PlayState)
 -> AppState -> Identity AppState)
-> ((ScenarioStatus -> Identity ScenarioStatus)
    -> PlayState -> Identity PlayState)
-> (ScenarioStatus -> Identity ScenarioStatus)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgressionState -> Identity ProgressionState)
-> PlayState -> Identity PlayState
Lens' PlayState ProgressionState
progression
    ((ProgressionState -> Identity ProgressionState)
 -> PlayState -> Identity PlayState)
-> ((ScenarioStatus -> Identity ScenarioStatus)
    -> ProgressionState -> Identity ProgressionState)
-> (ScenarioStatus -> Identity ScenarioStatus)
-> PlayState
-> Identity PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioCollection ScenarioInfo
 -> Identity (ScenarioCollection ScenarioInfo))
-> ProgressionState -> Identity ProgressionState
Lens' ProgressionState (ScenarioCollection ScenarioInfo)
scenarios
    ((ScenarioCollection ScenarioInfo
  -> Identity (ScenarioCollection ScenarioInfo))
 -> ProgressionState -> Identity ProgressionState)
-> ((ScenarioStatus -> Identity ScenarioStatus)
    -> ScenarioCollection ScenarioInfo
    -> Identity (ScenarioCollection ScenarioInfo))
-> (ScenarioStatus -> Identity ScenarioStatus)
-> ProgressionState
-> Identity ProgressionState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath
-> Traversal'
     (ScenarioCollection ScenarioInfo) (ScenarioItem ScenarioInfo)
forall a.
FilePath -> Traversal' (ScenarioCollection a) (ScenarioItem a)
scenarioItemByPath FilePath
p
    ((ScenarioItem ScenarioInfo
  -> Identity (ScenarioItem ScenarioInfo))
 -> ScenarioCollection ScenarioInfo
 -> Identity (ScenarioCollection ScenarioInfo))
-> ((ScenarioStatus -> Identity ScenarioStatus)
    -> ScenarioItem ScenarioInfo
    -> Identity (ScenarioItem ScenarioInfo))
-> (ScenarioStatus -> Identity ScenarioStatus)
-> ScenarioCollection ScenarioInfo
-> Identity (ScenarioCollection ScenarioInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioWith ScenarioInfo -> Identity (ScenarioWith ScenarioInfo))
-> ScenarioItem ScenarioInfo
-> Identity (ScenarioItem ScenarioInfo)
forall a (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p (ScenarioWith a) (f (ScenarioWith a))
-> p (ScenarioItem a) (f (ScenarioItem a))
_SISingle
    ((ScenarioWith ScenarioInfo
  -> Identity (ScenarioWith ScenarioInfo))
 -> ScenarioItem ScenarioInfo
 -> Identity (ScenarioItem ScenarioInfo))
-> ((ScenarioStatus -> Identity ScenarioStatus)
    -> ScenarioWith ScenarioInfo
    -> Identity (ScenarioWith ScenarioInfo))
-> (ScenarioStatus -> Identity ScenarioStatus)
-> ScenarioItem ScenarioInfo
-> Identity (ScenarioItem ScenarioInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioInfo -> Identity ScenarioInfo)
-> ScenarioWith ScenarioInfo
-> Identity (ScenarioWith ScenarioInfo)
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> ScenarioWith a1 -> f (ScenarioWith a2)
getScenarioInfo
    ((ScenarioInfo -> Identity ScenarioInfo)
 -> ScenarioWith ScenarioInfo
 -> Identity (ScenarioWith ScenarioInfo))
-> ((ScenarioStatus -> Identity ScenarioStatus)
    -> ScenarioInfo -> Identity ScenarioInfo)
-> (ScenarioStatus -> Identity ScenarioStatus)
-> ScenarioWith ScenarioInfo
-> Identity (ScenarioWith ScenarioInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioStatus -> Identity ScenarioStatus)
-> ScenarioInfo -> Identity ScenarioInfo
Lens' ScenarioInfo ScenarioStatus
scenarioStatus
    ((ScenarioStatus -> Identity ScenarioStatus)
 -> AppState -> Identity AppState)
-> ScenarioStatus -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= SerializableLaunchParams
-> ProgressMetric -> BestRecords -> ScenarioStatus
Played
      (ValidatedLaunchParams -> SerializableLaunchParams
toSerializableParams ValidatedLaunchParams
lp)
      (Progress -> ProgressStats -> ProgressMetric
forall a. Progress -> a -> Metric a
Metric Progress
Attempted (ProgressStats -> ProgressMetric)
-> ProgressStats -> ProgressMetric
forall a b. (a -> b) -> a -> b
$ ZonedTime -> AttemptMetrics -> ProgressStats
ProgressStats ZonedTime
t AttemptMetrics
emptyAttemptMetric)
      (ZonedTime -> BestRecords
prevBest ZonedTime
t)

  ScenarioWith ScenarioPath -> ValidatedLaunchParams -> m ()
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioWith ScenarioPath -> ValidatedLaunchParams -> m ()
scenarioToAppState (ScenarioWith ScenarioInfo -> ScenarioWith ScenarioPath
forall (f :: * -> *). Functor f => f ScenarioInfo -> f ScenarioPath
pathifyCollection ScenarioWith ScenarioInfo
siPair) ValidatedLaunchParams
lp

  -- Warn the user that the use of debugging options means progress
  -- will not be saved.
  Set DebugOption
debugging <- Getting (Set DebugOption) AppState (Set DebugOption)
-> m (Set DebugOption)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (Set DebugOption) AppState (Set DebugOption)
 -> m (Set DebugOption))
-> Getting (Set DebugOption) AppState (Set DebugOption)
-> m (Set DebugOption)
forall a b. (a -> b) -> a -> b
$ (UIState -> Const (Set DebugOption) UIState)
-> AppState -> Const (Set DebugOption) AppState
Lens' AppState UIState
uiState ((UIState -> Const (Set DebugOption) UIState)
 -> AppState -> Const (Set DebugOption) AppState)
-> ((Set DebugOption -> Const (Set DebugOption) (Set DebugOption))
    -> UIState -> Const (Set DebugOption) UIState)
-> Getting (Set DebugOption) AppState (Set DebugOption)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set DebugOption -> Const (Set DebugOption) (Set DebugOption))
-> UIState -> Const (Set DebugOption) UIState
Lens' UIState (Set DebugOption)
uiDebugOptions
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Set DebugOption -> Bool
forall a. Set a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Set DebugOption
debugging) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    (PlayState -> Identity PlayState) -> AppState -> Identity AppState
Lens' AppState PlayState
playState ((PlayState -> Identity PlayState)
 -> AppState -> Identity AppState)
-> ((PopupState -> Identity PopupState)
    -> PlayState -> Identity PlayState)
-> (PopupState -> Identity PopupState)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgressionState -> Identity ProgressionState)
-> PlayState -> Identity PlayState
Lens' PlayState ProgressionState
progression ((ProgressionState -> Identity ProgressionState)
 -> PlayState -> Identity PlayState)
-> ((PopupState -> Identity PopupState)
    -> ProgressionState -> Identity ProgressionState)
-> (PopupState -> Identity PopupState)
-> PlayState
-> Identity PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PopupState -> Identity PopupState)
-> ProgressionState -> Identity ProgressionState
Lens' ProgressionState PopupState
uiPopups ((PopupState -> Identity PopupState)
 -> AppState -> Identity AppState)
-> (PopupState -> PopupState) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Popup -> PopupState -> PopupState
addPopup Popup
DebugWarningPopup
 where
  prevBest :: ZonedTime -> BestRecords
prevBest ZonedTime
t = case ScenarioInfo
si ScenarioInfo
-> Getting ScenarioStatus ScenarioInfo ScenarioStatus
-> ScenarioStatus
forall s a. s -> Getting a s a -> a
^. Getting ScenarioStatus ScenarioInfo ScenarioStatus
Lens' ScenarioInfo ScenarioStatus
scenarioStatus of
    ScenarioStatus
NotStarted -> ZonedTime -> BestRecords
emptyBest ZonedTime
t
    Played SerializableLaunchParams
_ ProgressMetric
_ BestRecords
b -> BestRecords
b

-- | Modify the 'AppState' appropriately when starting a new scenario.
scenarioToAppState ::
  (MonadIO m, MonadState AppState m) =>
  ScenarioWith ScenarioPath ->
  ValidatedLaunchParams ->
  m ()
scenarioToAppState :: forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioWith ScenarioPath -> ValidatedLaunchParams -> m ()
scenarioToAppState siPair :: ScenarioWith ScenarioPath
siPair@(ScenarioWith Scenario
scene ScenarioPath
p) ValidatedLaunchParams
lp = do
  RuntimeState
rs <- Getting RuntimeState AppState RuntimeState -> m RuntimeState
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting RuntimeState AppState RuntimeState
Lens' AppState RuntimeState
runtimeState
  GameState
gs <- IO GameState -> m GameState
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GameState -> m GameState) -> IO GameState -> m GameState
forall a b. (a -> b) -> a -> b
$ ScenarioWith (Maybe ScenarioPath)
-> ValidatedLaunchParams -> GameStateConfig -> IO GameState
scenarioToGameState (Scenario -> Maybe ScenarioPath -> ScenarioWith (Maybe ScenarioPath)
forall a. Scenario -> a -> ScenarioWith a
ScenarioWith Scenario
scene (Maybe ScenarioPath -> ScenarioWith (Maybe ScenarioPath))
-> Maybe ScenarioPath -> ScenarioWith (Maybe ScenarioPath)
forall a b. (a -> b) -> a -> b
$ ScenarioPath -> Maybe ScenarioPath
forall a. a -> Maybe a
Just ScenarioPath
p) ValidatedLaunchParams
lp (GameStateConfig -> IO GameState)
-> GameStateConfig -> IO GameState
forall a b. (a -> b) -> a -> b
$ RuntimeState
rs RuntimeState
-> Getting GameStateConfig RuntimeState GameStateConfig
-> GameStateConfig
forall s a. s -> Getting a s a -> a
^. Getting GameStateConfig RuntimeState GameStateConfig
Lens' RuntimeState GameStateConfig
stdGameConfigInputs
  (PlayState -> Identity PlayState) -> AppState -> Identity AppState
Lens' AppState PlayState
playState ((PlayState -> Identity PlayState)
 -> AppState -> Identity AppState)
-> ((GameState -> Identity GameState)
    -> PlayState -> Identity PlayState)
-> (GameState -> Identity GameState)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState -> Identity ScenarioState)
-> PlayState -> Identity PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Identity ScenarioState)
 -> PlayState -> Identity PlayState)
-> ((GameState -> Identity GameState)
    -> ScenarioState -> Identity ScenarioState)
-> (GameState -> Identity GameState)
-> PlayState
-> Identity PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GameState -> Identity GameState)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState GameState
gameState ((GameState -> Identity GameState)
 -> AppState -> Identity AppState)
-> GameState -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= GameState
gs

  TimeSpec
curTime <- IO TimeSpec -> m TimeSpec
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TimeSpec -> m TimeSpec) -> IO TimeSpec -> m TimeSpec
forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
getTime Clock
Monotonic
  (PlayState -> Identity PlayState) -> AppState -> Identity AppState
Lens' AppState PlayState
playState ((PlayState -> Identity PlayState)
 -> AppState -> Identity AppState)
-> ((UIGameplay -> Identity UIGameplay)
    -> PlayState -> Identity PlayState)
-> (UIGameplay -> Identity UIGameplay)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioState -> Identity ScenarioState)
-> PlayState -> Identity PlayState
Lens' PlayState ScenarioState
scenarioState ((ScenarioState -> Identity ScenarioState)
 -> PlayState -> Identity PlayState)
-> ((UIGameplay -> Identity UIGameplay)
    -> ScenarioState -> Identity ScenarioState)
-> (UIGameplay -> Identity UIGameplay)
-> PlayState
-> Identity PlayState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay)
-> ScenarioState -> Identity ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> AppState -> Identity AppState)
-> (UIGameplay -> UIGameplay) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= GameState
-> TimeSpec
-> Bool
-> ScenarioWith ScenarioPath
-> UIGameplay
-> UIGameplay
setUIGameplay GameState
gs TimeSpec
curTime Bool
isAutoplaying ScenarioWith ScenarioPath
siPair

  m UIState -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m UIState -> m ()) -> m UIState -> m ()
forall a b. (a -> b) -> a -> b
$ Lens' AppState UIState -> (UIState -> IO UIState) -> m UIState
forall (m :: * -> *) x.
(MonadIO m, MonadState AppState m) =>
Lens' AppState x -> (x -> IO x) -> m x
withLensIO (UIState -> f UIState) -> AppState -> f AppState
Lens' AppState UIState
uiState ((UIState -> IO UIState) -> m UIState)
-> (UIState -> IO UIState) -> m UIState
forall a b. (a -> b) -> a -> b
$ ScenarioWith ScenarioPath -> UIState -> IO UIState
forall a. ScenarioWith a -> UIState -> IO UIState
scenarioToUIState ScenarioWith ScenarioPath
siPair
 where
  isAutoplaying :: Bool
isAutoplaying = case (CodeToRun -> SolutionSource)
-> Maybe CodeToRun -> Maybe SolutionSource
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting SolutionSource CodeToRun SolutionSource
-> CodeToRun -> SolutionSource
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting SolutionSource CodeToRun SolutionSource
Lens' CodeToRun SolutionSource
toRunSource) (Maybe CodeToRun -> Maybe SolutionSource)
-> (Identity (Maybe CodeToRun) -> Maybe CodeToRun)
-> Identity (Maybe CodeToRun)
-> Maybe SolutionSource
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (Maybe CodeToRun) -> Maybe CodeToRun
forall a. Identity a -> a
runIdentity (Identity (Maybe CodeToRun) -> Maybe SolutionSource)
-> Identity (Maybe CodeToRun) -> Maybe SolutionSource
forall a b. (a -> b) -> a -> b
$ ValidatedLaunchParams -> Identity (Maybe CodeToRun)
forall code (f :: * -> *).
ParameterizableLaunchParams code f -> f (Maybe code)
initialCode ValidatedLaunchParams
lp of
    Just SolutionSource
ScenarioSuggested -> Bool
True
    Maybe SolutionSource
_ -> Bool
False

  withLensIO :: (MonadIO m, MonadState AppState m) => Lens' AppState x -> (x -> IO x) -> m x
  withLensIO :: forall (m :: * -> *) x.
(MonadIO m, MonadState AppState m) =>
Lens' AppState x -> (x -> IO x) -> m x
withLensIO Lens' AppState x
l x -> IO x
a = do
    x
x <- Getting x AppState x -> m x
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting x AppState x
Lens' AppState x
l
    x
x' <- IO x -> m x
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO x -> m x) -> IO x -> m x
forall a b. (a -> b) -> a -> b
$ x -> IO x
a x
x
    (x -> Identity x) -> AppState -> Identity AppState
Lens' AppState x
l ((x -> Identity x) -> AppState -> Identity AppState) -> x -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= x
x'
    x -> m x
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return x
x'

setUIGameplay ::
  GameState ->
  TimeSpec ->
  Bool ->
  ScenarioWith ScenarioPath ->
  UIGameplay ->
  UIGameplay
setUIGameplay :: GameState
-> TimeSpec
-> Bool
-> ScenarioWith ScenarioPath
-> UIGameplay
-> UIGameplay
setUIGameplay GameState
gs TimeSpec
curTime Bool
isAutoplaying siPair :: ScenarioWith ScenarioPath
siPair@(ScenarioWith Scenario
scenario ScenarioPath
_) UIGameplay
uig =
  UIGameplay
uig
    UIGameplay -> (UIGameplay -> UIGameplay) -> UIGameplay
forall a b. a -> (a -> b) -> b
& (UIDialogs -> Identity UIDialogs)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Identity UIDialogs)
 -> UIGameplay -> Identity UIGameplay)
-> ((GoalDisplay -> Identity GoalDisplay)
    -> UIDialogs -> Identity UIDialogs)
-> (GoalDisplay -> Identity GoalDisplay)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GoalDisplay -> Identity GoalDisplay)
-> UIDialogs -> Identity UIDialogs
Lens' UIDialogs GoalDisplay
uiGoal ((GoalDisplay -> Identity GoalDisplay)
 -> UIGameplay -> Identity UIGameplay)
-> GoalDisplay -> UIGameplay -> UIGameplay
forall s t a b. ASetter s t a b -> b -> s -> t
.~ GoalDisplay
emptyGoalDisplay
    UIGameplay -> (UIGameplay -> UIGameplay) -> UIGameplay
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> UIGameplay -> Identity UIGameplay
Lens' UIGameplay Bool
uiIsAutoPlay ((Bool -> Identity Bool) -> UIGameplay -> Identity UIGameplay)
-> Bool -> UIGameplay -> UIGameplay
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
isAutoplaying
    UIGameplay -> (UIGameplay -> UIGameplay) -> UIGameplay
forall a b. a -> (a -> b) -> b
& (FocusRing Name -> Identity (FocusRing Name))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (FocusRing Name)
uiFocusRing ((FocusRing Name -> Identity (FocusRing Name))
 -> UIGameplay -> Identity UIGameplay)
-> FocusRing Name -> UIGameplay -> UIGameplay
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FocusRing Name
initFocusRing
    UIGameplay -> (UIGameplay -> UIGameplay) -> UIGameplay
forall a b. a -> (a -> b) -> b
& (UIInventory -> Identity UIInventory)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay UIInventory
uiInventory ((UIInventory -> Identity UIInventory)
 -> UIGameplay -> Identity UIGameplay)
-> ((Maybe Text -> Identity (Maybe Text))
    -> UIInventory -> Identity UIInventory)
-> (Maybe Text -> Identity (Maybe Text))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text))
-> UIInventory -> Identity UIInventory
Lens' UIInventory (Maybe Text)
uiInventorySearch ((Maybe Text -> Identity (Maybe Text))
 -> UIGameplay -> Identity UIGameplay)
-> Maybe Text -> UIGameplay -> UIGameplay
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text
forall a. Maybe a
Nothing
    UIGameplay -> (UIGameplay -> UIGameplay) -> UIGameplay
forall a b. a -> (a -> b) -> b
& (UIInventory -> Identity UIInventory)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay UIInventory
uiInventory ((UIInventory -> Identity UIInventory)
 -> UIGameplay -> Identity UIGameplay)
-> ((Maybe (Seed, List Name InventoryListEntry)
     -> Identity (Maybe (Seed, List Name InventoryListEntry)))
    -> UIInventory -> Identity UIInventory)
-> (Maybe (Seed, List Name InventoryListEntry)
    -> Identity (Maybe (Seed, List Name InventoryListEntry)))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Seed, List Name InventoryListEntry)
 -> Identity (Maybe (Seed, List Name InventoryListEntry)))
-> UIInventory -> Identity UIInventory
Lens' UIInventory (Maybe (Seed, List Name InventoryListEntry))
uiInventoryList ((Maybe (Seed, List Name InventoryListEntry)
  -> Identity (Maybe (Seed, List Name InventoryListEntry)))
 -> UIGameplay -> Identity UIGameplay)
-> Maybe (Seed, List Name InventoryListEntry)
-> UIGameplay
-> UIGameplay
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (Seed, List Name InventoryListEntry)
forall a. Maybe a
Nothing
    UIGameplay -> (UIGameplay -> UIGameplay) -> UIGameplay
forall a b. a -> (a -> b) -> b
& (UIInventory -> Identity UIInventory)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay UIInventory
uiInventory ((UIInventory -> Identity UIInventory)
 -> UIGameplay -> Identity UIGameplay)
-> ((InventorySortOptions -> Identity InventorySortOptions)
    -> UIInventory -> Identity UIInventory)
-> (InventorySortOptions -> Identity InventorySortOptions)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InventorySortOptions -> Identity InventorySortOptions)
-> UIInventory -> Identity UIInventory
Lens' UIInventory InventorySortOptions
uiInventorySort ((InventorySortOptions -> Identity InventorySortOptions)
 -> UIGameplay -> Identity UIGameplay)
-> InventorySortOptions -> UIGameplay -> UIGameplay
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InventorySortOptions
defaultSortOptions
    UIGameplay -> (UIGameplay -> UIGameplay) -> UIGameplay
forall a b. a -> (a -> b) -> b
& (UIInventory -> Identity UIInventory)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay UIInventory
uiInventory ((UIInventory -> Identity UIInventory)
 -> UIGameplay -> Identity UIGameplay)
-> ((Bool -> Identity Bool) -> UIInventory -> Identity UIInventory)
-> (Bool -> Identity Bool)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> UIInventory -> Identity UIInventory
Lens' UIInventory Bool
uiShowZero ((Bool -> Identity Bool) -> UIGameplay -> Identity UIGameplay)
-> Bool -> UIGameplay -> UIGameplay
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
    UIGameplay -> (UIGameplay -> UIGameplay) -> UIGameplay
forall a b. a -> (a -> b) -> b
& (UITiming -> Identity UITiming)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay UITiming
uiTiming ((UITiming -> Identity UITiming)
 -> UIGameplay -> Identity UIGameplay)
-> ((Bool -> Identity Bool) -> UITiming -> Identity UITiming)
-> (Bool -> Identity Bool)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> UITiming -> Identity UITiming
Lens' UITiming Bool
uiShowFPS ((Bool -> Identity Bool) -> UIGameplay -> Identity UIGameplay)
-> Bool -> UIGameplay -> UIGameplay
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False
    UIGameplay -> (UIGameplay -> UIGameplay) -> UIGameplay
forall a b. a -> (a -> b) -> b
& (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> UIGameplay -> Identity UIGameplay)
-> REPLState -> UIGameplay -> UIGameplay
forall s t a b. ASetter s t a b -> b -> s -> t
.~ REPLHistory -> REPLState
initREPLState (UIGameplay
uig UIGameplay
-> Getting REPLHistory UIGameplay REPLHistory -> REPLHistory
forall s a. s -> Getting a s a -> a
^. (REPLState -> Const REPLHistory REPLState)
-> UIGameplay -> Const REPLHistory UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Const REPLHistory REPLState)
 -> UIGameplay -> Const REPLHistory UIGameplay)
-> ((REPLHistory -> Const REPLHistory REPLHistory)
    -> REPLState -> Const REPLHistory REPLState)
-> Getting REPLHistory UIGameplay REPLHistory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLHistory -> Const REPLHistory REPLHistory)
-> REPLState -> Const REPLHistory REPLState
Lens' REPLState REPLHistory
replHistory)
    UIGameplay -> (UIGameplay -> UIGameplay) -> UIGameplay
forall a b. a -> (a -> b) -> b
& (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState)
 -> UIGameplay -> Identity UIGameplay)
-> ((REPLHistory -> Identity REPLHistory)
    -> REPLState -> Identity REPLState)
-> (REPLHistory -> Identity REPLHistory)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLHistory -> Identity REPLHistory)
-> REPLState -> Identity REPLState
Lens' REPLState REPLHistory
replHistory ((REPLHistory -> Identity REPLHistory)
 -> UIGameplay -> Identity UIGameplay)
-> (REPLHistory -> REPLHistory) -> UIGameplay -> UIGameplay
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ REPLHistory -> REPLHistory
restartREPLHistory
    UIGameplay -> (UIGameplay -> UIGameplay) -> UIGameplay
forall a b. a -> (a -> b) -> b
& (Maybe (ScenarioWith ScenarioPath)
 -> Identity (Maybe (ScenarioWith ScenarioPath)))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (Maybe (ScenarioWith ScenarioPath))
scenarioRef ((Maybe (ScenarioWith ScenarioPath)
  -> Identity (Maybe (ScenarioWith ScenarioPath)))
 -> UIGameplay -> Identity UIGameplay)
-> ScenarioWith ScenarioPath -> UIGameplay -> UIGameplay
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ScenarioWith ScenarioPath
siPair
    UIGameplay -> (UIGameplay -> UIGameplay) -> UIGameplay
forall a b. a -> (a -> b) -> b
& (UITiming -> Identity UITiming)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay UITiming
uiTiming ((UITiming -> Identity UITiming)
 -> UIGameplay -> Identity UIGameplay)
-> ((TimeSpec -> Identity TimeSpec)
    -> UITiming -> Identity UITiming)
-> (TimeSpec -> Identity TimeSpec)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TimeSpec -> Identity TimeSpec) -> UITiming -> Identity UITiming
Lens' UITiming TimeSpec
lastFrameTime ((TimeSpec -> Identity TimeSpec)
 -> UIGameplay -> Identity UIGameplay)
-> TimeSpec -> UIGameplay -> UIGameplay
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TimeSpec
curTime
    UIGameplay -> (UIGameplay -> UIGameplay) -> UIGameplay
forall a b. a -> (a -> b) -> b
& (WorldEditor Name -> Identity (WorldEditor Name))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name -> Identity (WorldEditor Name))
 -> UIGameplay -> Identity UIGameplay)
-> ((List Name EntityFacade -> Identity (List Name EntityFacade))
    -> WorldEditor Name -> Identity (WorldEditor Name))
-> (List Name EntityFacade -> Identity (List Name EntityFacade))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (List Name EntityFacade -> Identity (List Name EntityFacade))
-> WorldEditor Name -> Identity (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(List n EntityFacade -> f (List n EntityFacade))
-> WorldEditor n -> f (WorldEditor n)
EM.entityPaintList ((List Name EntityFacade -> Identity (List Name EntityFacade))
 -> UIGameplay -> Identity UIGameplay)
-> (List Name EntityFacade -> List Name EntityFacade)
-> UIGameplay
-> UIGameplay
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Vector EntityFacade
-> Maybe Seed -> List Name EntityFacade -> List Name EntityFacade
forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
t e -> Maybe Seed -> GenericList n t e -> GenericList n t e
BL.listReplace Vector EntityFacade
entityList Maybe Seed
forall a. Maybe a
Nothing
    UIGameplay -> (UIGameplay -> UIGameplay) -> UIGameplay
forall a b. a -> (a -> b) -> b
& (WorldEditor Name -> Identity (WorldEditor Name))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (WorldEditor Name)
uiWorldEditor ((WorldEditor Name -> Identity (WorldEditor Name))
 -> UIGameplay -> Identity UIGameplay)
-> ((Maybe (Cosmic BoundsRectangle)
     -> Identity (Maybe (Cosmic BoundsRectangle)))
    -> WorldEditor Name -> Identity (WorldEditor Name))
-> (Maybe (Cosmic BoundsRectangle)
    -> Identity (Maybe (Cosmic BoundsRectangle)))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MapEditingBounds -> Identity MapEditingBounds)
-> WorldEditor Name -> Identity (WorldEditor Name)
forall n (f :: * -> *).
Functor f =>
(MapEditingBounds -> f MapEditingBounds)
-> WorldEditor n -> f (WorldEditor n)
EM.editingBounds ((MapEditingBounds -> Identity MapEditingBounds)
 -> WorldEditor Name -> Identity (WorldEditor Name))
-> ((Maybe (Cosmic BoundsRectangle)
     -> Identity (Maybe (Cosmic BoundsRectangle)))
    -> MapEditingBounds -> Identity MapEditingBounds)
-> (Maybe (Cosmic BoundsRectangle)
    -> Identity (Maybe (Cosmic BoundsRectangle)))
-> WorldEditor Name
-> Identity (WorldEditor Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Cosmic BoundsRectangle)
 -> Identity (Maybe (Cosmic BoundsRectangle)))
-> MapEditingBounds -> Identity MapEditingBounds
Lens' MapEditingBounds (Maybe (Cosmic BoundsRectangle))
EM.boundsRect ((Maybe (Cosmic BoundsRectangle)
  -> Identity (Maybe (Cosmic BoundsRectangle)))
 -> UIGameplay -> Identity UIGameplay)
-> (Maybe (Cosmic BoundsRectangle)
    -> Maybe (Cosmic BoundsRectangle))
-> UIGameplay
-> UIGameplay
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Maybe (Cosmic BoundsRectangle) -> Maybe (Cosmic BoundsRectangle)
setNewBounds
    UIGameplay -> (UIGameplay -> UIGameplay) -> UIGameplay
forall a b. a -> (a -> b) -> b
& (UIDialogs -> Identity UIDialogs)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay UIDialogs
uiDialogs ((UIDialogs -> Identity UIDialogs)
 -> UIGameplay -> Identity UIGameplay)
-> ((StructureDisplay -> Identity StructureDisplay)
    -> UIDialogs -> Identity UIDialogs)
-> (StructureDisplay -> Identity StructureDisplay)
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureDisplay -> Identity StructureDisplay)
-> UIDialogs -> Identity UIDialogs
Lens' UIDialogs StructureDisplay
uiStructure
      ((StructureDisplay -> Identity StructureDisplay)
 -> UIGameplay -> Identity UIGameplay)
-> StructureDisplay -> UIGameplay -> UIGameplay
forall s t a b. ASetter s t a b -> b -> s -> t
.~ List Name (StructureInfo RecognizableStructureContent Entity)
-> FocusRing Name -> StructureDisplay
StructureDisplay
        ([StructureInfo RecognizableStructureContent Entity]
-> List Name (StructureInfo RecognizableStructureContent Entity)
forall b a. [StructureInfo b a] -> List Name (StructureInfo b a)
SR.makeListWidget ([StructureInfo RecognizableStructureContent Entity]
 -> List Name (StructureInfo RecognizableStructureContent Entity))
-> (Map
      StructureName (StructureInfo RecognizableStructureContent Entity)
    -> [StructureInfo RecognizableStructureContent Entity])
-> Map
     StructureName (StructureInfo RecognizableStructureContent Entity)
-> List Name (StructureInfo RecognizableStructureContent Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map
  StructureName (StructureInfo RecognizableStructureContent Entity)
-> [StructureInfo RecognizableStructureContent Entity]
forall k a. Map k a -> [a]
M.elems (Map
   StructureName (StructureInfo RecognizableStructureContent Entity)
 -> List Name (StructureInfo RecognizableStructureContent Entity))
-> Map
     StructureName (StructureInfo RecognizableStructureContent Entity)
-> List Name (StructureInfo RecognizableStructureContent Entity)
forall a b. (a -> b) -> a -> b
$ GameState
gs GameState
-> Getting
     (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
     GameState
     (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
-> Map
     StructureName (StructureInfo RecognizableStructureContent Entity)
forall s a. s -> Getting a s a -> a
^. (Landscape
 -> Const
      (Map
         StructureName (StructureInfo RecognizableStructureContent Entity))
      Landscape)
-> GameState
-> Const
     (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
     GameState
Lens' GameState Landscape
landscape ((Landscape
  -> Const
       (Map
          StructureName (StructureInfo RecognizableStructureContent Entity))
       Landscape)
 -> GameState
 -> Const
      (Map
         StructureName (StructureInfo RecognizableStructureContent Entity))
      GameState)
-> ((Map
       StructureName (StructureInfo RecognizableStructureContent Entity)
     -> Const
          (Map
             StructureName (StructureInfo RecognizableStructureContent Entity))
          (Map
             StructureName (StructureInfo RecognizableStructureContent Entity)))
    -> Landscape
    -> Const
         (Map
            StructureName (StructureInfo RecognizableStructureContent Entity))
         Landscape)
-> Getting
     (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
     GameState
     (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RecognizerAutomatons RecognizableStructureContent Entity
 -> Const
      (Map
         StructureName (StructureInfo RecognizableStructureContent Entity))
      (RecognizerAutomatons RecognizableStructureContent Entity))
-> Landscape
-> Const
     (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
     Landscape
Lens'
  Landscape
  (RecognizerAutomatons RecognizableStructureContent Entity)
recognizerAutomatons ((RecognizerAutomatons RecognizableStructureContent Entity
  -> Const
       (Map
          StructureName (StructureInfo RecognizableStructureContent Entity))
       (RecognizerAutomatons RecognizableStructureContent Entity))
 -> Landscape
 -> Const
      (Map
         StructureName (StructureInfo RecognizableStructureContent Entity))
      Landscape)
-> ((Map
       StructureName (StructureInfo RecognizableStructureContent Entity)
     -> Const
          (Map
             StructureName (StructureInfo RecognizableStructureContent Entity))
          (Map
             StructureName (StructureInfo RecognizableStructureContent Entity)))
    -> RecognizerAutomatons RecognizableStructureContent Entity
    -> Const
         (Map
            StructureName (StructureInfo RecognizableStructureContent Entity))
         (RecognizerAutomatons RecognizableStructureContent Entity))
-> (Map
      StructureName (StructureInfo RecognizableStructureContent Entity)
    -> Const
         (Map
            StructureName (StructureInfo RecognizableStructureContent Entity))
         (Map
            StructureName (StructureInfo RecognizableStructureContent Entity)))
-> Landscape
-> Const
     (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
     Landscape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map
   StructureName (StructureInfo RecognizableStructureContent Entity)
 -> Const
      (Map
         StructureName (StructureInfo RecognizableStructureContent Entity))
      (Map
         StructureName (StructureInfo RecognizableStructureContent Entity)))
-> RecognizerAutomatons RecognizableStructureContent Entity
-> Const
     (Map
        StructureName (StructureInfo RecognizableStructureContent Entity))
     (RecognizerAutomatons RecognizableStructureContent Entity)
forall b a (f :: * -> *).
Functor f =>
(Map StructureName (StructureInfo b a)
 -> f (Map StructureName (StructureInfo b a)))
-> RecognizerAutomatons b a -> f (RecognizerAutomatons b a)
originalStructureDefinitions)
        (Name -> FocusRing Name -> FocusRing Name
forall n. Eq n => n -> FocusRing n -> FocusRing n
focusSetCurrent (StructureWidget -> Name
StructureWidgets StructureWidget
StructuresList) (FocusRing Name -> FocusRing Name)
-> FocusRing Name -> FocusRing Name
forall a b. (a -> b) -> a -> b
$ [Name] -> FocusRing Name
forall n. [n] -> FocusRing n
focusRing ([Name] -> FocusRing Name) -> [Name] -> FocusRing Name
forall a b. (a -> b) -> a -> b
$ (StructureWidget -> Name) -> [StructureWidget] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map StructureWidget -> Name
StructureWidgets [StructureWidget]
forall a. (Enum a, Bounded a) => [a]
enumerate)
 where
  entityList :: Vector EntityFacade
entityList = EntityMap -> Vector EntityFacade
EU.getEntitiesForList (EntityMap -> Vector EntityFacade)
-> EntityMap -> Vector EntityFacade
forall a b. (a -> b) -> a -> b
$ GameState
gs GameState -> Getting EntityMap GameState EntityMap -> EntityMap
forall s a. s -> Getting a s a -> a
^. (Landscape -> Const EntityMap Landscape)
-> GameState -> Const EntityMap GameState
Lens' GameState Landscape
landscape ((Landscape -> Const EntityMap Landscape)
 -> GameState -> Const EntityMap GameState)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> Landscape -> Const EntityMap Landscape)
-> Getting EntityMap GameState EntityMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> Landscape -> Const EntityMap Landscape
Lens' Landscape TerrainEntityMaps
terrainAndEntities ((TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
 -> Landscape -> Const EntityMap Landscape)
-> ((EntityMap -> Const EntityMap EntityMap)
    -> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps)
-> (EntityMap -> Const EntityMap EntityMap)
-> Landscape
-> Const EntityMap Landscape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EntityMap -> Const EntityMap EntityMap)
-> TerrainEntityMaps -> Const EntityMap TerrainEntityMaps
Lens' TerrainEntityMaps EntityMap
entityMap

  (Bool
isEmptyArea, Cosmic BoundsRectangle
newBounds) =
    WorldDescription -> (Bool, Cosmic BoundsRectangle)
EU.getEditingBounds (WorldDescription -> (Bool, Cosmic BoundsRectangle))
-> WorldDescription -> (Bool, Cosmic BoundsRectangle)
forall a b. (a -> b) -> a -> b
$
      NonEmpty WorldDescription -> WorldDescription
forall a. NonEmpty a -> a
NE.head (NonEmpty WorldDescription -> WorldDescription)
-> NonEmpty WorldDescription -> WorldDescription
forall a b. (a -> b) -> a -> b
$
        Scenario
scenario Scenario
-> Getting
     (NonEmpty WorldDescription) Scenario (NonEmpty WorldDescription)
-> NonEmpty WorldDescription
forall s a. s -> Getting a s a -> a
^. (ScenarioLandscape
 -> Const (NonEmpty WorldDescription) ScenarioLandscape)
-> Scenario -> Const (NonEmpty WorldDescription) Scenario
Lens' Scenario ScenarioLandscape
scenarioLandscape ((ScenarioLandscape
  -> Const (NonEmpty WorldDescription) ScenarioLandscape)
 -> Scenario -> Const (NonEmpty WorldDescription) Scenario)
-> ((NonEmpty WorldDescription
     -> Const (NonEmpty WorldDescription) (NonEmpty WorldDescription))
    -> ScenarioLandscape
    -> Const (NonEmpty WorldDescription) ScenarioLandscape)
-> Getting
     (NonEmpty WorldDescription) Scenario (NonEmpty WorldDescription)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NonEmpty WorldDescription
 -> Const (NonEmpty WorldDescription) (NonEmpty WorldDescription))
-> ScenarioLandscape
-> Const (NonEmpty WorldDescription) ScenarioLandscape
Lens' ScenarioLandscape (NonEmpty WorldDescription)
scenarioWorlds

  setNewBounds :: Maybe (Cosmic BoundsRectangle) -> Maybe (Cosmic BoundsRectangle)
setNewBounds Maybe (Cosmic BoundsRectangle)
maybeOldBounds =
    if Bool
isEmptyArea
      then Maybe (Cosmic BoundsRectangle)
maybeOldBounds
      else Cosmic BoundsRectangle -> Maybe (Cosmic BoundsRectangle)
forall a. a -> Maybe a
Just Cosmic BoundsRectangle
newBounds

-- | Modify the UI state appropriately when starting a new scenario.
scenarioToUIState ::
  ScenarioWith a ->
  UIState ->
  IO UIState
scenarioToUIState :: forall a. ScenarioWith a -> UIState -> IO UIState
scenarioToUIState ScenarioWith a
siPair UIState
u = do
  UIState -> IO UIState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UIState -> IO UIState) -> UIState -> IO UIState
forall a b. (a -> b) -> a -> b
$
    UIState
u
      UIState -> (UIState -> UIState) -> UIState
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> UIState -> Identity UIState
Lens' UIState Bool
uiPlaying ((Bool -> Identity Bool) -> UIState -> Identity UIState)
-> Bool -> UIState -> UIState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True
      UIState -> (UIState -> UIState) -> UIState
forall a b. a -> (a -> b) -> b
& (AttrMap -> Identity AttrMap) -> UIState -> Identity UIState
Lens' UIState AttrMap
uiAttrMap
        ((AttrMap -> Identity AttrMap) -> UIState -> Identity UIState)
-> AttrMap -> UIState -> UIState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [(AttrName, Attr)] -> AttrMap -> AttrMap
applyAttrMappings
          ( (CustomAttr -> (AttrName, Attr))
-> [CustomAttr] -> [(AttrName, Attr)]
forall a b. (a -> b) -> [a] -> [b]
map ((WorldAttr -> AttrName) -> (WorldAttr, Attr) -> (AttrName, Attr)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first WorldAttr -> AttrName
getWorldAttrName ((WorldAttr, Attr) -> (AttrName, Attr))
-> (CustomAttr -> (WorldAttr, Attr))
-> CustomAttr
-> (AttrName, Attr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CustomAttr -> (WorldAttr, Attr)
toAttrPair) ([CustomAttr] -> [(AttrName, Attr)])
-> [CustomAttr] -> [(AttrName, Attr)]
forall a b. (a -> b) -> a -> b
$
              ScenarioWith a
siPair ScenarioWith a
-> Getting [CustomAttr] (ScenarioWith a) [CustomAttr]
-> [CustomAttr]
forall s a. s -> Getting a s a -> a
^. (Scenario -> Const [CustomAttr] Scenario)
-> ScenarioWith a -> Const [CustomAttr] (ScenarioWith a)
forall a (f :: * -> *).
Functor f =>
(Scenario -> f Scenario) -> ScenarioWith a -> f (ScenarioWith a)
getScenario ((Scenario -> Const [CustomAttr] Scenario)
 -> ScenarioWith a -> Const [CustomAttr] (ScenarioWith a))
-> (([CustomAttr] -> Const [CustomAttr] [CustomAttr])
    -> Scenario -> Const [CustomAttr] Scenario)
-> Getting [CustomAttr] (ScenarioWith a) [CustomAttr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioLandscape -> Const [CustomAttr] ScenarioLandscape)
-> Scenario -> Const [CustomAttr] Scenario
Lens' Scenario ScenarioLandscape
scenarioLandscape ((ScenarioLandscape -> Const [CustomAttr] ScenarioLandscape)
 -> Scenario -> Const [CustomAttr] Scenario)
-> (([CustomAttr] -> Const [CustomAttr] [CustomAttr])
    -> ScenarioLandscape -> Const [CustomAttr] ScenarioLandscape)
-> ([CustomAttr] -> Const [CustomAttr] [CustomAttr])
-> Scenario
-> Const [CustomAttr] Scenario
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([CustomAttr] -> Const [CustomAttr] [CustomAttr])
-> ScenarioLandscape -> Const [CustomAttr] ScenarioLandscape
Lens' ScenarioLandscape [CustomAttr]
scenarioAttrs
          )
          AttrMap
swarmAttrMap

-- | Create a BChan that holds only one event.
--   This should only be used in unit tests, integration tests, and benchmarks
initTestChan :: IO (BChan AppEvent)
initTestChan :: IO (BChan AppEvent)
initTestChan = Seed -> IO (BChan AppEvent)
forall a. Seed -> IO (BChan a)
newBChan Seed
1

-- | Create an initial app state for a specific scenario.  Note that
--   this function is used only for unit tests, integration tests, and
--   benchmarks.
--
--   In normal play, an 'AppState' already exists and we simply need
--   to update it using 'scenarioToAppState'.
initAppStateForScenario :: String -> Maybe Seed -> Maybe FilePath -> ExceptT Text IO AppState
initAppStateForScenario :: FilePath
-> Maybe Seed -> Maybe FilePath -> ExceptT Text IO AppState
initAppStateForScenario FilePath
sceneName Maybe Seed
userSeed Maybe FilePath
toRun =
  ThrowC Text IO AppState -> ExceptT Text IO AppState
forall e (m :: * -> *) a. ThrowC e m a -> ExceptT e m a
asExceptT (ThrowC Text IO AppState -> ExceptT Text IO AppState)
-> (AppOpts -> ThrowC Text IO AppState)
-> AppOpts
-> ExceptT Text IO AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SystemFailure -> Text)
-> ThrowC SystemFailure (ThrowC Text IO) AppState
-> ThrowC Text IO AppState
forall e2 (sig :: (* -> *) -> * -> *) (m :: * -> *) e1 a.
Has (Throw e2) sig m =>
(e1 -> e2) -> ThrowC e1 m a -> m a
withThrow (forall a. PrettyPrec a => a -> Text
prettyText @SystemFailure) (ThrowC SystemFailure (ThrowC Text IO) AppState
 -> ThrowC Text IO AppState)
-> (AppOpts -> ThrowC SystemFailure (ThrowC Text IO) AppState)
-> AppOpts
-> ThrowC Text IO AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AppOpts
 -> Maybe (BChan AppEvent)
 -> ThrowC SystemFailure (ThrowC Text IO) AppState)
-> Maybe (BChan AppEvent)
-> AppOpts
-> ThrowC SystemFailure (ThrowC Text IO) AppState
forall a b c. (a -> b -> c) -> b -> a -> c
flip AppOpts
-> Maybe (BChan AppEvent)
-> ThrowC SystemFailure (ThrowC Text IO) AppState
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AppOpts -> Maybe (BChan AppEvent) -> m AppState
initAppState Maybe (BChan AppEvent)
forall a. Maybe a
Nothing (AppOpts -> ExceptT Text IO AppState)
-> AppOpts -> ExceptT Text IO AppState
forall a b. (a -> b) -> a -> b
$
    AppOpts
defaultAppOpts
      { userScenario = Just sceneName
      , userSeed = userSeed
      , scriptToRun = toRun
      }

-- | For convenience, the 'AppState' corresponding to the classic game
--   with seed 0.  This is used only for benchmarks and unit tests.
classicGame0 :: ExceptT Text IO AppState
classicGame0 :: ExceptT Text IO AppState
classicGame0 = FilePath
-> Maybe Seed -> Maybe FilePath -> ExceptT Text IO AppState
initAppStateForScenario FilePath
"classic" (Seed -> Maybe Seed
forall a. a -> Maybe a
Just Seed
0) Maybe FilePath
forall a. Maybe a
Nothing