module Game.LambdaHack.Server.State
( StateServer(..), emptyStateServer
, DebugModeSer(..), defDebugModeSer
, RNGs(..)
) where
import Data.Binary
import qualified Data.EnumMap.Strict as EM
import qualified Data.HashMap.Strict as HM
import Data.List
import Data.Text (Text)
import qualified System.Random as R
import System.Time
import Game.LambdaHack.Atomic
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ClientOptions
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.Perception
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Content.RuleKind
import Game.LambdaHack.Server.ItemRev
data StateServer = StateServer
{ sdiscoKind :: !DiscoveryKind
, sdiscoKindRev :: !DiscoveryKindRev
, sdiscoEffect :: !DiscoveryEffect
, sitemSeedD :: !ItemSeedDict
, sitemRev :: !ItemRev
, sflavour :: !FlavourMap
, sacounter :: !ActorId
, sicounter :: !ItemId
, sprocessed :: !(EM.EnumMap LevelId Time)
, sundo :: ![CmdAtomic]
, sper :: !Pers
, srandom :: !R.StdGen
, srngs :: !RNGs
, squit :: !Bool
, swriteSave :: !Bool
, sstart :: !ClockTime
, sgstart :: !ClockTime
, sallTime :: !Time
, sheroNames :: !(EM.EnumMap FactionId [(Int, (Text, Text))])
, sdebugSer :: !DebugModeSer
, sdebugNxt :: !DebugModeSer
}
deriving (Show)
data DebugModeSer = DebugModeSer
{ sknowMap :: !Bool
, sknowEvents :: !Bool
, sniffIn :: !Bool
, sniffOut :: !Bool
, sallClear :: !Bool
, sgameMode :: !GroupName
, sautomateAll :: !Bool
, sstopAfter :: !(Maybe Int)
, sdungeonRng :: !(Maybe R.StdGen)
, smainRng :: !(Maybe R.StdGen)
, sfovMode :: !(Maybe FovMode)
, snewGameSer :: !Bool
, sdifficultySer :: !Int
, sdumpInitRngs :: !Bool
, ssavePrefixSer :: !(Maybe String)
, sdbgMsgSer :: !Bool
, sdebugCli :: !DebugModeCli
}
deriving Show
data RNGs = RNGs
{ dungeonRandomGenerator :: !(Maybe R.StdGen)
, startingRandomGenerator :: !(Maybe R.StdGen)
}
instance Show RNGs where
show RNGs{..} =
let args = [ maybe "" (\gen -> "--setDungeonRng \"" ++ show gen ++ "\"")
dungeonRandomGenerator
, maybe "" (\gen -> "--setMainRng \"" ++ show gen ++ "\"")
startingRandomGenerator ]
in intercalate " " args
emptyStateServer :: StateServer
emptyStateServer =
StateServer
{ sdiscoKind = EM.empty
, sdiscoKindRev = EM.empty
, sdiscoEffect = EM.empty
, sitemSeedD = EM.empty
, sitemRev = HM.empty
, sflavour = emptyFlavourMap
, sacounter = toEnum 0
, sicounter = toEnum 0
, sprocessed = EM.empty
, sundo = []
, sper = EM.empty
, srandom = R.mkStdGen 42
, srngs = RNGs { dungeonRandomGenerator = Nothing
, startingRandomGenerator = Nothing }
, squit = False
, swriteSave = False
, sstart = TOD 0 0
, sgstart = TOD 0 0
, sallTime = timeZero
, sheroNames = EM.empty
, sdebugSer = defDebugModeSer
, sdebugNxt = defDebugModeSer
}
defDebugModeSer :: DebugModeSer
defDebugModeSer = DebugModeSer { sknowMap = False
, sknowEvents = False
, sniffIn = False
, sniffOut = False
, sallClear = False
, sgameMode = "campaign"
, sautomateAll = False
, sstopAfter = Nothing
, sdungeonRng = Nothing
, smainRng = Nothing
, sfovMode = Nothing
, snewGameSer = False
, sdifficultySer = difficultyDefault
, sdumpInitRngs = False
, ssavePrefixSer = Nothing
, sdbgMsgSer = False
, sdebugCli = defDebugModeCli
}
instance Binary StateServer where
put StateServer{..} = do
put sdiscoKind
put sdiscoKindRev
put sdiscoEffect
put sitemSeedD
put sitemRev
put sflavour
put sacounter
put sicounter
put sprocessed
put sundo
put (show srandom)
put srngs
put sheroNames
put sdebugSer
get = do
sdiscoKind <- get
sdiscoKindRev <- get
sdiscoEffect <- get
sitemSeedD <- get
sitemRev <- get
sflavour <- get
sacounter <- get
sicounter <- get
sprocessed <- get
sundo <- get
g <- get
srngs <- get
sheroNames <- get
sdebugSer <- get
let srandom = read g
sper = EM.empty
squit = False
swriteSave = False
sstart = TOD 0 0
sgstart = TOD 0 0
sallTime = timeZero
sdebugNxt = defDebugModeSer
return $! StateServer{..}
instance Binary DebugModeSer where
put DebugModeSer{..} = do
put sknowMap
put sknowEvents
put sniffIn
put sniffOut
put sallClear
put sgameMode
put sautomateAll
put sdifficultySer
put sfovMode
put ssavePrefixSer
put sdbgMsgSer
put sdebugCli
get = do
sknowMap <- get
sknowEvents <- get
sniffIn <- get
sniffOut <- get
sallClear <- get
sgameMode <- get
sautomateAll <- get
sdifficultySer <- get
sfovMode <- get
ssavePrefixSer <- get
sdbgMsgSer <- get
sdebugCli <- get
let sstopAfter = Nothing
sdungeonRng = Nothing
smainRng = Nothing
snewGameSer = False
sdumpInitRngs = False
return $! DebugModeSer{..}
instance Binary RNGs where
put RNGs{..} = do
put (show dungeonRandomGenerator)
put (show startingRandomGenerator)
get = do
dg <- get
sg <- get
let dungeonRandomGenerator = read dg
startingRandomGenerator = read sg
return $! RNGs{..}