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

-- |
-- Module      :  Swarm.Game.State
-- Copyright   :  Brent Yorgey
-- Maintainer  :  byorgey@gmail.com
--
-- 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 (..),
  WinCondition (..),
  _NoWinCondition,
  _WinConditions,
  _Won,
  RunStatus (..),
  Seed,
  GameState,

  -- ** GameState fields
  creativeMode,
  winCondition,
  winSolution,
  runStatus,
  paused,
  robotMap,
  robotsByLocation,
  robotsAtLocation,
  robotsInArea,
  baseRobot,
  activeRobots,
  waitingRobots,
  availableRecipes,
  availableCommands,
  messageNotifications,
  allDiscoveredEntities,
  gensym,
  seed,
  randGen,
  adjList,
  nameList,
  entityMap,
  recipesOut,
  recipesIn,
  recipesReq,
  scenarios,
  currentScenarioPath,
  knownEntities,
  world,
  viewCenterRule,
  viewCenter,
  needsRedraw,
  replStatus,
  replNextValueIndex,
  replWorking,
  replActiveType,
  messageQueue,
  lastSeenMessageTime,
  focusedRobotID,
  ticks,
  robotStepsPerTick,

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

  -- ** GameState initialization
  initGameState,
  scenarioToGameState,
  initGameStateForScenario,
  classicGame0,
  CodeToRun (..),

  -- * Utilities
  applyViewCenterRule,
  recalcViewCenter,
  modifyViewCenter,
  viewingRegion,
  focusedRobot,
  clearFocusedRobotLogUpdated,
  addRobot,
  addTRobot,
  emitMessage,
  sleepUntil,
  sleepForever,
  wakeUpRobotsDoneSleeping,
  deleteRobot,
  activateRobot,
  toggleRunStatus,
  messageIsRecent,
  messageIsFromNearby,
) where

import Control.Algebra (Has)
import Control.Applicative ((<|>))
import Control.Arrow (Arrow ((&&&)))
import Control.Effect.Lens
import Control.Effect.State (State)
import Control.Lens hiding (Const, use, uses, view, (%=), (+=), (.=), (<+=), (<<.=))
import Control.Monad.Except
import Data.Aeson (FromJSON, ToJSON)
import Data.Array (Array, listArray)
import Data.Bifunctor (first)
import Data.Foldable (toList)
import Data.Int (Int64)
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, 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 (lines)
import Data.Text.IO qualified as T (readFile)
import Data.Time (getZonedTime)
import GHC.Generics (Generic)
import Linear
import Swarm.Game.CESK (emptyStore, initMachine)
import Swarm.Game.Entity
import Swarm.Game.Recipe (
  Recipe,
  inRecipeMap,
  loadRecipes,
  outRecipeMap,
  reqRecipeMap,
 )
import Swarm.Game.Robot
import Swarm.Game.ScenarioInfo
import Swarm.Game.Terrain (TerrainType (..))
import Swarm.Game.Value (Value)
import Swarm.Game.World (Coords (..), WorldFun (..), locToCoords, worldFunFromArray)
import Swarm.Game.World qualified as W
import Swarm.Game.WorldGen (Seed, findGoodOrigin, testWorld2FromArray)
import Swarm.Language.Capability (constCaps)
import Swarm.Language.Context qualified as Ctx
import Swarm.Language.Pipeline (ProcessedTerm)
import Swarm.Language.Pipeline.QQ (tmQ)
import Swarm.Language.Syntax (Const, Term (TText), allConst)
import Swarm.Language.Typed (Typed (Typed))
import Swarm.Language.Types
import Swarm.Util (getDataFileNameSafe, getElemsInArea, isRightOr, manhattan, uniq, (<+=), (<<.=), (?))
import System.Clock qualified as Clock
import System.Random (StdGen, mkStdGen, randomRIO)
import Witch (into)

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

data CodeToRun
  = SuggestedSolution ProcessedTerm
  | ScriptPath FilePath

-- | The 'ViewCenterRule' specifies how to determine the center of the
--   world viewport.
data ViewCenterRule
  = -- | The view should be centered on an absolute position.
    VCLocation (V2 Int64)
  | -- | 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.
    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 WinCondition
  = -- | There is no winning condition.
    NoWinCondition
  | -- | There are one or more objectives remaining that the player
    --   has not yet accomplished.
    WinConditions (NonEmpty Objective)
  | -- | The player has won. The boolean indicates whether they have
    --   already been congratulated.
    Won Bool
  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

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

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

-- | 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 -> WinCondition
_winCondition :: WinCondition
  , GameState -> Maybe ProcessedTerm
_winSolution :: Maybe ProcessedTerm
  , 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
    -- append to a list than to a Set.
    GameState -> Map Integer [RID]
_waitingRobots :: Map Integer [RID]
  , GameState -> Map (V2 Int64) IntSet
_robotsByLocation :: Map (V2 Int64) IntSet
  , 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 -> 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 -> ScenarioCollection
_scenarios :: ScenarioCollection
  , GameState -> Maybe String
_currentScenarioPath :: Maybe FilePath
  , GameState -> [Text]
_knownEntities :: [Text]
  , GameState -> World RID Entity
_world :: W.World Int Entity
  , GameState -> ViewCenterRule
_viewCenterRule :: ViewCenterRule
  , GameState -> V2 Int64
_viewCenter :: V2 Int64
  , GameState -> Bool
_needsRedraw :: Bool
  , GameState -> REPLStatus
_replStatus :: REPLStatus
  , GameState -> Integer
_replNextValueIndex :: Integer
  , GameState -> Seq LogEntry
_messageQueue :: Seq LogEntry
  , GameState -> Integer
_lastSeenMessageTime :: Integer
  , GameState -> RID
_focusedRobotID :: RID
  , GameState -> Integer
_ticks :: Integer
  , 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

let exclude = ['_viewCenter, '_focusedRobotID, '_viewCenterRule, '_activeRobots, '_waitingRobots, '_adjList, '_nameList]
 in makeLensesWith
      ( lensRules
          & generateSignatures .~ False
          & lensField . mapped . mapped %~ \fn n ->
            if n `elem` exclude then [] else fn n
      )
      ''GameState

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

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

-- | 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 name.
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 (V2 Int64) IntSet)

-- | Get a list of all the robots at a particular location.
robotsAtLocation :: V2 Int64 -> GameState -> [Robot]
robotsAtLocation :: V2 Int64 -> GameState -> [Robot]
robotsAtLocation V2 Int64
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 V2 Int64
loc
    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 (V2 Int64) IntSet)
robotsByLocation
    forall a b. (a -> b) -> a -> b
$ GameState
gs

-- | Get robots in manhattan distastance from location.
robotsInArea :: V2 Int64 -> Int64 -> GameState -> [Robot]
robotsInArea :: V2 Int64 -> Int64 -> GameState -> [Robot]
robotsInArea V2 Int64
o Int64
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 (V2 Int64) IntSet
rl = GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState (Map (V2 Int64) 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. V2 Int64 -> Int64 -> Map (V2 Int64) e -> [e]
getElemsInArea V2 Int64
o Int64
d Map (V2 Int64) 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 Integer [RID])
waitingRobots :: Getter GameState (Map Integer [RID])
waitingRobots = Lens' GameState (Map Integer [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

-- | 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 collection of scenarios that comes with the game.
scenarios :: Lens' GameState ScenarioCollection

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

-- | 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.
world :: Lens' GameState (W.World Int Entity)

-- | 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 (V2 Int64)
viewCenter :: Getter GameState (V2 Int64)
viewCenter = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> V2 Int64
_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

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

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

-- | 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 V2 Int64
v2 -> GameState
g {_viewCenterRule :: ViewCenterRule
_viewCenterRule = ViewCenterRule
rule, _viewCenter :: V2 Int64
_viewCenter = V2 Int64
v2}
      VCRobot RID
rid ->
        let robotcenter :: Maybe (V2 Int64)
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 (V2 Int64)
robotLocation
         in -- retrieve the loc of the robot if it exists, Nothing otherwise.
            -- sometimes, lenses are amazing...
            case Maybe (V2 Int64)
robotcenter of
              Maybe (V2 Int64)
Nothing -> GameState
g
              Just V2 Int64
v2 -> GameState
g {_viewCenterRule :: ViewCenterRule
_viewCenterRule = ViewCenterRule
rule, _viewCenter :: V2 Int64
_viewCenter = V2 Int64
v2, _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 Integer
leTime forall a. Ord a => a -> a -> Bool
> GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState Integer
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 = V2 Int64 -> LogEntry -> Bool
messageIsFromNearby (GameState
gs forall s a. s -> Getting a s a -> a
^. Getter GameState (V2 Int64)
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 = LogEntry
e forall s a. s -> Getting a s a -> a
^. Lens' LogEntry Integer
leTime forall a. Ord a => a -> a -> Bool
>= GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState Integer
ticks forall a. Num a => a -> a -> a
- Integer
1

messageIsFromNearby :: V2 Int64 -> LogEntry -> Bool
messageIsFromNearby :: V2 Int64 -> LogEntry -> Bool
messageIsFromNearby V2 Int64
l LogEntry
e = V2 Int64 -> V2 Int64 -> Int64
manhattan V2 Int64
l (LogEntry
e forall s a. s -> Getting a s a -> a
^. Lens' LogEntry (V2 Int64)
leLocation) 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 (V2 Int64)
applyViewCenterRule :: ViewCenterRule -> IntMap Robot -> Maybe (V2 Int64)
applyViewCenterRule (VCLocation V2 Int64
l) IntMap Robot
_ = forall a. a -> Maybe a
Just V2 Int64
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 (V2 Int64)
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 :: V2 Int64
_viewCenter = V2 Int64
newViewCenter
    }
    forall a b. a -> (a -> b) -> b
& (if V2 Int64
newViewCenter forall a. Eq a => a -> a -> Bool
/= V2 Int64
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 :: V2 Int64
oldViewCenter = GameState
g forall s a. s -> Getting a s a -> a
^. Getter GameState (V2 Int64)
viewCenter
  newViewCenter :: V2 Int64
newViewCenter = forall a. a -> Maybe a -> a
fromMaybe V2 Int64
oldViewCenter (ViewCenterRule -> IntMap Robot -> Maybe (V2 Int64)
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 :: (V2 Int64 -> V2 Int64) -> GameState -> GameState
modifyViewCenter :: (V2 Int64 -> V2 Int64) -> GameState -> GameState
modifyViewCenter V2 Int64 -> V2 Int64
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 V2 Int64
l -> Lens' GameState ViewCenterRule
viewCenterRule forall s t a b. ASetter s t a b -> b -> s -> t
.~ V2 Int64 -> ViewCenterRule
VCLocation (V2 Int64 -> V2 Int64
update V2 Int64
l)
      VCRobot RID
_ -> Lens' GameState ViewCenterRule
viewCenterRule forall s t a b. ASetter s t a b -> b -> s -> t
.~ V2 Int64 -> ViewCenterRule
VCLocation (V2 Int64 -> V2 Int64
update (GameState
g forall s a. s -> Getting a s a -> a
^. Getter GameState (V2 Int64)
viewCenter))

-- | Given a width and height, compute the region, centered on the
--   'viewCenter', that should currently be in view.
viewingRegion :: GameState -> (Int64, Int64) -> (W.Coords, W.Coords)
viewingRegion :: GameState -> (Int64, Int64) -> (Coords, Coords)
viewingRegion GameState
g (Int64
w, Int64
h) = ((Int64, Int64) -> Coords
W.Coords (Int64
rmin, Int64
cmin), (Int64, Int64) -> Coords
W.Coords (Int64
rmax, Int64
cmax))
 where
  V2 Int64
cx Int64
cy = GameState
g forall s a. s -> Getting a s a -> a
^. Getter GameState (V2 Int64)
viewCenter
  (Int64
rmin, Int64
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
+ (-Int64
cy forall a. Num a => a -> a -> a
- Int64
h forall a. Integral a => a -> a -> a
`div` Int64
2)) (Int64
0, Int64
h forall a. Num a => a -> a -> a
- Int64
1)
  (Int64
cmin, Int64
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
+ (Int64
cx forall a. Num a => a -> a -> a
- Int64
w forall a. Integral a => a -> a -> a
`div` Int64
2)) (Int64
0, Int64
w forall a. Num a => a -> a -> a
- Int64
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)

-- | 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
  Lens' GameState (Map (V2 Int64) 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 IntSet -> IntSet -> IntSet
IS.union (Robot
r forall s a. s -> Getting a s a -> a
^. Getter Robot (V2 Int64)
robotLocation) (RID -> IntSet
IS.singleton 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

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 -> Integer -> m ()
sleepUntil :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> Integer -> m ()
sleepUntil RID
rid Integer
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 Integer [RID])
internalWaitingRobots forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Integer
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
  Integer
time <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Integer
ticks
  Maybe [RID]
mrids <- Lens' GameState (Map Integer [RID])
internalWaitingRobots forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Integer
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)

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.
    Lens' GameState (Map (V2 Int64) IntSet)
robotsByLocation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Robot
robot forall s a. s -> Getting a s a -> a
^. Getter Robot (V2 Int64)
robotLocation) 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

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

-- | Create an initial game state record, first loading entities and
--   recipies from disk.
initGameState :: ExceptT Text IO GameState
initGameState :: ExceptT Text IO GameState
initGameState = do
  let guardRight :: e -> Either e a -> m a
guardRight e
what Either e a
i = Either e a
i forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) b a.
Has (Throw e) sig m =>
Either b a -> (b -> e) -> m a
`isRightOr` (\e
e -> e
"Failed to " forall a. Semigroup a => a -> a -> a
<> e
what forall a. Semigroup a => a -> a -> a
<> e
": " forall a. Semigroup a => a -> a -> a
<> e
e)
  EntityMap
entities <- forall (m :: * -> *). MonadIO m => m (Either Text EntityMap)
loadEntities forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {e} {sig :: (* -> *) -> * -> *} {m :: * -> *} {a}.
(Member (Throw e) sig, Algebra sig m, Semigroup e, IsString e) =>
e -> Either e a -> m a
guardRight Text
"load entities"
  [Recipe Entity]
recipes <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Lift IO) sig m =>
EntityMap -> m (Either Text [Recipe Entity])
loadRecipes EntityMap
entities forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {e} {sig :: (* -> *) -> * -> *} {m :: * -> *} {a}.
(Member (Throw e) sig, Algebra sig m, Semigroup e, IsString e) =>
e -> Either e a -> m a
guardRight Text
"load recipes"
  ScenarioCollection
loadedScenarios <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Lift IO) sig m =>
EntityMap -> m (Either Text ScenarioCollection)
loadScenarios EntityMap
entities forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {e} {sig :: (* -> *) -> * -> *} {m :: * -> *} {a}.
(Member (Throw e) sig, Algebra sig m, Semigroup e, IsString e) =>
e -> Either e a -> m a
guardRight Text
"load scenarios"

  let markEx :: String -> m a -> m a
markEx String
what m a
a = forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError m a
a (\a
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Failed to " forall a. Semigroup a => a -> a -> a
<> String
what forall a. Semigroup a => a -> a -> a
<> String
": " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
e)

  ([Text]
adjs, [Text]
names) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {m :: * -> *} {a}.
(MonadError a m, MonadFail m, Show a) =>
String -> m a -> m a
markEx String
"load name generation data" forall a b. (a -> b) -> a -> b
$ do
    -- if data directory did not exist we would have failed loading scenarios
    Just String
adjsFile <- String -> IO (Maybe String)
getDataFileNameSafe String
"adjectives.txt"
    [Text]
as <- forall a. [a] -> [a]
tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
T.readFile String
adjsFile
    Just String
namesFile <- String -> IO (Maybe String)
getDataFileNameSafe String
"names.txt"
    [Text]
ns <- forall a. [a] -> [a]
tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
T.readFile String
namesFile
    forall (m :: * -> *) a. Monad m => a -> m a
return ([Text]
as, [Text]
ns)

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    GameState
      { _creativeMode :: Bool
_creativeMode = Bool
False
      , _winCondition :: WinCondition
_winCondition = WinCondition
NoWinCondition
      , _winSolution :: Maybe ProcessedTerm
_winSolution = forall a. Maybe a
Nothing
      , _runStatus :: RunStatus
_runStatus = RunStatus
Running
      , _robotMap :: IntMap Robot
_robotMap = forall a. IntMap a
IM.empty
      , _robotsByLocation :: Map (V2 Int64) IntSet
_robotsByLocation = forall k a. Map k a
M.empty
      , _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 Integer [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 = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (RID
0, forall (t :: * -> *) a. Foldable t => t a -> RID
length [Text]
adjs forall a. Num a => a -> a -> a
- RID
1) [Text]
adjs
      , _nameList :: Array RID Text
_nameList = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (RID
0, forall (t :: * -> *) a. Foldable t => t a -> RID
length [Text]
names forall a. Num a => a -> a -> a
- RID
1) [Text]
names
      , _entityMap :: EntityMap
_entityMap = EntityMap
entities
      , _recipesOut :: IntMap [Recipe Entity]
_recipesOut = [Recipe Entity] -> IntMap [Recipe Entity]
outRecipeMap [Recipe Entity]
recipes
      , _recipesIn :: IntMap [Recipe Entity]
_recipesIn = [Recipe Entity] -> IntMap [Recipe Entity]
inRecipeMap [Recipe Entity]
recipes
      , _recipesReq :: IntMap [Recipe Entity]
_recipesReq = [Recipe Entity] -> IntMap [Recipe Entity]
reqRecipeMap [Recipe Entity]
recipes
      , _scenarios :: ScenarioCollection
_scenarios = ScenarioCollection
loadedScenarios
      , _currentScenarioPath :: Maybe String
_currentScenarioPath = forall a. Maybe a
Nothing
      , _knownEntities :: [Text]
_knownEntities = []
      , _world :: World RID Entity
_world = forall t e. t -> World t e
W.emptyWorld (forall a. Enum a => a -> RID
fromEnum TerrainType
StoneT)
      , _viewCenterRule :: ViewCenterRule
_viewCenterRule = RID -> ViewCenterRule
VCRobot RID
0
      , _viewCenter :: V2 Int64
_viewCenter = forall a. a -> a -> V2 a
V2 Int64
0 Int64
0
      , _needsRedraw :: Bool
_needsRedraw = Bool
False
      , _replStatus :: REPLStatus
_replStatus = Maybe (Typed Value) -> REPLStatus
REPLDone forall a. Maybe a
Nothing
      , _replNextValueIndex :: Integer
_replNextValueIndex = Integer
0
      , _messageQueue :: Seq LogEntry
_messageQueue = forall s. AsEmpty s => s
Empty
      , _lastSeenMessageTime :: Integer
_lastSeenMessageTime = -Integer
1
      , _focusedRobotID :: RID
_focusedRobotID = RID
0
      , _ticks :: Integer
_ticks = Integer
0
      , _robotStepsPerTick :: RID
_robotStepsPerTick = RID
defaultRobotStepsPerTick
      }

-- | Set a given scenario as the currently loaded scenario in the game state.
scenarioToGameState :: Scenario -> Maybe Seed -> Maybe CodeToRun -> GameState -> IO GameState
scenarioToGameState :: Scenario
-> Maybe RID -> Maybe CodeToRun -> GameState -> IO GameState
scenarioToGameState Scenario
scenario Maybe RID
userSeed Maybe CodeToRun
toRun GameState
g = 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
$
    GameState
g
      { _creativeMode :: Bool
_creativeMode = Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario Bool
scenarioCreative
      , _winCondition :: WinCondition
_winCondition = WinCondition
theWinCondition
      , _winSolution :: Maybe ProcessedTerm
_winSolution = Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario (Maybe ProcessedTerm)
scenarioSolution
      , _runStatus :: RunStatus
_runStatus = RunStatus
Running
      , _robotMap :: IntMap Robot
_robotMap = forall a. [(RID, a)] -> IntMap a
IM.fromList forall a b. (a -> b) -> a -> b
$ 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'
      , _robotsByLocation :: Map (V2 Int64) IntSet
_robotsByLocation =
          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
$
            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 (V2 Int64)
robotLocation 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)) [Robot]
robotList'
      , _activeRobots :: IntSet
_activeRobots = 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'
      , _availableCommands :: Notifications Const
_availableCommands = forall a. RID -> [a] -> Notifications a
Notifications RID
0 [Const]
initialCommands
      , _waitingRobots :: Map Integer [RID]
_waitingRobots = forall k a. Map k a
M.empty
      , _gensym :: RID
_gensym = RID
initGensym
      , _seed :: RID
_seed = RID
theSeed
      , _randGen :: StdGen
_randGen = RID -> StdGen
mkStdGen RID
theSeed
      , _entityMap :: EntityMap
_entityMap = EntityMap
em
      , _recipesOut :: IntMap [Recipe Entity]
_recipesOut = forall {a}.
Semigroup a =>
([Recipe Entity] -> IntMap a)
-> Getting (IntMap a) GameState (IntMap a) -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap [Recipe Entity]
outRecipeMap Lens' GameState (IntMap [Recipe Entity])
recipesOut
      , _recipesIn :: IntMap [Recipe Entity]
_recipesIn = forall {a}.
Semigroup a =>
([Recipe Entity] -> IntMap a)
-> Getting (IntMap a) GameState (IntMap a) -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap [Recipe Entity]
inRecipeMap Lens' GameState (IntMap [Recipe Entity])
recipesIn
      , _recipesReq :: IntMap [Recipe Entity]
_recipesReq = forall {a}.
Semigroup a =>
([Recipe Entity] -> IntMap a)
-> Getting (IntMap a) GameState (IntMap a) -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap [Recipe Entity]
reqRecipeMap Lens' GameState (IntMap [Recipe Entity])
recipesReq
      , _knownEntities :: [Text]
_knownEntities = Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario [Text]
scenarioKnown
      , _world :: World RID Entity
_world = RID -> World RID Entity
theWorld RID
theSeed
      , _viewCenterRule :: ViewCenterRule
_viewCenterRule = RID -> ViewCenterRule
VCRobot RID
baseID
      , _viewCenter :: V2 Int64
_viewCenter = forall a. a -> a -> V2 a
V2 Int64
0 Int64
0
      , _needsRedraw :: Bool
_needsRedraw = Bool
False
      , -- When starting base with the run flag, REPL status must be set to working,
        -- otherwise the store of definition cells is not saved (see #333)
        _replStatus :: REPLStatus
_replStatus = case Maybe CodeToRun
toRun of
          Maybe CodeToRun
Nothing -> Maybe (Typed Value) -> REPLStatus
REPLDone forall a. Maybe a
Nothing
          Just CodeToRun
_ -> 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)
      , _replNextValueIndex :: Integer
_replNextValueIndex = Integer
0
      , _messageQueue :: Seq LogEntry
_messageQueue = forall s. AsEmpty s => s
Empty
      , _focusedRobotID :: RID
_focusedRobotID = RID
baseID
      , _ticks :: Integer
_ticks = Integer
0
      , _robotStepsPerTick :: RID
_robotStepsPerTick = (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
  em :: EntityMap
em = GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState EntityMap
entityMap 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 [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 (V2 Int64))
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
x = case CodeToRun
x of
    SuggestedSolution ProcessedTerm
s -> ProcessedTerm
s
    ScriptPath (forall target source. From source target => source -> target
into @Text -> Text
f) -> [tmQ| run($str:f) |]

  -- 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 closest to the upper-left of the screen, with higher rows given precedence over columns.
  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 [IndexedTRobot]
genRobots)

  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.
      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 CodeToRun -> ProcessedTerm
getCodeToRun forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CodeToRun
toRun 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
installedDevices
        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)

  -- Initial list of available commands = all commands enabled by
  -- devices in inventory or installed; 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
installedDevices)
      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

  ([IndexedTRobot]
genRobots, RID -> WorldFun RID Entity
wf) = EntityMap
-> WorldDescription
-> ([IndexedTRobot], RID -> WorldFun RID Entity)
buildWorld EntityMap
em (Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario WorldDescription
scenarioWorld)
  theWorld :: RID -> World RID Entity
theWorld = forall t e. WorldFun t e -> World t e
W.newWorld forall b c a. (b -> c) -> (a -> b) -> a -> c
. RID -> WorldFun RID Entity
wf
  theWinCondition :: WinCondition
theWinCondition = forall b a. b -> (a -> b) -> Maybe a -> b
maybe WinCondition
NoWinCondition NonEmpty Objective -> WinCondition
WinConditions (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)
-> Getting (IntMap a) GameState (IntMap a) -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap a
f Getting (IntMap a) GameState (IntMap a)
gRs = 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) (GameState
g forall s a. s -> Getting a s a -> a
^. Getting (IntMap a) GameState (IntMap a)
gRs)

-- | Take a world description, parsed from a scenario file, and turn
--   it into a list of located robots and a world function.
buildWorld :: EntityMap -> WorldDescription -> ([IndexedTRobot], Seed -> WorldFun Int Entity)
buildWorld :: EntityMap
-> WorldDescription
-> ([IndexedTRobot], RID -> WorldFun RID Entity)
buildWorld EntityMap
em WorldDescription {Bool
[[Cell]]
Maybe Cell
V2 Int64
WorldPalette
area :: WorldDescription -> [[Cell]]
ul :: WorldDescription -> V2 Int64
palette :: WorldDescription -> WorldPalette
offsetOrigin :: WorldDescription -> Bool
defaultTerrain :: WorldDescription -> Maybe Cell
area :: [[Cell]]
ul :: V2 Int64
palette :: WorldPalette
offsetOrigin :: Bool
defaultTerrain :: Maybe Cell
..} = ([IndexedTRobot]
robots, 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 :: Int64
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 [[Cell]]
area
  cs :: Int64
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 [[Cell]]
area)
  Coords (Int64
ulr, Int64
ulc) = V2 Int64 -> Coords
locToCoords V2 Int64
ul

  worldGrid :: [[(TerrainType, Maybe Entity)]]
  worldGrid :: [[(TerrainType, Maybe 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) (Cell -> TerrainType
cellTerrain forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Cell -> Maybe Entity
cellEntity) [[Cell]]
area

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

  wf :: RID -> WorldFun TerrainType Entity
wf = case Maybe Cell
defaultTerrain of
    Maybe Cell
Nothing ->
      (if Bool
offsetOrigin then forall t. WorldFun t Entity -> WorldFun t Entity
findGoodOrigin else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityMap
-> Array (Int64, Int64) (TerrainType, Maybe Entity)
-> RID
-> WorldFun TerrainType Entity
testWorld2FromArray EntityMap
em Array (Int64, Int64) (TerrainType, Maybe Entity)
worldArray
    Just (Cell TerrainType
t Maybe Entity
e [IndexedTRobot]
_) -> forall a b. a -> b -> a
const (forall t e.
Array (Int64, Int64) (t, Maybe e) -> (t, Maybe e) -> WorldFun t e
worldFunFromArray Array (Int64, Int64) (TerrainType, Maybe Entity)
worldArray (TerrainType
t, Maybe Entity
e))

  -- Get all the robots described in cells and set their locations appropriately
  robots :: [IndexedTRobot]
  robots :: [IndexedTRobot]
robots =
    [[Cell]]
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 -> Int64
r, forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int64
c), Cell TerrainType
_ Maybe Entity
_ [IndexedTRobot]
robotList) ->
            let robotWithLoc :: TRobot -> TRobot
robotWithLoc = Lens' TRobot (Maybe (V2 Int64))
trobotLocation forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Coords -> V2 Int64
W.coordsToLoc ((Int64, Int64) -> Coords
Coords (Int64
ulr forall a. Num a => a -> a -> a
+ Int64
r, Int64
ulc forall a. Num a => a -> a -> a
+ Int64
c))
             in forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TRobot -> TRobot
robotWithLoc) [IndexedTRobot]
robotList
        )

-- | Create an initial game state for a specific scenario.
-- Note that this function is used only for unit tests, integration tests, and benchmarks.
--
-- In normal play, the code path that gets executed is scenarioToAppState.
initGameStateForScenario :: String -> Maybe Seed -> Maybe FilePath -> ExceptT Text IO GameState
initGameStateForScenario :: String -> Maybe RID -> Maybe String -> ExceptT Text IO GameState
initGameStateForScenario String
sceneName Maybe RID
userSeed Maybe String
toRun = do
  GameState
g <- ExceptT Text IO GameState
initGameState
  (Scenario
scene, String
path) <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Lift IO) sig m, Has (Throw Text) sig m) =>
String -> EntityMap -> m (Scenario, String)
loadScenario String
sceneName (GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState EntityMap
entityMap)
  GameState
gs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Scenario
-> Maybe RID -> Maybe CodeToRun -> GameState -> IO GameState
scenarioToGameState Scenario
scene Maybe RID
userSeed (String -> CodeToRun
ScriptPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
toRun) GameState
g
  String
normalPath <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ScenarioCollection -> String -> IO String
normalizeScenarioPath (GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState ScenarioCollection
scenarios) String
path
  ZonedTime
t <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ZonedTime
getZonedTime
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    GameState
gs
      forall a b. a -> (a -> b) -> b
& Lens' GameState (Maybe String)
currentScenarioPath forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ String
normalPath
      forall a b. a -> (a -> b) -> b
& Lens' GameState ScenarioCollection
scenarios forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Traversal' ScenarioCollection ScenarioItem
scenarioItemByPath String
normalPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' ScenarioItem ScenarioInfoPair
_SISingle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ScenarioInfo ScenarioStatus
scenarioStatus forall s t a b. ASetter s t a b -> b -> s -> t
.~ ZonedTime -> NominalDiffTime -> Integer -> ScenarioStatus
InProgress ZonedTime
t NominalDiffTime
0 Integer
0

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