-- SPDX-License-Identifier: BSD-3-Clause
-- Description: Game-related state and utilities
--
-- Definition of the record holding all the game-related state, and various related
-- utility functions.
module Swarm.Game.State.Initialize (
  scenarioToGameState,
  pureScenarioToGameState,
) where

import Control.Arrow (Arrow ((&&&)))
import Control.Carrier.State.Lazy qualified as Fused
import Control.Effect.Lens (view)
import Control.Effect.Lift (Has)
import Control.Effect.State (State)
import Control.Lens hiding (Const, use, uses, view, (%=), (+=), (.=), (<+=), (<<.=))
import Data.Foldable.Extra (allM)
import Data.IntMap qualified as IM
import Data.List (partition)
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 (isNothing)
import Data.Set qualified as S
import Data.Text (Text)
import Linear (V2 (..))
import Swarm.Game.CESK (finalValue, initMachine)
import Swarm.Game.Device (getCapabilitySet, getMap)
import Swarm.Game.Entity
import Swarm.Game.Land
import Swarm.Game.Recipe (
  catRecipeMap,
  inRecipeMap,
  outRecipeMap,
 )
import Swarm.Game.Robot
import Swarm.Game.Robot.Concrete
import Swarm.Game.Scenario
import Swarm.Game.Scenario.Objective (initCompletion)
import Swarm.Game.Scenario.Status
import Swarm.Game.Scenario.Topography.Structure.Recognition
import Swarm.Game.Scenario.Topography.Structure.Recognition.Log
import Swarm.Game.Scenario.Topography.Structure.Recognition.Precompute
import Swarm.Game.Scenario.Topography.Structure.Recognition.Type
import Swarm.Game.State
import Swarm.Game.State.Landscape (mkLandscape)
import Swarm.Game.State.Robot (setRobotInfo)
import Swarm.Game.State.Substate
import Swarm.Game.Universe as U (offsetBy)
import Swarm.Game.World.Gen (Seed)
import Swarm.Language.Capability (constCaps)
import Swarm.Language.Syntax (allConst)
import Swarm.Language.Types
import Swarm.Util (binTuples, (?))
import System.Clock qualified as Clock
import System.Random (mkStdGen)

-- | Create an initial game state corresponding to the given scenario.
scenarioToGameState ::
  Scenario ->
  ValidatedLaunchParams ->
  GameStateConfig ->
  IO GameState
scenarioToGameState :: Scenario
-> ValidatedLaunchParams -> GameStateConfig -> IO GameState
scenarioToGameState Scenario
scenario (LaunchParams (Identity Maybe Seed
userSeed) (Identity Maybe CodeToRun
toRun)) GameStateConfig
gsc = do
  Seed
theSeed <- Maybe Seed -> ScenarioLandscape -> IO Seed
arbitrateSeed Maybe Seed
userSeed (ScenarioLandscape -> IO Seed) -> ScenarioLandscape -> IO Seed
forall a b. (a -> b) -> a -> b
$ Scenario
scenario Scenario
-> Getting ScenarioLandscape Scenario ScenarioLandscape
-> ScenarioLandscape
forall s a. s -> Getting a s a -> a
^. Getting ScenarioLandscape Scenario ScenarioLandscape
Lens' Scenario ScenarioLandscape
scenarioLandscape
  TimeSpec
now <- Clock -> IO TimeSpec
Clock.getTime Clock
Clock.Monotonic
  GameState -> IO GameState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (GameState -> IO GameState) -> GameState -> IO GameState
forall a b. (a -> b) -> a -> b
$ Scenario
-> Seed
-> TimeSpec
-> Maybe CodeToRun
-> GameStateConfig
-> GameState
pureScenarioToGameState Scenario
scenario Seed
theSeed TimeSpec
now Maybe CodeToRun
toRun GameStateConfig
gsc

pureScenarioToGameState ::
  Scenario ->
  Seed ->
  Clock.TimeSpec ->
  Maybe CodeToRun ->
  GameStateConfig ->
  GameState
pureScenarioToGameState :: Scenario
-> Seed
-> TimeSpec
-> Maybe CodeToRun
-> GameStateConfig
-> GameState
pureScenarioToGameState Scenario
scenario Seed
theSeed TimeSpec
now Maybe CodeToRun
toRun GameStateConfig
gsc =
  GameState
preliminaryGameState
    GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Discovery -> Identity Discovery)
-> GameState -> Identity GameState
Lens' GameState Discovery
discovery ((Discovery -> Identity Discovery)
 -> GameState -> Identity GameState)
-> ((StructureRecognizer StructureCells Entity
     -> Identity (StructureRecognizer StructureCells Entity))
    -> Discovery -> Identity Discovery)
-> (StructureRecognizer StructureCells Entity
    -> Identity (StructureRecognizer StructureCells Entity))
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StructureRecognizer StructureCells Entity
 -> Identity (StructureRecognizer StructureCells Entity))
-> Discovery -> Identity Discovery
Lens' Discovery (StructureRecognizer StructureCells Entity)
structureRecognition ((StructureRecognizer StructureCells Entity
  -> Identity (StructureRecognizer StructureCells Entity))
 -> GameState -> Identity GameState)
-> StructureRecognizer StructureCells Entity
-> GameState
-> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StructureRecognizer StructureCells Entity
recognizer
 where
  sLandscape :: ScenarioLandscape
sLandscape = Scenario
scenario Scenario
-> Getting ScenarioLandscape Scenario ScenarioLandscape
-> ScenarioLandscape
forall s a. s -> Getting a s a -> a
^. Getting ScenarioLandscape Scenario ScenarioLandscape
Lens' Scenario ScenarioLandscape
scenarioLandscape

  recognizer :: StructureRecognizer StructureCells Entity
recognizer =
    Identity (StructureRecognizer StructureCells Entity)
-> StructureRecognizer StructureCells Entity
forall a. Identity a -> a
runIdentity (Identity (StructureRecognizer StructureCells Entity)
 -> StructureRecognizer StructureCells Entity)
-> Identity (StructureRecognizer StructureCells Entity)
-> StructureRecognizer StructureCells Entity
forall a b. (a -> b) -> a -> b
$
      GameState
-> StateC
     GameState Identity (StructureRecognizer StructureCells Entity)
-> Identity (StructureRecognizer StructureCells Entity)
forall s (m :: * -> *) a. Functor m => s -> StateC s m a -> m a
Fused.evalState GameState
preliminaryGameState (StateC
   GameState Identity (StructureRecognizer StructureCells Entity)
 -> Identity (StructureRecognizer StructureCells Entity))
-> StateC
     GameState Identity (StructureRecognizer StructureCells Entity)
-> Identity (StructureRecognizer StructureCells Entity)
forall a b. (a -> b) -> a -> b
$
        StaticStructureInfo
-> StateC
     GameState Identity (StructureRecognizer StructureCells Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
StaticStructureInfo
-> m (StructureRecognizer StructureCells Entity)
mkRecognizer (ScenarioLandscape
sLandscape ScenarioLandscape
-> Getting
     StaticStructureInfo ScenarioLandscape StaticStructureInfo
-> StaticStructureInfo
forall s a. s -> Getting a s a -> a
^. Getting StaticStructureInfo ScenarioLandscape StaticStructureInfo
Lens' ScenarioLandscape StaticStructureInfo
scenarioStructures)

  gs :: GameState
gs = GameStateConfig -> GameState
initGameState GameStateConfig
gsc
  preliminaryGameState :: GameState
preliminaryGameState =
    GameState
gs
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Robots -> Identity Robots) -> GameState -> Identity GameState
Lens' GameState Robots
robotInfo ((Robots -> Identity Robots) -> GameState -> Identity GameState)
-> (Robots -> Robots) -> GameState -> GameState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Seed -> [Robot] -> Robots -> Robots
setRobotInfo Seed
baseID [Robot]
robotList'
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Bool -> Identity Bool) -> GameState -> Identity GameState
Lens' GameState Bool
creativeMode ((Bool -> Identity Bool) -> GameState -> Identity GameState)
-> Bool -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Scenario
scenario Scenario -> Getting Bool Scenario Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (ScenarioOperation -> Const Bool ScenarioOperation)
-> Scenario -> Const Bool Scenario
Lens' Scenario ScenarioOperation
scenarioOperation ((ScenarioOperation -> Const Bool ScenarioOperation)
 -> Scenario -> Const Bool Scenario)
-> ((Bool -> Const Bool Bool)
    -> ScenarioOperation -> Const Bool ScenarioOperation)
-> Getting Bool Scenario Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> ScenarioOperation -> Const Bool ScenarioOperation
Lens' ScenarioOperation Bool
scenarioCreative
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (WinCondition -> Identity WinCondition)
-> GameState -> Identity GameState
Lens' GameState WinCondition
winCondition ((WinCondition -> Identity WinCondition)
 -> GameState -> Identity GameState)
-> WinCondition -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WinCondition
theWinCondition
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Maybe TSyntax -> Identity (Maybe TSyntax))
-> GameState -> Identity GameState
Lens' GameState (Maybe TSyntax)
winSolution ((Maybe TSyntax -> Identity (Maybe TSyntax))
 -> GameState -> Identity GameState)
-> Maybe TSyntax -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Scenario
scenario Scenario
-> Getting (Maybe TSyntax) Scenario (Maybe TSyntax)
-> Maybe TSyntax
forall s a. s -> Getting a s a -> a
^. (ScenarioOperation -> Const (Maybe TSyntax) ScenarioOperation)
-> Scenario -> Const (Maybe TSyntax) Scenario
Lens' Scenario ScenarioOperation
scenarioOperation ((ScenarioOperation -> Const (Maybe TSyntax) ScenarioOperation)
 -> Scenario -> Const (Maybe TSyntax) Scenario)
-> ((Maybe TSyntax -> Const (Maybe TSyntax) (Maybe TSyntax))
    -> ScenarioOperation -> Const (Maybe TSyntax) ScenarioOperation)
-> Getting (Maybe TSyntax) Scenario (Maybe TSyntax)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe TSyntax -> Const (Maybe TSyntax) (Maybe TSyntax))
-> ScenarioOperation -> Const (Maybe TSyntax) ScenarioOperation
Lens' ScenarioOperation (Maybe TSyntax)
scenarioSolution
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Discovery -> Identity Discovery)
-> GameState -> Identity GameState
Lens' GameState Discovery
discovery ((Discovery -> Identity Discovery)
 -> GameState -> Identity GameState)
-> ((Notifications Const -> Identity (Notifications Const))
    -> Discovery -> Identity Discovery)
-> (Notifications Const -> Identity (Notifications Const))
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Notifications Const -> Identity (Notifications Const))
-> Discovery -> Identity Discovery
Lens' Discovery (Notifications Const)
availableCommands ((Notifications Const -> Identity (Notifications Const))
 -> GameState -> Identity GameState)
-> Notifications Const -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seed -> Bool -> [Const] -> Notifications Const
forall a. Seed -> Bool -> [a] -> Notifications a
Notifications Seed
0 Bool
False [Const]
initialCommands
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Discovery -> Identity Discovery)
-> GameState -> Identity GameState
Lens' GameState Discovery
discovery ((Discovery -> Identity Discovery)
 -> GameState -> Identity GameState)
-> ((Set Text -> Identity (Set Text))
    -> Discovery -> Identity Discovery)
-> (Set Text -> Identity (Set Text))
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Set Text -> Identity (Set Text))
-> Discovery -> Identity Discovery
Lens' Discovery (Set Text)
knownEntities ((Set Text -> Identity (Set Text))
 -> GameState -> Identity GameState)
-> Set Text -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ScenarioLandscape
sLandscape ScenarioLandscape
-> Getting (Set Text) ScenarioLandscape (Set Text) -> Set Text
forall s a. s -> Getting a s a -> a
^. Getting (Set Text) ScenarioLandscape (Set Text)
Lens' ScenarioLandscape (Set Text)
scenarioKnown
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Discovery -> Identity Discovery)
-> GameState -> Identity GameState
Lens' GameState Discovery
discovery ((Discovery -> Identity Discovery)
 -> GameState -> Identity GameState)
-> ((Map Text (NonEmpty Text)
     -> Identity (Map Text (NonEmpty Text)))
    -> Discovery -> Identity Discovery)
-> (Map Text (NonEmpty Text)
    -> Identity (Map Text (NonEmpty Text)))
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Text (NonEmpty Text) -> Identity (Map Text (NonEmpty Text)))
-> Discovery -> Identity Discovery
Lens' Discovery (Map Text (NonEmpty Text))
tagMembers ((Map Text (NonEmpty Text) -> Identity (Map Text (NonEmpty Text)))
 -> GameState -> Identity GameState)
-> Map Text (NonEmpty Text) -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ EntityMap -> Map Text (NonEmpty Text)
buildTagMap EntityMap
em
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Randomness -> Identity Randomness)
-> GameState -> Identity GameState
Lens' GameState Randomness
randomness ((Randomness -> Identity Randomness)
 -> GameState -> Identity GameState)
-> ((Seed -> Identity Seed) -> Randomness -> Identity Randomness)
-> (Seed -> Identity Seed)
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seed -> Identity Seed) -> Randomness -> Identity Randomness
Lens' Randomness Seed
seed ((Seed -> Identity Seed) -> GameState -> Identity GameState)
-> Seed -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seed
theSeed
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Randomness -> Identity Randomness)
-> GameState -> Identity GameState
Lens' GameState Randomness
randomness ((Randomness -> Identity Randomness)
 -> GameState -> Identity GameState)
-> ((StdGen -> Identity StdGen)
    -> Randomness -> Identity Randomness)
-> (StdGen -> Identity StdGen)
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StdGen -> Identity StdGen) -> Randomness -> Identity Randomness
Lens' Randomness StdGen
randGen ((StdGen -> Identity StdGen) -> GameState -> Identity GameState)
-> StdGen -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Seed -> StdGen
mkStdGen Seed
theSeed
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Recipes -> Identity Recipes) -> GameState -> Identity GameState
Lens' GameState Recipes
recipesInfo ((Recipes -> Identity Recipes) -> GameState -> Identity GameState)
-> (Recipes -> Recipes) -> GameState -> GameState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Recipes -> Recipes
modifyRecipesInfo
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (Landscape -> Identity Landscape)
-> GameState -> Identity GameState
Lens' GameState Landscape
landscape ((Landscape -> Identity Landscape)
 -> GameState -> Identity GameState)
-> Landscape -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ScenarioLandscape
-> NonEmpty SubworldDescription -> Seed -> Landscape
mkLandscape ScenarioLandscape
sLandscape NonEmpty SubworldDescription
worldTuples Seed
theSeed
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (GameControls -> Identity GameControls)
-> GameState -> Identity GameState
Lens' GameState GameControls
gameControls ((GameControls -> Identity GameControls)
 -> GameState -> Identity GameState)
-> ((Maybe TSyntax -> Identity (Maybe TSyntax))
    -> GameControls -> Identity GameControls)
-> (Maybe TSyntax -> Identity (Maybe TSyntax))
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe TSyntax -> Identity (Maybe TSyntax))
-> GameControls -> Identity GameControls
Lens' GameControls (Maybe TSyntax)
initiallyRunCode ((Maybe TSyntax -> Identity (Maybe TSyntax))
 -> GameState -> Identity GameState)
-> Maybe TSyntax -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe TSyntax
initialCodeToRun
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (GameControls -> Identity GameControls)
-> GameState -> Identity GameState
Lens' GameState GameControls
gameControls ((GameControls -> Identity GameControls)
 -> GameState -> Identity GameState)
-> ((REPLStatus -> Identity REPLStatus)
    -> GameControls -> Identity GameControls)
-> (REPLStatus -> Identity REPLStatus)
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (REPLStatus -> Identity REPLStatus)
-> GameControls -> Identity GameControls
Lens' GameControls REPLStatus
replStatus ((REPLStatus -> Identity REPLStatus)
 -> GameState -> Identity GameState)
-> REPLStatus -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ case Bool
running of -- When the base starts out running a program, the REPL status must be set to working,
      -- otherwise the store of definition cells is not saved (see #333, #838)
        Bool
False -> Maybe (Polytype, Value) -> REPLStatus
REPLDone Maybe (Polytype, Value)
forall a. Maybe a
Nothing
        Bool
True -> Polytype -> Maybe Value -> REPLStatus
REPLWorking Polytype
PolyUnit Maybe Value
forall a. Maybe a
Nothing
      GameState -> (GameState -> GameState) -> GameState
forall a b. a -> (a -> b) -> b
& (TemporalState -> Identity TemporalState)
-> GameState -> Identity GameState
Lens' GameState TemporalState
temporal ((TemporalState -> Identity TemporalState)
 -> GameState -> Identity GameState)
-> ((Seed -> Identity Seed)
    -> TemporalState -> Identity TemporalState)
-> (Seed -> Identity Seed)
-> GameState
-> Identity GameState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Seed -> Identity Seed) -> TemporalState -> Identity TemporalState
Lens' TemporalState Seed
robotStepsPerTick ((Seed -> Identity Seed) -> GameState -> Identity GameState)
-> Seed -> GameState -> GameState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ((Scenario
scenario Scenario
-> Getting (Maybe Seed) Scenario (Maybe Seed) -> Maybe Seed
forall s a. s -> Getting a s a -> a
^. (ScenarioOperation -> Const (Maybe Seed) ScenarioOperation)
-> Scenario -> Const (Maybe Seed) Scenario
Lens' Scenario ScenarioOperation
scenarioOperation ((ScenarioOperation -> Const (Maybe Seed) ScenarioOperation)
 -> Scenario -> Const (Maybe Seed) Scenario)
-> ((Maybe Seed -> Const (Maybe Seed) (Maybe Seed))
    -> ScenarioOperation -> Const (Maybe Seed) ScenarioOperation)
-> Getting (Maybe Seed) Scenario (Maybe Seed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Seed -> Const (Maybe Seed) (Maybe Seed))
-> ScenarioOperation -> Const (Maybe Seed) ScenarioOperation
Lens' ScenarioOperation (Maybe Seed)
scenarioStepsPerTick) Maybe Seed -> Seed -> Seed
forall a. Maybe a -> a -> a
? Seed
defaultRobotStepsPerTick)

  robotList' :: [Robot]
robotList' = ((TimeSpec -> Identity TimeSpec) -> Robot -> Identity Robot
Lens' Robot TimeSpec
robotCreatedAt ((TimeSpec -> Identity TimeSpec) -> Robot -> Identity Robot)
-> TimeSpec -> Robot -> Robot
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TimeSpec
now) (Robot -> Robot) -> [Robot] -> [Robot]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Robot]
robotList

  modifyRecipesInfo :: Recipes -> Recipes
modifyRecipesInfo Recipes
oldRecipesInfo =
    Recipes
oldRecipesInfo
      Recipes -> (Recipes -> Recipes) -> Recipes
forall a b. a -> (a -> b) -> b
& (IntMap [Recipe Entity] -> Identity (IntMap [Recipe Entity]))
-> Recipes -> Identity Recipes
Lens' Recipes (IntMap [Recipe Entity])
recipesOut ((IntMap [Recipe Entity] -> Identity (IntMap [Recipe Entity]))
 -> Recipes -> Identity Recipes)
-> (IntMap [Recipe Entity] -> IntMap [Recipe Entity])
-> Recipes
-> Recipes
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Recipe Entity] -> IntMap [Recipe Entity])
-> IntMap [Recipe Entity] -> IntMap [Recipe Entity]
forall {a}.
Semigroup a =>
([Recipe Entity] -> IntMap a) -> IntMap a -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap [Recipe Entity]
outRecipeMap
      Recipes -> (Recipes -> Recipes) -> Recipes
forall a b. a -> (a -> b) -> b
& (IntMap [Recipe Entity] -> Identity (IntMap [Recipe Entity]))
-> Recipes -> Identity Recipes
Lens' Recipes (IntMap [Recipe Entity])
recipesIn ((IntMap [Recipe Entity] -> Identity (IntMap [Recipe Entity]))
 -> Recipes -> Identity Recipes)
-> (IntMap [Recipe Entity] -> IntMap [Recipe Entity])
-> Recipes
-> Recipes
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Recipe Entity] -> IntMap [Recipe Entity])
-> IntMap [Recipe Entity] -> IntMap [Recipe Entity]
forall {a}.
Semigroup a =>
([Recipe Entity] -> IntMap a) -> IntMap a -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap [Recipe Entity]
inRecipeMap
      Recipes -> (Recipes -> Recipes) -> Recipes
forall a b. a -> (a -> b) -> b
& (IntMap [Recipe Entity] -> Identity (IntMap [Recipe Entity]))
-> Recipes -> Identity Recipes
Lens' Recipes (IntMap [Recipe Entity])
recipesCat ((IntMap [Recipe Entity] -> Identity (IntMap [Recipe Entity]))
 -> Recipes -> Identity Recipes)
-> (IntMap [Recipe Entity] -> IntMap [Recipe Entity])
-> Recipes
-> Recipes
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ ([Recipe Entity] -> IntMap [Recipe Entity])
-> IntMap [Recipe Entity] -> IntMap [Recipe Entity]
forall {a}.
Semigroup a =>
([Recipe Entity] -> IntMap a) -> IntMap a -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap [Recipe Entity]
catRecipeMap

  TerrainEntityMaps TerrainMap
_ EntityMap
em = ScenarioLandscape
sLandscape ScenarioLandscape
-> Getting TerrainEntityMaps ScenarioLandscape TerrainEntityMaps
-> TerrainEntityMaps
forall s a. s -> Getting a s a -> a
^. Getting TerrainEntityMaps ScenarioLandscape TerrainEntityMaps
Lens' ScenarioLandscape TerrainEntityMaps
scenarioTerrainAndEntities
  baseID :: Seed
baseID = Seed
0
  ([Entity]
things, [Entity]
devices) = (Entity -> Bool) -> [Entity] -> ([Entity], [Entity])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Map Capability (ExerciseCost Text) -> Bool
forall k a. Map k a -> Bool
M.null (Map Capability (ExerciseCost Text) -> Bool)
-> (Entity -> Map Capability (ExerciseCost Text)) -> Entity -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SingleEntityCapabilities Text -> Map Capability (ExerciseCost Text)
forall e. Capabilities e -> Map Capability e
getMap (SingleEntityCapabilities Text
 -> Map Capability (ExerciseCost Text))
-> (Entity -> SingleEntityCapabilities Text)
-> Entity
-> Map Capability (ExerciseCost Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (SingleEntityCapabilities Text)
  Entity
  (SingleEntityCapabilities Text)
-> Entity -> SingleEntityCapabilities Text
forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getting
  (SingleEntityCapabilities Text)
  Entity
  (SingleEntityCapabilities Text)
Lens' Entity (SingleEntityCapabilities Text)
entityCapabilities) (Map Text Entity -> [Entity]
forall k a. Map k a -> [a]
M.elems (EntityMap -> Map Text Entity
entitiesByName EntityMap
em))

  getCodeToRun :: CodeToRun -> TSyntax
getCodeToRun (CodeToRun SolutionSource
_ TSyntax
s) = TSyntax
s

  robotsByBasePrecedence :: [TRobot]
robotsByBasePrecedence = ScenarioLandscape -> NonEmpty SubworldDescription -> [TRobot]
forall a b.
ScenarioLandscape
-> NonEmpty (a, ([(Seed, TRobot)], b)) -> [TRobot]
genRobotTemplates ScenarioLandscape
sLandscape NonEmpty SubworldDescription
worldTuples

  initialCodeToRun :: Maybe TSyntax
initialCodeToRun = CodeToRun -> TSyntax
getCodeToRun (CodeToRun -> TSyntax) -> Maybe CodeToRun -> Maybe TSyntax
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CodeToRun
toRun

  robotListRaw :: [Robot]
robotListRaw =
    (Seed -> TRobot -> Robot) -> [Seed] -> [TRobot] -> [Robot]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Maybe CESK -> Seed -> TRobot -> Robot
instantiateRobot Maybe CESK
forall a. Maybe a
Nothing) [Seed
baseID ..] [TRobot]
robotsByBasePrecedence

  robotList :: [Robot]
robotList =
    [Robot]
robotListRaw
      -- If the  --run flag was used, use it to replace the CESK machine of the
      -- robot whose id is 0, i.e. the first robot listed in the scenario.
      -- Note that this *replaces* any program the base robot otherwise
      -- would have run (i.e. any program specified in the program: field
      -- of the scenario description).
      [Robot] -> ([Robot] -> [Robot]) -> [Robot]
forall a b. a -> (a -> b) -> b
& Index [Robot] -> Traversal' [Robot] (IxValue [Robot])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Seed
Index [Robot]
baseID
        ((Robot -> Identity Robot) -> [Robot] -> Identity [Robot])
-> ((CESK -> Identity CESK) -> Robot -> Identity Robot)
-> (CESK -> Identity CESK)
-> [Robot]
-> Identity [Robot]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CESK -> Identity CESK) -> Robot -> Identity Robot
Lens' Robot CESK
machine
        ((CESK -> Identity CESK) -> [Robot] -> Identity [Robot])
-> (CESK -> CESK) -> [Robot] -> [Robot]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ case Maybe TSyntax
initialCodeToRun of
          Maybe TSyntax
Nothing -> CESK -> CESK
forall a. a -> a
id
          Just TSyntax
t -> CESK -> CESK -> CESK
forall a b. a -> b -> a
const (CESK -> CESK -> CESK) -> CESK -> CESK -> CESK
forall a b. (a -> b) -> a -> b
$ TSyntax -> CESK
initMachine TSyntax
t
      -- If we are in creative mode, give base all the things
      [Robot] -> ([Robot] -> [Robot]) -> [Robot]
forall a b. a -> (a -> b) -> b
& Index [Robot] -> Traversal' [Robot] (IxValue [Robot])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Seed
Index [Robot]
baseID
        ((Robot -> Identity Robot) -> [Robot] -> Identity [Robot])
-> ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Identity Inventory)
-> [Robot]
-> Identity [Robot]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
robotInventory
        ((Inventory -> Identity Inventory) -> [Robot] -> Identity [Robot])
-> (Inventory -> Inventory) -> [Robot] -> [Robot]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ case Scenario
scenario Scenario -> Getting Bool Scenario Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (ScenarioOperation -> Const Bool ScenarioOperation)
-> Scenario -> Const Bool Scenario
Lens' Scenario ScenarioOperation
scenarioOperation ((ScenarioOperation -> Const Bool ScenarioOperation)
 -> Scenario -> Const Bool Scenario)
-> ((Bool -> Const Bool Bool)
    -> ScenarioOperation -> Const Bool ScenarioOperation)
-> Getting Bool Scenario Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> ScenarioOperation -> Const Bool ScenarioOperation
Lens' ScenarioOperation Bool
scenarioCreative of
          Bool
False -> Inventory -> Inventory
forall a. a -> a
id
          Bool
True -> Inventory -> Inventory -> Inventory
union ([(Seed, Entity)] -> Inventory
fromElems ((Entity -> (Seed, Entity)) -> [Entity] -> [(Seed, Entity)]
forall a b. (a -> b) -> [a] -> [b]
map (Seed
0,) [Entity]
things))
      [Robot] -> ([Robot] -> [Robot]) -> [Robot]
forall a b. a -> (a -> b) -> b
& Index [Robot] -> Traversal' [Robot] (IxValue [Robot])
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Seed
Index [Robot]
baseID
        ((Robot -> Identity Robot) -> [Robot] -> Identity [Robot])
-> ((Inventory -> Identity Inventory) -> Robot -> Identity Robot)
-> (Inventory -> Identity Inventory)
-> [Robot]
-> Identity [Robot]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inventory -> Identity Inventory) -> Robot -> Identity Robot
Lens' Robot Inventory
equippedDevices
        ((Inventory -> Identity Inventory) -> [Robot] -> Identity [Robot])
-> (Inventory -> Inventory) -> [Robot] -> [Robot]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ case Scenario
scenario Scenario -> Getting Bool Scenario Bool -> Bool
forall s a. s -> Getting a s a -> a
^. (ScenarioOperation -> Const Bool ScenarioOperation)
-> Scenario -> Const Bool Scenario
Lens' Scenario ScenarioOperation
scenarioOperation ((ScenarioOperation -> Const Bool ScenarioOperation)
 -> Scenario -> Const Bool Scenario)
-> ((Bool -> Const Bool Bool)
    -> ScenarioOperation -> Const Bool ScenarioOperation)
-> Getting Bool Scenario Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool)
-> ScenarioOperation -> Const Bool ScenarioOperation
Lens' ScenarioOperation Bool
scenarioCreative of
          Bool
False -> Inventory -> Inventory
forall a. a -> a
id
          Bool
True -> Inventory -> Inventory -> Inventory
forall a b. a -> b -> a
const ([Entity] -> Inventory
fromList [Entity]
devices)

  running :: Bool
running = case [Robot]
robotList of
    [] -> Bool
False
    (Robot
base : [Robot]
_) -> Maybe Value -> Bool
forall a. Maybe a -> Bool
isNothing (CESK -> Maybe Value
finalValue (Robot
base Robot -> Getting CESK Robot CESK -> CESK
forall s a. s -> Getting a s a -> a
^. Getting CESK Robot CESK
Lens' Robot CESK
machine))

  -- Initial list of available commands = all commands enabled by
  -- devices in inventory or equipped; and commands that require no
  -- capability.
  allCapabilities :: Robot -> MultiEntityCapabilities Entity Text
allCapabilities Robot
r =
    Inventory -> MultiEntityCapabilities Entity Text
inventoryCapabilities (Robot
r Robot -> Getting Inventory Robot Inventory -> Inventory
forall s a. s -> Getting a s a -> a
^. Getting Inventory Robot Inventory
Lens' Robot Inventory
equippedDevices)
      MultiEntityCapabilities Entity Text
-> MultiEntityCapabilities Entity Text
-> MultiEntityCapabilities Entity Text
forall a. Semigroup a => a -> a -> a
<> Inventory -> MultiEntityCapabilities Entity Text
inventoryCapabilities (Robot
r Robot -> Getting Inventory Robot Inventory -> Inventory
forall s a. s -> Getting a s a -> a
^. Getting Inventory Robot Inventory
Lens' Robot Inventory
robotInventory)
  initialCaps :: Set Capability
initialCaps = MultiEntityCapabilities Entity Text -> Set Capability
forall e. Capabilities e -> Set Capability
getCapabilitySet (MultiEntityCapabilities Entity Text -> Set Capability)
-> MultiEntityCapabilities Entity Text -> Set Capability
forall a b. (a -> b) -> a -> b
$ [MultiEntityCapabilities Entity Text]
-> MultiEntityCapabilities Entity Text
forall a. Monoid a => [a] -> a
mconcat ([MultiEntityCapabilities Entity Text]
 -> MultiEntityCapabilities Entity Text)
-> [MultiEntityCapabilities Entity Text]
-> MultiEntityCapabilities Entity Text
forall a b. (a -> b) -> a -> b
$ (Robot -> MultiEntityCapabilities Entity Text)
-> [Robot] -> [MultiEntityCapabilities Entity Text]
forall a b. (a -> b) -> [a] -> [b]
map Robot -> MultiEntityCapabilities Entity Text
allCapabilities [Robot]
robotList
  initialCommands :: [Const]
initialCommands =
    (Const -> Bool) -> [Const] -> [Const]
forall a. (a -> Bool) -> [a] -> [a]
filter
      (Bool -> (Capability -> Bool) -> Maybe Capability -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (Capability -> Set Capability -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Capability
initialCaps) (Maybe Capability -> Bool)
-> (Const -> Maybe Capability) -> Const -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Const -> Maybe Capability
constCaps)
      [Const]
allConst

  worldTuples :: NonEmpty SubworldDescription
worldTuples = ScenarioLandscape -> NonEmpty SubworldDescription
buildWorldTuples ScenarioLandscape
sLandscape

  theWinCondition :: WinCondition
theWinCondition =
    WinCondition
-> (NonEmpty Objective -> WinCondition)
-> Maybe (NonEmpty Objective)
-> WinCondition
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      WinCondition
NoWinCondition
      (WinStatus -> ObjectiveCompletion -> WinCondition
WinConditions WinStatus
Ongoing (ObjectiveCompletion -> WinCondition)
-> (NonEmpty Objective -> ObjectiveCompletion)
-> NonEmpty Objective
-> WinCondition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Objective] -> ObjectiveCompletion
initCompletion ([Objective] -> ObjectiveCompletion)
-> (NonEmpty Objective -> [Objective])
-> NonEmpty Objective
-> ObjectiveCompletion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Objective -> [Objective]
forall a. NonEmpty a -> [a]
NE.toList)
      ([Objective] -> Maybe (NonEmpty Objective)
forall a. [a] -> Maybe (NonEmpty a)
NE.nonEmpty (Scenario
scenario Scenario -> Getting [Objective] Scenario [Objective] -> [Objective]
forall s a. s -> Getting a s a -> a
^. (ScenarioOperation -> Const [Objective] ScenarioOperation)
-> Scenario -> Const [Objective] Scenario
Lens' Scenario ScenarioOperation
scenarioOperation ((ScenarioOperation -> Const [Objective] ScenarioOperation)
 -> Scenario -> Const [Objective] Scenario)
-> (([Objective] -> Const [Objective] [Objective])
    -> ScenarioOperation -> Const [Objective] ScenarioOperation)
-> Getting [Objective] Scenario [Objective]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Objective] -> Const [Objective] [Objective])
-> ScenarioOperation -> Const [Objective] ScenarioOperation
Lens' ScenarioOperation [Objective]
scenarioObjectives))

  addRecipesWith :: ([Recipe Entity] -> IntMap a) -> IntMap a -> IntMap a
addRecipesWith [Recipe Entity] -> IntMap a
f = (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
forall a. (a -> a -> a) -> IntMap a -> IntMap a -> IntMap a
IM.unionWith a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) ([Recipe Entity] -> IntMap a
f ([Recipe Entity] -> IntMap a) -> [Recipe Entity] -> IntMap a
forall a b. (a -> b) -> a -> b
$ Scenario
scenario Scenario
-> Getting [Recipe Entity] Scenario [Recipe Entity]
-> [Recipe Entity]
forall s a. s -> Getting a s a -> a
^. (ScenarioOperation -> Const [Recipe Entity] ScenarioOperation)
-> Scenario -> Const [Recipe Entity] Scenario
Lens' Scenario ScenarioOperation
scenarioOperation ((ScenarioOperation -> Const [Recipe Entity] ScenarioOperation)
 -> Scenario -> Const [Recipe Entity] Scenario)
-> (([Recipe Entity] -> Const [Recipe Entity] [Recipe Entity])
    -> ScenarioOperation -> Const [Recipe Entity] ScenarioOperation)
-> Getting [Recipe Entity] Scenario [Recipe Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Recipe Entity] -> Const [Recipe Entity] [Recipe Entity])
-> ScenarioOperation -> Const [Recipe Entity] ScenarioOperation
Lens' ScenarioOperation [Recipe Entity]
scenarioRecipes)

mkRecognizer ::
  (Has (State GameState) sig m) =>
  StaticStructureInfo ->
  m (StructureRecognizer StructureCells Entity)
mkRecognizer :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
StaticStructureInfo
-> m (StructureRecognizer StructureCells Entity)
mkRecognizer structInfo :: StaticStructureInfo
structInfo@(StaticStructureInfo [SymmetryAnnotatedGrid StructureCells]
structDefs Map SubworldName [LocatedStructure]
_) = do
  [(FoundStructure StructureCells Entity, Bool)]
foundIntact <- (FoundStructure StructureCells Entity
 -> m (FoundStructure StructureCells Entity, Bool))
-> [FoundStructure StructureCells Entity]
-> m [(FoundStructure StructureCells Entity, Bool)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((FoundStructure StructureCells Entity, m Bool)
-> m (FoundStructure StructureCells Entity, Bool)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
(FoundStructure StructureCells Entity, f a)
-> f (FoundStructure StructureCells Entity, a)
sequenceA ((FoundStructure StructureCells Entity, m Bool)
 -> m (FoundStructure StructureCells Entity, Bool))
-> (FoundStructure StructureCells Entity
    -> (FoundStructure StructureCells Entity, m Bool))
-> FoundStructure StructureCells Entity
-> m (FoundStructure StructureCells Entity, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FoundStructure StructureCells Entity
-> FoundStructure StructureCells Entity
forall a. a -> a
id (FoundStructure StructureCells Entity
 -> FoundStructure StructureCells Entity)
-> (FoundStructure StructureCells Entity -> m Bool)
-> FoundStructure StructureCells Entity
-> (FoundStructure StructureCells Entity, m Bool)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& FoundStructure StructureCells Entity -> m Bool
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
FoundStructure StructureCells Entity -> m Bool
ensureStructureIntact)) [FoundStructure StructureCells Entity]
allPlaced
  let fs :: FoundRegistry StructureCells Entity
fs = [FoundStructure StructureCells Entity]
-> FoundRegistry StructureCells Entity
forall b a. [FoundStructure b a] -> FoundRegistry b a
populateStaticFoundStructures ([FoundStructure StructureCells Entity]
 -> FoundRegistry StructureCells Entity)
-> ([(FoundStructure StructureCells Entity, Bool)]
    -> [FoundStructure StructureCells Entity])
-> [(FoundStructure StructureCells Entity, Bool)]
-> FoundRegistry StructureCells Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FoundStructure StructureCells Entity, Bool)
 -> FoundStructure StructureCells Entity)
-> [(FoundStructure StructureCells Entity, Bool)]
-> [FoundStructure StructureCells Entity]
forall a b. (a -> b) -> [a] -> [b]
map (FoundStructure StructureCells Entity, Bool)
-> FoundStructure StructureCells Entity
forall a b. (a, b) -> a
fst ([(FoundStructure StructureCells Entity, Bool)]
 -> [FoundStructure StructureCells Entity])
-> ([(FoundStructure StructureCells Entity, Bool)]
    -> [(FoundStructure StructureCells Entity, Bool)])
-> [(FoundStructure StructureCells Entity, Bool)]
-> [FoundStructure StructureCells Entity]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FoundStructure StructureCells Entity, Bool) -> Bool)
-> [(FoundStructure StructureCells Entity, Bool)]
-> [(FoundStructure StructureCells Entity, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (FoundStructure StructureCells Entity, Bool) -> Bool
forall a b. (a, b) -> b
snd ([(FoundStructure StructureCells Entity, Bool)]
 -> FoundRegistry StructureCells Entity)
-> [(FoundStructure StructureCells Entity, Bool)]
-> FoundRegistry StructureCells Entity
forall a b. (a -> b) -> a -> b
$ [(FoundStructure StructureCells Entity, Bool)]
foundIntact
  StructureRecognizer StructureCells Entity
-> m (StructureRecognizer StructureCells Entity)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (StructureRecognizer StructureCells Entity
 -> m (StructureRecognizer StructureCells Entity))
-> StructureRecognizer StructureCells Entity
-> m (StructureRecognizer StructureCells Entity)
forall a b. (a -> b) -> a -> b
$
    RecognizerAutomatons StructureCells Entity
-> FoundRegistry StructureCells Entity
-> [SearchLog Entity]
-> StructureRecognizer StructureCells Entity
forall b a.
RecognizerAutomatons b a
-> FoundRegistry b a -> [SearchLog a] -> StructureRecognizer b a
StructureRecognizer
      ([SymmetryAnnotatedGrid StructureCells]
-> RecognizerAutomatons StructureCells Entity
mkAutomatons [SymmetryAnnotatedGrid StructureCells]
structDefs)
      FoundRegistry StructureCells Entity
fs
      [[IntactPlacementLog] -> SearchLog Entity
forall e. [IntactPlacementLog] -> SearchLog e
IntactStaticPlacement ([IntactPlacementLog] -> SearchLog Entity)
-> [IntactPlacementLog] -> SearchLog Entity
forall a b. (a -> b) -> a -> b
$ ((FoundStructure StructureCells Entity, Bool)
 -> IntactPlacementLog)
-> [(FoundStructure StructureCells Entity, Bool)]
-> [IntactPlacementLog]
forall a b. (a -> b) -> [a] -> [b]
map (FoundStructure StructureCells Entity, Bool) -> IntactPlacementLog
forall {b} {a}. (FoundStructure b a, Bool) -> IntactPlacementLog
mkLogEntry [(FoundStructure StructureCells Entity, Bool)]
foundIntact]
 where
  allPlaced :: [FoundStructure StructureCells Entity]
allPlaced = StaticStructureInfo -> [FoundStructure StructureCells Entity]
lookupStaticPlacements StaticStructureInfo
structInfo
  mkLogEntry :: (FoundStructure b a, Bool) -> IntactPlacementLog
mkLogEntry (FoundStructure b a
x, Bool
intact) =
    Bool -> Text -> Cosmic Location -> IntactPlacementLog
IntactPlacementLog
      Bool
intact
      ((NamedOriginal b -> Text
forall a. NamedOriginal a -> Text
getName (NamedOriginal b -> Text)
-> (FoundStructure b a -> NamedOriginal b)
-> FoundStructure b a
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StructureWithGrid b a -> NamedOriginal b
forall b a. StructureWithGrid b a -> NamedOriginal b
originalDefinition (StructureWithGrid b a -> NamedOriginal b)
-> (FoundStructure b a -> StructureWithGrid b a)
-> FoundStructure b a
-> NamedOriginal b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FoundStructure b a -> StructureWithGrid b a
forall b a. FoundStructure b a -> StructureWithGrid b a
structureWithGrid) FoundStructure b a
x)
      (FoundStructure b a -> Cosmic Location
forall b a. FoundStructure b a -> Cosmic Location
upperLeftCorner FoundStructure b a
x)

-- | Matches definitions against the placements.
-- Fails fast (short-circuits) if a non-matching
-- cell is encountered.
ensureStructureIntact ::
  (Has (State GameState) sig m) =>
  FoundStructure StructureCells Entity ->
  m Bool
ensureStructureIntact :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
FoundStructure StructureCells Entity -> m Bool
ensureStructureIntact (FoundStructure (StructureWithGrid NamedOriginal StructureCells
_ AbsoluteDir
_ [SymbolSequence Entity]
grid) Cosmic Location
upperLeft) =
  ((Int32, SymbolSequence Entity) -> m Bool)
-> [(Int32, SymbolSequence Entity)] -> m Bool
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Monad m) =>
(a -> m Bool) -> f a -> m Bool
allM (Int32, SymbolSequence Entity) -> m Bool
forall {m :: * -> *} {sig :: (* -> *) -> * -> *}.
(Member (State GameState) sig, Algebra sig m) =>
(Int32, SymbolSequence Entity) -> m Bool
outer ([(Int32, SymbolSequence Entity)] -> m Bool)
-> [(Int32, SymbolSequence Entity)] -> m Bool
forall a b. (a -> b) -> a -> b
$ [Int32]
-> [SymbolSequence Entity] -> [(Int32, SymbolSequence Entity)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int32
0 ..] [SymbolSequence Entity]
grid
 where
  outer :: (Int32, SymbolSequence Entity) -> m Bool
outer (Int32
y, SymbolSequence Entity
row) = ((Int32, Maybe Entity) -> m Bool)
-> [(Int32, Maybe Entity)] -> m Bool
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Monad m) =>
(a -> m Bool) -> f a -> m Bool
allM (Int32 -> (Int32, Maybe Entity) -> m Bool
forall {m :: * -> *} {sig :: (* -> *) -> * -> *}.
(Member (State GameState) sig, Algebra sig m) =>
Int32 -> (Int32, Maybe Entity) -> m Bool
inner Int32
y) ([(Int32, Maybe Entity)] -> m Bool)
-> [(Int32, Maybe Entity)] -> m Bool
forall a b. (a -> b) -> a -> b
$ [Int32] -> SymbolSequence Entity -> [(Int32, Maybe Entity)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int32
0 ..] SymbolSequence Entity
row
  inner :: Int32 -> (Int32, Maybe Entity) -> m Bool
inner Int32
y (Int32
x, Maybe Entity
maybeTemplateEntity) = case Maybe Entity
maybeTemplateEntity of
    Maybe Entity
Nothing -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    Just Entity
_ ->
      (Maybe Entity -> Bool) -> m (Maybe Entity) -> m Bool
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Entity -> Maybe Entity -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Entity
maybeTemplateEntity) (m (Maybe Entity) -> m Bool) -> m (Maybe Entity) -> m Bool
forall a b. (a -> b) -> a -> b
$
        Cosmic Location -> m (Maybe Entity)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (State GameState) sig m =>
Cosmic Location -> m (Maybe Entity)
entityAt (Cosmic Location -> m (Maybe Entity))
-> Cosmic Location -> m (Maybe Entity)
forall a b. (a -> b) -> a -> b
$
          Cosmic Location
upperLeft Cosmic Location -> V2 Int32 -> Cosmic Location
`offsetBy` Int32 -> Int32 -> V2 Int32
forall a. a -> a -> V2 a
V2 Int32
x (Int32 -> Int32
forall a. Num a => a -> a
negate Int32
y)

buildTagMap :: EntityMap -> Map Text (NonEmpty EntityName)
buildTagMap :: EntityMap -> Map Text (NonEmpty Text)
buildTagMap EntityMap
em =
  [(Text, Text)] -> Map Text (NonEmpty Text)
forall (t :: * -> *) a b.
(Foldable t, Ord a) =>
t (a, b) -> Map a (NonEmpty b)
binTuples [(Text, Text)]
expanded
 where
  expanded :: [(Text, Text)]
expanded = ((Text, Set Text) -> [(Text, Text)])
-> [(Text, Set Text)] -> [(Text, Text)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Text
k, Set Text
vs) -> [(Text
v, Text
k) | Text
v <- Set Text -> [Text]
forall a. Set a -> [a]
S.toList Set Text
vs]) [(Text, Set Text)]
tagsByEntity
  tagsByEntity :: [(Text, Set Text)]
tagsByEntity = (Entity -> (Text, Set Text)) -> [Entity] -> [(Text, Set Text)]
forall a b. (a -> b) -> [a] -> [b]
map (Getting Text Entity Text -> Entity -> Text
forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getting Text Entity Text
Lens' Entity Text
entityName (Entity -> Text)
-> (Entity -> Set Text) -> Entity -> (Text, Set Text)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Getting (Set Text) Entity (Set Text) -> Entity -> Set Text
forall r a (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Reader r) sig m =>
Getting a r a -> m a
view Getting (Set Text) Entity (Set Text)
Lens' Entity (Set Text)
entityTags) ([Entity] -> [(Text, Set Text)]) -> [Entity] -> [(Text, Set Text)]
forall a b. (a -> b) -> a -> b
$ EntityMap -> [Entity]
entityDefinitionOrder EntityMap
em