{-# 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,
winCondition,
winSolution,
robotMap,
robotsByLocation,
robotsAtLocation,
robotsWatching,
robotsInArea,
baseRobot,
activeRobots,
waitingRobots,
messageNotifications,
seed,
randGen,
currentScenarioPath,
viewCenterRule,
viewCenter,
needsRedraw,
focusedRobotID,
temporal,
robotNaming,
recipesInfo,
messageInfo,
gameControls,
discovery,
landscape,
TemporalState,
gameStep,
runStatus,
ticks,
robotStepsPerTick,
paused,
RobotNaming,
nameGenerator,
gensym,
Recipes,
recipesOut,
recipesIn,
recipesCat,
Messages,
messageQueue,
lastSeenMessageTime,
announcementQueue,
GameControls,
initiallyRunCode,
replStatus,
replNextValueIndex,
replWorking,
replActiveType,
inputHandler,
Discovery,
allDiscoveredEntities,
availableRecipes,
availableCommands,
knownEntities,
gameAchievements,
Landscape,
worldNavigation,
multiWorld,
worldScrollable,
entityMap,
Notifications (..),
notificationsCount,
notificationsContent,
LaunchParams,
ValidatedLaunchParams,
GameStateConfig (..),
initGameState,
scenarioToGameState,
CodeToRun (..),
Sha1 (..),
SolutionSource (..),
parseCodeFile,
applyViewCenterRule,
recalcViewCenter,
modifyViewCenter,
viewingRegion,
unfocus,
focusedRobot,
RobotRange (..),
focusedRange,
getRadioRange,
clearFocusedRobotLogUpdated,
addRobot,
addRobotToLocation,
addTRobot,
emitMessage,
wakeWatchingRobots,
sleepUntil,
sleepForever,
wakeUpRobotsDoneSleeping,
deleteRobot,
removeRobotFromLocationMap,
activateRobot,
toggleRunStatus,
messageIsRecent,
messageIsFromNearby,
getRunCodePath,
buildWorldTuples,
genMultiWorld,
genRobotTemplates,
) where
import Control.Applicative ((<|>))
import Control.Arrow (Arrow ((&&&)))
import Control.Effect.Lens
import Control.Effect.Lift
import Control.Effect.State (State)
import Control.Effect.Throw
import Control.Lens hiding (Const, use, uses, view, (%=), (+=), (.=), (<+=), (<<.=))
import Control.Monad (forM_)
import Data.Aeson (FromJSON, ToJSON)
import Data.Array (Array, listArray)
import Data.Bifunctor (first)
import Data.Digest.Pure.SHA (sha1, showDigest)
import Data.Foldable (toList)
import Data.Int (Int32)
import Data.IntMap (IntMap)
import Data.IntMap qualified as IM
import Data.IntSet (IntSet)
import Data.IntSet qualified as IS
import Data.IntSet.Lens (setOf)
import Data.List (partition, sortOn)
import Data.List.NonEmpty (NonEmpty)
import Data.List.NonEmpty qualified as NE
import Data.Map (Map)
import Data.Map qualified as M
import Data.Maybe (fromMaybe, isJust, isNothing, listToMaybe, mapMaybe)
import Data.Sequence (Seq ((:<|)))
import Data.Sequence qualified as Seq
import Data.Set qualified as S
import Data.Text (Text)
import Data.Text qualified as T (drop, take)
import Data.Text.IO qualified as TIO
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Encoding qualified as TL
import Data.Tuple (swap)
import GHC.Generics (Generic)
import Servant.Docs (ToSample)
import Servant.Docs qualified as SD
import Swarm.Game.Achievement.Attainment
import Swarm.Game.Achievement.Definitions
import Swarm.Game.CESK (CESK (Waiting), TickNumber (..), addTicks, emptyStore, finalValue, initMachine)
import Swarm.Game.Entity
import Swarm.Game.Failure (SystemFailure (..))
import Swarm.Game.Location
import Swarm.Game.Recipe (
Recipe,
catRecipeMap,
inRecipeMap,
outRecipeMap,
)
import Swarm.Game.ResourceLoading (NameGenerator)
import Swarm.Game.Robot
import Swarm.Game.Scenario.Objective
import Swarm.Game.Scenario.Status
import Swarm.Game.Scenario.Topography.Navigation.Portal (Navigation (..))
import Swarm.Game.ScenarioInfo
import Swarm.Game.Terrain (TerrainType (..))
import Swarm.Game.Universe as U
import Swarm.Game.World (Coords (..), WorldFun (..), locToCoords, worldFunFromArray)
import Swarm.Game.World qualified as W
import Swarm.Game.World.Eval (runWorld)
import Swarm.Game.World.Gen (Seed, findGoodOrigin)
import Swarm.Game.World.Typecheck (WorldMap)
import Swarm.Language.Capability (constCaps)
import Swarm.Language.Context qualified as Ctx
import Swarm.Language.Module (Module (Module))
import Swarm.Language.Pipeline (ProcessedTerm (ProcessedTerm), processTermEither)
import Swarm.Language.Syntax (Const, SrcLoc (..), Syntax' (..), allConst)
import Swarm.Language.Typed (Typed (Typed))
import Swarm.Language.Types
import Swarm.Language.Value (Value)
import Swarm.Log
import Swarm.Util (applyWhen, binTuples, surfaceEmpty, uniq, (<+=), (<<.=), (?))
import Swarm.Util.Erasable
import Swarm.Util.Lens (makeLensesExcluding, makeLensesNoSigs)
import System.Clock qualified as Clock
import System.Random (StdGen, mkStdGen, randomRIO)
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. [a] -> [(Text, a)]
SD.samples
[ WinCondition
NoWinCondition
]
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 Recipes = Recipes
{ Recipes -> IntMap [Recipe Entity]
_recipesOut :: IntMap [Recipe Entity]
, Recipes -> IntMap [Recipe Entity]
_recipesIn :: IntMap [Recipe Entity]
, Recipes -> IntMap [Recipe Entity]
_recipesCat :: IntMap [Recipe Entity]
}
makeLensesNoSigs ''Recipes
recipesOut :: Lens' Recipes (IntMap [Recipe Entity])
recipesIn :: Lens' Recipes (IntMap [Recipe Entity])
recipesCat :: Lens' Recipes (IntMap [Recipe Entity])
data Messages = Messages
{ Messages -> Seq LogEntry
_messageQueue :: Seq LogEntry
, Messages -> TickNumber
_lastSeenMessageTime :: TickNumber
, Messages -> Seq Announcement
_announcementQueue :: Seq Announcement
}
makeLensesNoSigs ''Messages
messageQueue :: Lens' Messages (Seq LogEntry)
lastSeenMessageTime :: Lens' Messages TickNumber
announcementQueue :: Lens' Messages (Seq Announcement)
data RobotNaming = RobotNaming
{ RobotNaming -> NameGenerator
_nameGenerator :: NameGenerator
, RobotNaming -> RID
_gensym :: Int
}
makeLensesExcluding ['_nameGenerator] ''RobotNaming
nameGenerator :: Getter RobotNaming NameGenerator
nameGenerator :: Getter RobotNaming NameGenerator
nameGenerator = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to RobotNaming -> NameGenerator
_nameGenerator
gensym :: Lens' RobotNaming Int
data TemporalState = TemporalState
{ TemporalState -> Step
_gameStep :: Step
, TemporalState -> RunStatus
_runStatus :: RunStatus
, TemporalState -> TickNumber
_ticks :: TickNumber
, TemporalState -> RID
_robotStepsPerTick :: Int
}
makeLensesNoSigs ''TemporalState
gameStep :: Lens' TemporalState Step
runStatus :: Lens' TemporalState RunStatus
paused :: Getter TemporalState Bool
paused :: Getter TemporalState Bool
paused = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\TemporalState
s -> TemporalState
s forall s a. s -> Getting a s a -> a
^. Lens' TemporalState RunStatus
runStatus forall a. Eq a => a -> a -> Bool
/= RunStatus
Running)
ticks :: Lens' TemporalState TickNumber
robotStepsPerTick :: Lens' TemporalState Int
data GameControls = GameControls
{ GameControls -> REPLStatus
_replStatus :: REPLStatus
, GameControls -> Integer
_replNextValueIndex :: Integer
, GameControls -> Maybe (Text, Value)
_inputHandler :: Maybe (Text, Value)
, GameControls -> Maybe ProcessedTerm
_initiallyRunCode :: Maybe ProcessedTerm
}
makeLensesNoSigs ''GameControls
replStatus :: Lens' GameControls REPLStatus
replNextValueIndex :: Lens' GameControls Integer
inputHandler :: Lens' GameControls (Maybe (Text, Value))
initiallyRunCode :: Lens' GameControls (Maybe ProcessedTerm)
data Discovery = Discovery
{ Discovery -> Inventory
_allDiscoveredEntities :: Inventory
, Discovery -> Notifications (Recipe Entity)
_availableRecipes :: Notifications (Recipe Entity)
, Discovery -> Notifications Const
_availableCommands :: Notifications Const
, Discovery -> [Text]
_knownEntities :: [Text]
, Discovery -> Map GameplayAchievement Attainment
_gameAchievements :: Map GameplayAchievement Attainment
}
makeLensesNoSigs ''Discovery
allDiscoveredEntities :: Lens' Discovery Inventory
availableRecipes :: Lens' Discovery (Notifications (Recipe Entity))
availableCommands :: Lens' Discovery (Notifications Const)
knownEntities :: Lens' Discovery [Text]
gameAchievements :: Lens' Discovery (Map GameplayAchievement Attainment)
data Landscape = Landscape
{ Landscape -> Navigation (Map SubworldName) Location
_worldNavigation :: Navigation (M.Map SubworldName) Location
, Landscape -> MultiWorld RID Entity
_multiWorld :: W.MultiWorld Int Entity
, Landscape -> EntityMap
_entityMap :: EntityMap
, Landscape -> Bool
_worldScrollable :: Bool
}
makeLensesNoSigs ''Landscape
worldNavigation :: Lens' Landscape (Navigation (M.Map SubworldName) Location)
multiWorld :: Lens' Landscape (W.MultiWorld Int Entity)
entityMap :: Lens' Landscape EntityMap
worldScrollable :: Lens' Landscape Bool
data GameState = GameState
{ GameState -> Bool
_creativeMode :: Bool
, GameState -> TemporalState
_temporal :: TemporalState
, GameState -> WinCondition
_winCondition :: WinCondition
, GameState -> Maybe ProcessedTerm
_winSolution :: Maybe ProcessedTerm
, GameState -> IntMap Robot
_robotMap :: IntMap Robot
,
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 -> Discovery
_discovery :: Discovery
, GameState -> RID
_seed :: Seed
, GameState -> StdGen
_randGen :: StdGen
, GameState -> RobotNaming
_robotNaming :: RobotNaming
, GameState -> Recipes
_recipesInfo :: Recipes
, GameState -> Maybe String
_currentScenarioPath :: Maybe FilePath
, GameState -> Landscape
_landscape :: Landscape
, GameState -> ViewCenterRule
_viewCenterRule :: ViewCenterRule
, GameState -> Cosmic Location
_viewCenter :: Cosmic Location
, GameState -> Bool
_needsRedraw :: Bool
, GameState -> GameControls
_gameControls :: GameControls
, GameState -> Messages
_messageInfo :: Messages
, GameState -> RID
_focusedRobotID :: RID
}
makeLensesFor
[ ("_activeRobots", "internalActiveRobots")
, ("_waitingRobots", "internalWaitingRobots")
]
''GameState
makeLensesExcluding ['_viewCenter, '_focusedRobotID, '_viewCenterRule, '_activeRobots, '_waitingRobots] ''GameState
creativeMode :: Lens' GameState Bool
temporal :: Lens' GameState TemporalState
winCondition :: Lens' GameState WinCondition
winSolution :: Lens' GameState (Maybe ProcessedTerm)
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
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
discovery :: Lens' GameState Discovery
seed :: Lens' GameState Seed
randGen :: Lens' GameState StdGen
robotNaming :: Lens' GameState RobotNaming
recipesInfo :: Lens' GameState Recipes
currentScenarioPath :: Lens' GameState (Maybe FilePath)
landscape :: Lens' GameState Landscape
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
gameControls :: Lens' GameState GameControls
messageInfo :: Lens' GameState Messages
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
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 GameControls Bool
replWorking :: Getter GameControls Bool
replWorking = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\GameControls
s -> REPLStatus -> Bool
matchesWorking forall a b. (a -> b) -> a -> b
$ GameControls
s forall s a. s -> Getting a s a -> a
^. Lens' GameControls REPLStatus
replStatus)
where
matchesWorking :: REPLStatus -> Bool
matchesWorking (REPLDone Maybe (Typed Value)
_) = Bool
False
matchesWorking (REPLWorking Typed (Maybe Value)
_) = Bool
True
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 Messages
messageInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Messages TickNumber
lastSeenMessageTime) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [LogEntry]
allUniq
unchecked :: Bool
unchecked = GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState Bool
creativeMode Bool -> Bool -> Bool
|| forall a. a -> Maybe a -> a
fromMaybe Bool
False (GameState -> Maybe Robot
focusedRobot GameState
gs forall s a. s -> Getting (First a) s a -> Maybe a
^? forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot Bool
systemRobot)
messages :: Seq LogEntry
messages = (if Bool
unchecked then forall a. a -> a
id else Seq LogEntry -> Seq LogEntry
focusedOrLatestClose) (GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState Messages
messageInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Messages (Seq LogEntry)
messageQueue)
allMessages :: Seq LogEntry
allMessages = forall a. Ord a => Seq a -> Seq a
Seq.sort forall a b. (a -> b) -> a -> b
$ Seq LogEntry
focusedLogs forall a. Semigroup a => a -> a -> a
<> Seq LogEntry
messages
focusedLogs :: Seq LogEntry
focusedLogs = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall s. AsEmpty s => s
Empty (forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Lens' Robot (Seq LogEntry)
robotLog) (GameState -> Maybe Robot
focusedRobot GameState
gs)
latestMsg :: LogEntry -> Bool
latestMsg = GameState -> LogEntry -> Bool
messageIsRecent GameState
gs
closeMsg :: LogEntry -> Bool
closeMsg = Cosmic Location -> LogEntry -> Bool
messageIsFromNearby (GameState
gs forall s a. s -> Getting a s a -> a
^. Getter GameState (Cosmic Location)
viewCenter)
generatedBy :: RID -> LogEntry -> Bool
generatedBy RID
rid LogEntry
logEntry = case LogEntry
logEntry forall s a. s -> Getting a s a -> a
^. Lens' LogEntry LogSource
leSource of
RobotLog RobotLogSource
_ RID
rid' Cosmic Location
_ -> RID
rid forall a. Eq a => a -> a -> Bool
== RID
rid'
LogSource
_ -> Bool
False
focusedOrLatestClose :: Seq LogEntry -> Seq LogEntry
focusedOrLatestClose Seq LogEntry
mq =
(forall a. RID -> Seq a -> Seq a
Seq.take RID
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Seq a -> Seq a
Seq.reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter LogEntry -> Bool
closeMsg forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> Seq a -> Seq a
Seq.takeWhileR LogEntry -> Bool
latestMsg Seq LogEntry
mq)
forall a. Semigroup a => a -> a -> a
<> forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (RID -> LogEntry -> Bool
generatedBy (GameState
gs forall s a. s -> Getting a s a -> a
^. Getter GameState RID
focusedRobotID)) Seq LogEntry
mq
messageIsRecent :: GameState -> LogEntry -> Bool
messageIsRecent :: GameState -> LogEntry -> Bool
messageIsRecent GameState
gs LogEntry
e = RID -> TickNumber -> TickNumber
addTicks RID
1 (LogEntry
e forall s a. s -> Getting a s a -> a
^. Lens' LogEntry TickNumber
leTime) forall a. Ord a => a -> a -> Bool
>= GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks
messageIsFromNearby :: Cosmic Location -> LogEntry -> Bool
messageIsFromNearby :: Cosmic Location -> LogEntry -> Bool
messageIsFromNearby Cosmic Location
l LogEntry
e = case LogEntry
e forall s a. s -> Getting a s a -> a
^. Lens' LogEntry LogSource
leSource of
LogSource
SystemLog -> Bool
True
RobotLog RobotLogSource
_ RID
_ Cosmic Location
loc -> Cosmic Location -> Bool
f Cosmic Location
loc
where
f :: Cosmic Location -> Bool
f Cosmic Location
logLoc = case forall a b.
(a -> a -> b) -> Cosmic a -> Cosmic a -> DistanceMeasure b
cosmoMeasure Location -> Location -> Int32
manhattan Cosmic Location
l Cosmic Location
logLoc of
DistanceMeasure Int32
InfinitelyFar -> Bool
False
Measurable Int32
x -> Int32
x forall a. Ord a => a -> a -> Bool
<= forall i. Num i => i
hearingDistance
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 :: Cosmic Location -> (Int32, Int32) -> Cosmic W.BoundsRectangle
viewingRegion :: Cosmic Location -> (Int32, Int32) -> Cosmic BoundsRectangle
viewingRegion (Cosmic SubworldName
sw (Location Int32
cx Int32
cy)) (Int32
w, Int32
h) =
forall a. SubworldName -> a -> Cosmic a
Cosmic SubworldName
sw ((Int32, Int32) -> Coords
W.Coords (Int32
rmin, Int32
cmin), (Int32, Int32) -> Coords
W.Coords (Int32
rmax, Int32
cmax))
where
(Int32
rmin, Int32
rmax) = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both (forall a. Num a => a -> a -> a
+ (-Int32
cy forall a. Num a => a -> a -> a
- Int32
h forall a. Integral a => a -> a -> a
`div` Int32
2)) (Int32
0, Int32
h forall a. Num a => a -> a -> a
- Int32
1)
(Int32
cmin, Int32
cmax) = forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall (r :: * -> * -> *) a b.
Bitraversable r =>
Traversal (r a a) (r b b) a b
both (forall a. Num a => a -> a -> a
+ (Int32
cx forall a. Num a => a -> a -> a
- Int32
w forall a. Integral a => a -> a -> a
`div` Int32
2)) (Int32
0, Int32
w forall a. Num a => a -> a -> a
- Int32
1)
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
<$ Maybe Robot
maybeFocusedRobot
where
maybeBaseRobot :: Maybe Robot
maybeBaseRobot = GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at RID
0
maybeFocusedRobot :: Maybe Robot
maybeFocusedRobot = GameState -> Maybe Robot
focusedRobot GameState
g
checkRange :: RobotRange
checkRange = case DistanceMeasure Double
r of
DistanceMeasure Double
InfinitelyFar -> RobotRange
Far
Measurable Double
r' -> Double -> RobotRange
computedRange Double
r'
computedRange :: Double -> RobotRange
computedRange Double
r'
| GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState Bool
creativeMode Bool -> Bool -> Bool
|| GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape Bool
worldScrollable Bool -> Bool -> Bool
|| Double
r' forall a. Ord a => a -> a -> Bool
<= Double
minRadius = RobotRange
Close
| Double
r' forall a. Ord a => a -> a -> Bool
> Double
maxRadius = RobotRange
Far
| Bool
otherwise = Double -> RobotRange
MidRange forall a b. (a -> b) -> a -> b
$ (Double
r' forall a. Num a => a -> a -> a
- Double
minRadius) forall a. Fractional a => a -> a -> a
/ (Double
maxRadius forall a. Num a => a -> a -> a
- Double
minRadius)
r :: DistanceMeasure Double
r = case Maybe Robot
maybeBaseRobot 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)
(Double
minRadius, Double
maxRadius) = Maybe Robot -> Maybe Robot -> (Double, Double)
getRadioRange Maybe Robot
maybeBaseRobot Maybe Robot
maybeFocusedRobot
getRadioRange :: Maybe Robot -> Maybe Robot -> (Double, Double)
getRadioRange :: Maybe Robot -> Maybe Robot -> (Double, Double)
getRadioRange Maybe Robot
maybeBaseRobot Maybe Robot
maybeTargetRobot =
(Double
minRadius, Double
maxRadius)
where
baseInv, focInv :: Maybe Inventory
baseInv :: Maybe Inventory
baseInv = forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Lens' Robot Inventory
equippedDevices forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Robot
maybeBaseRobot
focInv :: Maybe Inventory
focInv = forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Lens' Robot Inventory
equippedDevices forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Robot
maybeTargetRobot
gain :: Maybe Inventory -> (Double -> Double)
gain :: Maybe Inventory -> Double -> Double
gain (Just Inventory
inv)
| Text -> Inventory -> RID
countByName Text
"antenna" Inventory
inv forall a. Ord a => a -> a -> Bool
> RID
0 = (forall a. Num a => a -> a -> a
* Double
2)
gain Maybe Inventory
_ = forall a. a -> a
id
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 RobotNaming
robotNaming forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotNaming RID
gensym forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
(Has (State s) sig m, Num a) =>
LensLike' ((,) a) s a -> a -> m a
<+= RID
1
let r' :: Robot
r' = RID -> TRobot -> Robot
instantiateRobot RID
rid TRobot
r
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Robot -> m ()
addRobot Robot
r'
forall (m :: * -> *) a. Monad m => a -> m a
return Robot
r'
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 Messages
messageInfo forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Messages (Seq LogEntry)
messageQueue forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= (forall s a. Snoc s s a a => s -> a -> s
|> LogEntry
msg) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Seq a -> Seq a
dropLastIfLong
where
tooLong :: Seq a -> Bool
tooLong Seq a
s = forall a. Seq a -> RID
Seq.length Seq a
s forall a. Ord a => a -> a -> Bool
>= RID
maxMessageQueueSize
dropLastIfLong :: Seq a -> Seq a
dropLastIfLong whole :: Seq a
whole@(a
_oldest :<| Seq a
newer) = if forall {a}. Seq a -> Bool
tooLong Seq a
whole then Seq a
newer else Seq a
whole
dropLastIfLong Seq a
emptyQueue = Seq a
emptyQueue
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 forall a b. (a -> b) -> a -> b
$ Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks
Maybe [RID]
mrids <- Lens' GameState (Map TickNumber [RID])
internalWaitingRobots forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at TickNumber
time forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a b.
Has (State s) sig m =>
LensLike ((,) a) s s a b -> b -> m a
<<.= forall a. Maybe a
Nothing
case Maybe [RID]
mrids of
Maybe [RID]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just [RID]
rids -> do
IntMap Robot
robots <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState (IntMap Robot)
robotMap
let aliveRids :: [RID]
aliveRids = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. RID -> IntMap a -> Bool
`IM.member` IntMap Robot
robots) [RID]
rids
Lens' GameState IntSet
internalActiveRobots forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= IntSet -> IntSet -> IntSet
IS.union ([RID] -> IntSet
IS.fromList [RID]
aliveRids)
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 forall a b. (a -> b) -> a -> b
$ Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState TickNumber
ticks
Map TickNumber [RID]
waitingMap <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Getter GameState (Map TickNumber [RID])
waitingRobots
IntMap Robot
rMap <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState (IntMap Robot)
robotMap
Map (Cosmic Location) (Set RID)
watchingMap <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState (Map (Cosmic Location) (Set RID))
robotsWatching
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 = RID -> TickNumber -> TickNumber
addTicks RID
1 TickNumber
currentTick
newInsertions :: Map TickNumber [RID]
newInsertions = forall k a. k -> a -> Map k a
M.singleton TickNumber
newWakeTime [RID]
wakeableBotIds
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 -> NameGenerator
initNameParts :: NameGenerator
, 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
, _temporal :: TemporalState
_temporal =
TemporalState
{ _gameStep :: Step
_gameStep = Step
WorldTick
, _runStatus :: RunStatus
_runStatus = RunStatus
Running
, _ticks :: TickNumber
_ticks = Int64 -> TickNumber
TickNumber Int64
0
, _robotStepsPerTick :: RID
_robotStepsPerTick = RID
defaultRobotStepsPerTick
}
, _winCondition :: WinCondition
_winCondition = WinCondition
NoWinCondition
, _winSolution :: Maybe ProcessedTerm
_winSolution = forall a. Maybe a
Nothing
, _robotMap :: IntMap Robot
_robotMap = forall a. IntMap a
IM.empty
, _robotsByLocation :: Map SubworldName (Map Location IntSet)
_robotsByLocation = forall k a. Map k a
M.empty
, _robotsWatching :: Map (Cosmic Location) (Set RID)
_robotsWatching = forall a. Monoid a => a
mempty
, _discovery :: Discovery
_discovery =
Discovery
{ _availableRecipes :: Notifications (Recipe Entity)
_availableRecipes = forall a. Monoid a => a
mempty
, _availableCommands :: Notifications Const
_availableCommands = forall a. Monoid a => a
mempty
, _allDiscoveredEntities :: Inventory
_allDiscoveredEntities = Inventory
empty
, _knownEntities :: [Text]
_knownEntities = []
,
_gameAchievements :: Map GameplayAchievement Attainment
_gameAchievements = forall a. Monoid a => a
mempty
}
, _activeRobots :: IntSet
_activeRobots = IntSet
IS.empty
, _waitingRobots :: Map TickNumber [RID]
_waitingRobots = forall k a. Map k a
M.empty
, _seed :: RID
_seed = RID
0
, _randGen :: StdGen
_randGen = RID -> StdGen
mkStdGen RID
0
, _robotNaming :: RobotNaming
_robotNaming =
RobotNaming
{ _nameGenerator :: NameGenerator
_nameGenerator = GameStateConfig -> NameGenerator
initNameParts GameStateConfig
gsc
, _gensym :: RID
_gensym = RID
0
}
, _recipesInfo :: Recipes
_recipesInfo =
Recipes
{ _recipesOut :: IntMap [Recipe Entity]
_recipesOut = [Recipe Entity] -> IntMap [Recipe Entity]
outRecipeMap (GameStateConfig -> [Recipe Entity]
initRecipes GameStateConfig
gsc)
, _recipesIn :: IntMap [Recipe Entity]
_recipesIn = [Recipe Entity] -> IntMap [Recipe Entity]
inRecipeMap (GameStateConfig -> [Recipe Entity]
initRecipes GameStateConfig
gsc)
, _recipesCat :: IntMap [Recipe Entity]
_recipesCat = [Recipe Entity] -> IntMap [Recipe Entity]
catRecipeMap (GameStateConfig -> [Recipe Entity]
initRecipes GameStateConfig
gsc)
}
, _currentScenarioPath :: Maybe String
_currentScenarioPath = forall a. Maybe a
Nothing
, _landscape :: Landscape
_landscape =
Landscape
{ _worldNavigation :: Navigation (Map SubworldName) Location
_worldNavigation = forall (additionalDimension :: * -> *) portalExitLoc.
additionalDimension WaypointMap
-> Map (Cosmic Location) (AnnotatedDestination portalExitLoc)
-> Navigation additionalDimension portalExitLoc
Navigation forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty
, _multiWorld :: MultiWorld RID Entity
_multiWorld = forall a. Monoid a => a
mempty
, _entityMap :: EntityMap
_entityMap = GameStateConfig -> EntityMap
initEntities GameStateConfig
gsc
, _worldScrollable :: Bool
_worldScrollable = Bool
True
}
, _viewCenterRule :: ViewCenterRule
_viewCenterRule = RID -> ViewCenterRule
VCRobot RID
0
, _viewCenter :: Cosmic Location
_viewCenter = Cosmic Location
defaultCosmicLocation
, _needsRedraw :: Bool
_needsRedraw = Bool
False
, _gameControls :: GameControls
_gameControls =
GameControls
{ _replStatus :: REPLStatus
_replStatus = Maybe (Typed Value) -> REPLStatus
REPLDone forall a. Maybe a
Nothing
, _replNextValueIndex :: Integer
_replNextValueIndex = Integer
0
, _inputHandler :: Maybe (Text, Value)
_inputHandler = forall a. Maybe a
Nothing
, _initiallyRunCode :: Maybe ProcessedTerm
_initiallyRunCode = forall a. Maybe a
Nothing
}
, _messageInfo :: Messages
_messageInfo =
Messages
{ _messageQueue :: Seq LogEntry
_messageQueue = forall s. AsEmpty s => s
Empty
, _lastSeenMessageTime :: TickNumber
_lastSeenMessageTime = Int64 -> TickNumber
TickNumber (-Int64
1)
, _announcementQueue :: Seq Announcement
_announcementQueue = forall a. Monoid a => a
mempty
}
, _focusedRobotID :: RID
_focusedRobotID = RID
0
}
type SubworldDescription = (SubworldName, ([IndexedTRobot], Seed -> WorldFun Int Entity))
buildWorldTuples :: Scenario -> NonEmpty SubworldDescription
buildWorldTuples :: Scenario -> NonEmpty SubworldDescription
buildWorldTuples Scenario
s =
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (forall e. PWorldDescription e -> SubworldName
worldName forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& WorldDescription -> ([IndexedTRobot], RID -> WorldFun RID Entity)
buildWorld) forall a b. (a -> b) -> a -> b
$
Scenario
s forall s a. s -> Getting a s a -> a
^. Lens' Scenario (NonEmpty WorldDescription)
scenarioWorlds
genMultiWorld :: NonEmpty SubworldDescription -> Seed -> W.MultiWorld Int Entity
genMultiWorld :: NonEmpty SubworldDescription -> RID -> MultiWorld RID Entity
genMultiWorld NonEmpty SubworldDescription
worldTuples RID
s =
forall a b k. (a -> b) -> Map k a -> Map k b
M.map forall {a} {t} {e}. (a, RID -> WorldFun t e) -> World t e
genWorld
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList
forall a b. (a -> b) -> a -> b
$ NonEmpty SubworldDescription
worldTuples
where
genWorld :: (a, RID -> WorldFun t e) -> World t e
genWorld (a, RID -> WorldFun t e)
x = forall t e. WorldFun t e -> World t e
W.newWorld forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd (a, RID -> WorldFun t e)
x RID
s
genRobotTemplates :: Scenario -> NonEmpty (a, ([(Int, TRobot)], b)) -> [TRobot]
genRobotTemplates :: forall a b.
Scenario -> NonEmpty (a, ([IndexedTRobot], b)) -> [TRobot]
genRobotTemplates Scenario
scenario NonEmpty (a, ([IndexedTRobot], b))
worldTuples =
[TRobot]
locatedRobots forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst [IndexedTRobot]
genRobots)
where
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
genRobots :: [(Int, TRobot)]
genRobots :: [IndexedTRobot]
genRobots = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NE.toList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NE.map (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) NonEmpty (a, ([IndexedTRobot], b))
worldTuples
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
let modifyRecipesInfo :: Recipes -> Recipes
modifyRecipesInfo Recipes
oldRecipesInfo =
Recipes
oldRecipesInfo
forall a b. a -> (a -> b) -> b
& Lens' Recipes (IntMap [Recipe Entity])
recipesOut forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall {a}.
Semigroup a =>
([Recipe Entity] -> IntMap a) -> IntMap a -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap [Recipe Entity]
outRecipeMap
forall a b. a -> (a -> b) -> b
& Lens' Recipes (IntMap [Recipe Entity])
recipesIn forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall {a}.
Semigroup a =>
([Recipe Entity] -> IntMap a) -> IntMap a -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap [Recipe Entity]
inRecipeMap
forall a b. a -> (a -> b) -> b
& Lens' Recipes (IntMap [Recipe Entity])
recipesCat forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall {a}.
Semigroup a =>
([Recipe Entity] -> IntMap a) -> IntMap a -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap [Recipe Entity]
catRecipeMap
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
(GameStateConfig -> GameState
initGameState GameStateConfig
gsc)
{ _focusedRobotID :: RID
_focusedRobotID = RID
baseID
}
forall a b. a -> (a -> b) -> b
& Lens' GameState Bool
creativeMode forall s t a b. ASetter s t a b -> b -> s -> t
.~ Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario Bool
scenarioCreative
forall a b. a -> (a -> b) -> b
& Lens' GameState WinCondition
winCondition forall s t a b. ASetter s t a b -> b -> s -> t
.~ WinCondition
theWinCondition
forall a b. a -> (a -> b) -> b
& Lens' GameState (Maybe ProcessedTerm)
winSolution forall s t a b. ASetter s t a b -> b -> s -> t
.~ Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario (Maybe ProcessedTerm)
scenarioSolution
forall a b. a -> (a -> b) -> b
& Lens' GameState (IntMap Robot)
robotMap forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. [(RID, a)] -> IntMap a
IM.fromList (forall a b. (a -> b) -> [a] -> [b]
map (forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getter Robot RID
robotID forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id) [Robot]
robotList')
forall a b. a -> (a -> b) -> b
& Lens' GameState (Map SubworldName (Map Location IntSet))
robotsByLocation forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a b k. (a -> b) -> Map k a -> Map k b
M.map (forall {a}.
Member (Reader Robot) (Reader a) =>
[a] -> Map Location IntSet
groupRobotsByPlanarLocation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList) ([Robot] -> Map SubworldName (NonEmpty Robot)
groupRobotsBySubworld [Robot]
robotList')
forall a b. a -> (a -> b) -> b
& Lens' GameState IntSet
internalActiveRobots forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s. Getting IntSet s RID -> s -> IntSet
setOf (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter Robot RID
robotID) [Robot]
robotList'
forall a b. a -> (a -> b) -> b
& Lens' GameState Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery (Notifications Const)
availableCommands forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. RID -> [a] -> Notifications a
Notifications RID
0 [Const]
initialCommands
forall a b. a -> (a -> b) -> b
& Lens' GameState Discovery
discovery forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Discovery [Text]
knownEntities forall s t a b. ASetter s t a b -> b -> s -> t
.~ Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario [Text]
scenarioKnown
forall a b. a -> (a -> b) -> b
& Lens' GameState RobotNaming
robotNaming forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' RobotNaming RID
gensym forall s t a b. ASetter s t a b -> b -> s -> t
.~ RID
initGensym
forall a b. a -> (a -> b) -> b
& Lens' GameState RID
seed forall s t a b. ASetter s t a b -> b -> s -> t
.~ RID
theSeed
forall a b. a -> (a -> b) -> b
& Lens' GameState StdGen
randGen forall s t a b. ASetter s t a b -> b -> s -> t
.~ RID -> StdGen
mkStdGen RID
theSeed
forall a b. a -> (a -> b) -> b
& Lens' GameState Recipes
recipesInfo forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Recipes -> Recipes
modifyRecipesInfo
forall a b. a -> (a -> b) -> b
& Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape EntityMap
entityMap forall s t a b. ASetter s t a b -> b -> s -> t
.~ EntityMap
em
forall a b. a -> (a -> b) -> b
& Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape (Navigation (Map SubworldName) Location)
worldNavigation forall s t a b. ASetter s t a b -> b -> s -> t
.~ Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario (Navigation (Map SubworldName) Location)
scenarioNavigation
forall a b. a -> (a -> b) -> b
& Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape (MultiWorld RID Entity)
multiWorld forall s t a b. ASetter s t a b -> b -> s -> t
.~ NonEmpty SubworldDescription -> RID -> MultiWorld RID Entity
genMultiWorld NonEmpty SubworldDescription
worldTuples RID
theSeed
forall a b. a -> (a -> b) -> b
& Lens' GameState Landscape
landscape forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Landscape Bool
worldScrollable forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. NonEmpty a -> a
NE.head (Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario (NonEmpty WorldDescription)
scenarioWorlds) forall s a. s -> Getting a s a -> a
^. forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to forall e. PWorldDescription e -> Bool
scrollable
forall a b. a -> (a -> b) -> b
& Lens' GameState ViewCenterRule
viewCenterRule forall s t a b. ASetter s t a b -> b -> s -> t
.~ RID -> ViewCenterRule
VCRobot RID
baseID
forall a b. a -> (a -> b) -> b
& Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls (Maybe ProcessedTerm)
initiallyRunCode forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe ProcessedTerm
initialCodeToRun
forall a b. a -> (a -> b) -> b
& Lens' GameState GameControls
gameControls forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' GameControls REPLStatus
replStatus forall s t a b. ASetter s t a b -> b -> s -> t
.~ case Bool
running of
Bool
False -> Maybe (Typed Value) -> REPLStatus
REPLDone forall a. Maybe a
Nothing
Bool
True -> Typed (Maybe Value) -> REPLStatus
REPLWorking (forall v. v -> Polytype -> Requirements -> Typed v
Typed forall a. Maybe a
Nothing Polytype
PolyUnit forall a. Monoid a => a
mempty)
forall a b. a -> (a -> b) -> b
& Lens' GameState TemporalState
temporal forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' TemporalState RID
robotStepsPerTick forall s t a b. ASetter s t a b -> b -> s -> t
.~ ((Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario (Maybe RID)
scenarioStepsPerTick) forall a. Maybe a -> a -> a
? RID
defaultRobotStepsPerTick)
where
groupRobotsBySubworld :: [Robot] -> Map SubworldName (NonEmpty Robot)
groupRobotsBySubworld =
forall (t :: * -> *) a b.
(Foldable t, Ord a) =>
t (a, b) -> Map a (NonEmpty b)
binTuples forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view (Getter Robot (Cosmic Location)
robotLocation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Lens' (Cosmic a) SubworldName
subworld) forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id)
groupRobotsByPlanarLocation :: [a] -> Map Location IntSet
groupRobotsByPlanarLocation [a]
rs =
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith
IntSet -> IntSet -> IntSet
IS.union
(forall a b. (a -> b) -> [a] -> [b]
map (forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view (Getter Robot (Cosmic Location)
robotLocation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a1 a2. Lens (Cosmic a1) (Cosmic a2) a1 a2
planar) forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (RID -> IntSet
IS.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getter Robot RID
robotID)) [a]
rs)
em :: EntityMap
em = GameStateConfig -> EntityMap
initEntities GameStateConfig
gsc forall a. Semigroup a => a -> a -> a
<> Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario EntityMap
scenarioEntities
baseID :: RID
baseID = RID
0
([Entity]
things, [Entity]
devices) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Lens' Entity (Set Capability)
entityCapabilities) (forall k a. Map k a -> [a]
M.elems (EntityMap -> Map Text Entity
entitiesByName EntityMap
em))
getCodeToRun :: CodeToRun -> ProcessedTerm
getCodeToRun (CodeToRun SolutionSource
_ ProcessedTerm
s) = ProcessedTerm
s
robotsByBasePrecedence :: [TRobot]
robotsByBasePrecedence = forall a b.
Scenario -> NonEmpty (a, ([IndexedTRobot], b)) -> [TRobot]
genRobotTemplates Scenario
scenario NonEmpty SubworldDescription
worldTuples
initialCodeToRun :: Maybe ProcessedTerm
initialCodeToRun = CodeToRun -> ProcessedTerm
getCodeToRun forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CodeToRun
toRun
robotList :: [Robot]
robotList =
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith RID -> TRobot -> Robot
instantiateRobot [RID
baseID ..] [TRobot]
robotsByBasePrecedence
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
worldTuples :: NonEmpty SubworldDescription
worldTuples = Scenario -> NonEmpty SubworldDescription
buildWorldTuples Scenario
scenario
theWinCondition :: WinCondition
theWinCondition =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
WinCondition
NoWinCondition
(\NonEmpty Objective
x -> WinStatus -> ObjectiveCompletion -> WinCondition
WinConditions WinStatus
Ongoing (CompletionBuckets -> Set Text -> ObjectiveCompletion
ObjectiveCompletion ([Objective] -> [Objective] -> [Objective] -> CompletionBuckets
CompletionBuckets (forall a. NonEmpty a -> [a]
NE.toList NonEmpty Objective
x) forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty) forall a. Monoid a => a
mempty))
(forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty (Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario [Objective]
scenarioObjectives))
initGensym :: RID
initGensym = forall (t :: * -> *) a. Foldable t => t a -> RID
length [Robot]
robotList forall a. Num a => a -> a -> a
- RID
1
addRecipesWith :: ([Recipe Entity] -> IntMap a) -> IntMap a -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap a
f = forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IM.unionWith forall a. Semigroup a => a -> a -> a
(<>) ([Recipe Entity] -> IntMap a
f forall a b. (a -> b) -> a -> b
$ Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario [Recipe Entity]
scenarioRecipes)
buildWorld :: WorldDescription -> ([IndexedTRobot], Seed -> WorldFun Int Entity)
buildWorld :: WorldDescription -> ([IndexedTRobot], RID -> WorldFun RID Entity)
buildWorld WorldDescription {Bool
[[PCell Entity]]
Maybe (TTerm '[] (World CellVal))
Location
SubworldName
Navigation Identity WaypointName
WorldPalette Entity
worldProg :: forall e. PWorldDescription e -> Maybe (TTerm '[] (World CellVal))
navigation :: forall e. PWorldDescription e -> Navigation Identity WaypointName
area :: forall e. PWorldDescription e -> [[PCell e]]
ul :: forall e. PWorldDescription e -> Location
palette :: forall e. PWorldDescription e -> WorldPalette e
offsetOrigin :: forall e. PWorldDescription e -> Bool
worldProg :: Maybe (TTerm '[] (World CellVal))
worldName :: SubworldName
navigation :: Navigation Identity WaypointName
area :: [[PCell Entity]]
ul :: Location
palette :: WorldPalette Entity
scrollable :: Bool
offsetOrigin :: Bool
scrollable :: forall e. PWorldDescription e -> Bool
worldName :: forall e. PWorldDescription e -> SubworldName
..} = (SubworldName -> [IndexedTRobot]
robots SubworldName
worldName, forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Enum a => a -> RID
fromEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. RID -> WorldFun TerrainType Entity
wf)
where
rs :: Int32
rs = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> RID
length [[PCell Entity]]
area
cs :: Int32
cs = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe RID
0 forall (t :: * -> *) a. Foldable t => t a -> RID
length forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
listToMaybe [[PCell Entity]]
area
Coords (Int32
ulr, Int32
ulc) = Location -> Coords
locToCoords Location
ul
worldGrid :: [[(TerrainType, Erasable Entity)]]
worldGrid :: [[(TerrainType, Erasable Entity)]]
worldGrid = (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map) (forall e. PCell e -> TerrainType
cellTerrain forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall e. PCell e -> Erasable e
cellEntity) [[PCell Entity]]
area
worldArray :: Array (Int32, Int32) (TerrainType, Erasable Entity)
worldArray :: Array (Int32, Int32) (TerrainType, Erasable Entity)
worldArray = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray ((Int32
ulr, Int32
ulc), (Int32
ulr forall a. Num a => a -> a -> a
+ Int32
rs forall a. Num a => a -> a -> a
- Int32
1, Int32
ulc forall a. Num a => a -> a -> a
+ Int32
cs forall a. Num a => a -> a -> a
- Int32
1)) (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(TerrainType, Erasable Entity)]]
worldGrid)
dslWF, arrayWF :: Seed -> WorldFun TerrainType Entity
dslWF :: RID -> WorldFun TerrainType Entity
dslWF = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty ((forall a. Bool -> (a -> a) -> a -> a
applyWhen Bool
offsetOrigin forall t. WorldFun t Entity -> WorldFun t Entity
findGoodOrigin forall b c a. (b -> c) -> (a -> b) -> a -> c
.) forall b c a. (b -> c) -> (a -> b) -> a -> c
. TTerm '[] (World CellVal) -> RID -> WorldFun TerrainType Entity
runWorld) Maybe (TTerm '[] (World CellVal))
worldProg
arrayWF :: RID -> WorldFun TerrainType Entity
arrayWF = forall a b. a -> b -> a
const (forall t e.
Monoid t =>
Array (Int32, Int32) (t, Erasable e) -> WorldFun t e
worldFunFromArray Array (Int32, Int32) (TerrainType, Erasable Entity)
worldArray)
wf :: RID -> WorldFun TerrainType Entity
wf = RID -> WorldFun TerrainType Entity
dslWF forall a. Semigroup a => a -> a -> a
<> RID -> WorldFun TerrainType Entity
arrayWF
robots :: SubworldName -> [IndexedTRobot]
robots :: SubworldName -> [IndexedTRobot]
robots SubworldName
swName =
[[PCell Entity]]
area
forall a b. a -> (a -> b) -> b
& forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal RID (f a) (f b) a b
traversed forall i j (p :: * -> * -> *) s t r a b.
Indexable (i, j) p =>
(Indexed i s t -> r) -> (Indexed j a b -> s -> t) -> p a b -> r
Control.Lens.<.> forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal RID (f a) (f b) a b
traversed forall i s t a b.
AnIndexedSetter i s t a b -> (i -> a -> b) -> s -> t
%@~ (,)
forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
forall a b. a -> (a -> b) -> b
& forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
( \((forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int32
r, forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int32
c), Cell TerrainType
_ Erasable Entity
_ [IndexedTRobot]
robotList) ->
let robotWithLoc :: TRobot -> TRobot
robotWithLoc = Lens' TRobot (Maybe (Cosmic Location))
trobotLocation forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ forall a. SubworldName -> a -> Cosmic a
Cosmic SubworldName
swName (Coords -> Location
W.coordsToLoc ((Int32, Int32) -> Coords
Coords (Int32
ulr forall a. Num a => a -> a -> a
+ Int32
r, Int32
ulc forall a. Num a => a -> a -> a
+ Int32
c)))
in forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TRobot -> TRobot
robotWithLoc) [IndexedTRobot]
robotList
)