{-# 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',
  scenarioToAppState,
) where

import Brick.AttrMap (applyAttrMappings)
import Brick.Focus
import Brick.Widgets.List qualified as BL
import Control.Applicative ((<|>))
import Control.Carrier.Accum.FixedStrict (runAccum)
import Control.Carrier.Lift (runM)
import Control.Carrier.Throw.Either (runThrow)
import Control.Effect.Accum
import Control.Effect.Lift
import Control.Effect.Throw
import Control.Lens hiding (from, (<.>))
import Control.Monad (guard, 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 qualified as NE
import Data.Map qualified as M
import Data.Maybe (fromMaybe, isJust)
import Data.Sequence (Seq)
import Data.Text (Text)
import Data.Time (getZonedTime)
import Swarm.Game.Failure (SystemFailure (..))
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 (automatons)
import Swarm.Game.Scenario.Topography.Structure.Recognition.Type (originalStructureDefinitions)
import Swarm.Game.ScenarioInfo (
  loadScenarioInfo,
  normalizeScenarioPath,
  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.World.Gen (Seed)
import Swarm.Language.Pretty (prettyText)
import Swarm.Log (LogSource (SystemLog), Severity (..))
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.Goal (emptyGoalDisplay)
import Swarm.TUI.Model.KeyBindings
import Swarm.TUI.Model.Name
import Swarm.TUI.Model.Repl
import Swarm.TUI.Model.Structure
import Swarm.TUI.Model.UI
import Swarm.TUI.View.Attribute.Attr (getWorldAttrName, swarmAttrMap)
import Swarm.TUI.View.Attribute.CustomStyling (toAttrPair)
import Swarm.TUI.View.Structure qualified as SR
import Swarm.Util.Effect (asExceptT, withThrow)
import System.Clock

-- | Initialize the 'AppState' from scratch.
initAppState ::
  (Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
  AppOpts ->
  m AppState
initAppState :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AppOpts -> m AppState
initAppState AppOpts
opts = do
  (RuntimeState
rs, UIState
ui, KeyEventHandlingState
keyHandling) <- AppOpts -> m (RuntimeState, UIState, KeyEventHandlingState)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AppOpts -> m (RuntimeState, UIState, KeyEventHandlingState)
initPersistentState AppOpts
opts
  RuntimeState
-> UIState -> KeyEventHandlingState -> AppOpts -> m AppState
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
RuntimeState
-> UIState -> KeyEventHandlingState -> AppOpts -> m AppState
constructAppState RuntimeState
rs UIState
ui KeyEventHandlingState
keyHandling AppOpts
opts

-- | 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
-> OriginalName
-> OriginalName
-> Notifications LogEntry
-> Notifications LogEntry
logEvent LogSource
SystemLog Severity
Error OriginalName
"UI Loading" (a -> OriginalName
forall a. PrettyPrec a => a -> OriginalName
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
userSeed :: Maybe Seed
userScenario :: Maybe FilePath
scriptToRun :: Maybe FilePath
autoPlay :: Bool
speed :: Seed
cheatMode :: Bool
colorMode :: Maybe ColorMode
userWebPort :: Maybe Seed
repoGitInfo :: Maybe GitInfo
userSeed :: AppOpts -> Maybe Seed
userScenario :: AppOpts -> Maybe FilePath
scriptToRun :: AppOpts -> Maybe FilePath
autoPlay :: AppOpts -> Bool
speed :: AppOpts -> Seed
cheatMode :: AppOpts -> Bool
colorMode :: AppOpts -> Maybe ColorMode
userWebPort :: AppOpts -> Maybe Seed
repoGitInfo :: AppOpts -> Maybe GitInfo
..} = 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

-- | 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 (RuntimeState, UIState, KeyEventHandlingState)
initPersistentState :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AppOpts -> m (RuntimeState, UIState, KeyEventHandlingState)
initPersistentState opts :: AppOpts
opts@(AppOpts {Bool
Seed
Maybe Seed
Maybe FilePath
Maybe GitInfo
Maybe ColorMode
userSeed :: AppOpts -> Maybe Seed
userScenario :: AppOpts -> Maybe FilePath
scriptToRun :: AppOpts -> Maybe FilePath
autoPlay :: AppOpts -> Bool
speed :: AppOpts -> Seed
cheatMode :: AppOpts -> Bool
colorMode :: AppOpts -> Maybe ColorMode
userWebPort :: AppOpts -> Maybe Seed
repoGitInfo :: AppOpts -> Maybe GitInfo
userSeed :: Maybe Seed
userScenario :: Maybe FilePath
scriptToRun :: Maybe FilePath
autoPlay :: Bool
speed :: Seed
cheatMode :: Bool
colorMode :: Maybe ColorMode
userWebPort :: Maybe Seed
repoGitInfo :: Maybe GitInfo
..}) = do
  (Seq SystemFailure
warnings :: Seq SystemFailure, (RuntimeState
initRS, UIState
initUI, KeyEventHandlingState
initKs)) <- Seq SystemFailure
-> AccumC
     (Seq SystemFailure)
     m
     (RuntimeState, UIState, KeyEventHandlingState)
-> m (Seq SystemFailure,
      (RuntimeState, UIState, KeyEventHandlingState))
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
   (RuntimeState, UIState, KeyEventHandlingState)
 -> m (Seq SystemFailure,
       (RuntimeState, UIState, KeyEventHandlingState)))
-> AccumC
     (Seq SystemFailure)
     m
     (RuntimeState, UIState, KeyEventHandlingState)
-> m (Seq SystemFailure,
      (RuntimeState, UIState, KeyEventHandlingState))
forall a b. (a -> b) -> a -> b
$ do
    RuntimeState
rs <- AccumC (Seq SystemFailure) m RuntimeState
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m,
 Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
m RuntimeState
initRuntimeState
    UIState
ui <- Seed -> Bool -> Bool -> AccumC (Seq SystemFailure) m UIState
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
Seed -> Bool -> Bool -> m UIState
initUIState Seed
speed (Bool -> Bool
not (AppOpts -> Bool
skipMenu AppOpts
opts)) Bool
cheatMode
    KeyEventHandlingState
ks <- AccumC (Seq SystemFailure) m KeyEventHandlingState
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
m KeyEventHandlingState
initKeyHandlingState
    (RuntimeState, UIState, KeyEventHandlingState)
-> AccumC
     (Seq SystemFailure)
     m
     (RuntimeState, UIState, KeyEventHandlingState)
forall a. a -> AccumC (Seq SystemFailure) m a
forall (m :: * -> *) a. Monad m => a -> m a
return (RuntimeState
rs, UIState
ui, KeyEventHandlingState
ks)
  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)
  (RuntimeState, UIState, KeyEventHandlingState)
-> m (RuntimeState, UIState, KeyEventHandlingState)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (RuntimeState
initRS', UIState
initUI, KeyEventHandlingState
initKs)

-- | 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) =>
  RuntimeState ->
  UIState ->
  KeyEventHandlingState ->
  AppOpts ->
  m AppState
constructAppState :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
RuntimeState
-> UIState -> KeyEventHandlingState -> AppOpts -> m AppState
constructAppState RuntimeState
rs UIState
ui KeyEventHandlingState
key opts :: AppOpts
opts@(AppOpts {Bool
Seed
Maybe Seed
Maybe FilePath
Maybe GitInfo
Maybe ColorMode
userSeed :: AppOpts -> Maybe Seed
userScenario :: AppOpts -> Maybe FilePath
scriptToRun :: AppOpts -> Maybe FilePath
autoPlay :: AppOpts -> Bool
speed :: AppOpts -> Seed
cheatMode :: AppOpts -> Bool
colorMode :: AppOpts -> Maybe ColorMode
userWebPort :: AppOpts -> Maybe Seed
repoGitInfo :: AppOpts -> Maybe GitInfo
userSeed :: Maybe Seed
userScenario :: Maybe FilePath
scriptToRun :: Maybe FilePath
autoPlay :: Bool
speed :: Seed
cheatMode :: Bool
colorMode :: Maybe ColorMode
userWebPort :: Maybe Seed
repoGitInfo :: Maybe GitInfo
..}) = do
  let gs :: GameState
gs = GameStateConfig -> GameState
initGameState (GameStateConfig -> GameState) -> GameStateConfig -> 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
  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
$ GameState
-> UIState -> KeyEventHandlingState -> RuntimeState -> AppState
AppState GameState
gs (UIState
ui UIState -> (UIState -> UIState) -> UIState
forall a b. a -> (a -> b) -> b
& (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((Seed -> Identity Seed) -> UIGameplay -> Identity UIGameplay)
-> (Seed -> Identity Seed)
-> UIState
-> Identity UIState
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) -> UIState -> Identity UIState)
-> Seed -> UIState -> UIState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seed
defaultInitLgTicksPerSecond) KeyEventHandlingState
key RuntimeState
rs
    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

      Either SystemFailure ScenarioInfo
eitherSi <- IO (Either SystemFailure ScenarioInfo)
-> m (Either SystemFailure ScenarioInfo)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO (Either SystemFailure ScenarioInfo)
 -> m (Either SystemFailure ScenarioInfo))
-> (ThrowC SystemFailure (LiftC IO) ScenarioInfo
    -> IO (Either SystemFailure ScenarioInfo))
-> ThrowC SystemFailure (LiftC IO) ScenarioInfo
-> m (Either SystemFailure ScenarioInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LiftC IO (Either SystemFailure ScenarioInfo)
-> IO (Either SystemFailure ScenarioInfo)
forall (m :: * -> *) a. LiftC m a -> m a
runM (LiftC IO (Either SystemFailure ScenarioInfo)
 -> IO (Either SystemFailure ScenarioInfo))
-> (ThrowC SystemFailure (LiftC IO) ScenarioInfo
    -> LiftC IO (Either SystemFailure ScenarioInfo))
-> ThrowC SystemFailure (LiftC IO) ScenarioInfo
-> IO (Either SystemFailure ScenarioInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThrowC SystemFailure (LiftC IO) ScenarioInfo
-> LiftC IO (Either SystemFailure ScenarioInfo)
forall e (m :: * -> *) a. ThrowC e m a -> m (Either e a)
runThrow (ThrowC SystemFailure (LiftC IO) ScenarioInfo
 -> m (Either SystemFailure ScenarioInfo))
-> ThrowC SystemFailure (LiftC IO) ScenarioInfo
-> m (Either SystemFailure ScenarioInfo)
forall a b. (a -> b) -> a -> b
$ FilePath -> ThrowC SystemFailure (LiftC IO) ScenarioInfo
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
FilePath -> m ScenarioInfo
loadScenarioInfo FilePath
path
      let (ScenarioInfo
si, RuntimeState
newRs) = case Either SystemFailure ScenarioInfo
eitherSi of
            Right ScenarioInfo
x -> (ScenarioInfo
x, RuntimeState
rs)
            Left SystemFailure
e -> (FilePath -> ScenarioStatus -> ScenarioInfo
ScenarioInfo FilePath
path ScenarioStatus
NotStarted, RuntimeState -> [SystemFailure] -> RuntimeState
addWarnings RuntimeState
rs [SystemFailure
e])
      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
          (ScenarioInfoPair -> ValidatedLaunchParams -> StateT AppState IO ()
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioInfoPair -> ValidatedLaunchParams -> m ()
startGameWithSeed (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))
          (GameState
-> UIState -> KeyEventHandlingState -> RuntimeState -> AppState
AppState GameState
gs UIState
ui KeyEventHandlingState
key RuntimeState
newRs)

-- | Load a 'Scenario' and start playing the game.
startGame :: (MonadIO m, MonadState AppState m) => ScenarioInfoPair -> Maybe CodeToRun -> m ()
startGame :: forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioInfoPair -> Maybe CodeToRun -> m ()
startGame ScenarioInfoPair
siPair = ScenarioInfoPair -> ValidatedLaunchParams -> m ()
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioInfoPair -> ValidatedLaunchParams -> m ()
startGameWithSeed ScenarioInfoPair
siPair (ValidatedLaunchParams -> m ())
-> (Maybe CodeToRun -> ValidatedLaunchParams)
-> 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) -> ValidatedLaunchParams)
-> (Maybe CodeToRun -> Identity (Maybe CodeToRun))
-> Maybe CodeToRun
-> ValidatedLaunchParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe CodeToRun -> Identity (Maybe CodeToRun)
forall a. a -> Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | 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 -> ScenarioInfoPair -> m ()
restartGame :: forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
Seed -> ScenarioInfoPair -> m ()
restartGame Seed
currentSeed ScenarioInfoPair
siPair = ScenarioInfoPair -> ValidatedLaunchParams -> m ()
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioInfoPair -> ValidatedLaunchParams -> m ()
startGameWithSeed ScenarioInfoPair
siPair (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) =>
  ScenarioInfoPair ->
  ValidatedLaunchParams ->
  m ()
startGameWithSeed :: forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioInfoPair -> ValidatedLaunchParams -> m ()
startGameWithSeed siPair :: ScenarioInfoPair
siPair@(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
ss <- Getting ScenarioCollection AppState ScenarioCollection
-> m ScenarioCollection
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting ScenarioCollection AppState ScenarioCollection
 -> m ScenarioCollection)
-> Getting ScenarioCollection AppState ScenarioCollection
-> m ScenarioCollection
forall a b. (a -> b) -> a -> b
$ (RuntimeState -> Const ScenarioCollection RuntimeState)
-> AppState -> Const ScenarioCollection AppState
Lens' AppState RuntimeState
runtimeState ((RuntimeState -> Const ScenarioCollection RuntimeState)
 -> AppState -> Const ScenarioCollection AppState)
-> ((ScenarioCollection
     -> Const ScenarioCollection ScenarioCollection)
    -> RuntimeState -> Const ScenarioCollection RuntimeState)
-> Getting ScenarioCollection AppState ScenarioCollection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioCollection -> Const ScenarioCollection ScenarioCollection)
-> RuntimeState -> Const ScenarioCollection RuntimeState
Lens' RuntimeState ScenarioCollection
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 -> FilePath -> IO FilePath
forall (m :: * -> *).
MonadIO m =>
ScenarioCollection -> FilePath -> m FilePath
normalizeScenarioPath ScenarioCollection
ss (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)
  (RuntimeState -> Identity RuntimeState)
-> AppState -> Identity AppState
Lens' AppState RuntimeState
runtimeState
    ((RuntimeState -> Identity RuntimeState)
 -> AppState -> Identity AppState)
-> ((ScenarioStatus -> Identity ScenarioStatus)
    -> RuntimeState -> Identity RuntimeState)
-> (ScenarioStatus -> Identity ScenarioStatus)
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioCollection -> Identity ScenarioCollection)
-> RuntimeState -> Identity RuntimeState
Lens' RuntimeState ScenarioCollection
scenarios
    ((ScenarioCollection -> Identity ScenarioCollection)
 -> RuntimeState -> Identity RuntimeState)
-> ((ScenarioStatus -> Identity ScenarioStatus)
    -> ScenarioCollection -> Identity ScenarioCollection)
-> (ScenarioStatus -> Identity ScenarioStatus)
-> RuntimeState
-> Identity RuntimeState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Traversal' ScenarioCollection ScenarioItem
scenarioItemByPath FilePath
p
    ((ScenarioItem -> Identity ScenarioItem)
 -> ScenarioCollection -> Identity ScenarioCollection)
-> ((ScenarioStatus -> Identity ScenarioStatus)
    -> ScenarioItem -> Identity ScenarioItem)
-> (ScenarioStatus -> Identity ScenarioStatus)
-> ScenarioCollection
-> Identity ScenarioCollection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioInfoPair -> Identity ScenarioInfoPair)
-> ScenarioItem -> Identity ScenarioItem
Prism' ScenarioItem ScenarioInfoPair
_SISingle
    ((ScenarioInfoPair -> Identity ScenarioInfoPair)
 -> ScenarioItem -> Identity ScenarioItem)
-> ((ScenarioStatus -> Identity ScenarioStatus)
    -> ScenarioInfoPair -> Identity ScenarioInfoPair)
-> (ScenarioStatus -> Identity ScenarioStatus)
-> ScenarioItem
-> Identity ScenarioItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScenarioInfo -> Identity ScenarioInfo)
-> ScenarioInfoPair -> Identity ScenarioInfoPair
forall s t a b. Field2 s t a b => Lens s t a b
Lens ScenarioInfoPair ScenarioInfoPair ScenarioInfo ScenarioInfo
_2
    ((ScenarioInfo -> Identity ScenarioInfo)
 -> ScenarioInfoPair -> Identity ScenarioInfoPair)
-> ((ScenarioStatus -> Identity ScenarioStatus)
    -> ScenarioInfo -> Identity ScenarioInfo)
-> (ScenarioStatus -> Identity ScenarioStatus)
-> ScenarioInfoPair
-> Identity ScenarioInfoPair
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)
  ScenarioInfoPair -> ValidatedLaunchParams -> m ()
forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioInfoPair -> ValidatedLaunchParams -> m ()
scenarioToAppState ScenarioInfoPair
siPair ValidatedLaunchParams
lp
  -- Beware: currentScenarioPath must be set so that progress/achievements can be saved.
  -- It has just been cleared in scenarioToAppState.
  (GameState -> Identity GameState) -> AppState -> Identity AppState
Lens' AppState GameState
gameState ((GameState -> Identity GameState)
 -> AppState -> Identity AppState)
-> ((Maybe FilePath -> Identity (Maybe FilePath))
    -> GameState -> Identity GameState)
-> (Maybe FilePath -> Identity (Maybe FilePath))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe FilePath -> Identity (Maybe FilePath))
-> GameState -> Identity GameState
Lens' GameState (Maybe FilePath)
currentScenarioPath ((Maybe FilePath -> Identity (Maybe FilePath))
 -> AppState -> Identity AppState)
-> Maybe FilePath -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
p
 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) =>
  ScenarioInfoPair ->
  ValidatedLaunchParams ->
  m ()
scenarioToAppState :: forall (m :: * -> *).
(MonadIO m, MonadState AppState m) =>
ScenarioInfoPair -> ValidatedLaunchParams -> m ()
scenarioToAppState siPair :: ScenarioInfoPair
siPair@(Scenario
scene, ScenarioInfo
_) 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
$ Scenario
-> ValidatedLaunchParams -> GameStateConfig -> IO GameState
scenarioToGameState Scenario
scene 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
  (GameState -> Identity GameState) -> AppState -> Identity AppState
Lens' AppState 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
  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
$ Bool -> ScenarioInfoPair -> GameState -> UIState -> IO UIState
scenarioToUIState Bool
isAutoplaying ScenarioInfoPair
siPair GameState
gs
 where
  isAutoplaying :: Bool
isAutoplaying = case Identity (Maybe CodeToRun) -> Maybe CodeToRun
forall a. Identity a -> a
runIdentity (ValidatedLaunchParams -> Identity (Maybe CodeToRun)
forall code (f :: * -> *).
ParameterizableLaunchParams code f -> f (Maybe code)
initialCode ValidatedLaunchParams
lp) of
    Just (CodeToRun SolutionSource
ScenarioSuggested TSyntax
_) -> Bool
True
    Maybe CodeToRun
_ -> 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'

-- | Modify the UI state appropriately when starting a new scenario.
scenarioToUIState ::
  Bool ->
  ScenarioInfoPair ->
  GameState ->
  UIState ->
  IO UIState
scenarioToUIState :: Bool -> ScenarioInfoPair -> GameState -> UIState -> IO UIState
scenarioToUIState Bool
isAutoplaying siPair :: ScenarioInfoPair
siPair@(Scenario
scenario, ScenarioInfo
_) GameState
gs UIState
u = do
  TimeSpec
curTime <- Clock -> IO TimeSpec
getTime Clock
Monotonic
  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
& (Bool -> Identity Bool) -> UIState -> Identity UIState
Lens' UIState Bool
uiCheatMode ((Bool -> Identity Bool) -> UIState -> Identity UIState)
-> Bool -> UIState -> UIState
forall s t. ASetter s t Bool Bool -> Bool -> s -> t
||~ Bool
isAutoplaying
      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
$
              ScenarioInfoPair -> Scenario
forall a b. (a, b) -> a
fst ScenarioInfoPair
siPair Scenario
-> Getting [CustomAttr] Scenario [CustomAttr] -> [CustomAttr]
forall s a. s -> Getting a s a -> a
^. (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)
-> Getting [CustomAttr] Scenario [CustomAttr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([CustomAttr] -> Const [CustomAttr] [CustomAttr])
-> ScenarioLandscape -> Const [CustomAttr] ScenarioLandscape
Lens' ScenarioLandscape [CustomAttr]
scenarioAttrs
          )
          AttrMap
swarmAttrMap
      UIState -> (UIState -> UIState) -> UIState
forall a b. a -> (a -> b) -> b
& (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((GoalDisplay -> Identity GoalDisplay)
    -> UIGameplay -> Identity UIGameplay)
-> (GoalDisplay -> Identity GoalDisplay)
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GoalDisplay -> Identity GoalDisplay)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay GoalDisplay
uiGoal ((GoalDisplay -> Identity GoalDisplay)
 -> UIState -> Identity UIState)
-> GoalDisplay -> UIState -> UIState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ GoalDisplay
emptyGoalDisplay
      UIState -> (UIState -> UIState) -> UIState
forall a b. a -> (a -> b) -> b
& (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((Bool -> Identity Bool) -> UIGameplay -> Identity UIGameplay)
-> (Bool -> Identity Bool)
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> UIGameplay -> Identity UIGameplay
Lens' UIGameplay Bool
uiHideGoals ((Bool -> Identity Bool) -> UIState -> Identity UIState)
-> Bool -> UIState -> UIState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Bool
isAutoplaying Bool -> Bool -> Bool
&& Bool -> Bool
not (UIState
u UIState -> Getting Bool UIState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool UIState Bool
Lens' UIState Bool
uiCheatMode))
      UIState -> (UIState -> UIState) -> UIState
forall a b. a -> (a -> b) -> b
& (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((FocusRing Name -> Identity (FocusRing Name))
    -> UIGameplay -> Identity UIGameplay)
-> (FocusRing Name -> Identity (FocusRing Name))
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FocusRing Name -> Identity (FocusRing Name))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (FocusRing Name)
uiFocusRing ((FocusRing Name -> Identity (FocusRing Name))
 -> UIState -> Identity UIState)
-> FocusRing Name -> UIState -> UIState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FocusRing Name
initFocusRing
      UIState -> (UIState -> UIState) -> UIState
forall a b. a -> (a -> b) -> b
& (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((Maybe OriginalName -> Identity (Maybe OriginalName))
    -> UIGameplay -> Identity UIGameplay)
-> (Maybe OriginalName -> Identity (Maybe OriginalName))
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIInventory -> Identity UIInventory)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay UIInventory
uiInventory ((UIInventory -> Identity UIInventory)
 -> UIGameplay -> Identity UIGameplay)
-> ((Maybe OriginalName -> Identity (Maybe OriginalName))
    -> UIInventory -> Identity UIInventory)
-> (Maybe OriginalName -> Identity (Maybe OriginalName))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe OriginalName -> Identity (Maybe OriginalName))
-> UIInventory -> Identity UIInventory
Lens' UIInventory (Maybe OriginalName)
uiInventorySearch ((Maybe OriginalName -> Identity (Maybe OriginalName))
 -> UIState -> Identity UIState)
-> Maybe OriginalName -> UIState -> UIState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe OriginalName
forall a. Maybe a
Nothing
      UIState -> (UIState -> UIState) -> UIState
forall a b. a -> (a -> b) -> b
& (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((Maybe (Seed, List Name InventoryListEntry)
     -> Identity (Maybe (Seed, List Name InventoryListEntry)))
    -> UIGameplay -> Identity UIGameplay)
-> (Maybe (Seed, List Name InventoryListEntry)
    -> Identity (Maybe (Seed, List Name InventoryListEntry)))
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)))
 -> UIState -> Identity UIState)
-> Maybe (Seed, List Name InventoryListEntry) -> UIState -> UIState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe (Seed, List Name InventoryListEntry)
forall a. Maybe a
Nothing
      UIState -> (UIState -> UIState) -> UIState
forall a b. a -> (a -> b) -> b
& (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((InventorySortOptions -> Identity InventorySortOptions)
    -> UIGameplay -> Identity UIGameplay)
-> (InventorySortOptions -> Identity InventorySortOptions)
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
 -> UIState -> Identity UIState)
-> InventorySortOptions -> UIState -> UIState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ InventorySortOptions
defaultSortOptions
      UIState -> (UIState -> UIState) -> UIState
forall a b. a -> (a -> b) -> b
& (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((Bool -> Identity Bool) -> UIGameplay -> Identity UIGameplay)
-> (Bool -> Identity Bool)
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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) -> 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
& (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((Bool -> Identity Bool) -> UIGameplay -> Identity UIGameplay)
-> (Bool -> Identity Bool)
-> UIState
-> Identity UIState
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)
-> ((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) -> UIState -> Identity UIState)
-> Bool -> UIState -> UIState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
False
      UIState -> (UIState -> UIState) -> UIState
forall a b. a -> (a -> b) -> b
& (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((REPLState -> Identity REPLState)
    -> UIGameplay -> Identity UIGameplay)
-> (REPLState -> Identity REPLState)
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLState -> Identity REPLState)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay REPLState
uiREPL ((REPLState -> Identity REPLState) -> UIState -> Identity UIState)
-> REPLState -> UIState -> UIState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ REPLHistory -> REPLState
initREPLState (UIState
u UIState -> Getting REPLHistory UIState REPLHistory -> REPLHistory
forall s a. s -> Getting a s a -> a
^. (UIGameplay -> Const REPLHistory UIGameplay)
-> UIState -> Const REPLHistory UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const REPLHistory UIGameplay)
 -> UIState -> Const REPLHistory UIState)
-> ((REPLHistory -> Const REPLHistory REPLHistory)
    -> UIGameplay -> Const REPLHistory UIGameplay)
-> Getting REPLHistory UIState REPLHistory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
-> (REPLHistory -> Const REPLHistory REPLHistory)
-> UIGameplay
-> Const REPLHistory UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLHistory -> Const REPLHistory REPLHistory)
-> REPLState -> Const REPLHistory REPLState
Lens' REPLState REPLHistory
replHistory)
      UIState -> (UIState -> UIState) -> UIState
forall a b. a -> (a -> b) -> b
& (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((REPLHistory -> Identity REPLHistory)
    -> UIGameplay -> Identity UIGameplay)
-> (REPLHistory -> Identity REPLHistory)
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
 -> UIState -> Identity UIState)
-> (REPLHistory -> REPLHistory) -> UIState -> UIState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ REPLHistory -> REPLHistory
restartREPLHistory
      UIState -> (UIState -> UIState) -> UIState
forall a b. a -> (a -> b) -> b
& (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((Maybe ScenarioInfoPair -> Identity (Maybe ScenarioInfoPair))
    -> UIGameplay -> Identity UIGameplay)
-> (Maybe ScenarioInfoPair -> Identity (Maybe ScenarioInfoPair))
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ScenarioInfoPair -> Identity (Maybe ScenarioInfoPair))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (Maybe ScenarioInfoPair)
scenarioRef ((Maybe ScenarioInfoPair -> Identity (Maybe ScenarioInfoPair))
 -> UIState -> Identity UIState)
-> ScenarioInfoPair -> UIState -> UIState
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ ScenarioInfoPair
siPair
      UIState -> (UIState -> UIState) -> UIState
forall a b. a -> (a -> b) -> b
& (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((TimeSpec -> Identity TimeSpec)
    -> UIGameplay -> Identity UIGameplay)
-> (TimeSpec -> Identity TimeSpec)
-> UIState
-> Identity UIState
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)
-> ((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) -> UIState -> Identity UIState)
-> TimeSpec -> UIState -> UIState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TimeSpec
curTime
      UIState -> (UIState -> UIState) -> UIState
forall a b. a -> (a -> b) -> b
& (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((List Name EntityFacade -> Identity (List Name EntityFacade))
    -> UIGameplay -> Identity UIGameplay)
-> (List Name EntityFacade -> Identity (List Name EntityFacade))
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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))
 -> UIState -> Identity UIState)
-> (List Name EntityFacade -> List Name EntityFacade)
-> UIState
-> UIState
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
      UIState -> (UIState -> UIState) -> UIState
forall a b. a -> (a -> b) -> b
& (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((Maybe (Cosmic BoundsRectangle)
     -> Identity (Maybe (Cosmic BoundsRectangle)))
    -> UIGameplay -> Identity UIGameplay)
-> (Maybe (Cosmic BoundsRectangle)
    -> Identity (Maybe (Cosmic BoundsRectangle)))
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)))
 -> UIState -> Identity UIState)
-> (Maybe (Cosmic BoundsRectangle)
    -> Maybe (Cosmic BoundsRectangle))
-> UIState
-> UIState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Maybe (Cosmic BoundsRectangle) -> Maybe (Cosmic BoundsRectangle)
setNewBounds
      UIState -> (UIState -> UIState) -> UIState
forall a b. a -> (a -> b) -> b
& (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((StructureDisplay -> Identity StructureDisplay)
    -> UIGameplay -> Identity UIGameplay)
-> (StructureDisplay -> Identity StructureDisplay)
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureDisplay -> Identity StructureDisplay)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay StructureDisplay
uiStructure
        ((StructureDisplay -> Identity StructureDisplay)
 -> UIState -> Identity UIState)
-> StructureDisplay -> UIState -> UIState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ List Name (StructureInfo StructureCells Entity)
-> FocusRing Name -> StructureDisplay
StructureDisplay
          ([StructureInfo StructureCells Entity]
-> List Name (StructureInfo StructureCells Entity)
SR.makeListWidget ([StructureInfo StructureCells Entity]
 -> List Name (StructureInfo StructureCells Entity))
-> (Map OriginalName (StructureInfo StructureCells Entity)
    -> [StructureInfo StructureCells Entity])
-> Map OriginalName (StructureInfo StructureCells Entity)
-> List Name (StructureInfo StructureCells Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map OriginalName (StructureInfo StructureCells Entity)
-> [StructureInfo StructureCells Entity]
forall k a. Map k a -> [a]
M.elems (Map OriginalName (StructureInfo StructureCells Entity)
 -> List Name (StructureInfo StructureCells Entity))
-> Map OriginalName (StructureInfo StructureCells Entity)
-> List Name (StructureInfo StructureCells Entity)
forall a b. (a -> b) -> a -> b
$ GameState
gs GameState
-> Getting
     (Map OriginalName (StructureInfo StructureCells Entity))
     GameState
     (Map OriginalName (StructureInfo StructureCells Entity))
-> Map OriginalName (StructureInfo StructureCells Entity)
forall s a. s -> Getting a s a -> a
^. (Discovery
 -> Const
      (Map OriginalName (StructureInfo StructureCells Entity)) Discovery)
-> GameState
-> Const
     (Map OriginalName (StructureInfo StructureCells Entity)) GameState
Lens' GameState Discovery
discovery ((Discovery
  -> Const
       (Map OriginalName (StructureInfo StructureCells Entity)) Discovery)
 -> GameState
 -> Const
      (Map OriginalName (StructureInfo StructureCells Entity)) GameState)
-> ((Map OriginalName (StructureInfo StructureCells Entity)
     -> Const
          (Map OriginalName (StructureInfo StructureCells Entity))
          (Map OriginalName (StructureInfo StructureCells Entity)))
    -> Discovery
    -> Const
         (Map OriginalName (StructureInfo StructureCells Entity)) Discovery)
-> Getting
     (Map OriginalName (StructureInfo StructureCells Entity))
     GameState
     (Map OriginalName (StructureInfo StructureCells Entity))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureRecognizer StructureCells Entity
 -> Const
      (Map OriginalName (StructureInfo StructureCells Entity))
      (StructureRecognizer StructureCells Entity))
-> Discovery
-> Const
     (Map OriginalName (StructureInfo StructureCells Entity)) Discovery
Lens' Discovery (StructureRecognizer StructureCells Entity)
structureRecognition ((StructureRecognizer StructureCells Entity
  -> Const
       (Map OriginalName (StructureInfo StructureCells Entity))
       (StructureRecognizer StructureCells Entity))
 -> Discovery
 -> Const
      (Map OriginalName (StructureInfo StructureCells Entity)) Discovery)
-> ((Map OriginalName (StructureInfo StructureCells Entity)
     -> Const
          (Map OriginalName (StructureInfo StructureCells Entity))
          (Map OriginalName (StructureInfo StructureCells Entity)))
    -> StructureRecognizer StructureCells Entity
    -> Const
         (Map OriginalName (StructureInfo StructureCells Entity))
         (StructureRecognizer StructureCells Entity))
-> (Map OriginalName (StructureInfo StructureCells Entity)
    -> Const
         (Map OriginalName (StructureInfo StructureCells Entity))
         (Map OriginalName (StructureInfo StructureCells Entity)))
-> Discovery
-> Const
     (Map OriginalName (StructureInfo StructureCells Entity)) Discovery
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RecognizerAutomatons StructureCells Entity
 -> Const
      (Map OriginalName (StructureInfo StructureCells Entity))
      (RecognizerAutomatons StructureCells Entity))
-> StructureRecognizer StructureCells Entity
-> Const
     (Map OriginalName (StructureInfo StructureCells Entity))
     (StructureRecognizer StructureCells Entity)
forall b a (f :: * -> *).
Functor f =>
(RecognizerAutomatons b a -> f (RecognizerAutomatons b a))
-> StructureRecognizer b a -> f (StructureRecognizer b a)
automatons ((RecognizerAutomatons StructureCells Entity
  -> Const
       (Map OriginalName (StructureInfo StructureCells Entity))
       (RecognizerAutomatons StructureCells Entity))
 -> StructureRecognizer StructureCells Entity
 -> Const
      (Map OriginalName (StructureInfo StructureCells Entity))
      (StructureRecognizer StructureCells Entity))
-> ((Map OriginalName (StructureInfo StructureCells Entity)
     -> Const
          (Map OriginalName (StructureInfo StructureCells Entity))
          (Map OriginalName (StructureInfo StructureCells Entity)))
    -> RecognizerAutomatons StructureCells Entity
    -> Const
         (Map OriginalName (StructureInfo StructureCells Entity))
         (RecognizerAutomatons StructureCells Entity))
-> (Map OriginalName (StructureInfo StructureCells Entity)
    -> Const
         (Map OriginalName (StructureInfo StructureCells Entity))
         (Map OriginalName (StructureInfo StructureCells Entity)))
-> StructureRecognizer StructureCells Entity
-> Const
     (Map OriginalName (StructureInfo StructureCells Entity))
     (StructureRecognizer StructureCells Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map OriginalName (StructureInfo StructureCells Entity)
 -> Const
      (Map OriginalName (StructureInfo StructureCells Entity))
      (Map OriginalName (StructureInfo StructureCells Entity)))
-> RecognizerAutomatons StructureCells Entity
-> Const
     (Map OriginalName (StructureInfo StructureCells Entity))
     (RecognizerAutomatons StructureCells Entity)
forall b a (f :: * -> *).
Functor f =>
(Map OriginalName (StructureInfo b a)
 -> f (Map OriginalName (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

-- | 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 OriginalName IO AppState
initAppStateForScenario FilePath
sceneName Maybe Seed
userSeed Maybe FilePath
toRun =
  ThrowC OriginalName IO AppState -> ExceptT OriginalName IO AppState
forall e (m :: * -> *) a. ThrowC e m a -> ExceptT e m a
asExceptT (ThrowC OriginalName IO AppState
 -> ExceptT OriginalName IO AppState)
-> (AppOpts -> ThrowC OriginalName IO AppState)
-> AppOpts
-> ExceptT OriginalName IO AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SystemFailure -> OriginalName)
-> ThrowC SystemFailure (ThrowC OriginalName IO) AppState
-> ThrowC OriginalName 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 -> OriginalName
prettyText @SystemFailure) (ThrowC SystemFailure (ThrowC OriginalName IO) AppState
 -> ThrowC OriginalName IO AppState)
-> (AppOpts
    -> ThrowC SystemFailure (ThrowC OriginalName IO) AppState)
-> AppOpts
-> ThrowC OriginalName IO AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppOpts -> ThrowC SystemFailure (ThrowC OriginalName IO) AppState
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
AppOpts -> m AppState
initAppState (AppOpts -> ExceptT OriginalName IO AppState)
-> AppOpts -> ExceptT OriginalName 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 OriginalName IO AppState
classicGame0 = FilePath
-> Maybe Seed -> Maybe FilePath -> ExceptT OriginalName IO AppState
initAppStateForScenario FilePath
"classic" (Seed -> Maybe Seed
forall a. a -> Maybe a
Just Seed
0) Maybe FilePath
forall a. Maybe a
Nothing