{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Definition of the record holding all the game-related state, and various related
-- utility functions.
module Swarm.Game.State (
  -- * Game state record and related types
  ViewCenterRule (..),
  REPLStatus (..),
  WinStatus (..),
  WinCondition (..),
  ObjectiveCompletion (..),
  _NoWinCondition,
  _WinConditions,
  Announcement (..),
  RunStatus (..),
  Seed,
  Step (..),
  SingleStep (..),
  GameState,

  -- ** GameState fields
  creativeMode,
  winCondition,
  winSolution,
  robotMap,
  robotsByLocation,
  robotsAtLocation,
  robotsWatching,
  robotsInArea,
  baseRobot,
  activeRobots,
  waitingRobots,
  messageNotifications,
  seed,
  randGen,
  currentScenarioPath,
  viewCenterRule,
  viewCenter,
  needsRedraw,
  focusedRobotID,

  -- *** Subrecord accessors
  temporal,
  robotNaming,
  recipesInfo,
  messageInfo,
  gameControls,
  discovery,
  landscape,

  -- ** GameState subrecords

  -- *** Temporal state
  TemporalState,
  gameStep,
  runStatus,
  ticks,
  robotStepsPerTick,
  paused,

  -- *** Robot naming
  RobotNaming,
  nameGenerator,
  gensym,

  -- *** Recipes
  Recipes,
  recipesOut,
  recipesIn,
  recipesCat,

  -- *** Messages
  Messages,
  messageQueue,
  lastSeenMessageTime,
  announcementQueue,

  -- *** Controls
  GameControls,
  initiallyRunCode,
  replStatus,
  replNextValueIndex,
  replWorking,
  replActiveType,
  inputHandler,

  -- *** Discovery
  Discovery,
  allDiscoveredEntities,
  availableRecipes,
  availableCommands,
  knownEntities,
  gameAchievements,

  -- *** Landscape
  Landscape,
  worldNavigation,
  multiWorld,
  worldScrollable,
  entityMap,

  -- ** Notifications
  Notifications (..),
  notificationsCount,
  notificationsContent,

  -- ** Launch parameters
  LaunchParams,
  ValidatedLaunchParams,

  -- ** GameState initialization
  GameStateConfig (..),
  initGameState,
  scenarioToGameState,
  CodeToRun (..),
  Sha1 (..),
  SolutionSource (..),
  parseCodeFile,

  -- * Utilities
  applyViewCenterRule,
  recalcViewCenter,
  modifyViewCenter,
  viewingRegion,
  unfocus,
  focusedRobot,
  RobotRange (..),
  focusedRange,
  getRadioRange,
  clearFocusedRobotLogUpdated,
  addRobot,
  addRobotToLocation,
  addTRobot,
  emitMessage,
  wakeWatchingRobots,
  sleepUntil,
  sleepForever,
  wakeUpRobotsDoneSleeping,
  deleteRobot,
  removeRobotFromLocationMap,
  activateRobot,
  toggleRunStatus,
  messageIsRecent,
  messageIsFromNearby,
  getRunCodePath,
  buildWorldTuples,
  genMultiWorld,
  genRobotTemplates,
) where

import Control.Applicative ((<|>))
import Control.Arrow (Arrow ((&&&)))
import Control.Effect.Lens
import Control.Effect.Lift
import Control.Effect.State (State)
import Control.Effect.Throw
import Control.Lens hiding (Const, use, uses, view, (%=), (+=), (.=), (<+=), (<<.=))
import Control.Monad (forM_)
import Data.Aeson (FromJSON, ToJSON)
import Data.Array (Array, listArray)
import Data.Bifunctor (first)
import Data.Digest.Pure.SHA (sha1, showDigest)
import Data.Foldable (toList)
import Data.Int (Int32)
import Data.IntMap (IntMap)
import Data.IntMap qualified as IM
import Data.IntSet (IntSet)
import Data.IntSet qualified as IS
import Data.IntSet.Lens (setOf)
import Data.List (partition, sortOn)
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NE
import Data.Map (Map)
import Data.Map qualified as M
import Data.Maybe (fromMaybe, isJust, isNothing, listToMaybe, mapMaybe)
import Data.Sequence (Seq ((:<|)))
import Data.Sequence qualified as Seq
import Data.Set qualified as S
import Data.Text (Text)
import Data.Text qualified as T (drop, take)
import Data.Text.IO qualified as TIO
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Encoding qualified as TL
import Data.Tuple (swap)
import GHC.Generics (Generic)
import Servant.Docs (ToSample)
import Servant.Docs qualified as SD
import Swarm.Game.Achievement.Attainment
import Swarm.Game.Achievement.Definitions
import Swarm.Game.CESK (CESK (Waiting), TickNumber (..), addTicks, emptyStore, finalValue, initMachine)
import Swarm.Game.Entity
import Swarm.Game.Failure (SystemFailure (..))
import Swarm.Game.Location
import Swarm.Game.Recipe (
  Recipe,
  catRecipeMap,
  inRecipeMap,
  outRecipeMap,
 )
import Swarm.Game.ResourceLoading (NameGenerator)
import Swarm.Game.Robot
import Swarm.Game.Scenario.Objective
import Swarm.Game.Scenario.Status
import Swarm.Game.Scenario.Topography.Navigation.Portal (Navigation (..))
import Swarm.Game.ScenarioInfo
import Swarm.Game.Terrain (TerrainType (..))
import Swarm.Game.Universe as U
import Swarm.Game.World (Coords (..), WorldFun (..), locToCoords, worldFunFromArray)
import Swarm.Game.World qualified as W
import Swarm.Game.World.Eval (runWorld)
import Swarm.Game.World.Gen (Seed, findGoodOrigin)
import Swarm.Game.World.Typecheck (WorldMap)
import Swarm.Language.Capability (constCaps)
import Swarm.Language.Context qualified as Ctx
import Swarm.Language.Module (Module (Module))
import Swarm.Language.Pipeline (ProcessedTerm (ProcessedTerm), processTermEither)
import Swarm.Language.Syntax (Const, SrcLoc (..), Syntax' (..), allConst)
import Swarm.Language.Typed (Typed (Typed))
import Swarm.Language.Types
import Swarm.Language.Value (Value)
import Swarm.Log
import Swarm.Util (applyWhen, binTuples, surfaceEmpty, uniq, (<+=), (<<.=), (?))
import Swarm.Util.Erasable
import Swarm.Util.Lens (makeLensesExcluding, makeLensesNoSigs)
import System.Clock qualified as Clock
import System.Random (StdGen, mkStdGen, randomRIO)

------------------------------------------------------------
-- Subsidiary data types
------------------------------------------------------------

-- | The 'ViewCenterRule' specifies how to determine the center of the
--   world viewport.
data ViewCenterRule
  = -- | The view should be centered on an absolute position.
    VCLocation (Cosmic Location)
  | -- | The view should be centered on a certain robot.
    VCRobot RID
  deriving (ViewCenterRule -> ViewCenterRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ViewCenterRule -> ViewCenterRule -> Bool
$c/= :: ViewCenterRule -> ViewCenterRule -> Bool
== :: ViewCenterRule -> ViewCenterRule -> Bool
$c== :: ViewCenterRule -> ViewCenterRule -> Bool
Eq, Eq ViewCenterRule
ViewCenterRule -> ViewCenterRule -> Bool
ViewCenterRule -> ViewCenterRule -> Ordering
ViewCenterRule -> ViewCenterRule -> ViewCenterRule
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ViewCenterRule -> ViewCenterRule -> ViewCenterRule
$cmin :: ViewCenterRule -> ViewCenterRule -> ViewCenterRule
max :: ViewCenterRule -> ViewCenterRule -> ViewCenterRule
$cmax :: ViewCenterRule -> ViewCenterRule -> ViewCenterRule
>= :: ViewCenterRule -> ViewCenterRule -> Bool
$c>= :: ViewCenterRule -> ViewCenterRule -> Bool
> :: ViewCenterRule -> ViewCenterRule -> Bool
$c> :: ViewCenterRule -> ViewCenterRule -> Bool
<= :: ViewCenterRule -> ViewCenterRule -> Bool
$c<= :: ViewCenterRule -> ViewCenterRule -> Bool
< :: ViewCenterRule -> ViewCenterRule -> Bool
$c< :: ViewCenterRule -> ViewCenterRule -> Bool
compare :: ViewCenterRule -> ViewCenterRule -> Ordering
$ccompare :: ViewCenterRule -> ViewCenterRule -> Ordering
Ord, RID -> ViewCenterRule -> ShowS
[ViewCenterRule] -> ShowS
ViewCenterRule -> String
forall a.
(RID -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ViewCenterRule] -> ShowS
$cshowList :: [ViewCenterRule] -> ShowS
show :: ViewCenterRule -> String
$cshow :: ViewCenterRule -> String
showsPrec :: RID -> ViewCenterRule -> ShowS
$cshowsPrec :: RID -> ViewCenterRule -> ShowS
Show, forall x. Rep ViewCenterRule x -> ViewCenterRule
forall x. ViewCenterRule -> Rep ViewCenterRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ViewCenterRule x -> ViewCenterRule
$cfrom :: forall x. ViewCenterRule -> Rep ViewCenterRule x
Generic, Value -> Parser [ViewCenterRule]
Value -> Parser ViewCenterRule
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ViewCenterRule]
$cparseJSONList :: Value -> Parser [ViewCenterRule]
parseJSON :: Value -> Parser ViewCenterRule
$cparseJSON :: Value -> Parser ViewCenterRule
FromJSON, [ViewCenterRule] -> Encoding
[ViewCenterRule] -> Value
ViewCenterRule -> Encoding
ViewCenterRule -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ViewCenterRule] -> Encoding
$ctoEncodingList :: [ViewCenterRule] -> Encoding
toJSONList :: [ViewCenterRule] -> Value
$ctoJSONList :: [ViewCenterRule] -> Value
toEncoding :: ViewCenterRule -> Encoding
$ctoEncoding :: ViewCenterRule -> Encoding
toJSON :: ViewCenterRule -> Value
$ctoJSON :: ViewCenterRule -> Value
ToJSON)

makePrisms ''ViewCenterRule

-- | A data type to represent the current status of the REPL.
data REPLStatus
  = -- | The REPL is not doing anything actively at the moment.
    --   We persist the last value and its type though.
    --
    --   INVARIANT: the 'Value' stored here is not a 'Swarm.Language.Value.VResult'.
    REPLDone (Maybe (Typed Value))
  | -- | A command entered at the REPL is currently being run.  The
    --   'Polytype' represents the type of the expression that was
    --   entered.  The @Maybe Value@ starts out as 'Nothing' and gets
    --   filled in with a result once the command completes.
    REPLWorking (Typed (Maybe Value))
  deriving (REPLStatus -> REPLStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: REPLStatus -> REPLStatus -> Bool
$c/= :: REPLStatus -> REPLStatus -> Bool
== :: REPLStatus -> REPLStatus -> Bool
$c== :: REPLStatus -> REPLStatus -> Bool
Eq, RID -> REPLStatus -> ShowS
[REPLStatus] -> ShowS
REPLStatus -> String
forall a.
(RID -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [REPLStatus] -> ShowS
$cshowList :: [REPLStatus] -> ShowS
show :: REPLStatus -> String
$cshow :: REPLStatus -> String
showsPrec :: RID -> REPLStatus -> ShowS
$cshowsPrec :: RID -> REPLStatus -> ShowS
Show, forall x. Rep REPLStatus x -> REPLStatus
forall x. REPLStatus -> Rep REPLStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep REPLStatus x -> REPLStatus
$cfrom :: forall x. REPLStatus -> Rep REPLStatus x
Generic, Value -> Parser [REPLStatus]
Value -> Parser REPLStatus
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [REPLStatus]
$cparseJSONList :: Value -> Parser [REPLStatus]
parseJSON :: Value -> Parser REPLStatus
$cparseJSON :: Value -> Parser REPLStatus
FromJSON, [REPLStatus] -> Encoding
[REPLStatus] -> Value
REPLStatus -> Encoding
REPLStatus -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [REPLStatus] -> Encoding
$ctoEncodingList :: [REPLStatus] -> Encoding
toJSONList :: [REPLStatus] -> Value
$ctoJSONList :: [REPLStatus] -> Value
toEncoding :: REPLStatus -> Encoding
$ctoEncoding :: REPLStatus -> Encoding
toJSON :: REPLStatus -> Value
$ctoJSON :: REPLStatus -> Value
ToJSON)

data WinStatus
  = -- | There are one or more objectives remaining that the player
    -- has not yet accomplished.
    Ongoing
  | -- | The player has won.
    -- The boolean indicates whether they have
    -- already been congratulated.
    Won Bool
  | -- | The player has completed certain "goals" that preclude
    -- (via negative prerequisites) the completion of all of the
    -- required goals.
    -- The boolean indicates whether they have
    -- already been informed.
    Unwinnable Bool
  deriving (RID -> WinStatus -> ShowS
[WinStatus] -> ShowS
WinStatus -> String
forall a.
(RID -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WinStatus] -> ShowS
$cshowList :: [WinStatus] -> ShowS
show :: WinStatus -> String
$cshow :: WinStatus -> String
showsPrec :: RID -> WinStatus -> ShowS
$cshowsPrec :: RID -> WinStatus -> ShowS
Show, forall x. Rep WinStatus x -> WinStatus
forall x. WinStatus -> Rep WinStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WinStatus x -> WinStatus
$cfrom :: forall x. WinStatus -> Rep WinStatus x
Generic, Value -> Parser [WinStatus]
Value -> Parser WinStatus
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [WinStatus]
$cparseJSONList :: Value -> Parser [WinStatus]
parseJSON :: Value -> Parser WinStatus
$cparseJSON :: Value -> Parser WinStatus
FromJSON, [WinStatus] -> Encoding
[WinStatus] -> Value
WinStatus -> Encoding
WinStatus -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [WinStatus] -> Encoding
$ctoEncodingList :: [WinStatus] -> Encoding
toJSONList :: [WinStatus] -> Value
$ctoJSONList :: [WinStatus] -> Value
toEncoding :: WinStatus -> Encoding
$ctoEncoding :: WinStatus -> Encoding
toJSON :: WinStatus -> Value
$ctoJSON :: WinStatus -> Value
ToJSON)

data WinCondition
  = -- | There is no winning condition.
    NoWinCondition
  | -- | NOTE: It is possible to continue to achieve "optional" objectives
    -- even after the game has been won (or deemed unwinnable).
    WinConditions WinStatus ObjectiveCompletion
  deriving (RID -> WinCondition -> ShowS
[WinCondition] -> ShowS
WinCondition -> String
forall a.
(RID -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WinCondition] -> ShowS
$cshowList :: [WinCondition] -> ShowS
show :: WinCondition -> String
$cshow :: WinCondition -> String
showsPrec :: RID -> WinCondition -> ShowS
$cshowsPrec :: RID -> WinCondition -> ShowS
Show, forall x. Rep WinCondition x -> WinCondition
forall x. WinCondition -> Rep WinCondition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WinCondition x -> WinCondition
$cfrom :: forall x. WinCondition -> Rep WinCondition x
Generic, Value -> Parser [WinCondition]
Value -> Parser WinCondition
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [WinCondition]
$cparseJSONList :: Value -> Parser [WinCondition]
parseJSON :: Value -> Parser WinCondition
$cparseJSON :: Value -> Parser WinCondition
FromJSON, [WinCondition] -> Encoding
[WinCondition] -> Value
WinCondition -> Encoding
WinCondition -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [WinCondition] -> Encoding
$ctoEncodingList :: [WinCondition] -> Encoding
toJSONList :: [WinCondition] -> Value
$ctoJSONList :: [WinCondition] -> Value
toEncoding :: WinCondition -> Encoding
$ctoEncoding :: WinCondition -> Encoding
toJSON :: WinCondition -> Value
$ctoJSON :: WinCondition -> Value
ToJSON)

makePrisms ''WinCondition

instance ToSample WinCondition where
  toSamples :: Proxy WinCondition -> [(Text, WinCondition)]
toSamples Proxy WinCondition
_ =
    forall a. [a] -> [(Text, a)]
SD.samples
      [ WinCondition
NoWinCondition
      -- TODO: #1552 add simple objective sample
      ]

-- | A data type to keep track of the pause mode.
data RunStatus
  = -- | The game is running.
    Running
  | -- | The user paused the game, and it should stay pause after visiting the help.
    ManualPause
  | -- | The game got paused while visiting the help,
    --   and it should unpause after returning back to the game.
    AutoPause
  deriving (RunStatus -> RunStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RunStatus -> RunStatus -> Bool
$c/= :: RunStatus -> RunStatus -> Bool
== :: RunStatus -> RunStatus -> Bool
$c== :: RunStatus -> RunStatus -> Bool
Eq, RID -> RunStatus -> ShowS
[RunStatus] -> ShowS
RunStatus -> String
forall a.
(RID -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunStatus] -> ShowS
$cshowList :: [RunStatus] -> ShowS
show :: RunStatus -> String
$cshow :: RunStatus -> String
showsPrec :: RID -> RunStatus -> ShowS
$cshowsPrec :: RID -> RunStatus -> ShowS
Show, forall x. Rep RunStatus x -> RunStatus
forall x. RunStatus -> Rep RunStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RunStatus x -> RunStatus
$cfrom :: forall x. RunStatus -> Rep RunStatus x
Generic, Value -> Parser [RunStatus]
Value -> Parser RunStatus
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [RunStatus]
$cparseJSONList :: Value -> Parser [RunStatus]
parseJSON :: Value -> Parser RunStatus
$cparseJSON :: Value -> Parser RunStatus
FromJSON, [RunStatus] -> Encoding
[RunStatus] -> Value
RunStatus -> Encoding
RunStatus -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RunStatus] -> Encoding
$ctoEncodingList :: [RunStatus] -> Encoding
toJSONList :: [RunStatus] -> Value
$ctoJSONList :: [RunStatus] -> Value
toEncoding :: RunStatus -> Encoding
$ctoEncoding :: RunStatus -> Encoding
toJSON :: RunStatus -> Value
$ctoJSON :: RunStatus -> Value
ToJSON)

-- | Switch (auto or manually) paused game to running and running to manually paused.
--
--   Note that this function is not safe to use in the app directly, because the UI
--   also tracks time between ticks---use 'Swarm.TUI.Controller.safeTogglePause' instead.
toggleRunStatus :: RunStatus -> RunStatus
toggleRunStatus :: RunStatus -> RunStatus
toggleRunStatus RunStatus
s = if RunStatus
s forall a. Eq a => a -> a -> Bool
== RunStatus
Running then RunStatus
ManualPause else RunStatus
Running

-- | A data type to keep track of some kind of log or sequence, with
--   an index to remember which ones are "new" and which ones have
--   "already been seen".
data Notifications a = Notifications
  { forall a. Notifications a -> RID
_notificationsCount :: Int
  , forall a. Notifications a -> [a]
_notificationsContent :: [a]
  }
  deriving (Notifications a -> Notifications a -> Bool
forall a. Eq a => Notifications a -> Notifications a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Notifications a -> Notifications a -> Bool
$c/= :: forall a. Eq a => Notifications a -> Notifications a -> Bool
== :: Notifications a -> Notifications a -> Bool
$c== :: forall a. Eq a => Notifications a -> Notifications a -> Bool
Eq, RID -> Notifications a -> ShowS
forall a. Show a => RID -> Notifications a -> ShowS
forall a. Show a => [Notifications a] -> ShowS
forall a. Show a => Notifications a -> String
forall a.
(RID -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Notifications a] -> ShowS
$cshowList :: forall a. Show a => [Notifications a] -> ShowS
show :: Notifications a -> String
$cshow :: forall a. Show a => Notifications a -> String
showsPrec :: RID -> Notifications a -> ShowS
$cshowsPrec :: forall a. Show a => RID -> Notifications a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Notifications a) x -> Notifications a
forall a x. Notifications a -> Rep (Notifications a) x
$cto :: forall a x. Rep (Notifications a) x -> Notifications a
$cfrom :: forall a x. Notifications a -> Rep (Notifications a) x
Generic, forall a. FromJSON a => Value -> Parser [Notifications a]
forall a. FromJSON a => Value -> Parser (Notifications a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Notifications a]
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [Notifications a]
parseJSON :: Value -> Parser (Notifications a)
$cparseJSON :: forall a. FromJSON a => Value -> Parser (Notifications a)
FromJSON, forall a. ToJSON a => [Notifications a] -> Encoding
forall a. ToJSON a => [Notifications a] -> Value
forall a. ToJSON a => Notifications a -> Encoding
forall a. ToJSON a => Notifications a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Notifications a] -> Encoding
$ctoEncodingList :: forall a. ToJSON a => [Notifications a] -> Encoding
toJSONList :: [Notifications a] -> Value
$ctoJSONList :: forall a. ToJSON a => [Notifications a] -> Value
toEncoding :: Notifications a -> Encoding
$ctoEncoding :: forall a. ToJSON a => Notifications a -> Encoding
toJSON :: Notifications a -> Value
$ctoJSON :: forall a. ToJSON a => Notifications a -> Value
ToJSON)

instance Semigroup (Notifications a) where
  Notifications RID
count1 [a]
xs1 <> :: Notifications a -> Notifications a -> Notifications a
<> Notifications RID
count2 [a]
xs2 = forall a. RID -> [a] -> Notifications a
Notifications (RID
count1 forall a. Num a => a -> a -> a
+ RID
count2) ([a]
xs1 forall a. Semigroup a => a -> a -> a
<> [a]
xs2)

instance Monoid (Notifications a) where
  mempty :: Notifications a
mempty = forall a. RID -> [a] -> Notifications a
Notifications RID
0 []

makeLenses ''Notifications

newtype Sha1 = Sha1 String

data SolutionSource
  = ScenarioSuggested
  | -- | Includes the SHA1 of the program text
    -- for the purpose of corroborating solutions
    -- on a leaderboard.
    PlayerAuthored FilePath Sha1

data CodeToRun = CodeToRun SolutionSource ProcessedTerm

getRunCodePath :: CodeToRun -> Maybe FilePath
getRunCodePath :: CodeToRun -> Maybe String
getRunCodePath (CodeToRun SolutionSource
solutionSource ProcessedTerm
_) = case SolutionSource
solutionSource of
  SolutionSource
ScenarioSuggested -> forall a. Maybe a
Nothing
  PlayerAuthored String
fp Sha1
_ -> forall a. a -> Maybe a
Just String
fp

parseCodeFile ::
  (Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
  FilePath ->
  m CodeToRun
parseCodeFile :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
String -> m CodeToRun
parseCodeFile String
filepath = do
  Text
contents <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ String -> IO Text
TIO.readFile String
filepath
  pt :: ProcessedTerm
pt@(ProcessedTerm (Module (Syntax' SrcLoc
srcLoc Term' Polytype
_ Polytype
_) Ctx Polytype
_) Requirements
_ ReqCtx
_) <-
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SystemFailure
CustomFailure) forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text ProcessedTerm
processTermEither Text
contents)
  let strippedText :: Text
strippedText = SrcLoc -> Text -> Text
stripSrc SrcLoc
srcLoc Text
contents
      programBytestring :: ByteString
programBytestring = Text -> ByteString
TL.encodeUtf8 forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
strippedText
      sha1Hash :: String
sha1Hash = forall t. Digest t -> String
showDigest forall a b. (a -> b) -> a -> b
$ ByteString -> Digest SHA1State
sha1 ByteString
programBytestring
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SolutionSource -> ProcessedTerm -> CodeToRun
CodeToRun (String -> Sha1 -> SolutionSource
PlayerAuthored String
filepath forall a b. (a -> b) -> a -> b
$ String -> Sha1
Sha1 String
sha1Hash) ProcessedTerm
pt
 where
  stripSrc :: SrcLoc -> Text -> Text
  stripSrc :: SrcLoc -> Text -> Text
stripSrc (SrcLoc RID
start RID
end) Text
txt = RID -> Text -> Text
T.drop RID
start forall a b. (a -> b) -> a -> b
$ RID -> Text -> Text
T.take RID
end Text
txt
  stripSrc SrcLoc
NoLoc Text
txt = Text
txt

------------------------------------------------------------
-- The main GameState record type
------------------------------------------------------------

-- | By default, robots may make a maximum of 100 CESK machine steps
--   during one game tick.
defaultRobotStepsPerTick :: Int
defaultRobotStepsPerTick :: RID
defaultRobotStepsPerTick = RID
100

-- | Type for remembering which robots will be run next in a robot step mode.
--
-- Once some robots have run, we need to store 'RID' to know which ones should go next.
-- At 'SBefore' no robots were run yet, so it is safe to transition to and from 'WorldTick'.
--
-- @
--                     tick
--     ┌────────────────────────────────────┐
--     │                                    │
--     │               step                 │
--     │              ┌────┐                │
--     ▼              ▼    │                │
-- ┌───────┐ step  ┌───────┴───┐ step  ┌────┴─────┐
-- │SBefore├──────►│SSingle RID├──────►│SAfter RID│
-- └──┬────┘       └───────────┘       └────┬─────┘
--    │ ▲ player        ▲                   │
--    ▼ │ switch        └───────────────────┘
-- ┌────┴────┐             view RID > oldRID
-- │WorldTick│
-- └─────────┘
-- @
data SingleStep
  = -- | Run the robots from the beginning until the focused robot (noninclusive).
    SBefore
  | -- | Run a single step of the focused robot.
    SSingle RID
  | -- | Run robots after the (previously) focused robot and finish the tick.
    SAfter RID

-- | Game step mode - we use the single step mode when debugging robot 'CESK' machine.
data Step = WorldTick | RobotStep SingleStep

data Recipes = Recipes
  { Recipes -> IntMap [Recipe Entity]
_recipesOut :: IntMap [Recipe Entity]
  , Recipes -> IntMap [Recipe Entity]
_recipesIn :: IntMap [Recipe Entity]
  , Recipes -> IntMap [Recipe Entity]
_recipesCat :: IntMap [Recipe Entity]
  }

makeLensesNoSigs ''Recipes

-- | All recipes the game knows about, indexed by outputs.
recipesOut :: Lens' Recipes (IntMap [Recipe Entity])

-- | All recipes the game knows about, indexed by inputs.
recipesIn :: Lens' Recipes (IntMap [Recipe Entity])

-- | All recipes the game knows about, indexed by requirement/catalyst.
recipesCat :: Lens' Recipes (IntMap [Recipe Entity])

data Messages = Messages
  { Messages -> Seq LogEntry
_messageQueue :: Seq LogEntry
  , Messages -> TickNumber
_lastSeenMessageTime :: TickNumber
  , Messages -> Seq Announcement
_announcementQueue :: Seq Announcement
  }

makeLensesNoSigs ''Messages

-- | A queue of global messages.
--
-- Note that we put the newest entry to the right.
messageQueue :: Lens' Messages (Seq LogEntry)

-- | Last time message queue has been viewed (used for notification).
lastSeenMessageTime :: Lens' Messages TickNumber

-- | A queue of global announcements.
-- Note that this is distinct from the 'messageQueue',
-- which is for messages emitted by robots.
--
-- Note that we put the newest entry to the right.
announcementQueue :: Lens' Messages (Seq Announcement)

data RobotNaming = RobotNaming
  { RobotNaming -> NameGenerator
_nameGenerator :: NameGenerator
  , RobotNaming -> RID
_gensym :: Int
  }

makeLensesExcluding ['_nameGenerator] ''RobotNaming

--- | Read-only list of words, for use in building random robot names.
nameGenerator :: Getter RobotNaming NameGenerator
nameGenerator :: Getter RobotNaming NameGenerator
nameGenerator = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to RobotNaming -> NameGenerator
_nameGenerator

-- | A counter used to generate globally unique IDs.
gensym :: Lens' RobotNaming Int

data TemporalState = TemporalState
  { TemporalState -> Step
_gameStep :: Step
  , TemporalState -> RunStatus
_runStatus :: RunStatus
  , TemporalState -> TickNumber
_ticks :: TickNumber
  , TemporalState -> RID
_robotStepsPerTick :: Int
  }

makeLensesNoSigs ''TemporalState

-- | How to step the game: 'WorldTick' or 'RobotStep' for debugging the 'CESK' machine.
gameStep :: Lens' TemporalState Step

-- | The current 'RunStatus'.
runStatus :: Lens' TemporalState RunStatus

-- | Whether the game is currently paused.
paused :: Getter TemporalState Bool
paused :: Getter TemporalState Bool
paused = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\TemporalState
s -> TemporalState
s forall s a. s -> Getting a s a -> a
^. Lens' TemporalState RunStatus
runStatus forall a. Eq a => a -> a -> Bool
/= RunStatus
Running)

-- | The number of ticks elapsed since the game started.
ticks :: Lens' TemporalState TickNumber

-- | The maximum number of CESK machine steps a robot may take during
--   a single tick.
robotStepsPerTick :: Lens' TemporalState Int

data GameControls = GameControls
  { GameControls -> REPLStatus
_replStatus :: REPLStatus
  , GameControls -> Integer
_replNextValueIndex :: Integer
  , GameControls -> Maybe (Text, Value)
_inputHandler :: Maybe (Text, Value)
  , GameControls -> Maybe ProcessedTerm
_initiallyRunCode :: Maybe ProcessedTerm
  }

makeLensesNoSigs ''GameControls

-- | The current status of the REPL.
replStatus :: Lens' GameControls REPLStatus

-- | The index of the next @it{index}@ value
replNextValueIndex :: Lens' GameControls Integer

-- | The currently installed input handler and hint text.
inputHandler :: Lens' GameControls (Maybe (Text, Value))

-- | Code that is run upon scenario start, before any
-- REPL interaction.
initiallyRunCode :: Lens' GameControls (Maybe ProcessedTerm)

data Discovery = Discovery
  { Discovery -> Inventory
_allDiscoveredEntities :: Inventory
  , Discovery -> Notifications (Recipe Entity)
_availableRecipes :: Notifications (Recipe Entity)
  , Discovery -> Notifications Const
_availableCommands :: Notifications Const
  , Discovery -> [Text]
_knownEntities :: [Text]
  , Discovery -> Map GameplayAchievement Attainment
_gameAchievements :: Map GameplayAchievement Attainment
  }

makeLensesNoSigs ''Discovery

-- | The list of entities that have been discovered.
allDiscoveredEntities :: Lens' Discovery Inventory

-- | The list of available recipes.
availableRecipes :: Lens' Discovery (Notifications (Recipe Entity))

-- | The list of available commands.
availableCommands :: Lens' Discovery (Notifications Const)

-- | The names of entities that should be considered \"known\", that is,
--   robots know what they are without having to scan them.
knownEntities :: Lens' Discovery [Text]

-- | Map of in-game achievements that were obtained
gameAchievements :: Lens' Discovery (Map GameplayAchievement Attainment)

data Landscape = Landscape
  { Landscape -> Navigation (Map SubworldName) Location
_worldNavigation :: Navigation (M.Map SubworldName) Location
  , Landscape -> MultiWorld RID Entity
_multiWorld :: W.MultiWorld Int Entity
  , Landscape -> EntityMap
_entityMap :: EntityMap
  , Landscape -> Bool
_worldScrollable :: Bool
  }

makeLensesNoSigs ''Landscape

-- | Includes a 'Map' of named locations and an
-- "edge list" (graph) that maps portal entrances to exits
worldNavigation :: Lens' Landscape (Navigation (M.Map SubworldName) Location)

-- | The current state of the world (terrain and entities only; robots
--   are stored in the 'robotMap').  'Int' is used instead of
--   'TerrainType' because we need to be able to store terrain values in
--   unboxed tile arrays.
multiWorld :: Lens' Landscape (W.MultiWorld Int Entity)

-- | The catalog of all entities that the game knows about.
entityMap :: Lens' Landscape EntityMap

-- | Whether the world map is supposed to be scrollable or not.
worldScrollable :: Lens' Landscape Bool

-- | The main record holding the state for the game itself (as
--   distinct from the UI).  See the lenses below for access to its
--   fields.
data GameState = GameState
  { GameState -> Bool
_creativeMode :: Bool
  , GameState -> TemporalState
_temporal :: TemporalState
  , GameState -> WinCondition
_winCondition :: WinCondition
  , GameState -> Maybe ProcessedTerm
_winSolution :: Maybe ProcessedTerm
  , GameState -> IntMap Robot
_robotMap :: IntMap Robot
  , -- A set of robots to consider for the next game tick. It is guaranteed to
    -- be a subset of the keys of 'robotMap'. It may contain waiting or idle
    -- robots. But robots that are present in 'robotMap' and not in 'activeRobots'
    -- are guaranteed to be either waiting or idle.
    GameState -> IntSet
_activeRobots :: IntSet
  , -- A set of probably waiting robots, indexed by probable wake-up time. It
    -- may contain robots that are in fact active or idle, as well as robots
    -- that do not exist anymore. Its only guarantee is that once a robot name
    -- with its wake up time is inserted in it, it will remain there until the
    -- wake-up time is reached, at which point it is removed via
    -- 'wakeUpRobotsDoneSleeping'.
    -- Waiting robots for a given time are a list because it is cheaper to
    -- prepend to a list than insert into a 'Set'.
    GameState -> Map TickNumber [RID]
_waitingRobots :: Map TickNumber [RID]
  , GameState -> Map SubworldName (Map Location IntSet)
_robotsByLocation :: Map SubworldName (Map Location IntSet)
  , -- This member exists as an optimization so
    -- that we do not have to iterate over all "waiting" robots,
    -- since there may be many.
    GameState -> Map (Cosmic Location) (Set RID)
_robotsWatching :: Map (Cosmic Location) (S.Set RID)
  , GameState -> Discovery
_discovery :: Discovery
  , GameState -> RID
_seed :: Seed
  , GameState -> StdGen
_randGen :: StdGen
  , GameState -> RobotNaming
_robotNaming :: RobotNaming
  , GameState -> Recipes
_recipesInfo :: Recipes
  , GameState -> Maybe String
_currentScenarioPath :: Maybe FilePath
  , GameState -> Landscape
_landscape :: Landscape
  , GameState -> ViewCenterRule
_viewCenterRule :: ViewCenterRule
  , GameState -> Cosmic Location
_viewCenter :: Cosmic Location
  , GameState -> Bool
_needsRedraw :: Bool
  , GameState -> GameControls
_gameControls :: GameControls
  , GameState -> Messages
_messageInfo :: Messages
  , GameState -> RID
_focusedRobotID :: RID
  }

------------------------------------------------------------
-- Lenses
------------------------------------------------------------

-- We want to access active and waiting robots via lenses inside
-- this module but to expose it as a Getter to protect invariants.
makeLensesFor
  [ ("_activeRobots", "internalActiveRobots")
  , ("_waitingRobots", "internalWaitingRobots")
  ]
  ''GameState

makeLensesExcluding ['_viewCenter, '_focusedRobotID, '_viewCenterRule, '_activeRobots, '_waitingRobots] ''GameState

-- | Is the user in creative mode (i.e. able to do anything without restriction)?
creativeMode :: Lens' GameState Bool

-- | Aspects of the temporal state of the game
temporal :: Lens' GameState TemporalState

-- | How to determine whether the player has won.
winCondition :: Lens' GameState WinCondition

-- | How to win (if possible). This is useful for automated testing
--   and to show help to cheaters (or testers).
winSolution :: Lens' GameState (Maybe ProcessedTerm)

-- | All the robots that currently exist in the game, indexed by ID.
robotMap :: Lens' GameState (IntMap Robot)

-- | The names of all robots that currently exist in the game, indexed by
--   location (which we need both for /e.g./ the @salvage@ command as
--   well as for actually drawing the world).  Unfortunately there is
--   no good way to automatically keep this up to date, since we don't
--   just want to completely rebuild it every time the 'robotMap'
--   changes.  Instead, we just make sure to update it every time the
--   location of a robot changes, or a robot is created or destroyed.
--   Fortunately, there are relatively few ways for these things to
--   happen.
robotsByLocation :: Lens' GameState (Map SubworldName (Map Location IntSet))

-- | Get a list of all the robots at a particular location.
robotsAtLocation :: Cosmic Location -> GameState -> [Robot]
robotsAtLocation :: Cosmic Location -> GameState -> [Robot]
robotsAtLocation Cosmic Location
loc GameState
gs =
  forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a. RID -> IntMap a -> Maybe a
`IM.lookup` (GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState (IntMap Robot)
robotMap))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] IntSet -> [RID]
IS.toList
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Cosmic Location
loc forall s a. s -> Getting a s a -> a
^. forall a1 a2. Lens (Cosmic a1) (Cosmic a2) a1 a2
planar)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault forall a. Monoid a => a
mempty (Cosmic Location
loc forall s a. s -> Getting a s a -> a
^. forall a. Lens' (Cosmic a) SubworldName
subworld)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Lens' GameState (Map SubworldName (Map Location IntSet))
robotsByLocation
    forall a b. (a -> b) -> a -> b
$ GameState
gs

-- | Get a list of all the robots that are \"watching\" by location.
robotsWatching :: Lens' GameState (Map (Cosmic Location) (S.Set RID))

-- | Get all the robots within a given Manhattan distance from a
--   location.
robotsInArea :: Cosmic Location -> Int32 -> GameState -> [Robot]
robotsInArea :: Cosmic Location -> Int32 -> GameState -> [Robot]
robotsInArea (Cosmic SubworldName
subworldName Location
o) Int32
d GameState
gs = forall a b. (a -> b) -> [a] -> [b]
map (IntMap Robot
rm forall a. IntMap a -> RID -> a
IM.!) [RID]
rids
 where
  rm :: IntMap Robot
rm = GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState (IntMap Robot)
robotMap
  rl :: Map SubworldName (Map Location IntSet)
rl = GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState (Map SubworldName (Map Location IntSet))
robotsByLocation
  rids :: [RID]
rids =
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap IntSet -> [RID]
IS.elems forall a b. (a -> b) -> a -> b
$
      forall e. Location -> Int32 -> Map Location e -> [e]
getElemsInArea Location
o Int32
d forall a b. (a -> b) -> a -> b
$
        forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault forall a. Monoid a => a
mempty SubworldName
subworldName Map SubworldName (Map Location IntSet)
rl

-- | The base robot, if it exists.
baseRobot :: Traversal' GameState Robot
baseRobot :: Traversal' GameState Robot
baseRobot = Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix RID
0

-- | The names of the robots that are currently not sleeping.
activeRobots :: Getter GameState IntSet
activeRobots :: Getter GameState IntSet
activeRobots = Lens' GameState IntSet
internalActiveRobots

-- | The names of the robots that are currently sleeping, indexed by wake up
--   time. Note that this may not include all sleeping robots, particularly
--   those that are only taking a short nap (e.g. @wait 1@).
waitingRobots :: Getter GameState (Map TickNumber [RID])
waitingRobots :: Getter GameState (Map TickNumber [RID])
waitingRobots = Lens' GameState (Map TickNumber [RID])
internalWaitingRobots

-- | Discovery state of entities, commands, recipes
discovery :: Lens' GameState Discovery

-- | The initial seed that was used for the random number generator,
--   and world generation.
seed :: Lens' GameState Seed

-- | Pseudorandom generator initialized at start.
randGen :: Lens' GameState StdGen

-- | State and data for assigning identifiers to robots
robotNaming :: Lens' GameState RobotNaming

-- | Collection of recipe info
recipesInfo :: Lens' GameState Recipes

-- | The filepath of the currently running scenario.
--
-- This is useful as an index to the scenarios collection,
-- see 'Swarm.Game.ScenarioInfo.scenarioItemByPath'.
currentScenarioPath :: Lens' GameState (Maybe FilePath)

-- | Info about the lay of the land
landscape :: Lens' GameState Landscape

-- | The current center of the world view. Note that this cannot be
--   modified directly, since it is calculated automatically from the
--   'viewCenterRule'.  To modify the view center, either set the
--   'viewCenterRule', or use 'modifyViewCenter'.
viewCenter :: Getter GameState (Cosmic Location)
viewCenter :: Getter GameState (Cosmic Location)
viewCenter = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Cosmic Location
_viewCenter

-- | Whether the world view needs to be redrawn.
needsRedraw :: Lens' GameState Bool

-- | Controls, including REPL and key mapping
gameControls :: Lens' GameState GameControls

-- | Message info
messageInfo :: Lens' GameState Messages

-- | The current robot in focus.
--
-- It is only a 'Getter' because this value should be updated only when
-- the 'viewCenterRule' is specified to be a robot.
--
-- Technically it's the last robot ID specified by 'viewCenterRule',
-- but that robot may not be alive anymore - to be safe use 'focusedRobot'.
focusedRobotID :: Getter GameState RID
focusedRobotID :: Getter GameState RID
focusedRobotID = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> RID
_focusedRobotID

------------------------------------------------------------
-- Utilities
------------------------------------------------------------

-- | The current rule for determining the center of the world view.
--   It updates also, 'viewCenter' and 'focusedRobot' to keep
--   everything synchronized.
viewCenterRule :: Lens' GameState ViewCenterRule
viewCenterRule :: Lens' GameState ViewCenterRule
viewCenterRule = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens GameState -> ViewCenterRule
getter GameState -> ViewCenterRule -> GameState
setter
 where
  getter :: GameState -> ViewCenterRule
  getter :: GameState -> ViewCenterRule
getter = GameState -> ViewCenterRule
_viewCenterRule

  -- The setter takes care of updating 'viewCenter' and 'focusedRobot'
  -- So non of this fields get out of sync.
  setter :: GameState -> ViewCenterRule -> GameState
  setter :: GameState -> ViewCenterRule -> GameState
setter GameState
g ViewCenterRule
rule =
    case ViewCenterRule
rule of
      VCLocation Cosmic Location
loc -> GameState
g {_viewCenterRule :: ViewCenterRule
_viewCenterRule = ViewCenterRule
rule, _viewCenter :: Cosmic Location
_viewCenter = Cosmic Location
loc}
      VCRobot RID
rid ->
        let robotcenter :: Maybe (Cosmic Location)
robotcenter = GameState
g forall s a. s -> Getting (First a) s a -> Maybe a
^? Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix RID
rid forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter Robot (Cosmic Location)
robotLocation
         in -- retrieve the loc of the robot if it exists, Nothing otherwise.
            -- sometimes, lenses are amazing...
            case Maybe (Cosmic Location)
robotcenter of
              Maybe (Cosmic Location)
Nothing -> GameState
g
              Just Cosmic Location
loc -> GameState
g {_viewCenterRule :: ViewCenterRule
_viewCenterRule = ViewCenterRule
rule, _viewCenter :: Cosmic Location
_viewCenter = Cosmic Location
loc, _focusedRobotID :: RID
_focusedRobotID = RID
rid}

-- | Whether the repl is currently working.
replWorking :: Getter GameControls Bool
replWorking :: Getter GameControls Bool
replWorking = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\GameControls
s -> REPLStatus -> Bool
matchesWorking forall a b. (a -> b) -> a -> b
$ GameControls
s forall s a. s -> Getting a s a -> a
^. Lens' GameControls REPLStatus
replStatus)
 where
  matchesWorking :: REPLStatus -> Bool
matchesWorking (REPLDone Maybe (Typed Value)
_) = Bool
False
  matchesWorking (REPLWorking Typed (Maybe Value)
_) = Bool
True

-- | Either the type of the command being executed, or of the last command
replActiveType :: Getter REPLStatus (Maybe Polytype)
replActiveType :: Getter REPLStatus (Maybe Polytype)
replActiveType = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to REPLStatus -> Maybe Polytype
getter
 where
  getter :: REPLStatus -> Maybe Polytype
getter (REPLDone (Just (Typed Value
_ Polytype
typ Requirements
_))) = forall a. a -> Maybe a
Just Polytype
typ
  getter (REPLWorking (Typed Maybe Value
_ Polytype
typ Requirements
_)) = forall a. a -> Maybe a
Just Polytype
typ
  getter REPLStatus
_ = forall a. Maybe a
Nothing

-- | Get the notification list of messages from the point of view of focused robot.
messageNotifications :: Getter GameState (Notifications LogEntry)
messageNotifications :: Getter GameState (Notifications LogEntry)
messageNotifications = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Notifications LogEntry
getNotif
 where
  getNotif :: GameState -> Notifications LogEntry
getNotif GameState
gs = Notifications {_notificationsCount :: RID
_notificationsCount = forall (t :: * -> *) a. Foldable t => t a -> RID
length [LogEntry]
new, _notificationsContent :: [LogEntry]
_notificationsContent = [LogEntry]
allUniq}
   where
    allUniq :: [LogEntry]
allUniq = forall a. Eq a => [a] -> [a]
uniq forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq LogEntry
allMessages
    new :: [LogEntry]
new = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\LogEntry
l -> LogEntry
l forall s a. s -> Getting a s a -> a
^. Lens' LogEntry TickNumber
leTime forall a. Ord a => a -> a -> Bool
> GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState Messages
messageInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Messages TickNumber
lastSeenMessageTime) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [LogEntry]
allUniq
    -- creative players and system robots just see all messages (and focused robots logs)
    unchecked :: Bool
unchecked = GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState Bool
creativeMode Bool -> Bool -> Bool
|| forall a. a -> Maybe a -> a
fromMaybe Bool
False (GameState -> Maybe Robot
focusedRobot GameState
gs forall s a. s -> Getting (First a) s a -> Maybe a
^? forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot Bool
systemRobot)
    messages :: Seq LogEntry
messages = (if Bool
unchecked then forall a. a -> a
id else Seq LogEntry -> Seq LogEntry
focusedOrLatestClose) (GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState Messages
messageInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Messages (Seq LogEntry)
messageQueue)
    allMessages :: Seq LogEntry
allMessages = forall a. Ord a => Seq a -> Seq a
Seq.sort forall a b. (a -> b) -> a -> b
$ Seq LogEntry
focusedLogs forall a. Semigroup a => a -> a -> a
<> Seq LogEntry
messages
    focusedLogs :: Seq LogEntry
focusedLogs = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall s. AsEmpty s => s
Empty (forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Lens' Robot (Seq LogEntry)
robotLog) (GameState -> Maybe Robot
focusedRobot GameState
gs)
    -- classic players only get to see messages that they said and a one message that they just heard
    -- other they have to get from log
    latestMsg :: LogEntry -> Bool
latestMsg = GameState -> LogEntry -> Bool
messageIsRecent GameState
gs
    closeMsg :: LogEntry -> Bool
closeMsg = Cosmic Location -> LogEntry -> Bool
messageIsFromNearby (GameState
gs forall s a. s -> Getting a s a -> a
^. Getter GameState (Cosmic Location)
viewCenter)
    generatedBy :: RID -> LogEntry -> Bool
generatedBy RID
rid LogEntry
logEntry = case LogEntry
logEntry forall s a. s -> Getting a s a -> a
^. Lens' LogEntry LogSource
leSource of
      RobotLog RobotLogSource
_ RID
rid' Cosmic Location
_ -> RID
rid forall a. Eq a => a -> a -> Bool
== RID
rid'
      LogSource
_ -> Bool
False

    focusedOrLatestClose :: Seq LogEntry -> Seq LogEntry
focusedOrLatestClose Seq LogEntry
mq =
      (forall a. RID -> Seq a -> Seq a
Seq.take RID
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Seq a -> Seq a
Seq.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter LogEntry -> Bool
closeMsg forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Seq a
Seq.takeWhileR LogEntry -> Bool
latestMsg Seq LogEntry
mq)
        forall a. Semigroup a => a -> a -> a
<> forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (RID -> LogEntry -> Bool
generatedBy (GameState
gs forall s a. s -> Getting a s a -> a
^. Getter GameState RID
focusedRobotID)) Seq LogEntry
mq

messageIsRecent :: GameState -> LogEntry -> Bool
messageIsRecent :: GameState -> LogEntry -> Bool
messageIsRecent GameState
gs LogEntry
e = RID -> TickNumber -> TickNumber
addTicks RID
1 (LogEntry
e forall s a. s -> Getting a s a -> a
^. Lens' LogEntry TickNumber
leTime) forall a. Ord a => a -> a -> Bool
>= GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks

-- | Reconciles the possibilities of log messages being
--   omnipresent and robots being in different worlds
messageIsFromNearby :: Cosmic Location -> LogEntry -> Bool
messageIsFromNearby :: Cosmic Location -> LogEntry -> Bool
messageIsFromNearby Cosmic Location
l LogEntry
e = case LogEntry
e forall s a. s -> Getting a s a -> a
^. Lens' LogEntry LogSource
leSource of
  LogSource
SystemLog -> Bool
True
  RobotLog RobotLogSource
_ RID
_ Cosmic Location
loc -> Cosmic Location -> Bool
f Cosmic Location
loc
 where
  f :: Cosmic Location -> Bool
f Cosmic Location
logLoc = case forall a b.
(a -> a -> b) -> Cosmic a -> Cosmic a -> DistanceMeasure b
cosmoMeasure Location -> Location -> Int32
manhattan Cosmic Location
l Cosmic Location
logLoc of
    DistanceMeasure Int32
InfinitelyFar -> Bool
False
    Measurable Int32
x -> Int32
x forall a. Ord a => a -> a -> Bool
<= forall i. Num i => i
hearingDistance

-- | Given a current mapping from robot names to robots, apply a
--   'ViewCenterRule' to derive the location it refers to.  The result
--   is 'Maybe' because the rule may refer to a robot which does not
--   exist.
applyViewCenterRule :: ViewCenterRule -> IntMap Robot -> Maybe (Cosmic Location)
applyViewCenterRule :: ViewCenterRule -> IntMap Robot -> Maybe (Cosmic Location)
applyViewCenterRule (VCLocation Cosmic Location
l) IntMap Robot
_ = forall a. a -> Maybe a
Just Cosmic Location
l
applyViewCenterRule (VCRobot RID
name) IntMap Robot
m = IntMap Robot
m forall s a. s -> Getting (First a) s a -> Maybe a
^? forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at RID
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter Robot (Cosmic Location)
robotLocation

-- | Recalculate the view center (and cache the result in the
--   'viewCenter' field) based on the current 'viewCenterRule'.  If
--   the 'viewCenterRule' specifies a robot which does not exist,
--   simply leave the current 'viewCenter' as it is. Set 'needsRedraw'
--   if the view center changes.
recalcViewCenter :: GameState -> GameState
recalcViewCenter :: GameState -> GameState
recalcViewCenter GameState
g =
  GameState
g
    { _viewCenter :: Cosmic Location
_viewCenter = Cosmic Location
newViewCenter
    }
    forall a b. a -> (a -> b) -> b
& (if Cosmic Location
newViewCenter forall a. Eq a => a -> a -> Bool
/= Cosmic Location
oldViewCenter then Lens' GameState Bool
needsRedraw forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True else forall a. a -> a
id)
 where
  oldViewCenter :: Cosmic Location
oldViewCenter = GameState
g forall s a. s -> Getting a s a -> a
^. Getter GameState (Cosmic Location)
viewCenter
  newViewCenter :: Cosmic Location
newViewCenter =
    forall a. a -> Maybe a -> a
fromMaybe Cosmic Location
oldViewCenter forall a b. (a -> b) -> a -> b
$
      ViewCenterRule -> IntMap Robot -> Maybe (Cosmic Location)
applyViewCenterRule (GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState ViewCenterRule
viewCenterRule) (GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState (IntMap Robot)
robotMap)

-- | Modify the 'viewCenter' by applying an arbitrary function to the
--   current value.  Note that this also modifies the 'viewCenterRule'
--   to match.  After calling this function the 'viewCenterRule' will
--   specify a particular location, not a robot.
modifyViewCenter :: (Cosmic Location -> Cosmic Location) -> GameState -> GameState
modifyViewCenter :: (Cosmic Location -> Cosmic Location) -> GameState -> GameState
modifyViewCenter Cosmic Location -> Cosmic Location
update GameState
g =
  GameState
g
    forall a b. a -> (a -> b) -> b
& case GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState ViewCenterRule
viewCenterRule of
      VCLocation Cosmic Location
l -> Lens' GameState ViewCenterRule
viewCenterRule forall s t a b. ASetter s t a b -> b -> s -> t
.~ Cosmic Location -> ViewCenterRule
VCLocation (Cosmic Location -> Cosmic Location
update Cosmic Location
l)
      VCRobot RID
_ -> Lens' GameState ViewCenterRule
viewCenterRule forall s t a b. ASetter s t a b -> b -> s -> t
.~ Cosmic Location -> ViewCenterRule
VCLocation (Cosmic Location -> Cosmic Location
update (GameState
g forall s a. s -> Getting a s a -> a
^. Getter GameState (Cosmic Location)
viewCenter))

-- | "Unfocus" by modifying the view center rule to look at the
--   current location instead of a specific robot, and also set the
--   focused robot ID to an invalid value.  In classic mode this
--   causes the map view to become nothing but static.
unfocus :: GameState -> GameState
unfocus :: GameState -> GameState
unfocus = (\GameState
g -> GameState
g {_focusedRobotID :: RID
_focusedRobotID = -RID
1000}) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cosmic Location -> Cosmic Location) -> GameState -> GameState
modifyViewCenter forall a. a -> a
id

-- | Given a width and height, compute the region, centered on the
--   'viewCenter', that should currently be in view.
viewingRegion :: Cosmic Location -> (Int32, Int32) -> Cosmic W.BoundsRectangle
viewingRegion :: Cosmic Location -> (Int32, Int32) -> Cosmic BoundsRectangle
viewingRegion (Cosmic SubworldName
sw (Location Int32
cx Int32
cy)) (Int32
w, Int32
h) =
  forall a. SubworldName -> a -> Cosmic a
Cosmic SubworldName
sw ((Int32, Int32) -> Coords
W.Coords (Int32
rmin, Int32
cmin), (Int32, Int32) -> Coords
W.Coords (Int32
rmax, Int32
cmax))
 where
  (Int32
rmin, Int32
rmax) = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both (forall a. Num a => a -> a -> a
+ (-Int32
cy forall a. Num a => a -> a -> a
- Int32
h forall a. Integral a => a -> a -> a
`div` Int32
2)) (Int32
0, Int32
h forall a. Num a => a -> a -> a
- Int32
1)
  (Int32
cmin, Int32
cmax) = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both (forall a. Num a => a -> a -> a
+ (Int32
cx forall a. Num a => a -> a -> a
- Int32
w forall a. Integral a => a -> a -> a
`div` Int32
2)) (Int32
0, Int32
w forall a. Num a => a -> a -> a
- Int32
1)

-- | Find out which robot has been last specified by the
--   'viewCenterRule', if any.
focusedRobot :: GameState -> Maybe Robot
focusedRobot :: GameState -> Maybe Robot
focusedRobot GameState
g = GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (GameState
g forall s a. s -> Getting a s a -> a
^. Getter GameState RID
focusedRobotID)

-- | Type for describing how far away a robot is from the base, which
--   determines what kind of communication can take place.
data RobotRange
  = -- | Close; communication is perfect.
    Close
  | -- | Mid-range; communication is possible but lossy.
    MidRange Double
  | -- | Far; communication is not possible.
    Far
  deriving (RobotRange -> RobotRange -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RobotRange -> RobotRange -> Bool
$c/= :: RobotRange -> RobotRange -> Bool
== :: RobotRange -> RobotRange -> Bool
$c== :: RobotRange -> RobotRange -> Bool
Eq, Eq RobotRange
RobotRange -> RobotRange -> Bool
RobotRange -> RobotRange -> Ordering
RobotRange -> RobotRange -> RobotRange
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RobotRange -> RobotRange -> RobotRange
$cmin :: RobotRange -> RobotRange -> RobotRange
max :: RobotRange -> RobotRange -> RobotRange
$cmax :: RobotRange -> RobotRange -> RobotRange
>= :: RobotRange -> RobotRange -> Bool
$c>= :: RobotRange -> RobotRange -> Bool
> :: RobotRange -> RobotRange -> Bool
$c> :: RobotRange -> RobotRange -> Bool
<= :: RobotRange -> RobotRange -> Bool
$c<= :: RobotRange -> RobotRange -> Bool
< :: RobotRange -> RobotRange -> Bool
$c< :: RobotRange -> RobotRange -> Bool
compare :: RobotRange -> RobotRange -> Ordering
$ccompare :: RobotRange -> RobotRange -> Ordering
Ord)

-- | Check how far away the focused robot is from the base.  @Nothing@
--   is returned if there is no focused robot; otherwise, return a
--   'RobotRange' value as follows.
--
--   * If we are in creative or scroll-enabled mode, the focused robot is
--   always considered 'Close'.
--   * Otherwise, there is a "minimum radius" and "maximum radius".
--
--       * If the robot is within the minimum radius, it is 'Close'.
--       * If the robot is between the minimum and maximum radii, it
--         is 'MidRange', with a 'Double' value ranging linearly from
--         0 to 1 proportional to the distance from the minimum to
--         maximum radius.  For example, @MidRange 0.5@ would indicate
--         a robot exactly halfway between the minimum and maximum
--         radii.
--       * If the robot is beyond the maximum radius, it is 'Far'.
--
--   * By default, the minimum radius is 16, and maximum is 64.
--   * Device augmentations
--
--       * If the focused robot has an @antenna@ installed, it doubles
--         both radii.
--       * If the base has an @antenna@ installed, it also doubles both radii.
focusedRange :: GameState -> Maybe RobotRange
focusedRange :: GameState -> Maybe RobotRange
focusedRange GameState
g = RobotRange
checkRange forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Maybe Robot
maybeFocusedRobot
 where
  maybeBaseRobot :: Maybe Robot
maybeBaseRobot = GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at RID
0
  maybeFocusedRobot :: Maybe Robot
maybeFocusedRobot = GameState -> Maybe Robot
focusedRobot GameState
g

  checkRange :: RobotRange
checkRange = case DistanceMeasure Double
r of
    DistanceMeasure Double
InfinitelyFar -> RobotRange
Far
    Measurable Double
r' -> Double -> RobotRange
computedRange Double
r'

  computedRange :: Double -> RobotRange
computedRange Double
r'
    | GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState Bool
creativeMode Bool -> Bool -> Bool
|| GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape Bool
worldScrollable Bool -> Bool -> Bool
|| Double
r' forall a. Ord a => a -> a -> Bool
<= Double
minRadius = RobotRange
Close
    | Double
r' forall a. Ord a => a -> a -> Bool
> Double
maxRadius = RobotRange
Far
    | Bool
otherwise = Double -> RobotRange
MidRange forall a b. (a -> b) -> a -> b
$ (Double
r' forall a. Num a => a -> a -> a
- Double
minRadius) forall a. Fractional a => a -> a -> a
/ (Double
maxRadius forall a. Num a => a -> a -> a
- Double
minRadius)

  -- Euclidean distance from the base to the view center.
  r :: DistanceMeasure Double
r = case Maybe Robot
maybeBaseRobot of
    -- if the base doesn't exist, we have bigger problems
    Maybe Robot
Nothing -> forall b. DistanceMeasure b
InfinitelyFar
    Just Robot
br -> forall a b.
(a -> a -> b) -> Cosmic a -> Cosmic a -> DistanceMeasure b
cosmoMeasure Location -> Location -> Double
euclidean (GameState
g forall s a. s -> Getting a s a -> a
^. Getter GameState (Cosmic Location)
viewCenter) (Robot
br forall s a. s -> Getting a s a -> a
^. Getter Robot (Cosmic Location)
robotLocation)

  (Double
minRadius, Double
maxRadius) = Maybe Robot -> Maybe Robot -> (Double, Double)
getRadioRange Maybe Robot
maybeBaseRobot Maybe Robot
maybeFocusedRobot

-- | Get the min/max communication radii given possible augmentations on each end
getRadioRange :: Maybe Robot -> Maybe Robot -> (Double, Double)
getRadioRange :: Maybe Robot -> Maybe Robot -> (Double, Double)
getRadioRange Maybe Robot
maybeBaseRobot Maybe Robot
maybeTargetRobot =
  (Double
minRadius, Double
maxRadius)
 where
  -- See whether the base or focused robot have antennas installed.
  baseInv, focInv :: Maybe Inventory
  baseInv :: Maybe Inventory
baseInv = forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Lens' Robot Inventory
equippedDevices forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Robot
maybeBaseRobot
  focInv :: Maybe Inventory
focInv = forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Lens' Robot Inventory
equippedDevices forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Robot
maybeTargetRobot

  gain :: Maybe Inventory -> (Double -> Double)
  gain :: Maybe Inventory -> Double -> Double
gain (Just Inventory
inv)
    | Text -> Inventory -> RID
countByName Text
"antenna" Inventory
inv forall a. Ord a => a -> a -> Bool
> RID
0 = (forall a. Num a => a -> a -> a
* Double
2)
  gain Maybe Inventory
_ = forall a. a -> a
id

  -- Range radii.  Default thresholds are 16, 64; each antenna
  -- boosts the signal by 2x.
  minRadius, maxRadius :: Double
  (Double
minRadius, Double
maxRadius) = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both (Maybe Inventory -> Double -> Double
gain Maybe Inventory
baseInv forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Inventory -> Double -> Double
gain Maybe Inventory
focInv) (Double
16, Double
64)

-- | Clear the 'robotLogUpdated' flag of the focused robot.
clearFocusedRobotLogUpdated :: (Has (State GameState) sig m) => m ()
clearFocusedRobotLogUpdated :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
clearFocusedRobotLogUpdated = do
  RID
n <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter GameState RID
focusedRobotID
  Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix RID
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot Bool
robotLogUpdated forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Bool
False

-- | Add a concrete instance of a robot template to the game state:
--   First, generate a unique ID number for it.  Then, add it to the
--   main robot map, the active robot set, and to to the index of
--   robots by location. Return the updated robot.
addTRobot :: (Has (State GameState) sig m) => TRobot -> m Robot
addTRobot :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
TRobot -> m Robot
addTRobot TRobot
r = do
  RID
rid <- Lens' GameState RobotNaming
robotNaming forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotNaming RID
gensym forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (State s) sig m, Num a) =>
LensLike' ((,) a) s a -> a -> m a
<+= RID
1
  let r' :: Robot
r' = RID -> TRobot -> Robot
instantiateRobot RID
rid TRobot
r
  forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Robot -> m ()
addRobot Robot
r'
  forall (m :: * -> *) a. Monad m => a -> m a
return Robot
r'

-- | Add a robot to the game state, adding it to the main robot map,
--   the active robot set, and to to the index of robots by
--   location.
addRobot :: (Has (State GameState) sig m) => Robot -> m ()
addRobot :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Robot -> m ()
addRobot Robot
r = do
  let rid :: RID
rid = Robot
r forall s a. s -> Getting a s a -> a
^. Getter Robot RID
robotID

  Lens' GameState (IntMap Robot)
robotMap forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall a. RID -> a -> IntMap a -> IntMap a
IM.insert RID
rid Robot
r
  forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> Cosmic Location -> m ()
addRobotToLocation RID
rid forall a b. (a -> b) -> a -> b
$ Robot
r forall s a. s -> Getting a s a -> a
^. Getter Robot (Cosmic Location)
robotLocation
  Lens' GameState IntSet
internalActiveRobots forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= RID -> IntSet -> IntSet
IS.insert RID
rid

-- | Helper function for updating the "robotsByLocation" bookkeeping
addRobotToLocation :: (Has (State GameState) sig m) => RID -> Cosmic Location -> m ()
addRobotToLocation :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> Cosmic Location -> m ()
addRobotToLocation RID
rid Cosmic Location
rLoc =
  Lens' GameState (Map SubworldName (Map Location IntSet))
robotsByLocation
    forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith
      (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith IntSet -> IntSet -> IntSet
IS.union)
      (Cosmic Location
rLoc forall s a. s -> Getting a s a -> a
^. forall a. Lens' (Cosmic a) SubworldName
subworld)
      (forall k a. k -> a -> Map k a
M.singleton (Cosmic Location
rLoc forall s a. s -> Getting a s a -> a
^. forall a1 a2. Lens (Cosmic a1) (Cosmic a2) a1 a2
planar) (RID -> IntSet
IS.singleton RID
rid))

maxMessageQueueSize :: Int
maxMessageQueueSize :: RID
maxMessageQueueSize = RID
1000

-- | Add a message to the message queue.
emitMessage :: (Has (State GameState) sig m) => LogEntry -> m ()
emitMessage :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
LogEntry -> m ()
emitMessage LogEntry
msg = Lens' GameState Messages
messageInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Messages (Seq LogEntry)
messageQueue forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall s a. Snoc s s a a => s -> a -> s
|> LogEntry
msg) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Seq a -> Seq a
dropLastIfLong
 where
  tooLong :: Seq a -> Bool
tooLong Seq a
s = forall a. Seq a -> RID
Seq.length Seq a
s forall a. Ord a => a -> a -> Bool
>= RID
maxMessageQueueSize
  dropLastIfLong :: Seq a -> Seq a
dropLastIfLong whole :: Seq a
whole@(a
_oldest :<| Seq a
newer) = if forall {a}. Seq a -> Bool
tooLong Seq a
whole then Seq a
newer else Seq a
whole
  dropLastIfLong Seq a
emptyQueue = Seq a
emptyQueue

-- | Takes a robot out of the 'activeRobots' set and puts it in the 'waitingRobots'
--   queue.
sleepUntil :: (Has (State GameState) sig m) => RID -> TickNumber -> m ()
sleepUntil :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> TickNumber -> m ()
sleepUntil RID
rid TickNumber
time = do
  Lens' GameState IntSet
internalActiveRobots forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= RID -> IntSet -> IntSet
IS.delete RID
rid
  Lens' GameState (Map TickNumber [RID])
internalWaitingRobots forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at TickNumber
time forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non [] forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= (RID
rid forall a. a -> [a] -> [a]
:)

-- | Takes a robot out of the 'activeRobots' set.
sleepForever :: (Has (State GameState) sig m) => RID -> m ()
sleepForever :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> m ()
sleepForever RID
rid = Lens' GameState IntSet
internalActiveRobots forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= RID -> IntSet -> IntSet
IS.delete RID
rid

-- | Adds a robot to the 'activeRobots' set.
activateRobot :: (Has (State GameState) sig m) => RID -> m ()
activateRobot :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> m ()
activateRobot RID
rid = Lens' GameState IntSet
internalActiveRobots forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= RID -> IntSet -> IntSet
IS.insert RID
rid

-- | Removes robots whose wake up time matches the current game ticks count
--   from the 'waitingRobots' queue and put them back in the 'activeRobots' set
--   if they still exist in the keys of 'robotMap'.
wakeUpRobotsDoneSleeping :: (Has (State GameState) sig m) => m ()
wakeUpRobotsDoneSleeping :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
wakeUpRobotsDoneSleeping = do
  TickNumber
time <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks
  Maybe [RID]
mrids <- Lens' GameState (Map TickNumber [RID])
internalWaitingRobots forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at TickNumber
time forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a b.
Has (State s) sig m =>
LensLike ((,) a) s s a b -> b -> m a
<<.= forall a. Maybe a
Nothing
  case Maybe [RID]
mrids of
    Maybe [RID]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just [RID]
rids -> do
      IntMap Robot
robots <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState (IntMap Robot)
robotMap
      let aliveRids :: [RID]
aliveRids = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. RID -> IntMap a -> Bool
`IM.member` IntMap Robot
robots) [RID]
rids
      Lens' GameState IntSet
internalActiveRobots forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= IntSet -> IntSet -> IntSet
IS.union ([RID] -> IntSet
IS.fromList [RID]
aliveRids)

      -- These robots' wake times may have been moved "forward"
      -- by 'wakeWatchingRobots'.
      forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
[RID] -> m ()
clearWatchingRobots [RID]
rids

-- | Clear the "watch" state of all of the
-- awakened robots
clearWatchingRobots ::
  (Has (State GameState) sig m) =>
  [RID] ->
  m ()
clearWatchingRobots :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
[RID] -> m ()
clearWatchingRobots [RID]
rids = do
  Lens' GameState (Map (Cosmic Location) (Set RID))
robotsWatching forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall a b k. (a -> b) -> Map k a -> Map k b
M.map (forall a. Ord a => Set a -> Set a -> Set a
`S.difference` forall a. Ord a => [a] -> Set a
S.fromList [RID]
rids)

-- | Iterates through all of the currently @wait@-ing robots,
-- and moves forward the wake time of the ones that are @watch@-ing this location.
--
-- NOTE: Clearing 'TickNumber' map entries from 'internalWaitingRobots'
-- upon wakeup is handled by 'wakeUpRobotsDoneSleeping'
wakeWatchingRobots :: (Has (State GameState) sig m) => Cosmic Location -> m ()
wakeWatchingRobots :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m ()
wakeWatchingRobots Cosmic Location
loc = do
  TickNumber
currentTick <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use forall a b. (a -> b) -> a -> b
$ Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks
  Map TickNumber [RID]
waitingMap <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter GameState (Map TickNumber [RID])
waitingRobots
  IntMap Robot
rMap <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState (IntMap Robot)
robotMap
  Map (Cosmic Location) (Set RID)
watchingMap <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState (Map (Cosmic Location) (Set RID))
robotsWatching

  -- The bookkeeping updates to robot waiting
  -- states are prepared in 4 steps...

  let -- Step 1: Identify the robots that are watching this location.
      botsWatchingThisLoc :: [Robot]
      botsWatchingThisLoc :: [Robot]
botsWatchingThisLoc =
        forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a. RID -> IntMap a -> Maybe a
`IM.lookup` IntMap Robot
rMap) forall a b. (a -> b) -> a -> b
$
          forall a. Set a -> [a]
S.toList forall a b. (a -> b) -> a -> b
$
            forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault forall a. Monoid a => a
mempty Cosmic Location
loc Map (Cosmic Location) (Set RID)
watchingMap

      -- Step 2: Get the target wake time for each of these robots
      wakeTimes :: [(RID, TickNumber)]
      wakeTimes :: [(RID, TickNumber)]
wakeTimes = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getter Robot RID
robotID forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Robot -> Maybe TickNumber
waitingUntil)) [Robot]
botsWatchingThisLoc

      wakeTimesToPurge :: Map TickNumber (S.Set RID)
      wakeTimesToPurge :: Map TickNumber (Set RID)
wakeTimesToPurge = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith forall a. Semigroup a => a -> a -> a
(<>) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Set a
S.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> (b, a)
swap) [(RID, TickNumber)]
wakeTimes

      -- Step 3: Take these robots out of their time-indexed slot in "waitingRobots".
      -- To preserve performance, this should be done without iterating over the
      -- entire "waitingRobots" map.
      filteredWaiting :: Map TickNumber [RID]
filteredWaiting = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {k} {a}.
(Ord k, Ord a) =>
(k, Set a) -> Map k [a] -> Map k [a]
f Map TickNumber [RID]
waitingMap forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map TickNumber (Set RID)
wakeTimesToPurge
       where
        -- Note: some of the map values may become empty lists.
        -- But we shall not worry about cleaning those up here;
        -- they will be "garbage collected" as a matter of course
        -- when their tick comes up in "wakeUpRobotsDoneSleeping".
        f :: (k, Set a) -> Map k [a] -> Map k [a]
f (k
k, Set a
botsToRemove) = forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set a
botsToRemove)) k
k

      -- Step 4: Re-add the watching bots to be awakened at the next tick:
      wakeableBotIds :: [RID]
wakeableBotIds = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(RID, TickNumber)]
wakeTimes
      newWakeTime :: TickNumber
newWakeTime = RID -> TickNumber -> TickNumber
addTicks RID
1 TickNumber
currentTick
      newInsertions :: Map TickNumber [RID]
newInsertions = forall k a. k -> a -> Map k a
M.singleton TickNumber
newWakeTime [RID]
wakeableBotIds

  -- NOTE: There are two "sources of truth" for the waiting state of robots:
  -- 1. In the GameState via "internalWaitingRobots"
  -- 2. In each robot, via the CESK machine state

  -- 1. Update the game state
  Lens' GameState (Map TickNumber [RID])
internalWaitingRobots forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith forall a. Semigroup a => a -> a -> a
(<>) Map TickNumber [RID]
filteredWaiting Map TickNumber [RID]
newInsertions

  -- 2. Update the machine of each robot
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [RID]
wakeableBotIds forall a b. (a -> b) -> a -> b
$ \RID
rid ->
    Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at RID
rid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot CESK
machine forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= \case
      Waiting TickNumber
_ CESK
c -> TickNumber -> CESK -> CESK
Waiting TickNumber
newWakeTime CESK
c
      CESK
x -> CESK
x

deleteRobot :: (Has (State GameState) sig m) => RID -> m ()
deleteRobot :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> m ()
deleteRobot RID
rn = do
  Lens' GameState IntSet
internalActiveRobots forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= RID -> IntSet -> IntSet
IS.delete RID
rn
  Maybe Robot
mrobot <- Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at RID
rn forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a b.
Has (State s) sig m =>
LensLike ((,) a) s s a b -> b -> m a
<<.= forall a. Maybe a
Nothing
  Maybe Robot
mrobot forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
`forM_` \Robot
robot -> do
    -- Delete the robot from the index of robots by location.
    forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> RID -> m ()
removeRobotFromLocationMap (Robot
robot forall s a. s -> Getting a s a -> a
^. Getter Robot (Cosmic Location)
robotLocation) RID
rn

-- | Makes sure empty sets don't hang around in the
-- 'robotsByLocation' map.  We don't want a key with an
-- empty set at every location any robot has ever
-- visited!
removeRobotFromLocationMap ::
  (Has (State GameState) sig m) =>
  Cosmic Location ->
  RID ->
  m ()
removeRobotFromLocationMap :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> RID -> m ()
removeRobotFromLocationMap (Cosmic SubworldName
oldSubworld Location
oldPlanar) RID
rid =
  Lens' GameState (Map SubworldName (Map Location IntSet))
robotsByLocation forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
M.update (forall {f :: * -> *}.
Alternative f =>
RID -> Map Location IntSet -> f (Map Location IntSet)
tidyDelete RID
rid) SubworldName
oldSubworld
 where
  deleteOne :: RID -> IntSet -> f IntSet
deleteOne RID
x = forall (f :: * -> *) a. Alternative f => (a -> Bool) -> a -> f a
surfaceEmpty IntSet -> Bool
IS.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. RID -> IntSet -> IntSet
IS.delete RID
x

  tidyDelete :: RID -> Map Location IntSet -> f (Map Location IntSet)
tidyDelete RID
robID =
    forall (f :: * -> *) a. Alternative f => (a -> Bool) -> a -> f a
surfaceEmpty forall k a. Map k a -> Bool
M.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
M.update (forall {f :: * -> *}. Alternative f => RID -> IntSet -> f IntSet
deleteOne RID
robID) Location
oldPlanar

------------------------------------------------------------
-- Initialization
------------------------------------------------------------

type LaunchParams a = ParameterizableLaunchParams CodeToRun a

-- | In this stage in the UI pipeline, both fields
-- have already been validated, and "Nothing" means
-- that the field is simply absent.
type ValidatedLaunchParams = LaunchParams Identity

-- | Record to pass information needed to create an initial
--   'GameState' record when starting a scenario.
data GameStateConfig = GameStateConfig
  { GameStateConfig -> NameGenerator
initNameParts :: NameGenerator
  , GameStateConfig -> EntityMap
initEntities :: EntityMap
  , GameStateConfig -> [Recipe Entity]
initRecipes :: [Recipe Entity]
  , GameStateConfig -> WorldMap
initWorldMap :: WorldMap
  }

-- | Create an initial, fresh game state record when starting a new scenario.
initGameState :: GameStateConfig -> GameState
initGameState :: GameStateConfig -> GameState
initGameState GameStateConfig
gsc =
  GameState
    { _creativeMode :: Bool
_creativeMode = Bool
False
    , _temporal :: TemporalState
_temporal =
        TemporalState
          { _gameStep :: Step
_gameStep = Step
WorldTick
          , _runStatus :: RunStatus
_runStatus = RunStatus
Running
          , _ticks :: TickNumber
_ticks = Int64 -> TickNumber
TickNumber Int64
0
          , _robotStepsPerTick :: RID
_robotStepsPerTick = RID
defaultRobotStepsPerTick
          }
    , _winCondition :: WinCondition
_winCondition = WinCondition
NoWinCondition
    , _winSolution :: Maybe ProcessedTerm
_winSolution = forall a. Maybe a
Nothing
    , _robotMap :: IntMap Robot
_robotMap = forall a. IntMap a
IM.empty
    , _robotsByLocation :: Map SubworldName (Map Location IntSet)
_robotsByLocation = forall k a. Map k a
M.empty
    , _robotsWatching :: Map (Cosmic Location) (Set RID)
_robotsWatching = forall a. Monoid a => a
mempty
    , _discovery :: Discovery
_discovery =
        Discovery
          { _availableRecipes :: Notifications (Recipe Entity)
_availableRecipes = forall a. Monoid a => a
mempty
          , _availableCommands :: Notifications Const
_availableCommands = forall a. Monoid a => a
mempty
          , _allDiscoveredEntities :: Inventory
_allDiscoveredEntities = Inventory
empty
          , _knownEntities :: [Text]
_knownEntities = []
          , -- This does not need to be initialized with anything,
            -- since the master list of achievements is stored in UIState
            _gameAchievements :: Map GameplayAchievement Attainment
_gameAchievements = forall a. Monoid a => a
mempty
          }
    , _activeRobots :: IntSet
_activeRobots = IntSet
IS.empty
    , _waitingRobots :: Map TickNumber [RID]
_waitingRobots = forall k a. Map k a
M.empty
    , _seed :: RID
_seed = RID
0
    , _randGen :: StdGen
_randGen = RID -> StdGen
mkStdGen RID
0
    , _robotNaming :: RobotNaming
_robotNaming =
        RobotNaming
          { _nameGenerator :: NameGenerator
_nameGenerator = GameStateConfig -> NameGenerator
initNameParts GameStateConfig
gsc
          , _gensym :: RID
_gensym = RID
0
          }
    , _recipesInfo :: Recipes
_recipesInfo =
        Recipes
          { _recipesOut :: IntMap [Recipe Entity]
_recipesOut = [Recipe Entity] -> IntMap [Recipe Entity]
outRecipeMap (GameStateConfig -> [Recipe Entity]
initRecipes GameStateConfig
gsc)
          , _recipesIn :: IntMap [Recipe Entity]
_recipesIn = [Recipe Entity] -> IntMap [Recipe Entity]
inRecipeMap (GameStateConfig -> [Recipe Entity]
initRecipes GameStateConfig
gsc)
          , _recipesCat :: IntMap [Recipe Entity]
_recipesCat = [Recipe Entity] -> IntMap [Recipe Entity]
catRecipeMap (GameStateConfig -> [Recipe Entity]
initRecipes GameStateConfig
gsc)
          }
    , _currentScenarioPath :: Maybe String
_currentScenarioPath = forall a. Maybe a
Nothing
    , _landscape :: Landscape
_landscape =
        Landscape
          { _worldNavigation :: Navigation (Map SubworldName) Location
_worldNavigation = forall (additionalDimension :: * -> *) portalExitLoc.
additionalDimension WaypointMap
-> Map (Cosmic Location) (AnnotatedDestination portalExitLoc)
-> Navigation additionalDimension portalExitLoc
Navigation forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
          , _multiWorld :: MultiWorld RID Entity
_multiWorld = forall a. Monoid a => a
mempty
          , _entityMap :: EntityMap
_entityMap = GameStateConfig -> EntityMap
initEntities GameStateConfig
gsc
          , _worldScrollable :: Bool
_worldScrollable = Bool
True
          }
    , _viewCenterRule :: ViewCenterRule
_viewCenterRule = RID -> ViewCenterRule
VCRobot RID
0
    , _viewCenter :: Cosmic Location
_viewCenter = Cosmic Location
defaultCosmicLocation
    , _needsRedraw :: Bool
_needsRedraw = Bool
False
    , _gameControls :: GameControls
_gameControls =
        GameControls
          { _replStatus :: REPLStatus
_replStatus = Maybe (Typed Value) -> REPLStatus
REPLDone forall a. Maybe a
Nothing
          , _replNextValueIndex :: Integer
_replNextValueIndex = Integer
0
          , _inputHandler :: Maybe (Text, Value)
_inputHandler = forall a. Maybe a
Nothing
          , _initiallyRunCode :: Maybe ProcessedTerm
_initiallyRunCode = forall a. Maybe a
Nothing
          }
    , _messageInfo :: Messages
_messageInfo =
        Messages
          { _messageQueue :: Seq LogEntry
_messageQueue = forall s. AsEmpty s => s
Empty
          , _lastSeenMessageTime :: TickNumber
_lastSeenMessageTime = Int64 -> TickNumber
TickNumber (-Int64
1)
          , _announcementQueue :: Seq Announcement
_announcementQueue = forall a. Monoid a => a
mempty
          }
    , _focusedRobotID :: RID
_focusedRobotID = RID
0
    }

type SubworldDescription = (SubworldName, ([IndexedTRobot], Seed -> WorldFun Int Entity))

buildWorldTuples :: Scenario -> NonEmpty SubworldDescription
buildWorldTuples :: Scenario -> NonEmpty SubworldDescription
buildWorldTuples Scenario
s =
  forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (forall e. PWorldDescription e -> SubworldName
worldName forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& WorldDescription -> ([IndexedTRobot], RID -> WorldFun RID Entity)
buildWorld) forall a b. (a -> b) -> a -> b
$
    Scenario
s forall s a. s -> Getting a s a -> a
^. Lens' Scenario (NonEmpty WorldDescription)
scenarioWorlds

genMultiWorld :: NonEmpty SubworldDescription -> Seed -> W.MultiWorld Int Entity
genMultiWorld :: NonEmpty SubworldDescription -> RID -> MultiWorld RID Entity
genMultiWorld NonEmpty SubworldDescription
worldTuples RID
s =
  forall a b k. (a -> b) -> Map k a -> Map k b
M.map forall {a} {t} {e}. (a, RID -> WorldFun t e) -> World t e
genWorld
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList
    forall a b. (a -> b) -> a -> b
$ NonEmpty SubworldDescription
worldTuples
 where
  genWorld :: (a, RID -> WorldFun t e) -> World t e
genWorld (a, RID -> WorldFun t e)
x = forall t e. WorldFun t e -> World t e
W.newWorld forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd (a, RID -> WorldFun t e)
x RID
s

-- |
-- Returns a list of robots, ordered by decreasing preference
-- to serve as the "base".
--
-- = Rules for selecting the "base" robot:
--
-- What follows is a thorough description of how the base
-- choice is made as of the most recent study of the code.
-- This level of detail is not meant to be public-facing.
--
-- For an abbreviated explanation, see the "Base robot" section of the
-- <https://github.com/swarm-game/swarm/tree/main/data/scenarios#base-robot Scenario Authoring Guide>.
--
-- == Precedence rules
--
-- 1. Prefer those robots defined with a @loc@ ('robotLocation') in the scenario file
--
--     1. If multiple robots define a @loc@, use the robot that is defined
--        first within the scenario file.
--     2. Note that if a robot is both given a @loc@ AND is specified in the
--        world map, then two instances of the robot shall be created. The
--        instance with the @loc@ shall be preferred as the base.
--
-- 2. Fall back to robots generated from templates via the map and palette.
--
--     1. If multiple robots are specified in the map, prefer the one that
--        is defined first within the scenario file.
--     2. If multiple robots are instantiated from the same template, then
--        prefer the one with a lower-indexed subworld. Note that the root
--        subworld is always first.
--     3. If multiple robots instantiated from the same template are in the
--        same subworld, then
--        prefer the one closest to the upper-left of the screen, with higher
--        rows given precedence over columns (i.e. first in row-major order).
genRobotTemplates :: Scenario -> NonEmpty (a, ([(Int, TRobot)], b)) -> [TRobot]
genRobotTemplates :: forall a b.
Scenario -> NonEmpty (a, ([IndexedTRobot], b)) -> [TRobot]
genRobotTemplates Scenario
scenario NonEmpty (a, ([IndexedTRobot], b))
worldTuples =
  [TRobot]
locatedRobots forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst [IndexedTRobot]
genRobots)
 where
  -- Keep only robots from the robot list with a concrete location;
  -- the others existed only to serve as a template for robots drawn
  -- in the world map
  locatedRobots :: [TRobot]
locatedRobots = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Lens' TRobot (Maybe (Cosmic Location))
trobotLocation) forall a b. (a -> b) -> a -> b
$ Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario [TRobot]
scenarioRobots

  -- Subworld order as encountered in the scenario YAML file is preserved for
  -- the purpose of numbering robots, other than the "root" subworld
  -- guaranteed to be first.
  genRobots :: [(Int, TRobot)]
  genRobots :: [IndexedTRobot]
genRobots = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) NonEmpty (a, ([IndexedTRobot], b))
worldTuples

-- | Create an initial game state corresponding to the given scenario.
scenarioToGameState ::
  Scenario ->
  ValidatedLaunchParams ->
  GameStateConfig ->
  IO GameState
scenarioToGameState :: Scenario
-> ValidatedLaunchParams -> GameStateConfig -> IO GameState
scenarioToGameState Scenario
scenario (LaunchParams (Identity Maybe RID
userSeed) (Identity Maybe CodeToRun
toRun)) GameStateConfig
gsc = do
  -- Decide on a seed.  In order of preference, we will use:
  --   1. seed value provided by the user
  --   2. seed value specified in the scenario description
  --   3. randomly chosen seed value
  RID
theSeed <- case Maybe RID
userSeed forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario (Maybe RID)
scenarioSeed of
    Just RID
s -> forall (m :: * -> *) a. Monad m => a -> m a
return RID
s
    Maybe RID
Nothing -> forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (RID
0, forall a. Bounded a => a
maxBound :: Int)

  TimeSpec
now <- Clock -> IO TimeSpec
Clock.getTime Clock
Clock.Monotonic
  let robotList' :: [Robot]
robotList' = (Lens' Robot TimeSpec
robotCreatedAt forall s t a b. ASetter s t a b -> b -> s -> t
.~ TimeSpec
now) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Robot]
robotList

  let modifyRecipesInfo :: Recipes -> Recipes
modifyRecipesInfo Recipes
oldRecipesInfo =
        Recipes
oldRecipesInfo
          forall a b. a -> (a -> b) -> b
& Lens' Recipes (IntMap [Recipe Entity])
recipesOut forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall {a}.
Semigroup a =>
([Recipe Entity] -> IntMap a) -> IntMap a -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap [Recipe Entity]
outRecipeMap
          forall a b. a -> (a -> b) -> b
& Lens' Recipes (IntMap [Recipe Entity])
recipesIn forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall {a}.
Semigroup a =>
([Recipe Entity] -> IntMap a) -> IntMap a -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap [Recipe Entity]
inRecipeMap
          forall a b. a -> (a -> b) -> b
& Lens' Recipes (IntMap [Recipe Entity])
recipesCat forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall {a}.
Semigroup a =>
([Recipe Entity] -> IntMap a) -> IntMap a -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap [Recipe Entity]
catRecipeMap

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    (GameStateConfig -> GameState
initGameState GameStateConfig
gsc)
      { _focusedRobotID :: RID
_focusedRobotID = RID
baseID
      }
      forall a b. a -> (a -> b) -> b
& Lens' GameState Bool
creativeMode forall s t a b. ASetter s t a b -> b -> s -> t
.~ Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario Bool
scenarioCreative
      forall a b. a -> (a -> b) -> b
& Lens' GameState WinCondition
winCondition forall s t a b. ASetter s t a b -> b -> s -> t
.~ WinCondition
theWinCondition
      forall a b. a -> (a -> b) -> b
& Lens' GameState (Maybe ProcessedTerm)
winSolution forall s t a b. ASetter s t a b -> b -> s -> t
.~ Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario (Maybe ProcessedTerm)
scenarioSolution
      forall a b. a -> (a -> b) -> b
& Lens' GameState (IntMap Robot)
robotMap forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. [(RID, a)] -> IntMap a
IM.fromList (forall a b. (a -> b) -> [a] -> [b]
map (forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getter Robot RID
robotID forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id) [Robot]
robotList')
      forall a b. a -> (a -> b) -> b
& Lens' GameState (Map SubworldName (Map Location IntSet))
robotsByLocation forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a b k. (a -> b) -> Map k a -> Map k b
M.map (forall {a}.
Member (Reader Robot) (Reader a) =>
[a] -> Map Location IntSet
groupRobotsByPlanarLocation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList) ([Robot] -> Map SubworldName (NonEmpty Robot)
groupRobotsBySubworld [Robot]
robotList')
      forall a b. a -> (a -> b) -> b
& Lens' GameState IntSet
internalActiveRobots forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s. Getting IntSet s RID -> s -> IntSet
setOf (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter Robot RID
robotID) [Robot]
robotList'
      forall a b. a -> (a -> b) -> b
& Lens' GameState Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery (Notifications Const)
availableCommands forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. RID -> [a] -> Notifications a
Notifications RID
0 [Const]
initialCommands
      forall a b. a -> (a -> b) -> b
& Lens' GameState Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery [Text]
knownEntities forall s t a b. ASetter s t a b -> b -> s -> t
.~ Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario [Text]
scenarioKnown
      forall a b. a -> (a -> b) -> b
& Lens' GameState RobotNaming
robotNaming forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotNaming RID
gensym forall s t a b. ASetter s t a b -> b -> s -> t
.~ RID
initGensym
      forall a b. a -> (a -> b) -> b
& Lens' GameState RID
seed forall s t a b. ASetter s t a b -> b -> s -> t
.~ RID
theSeed
      forall a b. a -> (a -> b) -> b
& Lens' GameState StdGen
randGen forall s t a b. ASetter s t a b -> b -> s -> t
.~ RID -> StdGen
mkStdGen RID
theSeed
      forall a b. a -> (a -> b) -> b
& Lens' GameState Recipes
recipesInfo forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Recipes -> Recipes
modifyRecipesInfo
      forall a b. a -> (a -> b) -> b
& Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape EntityMap
entityMap forall s t a b. ASetter s t a b -> b -> s -> t
.~ EntityMap
em
      forall a b. a -> (a -> b) -> b
& Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape (Navigation (Map SubworldName) Location)
worldNavigation forall s t a b. ASetter s t a b -> b -> s -> t
.~ Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario (Navigation (Map SubworldName) Location)
scenarioNavigation
      forall a b. a -> (a -> b) -> b
& Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape (MultiWorld RID Entity)
multiWorld forall s t a b. ASetter s t a b -> b -> s -> t
.~ NonEmpty SubworldDescription -> RID -> MultiWorld RID Entity
genMultiWorld NonEmpty SubworldDescription
worldTuples RID
theSeed
      -- TODO (#1370): Should we allow subworlds to have their own scrollability?
      -- Leaning toward no , but for now just adopt the root world scrollability
      -- as being universal.
      forall a b. a -> (a -> b) -> b
& Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape Bool
worldScrollable forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. NonEmpty a -> a
NE.head (Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario (NonEmpty WorldDescription)
scenarioWorlds) forall s a. s -> Getting a s a -> a
^. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall e. PWorldDescription e -> Bool
scrollable
      forall a b. a -> (a -> b) -> b
& Lens' GameState ViewCenterRule
viewCenterRule forall s t a b. ASetter s t a b -> b -> s -> t
.~ RID -> ViewCenterRule
VCRobot RID
baseID
      forall a b. a -> (a -> b) -> b
& Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls (Maybe ProcessedTerm)
initiallyRunCode forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe ProcessedTerm
initialCodeToRun
      forall a b. a -> (a -> b) -> b
& Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls REPLStatus
replStatus forall s t a b. ASetter s t a b -> b -> s -> t
.~ case Bool
running of -- When the base starts out running a program, the REPL status must be set to working,
      -- otherwise the store of definition cells is not saved (see #333, #838)
        Bool
False -> Maybe (Typed Value) -> REPLStatus
REPLDone forall a. Maybe a
Nothing
        Bool
True -> Typed (Maybe Value) -> REPLStatus
REPLWorking (forall v. v -> Polytype -> Requirements -> Typed v
Typed forall a. Maybe a
Nothing Polytype
PolyUnit forall a. Monoid a => a
mempty)
      forall a b. a -> (a -> b) -> b
& Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState RID
robotStepsPerTick forall s t a b. ASetter s t a b -> b -> s -> t
.~ ((Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario (Maybe RID)
scenarioStepsPerTick) forall a. Maybe a -> a -> a
? RID
defaultRobotStepsPerTick)
 where
  groupRobotsBySubworld :: [Robot] -> Map SubworldName (NonEmpty Robot)
groupRobotsBySubworld =
    forall (t :: * -> *) a b.
(Foldable t, Ord a) =>
t (a, b) -> Map a (NonEmpty b)
binTuples forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view (Getter Robot (Cosmic Location)
robotLocation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Lens' (Cosmic a) SubworldName
subworld) forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id)

  groupRobotsByPlanarLocation :: [a] -> Map Location IntSet
groupRobotsByPlanarLocation [a]
rs =
    forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith
      IntSet -> IntSet -> IntSet
IS.union
      (forall a b. (a -> b) -> [a] -> [b]
map (forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view (Getter Robot (Cosmic Location)
robotLocation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2. Lens (Cosmic a1) (Cosmic a2) a1 a2
planar) forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (RID -> IntSet
IS.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getter Robot RID
robotID)) [a]
rs)

  em :: EntityMap
em = GameStateConfig -> EntityMap
initEntities GameStateConfig
gsc forall a. Semigroup a => a -> a -> a
<> Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario EntityMap
scenarioEntities
  baseID :: RID
baseID = RID
0
  ([Entity]
things, [Entity]
devices) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Lens' Entity (Set Capability)
entityCapabilities) (forall k a. Map k a -> [a]
M.elems (EntityMap -> Map Text Entity
entitiesByName EntityMap
em))

  getCodeToRun :: CodeToRun -> ProcessedTerm
getCodeToRun (CodeToRun SolutionSource
_ ProcessedTerm
s) = ProcessedTerm
s

  robotsByBasePrecedence :: [TRobot]
robotsByBasePrecedence = forall a b.
Scenario -> NonEmpty (a, ([IndexedTRobot], b)) -> [TRobot]
genRobotTemplates Scenario
scenario NonEmpty SubworldDescription
worldTuples

  initialCodeToRun :: Maybe ProcessedTerm
initialCodeToRun = CodeToRun -> ProcessedTerm
getCodeToRun forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CodeToRun
toRun

  robotList :: [Robot]
robotList =
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith RID -> TRobot -> Robot
instantiateRobot [RID
baseID ..] [TRobot]
robotsByBasePrecedence
      -- If the  --run flag was used, use it to replace the CESK machine of the
      -- robot whose id is 0, i.e. the first robot listed in the scenario.
      -- Note that this *replaces* any program the base robot otherwise
      -- would have run (i.e. any program specified in the program: field
      -- of the scenario description).
      forall a b. a -> (a -> b) -> b
& forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix RID
baseID
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot CESK
machine
        forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ case Maybe ProcessedTerm
initialCodeToRun of
          Maybe ProcessedTerm
Nothing -> forall a. a -> a
id
          Just ProcessedTerm
pt -> forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ ProcessedTerm -> Env -> Store -> CESK
initMachine ProcessedTerm
pt forall t. Ctx t
Ctx.empty Store
emptyStore
      -- If we are in creative mode, give base all the things
      forall a b. a -> (a -> b) -> b
& forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix RID
baseID
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot Inventory
robotInventory
        forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ case Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario Bool
scenarioCreative of
          Bool
False -> forall a. a -> a
id
          Bool
True -> Inventory -> Inventory -> Inventory
union ([(RID, Entity)] -> Inventory
fromElems (forall a b. (a -> b) -> [a] -> [b]
map (RID
0,) [Entity]
things))
      forall a b. a -> (a -> b) -> b
& forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix RID
baseID
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot Inventory
equippedDevices
        forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ case Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario Bool
scenarioCreative of
          Bool
False -> forall a. a -> a
id
          Bool
True -> forall a b. a -> b -> a
const ([Entity] -> Inventory
fromList [Entity]
devices)

  running :: Bool
running = case [Robot]
robotList of
    [] -> Bool
False
    (Robot
base : [Robot]
_) -> forall a. Maybe a -> Bool
isNothing (CESK -> Maybe (Value, Store)
finalValue (Robot
base forall s a. s -> Getting a s a -> a
^. Lens' Robot CESK
machine))

  -- Initial list of available commands = all commands enabled by
  -- devices in inventory or equipped; and commands that require no
  -- capability.
  allCapabilities :: Robot -> Set Capability
allCapabilities Robot
r =
    Inventory -> Set Capability
inventoryCapabilities (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
equippedDevices)
      forall a. Semigroup a => a -> a -> a
<> Inventory -> Set Capability
inventoryCapabilities (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
robotInventory)
  initialCaps :: Set Capability
initialCaps = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Robot -> Set Capability
allCapabilities [Robot]
robotList
  initialCommands :: [Const]
initialCommands =
    forall a. (a -> Bool) -> [a] -> [a]
filter
      (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall a. Ord a => a -> Set a -> Bool
`S.member` Set Capability
initialCaps) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const -> Maybe Capability
constCaps)
      [Const]
allConst

  worldTuples :: NonEmpty SubworldDescription
worldTuples = Scenario -> NonEmpty SubworldDescription
buildWorldTuples Scenario
scenario

  theWinCondition :: WinCondition
theWinCondition =
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      WinCondition
NoWinCondition
      (\NonEmpty Objective
x -> WinStatus -> ObjectiveCompletion -> WinCondition
WinConditions WinStatus
Ongoing (CompletionBuckets -> Set Text -> ObjectiveCompletion
ObjectiveCompletion ([Objective] -> [Objective] -> [Objective] -> CompletionBuckets
CompletionBuckets (forall a. NonEmpty a -> [a]
NE.toList NonEmpty Objective
x) forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty) forall a. Monoid a => a
mempty))
      (forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty (Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario [Objective]
scenarioObjectives))

  initGensym :: RID
initGensym = forall (t :: * -> *) a. Foldable t => t a -> RID
length [Robot]
robotList forall a. Num a => a -> a -> a
- RID
1
  addRecipesWith :: ([Recipe Entity] -> IntMap a) -> IntMap a -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap a
f = forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IM.unionWith forall a. Semigroup a => a -> a -> a
(<>) ([Recipe Entity] -> IntMap a
f forall a b. (a -> b) -> a -> b
$ Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario [Recipe Entity]
scenarioRecipes)

-- | Take a world description, parsed from a scenario file, and turn
--   it into a list of located robots and a world function.
buildWorld :: WorldDescription -> ([IndexedTRobot], Seed -> WorldFun Int Entity)
buildWorld :: WorldDescription -> ([IndexedTRobot], RID -> WorldFun RID Entity)
buildWorld WorldDescription {Bool
[[PCell Entity]]
Maybe (TTerm '[] (World CellVal))
Location
SubworldName
Navigation Identity WaypointName
WorldPalette Entity
worldProg :: forall e. PWorldDescription e -> Maybe (TTerm '[] (World CellVal))
navigation :: forall e. PWorldDescription e -> Navigation Identity WaypointName
area :: forall e. PWorldDescription e -> [[PCell e]]
ul :: forall e. PWorldDescription e -> Location
palette :: forall e. PWorldDescription e -> WorldPalette e
offsetOrigin :: forall e. PWorldDescription e -> Bool
worldProg :: Maybe (TTerm '[] (World CellVal))
worldName :: SubworldName
navigation :: Navigation Identity WaypointName
area :: [[PCell Entity]]
ul :: Location
palette :: WorldPalette Entity
scrollable :: Bool
offsetOrigin :: Bool
scrollable :: forall e. PWorldDescription e -> Bool
worldName :: forall e. PWorldDescription e -> SubworldName
..} = (SubworldName -> [IndexedTRobot]
robots SubworldName
worldName, forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Enum a => a -> RID
fromEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. RID -> WorldFun TerrainType Entity
wf)
 where
  rs :: Int32
rs = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> RID
length [[PCell Entity]]
area
  cs :: Int32
cs = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe RID
0 forall (t :: * -> *) a. Foldable t => t a -> RID
length forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
listToMaybe [[PCell Entity]]
area
  Coords (Int32
ulr, Int32
ulc) = Location -> Coords
locToCoords Location
ul

  worldGrid :: [[(TerrainType, Erasable Entity)]]
  worldGrid :: [[(TerrainType, Erasable Entity)]]
worldGrid = (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map) (forall e. PCell e -> TerrainType
cellTerrain forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall e. PCell e -> Erasable e
cellEntity) [[PCell Entity]]
area

  worldArray :: Array (Int32, Int32) (TerrainType, Erasable Entity)
  worldArray :: Array (Int32, Int32) (TerrainType, Erasable Entity)
worldArray = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Int32
ulr, Int32
ulc), (Int32
ulr forall a. Num a => a -> a -> a
+ Int32
rs forall a. Num a => a -> a -> a
- Int32
1, Int32
ulc forall a. Num a => a -> a -> a
+ Int32
cs forall a. Num a => a -> a -> a
- Int32
1)) (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(TerrainType, Erasable Entity)]]
worldGrid)

  dslWF, arrayWF :: Seed -> WorldFun TerrainType Entity
  dslWF :: RID -> WorldFun TerrainType Entity
dslWF = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty ((forall a. Bool -> (a -> a) -> a -> a
applyWhen Bool
offsetOrigin forall t. WorldFun t Entity -> WorldFun t Entity
findGoodOrigin forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. TTerm '[] (World CellVal) -> RID -> WorldFun TerrainType Entity
runWorld) Maybe (TTerm '[] (World CellVal))
worldProg
  arrayWF :: RID -> WorldFun TerrainType Entity
arrayWF = forall a b. a -> b -> a
const (forall t e.
Monoid t =>
Array (Int32, Int32) (t, Erasable e) -> WorldFun t e
worldFunFromArray Array (Int32, Int32) (TerrainType, Erasable Entity)
worldArray)

  wf :: RID -> WorldFun TerrainType Entity
wf = RID -> WorldFun TerrainType Entity
dslWF forall a. Semigroup a => a -> a -> a
<> RID -> WorldFun TerrainType Entity
arrayWF

  -- Get all the robots described in cells and set their locations appropriately
  robots :: SubworldName -> [IndexedTRobot]
  robots :: SubworldName -> [IndexedTRobot]
robots SubworldName
swName =
    [[PCell Entity]]
area
      forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal RID (f a) (f b) a b
traversed forall i j (p :: * -> * -> *) s t r a b.
Indexable (i, j) p =>
(Indexed i s t -> r) -> (Indexed j a b -> s -> t) -> p a b -> r
Control.Lens.<.> forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal RID (f a) (f b) a b
traversed forall i s t a b.
AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t
%@~ (,) -- add (r,c) indices
      forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
        ( \((forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int32
r, forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int32
c), Cell TerrainType
_ Erasable Entity
_ [IndexedTRobot]
robotList) ->
            let robotWithLoc :: TRobot -> TRobot
robotWithLoc = Lens' TRobot (Maybe (Cosmic Location))
trobotLocation forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a. SubworldName -> a -> Cosmic a
Cosmic SubworldName
swName (Coords -> Location
W.coordsToLoc ((Int32, Int32) -> Coords
Coords (Int32
ulr forall a. Num a => a -> a -> a
+ Int32
r, Int32
ulc forall a. Num a => a -> a -> a
+ Int32
c)))
             in forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TRobot -> TRobot
robotWithLoc) [IndexedTRobot]
robotList
        )