-- | Server and client game state types and operations.
module Game.LambdaHack.Server.State
  ( StateServer(..), ActorTime, ActorPushedBy
  , emptyStateServer, updateActorTime, lookupActorTime, ageActor
  ) 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 System.Random as R

import Game.LambdaHack.Common.Analytics
import Game.LambdaHack.Common.Perception
import Game.LambdaHack.Common.State
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Types
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 -> 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
  , 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 -> 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 -> [LevelId]
sarenas       :: [LevelId]      -- ^ active arenas
  , StateServer -> Bool
svalidArenas  :: Bool           -- ^ whether active arenas valid
  , StateServer -> StdGen
srandom       :: R.StdGen       -- ^ 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
showList :: [StateServer] -> ShowS
$cshowList :: [StateServer] -> ShowS
show :: StateServer -> String
$cshow :: StateServer -> String
showsPrec :: Int -> StateServer -> ShowS
$cshowsPrec :: Int -> 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

-- | Initial, empty game server state.
emptyStateServer :: StateServer
emptyStateServer :: StateServer
emptyStateServer =
  $WStateServer :: ActorTime
-> ActorTime
-> ActorPushedBy
-> FactionAnalytics
-> ActorAnalytics
-> GenerationAnalytics
-> EnumSet ActorId
-> DiscoveryKindRev
-> UniqueSet
-> ItemRev
-> FlavourMap
-> ActorId
-> ItemId
-> EnumMap LevelId Int
-> ()
-> EnumMap FactionId State
-> PerFid
-> PerValidFid
-> PerCacheFid
-> FovLucidLid
-> FovClearLid
-> FovLitLid
-> [LevelId]
-> Bool
-> StdGen
-> RNGs
-> Bool
-> Bool
-> Bool
-> ServerOptions
-> ServerOptions
-> StateServer
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
    , 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.fromAscList ([(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 0
    , sicounter :: ItemId
sicounter = Int -> ItemId
forall a. Enum a => Int -> a
toEnum 0
    , snumSpawned :: EnumMap LevelId Int
snumSpawned = EnumMap LevelId Int
forall k a. EnumMap k a
EM.empty
    , sundo :: ()
sundo = ()
    , sclientStates :: EnumMap FactionId State
sclientStates = EnumMap FactionId State
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 :: [LevelId]
sarenas = []
    , svalidArenas :: Bool
svalidArenas = Bool
False
    , srandom :: StdGen
srandom = Int -> StdGen
R.mkStdGen 42
    , srngs :: RNGs
srngs = $WRNGs :: Maybe StdGen -> Maybe StdGen -> RNGs
RNGs { dungeonRandomGenerator :: Maybe StdGen
dungeonRandomGenerator = Maybe StdGen
forall a. Maybe a
Nothing
                   , startingRandomGenerator :: Maybe StdGen
startingRandomGenerator = Maybe StdGen
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
  EnumMap LevelId (EnumMap ActorId Time)
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
  EnumMap ActorId Time
m2 <- LevelId
-> EnumMap LevelId (EnumMap ActorId Time)
-> Maybe (EnumMap ActorId Time)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup LevelId
lid EnumMap LevelId (EnumMap ActorId Time)
m1
  ActorId -> EnumMap ActorId Time -> Maybe Time
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid EnumMap ActorId Time
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{..} = 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
    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
    EnumMap FactionId State -> Put
forall t. Binary t => t -> Put
put EnumMap FactionId State
sclientStates
    String -> Put
forall t. Binary t => t -> Put
put (StdGen -> String
forall a. Show a => a -> String
show StdGen
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
    ActorTime
sactorTime <- Get ActorTime
forall t. Binary t => Get t
get
    ActorTime
strajTime <- Get ActorTime
forall t. Binary t => Get t
get
    ActorPushedBy
strajPushedBy <- Get ActorPushedBy
forall t. Binary t => Get t
get
    FactionAnalytics
sfactionAn <- Get FactionAnalytics
forall t. Binary t => Get t
get
    ActorAnalytics
sactorAn <- Get ActorAnalytics
forall t. Binary t => Get t
get
    GenerationAnalytics
sgenerationAn <- Get GenerationAnalytics
forall t. Binary t => Get t
get
    EnumSet ActorId
sactorStasis <- Get (EnumSet ActorId)
forall t. Binary t => Get t
get
    DiscoveryKindRev
sdiscoKindRev <- Get DiscoveryKindRev
forall t. Binary t => Get t
get
    UniqueSet
suniqueSet <- Get UniqueSet
forall t. Binary t => Get t
get
    ItemRev
sitemRev <- Get ItemRev
forall t. Binary t => Get t
get
    FlavourMap
sflavour <- Get FlavourMap
forall t. Binary t => Get t
get
    ActorId
sacounter <- Get ActorId
forall t. Binary t => Get t
get
    ItemId
sicounter <- Get ItemId
forall t. Binary t => Get t
get
    EnumMap LevelId Int
snumSpawned <- Get (EnumMap LevelId Int)
forall t. Binary t => Get t
get
    EnumMap FactionId State
sclientStates <- Get (EnumMap FactionId State)
forall t. Binary t => Get t
get
    String
g <- Get String
forall t. Binary t => Get t
get
    RNGs
srngs <- Get RNGs
forall t. Binary t => Get t
get
    ServerOptions
soptions <- Get ServerOptions
forall t. Binary t => Get t
get
    let srandom :: StdGen
srandom = String -> StdGen
forall a. Read a => String -> a
read String
g
        sundo :: ()
sundo = ()
        sperFid :: EnumMap k a
sperFid = EnumMap k a
forall k a. EnumMap k a
EM.empty
        sperValidFid :: EnumMap k a
sperValidFid = EnumMap k a
forall k a. EnumMap k a
EM.empty
        sperCacheFid :: EnumMap k a
sperCacheFid = EnumMap k a
forall k a. EnumMap k a
EM.empty
        sfovLucidLid :: EnumMap k a
sfovLucidLid = EnumMap k a
forall k a. EnumMap k a
EM.empty
        sfovClearLid :: EnumMap k a
sfovClearLid = EnumMap k a
forall k a. EnumMap k a
EM.empty
        sfovLitLid :: EnumMap k a
sfovLitLid = EnumMap k a
forall k a. EnumMap k a
EM.empty
        sarenas :: [a]
sarenas = []
        svalidArenas :: Bool
svalidArenas = Bool
False
        sbreakLoop :: Bool
sbreakLoop = Bool
False
        sbreakASAP :: Bool
sbreakASAP = Bool
False
        swriteSave :: Bool
swriteSave = Bool
False
        soptionsNxt :: ServerOptions
soptionsNxt = ServerOptions
defServerOptions
    StateServer -> Get StateServer
forall (m :: * -> *) a. Monad m => a -> m a
return (StateServer -> Get StateServer) -> StateServer -> Get StateServer
forall a b. (a -> b) -> a -> b
$! $WStateServer :: ActorTime
-> ActorTime
-> ActorPushedBy
-> FactionAnalytics
-> ActorAnalytics
-> GenerationAnalytics
-> EnumSet ActorId
-> DiscoveryKindRev
-> UniqueSet
-> ItemRev
-> FlavourMap
-> ActorId
-> ItemId
-> EnumMap LevelId Int
-> ()
-> EnumMap FactionId State
-> PerFid
-> PerValidFid
-> PerCacheFid
-> FovLucidLid
-> FovClearLid
-> FovLitLid
-> [LevelId]
-> Bool
-> StdGen
-> RNGs
-> Bool
-> Bool
-> Bool
-> ServerOptions
-> ServerOptions
-> StateServer
StateServer{..}