{-# 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,
  gameStep,
  winCondition,
  winSolution,
  gameAchievements,
  announcementQueue,
  runStatus,
  paused,
  robotMap,
  robotsByLocation,
  robotsAtLocation,
  robotsWatching,
  robotsInArea,
  baseRobot,
  activeRobots,
  waitingRobots,
  availableRecipes,
  availableCommands,
  messageNotifications,
  allDiscoveredEntities,
  gensym,
  seed,
  randGen,
  adjList,
  nameList,
  initiallyRunCode,
  entityMap,
  recipesOut,
  recipesIn,
  recipesReq,
  currentScenarioPath,
  knownEntities,
  worldNavigation,
  multiWorld,
  worldScrollable,
  viewCenterRule,
  viewCenter,
  needsRedraw,
  replStatus,
  replNextValueIndex,
  replWorking,
  replActiveType,
  inputHandler,
  messageQueue,
  lastSeenMessageTime,
  focusedRobotID,
  ticks,
  robotStepsPerTick,

  -- ** 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,
  clearFocusedRobotLogUpdated,
  addRobot,
  addRobotToLocation,
  addTRobot,
  emitMessage,
  wakeWatchingRobots,
  sleepUntil,
  sleepForever,
  wakeUpRobotsDoneSleeping,
  deleteRobot,
  removeRobotFromLocationMap,
  activateRobot,
  toggleRunStatus,
  messageIsRecent,
  messageIsFromNearby,
  getRunCodePath,
) 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, 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,
  inRecipeMap,
  outRecipeMap,
  reqRecipeMap,
 )
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.Util (applyWhen, binTuples, surfaceEmpty, uniq, (<+=), (<<.=), (?))
import Swarm.Util.Erasable
import Swarm.Util.Lens (makeLensesExcluding)
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 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. [(Text, a)]
SD.noSamples

-- | 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 discovered recipes and commands
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 remebering 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

-- | 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 -> Step
_gameStep :: Step
  , GameState -> WinCondition
_winCondition :: WinCondition
  , GameState -> Maybe ProcessedTerm
_winSolution :: Maybe ProcessedTerm
  , GameState -> Map GameplayAchievement Attainment
_gameAchievements :: Map GameplayAchievement Attainment
  , GameState -> Seq Announcement
_announcementQueue :: Seq Announcement
  , GameState -> RunStatus
_runStatus :: RunStatus
  , 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 -> Inventory
_allDiscoveredEntities :: Inventory
  , GameState -> Notifications (Recipe Entity)
_availableRecipes :: Notifications (Recipe Entity)
  , GameState -> Notifications Const
_availableCommands :: Notifications Const
  , GameState -> RID
_gensym :: Int
  , GameState -> RID
_seed :: Seed
  , GameState -> StdGen
_randGen :: StdGen
  , GameState -> Array RID Text
_adjList :: Array Int Text
  , GameState -> Array RID Text
_nameList :: Array Int Text
  , GameState -> Maybe ProcessedTerm
_initiallyRunCode :: Maybe ProcessedTerm
  , GameState -> EntityMap
_entityMap :: EntityMap
  , GameState -> IntMap [Recipe Entity]
_recipesOut :: IntMap [Recipe Entity]
  , GameState -> IntMap [Recipe Entity]
_recipesIn :: IntMap [Recipe Entity]
  , GameState -> IntMap [Recipe Entity]
_recipesReq :: IntMap [Recipe Entity]
  , GameState -> Maybe String
_currentScenarioPath :: Maybe FilePath
  , GameState -> [Text]
_knownEntities :: [Text]
  , GameState -> Navigation (Map SubworldName) Location
_worldNavigation :: Navigation (M.Map SubworldName) Location
  , GameState -> MultiWorld RID Entity
_multiWorld :: W.MultiWorld Int Entity
  , GameState -> Bool
_worldScrollable :: Bool
  , GameState -> ViewCenterRule
_viewCenterRule :: ViewCenterRule
  , GameState -> Cosmic Location
_viewCenter :: Cosmic Location
  , GameState -> Bool
_needsRedraw :: Bool
  , GameState -> REPLStatus
_replStatus :: REPLStatus
  , GameState -> Integer
_replNextValueIndex :: Integer
  , GameState -> Maybe (Text, Value)
_inputHandler :: Maybe (Text, Value)
  , GameState -> Seq LogEntry
_messageQueue :: Seq LogEntry
  , GameState -> TickNumber
_lastSeenMessageTime :: TickNumber
  , GameState -> RID
_focusedRobotID :: RID
  , GameState -> TickNumber
_ticks :: TickNumber
  , GameState -> RID
_robotStepsPerTick :: Int
  }

------------------------------------------------------------
-- 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, '_adjList, '_nameList] ''GameState

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

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

-- | 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)

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

-- | 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' GameState (Seq Announcement)

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

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

-- | 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 list of entities that have been discovered.
allDiscoveredEntities :: Lens' GameState Inventory

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

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

-- | 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

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

-- | 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

-- | Read-only list of words, for use in building random robot names.
adjList :: Getter GameState (Array Int Text)
adjList :: Getter GameState (Array RID Text)
adjList = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Array RID Text
_adjList

-- | Read-only list of words, for use in building random robot names.
nameList :: Getter GameState (Array Int Text)
nameList :: Getter GameState (Array RID Text)
nameList = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Array RID Text
_nameList

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

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

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

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

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

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

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

-- | Includes a 'Map' of named locations and an
-- "Edge list" (graph) that maps portal entrances to exits
worldNavigation :: Lens' GameState (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' GameState (W.MultiWorld Int Entity)

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

-- | 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

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

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

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

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

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

-- | 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

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

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

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

-- | The current rule for determining the center of the world view.
--   It updates also, viewCenter and focusedRobotName to keep
--   everything synchronize.
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 focusedRobotName
  -- 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 GameState Bool
replWorking :: Getter GameState Bool
replWorking = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\GameState
s -> REPLStatus -> Bool
matchesWorking forall a b. (a -> b) -> a -> b
$ GameState
s forall s a. s -> Getting a s a -> a
^. Lens' GameState 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 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 (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)
    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 ((forall a. Eq a => a -> a -> Bool
== GameState
gs forall s a. s -> Getting a s a -> a
^. Getter GameState RID
focusedRobotID) 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' LogEntry RID
leRobotID) Seq LogEntry
mq

messageIsRecent :: GameState -> LogEntry -> Bool
messageIsRecent :: GameState -> LogEntry -> Bool
messageIsRecent GameState
gs LogEntry
e = Integer -> TickNumber -> TickNumber
addTicks Integer
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 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 (LogLocation (Cosmic Location))
leLocation of
  LogLocation (Cosmic Location)
Omnipresent -> Bool
True
  Located Cosmic Location
x -> Cosmic Location -> Bool
f Cosmic Location
x
 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 veiw 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 :: GameState -> (Int32, Int32) -> Cosmic W.BoundsRectangle
viewingRegion :: GameState -> (Int32, Int32) -> Cosmic BoundsRectangle
viewingRegion GameState
g (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
  Cosmic SubworldName
sw (Location Int32
cx Int32
cy) = GameState
g forall s a. s -> Getting a s a -> a
^. Getter GameState (Cosmic Location)
viewCenter
  (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.
--   * 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
<$ GameState -> Maybe Robot
focusedRobot GameState
g
 where
  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 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 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 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)

  -- See whether the base or focused robot have antennas installed.
  baseInv, focInv :: Maybe Inventory
  baseInv :: Maybe Inventory
baseInv = 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
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot Inventory
equippedDevices
  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
<$> GameState -> Maybe Robot
focusedRobot GameState
g

  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 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 (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 Lens' GameState 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 watching this location.
--
-- NOTE: Clearing "TickNumber" map entries from "internalWaitingRobots"
-- upon wakeup is handled by "wakeUpRobotsDoneSleeping" in State.hs
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 Lens' GameState 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 = Integer -> TickNumber -> TickNumber
addTicks Integer
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 -> Array RID Text
initAdjList :: Array Int Text
  , GameStateConfig -> Array RID Text
initNameList :: Array Int Text
  , 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
    , _gameStep :: Step
_gameStep = Step
WorldTick
    , _winCondition :: WinCondition
_winCondition = WinCondition
NoWinCondition
    , _winSolution :: Maybe ProcessedTerm
_winSolution = forall a. Maybe a
Nothing
    , -- 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
    , _announcementQueue :: Seq Announcement
_announcementQueue = forall a. Monoid a => a
mempty
    , _runStatus :: RunStatus
_runStatus = RunStatus
Running
    , _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
    , _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
    , _activeRobots :: IntSet
_activeRobots = IntSet
IS.empty
    , _waitingRobots :: Map TickNumber [RID]
_waitingRobots = forall k a. Map k a
M.empty
    , _gensym :: RID
_gensym = RID
0
    , _seed :: RID
_seed = RID
0
    , _randGen :: StdGen
_randGen = RID -> StdGen
mkStdGen RID
0
    , _adjList :: Array RID Text
_adjList = GameStateConfig -> Array RID Text
initAdjList GameStateConfig
gsc
    , _nameList :: Array RID Text
_nameList = GameStateConfig -> Array RID Text
initNameList GameStateConfig
gsc
    , _initiallyRunCode :: Maybe ProcessedTerm
_initiallyRunCode = forall a. Maybe a
Nothing
    , _entityMap :: EntityMap
_entityMap = GameStateConfig -> EntityMap
initEntities GameStateConfig
gsc
    , _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)
    , _recipesReq :: IntMap [Recipe Entity]
_recipesReq = [Recipe Entity] -> IntMap [Recipe Entity]
reqRecipeMap (GameStateConfig -> [Recipe Entity]
initRecipes GameStateConfig
gsc)
    , _currentScenarioPath :: Maybe String
_currentScenarioPath = forall a. Maybe a
Nothing
    , _knownEntities :: [Text]
_knownEntities = []
    , _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
    , _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
    , _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
    , _messageQueue :: Seq LogEntry
_messageQueue = forall s. AsEmpty s => s
Empty
    , _lastSeenMessageTime :: TickNumber
_lastSeenMessageTime = Integer -> TickNumber
TickNumber (-Integer
1)
    , _focusedRobotID :: RID
_focusedRobotID = RID
0
    , _ticks :: TickNumber
_ticks = Integer -> TickNumber
TickNumber Integer
0
    , _robotStepsPerTick :: RID
_robotStepsPerTick = RID
defaultRobotStepsPerTick
    }

-- | 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

  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 (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 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 (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 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 (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' GameState (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' GameState (IntMap [Recipe Entity])
recipesReq 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]
reqRecipeMap
      forall a b. a -> (a -> b) -> b
& Lens' GameState [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 (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 (MultiWorld RID Entity)
multiWorld forall s t a b. ASetter s t a b -> b -> s -> t
.~ RID -> MultiWorld RID Entity
allSubworldsMap 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 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 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 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))
  -- 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
  getCodeToRun :: CodeToRun -> ProcessedTerm
getCodeToRun (CodeToRun SolutionSource
_ ProcessedTerm
s) = ProcessedTerm
s

  -- 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
  -- "Scenario Authoring Guide".
  -- https://github.com/swarm-game/swarm/tree/main/data/scenarios#base-robot
  --
  -- Precedence rules:
  -- 1. Prefer those robots defined with a loc in the Scenario file
  --   1.a. If multiple robots define a loc, use the robot that is defined
  --        first within the Scenario file.
  --   1.b. 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.
  --   2.a. If multiple robots are specified in the map, prefer the one that
  --        is defined first within the Scenario file.
  --   2.b. 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.
  --   2.c. 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).
  robotsByBasePrecedence :: [TRobot]
robotsByBasePrecedence = [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 [(RID, TRobot)]
genRobots)

  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

  -- 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 :: [(RID, TRobot)]
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
  (SubworldName, ([(RID, TRobot)], RID -> WorldFun RID Entity))
builtWorldTuples

  builtWorldTuples :: NonEmpty (SubworldName, ([IndexedTRobot], Seed -> WorldFun Int Entity))
  builtWorldTuples :: NonEmpty
  (SubworldName, ([(RID, TRobot)], RID -> WorldFun RID Entity))
builtWorldTuples =
    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 -> ([(RID, TRobot)], RID -> WorldFun RID Entity)
buildWorld) forall a b. (a -> b) -> a -> b
$
      Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario (NonEmpty WorldDescription)
scenarioWorlds

  allSubworldsMap :: Seed -> W.MultiWorld Int Entity
  allSubworldsMap :: RID -> MultiWorld RID Entity
allSubworldsMap 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
  (SubworldName, ([(RID, TRobot)], RID -> WorldFun RID Entity))
builtWorldTuples
   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

  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 -> ([(RID, TRobot)], 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
worldName :: forall e. PWorldDescription e -> SubworldName
scrollable :: forall e. PWorldDescription e -> Bool
..} = (SubworldName -> [(RID, TRobot)]
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 (t :: * -> *) a. Foldable t => t a -> RID
length (forall a. [a] -> a
head [[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 -> [(RID, TRobot)]
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
_ [(RID, TRobot)]
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) [(RID, TRobot)]
robotList
        )