{-# 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,
GameState,
creativeMode,
winCondition,
winSolution,
gameAchievements,
announcementQueue,
runStatus,
paused,
robotMap,
robotsByLocation,
robotsAtLocation,
robotsInArea,
baseRobot,
activeRobots,
waitingRobots,
availableRecipes,
availableCommands,
messageNotifications,
allDiscoveredEntities,
gensym,
seed,
randGen,
adjList,
nameList,
entityMap,
recipesOut,
recipesIn,
recipesReq,
scenarios,
currentScenarioPath,
knownEntities,
world,
viewCenterRule,
viewCenter,
needsRedraw,
replStatus,
replNextValueIndex,
replWorking,
replActiveType,
messageQueue,
lastSeenMessageTime,
focusedRobotID,
ticks,
robotStepsPerTick,
Notifications (..),
notificationsCount,
notificationsContent,
initGameState,
scenarioToGameState,
initGameStateForScenario,
classicGame0,
CodeToRun (..),
applyViewCenterRule,
recalcViewCenter,
modifyViewCenter,
viewingRegion,
focusedRobot,
clearFocusedRobotLogUpdated,
addRobot,
addTRobot,
emitMessage,
sleepUntil,
sleepForever,
wakeUpRobotsDoneSleeping,
deleteRobot,
activateRobot,
toggleRunStatus,
messageIsRecent,
messageIsFromNearby,
) where
import Control.Algebra (Has)
import Control.Applicative ((<|>))
import Control.Arrow (Arrow ((&&&)))
import Control.Effect.Lens
import Control.Effect.State (State)
import Control.Lens hiding (Const, use, uses, view, (%=), (+=), (.=), (<+=), (<<.=))
import Control.Monad.Except
import Data.Aeson (FromJSON, ToJSON)
import Data.Array (Array, listArray)
import Data.Bifunctor (first)
import Data.Foldable (toList)
import Data.Int (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 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 (lines)
import Data.Text.IO qualified as T (readFile)
import Data.Time (getZonedTime)
import GHC.Generics (Generic)
import Swarm.Game.CESK (emptyStore, finalValue, initMachine)
import Swarm.Game.Entity
import Swarm.Game.Recipe (
Recipe,
inRecipeMap,
loadRecipes,
outRecipeMap,
reqRecipeMap,
)
import Swarm.Game.Robot
import Swarm.Game.Scenario.Objective
import Swarm.Game.Scenario.Objective.Presentation.Model
import Swarm.Game.ScenarioInfo
import Swarm.Game.Terrain (TerrainType (..))
import Swarm.Game.World (Coords (..), WorldFun (..), locToCoords, worldFunFromArray)
import Swarm.Game.World qualified as W
import Swarm.Game.WorldGen (Seed, findGoodOrigin, testWorld2FromArray)
import Swarm.Language.Capability (constCaps)
import Swarm.Language.Context qualified as Ctx
import Swarm.Language.Pipeline (ProcessedTerm)
import Swarm.Language.Pipeline.QQ (tmQ)
import Swarm.Language.Syntax (Const, Term' (TText), allConst)
import Swarm.Language.Typed (Typed (Typed))
import Swarm.Language.Types
import Swarm.Language.Value (Value)
import Swarm.TUI.Model.Achievement.Attainment
import Swarm.TUI.Model.Achievement.Definitions
import Swarm.Util (getDataFileNameSafe, getElemsInArea, isRightOr, manhattan, uniq, (<+=), (<<.=), (?))
import Swarm.Util.Location
import System.Clock qualified as Clock
import System.Random (StdGen, mkStdGen, randomRIO)
import Witch (into)
data CodeToRun
= SuggestedSolution ProcessedTerm
| ScriptPath FilePath
data ViewCenterRule
=
VCLocation 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
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
defaultRobotStepsPerTick :: Int
defaultRobotStepsPerTick :: RID
defaultRobotStepsPerTick = RID
100
data GameState = GameState
{ GameState -> Bool
_creativeMode :: Bool
, 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 Integer [RID]
_waitingRobots :: Map Integer [RID]
, GameState -> Map Location IntSet
_robotsByLocation :: Map Location IntSet
, GameState -> Inventory
_allDiscoveredEntities :: Inventory
, GameState -> Notifications (Recipe Entity)
_availableRecipes :: Notifications (Recipe Entity)
, GameState -> Notifications Const
_availableCommands :: Notifications Const
, GameState -> RID
_gensym :: Int
, GameState -> RID
_seed :: Seed
, GameState -> StdGen
_randGen :: StdGen
, GameState -> Array RID Text
_adjList :: Array Int Text
, GameState -> Array RID Text
_nameList :: Array Int Text
, GameState -> EntityMap
_entityMap :: EntityMap
, GameState -> IntMap [Recipe Entity]
_recipesOut :: IntMap [Recipe Entity]
, GameState -> IntMap [Recipe Entity]
_recipesIn :: IntMap [Recipe Entity]
, GameState -> IntMap [Recipe Entity]
_recipesReq :: IntMap [Recipe Entity]
, GameState -> ScenarioCollection
_scenarios :: ScenarioCollection
, GameState -> Maybe String
_currentScenarioPath :: Maybe FilePath
, GameState -> [Text]
_knownEntities :: [Text]
, GameState -> World RID Entity
_world :: W.World Int Entity
, GameState -> ViewCenterRule
_viewCenterRule :: ViewCenterRule
, GameState -> Location
_viewCenter :: Location
, GameState -> Bool
_needsRedraw :: Bool
, GameState -> REPLStatus
_replStatus :: REPLStatus
, GameState -> Integer
_replNextValueIndex :: Integer
, GameState -> Seq LogEntry
_messageQueue :: Seq LogEntry
, GameState -> Integer
_lastSeenMessageTime :: Integer
, GameState -> RID
_focusedRobotID :: RID
, GameState -> Integer
_ticks :: Integer
, GameState -> RID
_robotStepsPerTick :: Int
}
makeLensesFor
[ ("_activeRobots", "internalActiveRobots")
, ("_waitingRobots", "internalWaitingRobots")
]
''GameState
let exclude = ['_viewCenter, '_focusedRobotID, '_viewCenterRule, '_activeRobots, '_waitingRobots, '_adjList, '_nameList]
in makeLensesWith
( lensRules
& generateSignatures .~ False
& lensField . mapped . mapped %~ \fn n ->
if n `elem` exclude then [] else fn n
)
''GameState
creativeMode :: Lens' GameState Bool
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 Location IntSet)
robotsAtLocation :: Location -> GameState -> [Robot]
robotsAtLocation :: Location -> GameState -> [Robot]
robotsAtLocation 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 Location
loc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Lens' GameState (Map Location IntSet)
robotsByLocation
forall a b. (a -> b) -> a -> b
$ GameState
gs
robotsInArea :: Location -> Int32 -> GameState -> [Robot]
robotsInArea :: Location -> Int32 -> GameState -> [Robot]
robotsInArea 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 Location IntSet
rl = GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState (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 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 Integer [RID])
waitingRobots :: Getter GameState (Map Integer [RID])
waitingRobots = Lens' GameState (Map Integer [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
entityMap :: Lens' GameState EntityMap
recipesOut :: Lens' GameState (IntMap [Recipe Entity])
recipesIn :: Lens' GameState (IntMap [Recipe Entity])
recipesReq :: Lens' GameState (IntMap [Recipe Entity])
scenarios :: Lens' GameState ScenarioCollection
currentScenarioPath :: Lens' GameState (Maybe FilePath)
knownEntities :: Lens' GameState [Text]
world :: Lens' GameState (W.World Int Entity)
viewCenter :: Getter GameState Location
viewCenter :: Getter GameState Location
viewCenter = forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to GameState -> Location
_viewCenter
needsRedraw :: Lens' GameState Bool
replStatus :: Lens' GameState REPLStatus
replNextValueIndex :: Lens' GameState Integer
messageQueue :: Lens' GameState (Seq LogEntry)
lastSeenMessageTime :: Lens' GameState Integer
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 Integer
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 Location
v2 -> GameState
g {_viewCenterRule :: ViewCenterRule
_viewCenterRule = ViewCenterRule
rule, _viewCenter :: Location
_viewCenter = Location
v2}
VCRobot RID
rid ->
let robotcenter :: Maybe 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 Location
robotLocation
in
case Maybe Location
robotcenter of
Maybe Location
Nothing -> GameState
g
Just Location
v2 -> GameState
g {_viewCenterRule :: ViewCenterRule
_viewCenterRule = ViewCenterRule
rule, _viewCenter :: Location
_viewCenter = Location
v2, _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 Integer
leTime forall a. Ord a => a -> a -> Bool
> GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState Integer
lastSeenMessageTime) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [LogEntry]
allUniq
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 = Location -> LogEntry -> Bool
messageIsFromNearby (GameState
gs forall s a. s -> Getting a s a -> a
^. Getter GameState 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 = LogEntry
e forall s a. s -> Getting a s a -> a
^. Lens' LogEntry Integer
leTime forall a. Ord a => a -> a -> Bool
>= GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState Integer
ticks forall a. Num a => a -> a -> a
- Integer
1
messageIsFromNearby :: Location -> LogEntry -> Bool
messageIsFromNearby :: Location -> LogEntry -> Bool
messageIsFromNearby Location
l LogEntry
e = Location -> Location -> Int32
manhattan Location
l (LogEntry
e forall s a. s -> Getting a s a -> a
^. Lens' LogEntry Location
leLocation) forall a. Ord a => a -> a -> Bool
<= forall i. Num i => i
hearingDistance
applyViewCenterRule :: ViewCenterRule -> IntMap Robot -> Maybe Location
applyViewCenterRule :: ViewCenterRule -> IntMap Robot -> Maybe Location
applyViewCenterRule (VCLocation Location
l) IntMap Robot
_ = forall a. a -> Maybe a
Just 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 Location
robotLocation
recalcViewCenter :: GameState -> GameState
recalcViewCenter :: GameState -> GameState
recalcViewCenter GameState
g =
GameState
g
{ _viewCenter :: Location
_viewCenter = Location
newViewCenter
}
forall a b. a -> (a -> b) -> b
& (if Location
newViewCenter forall a. Eq a => a -> a -> Bool
/= 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 :: Location
oldViewCenter = GameState
g forall s a. s -> Getting a s a -> a
^. Getter GameState Location
viewCenter
newViewCenter :: Location
newViewCenter = forall a. a -> Maybe a -> a
fromMaybe Location
oldViewCenter (ViewCenterRule -> IntMap Robot -> Maybe 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 :: (Location -> Location) -> GameState -> GameState
modifyViewCenter :: (Location -> Location) -> GameState -> GameState
modifyViewCenter Location -> 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 Location
l -> Lens' GameState ViewCenterRule
viewCenterRule forall s t a b. ASetter s t a b -> b -> s -> t
.~ Location -> ViewCenterRule
VCLocation (Location -> Location
update Location
l)
VCRobot RID
_ -> Lens' GameState ViewCenterRule
viewCenterRule forall s t a b. ASetter s t a b -> b -> s -> t
.~ Location -> ViewCenterRule
VCLocation (Location -> Location
update (GameState
g forall s a. s -> Getting a s a -> a
^. Getter GameState Location
viewCenter))
viewingRegion :: GameState -> (Int32, Int32) -> (W.Coords, W.Coords)
viewingRegion :: GameState -> (Int32, Int32) -> (Coords, Coords)
viewingRegion GameState
g (Int32
w, Int32
h) = ((Int32, Int32) -> Coords
W.Coords (Int32
rmin, Int32
cmin), (Int32, Int32) -> Coords
W.Coords (Int32
rmax, Int32
cmax))
where
Location Int32
cx Int32
cy = GameState
g forall s a. s -> Getting a s a -> a
^. Getter GameState 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)
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
Lens' GameState (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 IntSet -> IntSet -> IntSet
IS.union (Robot
r forall s a. s -> Getting a s a -> a
^. Getter Robot Location
robotLocation) (RID -> IntSet
IS.singleton RID
rid)
Lens' GameState IntSet
internalActiveRobots forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= RID -> IntSet -> IntSet
IS.insert RID
rid
maxMessageQueueSize :: Int
maxMessageQueueSize :: RID
maxMessageQueueSize = RID
1000
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 -> Integer -> m ()
sleepUntil :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> Integer -> m ()
sleepUntil RID
rid Integer
time = do
Lens' GameState IntSet
internalActiveRobots forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= RID -> IntSet -> IntSet
IS.delete RID
rid
Lens' GameState (Map Integer [RID])
internalWaitingRobots forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Integer
time forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> Iso' (Maybe a) a
non [] forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= (RID
rid forall a. a -> [a] -> [a]
:)
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
Integer
time <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState Integer
ticks
Maybe [RID]
mrids <- Lens' GameState (Map Integer [RID])
internalWaitingRobots forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Integer
time forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a b.
Has (State s) sig m =>
LensLike ((,) a) s s a b -> b -> m a
<<.= forall a. Maybe a
Nothing
case Maybe [RID]
mrids of
Maybe [RID]
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just [RID]
rids -> do
IntMap Robot
robots <- forall s a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
Getting a s a -> m a
use Lens' GameState (IntMap Robot)
robotMap
let aliveRids :: [RID]
aliveRids = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. RID -> IntMap a -> Bool
`IM.member` IntMap Robot
robots) [RID]
rids
Lens' GameState IntSet
internalActiveRobots forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= IntSet -> IntSet -> IntSet
IS.union ([RID] -> IntSet
IS.fromList [RID]
aliveRids)
deleteRobot :: Has (State GameState) sig m => RID -> m ()
deleteRobot :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
RID -> m ()
deleteRobot RID
rn = do
Lens' GameState IntSet
internalActiveRobots forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= RID -> IntSet -> IntSet
IS.delete RID
rn
Maybe Robot
mrobot <- Lens' GameState (IntMap Robot)
robotMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at RID
rn forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a b.
Has (State s) sig m =>
LensLike ((,) a) s s a b -> b -> m a
<<.= forall a. Maybe a
Nothing
Maybe Robot
mrobot forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
`forM_` \Robot
robot -> do
Lens' GameState (Map Location IntSet)
robotsByLocation forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix (Robot
robot forall s a. s -> Getting a s a -> a
^. Getter Robot Location
robotLocation) forall s a b (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State s) sig m =>
ASetter s s a b -> (a -> b) -> m ()
%= RID -> IntSet -> IntSet
IS.delete RID
rn
initGameState :: ExceptT Text IO GameState
initGameState :: ExceptT Text IO GameState
initGameState = do
let guardRight :: e -> Either e a -> m a
guardRight e
what Either e a
i = Either e a
i forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) b a.
Has (Throw e) sig m =>
Either b a -> (b -> e) -> m a
`isRightOr` (\e
e -> e
"Failed to " forall a. Semigroup a => a -> a -> a
<> e
what forall a. Semigroup a => a -> a -> a
<> e
": " forall a. Semigroup a => a -> a -> a
<> e
e)
EntityMap
entities <- forall (m :: * -> *). MonadIO m => m (Either Text EntityMap)
loadEntities forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {e} {sig :: (* -> *) -> * -> *} {m :: * -> *} {a}.
(Member (Throw e) sig, Algebra sig m, Semigroup e, IsString e) =>
e -> Either e a -> m a
guardRight Text
"load entities"
[Recipe Entity]
recipes <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Lift IO) sig m =>
EntityMap -> m (Either Text [Recipe Entity])
loadRecipes EntityMap
entities forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {e} {sig :: (* -> *) -> * -> *} {m :: * -> *} {a}.
(Member (Throw e) sig, Algebra sig m, Semigroup e, IsString e) =>
e -> Either e a -> m a
guardRight Text
"load recipes"
ScenarioCollection
loadedScenarios <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Lift IO) sig m =>
EntityMap -> m (Either Text ScenarioCollection)
loadScenarios EntityMap
entities forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {e} {sig :: (* -> *) -> * -> *} {m :: * -> *} {a}.
(Member (Throw e) sig, Algebra sig m, Semigroup e, IsString e) =>
e -> Either e a -> m a
guardRight Text
"load scenarios"
let markEx :: String -> m a -> m a
markEx String
what m a
a = forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError m a
a (\a
e -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Failed to " forall a. Semigroup a => a -> a -> a
<> String
what forall a. Semigroup a => a -> a -> a
<> String
": " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
e)
([Text]
adjs, [Text]
names) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {m :: * -> *} {a}.
(MonadError a m, MonadFail m, Show a) =>
String -> m a -> m a
markEx String
"load name generation data" forall a b. (a -> b) -> a -> b
$ do
Just String
adjsFile <- String -> IO (Maybe String)
getDataFileNameSafe String
"adjectives.txt"
[Text]
as <- forall a. [a] -> [a]
tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
T.readFile String
adjsFile
Just String
namesFile <- String -> IO (Maybe String)
getDataFileNameSafe String
"names.txt"
[Text]
ns <- forall a. [a] -> [a]
tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO Text
T.readFile String
namesFile
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text]
as, [Text]
ns)
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
GameState
{ _creativeMode :: Bool
_creativeMode = Bool
False
, _winCondition :: WinCondition
_winCondition = WinCondition
NoWinCondition
, _winSolution :: Maybe ProcessedTerm
_winSolution = forall a. Maybe a
Nothing
,
_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 Location IntSet
_robotsByLocation = forall k a. Map k a
M.empty
, _availableRecipes :: Notifications (Recipe Entity)
_availableRecipes = forall a. Monoid a => a
mempty
, _availableCommands :: Notifications Const
_availableCommands = forall a. Monoid a => a
mempty
, _allDiscoveredEntities :: Inventory
_allDiscoveredEntities = Inventory
empty
, _activeRobots :: IntSet
_activeRobots = IntSet
IS.empty
, _waitingRobots :: Map Integer [RID]
_waitingRobots = forall k a. Map k a
M.empty
, _gensym :: RID
_gensym = RID
0
, _seed :: RID
_seed = RID
0
, _randGen :: StdGen
_randGen = RID -> StdGen
mkStdGen RID
0
, _adjList :: Array RID Text
_adjList = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (RID
0, forall (t :: * -> *) a. Foldable t => t a -> RID
length [Text]
adjs forall a. Num a => a -> a -> a
- RID
1) [Text]
adjs
, _nameList :: Array RID Text
_nameList = forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (RID
0, forall (t :: * -> *) a. Foldable t => t a -> RID
length [Text]
names forall a. Num a => a -> a -> a
- RID
1) [Text]
names
, _entityMap :: EntityMap
_entityMap = EntityMap
entities
, _recipesOut :: IntMap [Recipe Entity]
_recipesOut = [Recipe Entity] -> IntMap [Recipe Entity]
outRecipeMap [Recipe Entity]
recipes
, _recipesIn :: IntMap [Recipe Entity]
_recipesIn = [Recipe Entity] -> IntMap [Recipe Entity]
inRecipeMap [Recipe Entity]
recipes
, _recipesReq :: IntMap [Recipe Entity]
_recipesReq = [Recipe Entity] -> IntMap [Recipe Entity]
reqRecipeMap [Recipe Entity]
recipes
, _scenarios :: ScenarioCollection
_scenarios = ScenarioCollection
loadedScenarios
, _currentScenarioPath :: Maybe String
_currentScenarioPath = forall a. Maybe a
Nothing
, _knownEntities :: [Text]
_knownEntities = []
, _world :: World RID Entity
_world = forall t e. t -> World t e
W.emptyWorld (forall a. Enum a => a -> RID
fromEnum TerrainType
StoneT)
, _viewCenterRule :: ViewCenterRule
_viewCenterRule = RID -> ViewCenterRule
VCRobot RID
0
, _viewCenter :: Location
_viewCenter = forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin
, _needsRedraw :: Bool
_needsRedraw = Bool
False
, _replStatus :: REPLStatus
_replStatus = Maybe (Typed Value) -> REPLStatus
REPLDone forall a. Maybe a
Nothing
, _replNextValueIndex :: Integer
_replNextValueIndex = Integer
0
, _messageQueue :: Seq LogEntry
_messageQueue = forall s. AsEmpty s => s
Empty
, _lastSeenMessageTime :: Integer
_lastSeenMessageTime = -Integer
1
, _focusedRobotID :: RID
_focusedRobotID = RID
0
, _ticks :: Integer
_ticks = Integer
0
, _robotStepsPerTick :: RID
_robotStepsPerTick = RID
defaultRobotStepsPerTick
}
scenarioToGameState :: Scenario -> Maybe Seed -> Maybe CodeToRun -> GameState -> IO GameState
scenarioToGameState :: Scenario
-> Maybe RID -> Maybe CodeToRun -> GameState -> IO GameState
scenarioToGameState Scenario
scenario Maybe RID
userSeed Maybe CodeToRun
toRun GameState
g = do
RID
theSeed <- case Maybe RID
userSeed forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario (Maybe RID)
scenarioSeed of
Just RID
s -> forall (m :: * -> *) a. Monad m => a -> m a
return RID
s
Maybe RID
Nothing -> forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (RID
0, forall a. Bounded a => a
maxBound :: Int)
TimeSpec
now <- Clock -> IO TimeSpec
Clock.getTime Clock
Clock.Monotonic
let robotList' :: [Robot]
robotList' = (Lens' Robot TimeSpec
robotCreatedAt forall s t a b. ASetter s t a b -> b -> s -> t
.~ TimeSpec
now) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Robot]
robotList
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
GameState
g
{ _creativeMode :: Bool
_creativeMode = Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario Bool
scenarioCreative
, _winCondition :: WinCondition
_winCondition = WinCondition
theWinCondition
, _winSolution :: Maybe ProcessedTerm
_winSolution = Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario (Maybe ProcessedTerm)
scenarioSolution
, _runStatus :: RunStatus
_runStatus = RunStatus
Running
, _robotMap :: IntMap Robot
_robotMap = forall a. [(RID, a)] -> IntMap a
IM.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getter Robot RID
robotID forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id) [Robot]
robotList'
, _robotsByLocation :: Map Location IntSet
_robotsByLocation =
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith IntSet -> IntSet -> IntSet
IS.union forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getter Robot Location
robotLocation forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& (RID -> IntSet
IS.singleton forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getter Robot RID
robotID)) [Robot]
robotList'
, _activeRobots :: IntSet
_activeRobots = forall s. Getting IntSet s RID -> s -> IntSet
setOf (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getter Robot RID
robotID) [Robot]
robotList'
, _availableCommands :: Notifications Const
_availableCommands = forall a. RID -> [a] -> Notifications a
Notifications RID
0 [Const]
initialCommands
, _waitingRobots :: Map Integer [RID]
_waitingRobots = forall k a. Map k a
M.empty
, _gensym :: RID
_gensym = RID
initGensym
, _seed :: RID
_seed = RID
theSeed
, _randGen :: StdGen
_randGen = RID -> StdGen
mkStdGen RID
theSeed
, _entityMap :: EntityMap
_entityMap = EntityMap
em
, _recipesOut :: IntMap [Recipe Entity]
_recipesOut = forall {a}.
Semigroup a =>
([Recipe Entity] -> IntMap a)
-> Getting (IntMap a) GameState (IntMap a) -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap [Recipe Entity]
outRecipeMap Lens' GameState (IntMap [Recipe Entity])
recipesOut
, _recipesIn :: IntMap [Recipe Entity]
_recipesIn = forall {a}.
Semigroup a =>
([Recipe Entity] -> IntMap a)
-> Getting (IntMap a) GameState (IntMap a) -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap [Recipe Entity]
inRecipeMap Lens' GameState (IntMap [Recipe Entity])
recipesIn
, _recipesReq :: IntMap [Recipe Entity]
_recipesReq = forall {a}.
Semigroup a =>
([Recipe Entity] -> IntMap a)
-> Getting (IntMap a) GameState (IntMap a) -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap [Recipe Entity]
reqRecipeMap Lens' GameState (IntMap [Recipe Entity])
recipesReq
, _knownEntities :: [Text]
_knownEntities = Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario [Text]
scenarioKnown
, _world :: World RID Entity
_world = RID -> World RID Entity
theWorld RID
theSeed
, _viewCenterRule :: ViewCenterRule
_viewCenterRule = RID -> ViewCenterRule
VCRobot RID
baseID
, _viewCenter :: Location
_viewCenter = forall (f :: * -> *) a. (Additive f, Num a) => Point f a
origin
, _needsRedraw :: Bool
_needsRedraw = Bool
False
,
_replStatus :: REPLStatus
_replStatus = 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)
, _replNextValueIndex :: Integer
_replNextValueIndex = Integer
0
, _messageQueue :: Seq LogEntry
_messageQueue = forall s. AsEmpty s => s
Empty
, _focusedRobotID :: RID
_focusedRobotID = RID
baseID
, _ticks :: Integer
_ticks = Integer
0
, _robotStepsPerTick :: RID
_robotStepsPerTick = (Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario (Maybe RID)
scenarioStepsPerTick) forall a. Maybe a -> a -> a
? RID
defaultRobotStepsPerTick
}
where
em :: EntityMap
em = GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState EntityMap
entityMap forall a. Semigroup a => a -> a -> a
<> Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario EntityMap
scenarioEntities
baseID :: RID
baseID = RID
0
([Entity]
things, [Entity]
devices) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Lens' Entity (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 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
x = case CodeToRun
x of
SuggestedSolution ProcessedTerm
s -> ProcessedTerm
s
ScriptPath (forall target source. From source target => source -> target
into @Text -> Text
f) -> [tmQ| run($str:f) |]
robotsByBasePrecedence :: [TRobot]
robotsByBasePrecedence = [TRobot]
locatedRobots forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a b. (a, b) -> a
fst [IndexedTRobot]
genRobots)
robotList :: [Robot]
robotList =
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith RID -> TRobot -> Robot
instantiateRobot [RID
baseID ..] [TRobot]
robotsByBasePrecedence
forall a b. a -> (a -> b) -> b
& forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix RID
baseID forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Robot CESK
machine
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ case CodeToRun -> ProcessedTerm
getCodeToRun forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CodeToRun
toRun of
Maybe ProcessedTerm
Nothing -> forall a. a -> a
id
Just ProcessedTerm
pt -> forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ ProcessedTerm -> Env -> Store -> CESK
initMachine ProcessedTerm
pt forall t. Ctx t
Ctx.empty Store
emptyStore
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
([IndexedTRobot]
genRobots, RID -> WorldFun RID Entity
wf) = EntityMap
-> WorldDescription
-> ([IndexedTRobot], RID -> WorldFun RID Entity)
buildWorld EntityMap
em (Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario WorldDescription
scenarioWorld)
theWorld :: RID -> World RID Entity
theWorld = forall t e. WorldFun t e -> World t e
W.newWorld forall b c a. (b -> c) -> (a -> b) -> a -> c
. RID -> WorldFun RID Entity
wf
theWinCondition :: WinCondition
theWinCondition =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
WinCondition
NoWinCondition
(\NonEmpty Objective
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)
-> Getting (IntMap a) GameState (IntMap a) -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap a
f Getting (IntMap a) GameState (IntMap a)
gRs = forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IM.unionWith forall a. Semigroup a => a -> a -> a
(<>) ([Recipe Entity] -> IntMap a
f forall a b. (a -> b) -> a -> b
$ Scenario
scenario forall s a. s -> Getting a s a -> a
^. Lens' Scenario [Recipe Entity]
scenarioRecipes) (GameState
g forall s a. s -> Getting a s a -> a
^. Getting (IntMap a) GameState (IntMap a)
gRs)
buildWorld :: EntityMap -> WorldDescription -> ([IndexedTRobot], Seed -> WorldFun Int Entity)
buildWorld :: EntityMap
-> WorldDescription
-> ([IndexedTRobot], RID -> WorldFun RID Entity)
buildWorld EntityMap
em WorldDescription {Bool
[[PCell Entity]]
Maybe (PCell Entity)
Location
WorldPalette Entity
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
defaultTerrain :: forall e. PWorldDescription e -> Maybe (PCell e)
area :: [[PCell Entity]]
ul :: Location
palette :: WorldPalette Entity
offsetOrigin :: Bool
defaultTerrain :: Maybe (PCell Entity)
..} = ([IndexedTRobot]
robots, forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. Enum a => a -> RID
fromEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. RID -> WorldFun TerrainType Entity
wf)
where
rs :: 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, Maybe Entity)]]
worldGrid :: [[(TerrainType, Maybe Entity)]]
worldGrid = (forall a b. (a -> b) -> [a] -> [b]
map forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map) (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 -> Maybe e
cellEntity) [[PCell Entity]]
area
worldArray :: Array (Int32, Int32) (TerrainType, Maybe Entity)
worldArray :: Array (Int32, Int32) (TerrainType, Maybe 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, Maybe Entity)]]
worldGrid)
wf :: RID -> WorldFun TerrainType Entity
wf = case Maybe (PCell Entity)
defaultTerrain of
Maybe (PCell Entity)
Nothing ->
(if Bool
offsetOrigin then forall t. WorldFun t Entity -> WorldFun t Entity
findGoodOrigin else forall a. a -> a
id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntityMap
-> Array (Int32, Int32) (TerrainType, Maybe Entity)
-> RID
-> WorldFun TerrainType Entity
testWorld2FromArray EntityMap
em Array (Int32, Int32) (TerrainType, Maybe Entity)
worldArray
Just (Cell TerrainType
t Maybe Entity
e [IndexedTRobot]
_) -> forall a b. a -> b -> a
const (forall t e.
Array (Int32, Int32) (t, Maybe e) -> (t, Maybe e) -> WorldFun t e
worldFunFromArray Array (Int32, Int32) (TerrainType, Maybe Entity)
worldArray (TerrainType
t, Maybe Entity
e))
robots :: [IndexedTRobot]
robots :: [IndexedTRobot]
robots =
[[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
_ Maybe Entity
_ [IndexedTRobot]
robotList) ->
let robotWithLoc :: TRobot -> TRobot
robotWithLoc = Lens' TRobot (Maybe Location)
trobotLocation forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ 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
)
initGameStateForScenario :: String -> Maybe Seed -> Maybe FilePath -> ExceptT Text IO GameState
initGameStateForScenario :: String -> Maybe RID -> Maybe String -> ExceptT Text IO GameState
initGameStateForScenario String
sceneName Maybe RID
userSeed Maybe String
toRun = do
GameState
g <- ExceptT Text IO GameState
initGameState
(Scenario
scene, String
path) <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Lift IO) sig m, Has (Throw Text) sig m) =>
String -> EntityMap -> m (Scenario, String)
loadScenario String
sceneName (GameState
g forall s a. s -> Getting a s a -> a
^. Lens' GameState EntityMap
entityMap)
GameState
gs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Scenario
-> Maybe RID -> Maybe CodeToRun -> GameState -> IO GameState
scenarioToGameState Scenario
scene Maybe RID
userSeed (String -> CodeToRun
ScriptPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
toRun) GameState
g
String
normalPath <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ScenarioCollection -> String -> IO String
normalizeScenarioPath (GameState
gs forall s a. s -> Getting a s a -> a
^. Lens' GameState ScenarioCollection
scenarios) String
path
ZonedTime
t <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ZonedTime
getZonedTime
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
GameState
gs
forall a b. a -> (a -> b) -> b
& Lens' GameState (Maybe String)
currentScenarioPath forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ String
normalPath
forall a b. a -> (a -> b) -> b
& Lens' GameState ScenarioCollection
scenarios forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Traversal' ScenarioCollection ScenarioItem
scenarioItemByPath String
normalPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. Prism' ScenarioItem ScenarioInfoPair
_SISingle forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. Field2 s t a b => Lens s t a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' ScenarioInfo ScenarioStatus
scenarioStatus forall s t a b. ASetter s t a b -> b -> s -> t
.~ ZonedTime -> NominalDiffTime -> Integer -> ScenarioStatus
InProgress ZonedTime
t NominalDiffTime
0 Integer
0
classicGame0 :: ExceptT Text IO GameState
classicGame0 :: ExceptT Text IO GameState
classicGame0 = String -> Maybe RID -> Maybe String -> ExceptT Text IO GameState
initGameStateForScenario String
"classic" (forall a. a -> Maybe a
Just RID
0) forall a. Maybe a
Nothing