-- | Server and client game state types and operations.
module Game.LambdaHack.Server.State
  ( StateServer(..), ActorTime, ActorPushedBy
  , emptyStateServer, updateActorTime, lookupActorTime, ageActor
#ifdef EXPOSE_INTERNAL
  , GearOfTeams
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Binary
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import qualified Data.HashMap.Strict as HM
import qualified Data.IntMap.Strict as IM
import qualified System.Random.SplitMix32 as SM

import Game.LambdaHack.Common.Analytics
import Game.LambdaHack.Common.Item
import Game.LambdaHack.Common.Perception
import Game.LambdaHack.Common.State
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Types
import Game.LambdaHack.Content.FactionKind (TeamContinuity)
import Game.LambdaHack.Content.ItemKind (ItemKind)
import Game.LambdaHack.Definition.Defs
import Game.LambdaHack.Server.Fov
import Game.LambdaHack.Server.ItemRev
import Game.LambdaHack.Server.ServerOptions

-- | State with server-specific data, including a copy of each client's
-- basic game state, but not the server's basic state.
data StateServer = StateServer
  { StateServer -> ActorTime
sactorTime    :: ActorTime      -- ^ absolute times of actors next actions
  , StateServer -> ActorTime
strajTime     :: ActorTime      -- ^ and same for actors with trajectories
  , StateServer -> ActorPushedBy
strajPushedBy :: ActorPushedBy  -- ^ culprits for actors with trajectories
  , StateServer -> GearOfTeams
steamGear     :: GearOfTeams    -- ^ metagame persistent personal
                                    --   characteristics and favourite gear
                                    --   of each numbered continued team member
  , StateServer -> GearOfTeams
steamGearCur  :: GearOfTeams    -- ^ gear preferences to be taken into
                                    --   account in the current game
  , StateServer -> EnumMap TeamContinuity Int
stcounter     :: EM.EnumMap TeamContinuity Int
                                    -- ^ stores next continued team character
                                    --   identity index number in this game
  , StateServer -> FactionAnalytics
sfactionAn    :: FactionAnalytics
                                    -- ^ various past events data for factions
  , StateServer -> ActorAnalytics
sactorAn      :: ActorAnalytics -- ^ various past events data for actors
  , StateServer -> GenerationAnalytics
sgenerationAn :: GenerationAnalytics
                                    -- ^ item creation statistics, by item lore
  , StateServer -> EnumSet ActorId
sactorStasis  :: ES.EnumSet ActorId
                                    -- ^ actors currently in time stasis,
                                    --   invulnerable to time warps until move
  , StateServer -> DiscoveryKindRev
sdiscoKindRev :: DiscoveryKindRev
                                    -- ^ reverse map, used for item creation
  , StateServer -> UniqueSet
suniqueSet    :: UniqueSet      -- ^ already generated unique items
  , StateServer -> ItemRev
sitemRev      :: ItemRev        -- ^ reverse id map, used for item creation
  , StateServer -> FlavourMap
sflavour      :: FlavourMap     -- ^ association of flavour to item kinds
  , StateServer -> ActorId
sacounter     :: ActorId        -- ^ stores next actor index
  , StateServer -> ItemId
sicounter     :: ItemId         -- ^ stores next item index
  , StateServer -> EnumMap LevelId Int
snumSpawned   :: EM.EnumMap LevelId Int
                                    -- ^ how many spawned so far on the level
  , StateServer -> IntMap Int
sbandSpawned  :: IM.IntMap Int  -- ^ how many times such group spawned
  , StateServer -> ()
sundo         :: () -- [CmdAtomic] -- ^ atomic commands performed to date
  , StateServer -> EnumMap FactionId State
sclientStates :: EM.EnumMap FactionId State
                                    -- ^ each faction state, as seen by clients
  , StateServer -> EnumMap TeamContinuity DiscoveryKind
smetaBackup   :: EM.EnumMap TeamContinuity DiscoveryKind
                                    -- ^ discovery info for absent factions
  , StateServer -> PerFid
sperFid       :: PerFid         -- ^ perception of all factions
  , StateServer -> PerValidFid
sperValidFid  :: PerValidFid    -- ^ perception validity for all factions
  , StateServer -> PerCacheFid
sperCacheFid  :: PerCacheFid    -- ^ perception cache of all factions
  , StateServer -> FovLucidLid
sfovLucidLid  :: FovLucidLid    -- ^ ambient or shining light positions
  , StateServer -> FovClearLid
sfovClearLid  :: FovClearLid    -- ^ clear tiles positions
  , StateServer -> FovLitLid
sfovLitLid    :: FovLitLid      -- ^ ambient light positions
  , StateServer -> EnumSet LevelId
sarenas       :: ES.EnumSet LevelId
                                    -- ^ the set of active arenas
  , StateServer -> Bool
svalidArenas  :: Bool           -- ^ whether active arenas valid
  , StateServer -> SMGen
srandom       :: SM.SMGen       -- ^ current random generator
  , StateServer -> RNGs
srngs         :: RNGs           -- ^ initial random generators
  , StateServer -> Bool
sbreakLoop    :: Bool           -- ^ exit game loop after clip's end;
                                    --   usually no game save follows
  , StateServer -> Bool
sbreakASAP    :: Bool           -- ^ exit game loop ASAP; usually with save
  , StateServer -> Bool
swriteSave    :: Bool           -- ^ write savegame to file after loop exit
  , StateServer -> ServerOptions
soptions      :: ServerOptions  -- ^ current commandline options
  , StateServer -> ServerOptions
soptionsNxt   :: ServerOptions  -- ^ options for the next game
  }
  deriving Int -> StateServer -> ShowS
[StateServer] -> ShowS
StateServer -> String
(Int -> StateServer -> ShowS)
-> (StateServer -> String)
-> ([StateServer] -> ShowS)
-> Show StateServer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StateServer -> ShowS
showsPrec :: Int -> StateServer -> ShowS
$cshow :: StateServer -> String
show :: StateServer -> String
$cshowList :: [StateServer] -> ShowS
showList :: [StateServer] -> ShowS
Show

-- | Position in time for each actor, grouped by level and by faction.
type ActorTime =
  EM.EnumMap FactionId (EM.EnumMap LevelId (EM.EnumMap ActorId Time))

-- | Record who last propelled a given actor with trajectory.
type ActorPushedBy = EM.EnumMap ActorId ActorId

-- | Per-team, per-actor metagame persistent favourite organs and gear.
type GearOfTeams = EM.EnumMap
                     TeamContinuity
                     (IM.IntMap [(GroupName ItemKind, ContentId ItemKind)])

-- | Initial, empty game server state.
emptyStateServer :: StateServer
emptyStateServer :: StateServer
emptyStateServer =
  StateServer
    { sactorTime :: ActorTime
sactorTime = ActorTime
forall k a. EnumMap k a
EM.empty
    , strajTime :: ActorTime
strajTime = ActorTime
forall k a. EnumMap k a
EM.empty
    , strajPushedBy :: ActorPushedBy
strajPushedBy = ActorPushedBy
forall k a. EnumMap k a
EM.empty
    , steamGear :: GearOfTeams
steamGear = GearOfTeams
forall k a. EnumMap k a
EM.empty
    , steamGearCur :: GearOfTeams
steamGearCur = GearOfTeams
forall k a. EnumMap k a
EM.empty
    , stcounter :: EnumMap TeamContinuity Int
stcounter = EnumMap TeamContinuity Int
forall k a. EnumMap k a
EM.empty
    , sfactionAn :: FactionAnalytics
sfactionAn = FactionAnalytics
forall k a. EnumMap k a
EM.empty
    , sactorAn :: ActorAnalytics
sactorAn = ActorAnalytics
forall k a. EnumMap k a
EM.empty
    , sgenerationAn :: GenerationAnalytics
sgenerationAn = [(SLore, EnumMap ItemId Int)] -> GenerationAnalytics
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromDistinctAscList
                      ([(SLore, EnumMap ItemId Int)] -> GenerationAnalytics)
-> [(SLore, EnumMap ItemId Int)] -> GenerationAnalytics
forall a b. (a -> b) -> a -> b
$ [SLore] -> [EnumMap ItemId Int] -> [(SLore, EnumMap ItemId Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [SLore
forall a. Bounded a => a
minBound..SLore
forall a. Bounded a => a
maxBound] (EnumMap ItemId Int -> [EnumMap ItemId Int]
forall a. a -> [a]
repeat EnumMap ItemId Int
forall k a. EnumMap k a
EM.empty)
    , sactorStasis :: EnumSet ActorId
sactorStasis = EnumSet ActorId
forall k. EnumSet k
ES.empty
    , sdiscoKindRev :: DiscoveryKindRev
sdiscoKindRev = DiscoveryKindRev
emptyDiscoveryKindRev
    , suniqueSet :: UniqueSet
suniqueSet = UniqueSet
forall k. EnumSet k
ES.empty
    , sitemRev :: ItemRev
sitemRev = ItemRev
forall k v. HashMap k v
HM.empty
    , sflavour :: FlavourMap
sflavour = FlavourMap
emptyFlavourMap
    , sacounter :: ActorId
sacounter = Int -> ActorId
forall a. Enum a => Int -> a
toEnum Int
0
    , sicounter :: ItemId
sicounter = Int -> ItemId
forall a. Enum a => Int -> a
toEnum Int
0
    , snumSpawned :: EnumMap LevelId Int
snumSpawned = EnumMap LevelId Int
forall k a. EnumMap k a
EM.empty
    , sbandSpawned :: IntMap Int
sbandSpawned = [(Int, Int)] -> IntMap Int
forall a. [(Int, a)] -> IntMap a
IM.fromList [(Int
1, Int
0), (Int
2, Int
0), (Int
3, Int
0)]
    , sundo :: ()
sundo = ()
    , sclientStates :: EnumMap FactionId State
sclientStates = EnumMap FactionId State
forall k a. EnumMap k a
EM.empty
    , smetaBackup :: EnumMap TeamContinuity DiscoveryKind
smetaBackup = EnumMap TeamContinuity DiscoveryKind
forall k a. EnumMap k a
EM.empty
    , sperFid :: PerFid
sperFid = PerFid
forall k a. EnumMap k a
EM.empty
    , sperValidFid :: PerValidFid
sperValidFid = PerValidFid
forall k a. EnumMap k a
EM.empty
    , sperCacheFid :: PerCacheFid
sperCacheFid = PerCacheFid
forall k a. EnumMap k a
EM.empty
    , sfovLucidLid :: FovLucidLid
sfovLucidLid = FovLucidLid
forall k a. EnumMap k a
EM.empty
    , sfovClearLid :: FovClearLid
sfovClearLid = FovClearLid
forall k a. EnumMap k a
EM.empty
    , sfovLitLid :: FovLitLid
sfovLitLid = FovLitLid
forall k a. EnumMap k a
EM.empty
    , sarenas :: EnumSet LevelId
sarenas = EnumSet LevelId
forall k. EnumSet k
ES.empty
    , svalidArenas :: Bool
svalidArenas = Bool
False
    , srandom :: SMGen
srandom = Word32 -> SMGen
SM.mkSMGen Word32
42
    , srngs :: RNGs
srngs = RNGs { dungeonRandomGenerator :: Maybe SMGen
dungeonRandomGenerator = Maybe SMGen
forall a. Maybe a
Nothing
                   , startingRandomGenerator :: Maybe SMGen
startingRandomGenerator = Maybe SMGen
forall a. Maybe a
Nothing }
    , sbreakLoop :: Bool
sbreakLoop = Bool
False
    , sbreakASAP :: Bool
sbreakASAP = Bool
False
    , swriteSave :: Bool
swriteSave = Bool
False
    , soptions :: ServerOptions
soptions = ServerOptions
defServerOptions
    , soptionsNxt :: ServerOptions
soptionsNxt = ServerOptions
defServerOptions
    }

updateActorTime :: FactionId -> LevelId -> ActorId -> Time -> ActorTime
                -> ActorTime
updateActorTime :: FactionId -> LevelId -> ActorId -> Time -> ActorTime -> ActorTime
updateActorTime !FactionId
fid !LevelId
lid !ActorId
aid !Time
time =
  (EnumMap LevelId (EnumMap ActorId Time)
 -> EnumMap LevelId (EnumMap ActorId Time))
-> FactionId -> ActorTime -> ActorTime
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust ((EnumMap ActorId Time -> EnumMap ActorId Time)
-> LevelId
-> EnumMap LevelId (EnumMap ActorId Time)
-> EnumMap LevelId (EnumMap ActorId Time)
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust (ActorId -> Time -> EnumMap ActorId Time -> EnumMap ActorId Time
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ActorId
aid Time
time) LevelId
lid) FactionId
fid

lookupActorTime :: FactionId -> LevelId -> ActorId -> ActorTime
                -> Maybe Time
lookupActorTime :: FactionId -> LevelId -> ActorId -> ActorTime -> Maybe Time
lookupActorTime !FactionId
fid !LevelId
lid !ActorId
aid !ActorTime
atime = do
  m1 <- FactionId
-> ActorTime -> Maybe (EnumMap LevelId (EnumMap ActorId Time))
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup FactionId
fid ActorTime
atime
  m2 <- EM.lookup lid m1
  EM.lookup aid m2

ageActor :: FactionId -> LevelId -> ActorId -> Delta Time -> ActorTime
         -> ActorTime
ageActor :: FactionId
-> LevelId -> ActorId -> Delta Time -> ActorTime -> ActorTime
ageActor !FactionId
fid !LevelId
lid !ActorId
aid !Delta Time
delta =
  (EnumMap LevelId (EnumMap ActorId Time)
 -> EnumMap LevelId (EnumMap ActorId Time))
-> FactionId -> ActorTime -> ActorTime
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust ((EnumMap ActorId Time -> EnumMap ActorId Time)
-> LevelId
-> EnumMap LevelId (EnumMap ActorId Time)
-> EnumMap LevelId (EnumMap ActorId Time)
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust ((Time -> Time)
-> ActorId -> EnumMap ActorId Time -> EnumMap ActorId Time
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust (Time -> Delta Time -> Time
`timeShift` Delta Time
delta) ActorId
aid) LevelId
lid) FactionId
fid

instance Binary StateServer where
  put :: StateServer -> Put
put StateServer{Bool
()
IntMap Int
UniqueSet
EnumSet ActorId
EnumSet LevelId
GenerationAnalytics
ActorPushedBy
ActorAnalytics
EnumMap LevelId Int
FovLitLid
FovClearLid
FovLucidLid
PerValidFid
ActorTime
PerFid
PerCacheFid
FactionAnalytics
EnumMap FactionId State
EnumMap TeamContinuity Int
GearOfTeams
EnumMap TeamContinuity DiscoveryKind
SMGen
ItemRev
ActorId
ItemId
FlavourMap
DiscoveryKindRev
RNGs
ServerOptions
sactorTime :: StateServer -> ActorTime
strajTime :: StateServer -> ActorTime
strajPushedBy :: StateServer -> ActorPushedBy
steamGear :: StateServer -> GearOfTeams
steamGearCur :: StateServer -> GearOfTeams
stcounter :: StateServer -> EnumMap TeamContinuity Int
sfactionAn :: StateServer -> FactionAnalytics
sactorAn :: StateServer -> ActorAnalytics
sgenerationAn :: StateServer -> GenerationAnalytics
sactorStasis :: StateServer -> EnumSet ActorId
sdiscoKindRev :: StateServer -> DiscoveryKindRev
suniqueSet :: StateServer -> UniqueSet
sitemRev :: StateServer -> ItemRev
sflavour :: StateServer -> FlavourMap
sacounter :: StateServer -> ActorId
sicounter :: StateServer -> ItemId
snumSpawned :: StateServer -> EnumMap LevelId Int
sbandSpawned :: StateServer -> IntMap Int
sundo :: StateServer -> ()
sclientStates :: StateServer -> EnumMap FactionId State
smetaBackup :: StateServer -> EnumMap TeamContinuity DiscoveryKind
sperFid :: StateServer -> PerFid
sperValidFid :: StateServer -> PerValidFid
sperCacheFid :: StateServer -> PerCacheFid
sfovLucidLid :: StateServer -> FovLucidLid
sfovClearLid :: StateServer -> FovClearLid
sfovLitLid :: StateServer -> FovLitLid
sarenas :: StateServer -> EnumSet LevelId
svalidArenas :: StateServer -> Bool
srandom :: StateServer -> SMGen
srngs :: StateServer -> RNGs
sbreakLoop :: StateServer -> Bool
sbreakASAP :: StateServer -> Bool
swriteSave :: StateServer -> Bool
soptions :: StateServer -> ServerOptions
soptionsNxt :: StateServer -> ServerOptions
sactorTime :: ActorTime
strajTime :: ActorTime
strajPushedBy :: ActorPushedBy
steamGear :: GearOfTeams
steamGearCur :: GearOfTeams
stcounter :: EnumMap TeamContinuity Int
sfactionAn :: FactionAnalytics
sactorAn :: ActorAnalytics
sgenerationAn :: GenerationAnalytics
sactorStasis :: EnumSet ActorId
sdiscoKindRev :: DiscoveryKindRev
suniqueSet :: UniqueSet
sitemRev :: ItemRev
sflavour :: FlavourMap
sacounter :: ActorId
sicounter :: ItemId
snumSpawned :: EnumMap LevelId Int
sbandSpawned :: IntMap Int
sundo :: ()
sclientStates :: EnumMap FactionId State
smetaBackup :: EnumMap TeamContinuity DiscoveryKind
sperFid :: PerFid
sperValidFid :: PerValidFid
sperCacheFid :: PerCacheFid
sfovLucidLid :: FovLucidLid
sfovClearLid :: FovClearLid
sfovLitLid :: FovLitLid
sarenas :: EnumSet LevelId
svalidArenas :: Bool
srandom :: SMGen
srngs :: RNGs
sbreakLoop :: Bool
sbreakASAP :: Bool
swriteSave :: Bool
soptions :: ServerOptions
soptionsNxt :: ServerOptions
..} = do
    ActorTime -> Put
forall t. Binary t => t -> Put
put ActorTime
sactorTime
    ActorTime -> Put
forall t. Binary t => t -> Put
put ActorTime
strajTime
    ActorPushedBy -> Put
forall t. Binary t => t -> Put
put ActorPushedBy
strajPushedBy
    GearOfTeams -> Put
forall t. Binary t => t -> Put
put GearOfTeams
steamGear
    GearOfTeams -> Put
forall t. Binary t => t -> Put
put GearOfTeams
steamGearCur
    EnumMap TeamContinuity Int -> Put
forall t. Binary t => t -> Put
put EnumMap TeamContinuity Int
stcounter
    FactionAnalytics -> Put
forall t. Binary t => t -> Put
put FactionAnalytics
sfactionAn
    ActorAnalytics -> Put
forall t. Binary t => t -> Put
put ActorAnalytics
sactorAn
    GenerationAnalytics -> Put
forall t. Binary t => t -> Put
put GenerationAnalytics
sgenerationAn
    EnumSet ActorId -> Put
forall t. Binary t => t -> Put
put EnumSet ActorId
sactorStasis
    DiscoveryKindRev -> Put
forall t. Binary t => t -> Put
put DiscoveryKindRev
sdiscoKindRev
    UniqueSet -> Put
forall t. Binary t => t -> Put
put UniqueSet
suniqueSet
    ItemRev -> Put
forall t. Binary t => t -> Put
put ItemRev
sitemRev
    FlavourMap -> Put
forall t. Binary t => t -> Put
put FlavourMap
sflavour
    ActorId -> Put
forall t. Binary t => t -> Put
put ActorId
sacounter
    ItemId -> Put
forall t. Binary t => t -> Put
put ItemId
sicounter
    EnumMap LevelId Int -> Put
forall t. Binary t => t -> Put
put EnumMap LevelId Int
snumSpawned
    IntMap Int -> Put
forall t. Binary t => t -> Put
put IntMap Int
sbandSpawned
    EnumMap FactionId State -> Put
forall t. Binary t => t -> Put
put EnumMap FactionId State
sclientStates
    EnumMap TeamContinuity DiscoveryKind -> Put
forall t. Binary t => t -> Put
put EnumMap TeamContinuity DiscoveryKind
smetaBackup
    String -> Put
forall t. Binary t => t -> Put
put (SMGen -> String
forall a. Show a => a -> String
show SMGen
srandom)
    RNGs -> Put
forall t. Binary t => t -> Put
put RNGs
srngs
    ServerOptions -> Put
forall t. Binary t => t -> Put
put ServerOptions
soptions
  get :: Get StateServer
get = do
    sactorTime <- Get ActorTime
forall t. Binary t => Get t
get
    strajTime <- get
    strajPushedBy <- get
    steamGear <- get
    steamGearCur <- get
    stcounter <- get
    sfactionAn <- get
    sactorAn <- get
    sgenerationAn <- get
    sactorStasis <- get
    sdiscoKindRev <- get
    suniqueSet <- get
    sitemRev <- get
    sflavour <- get
    sacounter <- get
    sicounter <- get
    snumSpawned <- get
    sbandSpawned <- get
    sclientStates <- get
    smetaBackup <- get
    g <- get
    srngs <- get
    soptions <- get
    let srandom = String -> SMGen
forall a. Read a => String -> a
read String
g
        sundo = ()
        sperFid = EnumMap k a
forall k a. EnumMap k a
EM.empty
        sperValidFid = EnumMap k a
forall k a. EnumMap k a
EM.empty
        sperCacheFid = EnumMap k a
forall k a. EnumMap k a
EM.empty
        sfovLucidLid = EnumMap k a
forall k a. EnumMap k a
EM.empty
        sfovClearLid = EnumMap k a
forall k a. EnumMap k a
EM.empty
        sfovLitLid = EnumMap k a
forall k a. EnumMap k a
EM.empty
        sarenas = EnumSet k
forall k. EnumSet k
ES.empty
        svalidArenas = Bool
False
        sbreakLoop = Bool
False
        sbreakASAP = Bool
False
        swriteSave = Bool
False
        soptionsNxt = ServerOptions
defServerOptions
    return $! StateServer{..}