{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
module Swarm.Game.State (
ViewCenterRule (..),
REPLStatus (..),
WinStatus (..),
WinCondition (..),
ObjectiveCompletion (..),
_NoWinCondition,
_WinConditions,
Announcement (..),
RunStatus (..),
Seed,
Step (..),
SingleStep (..),
GameState,
creativeMode,
gameStep,
winCondition,
winSolution,
gameAchievements,
announcementQueue,
runStatus,
paused,
robotMap,
robotsByLocation,
robotsAtLocation,
robotsWatching,
robotsInArea,
baseRobot,
activeRobots,
waitingRobots,
availableRecipes,
availableCommands,
messageNotifications,
allDiscoveredEntities,
gensym,
seed,
randGen,
adjList,
nameList,
initiallyRunCode,
entityMap,
recipesOut,
recipesIn,
recipesReq,
currentScenarioPath,
knownEntities,
worldNavigation,
multiWorld,
worldScrollable,
viewCenterRule,
viewCenter,
needsRedraw,
replStatus,
replNextValueIndex,
replWorking,
replActiveType,
inputHandler,
messageQueue,
lastSeenMessageTime,
focusedRobotID,
ticks,
robotStepsPerTick,
Notifications (..),
notificationsCount,
notificationsContent,
LaunchParams,
ValidatedLaunchParams,
GameStateConfig (..),
initGameState,
scenarioToGameState,
CodeToRun (..),
Sha1 (..),
SolutionSource (..),
parseCodeFile,
applyViewCenterRule,
recalcViewCenter,
modifyViewCenter,
viewingRegion,
unfocus,
focusedRobot,
RobotRange (..),
focusedRange,
clearFocusedRobotLogUpdated,
addRobot,
addRobotToLocation,
addTRobot,
emitMessage,
wakeWatchingRobots,
sleepUntil,
sleepForever,
wakeUpRobotsDoneSleeping,
deleteRobot,
removeRobotFromLocationMap,
activateRobot,
toggleRunStatus,
messageIsRecent,
messageIsFromNearby,
getRunCodePath,
) where
import Control.Applicative ((<|>))
import Control.Arrow (Arrow ((&&&)))
import Control.Effect.Lens
import Control.Effect.Lift
import Control.Effect.State (State)
import Control.Effect.Throw
import Control.Lens hiding (Const, use, uses, view, (%=), (+=), (.=), (<+=), (<<.=))
import Control.Monad (forM_)
import Data.Aeson (FromJSON, ToJSON)
import Data.Array (Array, listArray)
import Data.Bifunctor (first)
import Data.Digest.Pure.SHA (sha1, showDigest)
import Data.Foldable (toList)
import Data.Int (Int32)
import Data.IntMap (IntMap)
import Data.IntMap qualified as IM
import Data.IntSet (IntSet)
import Data.IntSet qualified as IS
import Data.IntSet.Lens (setOf)
import Data.List (partition, sortOn)
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NE
import Data.Map (Map)
import Data.Map qualified as M
import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
import Data.Sequence (Seq ((:<|)))
import Data.Sequence qualified as Seq
import Data.Set qualified as S
import Data.Text (Text)
import Data.Text qualified as T (drop, take)
import Data.Text.IO qualified as TIO
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Encoding qualified as TL
import Data.Tuple (swap)
import GHC.Generics (Generic)
import Servant.Docs (ToSample)
import Servant.Docs qualified as SD
import Swarm.Game.Achievement.Attainment
import Swarm.Game.Achievement.Definitions
import Swarm.Game.CESK (CESK (Waiting), TickNumber (..), addTicks, emptyStore, finalValue, initMachine)
import Swarm.Game.Entity
import Swarm.Game.Failure (SystemFailure (..))
import Swarm.Game.Location
import Swarm.Game.Recipe (
Recipe,
inRecipeMap,
outRecipeMap,
reqRecipeMap,
)
import Swarm.Game.Robot
import Swarm.Game.Scenario.Objective
import Swarm.Game.Scenario.Status
import Swarm.Game.Scenario.Topography.Navigation.Portal (Navigation (..))
import Swarm.Game.ScenarioInfo
import Swarm.Game.Terrain (TerrainType (..))
import Swarm.Game.Universe as U
import Swarm.Game.World (Coords (..), WorldFun (..), locToCoords, worldFunFromArray)
import Swarm.Game.World qualified as W
import Swarm.Game.World.Eval (runWorld)
import Swarm.Game.World.Gen (Seed, findGoodOrigin)
import Swarm.Game.World.Typecheck (WorldMap)
import Swarm.Language.Capability (constCaps)
import Swarm.Language.Context qualified as Ctx
import Swarm.Language.Module (Module (Module))
import Swarm.Language.Pipeline (ProcessedTerm (ProcessedTerm), processTermEither)
import Swarm.Language.Syntax (Const, SrcLoc (..), Syntax' (..), allConst)
import Swarm.Language.Typed (Typed (Typed))
import Swarm.Language.Types
import Swarm.Language.Value (Value)
import Swarm.Util (applyWhen, binTuples, surfaceEmpty, uniq, (<+=), (<<.=), (?))
import Swarm.Util.Erasable
import Swarm.Util.Lens (makeLensesExcluding)
import System.Clock qualified as Clock
import System.Random (StdGen, mkStdGen, randomRIO)
data ViewCenterRule
=
VCLocation (Cosmic Location)
|
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
data REPLStatus
=
REPLDone (Maybe (Typed Value))
|
REPLWorking (Typed (Maybe Value))
deriving (REPLStatus -> REPLStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: REPLStatus -> REPLStatus -> Bool
$c/= :: REPLStatus -> REPLStatus -> Bool
== :: REPLStatus -> REPLStatus -> Bool
$c== :: REPLStatus -> REPLStatus -> Bool
Eq, RID -> REPLStatus -> ShowS
[REPLStatus] -> ShowS
REPLStatus -> String
forall a.
(RID -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [REPLStatus] -> ShowS
$cshowList :: [REPLStatus] -> ShowS
show :: REPLStatus -> String
$cshow :: REPLStatus -> String
showsPrec :: RID -> REPLStatus -> ShowS
$cshowsPrec :: RID -> REPLStatus -> ShowS
Show, forall x. Rep REPLStatus x -> REPLStatus
forall x. REPLStatus -> Rep REPLStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep REPLStatus x -> REPLStatus
$cfrom :: forall x. REPLStatus -> Rep REPLStatus x
Generic, Value -> Parser [REPLStatus]
Value -> Parser REPLStatus
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [REPLStatus]
$cparseJSONList :: Value -> Parser [REPLStatus]
parseJSON :: Value -> Parser REPLStatus
$cparseJSON :: Value -> Parser REPLStatus
FromJSON, [REPLStatus] -> Encoding
[REPLStatus] -> Value
REPLStatus -> Encoding
REPLStatus -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [REPLStatus] -> Encoding
$ctoEncodingList :: [REPLStatus] -> Encoding
toJSONList :: [REPLStatus] -> Value
$ctoJSONList :: [REPLStatus] -> Value
toEncoding :: REPLStatus -> Encoding
$ctoEncoding :: REPLStatus -> Encoding
toJSON :: REPLStatus -> Value
$ctoJSON :: REPLStatus -> Value
ToJSON)
data WinStatus
=
Ongoing
|
Won Bool
|
Unwinnable Bool
deriving (RID -> WinStatus -> ShowS
[WinStatus] -> ShowS
WinStatus -> String
forall a.
(RID -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WinStatus] -> ShowS
$cshowList :: [WinStatus] -> ShowS
show :: WinStatus -> String
$cshow :: WinStatus -> String
showsPrec :: RID -> WinStatus -> ShowS
$cshowsPrec :: RID -> WinStatus -> ShowS
Show, forall x. Rep WinStatus x -> WinStatus
forall x. WinStatus -> Rep WinStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WinStatus x -> WinStatus
$cfrom :: forall x. WinStatus -> Rep WinStatus x
Generic, Value -> Parser [WinStatus]
Value -> Parser WinStatus
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [WinStatus]
$cparseJSONList :: Value -> Parser [WinStatus]
parseJSON :: Value -> Parser WinStatus
$cparseJSON :: Value -> Parser WinStatus
FromJSON, [WinStatus] -> Encoding
[WinStatus] -> Value
WinStatus -> Encoding
WinStatus -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [WinStatus] -> Encoding
$ctoEncodingList :: [WinStatus] -> Encoding
toJSONList :: [WinStatus] -> Value
$ctoJSONList :: [WinStatus] -> Value
toEncoding :: WinStatus -> Encoding
$ctoEncoding :: WinStatus -> Encoding
toJSON :: WinStatus -> Value
$ctoJSON :: WinStatus -> Value
ToJSON)
data WinCondition
=
NoWinCondition
|
WinConditions WinStatus ObjectiveCompletion
deriving (RID -> WinCondition -> ShowS
[WinCondition] -> ShowS
WinCondition -> String
forall a.
(RID -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WinCondition] -> ShowS
$cshowList :: [WinCondition] -> ShowS
show :: WinCondition -> String
$cshow :: WinCondition -> String
showsPrec :: RID -> WinCondition -> ShowS
$cshowsPrec :: RID -> WinCondition -> ShowS
Show, forall x. Rep WinCondition x -> WinCondition
forall x. WinCondition -> Rep WinCondition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WinCondition x -> WinCondition
$cfrom :: forall x. WinCondition -> Rep WinCondition x
Generic, Value -> Parser [WinCondition]
Value -> Parser WinCondition
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [WinCondition]
$cparseJSONList :: Value -> Parser [WinCondition]
parseJSON :: Value -> Parser WinCondition
$cparseJSON :: Value -> Parser WinCondition
FromJSON, [WinCondition] -> Encoding
[WinCondition] -> Value
WinCondition -> Encoding
WinCondition -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [WinCondition] -> Encoding
$ctoEncodingList :: [WinCondition] -> Encoding
toJSONList :: [WinCondition] -> Value
$ctoJSONList :: [WinCondition] -> Value
toEncoding :: WinCondition -> Encoding
$ctoEncoding :: WinCondition -> Encoding
toJSON :: WinCondition -> Value
$ctoJSON :: WinCondition -> Value
ToJSON)
makePrisms ''WinCondition
instance ToSample WinCondition where
toSamples :: Proxy WinCondition -> [(Text, WinCondition)]
toSamples Proxy WinCondition
_ = forall a. [(Text, a)]
SD.noSamples
data RunStatus
=
Running
|
ManualPause
|
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)
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
data Notifications a = Notifications
{ forall a. Notifications a -> RID
_notificationsCount :: Int
, forall a. Notifications a -> [a]
_notificationsContent :: [a]
}
deriving (Notifications a -> Notifications a -> Bool
forall a. Eq a => Notifications a -> Notifications a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Notifications a -> Notifications a -> Bool
$c/= :: forall a. Eq a => Notifications a -> Notifications a -> Bool
== :: Notifications a -> Notifications a -> Bool
$c== :: forall a. Eq a => Notifications a -> Notifications a -> Bool
Eq, RID -> Notifications a -> ShowS
forall a. Show a => RID -> Notifications a -> ShowS
forall a. Show a => [Notifications a] -> ShowS
forall a. Show a => Notifications a -> String
forall a.
(RID -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Notifications a] -> ShowS
$cshowList :: forall a. Show a => [Notifications a] -> ShowS
show :: Notifications a -> String
$cshow :: forall a. Show a => Notifications a -> String
showsPrec :: RID -> Notifications a -> ShowS
$cshowsPrec :: forall a. Show a => RID -> Notifications a -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Notifications a) x -> Notifications a
forall a x. Notifications a -> Rep (Notifications a) x
$cto :: forall a x. Rep (Notifications a) x -> Notifications a
$cfrom :: forall a x. Notifications a -> Rep (Notifications a) x
Generic, forall a. FromJSON a => Value -> Parser [Notifications a]
forall a. FromJSON a => Value -> Parser (Notifications a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Notifications a]
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [Notifications a]
parseJSON :: Value -> Parser (Notifications a)
$cparseJSON :: forall a. FromJSON a => Value -> Parser (Notifications a)
FromJSON, forall a. ToJSON a => [Notifications a] -> Encoding
forall a. ToJSON a => [Notifications a] -> Value
forall a. ToJSON a => Notifications a -> Encoding
forall a. ToJSON a => Notifications a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Notifications a] -> Encoding
$ctoEncodingList :: forall a. ToJSON a => [Notifications a] -> Encoding
toJSONList :: [Notifications a] -> Value
$ctoJSONList :: forall a. ToJSON a => [Notifications a] -> Value
toEncoding :: Notifications a -> Encoding
$ctoEncoding :: forall a. ToJSON a => Notifications a -> Encoding
toJSON :: Notifications a -> Value
$ctoJSON :: forall a. ToJSON a => Notifications a -> Value
ToJSON)
instance Semigroup (Notifications a) where
Notifications RID
count1 [a]
xs1 <> :: Notifications a -> Notifications a -> Notifications a
<> Notifications RID
count2 [a]
xs2 = forall a. RID -> [a] -> Notifications a
Notifications (RID
count1 forall a. Num a => a -> a -> a
+ RID
count2) ([a]
xs1 forall a. Semigroup a => a -> a -> a
<> [a]
xs2)
instance Monoid (Notifications a) where
mempty :: Notifications a
mempty = forall a. RID -> [a] -> Notifications a
Notifications RID
0 []
makeLenses ''Notifications
newtype Sha1 = Sha1 String
data SolutionSource
= ScenarioSuggested
|
PlayerAuthored FilePath Sha1
data CodeToRun = CodeToRun SolutionSource ProcessedTerm
getRunCodePath :: CodeToRun -> Maybe FilePath
getRunCodePath :: CodeToRun -> Maybe String
getRunCodePath (CodeToRun SolutionSource
solutionSource ProcessedTerm
_) = case SolutionSource
solutionSource of
SolutionSource
ScenarioSuggested -> forall a. Maybe a
Nothing
PlayerAuthored String
fp Sha1
_ -> forall a. a -> Maybe a
Just String
fp
parseCodeFile ::
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
FilePath ->
m CodeToRun
parseCodeFile :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Throw SystemFailure) sig m, Has (Lift IO) sig m) =>
String -> m CodeToRun
parseCodeFile String
filepath = do
Text
contents <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ String -> IO Text
TIO.readFile String
filepath
pt :: ProcessedTerm
pt@(ProcessedTerm (Module (Syntax' SrcLoc
srcLoc Term' Polytype
_ Polytype
_) Ctx Polytype
_) Requirements
_ ReqCtx
_) <-
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SystemFailure
CustomFailure) forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Either Text ProcessedTerm
processTermEither Text
contents)
let strippedText :: Text
strippedText = SrcLoc -> Text -> Text
stripSrc SrcLoc
srcLoc Text
contents
programBytestring :: ByteString
programBytestring = Text -> ByteString
TL.encodeUtf8 forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.fromStrict Text
strippedText
sha1Hash :: String
sha1Hash = forall t. Digest t -> String
showDigest forall a b. (a -> b) -> a -> b
$ ByteString -> Digest SHA1State
sha1 ByteString
programBytestring
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SolutionSource -> ProcessedTerm -> CodeToRun
CodeToRun (String -> Sha1 -> SolutionSource
PlayerAuthored String
filepath forall a b. (a -> b) -> a -> b
$ String -> Sha1
Sha1 String
sha1Hash) ProcessedTerm
pt
where
stripSrc :: SrcLoc -> Text -> Text
stripSrc :: SrcLoc -> Text -> Text
stripSrc (SrcLoc RID
start RID
end) Text
txt = RID -> Text -> Text
T.drop RID
start forall a b. (a -> b) -> a -> b
$ RID -> Text -> Text
T.take RID
end Text
txt
stripSrc SrcLoc
NoLoc Text
txt = Text
txt
defaultRobotStepsPerTick :: Int
defaultRobotStepsPerTick :: RID
defaultRobotStepsPerTick = RID
100
data SingleStep
=
SBefore
|
SSingle RID
|
SAfter RID
data Step = WorldTick | RobotStep SingleStep
data GameState = GameState
{ GameState -> Bool
_creativeMode :: Bool
, GameState -> Step
_gameStep :: Step
, GameState -> WinCondition
_winCondition :: WinCondition
, GameState -> Maybe ProcessedTerm
_winSolution :: Maybe ProcessedTerm
, GameState -> Map GameplayAchievement Attainment
_gameAchievements :: Map GameplayAchievement Attainment
, GameState -> Seq Announcement
_announcementQueue :: Seq Announcement
, GameState -> RunStatus
_runStatus :: RunStatus
, GameState -> IntMap Robot
_robotMap :: IntMap Robot
,
GameState -> IntSet
_activeRobots :: IntSet
,
GameState -> Map TickNumber [RID]
_waitingRobots :: Map TickNumber [RID]
, GameState -> Map SubworldName (Map Location IntSet)
_robotsByLocation :: Map SubworldName (Map Location IntSet)
,
GameState -> Map (Cosmic Location) (Set RID)
_robotsWatching :: Map (Cosmic Location) (S.Set RID)
, GameState -> Inventory
_allDiscoveredEntities :: Inventory
, GameState -> Notifications (Recipe Entity)
_availableRecipes :: Notifications (Recipe Entity)
, GameState -> Notifications Const
_availableCommands :: Notifications Const
, GameState -> RID
_gensym :: Int
, GameState -> RID
_seed :: Seed
, GameState -> StdGen
_randGen :: StdGen
, GameState -> Array RID Text
_adjList :: Array Int Text
, GameState -> Array RID Text
_nameList :: Array Int Text
, GameState -> Maybe ProcessedTerm
_initiallyRunCode :: Maybe ProcessedTerm
, GameState -> EntityMap
_entityMap :: EntityMap
, GameState -> IntMap [Recipe Entity]
_recipesOut :: IntMap [Recipe Entity]
, GameState -> IntMap [Recipe Entity]
_recipesIn :: IntMap [Recipe Entity]
, GameState -> IntMap [Recipe Entity]
_recipesReq :: IntMap [Recipe Entity]
, GameState -> Maybe String
_currentScenarioPath :: Maybe FilePath
, GameState -> [Text]
_knownEntities :: [Text]
, GameState -> Navigation (Map SubworldName) Location
_worldNavigation :: Navigation (M.Map SubworldName) Location
, GameState -> MultiWorld RID Entity
_multiWorld :: W.MultiWorld Int Entity
, GameState -> Bool
_worldScrollable :: Bool
, GameState -> ViewCenterRule
_viewCenterRule :: ViewCenterRule
, GameState -> Cosmic Location
_viewCenter :: Cosmic Location
, GameState -> Bool
_needsRedraw :: Bool
, GameState -> REPLStatus
_replStatus :: REPLStatus
, GameState -> Integer
_replNextValueIndex :: Integer
, GameState -> Maybe (Text, Value)
_inputHandler :: Maybe (Text, Value)
, GameState -> Seq LogEntry
_messageQueue :: Seq LogEntry
, GameState -> TickNumber
_lastSeenMessageTime :: TickNumber
, GameState -> RID
_focusedRobotID :: RID
, GameState -> TickNumber
_ticks :: TickNumber
, GameState -> RID
_robotStepsPerTick :: Int
}
makeLensesFor
[ ("_activeRobots", "internalActiveRobots")
, ("_waitingRobots", "internalWaitingRobots")
]
''GameState
makeLensesExcluding ['_viewCenter, '_focusedRobotID, '_viewCenterRule, '_activeRobots, '_waitingRobots, '_adjList, '_nameList] ''GameState
creativeMode :: Lens' GameState Bool
gameStep :: Lens' GameState Step
winCondition :: Lens' GameState WinCondition
winSolution :: Lens' GameState (Maybe ProcessedTerm)
gameAchievements :: Lens' GameState (Map GameplayAchievement Attainment)
announcementQueue :: Lens' GameState (Seq Announcement)
runStatus :: Lens' GameState RunStatus
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)
robotMap :: Lens' GameState (IntMap Robot)
robotsByLocation :: Lens' GameState (Map SubworldName (Map Location IntSet))
robotsAtLocation :: Cosmic Location -> GameState -> [Robot]
robotsAtLocation :: Cosmic Location -> GameState -> [Robot]
robotsAtLocation Cosmic Location
loc GameState
gs =
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a. RID -> IntMap a -> Maybe a
`IM.lookup` (GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState (IntMap Robot)
robotMap))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] IntSet -> [RID]
IS.toList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (Cosmic Location
loc forall s a. s -> Getting a s a -> a
^. forall a1 a2. Lens (Cosmic a1) (Cosmic a2) a1 a2
planar)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault forall a. Monoid a => a
mempty (Cosmic Location
loc forall s a. s -> Getting a s a -> a
^. forall a. Lens' (Cosmic a) SubworldName
subworld)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Lens' GameState (Map SubworldName (Map Location IntSet))
robotsByLocation
forall a b. (a -> b) -> a -> b
$ GameState
gs
robotsWatching :: Lens' GameState (Map (Cosmic Location) (S.Set RID))
robotsInArea :: Cosmic Location -> Int32 -> GameState -> [Robot]
robotsInArea :: Cosmic Location -> Int32 -> GameState -> [Robot]
robotsInArea (Cosmic SubworldName
subworldName Location
o) Int32
d GameState
gs = forall a b. (a -> b) -> [a] -> [b]
map (IntMap Robot
rm forall a. IntMap a -> RID -> a
IM.!) [RID]
rids
where
rm :: IntMap Robot
rm = GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState (IntMap Robot)
robotMap
rl :: Map SubworldName (Map Location IntSet)
rl = GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState (Map SubworldName (Map Location IntSet))
robotsByLocation
rids :: [RID]
rids =
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap IntSet -> [RID]
IS.elems forall a b. (a -> b) -> a -> b
$
forall e. Location -> Int32 -> Map Location e -> [e]
getElemsInArea Location
o Int32
d forall a b. (a -> b) -> a -> b
$
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault forall a. Monoid a => a
mempty SubworldName
subworldName Map SubworldName (Map Location IntSet)
rl
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
allDiscoveredEntities :: Lens' GameState Inventory
availableRecipes :: Lens' GameState (Notifications (Recipe Entity))
availableCommands :: Lens' GameState (Notifications Const)
activeRobots :: Getter GameState IntSet
activeRobots :: Getter GameState IntSet
activeRobots = Lens' GameState IntSet
internalActiveRobots
waitingRobots :: Getter GameState (Map TickNumber [RID])
waitingRobots :: Getter GameState (Map TickNumber [RID])
waitingRobots = Lens' GameState (Map TickNumber [RID])
internalWaitingRobots
gensym :: Lens' GameState Int
seed :: Lens' GameState Seed
randGen :: Lens' GameState StdGen
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
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
initiallyRunCode :: Lens' GameState (Maybe ProcessedTerm)
entityMap :: Lens' GameState EntityMap
recipesOut :: Lens' GameState (IntMap [Recipe Entity])
recipesIn :: Lens' GameState (IntMap [Recipe Entity])
recipesReq :: Lens' GameState (IntMap [Recipe Entity])
currentScenarioPath :: Lens' GameState (Maybe FilePath)
knownEntities :: Lens' GameState [Text]
worldNavigation :: Lens' GameState (Navigation (M.Map SubworldName) Location)
multiWorld :: Lens' GameState (W.MultiWorld Int Entity)
worldScrollable :: Lens' GameState Bool
viewCenter :: Getter GameState (Cosmic Location)
viewCenter :: Getter GameState (Cosmic Location)
viewCenter = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Cosmic Location
_viewCenter
needsRedraw :: Lens' GameState Bool
replStatus :: Lens' GameState REPLStatus
replNextValueIndex :: Lens' GameState Integer
inputHandler :: Lens' GameState (Maybe (Text, Value))
messageQueue :: Lens' GameState (Seq LogEntry)
lastSeenMessageTime :: Lens' GameState TickNumber
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
ticks :: Lens' GameState TickNumber
robotStepsPerTick :: Lens' GameState Int
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
setter :: GameState -> ViewCenterRule -> GameState
setter :: GameState -> ViewCenterRule -> GameState
setter GameState
g ViewCenterRule
rule =
case ViewCenterRule
rule of
VCLocation Cosmic Location
loc -> GameState
g {_viewCenterRule :: ViewCenterRule
_viewCenterRule = ViewCenterRule
rule, _viewCenter :: Cosmic Location
_viewCenter = Cosmic Location
loc}
VCRobot RID
rid ->
let robotcenter :: Maybe (Cosmic Location)
robotcenter = GameState
g forall s a. s -> Getting (First a) s a -> Maybe a
^? Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix RID
rid forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter Robot (Cosmic Location)
robotLocation
in
case Maybe (Cosmic Location)
robotcenter of
Maybe (Cosmic Location)
Nothing -> GameState
g
Just Cosmic Location
loc -> GameState
g {_viewCenterRule :: ViewCenterRule
_viewCenterRule = ViewCenterRule
rule, _viewCenter :: Cosmic Location
_viewCenter = Cosmic Location
loc, _focusedRobotID :: RID
_focusedRobotID = RID
rid}
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
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
messageNotifications :: Getter GameState (Notifications LogEntry)
messageNotifications :: Getter GameState (Notifications LogEntry)
messageNotifications = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Notifications LogEntry
getNotif
where
getNotif :: GameState -> Notifications LogEntry
getNotif GameState
gs = Notifications {_notificationsCount :: RID
_notificationsCount = forall (t :: * -> *) a. Foldable t => t a -> RID
length [LogEntry]
new, _notificationsContent :: [LogEntry]
_notificationsContent = [LogEntry]
allUniq}
where
allUniq :: [LogEntry]
allUniq = forall a. Eq a => [a] -> [a]
uniq forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq LogEntry
allMessages
new :: [LogEntry]
new = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\LogEntry
l -> LogEntry
l forall s a. s -> Getting a s a -> a
^. Lens' LogEntry TickNumber
leTime forall a. Ord a => a -> a -> Bool
> GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState TickNumber
lastSeenMessageTime) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [LogEntry]
allUniq
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)
latestMsg :: LogEntry -> Bool
latestMsg = GameState -> LogEntry -> Bool
messageIsRecent GameState
gs
closeMsg :: LogEntry -> Bool
closeMsg = Cosmic Location -> LogEntry -> Bool
messageIsFromNearby (GameState
gs forall s a. s -> Getting a s a -> a
^. Getter GameState (Cosmic Location)
viewCenter)
focusedOrLatestClose :: Seq LogEntry -> Seq LogEntry
focusedOrLatestClose Seq LogEntry
mq =
(forall a. RID -> Seq a -> Seq a
Seq.take RID
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Seq a -> Seq a
Seq.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter LogEntry -> Bool
closeMsg forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Seq a
Seq.takeWhileR LogEntry -> Bool
latestMsg Seq LogEntry
mq)
forall a. Semigroup a => a -> a -> a
<> forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter ((forall a. Eq a => a -> a -> Bool
== GameState
gs forall s a. s -> Getting a s a -> a
^. Getter GameState RID
focusedRobotID) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Lens' LogEntry RID
leRobotID) Seq LogEntry
mq
messageIsRecent :: GameState -> LogEntry -> Bool
messageIsRecent :: GameState -> LogEntry -> Bool
messageIsRecent GameState
gs LogEntry
e = Integer -> TickNumber -> TickNumber
addTicks Integer
1 (LogEntry
e forall s a. s -> Getting a s a -> a
^. Lens' LogEntry TickNumber
leTime) forall a. Ord a => a -> a -> Bool
>= GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState TickNumber
ticks
messageIsFromNearby :: Cosmic Location -> LogEntry -> Bool
messageIsFromNearby :: Cosmic Location -> LogEntry -> Bool
messageIsFromNearby Cosmic Location
l LogEntry
e = case LogEntry
e forall s a. s -> Getting a s a -> a
^. Lens' LogEntry (LogLocation (Cosmic Location))
leLocation of
LogLocation (Cosmic Location)
Omnipresent -> Bool
True
Located Cosmic Location
x -> Cosmic Location -> Bool
f Cosmic Location
x
where
f :: Cosmic Location -> Bool
f Cosmic Location
logLoc = case forall a b.
(a -> a -> b) -> Cosmic a -> Cosmic a -> DistanceMeasure b
cosmoMeasure Location -> Location -> Int32
manhattan Cosmic Location
l Cosmic Location
logLoc of
DistanceMeasure Int32
InfinitelyFar -> Bool
False
Measurable Int32
x -> Int32
x forall a. Ord a => a -> a -> Bool
<= forall i. Num i => i
hearingDistance
applyViewCenterRule :: ViewCenterRule -> IntMap Robot -> Maybe (Cosmic Location)
applyViewCenterRule :: ViewCenterRule -> IntMap Robot -> Maybe (Cosmic Location)
applyViewCenterRule (VCLocation Cosmic Location
l) IntMap Robot
_ = forall a. a -> Maybe a
Just Cosmic Location
l
applyViewCenterRule (VCRobot RID
name) IntMap Robot
m = IntMap Robot
m forall s a. s -> Getting (First a) s a -> Maybe a
^? forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at RID
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter Robot (Cosmic Location)
robotLocation
recalcViewCenter :: GameState -> GameState
recalcViewCenter :: GameState -> GameState
recalcViewCenter GameState
g =
GameState
g
{ _viewCenter :: Cosmic Location
_viewCenter = Cosmic Location
newViewCenter
}
forall a b. a -> (a -> b) -> b
& (if Cosmic Location
newViewCenter forall a. Eq a => a -> a -> Bool
/= Cosmic Location
oldViewCenter then Lens' GameState Bool
needsRedraw forall s t a b. ASetter s t a b -> b -> s -> t
.~ Bool
True else forall a. a -> a
id)
where
oldViewCenter :: Cosmic Location
oldViewCenter = GameState
g forall s a. s -> Getting a s a -> a
^. Getter GameState (Cosmic Location)
viewCenter
newViewCenter :: Cosmic Location
newViewCenter =
forall a. a -> Maybe a -> a
fromMaybe Cosmic Location
oldViewCenter forall a b. (a -> b) -> a -> b
$
ViewCenterRule -> IntMap Robot -> Maybe (Cosmic Location)
applyViewCenterRule (GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState ViewCenterRule
viewCenterRule) (GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState (IntMap Robot)
robotMap)
modifyViewCenter :: (Cosmic Location -> Cosmic Location) -> GameState -> GameState
modifyViewCenter :: (Cosmic Location -> Cosmic Location) -> GameState -> GameState
modifyViewCenter Cosmic Location -> Cosmic Location
update GameState
g =
GameState
g
forall a b. a -> (a -> b) -> b
& case GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState ViewCenterRule
viewCenterRule of
VCLocation Cosmic Location
l -> Lens' GameState ViewCenterRule
viewCenterRule forall s t a b. ASetter s t a b -> b -> s -> t
.~ Cosmic Location -> ViewCenterRule
VCLocation (Cosmic Location -> Cosmic Location
update Cosmic Location
l)
VCRobot RID
_ -> Lens' GameState ViewCenterRule
viewCenterRule forall s t a b. ASetter s t a b -> b -> s -> t
.~ Cosmic Location -> ViewCenterRule
VCLocation (Cosmic Location -> Cosmic Location
update (GameState
g forall s a. s -> Getting a s a -> a
^. Getter GameState (Cosmic Location)
viewCenter))
unfocus :: GameState -> GameState
unfocus :: GameState -> GameState
unfocus = (\GameState
g -> GameState
g {_focusedRobotID :: RID
_focusedRobotID = -RID
1000}) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cosmic Location -> Cosmic Location) -> GameState -> GameState
modifyViewCenter forall a. a -> a
id
viewingRegion :: GameState -> (Int32, Int32) -> Cosmic W.BoundsRectangle
viewingRegion :: GameState -> (Int32, Int32) -> Cosmic BoundsRectangle
viewingRegion GameState
g (Int32
w, Int32
h) = forall a. SubworldName -> a -> Cosmic a
Cosmic SubworldName
sw ((Int32, Int32) -> Coords
W.Coords (Int32
rmin, Int32
cmin), (Int32, Int32) -> Coords
W.Coords (Int32
rmax, Int32
cmax))
where
Cosmic SubworldName
sw (Location Int32
cx Int32
cy) = GameState
g forall s a. s -> Getting a s a -> a
^. Getter GameState (Cosmic Location)
viewCenter
(Int32
rmin, Int32
rmax) = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both (forall a. Num a => a -> a -> a
+ (-Int32
cy forall a. Num a => a -> a -> a
- Int32
h forall a. Integral a => a -> a -> a
`div` Int32
2)) (Int32
0, Int32
h forall a. Num a => a -> a -> a
- Int32
1)
(Int32
cmin, Int32
cmax) = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both (forall a. Num a => a -> a -> a
+ (Int32
cx forall a. Num a => a -> a -> a
- Int32
w forall a. Integral a => a -> a -> a
`div` Int32
2)) (Int32
0, Int32
w forall a. Num a => a -> a -> a
- Int32
1)
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)
data RobotRange
=
Close
|
MidRange Double
|
Far
deriving (RobotRange -> RobotRange -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RobotRange -> RobotRange -> Bool
$c/= :: RobotRange -> RobotRange -> Bool
== :: RobotRange -> RobotRange -> Bool
$c== :: RobotRange -> RobotRange -> Bool
Eq, Eq RobotRange
RobotRange -> RobotRange -> Bool
RobotRange -> RobotRange -> Ordering
RobotRange -> RobotRange -> RobotRange
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RobotRange -> RobotRange -> RobotRange
$cmin :: RobotRange -> RobotRange -> RobotRange
max :: RobotRange -> RobotRange -> RobotRange
$cmax :: RobotRange -> RobotRange -> RobotRange
>= :: RobotRange -> RobotRange -> Bool
$c>= :: RobotRange -> RobotRange -> Bool
> :: RobotRange -> RobotRange -> Bool
$c> :: RobotRange -> RobotRange -> Bool
<= :: RobotRange -> RobotRange -> Bool
$c<= :: RobotRange -> RobotRange -> Bool
< :: RobotRange -> RobotRange -> Bool
$c< :: RobotRange -> RobotRange -> Bool
compare :: RobotRange -> RobotRange -> Ordering
$ccompare :: RobotRange -> RobotRange -> Ordering
Ord)
focusedRange :: GameState -> Maybe RobotRange
focusedRange :: GameState -> Maybe RobotRange
focusedRange GameState
g = RobotRange
checkRange forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ GameState -> Maybe Robot
focusedRobot GameState
g
where
checkRange :: RobotRange
checkRange = case DistanceMeasure Double
r of
DistanceMeasure Double
InfinitelyFar -> RobotRange
Far
Measurable Double
r' -> Double -> RobotRange
computedRange Double
r'
computedRange :: Double -> RobotRange
computedRange Double
r'
| GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState Bool
creativeMode Bool -> Bool -> Bool
|| GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState Bool
worldScrollable Bool -> Bool -> Bool
|| Double
r' forall a. Ord a => a -> a -> Bool
<= Double
minRadius = RobotRange
Close
| Double
r' forall a. Ord a => a -> a -> Bool
> Double
maxRadius = RobotRange
Far
| Bool
otherwise = Double -> RobotRange
MidRange forall a b. (a -> b) -> a -> b
$ (Double
r' forall a. Num a => a -> a -> a
- Double
minRadius) forall a. Fractional a => a -> a -> a
/ (Double
maxRadius forall a. Num a => a -> a -> a
- Double
minRadius)
r :: DistanceMeasure Double
r = case GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at RID
0 of
Maybe Robot
Nothing -> forall b. DistanceMeasure b
InfinitelyFar
Just Robot
br -> forall a b.
(a -> a -> b) -> Cosmic a -> Cosmic a -> DistanceMeasure b
cosmoMeasure Location -> Location -> Double
euclidean (GameState
g forall s a. s -> Getting a s a -> a
^. Getter GameState (Cosmic Location)
viewCenter) (Robot
br forall s a. s -> Getting a s a -> a
^. Getter Robot (Cosmic Location)
robotLocation)
baseInv, focInv :: Maybe Inventory
baseInv :: Maybe Inventory
baseInv = GameState
g forall s a. s -> Getting (First a) s a -> Maybe a
^? Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix RID
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot Inventory
equippedDevices
focInv :: Maybe Inventory
focInv = forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Lens' Robot Inventory
equippedDevices forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GameState -> Maybe Robot
focusedRobot GameState
g
gain :: Maybe Inventory -> (Double -> Double)
gain :: Maybe Inventory -> Double -> Double
gain (Just Inventory
inv)
| Text -> Inventory -> RID
countByName Text
"antenna" Inventory
inv forall a. Ord a => a -> a -> Bool
> RID
0 = (forall a. Num a => a -> a -> a
* Double
2)
gain Maybe Inventory
_ = forall a. a -> a
id
minRadius, maxRadius :: Double
(Double
minRadius, Double
maxRadius) = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both (Maybe Inventory -> Double -> Double
gain Maybe Inventory
baseInv forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Inventory -> Double -> Double
gain Maybe Inventory
focInv) (Double
16, Double
64)
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
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'
addRobot :: (Has (State GameState) sig m) => Robot -> m ()
addRobot :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Robot -> m ()
addRobot Robot
r = do
let rid :: RID
rid = Robot
r forall s a. s -> Getting a s a -> a
^. Getter Robot RID
robotID
Lens' GameState (IntMap Robot)
robotMap forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall a. RID -> a -> IntMap a -> IntMap a
IM.insert RID
rid Robot
r
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> Cosmic Location -> m ()
addRobotToLocation RID
rid forall a b. (a -> b) -> a -> b
$ Robot
r forall s a. s -> Getting a s a -> a
^. Getter Robot (Cosmic Location)
robotLocation
Lens' GameState IntSet
internalActiveRobots forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= RID -> IntSet -> IntSet
IS.insert RID
rid
addRobotToLocation :: (Has (State GameState) sig m) => RID -> Cosmic Location -> m ()
addRobotToLocation :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> Cosmic Location -> m ()
addRobotToLocation RID
rid Cosmic Location
rLoc =
Lens' GameState (Map SubworldName (Map Location IntSet))
robotsByLocation
forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith
(forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith IntSet -> IntSet -> IntSet
IS.union)
(Cosmic Location
rLoc forall s a. s -> Getting a s a -> a
^. forall a. Lens' (Cosmic a) SubworldName
subworld)
(forall k a. k -> a -> Map k a
M.singleton (Cosmic Location
rLoc forall s a. s -> Getting a s a -> a
^. forall a1 a2. Lens (Cosmic a1) (Cosmic a2) a1 a2
planar) (RID -> IntSet
IS.singleton RID
rid))
maxMessageQueueSize :: Int
maxMessageQueueSize :: RID
maxMessageQueueSize = RID
1000
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
sleepUntil :: (Has (State GameState) sig m) => RID -> TickNumber -> m ()
sleepUntil :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> TickNumber -> m ()
sleepUntil RID
rid TickNumber
time = do
Lens' GameState IntSet
internalActiveRobots forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= RID -> IntSet -> IntSet
IS.delete RID
rid
Lens' GameState (Map TickNumber [RID])
internalWaitingRobots forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at TickNumber
time forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non [] forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= (RID
rid forall a. a -> [a] -> [a]
:)
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
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
wakeUpRobotsDoneSleeping :: (Has (State GameState) sig m) => m ()
wakeUpRobotsDoneSleeping :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
m ()
wakeUpRobotsDoneSleeping = do
TickNumber
time <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState TickNumber
ticks
Maybe [RID]
mrids <- Lens' GameState (Map TickNumber [RID])
internalWaitingRobots forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at TickNumber
time forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a b.
Has (State s) sig m =>
LensLike ((,) a) s s a b -> b -> m a
<<.= forall a. Maybe a
Nothing
case Maybe [RID]
mrids of
Maybe [RID]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just [RID]
rids -> do
IntMap Robot
robots <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState (IntMap Robot)
robotMap
let aliveRids :: [RID]
aliveRids = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. RID -> IntMap a -> Bool
`IM.member` IntMap Robot
robots) [RID]
rids
Lens' GameState IntSet
internalActiveRobots forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= IntSet -> IntSet -> IntSet
IS.union ([RID] -> IntSet
IS.fromList [RID]
aliveRids)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
[RID] -> m ()
clearWatchingRobots [RID]
rids
clearWatchingRobots ::
(Has (State GameState) sig m) =>
[RID] ->
m ()
clearWatchingRobots :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
[RID] -> m ()
clearWatchingRobots [RID]
rids = do
Lens' GameState (Map (Cosmic Location) (Set RID))
robotsWatching forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall a b k. (a -> b) -> Map k a -> Map k b
M.map (forall a. Ord a => Set a -> Set a -> Set a
`S.difference` forall a. Ord a => [a] -> Set a
S.fromList [RID]
rids)
wakeWatchingRobots :: (Has (State GameState) sig m) => Cosmic Location -> m ()
wakeWatchingRobots :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m ()
wakeWatchingRobots Cosmic Location
loc = do
TickNumber
currentTick <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState TickNumber
ticks
Map TickNumber [RID]
waitingMap <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter GameState (Map TickNumber [RID])
waitingRobots
IntMap Robot
rMap <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState (IntMap Robot)
robotMap
Map (Cosmic Location) (Set RID)
watchingMap <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState (Map (Cosmic Location) (Set RID))
robotsWatching
let
botsWatchingThisLoc :: [Robot]
botsWatchingThisLoc :: [Robot]
botsWatchingThisLoc =
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a. RID -> IntMap a -> Maybe a
`IM.lookup` IntMap Robot
rMap) forall a b. (a -> b) -> a -> b
$
forall a. Set a -> [a]
S.toList forall a b. (a -> b) -> a -> b
$
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault forall a. Monoid a => a
mempty Cosmic Location
loc Map (Cosmic Location) (Set RID)
watchingMap
wakeTimes :: [(RID, TickNumber)]
wakeTimes :: [(RID, TickNumber)]
wakeTimes = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getter Robot RID
robotID forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Robot -> Maybe TickNumber
waitingUntil)) [Robot]
botsWatchingThisLoc
wakeTimesToPurge :: Map TickNumber (S.Set RID)
wakeTimesToPurge :: Map TickNumber (Set RID)
wakeTimesToPurge = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith forall a. Semigroup a => a -> a -> a
(<>) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Set a
S.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> (b, a)
swap) [(RID, TickNumber)]
wakeTimes
filteredWaiting :: Map TickNumber [RID]
filteredWaiting = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {k} {a}.
(Ord k, Ord a) =>
(k, Set a) -> Map k [a] -> Map k [a]
f Map TickNumber [RID]
waitingMap forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map TickNumber (Set RID)
wakeTimesToPurge
where
f :: (k, Set a) -> Map k [a] -> Map k [a]
f (k
k, Set a
botsToRemove) = forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
M.adjust (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set a
botsToRemove)) k
k
wakeableBotIds :: [RID]
wakeableBotIds = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(RID, TickNumber)]
wakeTimes
newWakeTime :: TickNumber
newWakeTime = Integer -> TickNumber -> TickNumber
addTicks Integer
1 TickNumber
currentTick
newInsertions :: Map TickNumber [RID]
newInsertions = forall k a. k -> a -> Map k a
M.singleton TickNumber
newWakeTime [RID]
wakeableBotIds
Lens' GameState (Map TickNumber [RID])
internalWaitingRobots forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> b -> m ()
.= forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith forall a. Semigroup a => a -> a -> a
(<>) Map TickNumber [RID]
filteredWaiting Map TickNumber [RID]
newInsertions
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [RID]
wakeableBotIds forall a b. (a -> b) -> a -> b
$ \RID
rid ->
Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at RID
rid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot CESK
machine forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= \case
Waiting TickNumber
_ CESK
c -> TickNumber -> CESK -> CESK
Waiting TickNumber
newWakeTime CESK
c
CESK
x -> CESK
x
deleteRobot :: (Has (State GameState) sig m) => RID -> m ()
deleteRobot :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> m ()
deleteRobot RID
rn = do
Lens' GameState IntSet
internalActiveRobots forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= RID -> IntSet -> IntSet
IS.delete RID
rn
Maybe Robot
mrobot <- Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at RID
rn forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a b.
Has (State s) sig m =>
LensLike ((,) a) s s a b -> b -> m a
<<.= forall a. Maybe a
Nothing
Maybe Robot
mrobot forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
`forM_` \Robot
robot -> do
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> RID -> m ()
removeRobotFromLocationMap (Robot
robot forall s a. s -> Getting a s a -> a
^. Getter Robot (Cosmic Location)
robotLocation) RID
rn
removeRobotFromLocationMap ::
(Has (State GameState) sig m) =>
Cosmic Location ->
RID ->
m ()
removeRobotFromLocationMap :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> RID -> m ()
removeRobotFromLocationMap (Cosmic SubworldName
oldSubworld Location
oldPlanar) RID
rid =
Lens' GameState (Map SubworldName (Map Location IntSet))
robotsByLocation forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
M.update (forall {f :: * -> *}.
Alternative f =>
RID -> Map Location IntSet -> f (Map Location IntSet)
tidyDelete RID
rid) SubworldName
oldSubworld
where
deleteOne :: RID -> IntSet -> f IntSet
deleteOne RID
x = forall (f :: * -> *) a. Alternative f => (a -> Bool) -> a -> f a
surfaceEmpty IntSet -> Bool
IS.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. RID -> IntSet -> IntSet
IS.delete RID
x
tidyDelete :: RID -> Map Location IntSet -> f (Map Location IntSet)
tidyDelete RID
robID =
forall (f :: * -> *) a. Alternative f => (a -> Bool) -> a -> f a
surfaceEmpty forall k a. Map k a -> Bool
M.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a
M.update (forall {f :: * -> *}. Alternative f => RID -> IntSet -> f IntSet
deleteOne RID
robID) Location
oldPlanar
type LaunchParams a = ParameterizableLaunchParams CodeToRun a
type ValidatedLaunchParams = LaunchParams Identity
data GameStateConfig = GameStateConfig
{ GameStateConfig -> Array RID Text
initAdjList :: Array Int Text
, GameStateConfig -> Array RID Text
initNameList :: Array Int Text
, GameStateConfig -> EntityMap
initEntities :: EntityMap
, GameStateConfig -> [Recipe Entity]
initRecipes :: [Recipe Entity]
, GameStateConfig -> WorldMap
initWorldMap :: WorldMap
}
initGameState :: GameStateConfig -> GameState
initGameState :: GameStateConfig -> GameState
initGameState GameStateConfig
gsc =
GameState
{ _creativeMode :: Bool
_creativeMode = Bool
False
, _gameStep :: Step
_gameStep = Step
WorldTick
, _winCondition :: WinCondition
_winCondition = WinCondition
NoWinCondition
, _winSolution :: Maybe ProcessedTerm
_winSolution = forall a. Maybe a
Nothing
,
_gameAchievements :: Map GameplayAchievement Attainment
_gameAchievements = forall a. Monoid a => a
mempty
, _announcementQueue :: Seq Announcement
_announcementQueue = forall a. Monoid a => a
mempty
, _runStatus :: RunStatus
_runStatus = RunStatus
Running
, _robotMap :: IntMap Robot
_robotMap = forall a. IntMap a
IM.empty
, _robotsByLocation :: Map SubworldName (Map Location IntSet)
_robotsByLocation = forall k a. Map k a
M.empty
, _robotsWatching :: Map (Cosmic Location) (Set RID)
_robotsWatching = forall a. Monoid a => a
mempty
, _availableRecipes :: Notifications (Recipe Entity)
_availableRecipes = forall a. Monoid a => a
mempty
, _availableCommands :: Notifications Const
_availableCommands = forall a. Monoid a => a
mempty
, _allDiscoveredEntities :: Inventory
_allDiscoveredEntities = Inventory
empty
, _activeRobots :: IntSet
_activeRobots = IntSet
IS.empty
, _waitingRobots :: Map TickNumber [RID]
_waitingRobots = forall k a. Map k a
M.empty
, _gensym :: RID
_gensym = RID
0
, _seed :: RID
_seed = RID
0
, _randGen :: StdGen
_randGen = RID -> StdGen
mkStdGen RID
0
, _adjList :: Array RID Text
_adjList = GameStateConfig -> Array RID Text
initAdjList GameStateConfig
gsc
, _nameList :: Array RID Text
_nameList = GameStateConfig -> Array RID Text
initNameList GameStateConfig
gsc
, _initiallyRunCode :: Maybe ProcessedTerm
_initiallyRunCode = forall a. Maybe a
Nothing
, _entityMap :: EntityMap
_entityMap = GameStateConfig -> EntityMap
initEntities GameStateConfig
gsc
, _recipesOut :: IntMap [Recipe Entity]
_recipesOut = [Recipe Entity] -> IntMap [Recipe Entity]
outRecipeMap (GameStateConfig -> [Recipe Entity]
initRecipes GameStateConfig
gsc)
, _recipesIn :: IntMap [Recipe Entity]
_recipesIn = [Recipe Entity] -> IntMap [Recipe Entity]
inRecipeMap (GameStateConfig -> [Recipe Entity]
initRecipes GameStateConfig
gsc)
, _recipesReq :: IntMap [Recipe Entity]
_recipesReq = [Recipe Entity] -> IntMap [Recipe Entity]
reqRecipeMap (GameStateConfig -> [Recipe Entity]
initRecipes GameStateConfig
gsc)
, _currentScenarioPath :: Maybe String
_currentScenarioPath = forall a. Maybe a
Nothing
, _knownEntities :: [Text]
_knownEntities = []
, _worldNavigation :: Navigation (Map SubworldName) Location
_worldNavigation = forall (additionalDimension :: * -> *) portalExitLoc.
additionalDimension WaypointMap
-> Map (Cosmic Location) (AnnotatedDestination portalExitLoc)
-> Navigation additionalDimension portalExitLoc
Navigation forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
, _multiWorld :: MultiWorld RID Entity
_multiWorld = forall a. Monoid a => a
mempty
, _worldScrollable :: Bool
_worldScrollable = Bool
True
, _viewCenterRule :: ViewCenterRule
_viewCenterRule = RID -> ViewCenterRule
VCRobot RID
0
, _viewCenter :: Cosmic Location
_viewCenter = Cosmic Location
defaultCosmicLocation
, _needsRedraw :: Bool
_needsRedraw = Bool
False
, _replStatus :: REPLStatus
_replStatus = Maybe (Typed Value) -> REPLStatus
REPLDone forall a. Maybe a
Nothing
, _replNextValueIndex :: Integer
_replNextValueIndex = Integer
0
, _inputHandler :: Maybe (Text, Value)
_inputHandler = forall a. Maybe a
Nothing
, _messageQueue :: Seq LogEntry
_messageQueue = forall s. AsEmpty s => s
Empty
, _lastSeenMessageTime :: TickNumber
_lastSeenMessageTime = Integer -> TickNumber
TickNumber (-Integer
1)
, _focusedRobotID :: RID
_focusedRobotID = RID
0
, _ticks :: TickNumber
_ticks = Integer -> TickNumber
TickNumber Integer
0
, _robotStepsPerTick :: RID
_robotStepsPerTick = RID
defaultRobotStepsPerTick
}
scenarioToGameState ::
Scenario ->
ValidatedLaunchParams ->
GameStateConfig ->
IO GameState
scenarioToGameState :: Scenario
-> ValidatedLaunchParams -> GameStateConfig -> IO GameState
scenarioToGameState Scenario
scenario (LaunchParams (Identity Maybe RID
userSeed) (Identity Maybe CodeToRun
toRun)) GameStateConfig
gsc = do
RID
theSeed <- case Maybe RID
userSeed forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario (Maybe RID)
scenarioSeed of
Just RID
s -> forall (m :: * -> *) a. Monad m => a -> m a
return RID
s
Maybe RID
Nothing -> forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (RID
0, forall a. Bounded a => a
maxBound :: Int)
TimeSpec
now <- Clock -> IO TimeSpec
Clock.getTime Clock
Clock.Monotonic
let robotList' :: [Robot]
robotList' = (Lens' Robot TimeSpec
robotCreatedAt forall s t a b. ASetter s t a b -> b -> s -> t
.~ TimeSpec
now) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Robot]
robotList
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
(GameStateConfig -> GameState
initGameState GameStateConfig
gsc)
{ _focusedRobotID :: RID
_focusedRobotID = RID
baseID
}
forall a b. a -> (a -> b) -> b
& Lens' GameState Bool
creativeMode forall s t a b. ASetter s t a b -> b -> s -> t
.~ Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario Bool
scenarioCreative
forall a b. a -> (a -> b) -> b
& Lens' GameState WinCondition
winCondition forall s t a b. ASetter s t a b -> b -> s -> t
.~ WinCondition
theWinCondition
forall a b. a -> (a -> b) -> b
& Lens' GameState (Maybe ProcessedTerm)
winSolution forall s t a b. ASetter s t a b -> b -> s -> t
.~ Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario (Maybe ProcessedTerm)
scenarioSolution
forall a b. a -> (a -> b) -> b
& Lens' GameState (IntMap Robot)
robotMap forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. [(RID, a)] -> IntMap a
IM.fromList (forall a b. (a -> b) -> [a] -> [b]
map (forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getter Robot RID
robotID forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id) [Robot]
robotList')
forall a b. a -> (a -> b) -> b
& Lens' GameState (Map SubworldName (Map Location IntSet))
robotsByLocation forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a b k. (a -> b) -> Map k a -> Map k b
M.map (forall {a}.
Member (Reader Robot) (Reader a) =>
[a] -> Map Location IntSet
groupRobotsByPlanarLocation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList) ([Robot] -> Map SubworldName (NonEmpty Robot)
groupRobotsBySubworld [Robot]
robotList')
forall a b. a -> (a -> b) -> b
& Lens' GameState IntSet
internalActiveRobots forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s. Getting IntSet s RID -> s -> IntSet
setOf (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter Robot RID
robotID) [Robot]
robotList'
forall a b. a -> (a -> b) -> b
& Lens' GameState (Notifications Const)
availableCommands forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. RID -> [a] -> Notifications a
Notifications RID
0 [Const]
initialCommands
forall a b. a -> (a -> b) -> b
& Lens' GameState RID
gensym forall s t a b. ASetter s t a b -> b -> s -> t
.~ RID
initGensym
forall a b. a -> (a -> b) -> b
& Lens' GameState RID
seed forall s t a b. ASetter s t a b -> b -> s -> t
.~ RID
theSeed
forall a b. a -> (a -> b) -> b
& Lens' GameState StdGen
randGen forall s t a b. ASetter s t a b -> b -> s -> t
.~ RID -> StdGen
mkStdGen RID
theSeed
forall a b. a -> (a -> b) -> b
& Lens' GameState (Maybe ProcessedTerm)
initiallyRunCode forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe ProcessedTerm
initialCodeToRun
forall a b. a -> (a -> b) -> b
& Lens' GameState EntityMap
entityMap forall s t a b. ASetter s t a b -> b -> s -> t
.~ EntityMap
em
forall a b. a -> (a -> b) -> b
& Lens' GameState (IntMap [Recipe Entity])
recipesOut forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall {a}.
Semigroup a =>
([Recipe Entity] -> IntMap a) -> IntMap a -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap [Recipe Entity]
outRecipeMap
forall a b. a -> (a -> b) -> b
& Lens' GameState (IntMap [Recipe Entity])
recipesIn forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall {a}.
Semigroup a =>
([Recipe Entity] -> IntMap a) -> IntMap a -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap [Recipe Entity]
inRecipeMap
forall a b. a -> (a -> b) -> b
& Lens' GameState (IntMap [Recipe Entity])
recipesReq forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall {a}.
Semigroup a =>
([Recipe Entity] -> IntMap a) -> IntMap a -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap [Recipe Entity]
reqRecipeMap
forall a b. a -> (a -> b) -> b
& Lens' GameState [Text]
knownEntities forall s t a b. ASetter s t a b -> b -> s -> t
.~ Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario [Text]
scenarioKnown
forall a b. a -> (a -> b) -> b
& Lens' GameState (Navigation (Map SubworldName) Location)
worldNavigation forall s t a b. ASetter s t a b -> b -> s -> t
.~ Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario (Navigation (Map SubworldName) Location)
scenarioNavigation
forall a b. a -> (a -> b) -> b
& Lens' GameState (MultiWorld RID Entity)
multiWorld forall s t a b. ASetter s t a b -> b -> s -> t
.~ RID -> MultiWorld RID Entity
allSubworldsMap RID
theSeed
forall a b. a -> (a -> b) -> b
& Lens' GameState Bool
worldScrollable forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. NonEmpty a -> a
NE.head (Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario (NonEmpty WorldDescription)
scenarioWorlds) forall s a. s -> Getting a s a -> a
^. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall e. PWorldDescription e -> Bool
scrollable
forall a b. a -> (a -> b) -> b
& Lens' GameState ViewCenterRule
viewCenterRule forall s t a b. ASetter s t a b -> b -> s -> t
.~ RID -> ViewCenterRule
VCRobot RID
baseID
forall a b. a -> (a -> b) -> b
& Lens' GameState REPLStatus
replStatus forall s t a b. ASetter s t a b -> b -> s -> t
.~ case Bool
running of
Bool
False -> Maybe (Typed Value) -> REPLStatus
REPLDone forall a. Maybe a
Nothing
Bool
True -> Typed (Maybe Value) -> REPLStatus
REPLWorking (forall v. v -> Polytype -> Requirements -> Typed v
Typed forall a. Maybe a
Nothing Polytype
PolyUnit forall a. Monoid a => a
mempty)
forall a b. a -> (a -> b) -> b
& Lens' GameState RID
robotStepsPerTick forall s t a b. ASetter s t a b -> b -> s -> t
.~ ((Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario (Maybe RID)
scenarioStepsPerTick) forall a. Maybe a -> a -> a
? RID
defaultRobotStepsPerTick)
where
groupRobotsBySubworld :: [Robot] -> Map SubworldName (NonEmpty Robot)
groupRobotsBySubworld =
forall (t :: * -> *) a b.
(Foldable t, Ord a) =>
t (a, b) -> Map a (NonEmpty b)
binTuples forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view (Getter Robot (Cosmic Location)
robotLocation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Lens' (Cosmic a) SubworldName
subworld) forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id)
groupRobotsByPlanarLocation :: [a] -> Map Location IntSet
groupRobotsByPlanarLocation [a]
rs =
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith
IntSet -> IntSet -> IntSet
IS.union
(forall a b. (a -> b) -> [a] -> [b]
map (forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view (Getter Robot (Cosmic Location)
robotLocation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2. Lens (Cosmic a1) (Cosmic a2) a1 a2
planar) forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (RID -> IntSet
IS.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getter Robot RID
robotID)) [a]
rs)
em :: EntityMap
em = GameStateConfig -> EntityMap
initEntities GameStateConfig
gsc forall a. Semigroup a => a -> a -> a
<> Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario EntityMap
scenarioEntities
baseID :: RID
baseID = RID
0
([Entity]
things, [Entity]
devices) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Lens' Entity (Set Capability)
entityCapabilities) (forall k a. Map k a -> [a]
M.elems (EntityMap -> Map Text Entity
entitiesByName EntityMap
em))
locatedRobots :: [TRobot]
locatedRobots = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Lens' TRobot (Maybe (Cosmic Location))
trobotLocation) forall a b. (a -> b) -> a -> b
$ Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario [TRobot]
scenarioRobots
getCodeToRun :: CodeToRun -> ProcessedTerm
getCodeToRun (CodeToRun SolutionSource
_ ProcessedTerm
s) = ProcessedTerm
s
robotsByBasePrecedence :: [TRobot]
robotsByBasePrecedence = [TRobot]
locatedRobots forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst [(RID, TRobot)]
genRobots)
initialCodeToRun :: Maybe ProcessedTerm
initialCodeToRun = CodeToRun -> ProcessedTerm
getCodeToRun forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CodeToRun
toRun
robotList :: [Robot]
robotList =
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith RID -> TRobot -> Robot
instantiateRobot [RID
baseID ..] [TRobot]
robotsByBasePrecedence
forall a b. a -> (a -> b) -> b
& forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix RID
baseID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot CESK
machine
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ case Maybe ProcessedTerm
initialCodeToRun of
Maybe ProcessedTerm
Nothing -> forall a. a -> a
id
Just ProcessedTerm
pt -> forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ ProcessedTerm -> Env -> Store -> CESK
initMachine ProcessedTerm
pt forall t. Ctx t
Ctx.empty Store
emptyStore
forall a b. a -> (a -> b) -> b
& forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix RID
baseID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot Inventory
robotInventory
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ case Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario Bool
scenarioCreative of
Bool
False -> forall a. a -> a
id
Bool
True -> Inventory -> Inventory -> Inventory
union ([(RID, Entity)] -> Inventory
fromElems (forall a b. (a -> b) -> [a] -> [b]
map (RID
0,) [Entity]
things))
forall a b. a -> (a -> b) -> b
& forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix RID
baseID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot Inventory
equippedDevices
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ case Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario Bool
scenarioCreative of
Bool
False -> forall a. a -> a
id
Bool
True -> forall a b. a -> b -> a
const ([Entity] -> Inventory
fromList [Entity]
devices)
running :: Bool
running = case [Robot]
robotList of
[] -> Bool
False
(Robot
base : [Robot]
_) -> forall a. Maybe a -> Bool
isNothing (CESK -> Maybe (Value, Store)
finalValue (Robot
base forall s a. s -> Getting a s a -> a
^. Lens' Robot CESK
machine))
allCapabilities :: Robot -> Set Capability
allCapabilities Robot
r =
Inventory -> Set Capability
inventoryCapabilities (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
equippedDevices)
forall a. Semigroup a => a -> a -> a
<> Inventory -> Set Capability
inventoryCapabilities (Robot
r forall s a. s -> Getting a s a -> a
^. Lens' Robot Inventory
robotInventory)
initialCaps :: Set Capability
initialCaps = forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Robot -> Set Capability
allCapabilities [Robot]
robotList
initialCommands :: [Const]
initialCommands =
forall a. (a -> Bool) -> [a] -> [a]
filter
(forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (forall a. Ord a => a -> Set a -> Bool
`S.member` Set Capability
initialCaps) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const -> Maybe Capability
constCaps)
[Const]
allConst
genRobots :: [(Int, TRobot)]
genRobots :: [(RID, TRobot)]
genRobots = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) NonEmpty
(SubworldName, ([(RID, TRobot)], RID -> WorldFun RID Entity))
builtWorldTuples
builtWorldTuples :: NonEmpty (SubworldName, ([IndexedTRobot], Seed -> WorldFun Int Entity))
builtWorldTuples :: NonEmpty
(SubworldName, ([(RID, TRobot)], RID -> WorldFun RID Entity))
builtWorldTuples =
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (forall e. PWorldDescription e -> SubworldName
worldName forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& WorldDescription -> ([(RID, TRobot)], RID -> WorldFun RID Entity)
buildWorld) forall a b. (a -> b) -> a -> b
$
Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario (NonEmpty WorldDescription)
scenarioWorlds
allSubworldsMap :: Seed -> W.MultiWorld Int Entity
allSubworldsMap :: RID -> MultiWorld RID Entity
allSubworldsMap RID
s =
forall a b k. (a -> b) -> Map k a -> Map k b
M.map forall {a} {t} {e}. (a, RID -> WorldFun t e) -> World t e
genWorld
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList
forall a b. (a -> b) -> a -> b
$ NonEmpty
(SubworldName, ([(RID, TRobot)], RID -> WorldFun RID Entity))
builtWorldTuples
where
genWorld :: (a, RID -> WorldFun t e) -> World t e
genWorld (a, RID -> WorldFun t e)
x = forall t e. WorldFun t e -> World t e
W.newWorld forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd (a, RID -> WorldFun t e)
x RID
s
theWinCondition :: WinCondition
theWinCondition =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
WinCondition
NoWinCondition
(\NonEmpty Objective
x -> WinStatus -> ObjectiveCompletion -> WinCondition
WinConditions WinStatus
Ongoing (CompletionBuckets -> Set Text -> ObjectiveCompletion
ObjectiveCompletion ([Objective] -> [Objective] -> [Objective] -> CompletionBuckets
CompletionBuckets (forall a. NonEmpty a -> [a]
NE.toList NonEmpty Objective
x) forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty) forall a. Monoid a => a
mempty))
(forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty (Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario [Objective]
scenarioObjectives))
initGensym :: RID
initGensym = forall (t :: * -> *) a. Foldable t => t a -> RID
length [Robot]
robotList forall a. Num a => a -> a -> a
- RID
1
addRecipesWith :: ([Recipe Entity] -> IntMap a) -> IntMap a -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap a
f = forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IM.unionWith forall a. Semigroup a => a -> a -> a
(<>) ([Recipe Entity] -> IntMap a
f forall a b. (a -> b) -> a -> b
$ Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario [Recipe Entity]
scenarioRecipes)
buildWorld :: WorldDescription -> ([IndexedTRobot], Seed -> WorldFun Int Entity)
buildWorld :: WorldDescription -> ([(RID, TRobot)], RID -> WorldFun RID Entity)
buildWorld WorldDescription {Bool
[[PCell Entity]]
Maybe (TTerm '[] (World CellVal))
Location
SubworldName
Navigation Identity WaypointName
WorldPalette Entity
worldProg :: forall e. PWorldDescription e -> Maybe (TTerm '[] (World CellVal))
navigation :: forall e. PWorldDescription e -> Navigation Identity WaypointName
area :: forall e. PWorldDescription e -> [[PCell e]]
ul :: forall e. PWorldDescription e -> Location
palette :: forall e. PWorldDescription e -> WorldPalette e
offsetOrigin :: forall e. PWorldDescription e -> Bool
worldProg :: Maybe (TTerm '[] (World CellVal))
worldName :: SubworldName
navigation :: Navigation Identity WaypointName
area :: [[PCell Entity]]
ul :: Location
palette :: WorldPalette Entity
scrollable :: Bool
offsetOrigin :: Bool
worldName :: forall e. PWorldDescription e -> SubworldName
scrollable :: forall e. PWorldDescription e -> Bool
..} = (SubworldName -> [(RID, TRobot)]
robots SubworldName
worldName, forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Enum a => a -> RID
fromEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. RID -> WorldFun TerrainType Entity
wf)
where
rs :: Int32
rs = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> RID
length [[PCell Entity]]
area
cs :: Int32
cs = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> RID
length (forall a. [a] -> a
head [[PCell Entity]]
area)
Coords (Int32
ulr, Int32
ulc) = Location -> Coords
locToCoords Location
ul
worldGrid :: [[(TerrainType, Erasable Entity)]]
worldGrid :: [[(TerrainType, Erasable Entity)]]
worldGrid = (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map) (forall e. PCell e -> TerrainType
cellTerrain forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall e. PCell e -> Erasable e
cellEntity) [[PCell Entity]]
area
worldArray :: Array (Int32, Int32) (TerrainType, Erasable Entity)
worldArray :: Array (Int32, Int32) (TerrainType, Erasable Entity)
worldArray = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Int32
ulr, Int32
ulc), (Int32
ulr forall a. Num a => a -> a -> a
+ Int32
rs forall a. Num a => a -> a -> a
- Int32
1, Int32
ulc forall a. Num a => a -> a -> a
+ Int32
cs forall a. Num a => a -> a -> a
- Int32
1)) (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(TerrainType, Erasable Entity)]]
worldGrid)
dslWF, arrayWF :: Seed -> WorldFun TerrainType Entity
dslWF :: RID -> WorldFun TerrainType Entity
dslWF = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty ((forall a. Bool -> (a -> a) -> a -> a
applyWhen Bool
offsetOrigin forall t. WorldFun t Entity -> WorldFun t Entity
findGoodOrigin forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. TTerm '[] (World CellVal) -> RID -> WorldFun TerrainType Entity
runWorld) Maybe (TTerm '[] (World CellVal))
worldProg
arrayWF :: RID -> WorldFun TerrainType Entity
arrayWF = forall a b. a -> b -> a
const (forall t e.
Monoid t =>
Array (Int32, Int32) (t, Erasable e) -> WorldFun t e
worldFunFromArray Array (Int32, Int32) (TerrainType, Erasable Entity)
worldArray)
wf :: RID -> WorldFun TerrainType Entity
wf = RID -> WorldFun TerrainType Entity
dslWF forall a. Semigroup a => a -> a -> a
<> RID -> WorldFun TerrainType Entity
arrayWF
robots :: SubworldName -> [IndexedTRobot]
robots :: SubworldName -> [(RID, TRobot)]
robots SubworldName
swName =
[[PCell Entity]]
area
forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal RID (f a) (f b) a b
traversed forall i j (p :: * -> * -> *) s t r a b.
Indexable (i, j) p =>
(Indexed i s t -> r) -> (Indexed j a b -> s -> t) -> p a b -> r
Control.Lens.<.> forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal RID (f a) (f b) a b
traversed forall i s t a b.
AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t
%@~ (,)
forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
( \((forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int32
r, forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int32
c), Cell TerrainType
_ Erasable Entity
_ [(RID, TRobot)]
robotList) ->
let robotWithLoc :: TRobot -> TRobot
robotWithLoc = Lens' TRobot (Maybe (Cosmic Location))
trobotLocation forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a. SubworldName -> a -> Cosmic a
Cosmic SubworldName
swName (Coords -> Location
W.coordsToLoc ((Int32, Int32) -> Coords
Coords (Int32
ulr forall a. Num a => a -> a -> a
+ Int32
r, Int32
ulc forall a. Num a => a -> a -> a
+ Int32
c)))
in forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TRobot -> TRobot
robotWithLoc) [(RID, TRobot)]
robotList
)