{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
-- Description: Game-related state and utilities
--
-- Definition of the record holding all the game-related state, and various related
-- utility functions.
module Swarm.Game.State (
  -- * Game state record
  GameState,
  creativeMode,
  winCondition,
  winSolution,
  completionStatsSaved,

  -- ** Launch parameters
  LaunchParams,
  ValidatedLaunchParams,

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

  -- ** GameState initialization
  initGameState,
  CodeToRun (..),
  toRunSource,
  toRunSyntax,
  Sha1 (..),
  SolutionSource (..),
  parseCodeFile,

  -- * Utilities
  robotsAtLocation,
  robotsInArea,
  baseRobot,
  baseEnv,
  baseStore,
  messageNotifications,
  currentScenarioPath,
  needsRedraw,
  replWorking,
  recalcViewCenterAndRedraw,
  viewingRegion,
  focusedRobot,
  RobotRange (..),
  focusedRange,
  getRadioRange,
  clearFocusedRobotLogUpdated,
  emitMessage,
  messageIsRecent,
  messageIsFromNearby,
  getRunCodePath,
  buildWorldTuples,
  genMultiWorld,
  genRobotTemplates,
  entityAt,
  mtlEntityAt,
  contentAt,
  zoomWorld,
  zoomRobots,
) where

import Control.Carrier.State.Lazy qualified as Fused
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, join)
import Control.Monad.Trans.State.Strict qualified as TS
import Data.Aeson (ToJSON)
import Data.Digest.Pure.SHA (sha1, showDigest)
import Data.Foldable (toList)
import Data.Function (on)
import Data.Int (Int32)
import Data.IntMap qualified as IM
import Data.IntSet qualified as IS
import Data.Map qualified as M
import Data.Maybe (fromMaybe, mapMaybe)
import Data.MonoidMap qualified as MM
import Data.Sequence (Seq ((:<|)))
import Data.Sequence qualified as Seq
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 Swarm.Failure (SystemFailure (..))
import Swarm.Game.CESK (Store, emptyStore, store, suspendedEnv)
import Swarm.Game.Entity
import Swarm.Game.Land
import Swarm.Game.Location
import Swarm.Game.Robot
import Swarm.Game.Robot.Concrete
import Swarm.Game.Scenario.Status
import Swarm.Game.State.Config
import Swarm.Game.State.Landscape
import Swarm.Game.State.Robot
import Swarm.Game.State.Substate
import Swarm.Game.Step.Path.Type
import Swarm.Game.Terrain
import Swarm.Game.Tick (addTicks)
import Swarm.Game.Universe as U
import Swarm.Game.World qualified as W
import Swarm.Game.World.Coords
import Swarm.Language.Pipeline (processTermEither)
import Swarm.Language.Syntax (SrcLoc (..), TSyntax, sLoc)
import Swarm.Language.Value (Env)
import Swarm.Log
import Swarm.Util (applyWhen, uniq)
import Swarm.Util.Lens (makeLensesNoSigs)

newtype Sha1 = Sha1 String
  deriving (Count -> Sha1 -> ShowS
[Sha1] -> ShowS
Sha1 -> String
(Count -> Sha1 -> ShowS)
-> (Sha1 -> String) -> ([Sha1] -> ShowS) -> Show Sha1
forall a.
(Count -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Count -> Sha1 -> ShowS
showsPrec :: Count -> Sha1 -> ShowS
$cshow :: Sha1 -> String
show :: Sha1 -> String
$cshowList :: [Sha1] -> ShowS
showList :: [Sha1] -> ShowS
Show, Sha1 -> Sha1 -> Bool
(Sha1 -> Sha1 -> Bool) -> (Sha1 -> Sha1 -> Bool) -> Eq Sha1
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sha1 -> Sha1 -> Bool
== :: Sha1 -> Sha1 -> Bool
$c/= :: Sha1 -> Sha1 -> Bool
/= :: Sha1 -> Sha1 -> Bool
Eq, Eq Sha1
Eq Sha1 =>
(Sha1 -> Sha1 -> Ordering)
-> (Sha1 -> Sha1 -> Bool)
-> (Sha1 -> Sha1 -> Bool)
-> (Sha1 -> Sha1 -> Bool)
-> (Sha1 -> Sha1 -> Bool)
-> (Sha1 -> Sha1 -> Sha1)
-> (Sha1 -> Sha1 -> Sha1)
-> Ord Sha1
Sha1 -> Sha1 -> Bool
Sha1 -> Sha1 -> Ordering
Sha1 -> Sha1 -> Sha1
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
$ccompare :: Sha1 -> Sha1 -> Ordering
compare :: Sha1 -> Sha1 -> Ordering
$c< :: Sha1 -> Sha1 -> Bool
< :: Sha1 -> Sha1 -> Bool
$c<= :: Sha1 -> Sha1 -> Bool
<= :: Sha1 -> Sha1 -> Bool
$c> :: Sha1 -> Sha1 -> Bool
> :: Sha1 -> Sha1 -> Bool
$c>= :: Sha1 -> Sha1 -> Bool
>= :: Sha1 -> Sha1 -> Bool
$cmax :: Sha1 -> Sha1 -> Sha1
max :: Sha1 -> Sha1 -> Sha1
$cmin :: Sha1 -> Sha1 -> Sha1
min :: Sha1 -> Sha1 -> Sha1
Ord, (forall x. Sha1 -> Rep Sha1 x)
-> (forall x. Rep Sha1 x -> Sha1) -> Generic Sha1
forall x. Rep Sha1 x -> Sha1
forall x. Sha1 -> Rep Sha1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Sha1 -> Rep Sha1 x
from :: forall x. Sha1 -> Rep Sha1 x
$cto :: forall x. Rep Sha1 x -> Sha1
to :: forall x. Rep Sha1 x -> Sha1
Generic, [Sha1] -> Value
[Sha1] -> Encoding
Sha1 -> Bool
Sha1 -> Value
Sha1 -> Encoding
(Sha1 -> Value)
-> (Sha1 -> Encoding)
-> ([Sha1] -> Value)
-> ([Sha1] -> Encoding)
-> (Sha1 -> Bool)
-> ToJSON Sha1
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Sha1 -> Value
toJSON :: Sha1 -> Value
$ctoEncoding :: Sha1 -> Encoding
toEncoding :: Sha1 -> Encoding
$ctoJSONList :: [Sha1] -> Value
toJSONList :: [Sha1] -> Value
$ctoEncodingList :: [Sha1] -> Encoding
toEncodingList :: [Sha1] -> Encoding
$comitField :: Sha1 -> Bool
omitField :: Sha1 -> Bool
ToJSON)

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
  { CodeToRun -> SolutionSource
_toRunSource :: SolutionSource
  , CodeToRun -> TSyntax
_toRunSyntax :: TSyntax
  }

makeLenses ''CodeToRun

getRunCodePath :: CodeToRun -> Maybe FilePath
getRunCodePath :: CodeToRun -> Maybe String
getRunCodePath (CodeToRun SolutionSource
solutionSource TSyntax
_) = case SolutionSource
solutionSource of
  SolutionSource
ScenarioSuggested -> Maybe String
forall a. Maybe a
Nothing
  PlayerAuthored String
fp Sha1
_ -> String -> Maybe String
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 <- IO Text -> m Text
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ String -> IO Text
TIO.readFile String
filepath
  TSyntax
pt <- (Text -> m TSyntax)
-> (TSyntax -> m TSyntax) -> Either Text TSyntax -> m TSyntax
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (SystemFailure -> m TSyntax
forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError (SystemFailure -> m TSyntax)
-> (Text -> SystemFailure) -> Text -> m TSyntax
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SystemFailure
CustomFailure) TSyntax -> m TSyntax
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text TSyntax
processTermEither Text
contents)

  let srcLoc :: SrcLoc
srcLoc = TSyntax
pt TSyntax -> Getting SrcLoc TSyntax SrcLoc -> SrcLoc
forall s a. s -> Getting a s a -> a
^. Getting SrcLoc TSyntax SrcLoc
forall ty (f :: * -> *).
Functor f =>
(SrcLoc -> f SrcLoc) -> Syntax' ty -> f (Syntax' ty)
sLoc
      strippedText :: Text
strippedText = SrcLoc -> Text -> Text
stripSrc SrcLoc
srcLoc Text
contents
      programBytestring :: ByteString
programBytestring = Text -> ByteString
TL.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
strippedText
      sha1Hash :: String
sha1Hash = Digest SHA1State -> String
forall t. Digest t -> String
showDigest (Digest SHA1State -> String) -> Digest SHA1State -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Digest SHA1State
sha1 ByteString
programBytestring
  CodeToRun -> m CodeToRun
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CodeToRun -> m CodeToRun) -> CodeToRun -> m CodeToRun
forall a b. (a -> b) -> a -> b
$ SolutionSource -> TSyntax -> CodeToRun
CodeToRun (String -> Sha1 -> SolutionSource
PlayerAuthored String
filepath (Sha1 -> SolutionSource) -> Sha1 -> SolutionSource
forall a b. (a -> b) -> a -> b
$ String -> Sha1
Sha1 String
sha1Hash) TSyntax
pt
 where
  stripSrc :: SrcLoc -> Text -> Text
  stripSrc :: SrcLoc -> Text -> Text
stripSrc (SrcLoc Count
start Count
end) Text
txt = Count -> Text -> Text
T.drop Count
start (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Count -> Text -> Text
T.take Count
end Text
txt
  stripSrc SrcLoc
NoLoc Text
txt = Text
txt

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

-- | The main record holding the state for the game itself (as
--   distinct from the UI).  See the lenses below for access to its
--   fields.
--
--   To answer the question of what belongs in the `GameState` and
--   what belongs in the `UIState`, ask yourself the question: is this
--   something specific to a particular UI, or is it something
--   inherent to the game which would be needed even if we put a
--   different UI on top (web-based, GUI-based, etc.)? For example,
--   tracking whether the game is paused needs to be in the
--   `GameState`: especially if we want to have the game running in
--   one thread and the UI running in another thread, then the game
--   itself needs to keep track of whether it is currently paused, so
--   that it can know whether to step independently of the UI telling
--   it so. For example, the game may run for several ticks during a
--   single frame, but if an objective is completed during one of
--   those ticks, the game needs to immediately auto-pause without
--   waiting for the UI to tell it that it should do so, which could
--   come several ticks late.
data GameState = GameState
  { GameState -> Bool
_creativeMode :: Bool
  , GameState -> TemporalState
_temporal :: TemporalState
  , GameState -> WinCondition
_winCondition :: WinCondition
  , GameState -> Maybe TSyntax
_winSolution :: Maybe TSyntax
  , GameState -> Robots
_robotInfo :: Robots
  , GameState -> PathCaching
_pathCaching :: PathCaching
  , GameState -> Discovery
_discovery :: Discovery
  , GameState -> Randomness
_randomness :: Randomness
  , GameState -> Recipes
_recipesInfo :: Recipes
  , GameState -> Maybe ScenarioPath
_currentScenarioPath :: Maybe ScenarioPath
  , GameState -> Landscape
_landscape :: Landscape
  , GameState -> Bool
_needsRedraw :: Bool
  , GameState -> GameControls
_gameControls :: GameControls
  , GameState -> Messages
_messageInfo :: Messages
  , GameState -> Bool
_completionStatsSaved :: Bool
  }

makeLensesNoSigs ''GameState

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

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

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

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

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

-- | 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 =
  (Count -> Maybe Robot) -> [Count] -> [Robot]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Count -> IntMap Robot -> Maybe Robot
forall a. Count -> IntMap a -> Maybe a
`IM.lookup` (GameState
gs GameState
-> Getting (IntMap Robot) GameState (IntMap Robot) -> IntMap Robot
forall s a. s -> Getting a s a -> a
^. (Robots -> Const (IntMap Robot) Robots)
-> GameState -> Const (IntMap Robot) GameState
Lens' GameState Robots
robotInfo ((Robots -> Const (IntMap Robot) Robots)
 -> GameState -> Const (IntMap Robot) GameState)
-> ((IntMap Robot -> Const (IntMap Robot) (IntMap Robot))
    -> Robots -> Const (IntMap Robot) Robots)
-> Getting (IntMap Robot) GameState (IntMap Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap Robot -> Const (IntMap Robot) (IntMap Robot))
-> Robots -> Const (IntMap Robot) Robots
Lens' Robots (IntMap Robot)
robotMap))
    ([Count] -> [Robot])
-> (GameState -> [Count]) -> GameState -> [Robot]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> [Count]
IS.toList
    (IntSet -> [Count])
-> (GameState -> IntSet) -> GameState -> [Count]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Location -> MonoidMap Location IntSet -> IntSet
forall k v. (Ord k, Monoid v) => k -> MonoidMap k v -> v
MM.get (Cosmic Location
loc Cosmic Location
-> Getting Location (Cosmic Location) Location -> Location
forall s a. s -> Getting a s a -> a
^. Getting Location (Cosmic Location) Location
forall a1 a2 (f :: * -> *).
Functor f =>
(a1 -> f a2) -> Cosmic a1 -> f (Cosmic a2)
planar)
    (MonoidMap Location IntSet -> IntSet)
-> (GameState -> MonoidMap Location IntSet) -> GameState -> IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubworldName
-> MonoidMap SubworldName (MonoidMap Location IntSet)
-> MonoidMap Location IntSet
forall k v. (Ord k, Monoid v) => k -> MonoidMap k v -> v
MM.get (Cosmic Location
loc Cosmic Location
-> Getting SubworldName (Cosmic Location) SubworldName
-> SubworldName
forall s a. s -> Getting a s a -> a
^. Getting SubworldName (Cosmic Location) SubworldName
forall a (f :: * -> *).
Functor f =>
(SubworldName -> f SubworldName) -> Cosmic a -> f (Cosmic a)
subworld)
    (MonoidMap SubworldName (MonoidMap Location IntSet)
 -> MonoidMap Location IntSet)
-> (GameState
    -> MonoidMap SubworldName (MonoidMap Location IntSet))
-> GameState
-> MonoidMap Location IntSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (MonoidMap SubworldName (MonoidMap Location IntSet))
  GameState
  (MonoidMap SubworldName (MonoidMap Location IntSet))
-> GameState -> MonoidMap SubworldName (MonoidMap Location IntSet)
forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view ((Robots
 -> Const
      (MonoidMap SubworldName (MonoidMap Location IntSet)) Robots)
-> GameState
-> Const
     (MonoidMap SubworldName (MonoidMap Location IntSet)) GameState
Lens' GameState Robots
robotInfo ((Robots
  -> Const
       (MonoidMap SubworldName (MonoidMap Location IntSet)) Robots)
 -> GameState
 -> Const
      (MonoidMap SubworldName (MonoidMap Location IntSet)) GameState)
-> ((MonoidMap SubworldName (MonoidMap Location IntSet)
     -> Const
          (MonoidMap SubworldName (MonoidMap Location IntSet))
          (MonoidMap SubworldName (MonoidMap Location IntSet)))
    -> Robots
    -> Const
         (MonoidMap SubworldName (MonoidMap Location IntSet)) Robots)
-> Getting
     (MonoidMap SubworldName (MonoidMap Location IntSet))
     GameState
     (MonoidMap SubworldName (MonoidMap Location IntSet))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MonoidMap SubworldName (MonoidMap Location IntSet)
 -> Const
      (MonoidMap SubworldName (MonoidMap Location IntSet))
      (MonoidMap SubworldName (MonoidMap Location IntSet)))
-> Robots
-> Const
     (MonoidMap SubworldName (MonoidMap Location IntSet)) Robots
Lens' Robots (MonoidMap SubworldName (MonoidMap Location IntSet))
robotsByLocation)
    (GameState -> [Robot]) -> GameState -> [Robot]
forall a b. (a -> b) -> a -> b
$ GameState
gs

-- | Registry for caching output of the @path@ command
pathCaching :: Lens' GameState PathCaching

-- | Get all the robots within a given Manhattan distance from a
--   location.
robotsInArea :: Cosmic Location -> Int32 -> Robots -> [Robot]
robotsInArea :: Cosmic Location -> Int32 -> Robots -> [Robot]
robotsInArea (Cosmic SubworldName
subworldName Location
o) Int32
d Robots
rs = (Count -> Maybe Robot) -> [Count] -> [Robot]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (IntMap Robot
rm IntMap Robot -> Count -> Maybe Robot
forall a. IntMap a -> Count -> Maybe a
IM.!?) [Count]
rids
 where
  rm :: IntMap Robot
rm = Robots
rs Robots
-> ((IntMap Robot -> Const (IntMap Robot) (IntMap Robot))
    -> Robots -> Const (IntMap Robot) Robots)
-> IntMap Robot
forall s a. s -> Getting a s a -> a
^. (IntMap Robot -> Const (IntMap Robot) (IntMap Robot))
-> Robots -> Const (IntMap Robot) Robots
Lens' Robots (IntMap Robot)
robotMap
  rl :: MonoidMap SubworldName (MonoidMap Location IntSet)
rl = Robots
rs Robots
-> ((MonoidMap SubworldName (MonoidMap Location IntSet)
     -> Const
          (MonoidMap SubworldName (MonoidMap Location IntSet))
          (MonoidMap SubworldName (MonoidMap Location IntSet)))
    -> Robots
    -> Const
         (MonoidMap SubworldName (MonoidMap Location IntSet)) Robots)
-> MonoidMap SubworldName (MonoidMap Location IntSet)
forall s a. s -> Getting a s a -> a
^. (MonoidMap SubworldName (MonoidMap Location IntSet)
 -> Const
      (MonoidMap SubworldName (MonoidMap Location IntSet))
      (MonoidMap SubworldName (MonoidMap Location IntSet)))
-> Robots
-> Const
     (MonoidMap SubworldName (MonoidMap Location IntSet)) Robots
Lens' Robots (MonoidMap SubworldName (MonoidMap Location IntSet))
robotsByLocation
  rids :: [Count]
rids =
    (IntSet -> [Count]) -> [IntSet] -> [Count]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap IntSet -> [Count]
IS.elems
      ([IntSet] -> [Count])
-> (MonoidMap Location IntSet -> [IntSet])
-> MonoidMap Location IntSet
-> [Count]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Location -> Int32 -> Map Location IntSet -> [IntSet]
forall e. Location -> Int32 -> Map Location e -> [e]
getElemsInArea Location
o Int32
d
      (Map Location IntSet -> [IntSet])
-> (MonoidMap Location IntSet -> Map Location IntSet)
-> MonoidMap Location IntSet
-> [IntSet]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MonoidMap Location IntSet -> Map Location IntSet
forall k v. MonoidMap k v -> Map k v
MM.toMap
      (MonoidMap Location IntSet -> [Count])
-> MonoidMap Location IntSet -> [Count]
forall a b. (a -> b) -> a -> b
$ SubworldName
-> MonoidMap SubworldName (MonoidMap Location IntSet)
-> MonoidMap Location IntSet
forall k v. (Ord k, Monoid v) => k -> MonoidMap k v -> v
MM.get SubworldName
subworldName MonoidMap SubworldName (MonoidMap Location IntSet)
rl

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

-- | The base robot environment.
baseEnv :: Traversal' GameState Env
baseEnv :: Traversal' GameState Env
baseEnv = (Robot -> f Robot) -> GameState -> f GameState
Traversal' GameState Robot
baseRobot ((Robot -> f Robot) -> GameState -> f GameState)
-> ((Env -> f Env) -> Robot -> f Robot)
-> (Env -> f Env)
-> GameState
-> f GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CESK -> f CESK) -> Robot -> f Robot
Lens' Robot CESK
machine ((CESK -> f CESK) -> Robot -> f Robot)
-> ((Env -> f Env) -> CESK -> f CESK)
-> (Env -> f Env)
-> Robot
-> f Robot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Env -> f Env) -> CESK -> f CESK
Traversal' CESK Env
suspendedEnv

-- | The base robot store, or the empty store if there is no base robot.
baseStore :: Getter GameState Store
baseStore :: Getter GameState Store
baseStore = (GameState -> Store) -> Optic' (->) f GameState Store
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to ((GameState -> Store) -> Optic' (->) f GameState Store)
-> (GameState -> Store) -> Optic' (->) f GameState Store
forall a b. (a -> b) -> a -> b
$ \GameState
g -> case GameState
g GameState -> Getting (First CESK) GameState CESK -> Maybe CESK
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Robot -> Const (First CESK) Robot)
-> GameState -> Const (First CESK) GameState
Traversal' GameState Robot
baseRobot ((Robot -> Const (First CESK) Robot)
 -> GameState -> Const (First CESK) GameState)
-> ((CESK -> Const (First CESK) CESK)
    -> Robot -> Const (First CESK) Robot)
-> Getting (First CESK) GameState CESK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CESK -> Const (First CESK) CESK)
-> Robot -> Const (First CESK) Robot
Lens' Robot CESK
machine of
  Maybe CESK
Nothing -> Store
emptyStore
  Just CESK
m -> CESK
m CESK -> Getting Store CESK Store -> Store
forall s a. s -> Getting a s a -> a
^. Getting Store CESK Store
Lens' CESK Store
store

-- | Inputs for randomness
randomness :: Lens' GameState Randomness

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

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

-- | The filepath of the currently running scenario.
--
-- This is useful as an index to the scenarios collection,
-- see 'Swarm.Game.ScenarioInfo.scenarioItemByPath'.
--
-- Note that it is possible for this to be missing even
-- with an active game state, since the game state can
-- be initialized from sources other than a scenario
-- file on disk.
--
-- We keep a reference to the possible path within the GameState,
-- however, so that the achievement/progress saving functions
-- do not require access to anything outside GameState.
currentScenarioPath :: Lens' GameState (Maybe ScenarioPath)

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

-- | Info about robots
robotInfo :: Lens' GameState Robots

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

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

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

-- | Whether statistics for the current scenario have been saved to
--   disk *upon scenario completion*. (It should remain False whenever
--   the current scenario has not been completed, either because there
--   is no win condition or because the player has not yet achieved
--   it.)  If this is set to True, we should not update completion
--   statistics any more.  We need this to make sure we don't
--   overwrite statistics if the user continues playing the scenario
--   after completing it (or even if the user stays in the completion
--   menu for a while before quitting; see #1932).
completionStatsSaved :: Lens' GameState Bool

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

-- | 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 = (GameState -> Notifications LogEntry)
-> (Notifications LogEntry -> f (Notifications LogEntry))
-> GameState
-> f GameState
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 :: Count
_notificationsCount = [LogEntry] -> Count
forall a. [a] -> Count
forall (t :: * -> *) a. Foldable t => t a -> Count
length [LogEntry]
new
      , _notificationsShouldAlert :: Bool
_notificationsShouldAlert = Bool -> Bool
not ([LogEntry] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LogEntry]
new)
      , _notificationsContent :: [LogEntry]
_notificationsContent = [LogEntry]
allUniq
      }
   where
    allUniq :: [LogEntry]
allUniq = [LogEntry] -> [LogEntry]
forall a. Eq a => [a] -> [a]
uniq ([LogEntry] -> [LogEntry]) -> [LogEntry] -> [LogEntry]
forall a b. (a -> b) -> a -> b
$ Seq LogEntry -> [LogEntry]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq LogEntry
allMessages
    new :: [LogEntry]
new = (LogEntry -> Bool) -> [LogEntry] -> [LogEntry]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\LogEntry
l -> LogEntry
l LogEntry -> Getting TickNumber LogEntry TickNumber -> TickNumber
forall s a. s -> Getting a s a -> a
^. Getting TickNumber LogEntry TickNumber
Lens' LogEntry TickNumber
leTime TickNumber -> TickNumber -> Bool
forall a. Ord a => a -> a -> Bool
> GameState
gs GameState -> Getting TickNumber GameState TickNumber -> TickNumber
forall s a. s -> Getting a s a -> a
^. (Messages -> Const TickNumber Messages)
-> GameState -> Const TickNumber GameState
Lens' GameState Messages
messageInfo ((Messages -> Const TickNumber Messages)
 -> GameState -> Const TickNumber GameState)
-> ((TickNumber -> Const TickNumber TickNumber)
    -> Messages -> Const TickNumber Messages)
-> Getting TickNumber GameState TickNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TickNumber -> Const TickNumber TickNumber)
-> Messages -> Const TickNumber Messages
Lens' Messages TickNumber
lastSeenMessageTime) ([LogEntry] -> [LogEntry]) -> [LogEntry] -> [LogEntry]
forall a b. (a -> b) -> a -> b
$ [LogEntry] -> [LogEntry]
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 GameState -> Getting Bool GameState Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool GameState Bool
Lens' GameState Bool
creativeMode Bool -> Bool -> Bool
|| Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (GameState -> Maybe Robot
focusedRobot GameState
gs Maybe Robot
-> Getting (First Bool) (Maybe Robot) Bool -> Maybe Bool
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Robot -> Const (First Bool) Robot)
-> Maybe Robot -> Const (First Bool) (Maybe Robot)
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just ((Robot -> Const (First Bool) Robot)
 -> Maybe Robot -> Const (First Bool) (Maybe Robot))
-> ((Bool -> Const (First Bool) Bool)
    -> Robot -> Const (First Bool) Robot)
-> Getting (First Bool) (Maybe Robot) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const (First Bool) Bool)
-> Robot -> Const (First Bool) Robot
Lens' Robot Bool
systemRobot)
    messages :: Seq LogEntry
messages = Bool
-> (Seq LogEntry -> Seq LogEntry) -> Seq LogEntry -> Seq LogEntry
forall a. Bool -> (a -> a) -> a -> a
applyWhen (Bool -> Bool
not Bool
unchecked) Seq LogEntry -> Seq LogEntry
focusedOrLatestClose (GameState
gs GameState
-> Getting (Seq LogEntry) GameState (Seq LogEntry) -> Seq LogEntry
forall s a. s -> Getting a s a -> a
^. (Messages -> Const (Seq LogEntry) Messages)
-> GameState -> Const (Seq LogEntry) GameState
Lens' GameState Messages
messageInfo ((Messages -> Const (Seq LogEntry) Messages)
 -> GameState -> Const (Seq LogEntry) GameState)
-> ((Seq LogEntry -> Const (Seq LogEntry) (Seq LogEntry))
    -> Messages -> Const (Seq LogEntry) Messages)
-> Getting (Seq LogEntry) GameState (Seq LogEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq LogEntry -> Const (Seq LogEntry) (Seq LogEntry))
-> Messages -> Const (Seq LogEntry) Messages
Lens' Messages (Seq LogEntry)
messageQueue)
    allMessages :: Seq LogEntry
allMessages = Seq LogEntry -> Seq LogEntry
forall a. Ord a => Seq a -> Seq a
Seq.sort (Seq LogEntry -> Seq LogEntry) -> Seq LogEntry -> Seq LogEntry
forall a b. (a -> b) -> a -> b
$ Seq LogEntry
focusedLogs Seq LogEntry -> Seq LogEntry -> Seq LogEntry
forall a. Semigroup a => a -> a -> a
<> Seq LogEntry
messages
    focusedLogs :: Seq LogEntry
focusedLogs = Seq LogEntry
-> (Robot -> Seq LogEntry) -> Maybe Robot -> Seq LogEntry
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Seq LogEntry
forall s. AsEmpty s => s
Empty (Getting (Seq LogEntry) Robot (Seq LogEntry)
-> Robot -> Seq LogEntry
forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getting (Seq LogEntry) Robot (Seq LogEntry)
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 GameState
-> Getting (Cosmic Location) GameState (Cosmic Location)
-> Cosmic Location
forall s a. s -> Getting a s a -> a
^. (Robots -> Const (Cosmic Location) Robots)
-> GameState -> Const (Cosmic Location) GameState
Lens' GameState Robots
robotInfo ((Robots -> Const (Cosmic Location) Robots)
 -> GameState -> Const (Cosmic Location) GameState)
-> ((Cosmic Location -> Const (Cosmic Location) (Cosmic Location))
    -> Robots -> Const (Cosmic Location) Robots)
-> Getting (Cosmic Location) GameState (Cosmic Location)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cosmic Location -> Const (Cosmic Location) (Cosmic Location))
-> Robots -> Const (Cosmic Location) Robots
Getter Robots (Cosmic Location)
viewCenter)
    generatedBy :: Count -> LogEntry -> Bool
generatedBy Count
rid LogEntry
logEntry = case LogEntry
logEntry LogEntry -> Getting LogSource LogEntry LogSource -> LogSource
forall s a. s -> Getting a s a -> a
^. Getting LogSource LogEntry LogSource
Lens' LogEntry LogSource
leSource of
      RobotLog RobotLogSource
_ Count
rid' Cosmic Location
_ -> Count
rid Count -> Count -> Bool
forall a. Eq a => a -> a -> Bool
== Count
rid'
      LogSource
_ -> Bool
False

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

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

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

-- | Recalculate the view center (and cache the result in the
--   'viewCenter' field) based on the current 'viewCenterRule'.  If
--   the 'viewCenterRule' specifies a robot which does not exist,
--   simply leave the current 'viewCenter' as it is. Set 'needsRedraw'
--   if the view center changes.
recalcViewCenterAndRedraw :: GameState -> GameState
recalcViewCenterAndRedraw :: GameState -> GameState
recalcViewCenterAndRedraw GameState
g =
  GameState
g
    GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Robots -> Identity Robots) -> GameState -> Identity GameState
Lens' GameState Robots
robotInfo ((Robots -> Identity Robots) -> GameState -> Identity GameState)
-> Robots -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Robots
newRobotInfo
    GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& Bool -> (GameState -> GameState) -> GameState -> GameState
forall a. Bool -> (a -> a) -> a -> a
applyWhen ((Cosmic Location -> Cosmic Location -> Bool
forall a. Eq a => a -> a -> Bool
(/=) (Cosmic Location -> Cosmic Location -> Bool)
-> (Robots -> Cosmic Location) -> Robots -> Robots -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Robots
-> ((Cosmic Location -> Const (Cosmic Location) (Cosmic Location))
    -> Robots -> Const (Cosmic Location) Robots)
-> Cosmic Location
forall s a. s -> Getting a s a -> a
^. (Cosmic Location -> Const (Cosmic Location) (Cosmic Location))
-> Robots -> Const (Cosmic Location) Robots
Getter Robots (Cosmic Location)
viewCenter)) Robots
oldRobotInfo Robots
newRobotInfo) ((Bool -> Identity Bool) -> GameState -> Identity GameState
Lens' GameState Bool
needsRedraw ((Bool -> Identity Bool) -> GameState -> Identity GameState)
-> Bool -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True)
 where
  oldRobotInfo :: Robots
oldRobotInfo = GameState
g GameState -> Getting Robots GameState Robots -> Robots
forall s a. s -> Getting a s a -> a
^. Getting Robots GameState Robots
Lens' GameState Robots
robotInfo
  newRobotInfo :: Robots
newRobotInfo = Robots -> Robots
recalcViewCenter Robots
oldRobotInfo

-- | Given a width and height, compute the region, centered on the
--   'viewCenter', that should currently be in view.
viewingRegion :: Cosmic Location -> (Int32, Int32) -> Cosmic BoundsRectangle
viewingRegion :: Cosmic Location -> (Int32, Int32) -> Cosmic BoundsRectangle
viewingRegion (Cosmic SubworldName
sw (Location Int32
cx Int32
cy)) (Int32
w, Int32
h) =
  SubworldName -> BoundsRectangle -> Cosmic BoundsRectangle
forall a. SubworldName -> a -> Cosmic a
Cosmic SubworldName
sw ((Int32, Int32) -> Coords
Coords (Int32
rmin, Int32
cmin), (Int32, Int32) -> Coords
Coords (Int32
rmax, Int32
cmax))
 where
  (Int32
rmin, Int32
rmax) = ASetter (Int32, Int32) (Int32, Int32) Int32 Int32
-> (Int32 -> Int32) -> (Int32, Int32) -> (Int32, Int32)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Int32, Int32) (Int32, Int32) Int32 Int32
Traversal (Int32, Int32) (Int32, Int32) Int32 Int32
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both (Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ (-Int32
cy Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
h Int32 -> Int32 -> Int32
forall a. Integral a => a -> a -> a
`div` Int32
2)) (Int32
0, Int32
h Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
1)
  (Int32
cmin, Int32
cmax) = ASetter (Int32, Int32) (Int32, Int32) Int32 Int32
-> (Int32 -> Int32) -> (Int32, Int32) -> (Int32, Int32)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Int32, Int32) (Int32, Int32) Int32 Int32
Traversal (Int32, Int32) (Int32, Int32) Int32 Int32
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both (Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ (Int32
cx Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
w Int32 -> Int32 -> Int32
forall a. Integral a => a -> a -> a
`div` Int32
2)) (Int32
0, Int32
w Int32 -> Int32 -> Int32
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 GameState
-> Getting (Maybe Robot) GameState (Maybe Robot) -> Maybe Robot
forall s a. s -> Getting a s a -> a
^. (Robots -> Const (Maybe Robot) Robots)
-> GameState -> Const (Maybe Robot) GameState
Lens' GameState Robots
robotInfo ((Robots -> Const (Maybe Robot) Robots)
 -> GameState -> Const (Maybe Robot) GameState)
-> ((Maybe Robot -> Const (Maybe Robot) (Maybe Robot))
    -> Robots -> Const (Maybe Robot) Robots)
-> Getting (Maybe Robot) GameState (Maybe Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IntMap Robot -> Const (Maybe Robot) (IntMap Robot))
-> Robots -> Const (Maybe Robot) Robots
Lens' Robots (IntMap Robot)
robotMap ((IntMap Robot -> Const (Maybe Robot) (IntMap Robot))
 -> Robots -> Const (Maybe Robot) Robots)
-> ((Maybe Robot -> Const (Maybe Robot) (Maybe Robot))
    -> IntMap Robot -> Const (Maybe Robot) (IntMap Robot))
-> (Maybe Robot -> Const (Maybe Robot) (Maybe Robot))
-> Robots
-> Const (Maybe Robot) Robots
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (IntMap Robot)
-> Lens' (IntMap Robot) (Maybe (IxValue (IntMap Robot)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at (GameState
g GameState -> Getting Count GameState Count -> Count
forall s a. s -> Getting a s a -> a
^. (Robots -> Const Count Robots)
-> GameState -> Const Count GameState
Lens' GameState Robots
robotInfo ((Robots -> Const Count Robots)
 -> GameState -> Const Count GameState)
-> ((Count -> Const Count Count) -> Robots -> Const Count Robots)
-> Getting Count GameState Count
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Count -> Const Count Count) -> Robots -> Const Count Robots
Getter Robots Count
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
(RobotRange -> RobotRange -> Bool)
-> (RobotRange -> RobotRange -> Bool) -> Eq RobotRange
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RobotRange -> RobotRange -> Bool
== :: RobotRange -> RobotRange -> Bool
$c/= :: RobotRange -> RobotRange -> Bool
/= :: RobotRange -> RobotRange -> Bool
Eq, Eq RobotRange
Eq RobotRange =>
(RobotRange -> RobotRange -> Ordering)
-> (RobotRange -> RobotRange -> Bool)
-> (RobotRange -> RobotRange -> Bool)
-> (RobotRange -> RobotRange -> Bool)
-> (RobotRange -> RobotRange -> Bool)
-> (RobotRange -> RobotRange -> RobotRange)
-> (RobotRange -> RobotRange -> RobotRange)
-> Ord 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
$ccompare :: RobotRange -> RobotRange -> Ordering
compare :: RobotRange -> RobotRange -> Ordering
$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
>= :: RobotRange -> RobotRange -> Bool
$cmax :: RobotRange -> RobotRange -> RobotRange
max :: RobotRange -> RobotRange -> RobotRange
$cmin :: RobotRange -> RobotRange -> RobotRange
min :: RobotRange -> RobotRange -> RobotRange
Ord)

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

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

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

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

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

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

  gain :: Maybe Inventory -> (Double -> Double)
  gain :: Maybe Inventory -> Double -> Double
gain (Just Inventory
inv)
    | Text -> Inventory -> Count
countByName Text
"antenna" Inventory
inv Count -> Count -> Bool
forall a. Ord a => a -> a -> Bool
> Count
0 = (Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
2)
  gain Maybe Inventory
_ = Double -> Double
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) = ASetter (Double, Double) (Double, Double) Double Double
-> (Double -> Double) -> (Double, Double) -> (Double, Double)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Double, Double) (Double, Double) Double Double
Traversal (Double, Double) (Double, Double) Double Double
forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both (Maybe Inventory -> Double -> Double
gain Maybe Inventory
baseInv (Double -> Double) -> (Double -> Double) -> Double -> Double
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 Robots) sig m) => m ()
clearFocusedRobotLogUpdated :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State Robots) sig m =>
m ()
clearFocusedRobotLogUpdated = do
  Count
n <- ((Count -> Const Count Count) -> Robots -> Const Count Robots)
-> m Count
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Count -> Const Count Count) -> Robots -> Const Count Robots
Getter Robots Count
focusedRobotID
  (IntMap Robot -> Identity (IntMap Robot))
-> Robots -> Identity Robots
Lens' Robots (IntMap Robot)
robotMap ((IntMap Robot -> Identity (IntMap Robot))
 -> Robots -> Identity Robots)
-> ((Bool -> Identity Bool)
    -> IntMap Robot -> Identity (IntMap Robot))
-> (Bool -> Identity Bool)
-> Robots
-> Identity Robots
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (IntMap Robot)
-> Traversal' (IntMap Robot) (IxValue (IntMap Robot))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Count
Index (IntMap Robot)
n ((Robot -> Identity Robot)
 -> IntMap Robot -> Identity (IntMap Robot))
-> ((Bool -> Identity Bool) -> Robot -> Identity Robot)
-> (Bool -> Identity Bool)
-> IntMap Robot
-> Identity (IntMap Robot)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Identity Bool) -> Robot -> Identity Robot
Lens' Robot Bool
robotLogUpdated ((Bool -> Identity Bool) -> Robots -> Identity Robots)
-> Bool -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Bool
False

maxMessageQueueSize :: Int
maxMessageQueueSize :: Count
maxMessageQueueSize = Count
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 = (Messages -> Identity Messages) -> GameState -> Identity GameState
Lens' GameState Messages
messageInfo ((Messages -> Identity Messages)
 -> GameState -> Identity GameState)
-> ((Seq LogEntry -> Identity (Seq LogEntry))
    -> Messages -> Identity Messages)
-> (Seq LogEntry -> Identity (Seq LogEntry))
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seq LogEntry -> Identity (Seq LogEntry))
-> Messages -> Identity Messages
Lens' Messages (Seq LogEntry)
messageQueue ((Seq LogEntry -> Identity (Seq LogEntry))
 -> GameState -> Identity GameState)
-> (Seq LogEntry -> Seq LogEntry) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Seq LogEntry -> LogEntry -> Seq LogEntry
forall s a. Snoc s s a a => s -> a -> s
|> LogEntry
msg) (Seq LogEntry -> Seq LogEntry)
-> (Seq LogEntry -> Seq LogEntry) -> Seq LogEntry -> Seq LogEntry
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq LogEntry -> Seq LogEntry
forall a. Seq a -> Seq a
dropLastIfLong
 where
  tooLong :: Seq a -> Bool
tooLong Seq a
s = Seq a -> Count
forall a. Seq a -> Count
Seq.length Seq a
s Count -> Count -> Bool
forall a. Ord a => a -> a -> Bool
>= Count
maxMessageQueueSize
  dropLastIfLong :: Seq a -> Seq a
dropLastIfLong whole :: Seq a
whole@(a
_oldest :<| Seq a
newer) = if Seq a -> Bool
forall {a}. Seq a -> Bool
tooLong Seq a
whole then Seq a
newer else Seq a
whole
  dropLastIfLong Seq a
emptyQueue = Seq a
emptyQueue

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

-- | Create an initial, fresh game state record when starting a new scenario.
initGameState :: GameStateConfig -> GameState
initGameState :: GameStateConfig -> GameState
initGameState GameStateConfig
gsc =
  GameState
    { _creativeMode :: Bool
_creativeMode = Bool
False
    , _temporal :: TemporalState
_temporal =
        Bool -> TemporalState
initTemporalState (GameStateConfig -> Bool
startPaused GameStateConfig
gsc)
          TemporalState -> (TemporalState -> TemporalState) -> TemporalState
forall a b. a -> (a -> b) -> b
& (PauseOnObjective -> Identity PauseOnObjective)
-> TemporalState -> Identity TemporalState
Lens' TemporalState PauseOnObjective
pauseOnObjective ((PauseOnObjective -> Identity PauseOnObjective)
 -> TemporalState -> Identity TemporalState)
-> PauseOnObjective -> TemporalState -> TemporalState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (if GameStateConfig -> Bool
pauseOnObjectiveCompletion GameStateConfig
gsc then PauseOnObjective
PauseOnAnyObjective else PauseOnObjective
PauseOnWin)
    , _winCondition :: WinCondition
_winCondition = WinCondition
NoWinCondition
    , _winSolution :: Maybe TSyntax
_winSolution = Maybe TSyntax
forall a. Maybe a
Nothing
    , _robotInfo :: Robots
_robotInfo = GameStateConfig -> Robots
initRobots GameStateConfig
gsc
    , _pathCaching :: PathCaching
_pathCaching = PathCaching
emptyPathCache
    , _discovery :: Discovery
_discovery = Discovery
initDiscovery
    , _randomness :: Randomness
_randomness = Randomness
initRandomness
    , _recipesInfo :: Recipes
_recipesInfo = GameStateConfig -> Recipes
initRecipeMaps GameStateConfig
gsc
    , _currentScenarioPath :: Maybe ScenarioPath
_currentScenarioPath = Maybe ScenarioPath
forall a. Maybe a
Nothing
    , _landscape :: Landscape
_landscape = GameStateConfig -> Landscape
initLandscape GameStateConfig
gsc
    , _needsRedraw :: Bool
_needsRedraw = Bool
False
    , _gameControls :: GameControls
_gameControls = GameControls
initGameControls
    , _messageInfo :: Messages
_messageInfo = Messages
initMessages
    , _completionStatsSaved :: Bool
_completionStatsSaved = Bool
False
    }

-- | Provide an entity accessor via the MTL transformer State API.
-- This is useful for the structure recognizer.
mtlEntityAt :: Cosmic Location -> TS.State GameState (Maybe Entity)
mtlEntityAt :: Cosmic Location -> State GameState (Maybe Entity)
mtlEntityAt = (GameState -> (Maybe Entity, GameState))
-> State GameState (Maybe Entity)
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
TS.state ((GameState -> (Maybe Entity, GameState))
 -> State GameState (Maybe Entity))
-> (Cosmic Location -> GameState -> (Maybe Entity, GameState))
-> Cosmic Location
-> State GameState (Maybe Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cosmic Location -> GameState -> (Maybe Entity, GameState)
runGetEntity
 where
  runGetEntity :: Cosmic Location -> GameState -> (Maybe Entity, GameState)
  runGetEntity :: Cosmic Location -> GameState -> (Maybe Entity, GameState)
runGetEntity Cosmic Location
loc GameState
gs =
    (GameState, Maybe Entity) -> (Maybe Entity, GameState)
forall a b. (a, b) -> (b, a)
swap ((GameState, Maybe Entity) -> (Maybe Entity, GameState))
-> (StateC GameState Identity (Maybe Entity)
    -> (GameState, Maybe Entity))
-> StateC GameState Identity (Maybe Entity)
-> (Maybe Entity, GameState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity (GameState, Maybe Entity) -> (GameState, Maybe Entity)
forall a. Identity a -> a
run (Identity (GameState, Maybe Entity) -> (GameState, Maybe Entity))
-> (StateC GameState Identity (Maybe Entity)
    -> Identity (GameState, Maybe Entity))
-> StateC GameState Identity (Maybe Entity)
-> (GameState, Maybe Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GameState
-> StateC GameState Identity (Maybe Entity)
-> Identity (GameState, Maybe Entity)
forall s (m :: * -> *) a. s -> StateC s m a -> m (s, a)
Fused.runState GameState
gs (StateC GameState Identity (Maybe Entity)
 -> (Maybe Entity, GameState))
-> StateC GameState Identity (Maybe Entity)
-> (Maybe Entity, GameState)
forall a b. (a -> b) -> a -> b
$ Cosmic Location -> StateC GameState Identity (Maybe Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt Cosmic Location
loc

-- | Get the entity (if any) at a given location.
entityAt :: (Has (State GameState) sig m) => Cosmic Location -> m (Maybe Entity)
entityAt :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt (Cosmic SubworldName
subworldName Location
loc) =
  Maybe (Maybe Entity) -> Maybe Entity
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Maybe (Maybe Entity) -> Maybe Entity)
-> m (Maybe (Maybe Entity)) -> m (Maybe Entity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SubworldName
-> StateC (World Count Entity) Identity (Maybe Entity)
-> m (Maybe (Maybe Entity))
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) b.
Has (State GameState) sig m =>
SubworldName
-> StateC (World Count Entity) Identity b -> m (Maybe b)
zoomWorld SubworldName
subworldName (forall t e (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State (World t e)) sig m, IArray UArray t) =>
Coords -> m (Maybe e)
W.lookupEntityM @Int (Location -> Coords
locToCoords Location
loc))

contentAt ::
  (Has (State GameState) sig m) =>
  Cosmic Location ->
  m (TerrainType, Maybe Entity)
contentAt :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (TerrainType, Maybe Entity)
contentAt (Cosmic SubworldName
subworldName Location
loc) = do
  TerrainMap
tm <- Getting TerrainMap GameState TerrainMap -> m TerrainMap
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting TerrainMap GameState TerrainMap -> m TerrainMap)
-> Getting TerrainMap GameState TerrainMap -> m TerrainMap
forall a b. (a -> b) -> a -> b
$ (Landscape -> Const TerrainMap Landscape)
-> GameState -> Const TerrainMap GameState
Lens' GameState Landscape
landscape ((Landscape -> Const TerrainMap Landscape)
 -> GameState -> Const TerrainMap GameState)
-> ((TerrainMap -> Const TerrainMap TerrainMap)
    -> Landscape -> Const TerrainMap Landscape)
-> Getting TerrainMap GameState TerrainMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps)
-> Landscape -> Const TerrainMap Landscape
Lens' Landscape TerrainEntityMaps
terrainAndEntities ((TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps)
 -> Landscape -> Const TerrainMap Landscape)
-> ((TerrainMap -> Const TerrainMap TerrainMap)
    -> TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps)
-> (TerrainMap -> Const TerrainMap TerrainMap)
-> Landscape
-> Const TerrainMap Landscape
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TerrainMap -> Const TerrainMap TerrainMap)
-> TerrainEntityMaps -> Const TerrainMap TerrainEntityMaps
Lens' TerrainEntityMaps TerrainMap
terrainMap
  Maybe (TerrainType, Maybe Entity)
val <- SubworldName
-> StateC (World Count Entity) Identity (TerrainType, Maybe Entity)
-> m (Maybe (TerrainType, Maybe Entity))
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) b.
Has (State GameState) sig m =>
SubworldName
-> StateC (World Count Entity) Identity b -> m (Maybe b)
zoomWorld SubworldName
subworldName (StateC (World Count Entity) Identity (TerrainType, Maybe Entity)
 -> m (Maybe (TerrainType, Maybe Entity)))
-> StateC (World Count Entity) Identity (TerrainType, Maybe Entity)
-> m (Maybe (TerrainType, Maybe Entity))
forall a b. (a -> b) -> a -> b
$ do
    (Count
terrIdx, Maybe Entity
maybeEnt) <- Coords
-> StateC (World Count Entity) Identity (Count, Maybe Entity)
forall t e (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (State (World t e)) sig m, IArray UArray t) =>
Coords -> m (t, Maybe e)
W.lookupContentM (Location -> Coords
locToCoords Location
loc)
    let terrObj :: Maybe TerrainObj
terrObj = Count
terrIdx Count -> IntMap TerrainObj -> Maybe TerrainObj
forall a. Count -> IntMap a -> Maybe a
`IM.lookup` TerrainMap -> IntMap TerrainObj
terrainByIndex TerrainMap
tm
    (TerrainType, Maybe Entity)
-> StateC (World Count Entity) Identity (TerrainType, Maybe Entity)
forall a. a -> StateC (World Count Entity) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (TerrainType
-> (TerrainObj -> TerrainType) -> Maybe TerrainObj -> TerrainType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TerrainType
BlankT TerrainObj -> TerrainType
terrainName Maybe TerrainObj
terrObj, Maybe Entity
maybeEnt)
  (TerrainType, Maybe Entity) -> m (TerrainType, Maybe Entity)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ((TerrainType, Maybe Entity) -> m (TerrainType, Maybe Entity))
-> (TerrainType, Maybe Entity) -> m (TerrainType, Maybe Entity)
forall a b. (a -> b) -> a -> b
$ (TerrainType, Maybe Entity)
-> Maybe (TerrainType, Maybe Entity) -> (TerrainType, Maybe Entity)
forall a. a -> Maybe a -> a
fromMaybe (TerrainType
BlankT, Maybe Entity
forall a. Maybe a
Nothing) Maybe (TerrainType, Maybe Entity)
val

-- | Perform an action requiring a 'Robots' state component in a
--   larger context with a 'GameState'.
zoomRobots ::
  (Has (State GameState) sig m) =>
  Fused.StateC Robots Identity b ->
  m b
zoomRobots :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) b.
Has (State GameState) sig m =>
StateC Robots Identity b -> m b
zoomRobots StateC Robots Identity b
n = do
  Robots
ri <- Getting Robots GameState Robots -> m Robots
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getting Robots GameState Robots
Lens' GameState Robots
robotInfo
  do
    let (Robots
ri', b
a) = Identity (Robots, b) -> (Robots, b)
forall a. Identity a -> a
run (Identity (Robots, b) -> (Robots, b))
-> Identity (Robots, b) -> (Robots, b)
forall a b. (a -> b) -> a -> b
$ Robots -> StateC Robots Identity b -> Identity (Robots, b)
forall s (m :: * -> *) a. s -> StateC s m a -> m (s, a)
Fused.runState Robots
ri StateC Robots Identity b
n
    (Robots -> Identity Robots) -> GameState -> Identity GameState
Lens' GameState Robots
robotInfo ((Robots -> Identity Robots) -> GameState -> Identity GameState)
-> Robots -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= Robots
ri'
    b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
a

-- | Perform an action requiring a 'W.World' state component in a
--   larger context with a 'GameState'.
zoomWorld ::
  (Has (State GameState) sig m) =>
  SubworldName ->
  Fused.StateC (W.World Int Entity) Identity b ->
  m (Maybe b)
zoomWorld :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *) b.
Has (State GameState) sig m =>
SubworldName
-> StateC (World Count Entity) Identity b -> m (Maybe b)
zoomWorld SubworldName
swName StateC (World Count Entity) Identity b
n = do
  MultiWorld Count Entity
mw <- Getting
  (MultiWorld Count Entity) GameState (MultiWorld Count Entity)
-> m (MultiWorld Count Entity)
forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use (Getting
   (MultiWorld Count Entity) GameState (MultiWorld Count Entity)
 -> m (MultiWorld Count Entity))
-> Getting
     (MultiWorld Count Entity) GameState (MultiWorld Count Entity)
-> m (MultiWorld Count Entity)
forall a b. (a -> b) -> a -> b
$ (Landscape -> Const (MultiWorld Count Entity) Landscape)
-> GameState -> Const (MultiWorld Count Entity) GameState
Lens' GameState Landscape
landscape ((Landscape -> Const (MultiWorld Count Entity) Landscape)
 -> GameState -> Const (MultiWorld Count Entity) GameState)
-> ((MultiWorld Count Entity
     -> Const (MultiWorld Count Entity) (MultiWorld Count Entity))
    -> Landscape -> Const (MultiWorld Count Entity) Landscape)
-> Getting
     (MultiWorld Count Entity) GameState (MultiWorld Count Entity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MultiWorld Count Entity
 -> Const (MultiWorld Count Entity) (MultiWorld Count Entity))
-> Landscape -> Const (MultiWorld Count Entity) Landscape
Lens' Landscape (MultiWorld Count Entity)
multiWorld
  Maybe (World Count Entity)
-> (World Count Entity -> m b) -> m (Maybe b)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (SubworldName
-> MultiWorld Count Entity -> Maybe (World Count Entity)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup SubworldName
swName MultiWorld Count Entity
mw) ((World Count Entity -> m b) -> m (Maybe b))
-> (World Count Entity -> m b) -> m (Maybe b)
forall a b. (a -> b) -> a -> b
$ \World Count Entity
w -> do
    let (World Count Entity
w', b
a) = Identity (World Count Entity, b) -> (World Count Entity, b)
forall a. Identity a -> a
run (World Count Entity
-> StateC (World Count Entity) Identity b
-> Identity (World Count Entity, b)
forall s (m :: * -> *) a. s -> StateC s m a -> m (s, a)
Fused.runState World Count Entity
w StateC (World Count Entity) Identity b
n)
    (Landscape -> Identity Landscape)
-> GameState -> Identity GameState
Lens' GameState Landscape
landscape ((Landscape -> Identity Landscape)
 -> GameState -> Identity GameState)
-> ((MultiWorld Count Entity -> Identity (MultiWorld Count Entity))
    -> Landscape -> Identity Landscape)
-> (MultiWorld Count Entity -> Identity (MultiWorld Count Entity))
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MultiWorld Count Entity -> Identity (MultiWorld Count Entity))
-> Landscape -> Identity Landscape
Lens' Landscape (MultiWorld Count Entity)
multiWorld ((MultiWorld Count Entity -> Identity (MultiWorld Count Entity))
 -> GameState -> Identity GameState)
-> (MultiWorld Count Entity -> MultiWorld Count Entity) -> m ()
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= SubworldName
-> World Count Entity
-> MultiWorld Count Entity
-> MultiWorld Count Entity
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert SubworldName
swName World Count Entity
w'
    b -> m b
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return b
a