{-# LANGUAGE DeriveGeneric #-}
-- | Client-specific game state components.
module Game.LambdaHack.Client.State
  ( StateClient(..), AlterLid, BfsAndPath(..)
  , TgtAndPath(..), Target(..), TGoal(..)
  , emptyStateClient, cycleMarkSuspect
  , updateTarget, getTarget, updateLeader, sside, sleader
  ) 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.Primitive.PrimArray as PA
import           GHC.Generics (Generic)
import qualified System.Random.SplitMix32 as SM

import           Game.LambdaHack.Client.Bfs
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.ClientOptions
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Item
import           Game.LambdaHack.Common.Perception
import           Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Common.PointArray as PointArray
import           Game.LambdaHack.Common.State
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Common.Vector

-- | Client state, belonging to a single faction.
data StateClient = StateClient
  { StateClient -> Int
seps          :: Int            -- ^ a parameter of the aiming digital line
  , StateClient -> EnumMap ActorId TgtAndPath
stargetD      :: EM.EnumMap ActorId TgtAndPath
      -- ^ targets of our actors in the dungeon; this is only useful for AI
      --   and for directing non-pointmen, in particular with following
      --   doctrines, where non-pointmen go to the pointman's target
  , StateClient -> EnumMap ActorId (Point, Time)
sfleeD        :: EM.EnumMap ActorId (Point, Time)
                                    -- ^ the position and time of last fleeing
                                    --   attempt (regardless if succeeded)
  , StateClient -> EnumSet LevelId
sexplored     :: ES.EnumSet LevelId
                                    -- ^ the set of fully explored levels
  , StateClient -> EnumMap ActorId BfsAndPath
sbfsD         :: EM.EnumMap ActorId BfsAndPath
                                    -- ^ pathfinding data for our actors
  , StateClient -> ()
sundo         :: () -- [CmdAtomic] -- ^ atomic commands performed to date
  , StateClient -> DiscoveryBenefit
sdiscoBenefit :: DiscoveryBenefit
      -- ^ remembered AI benefits of items; could be recomputed at resume,
      --   but they are costly to generate and not too large
  , StateClient -> PerLid
sfper         :: PerLid         -- ^ faction perception indexed by level
  , StateClient -> AlterLid
salter        :: AlterLid       -- ^ cached alter skill data for positions
                                    --   (actually, @Tile.alterMinWalk@ instead)
  , StateClient -> SMGen
srandom       :: SM.SMGen       -- ^ current random generator
  , StateClient -> Maybe ActorId
_sleader      :: Maybe ActorId  -- ^ candidate new leader of the faction;
                                    --   Faction.gleader is the old leader
  , StateClient -> FactionId
_sside        :: FactionId      -- ^ faction controlled by the client
  , StateClient -> Bool
squit         :: Bool           -- ^ exit the game loop
  , StateClient -> EnumSet LevelId
scondInMelee  :: ES.EnumSet LevelId
                                    -- ^ whether we are in melee, per level
  , StateClient -> ClientOptions
soptions      :: ClientOptions  -- ^ client options
  , StateClient -> (PrimArray Int, PrimArray Int)
stabs         :: (PA.PrimArray PointI, PA.PrimArray PointI)
      -- ^ Instead of a BFS queue (list) we use these two arrays,
      --   for (JS) speed. They need to be per-client distinct,
      --   because sometimes multiple clients interleave BFS computation.

    -- The three fields below only make sense for the UI faction,
    -- but can't be in SessionUI, because AI-moved actors of the UI faction
    -- require them for their action. Fortunately, being in StateClient
    -- of the UI client, these are never lost, even when a different faction
    -- becomes the UI faction.
  , StateClient -> Challenge
scurChal      :: Challenge      -- ^ current game challenge setup
  , StateClient -> Challenge
snxtChal      :: Challenge      -- ^ next game challenge setup
  , StateClient -> Int
smarkSuspect  :: Int            -- ^ whether to mark suspect features
  }
  -- No @Show@ instance, because @stabs@ start undefined.

type AlterLid = EM.EnumMap LevelId (PointArray.Array Word8)

-- | Pathfinding distances to all reachable positions of an actor
-- and a shortest paths to some of the positions.
data BfsAndPath =
    BfsInvalid
  | BfsAndPath (PointArray.Array BfsDistance)
               (EM.EnumMap Point AndPath)
  deriving Int -> BfsAndPath -> ShowS
[BfsAndPath] -> ShowS
BfsAndPath -> String
(Int -> BfsAndPath -> ShowS)
-> (BfsAndPath -> String)
-> ([BfsAndPath] -> ShowS)
-> Show BfsAndPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BfsAndPath] -> ShowS
$cshowList :: [BfsAndPath] -> ShowS
show :: BfsAndPath -> String
$cshow :: BfsAndPath -> String
showsPrec :: Int -> BfsAndPath -> ShowS
$cshowsPrec :: Int -> BfsAndPath -> ShowS
Show

-- | Actor's target and a path to it, if any.
data TgtAndPath = TgtAndPath {TgtAndPath -> Target
tapTgt :: Target, TgtAndPath -> Maybe AndPath
tapPath :: Maybe AndPath}
  deriving (Int -> TgtAndPath -> ShowS
[TgtAndPath] -> ShowS
TgtAndPath -> String
(Int -> TgtAndPath -> ShowS)
-> (TgtAndPath -> String)
-> ([TgtAndPath] -> ShowS)
-> Show TgtAndPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TgtAndPath] -> ShowS
$cshowList :: [TgtAndPath] -> ShowS
show :: TgtAndPath -> String
$cshow :: TgtAndPath -> String
showsPrec :: Int -> TgtAndPath -> ShowS
$cshowsPrec :: Int -> TgtAndPath -> ShowS
Show, (forall x. TgtAndPath -> Rep TgtAndPath x)
-> (forall x. Rep TgtAndPath x -> TgtAndPath) -> Generic TgtAndPath
forall x. Rep TgtAndPath x -> TgtAndPath
forall x. TgtAndPath -> Rep TgtAndPath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TgtAndPath x -> TgtAndPath
$cfrom :: forall x. TgtAndPath -> Rep TgtAndPath x
Generic)

instance Binary TgtAndPath

-- | The type of na actor target.
data Target =
    TEnemy ActorId              -- ^ target an enemy
  | TNonEnemy ActorId           -- ^ target a friend or neutral
  | TPoint TGoal LevelId Point  -- ^ target a concrete spot
  | TVector Vector              -- ^ target position relative to actor
  deriving (Int -> Target -> ShowS
[Target] -> ShowS
Target -> String
(Int -> Target -> ShowS)
-> (Target -> String) -> ([Target] -> ShowS) -> Show Target
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Target] -> ShowS
$cshowList :: [Target] -> ShowS
show :: Target -> String
$cshow :: Target -> String
showsPrec :: Int -> Target -> ShowS
$cshowsPrec :: Int -> Target -> ShowS
Show, Target -> Target -> Bool
(Target -> Target -> Bool)
-> (Target -> Target -> Bool) -> Eq Target
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Target -> Target -> Bool
$c/= :: Target -> Target -> Bool
== :: Target -> Target -> Bool
$c== :: Target -> Target -> Bool
Eq, (forall x. Target -> Rep Target x)
-> (forall x. Rep Target x -> Target) -> Generic Target
forall x. Rep Target x -> Target
forall x. Target -> Rep Target x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Target x -> Target
$cfrom :: forall x. Target -> Rep Target x
Generic)

instance Binary Target

-- | The goal of an actor.
data TGoal =
    TStash FactionId  -- ^ shared inventory stash of our or an enemy faction
  | TEnemyPos ActorId  -- ^ last seen position of the targeted actor
  | TEmbed ItemBag Point  -- ^ embedded item that can be triggered;
                          -- in @TPoint (TEmbed bag p) _ q@ usually @bag@ is
                          -- embbedded in @p@ and @q@ is an adjacent open tile
  | TItem ItemBag  -- ^ item lying on the ground
  | TSmell  -- ^ smell potentially left by enemies
  | TBlock  -- ^ a blocking tile to be approached (and, e.g., revealed
            --   to be walkable or altered or searched)
  | TUnknown  -- ^ an unknown tile to be explored
  | TKnown  -- ^ a known tile to be patrolled
  | THideout  -- ^ a hideout to either flee to or find a hidden enemy sniper in
  deriving (Int -> TGoal -> ShowS
[TGoal] -> ShowS
TGoal -> String
(Int -> TGoal -> ShowS)
-> (TGoal -> String) -> ([TGoal] -> ShowS) -> Show TGoal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TGoal] -> ShowS
$cshowList :: [TGoal] -> ShowS
show :: TGoal -> String
$cshow :: TGoal -> String
showsPrec :: Int -> TGoal -> ShowS
$cshowsPrec :: Int -> TGoal -> ShowS
Show, TGoal -> TGoal -> Bool
(TGoal -> TGoal -> Bool) -> (TGoal -> TGoal -> Bool) -> Eq TGoal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TGoal -> TGoal -> Bool
$c/= :: TGoal -> TGoal -> Bool
== :: TGoal -> TGoal -> Bool
$c== :: TGoal -> TGoal -> Bool
Eq, (forall x. TGoal -> Rep TGoal x)
-> (forall x. Rep TGoal x -> TGoal) -> Generic TGoal
forall x. Rep TGoal x -> TGoal
forall x. TGoal -> Rep TGoal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TGoal x -> TGoal
$cfrom :: forall x. TGoal -> Rep TGoal x
Generic)

instance Binary TGoal

-- | Initial empty game client state.
emptyStateClient :: FactionId -> StateClient
emptyStateClient :: FactionId -> StateClient
emptyStateClient FactionId
_sside =
  StateClient :: Int
-> EnumMap ActorId TgtAndPath
-> EnumMap ActorId (Point, Time)
-> EnumSet LevelId
-> EnumMap ActorId BfsAndPath
-> ()
-> DiscoveryBenefit
-> PerLid
-> AlterLid
-> SMGen
-> Maybe ActorId
-> FactionId
-> Bool
-> EnumSet LevelId
-> ClientOptions
-> (PrimArray Int, PrimArray Int)
-> Challenge
-> Challenge
-> Int
-> StateClient
StateClient
    { seps :: Int
seps = FactionId -> Int
forall a. Enum a => a -> Int
fromEnum FactionId
_sside
    , stargetD :: EnumMap ActorId TgtAndPath
stargetD = EnumMap ActorId TgtAndPath
forall k a. EnumMap k a
EM.empty
    , sfleeD :: EnumMap ActorId (Point, Time)
sfleeD = EnumMap ActorId (Point, Time)
forall k a. EnumMap k a
EM.empty
    , sexplored :: EnumSet LevelId
sexplored = EnumSet LevelId
forall k. EnumSet k
ES.empty
    , sbfsD :: EnumMap ActorId BfsAndPath
sbfsD = EnumMap ActorId BfsAndPath
forall k a. EnumMap k a
EM.empty
    , sundo :: ()
sundo = ()
    , sdiscoBenefit :: DiscoveryBenefit
sdiscoBenefit = DiscoveryBenefit
forall k a. EnumMap k a
EM.empty
    , sfper :: PerLid
sfper = PerLid
forall k a. EnumMap k a
EM.empty
    , salter :: AlterLid
salter = AlterLid
forall k a. EnumMap k a
EM.empty
    , srandom :: SMGen
srandom = Word32 -> SMGen
SM.mkSMGen Word32
42  -- will get modified in this and future games
    , _sleader :: Maybe ActorId
_sleader = Maybe ActorId
forall a. Maybe a
Nothing  -- no heroes yet alive
    , FactionId
_sside :: FactionId
_sside :: FactionId
_sside
    , squit :: Bool
squit = Bool
False
    , scondInMelee :: EnumSet LevelId
scondInMelee = EnumSet LevelId
forall k. EnumSet k
ES.empty
    , soptions :: ClientOptions
soptions = ClientOptions
defClientOptions
    , stabs :: (PrimArray Int, PrimArray Int)
stabs = (PrimArray Int
forall a. HasCallStack => a
undefined, PrimArray Int
forall a. HasCallStack => a
undefined)
    , scurChal :: Challenge
scurChal = Challenge
defaultChallenge
    , snxtChal :: Challenge
snxtChal = Challenge
defaultChallenge
    , smarkSuspect :: Int
smarkSuspect = Int
1
    }

-- | Cycle the 'smarkSuspect' setting.
cycleMarkSuspect :: Int -> StateClient -> StateClient
cycleMarkSuspect :: Int -> StateClient -> StateClient
cycleMarkSuspect Int
delta StateClient
cli =
  StateClient
cli {smarkSuspect :: Int
smarkSuspect = (StateClient -> Int
smarkSuspect StateClient
cli Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
3}

-- | Update target parameters within client state.
updateTarget :: ActorId -> (Maybe Target -> Maybe Target) -> StateClient
             -> StateClient
updateTarget :: ActorId
-> (Maybe Target -> Maybe Target) -> StateClient -> StateClient
updateTarget ActorId
aid Maybe Target -> Maybe Target
f StateClient
cli =
  let f2 :: Maybe TgtAndPath -> Maybe TgtAndPath
f2 Maybe TgtAndPath
tp = case Maybe Target -> Maybe Target
f (Maybe Target -> Maybe Target) -> Maybe Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ (TgtAndPath -> Target) -> Maybe TgtAndPath -> Maybe Target
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TgtAndPath -> Target
tapTgt Maybe TgtAndPath
tp of
        Maybe Target
Nothing -> Maybe TgtAndPath
forall a. Maybe a
Nothing
        Just Target
tgt -> TgtAndPath -> Maybe TgtAndPath
forall a. a -> Maybe a
Just (TgtAndPath -> Maybe TgtAndPath) -> TgtAndPath -> Maybe TgtAndPath
forall a b. (a -> b) -> a -> b
$ Target -> Maybe AndPath -> TgtAndPath
TgtAndPath Target
tgt Maybe AndPath
forall a. Maybe a
Nothing  -- reset path
  in StateClient
cli {stargetD :: EnumMap ActorId TgtAndPath
stargetD = (Maybe TgtAndPath -> Maybe TgtAndPath)
-> ActorId
-> EnumMap ActorId TgtAndPath
-> EnumMap ActorId TgtAndPath
forall k a.
Enum k =>
(Maybe a -> Maybe a) -> k -> EnumMap k a -> EnumMap k a
EM.alter Maybe TgtAndPath -> Maybe TgtAndPath
f2 ActorId
aid (StateClient -> EnumMap ActorId TgtAndPath
stargetD StateClient
cli)}

-- | Get target parameters from client state.
getTarget :: ActorId -> StateClient -> Maybe Target
getTarget :: ActorId -> StateClient -> Maybe Target
getTarget ActorId
aid StateClient
cli = (TgtAndPath -> Target) -> Maybe TgtAndPath -> Maybe Target
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TgtAndPath -> Target
tapTgt (Maybe TgtAndPath -> Maybe Target)
-> Maybe TgtAndPath -> Maybe Target
forall a b. (a -> b) -> a -> b
$ ActorId -> EnumMap ActorId TgtAndPath -> Maybe TgtAndPath
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ActorId
aid (EnumMap ActorId TgtAndPath -> Maybe TgtAndPath)
-> EnumMap ActorId TgtAndPath -> Maybe TgtAndPath
forall a b. (a -> b) -> a -> b
$ StateClient -> EnumMap ActorId TgtAndPath
stargetD StateClient
cli

-- | Update picked leader within state. Verify actor's faction.
updateLeader :: ActorId -> State -> StateClient -> StateClient
updateLeader :: ActorId -> State -> StateClient -> StateClient
updateLeader ActorId
leader State
s StateClient
cli =
  let side1 :: FactionId
side1 = Actor -> FactionId
bfid (Actor -> FactionId) -> Actor -> FactionId
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader State
s
      side2 :: FactionId
side2 = StateClient -> FactionId
sside StateClient
cli
  in Bool -> StateClient -> StateClient
forall a. HasCallStack => Bool -> a -> a
assert (FactionId
side1 FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side2 Bool -> (String, (FactionId, FactionId, ActorId, State)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` String
"enemy actor becomes our leader"
                            String
-> (FactionId, FactionId, ActorId, State)
-> (String, (FactionId, FactionId, ActorId, State))
forall v. String -> v -> (String, v)
`swith` (FactionId
side1, FactionId
side2, ActorId
leader, State
s))
     (StateClient -> StateClient) -> StateClient -> StateClient
forall a b. (a -> b) -> a -> b
$ StateClient
cli {_sleader :: Maybe ActorId
_sleader = ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
leader}

sside :: StateClient -> FactionId
sside :: StateClient -> FactionId
sside = StateClient -> FactionId
_sside

sleader :: StateClient -> Maybe ActorId
sleader :: StateClient -> Maybe ActorId
sleader = StateClient -> Maybe ActorId
_sleader

instance Binary StateClient where
  put :: StateClient -> Put
put StateClient{Bool
Int
Maybe ActorId
()
(PrimArray Int, PrimArray Int)
EnumMap ActorId (Point, Time)
EnumMap ActorId TgtAndPath
EnumMap ActorId BfsAndPath
PerLid
AlterLid
DiscoveryBenefit
EnumSet LevelId
SMGen
ClientOptions
FactionId
Challenge
smarkSuspect :: Int
snxtChal :: Challenge
scurChal :: Challenge
stabs :: (PrimArray Int, PrimArray Int)
soptions :: ClientOptions
scondInMelee :: EnumSet LevelId
squit :: Bool
_sside :: FactionId
_sleader :: Maybe ActorId
srandom :: SMGen
salter :: AlterLid
sfper :: PerLid
sdiscoBenefit :: DiscoveryBenefit
sundo :: ()
sbfsD :: EnumMap ActorId BfsAndPath
sexplored :: EnumSet LevelId
sfleeD :: EnumMap ActorId (Point, Time)
stargetD :: EnumMap ActorId TgtAndPath
seps :: Int
smarkSuspect :: StateClient -> Int
snxtChal :: StateClient -> Challenge
scurChal :: StateClient -> Challenge
stabs :: StateClient -> (PrimArray Int, PrimArray Int)
soptions :: StateClient -> ClientOptions
scondInMelee :: StateClient -> EnumSet LevelId
squit :: StateClient -> Bool
_sside :: StateClient -> FactionId
_sleader :: StateClient -> Maybe ActorId
srandom :: StateClient -> SMGen
salter :: StateClient -> AlterLid
sfper :: StateClient -> PerLid
sdiscoBenefit :: StateClient -> DiscoveryBenefit
sundo :: StateClient -> ()
sbfsD :: StateClient -> EnumMap ActorId BfsAndPath
sexplored :: StateClient -> EnumSet LevelId
sfleeD :: StateClient -> EnumMap ActorId (Point, Time)
stargetD :: StateClient -> EnumMap ActorId TgtAndPath
seps :: StateClient -> Int
..} = do
    Int -> Put
forall t. Binary t => t -> Put
put Int
seps
    EnumMap ActorId TgtAndPath -> Put
forall t. Binary t => t -> Put
put EnumMap ActorId TgtAndPath
stargetD
    EnumMap ActorId (Point, Time) -> Put
forall t. Binary t => t -> Put
put EnumMap ActorId (Point, Time)
sfleeD
    EnumSet LevelId -> Put
forall t. Binary t => t -> Put
put EnumSet LevelId
sexplored
    DiscoveryBenefit -> Put
forall t. Binary t => t -> Put
put DiscoveryBenefit
sdiscoBenefit
    String -> Put
forall t. Binary t => t -> Put
put (SMGen -> String
forall a. Show a => a -> String
show SMGen
srandom)
    Maybe ActorId -> Put
forall t. Binary t => t -> Put
put Maybe ActorId
_sleader
    FactionId -> Put
forall t. Binary t => t -> Put
put FactionId
_sside
    EnumSet LevelId -> Put
forall t. Binary t => t -> Put
put EnumSet LevelId
scondInMelee
    ClientOptions -> Put
forall t. Binary t => t -> Put
put ClientOptions
soptions
    Challenge -> Put
forall t. Binary t => t -> Put
put Challenge
scurChal
    Challenge -> Put
forall t. Binary t => t -> Put
put Challenge
snxtChal
    Int -> Put
forall t. Binary t => t -> Put
put Int
smarkSuspect
#ifdef WITH_EXPENSIVE_ASSERTIONS
    PerLid -> Put
forall t. Binary t => t -> Put
put PerLid
sfper
#endif
  get :: Get StateClient
get = do
    Int
seps <- Get Int
forall t. Binary t => Get t
get
    EnumMap ActorId TgtAndPath
stargetD <- Get (EnumMap ActorId TgtAndPath)
forall t. Binary t => Get t
get
    EnumMap ActorId (Point, Time)
sfleeD <- Get (EnumMap ActorId (Point, Time))
forall t. Binary t => Get t
get
    EnumSet LevelId
sexplored <- Get (EnumSet LevelId)
forall t. Binary t => Get t
get
    DiscoveryBenefit
sdiscoBenefit <- Get DiscoveryBenefit
forall t. Binary t => Get t
get
    String
g <- Get String
forall t. Binary t => Get t
get
    Maybe ActorId
_sleader <- Get (Maybe ActorId)
forall t. Binary t => Get t
get
    FactionId
_sside <- Get FactionId
forall t. Binary t => Get t
get
    EnumSet LevelId
scondInMelee <- Get (EnumSet LevelId)
forall t. Binary t => Get t
get
    ClientOptions
soptions <- Get ClientOptions
forall t. Binary t => Get t
get
    Challenge
scurChal <- Get Challenge
forall t. Binary t => Get t
get
    Challenge
snxtChal <- Get Challenge
forall t. Binary t => Get t
get
    Int
smarkSuspect <- Get Int
forall t. Binary t => Get t
get
    let sbfsD :: EnumMap k a
sbfsD = EnumMap k a
forall k a. EnumMap k a
EM.empty
        sundo :: ()
sundo = ()
        salter :: EnumMap k a
salter = EnumMap k a
forall k a. EnumMap k a
EM.empty
        srandom :: SMGen
srandom = String -> SMGen
forall a. Read a => String -> a
read String
g
        squit :: Bool
squit = Bool
False
        stabs :: (a, b)
stabs = (a
forall a. HasCallStack => a
undefined, b
forall a. HasCallStack => a
undefined)
#ifndef WITH_EXPENSIVE_ASSERTIONS
        sfper = EM.empty
#else
    PerLid
sfper <- Get PerLid
forall t. Binary t => Get t
get
#endif
    StateClient -> Get StateClient
forall (m :: * -> *) a. Monad m => a -> m a
return (StateClient -> Get StateClient) -> StateClient -> Get StateClient
forall a b. (a -> b) -> a -> b
$! StateClient :: Int
-> EnumMap ActorId TgtAndPath
-> EnumMap ActorId (Point, Time)
-> EnumSet LevelId
-> EnumMap ActorId BfsAndPath
-> ()
-> DiscoveryBenefit
-> PerLid
-> AlterLid
-> SMGen
-> Maybe ActorId
-> FactionId
-> Bool
-> EnumSet LevelId
-> ClientOptions
-> (PrimArray Int, PrimArray Int)
-> Challenge
-> Challenge
-> Int
-> StateClient
StateClient{Bool
Int
Maybe ActorId
()
(PrimArray Int, PrimArray Int)
EnumMap ActorId (Point, Time)
EnumMap ActorId TgtAndPath
EnumMap ActorId BfsAndPath
PerLid
AlterLid
DiscoveryBenefit
EnumSet LevelId
SMGen
ClientOptions
FactionId
Challenge
forall a b. (a, b)
forall k a. EnumMap k a
sfper :: PerLid
stabs :: forall a b. (a, b)
squit :: Bool
srandom :: SMGen
salter :: forall k a. EnumMap k a
sundo :: ()
sbfsD :: forall k a. EnumMap k a
smarkSuspect :: Int
snxtChal :: Challenge
scurChal :: Challenge
soptions :: ClientOptions
scondInMelee :: EnumSet LevelId
_sside :: FactionId
_sleader :: Maybe ActorId
sdiscoBenefit :: DiscoveryBenefit
sexplored :: EnumSet LevelId
sfleeD :: EnumMap ActorId (Point, Time)
stargetD :: EnumMap ActorId TgtAndPath
seps :: Int
smarkSuspect :: Int
snxtChal :: Challenge
scurChal :: Challenge
stabs :: (PrimArray Int, PrimArray Int)
soptions :: ClientOptions
scondInMelee :: EnumSet LevelId
squit :: Bool
_sside :: FactionId
_sleader :: Maybe ActorId
srandom :: SMGen
salter :: AlterLid
sfper :: PerLid
sdiscoBenefit :: DiscoveryBenefit
sundo :: ()
sbfsD :: EnumMap ActorId BfsAndPath
sexplored :: EnumSet LevelId
sfleeD :: EnumMap ActorId (Point, Time)
stargetD :: EnumMap ActorId TgtAndPath
seps :: Int
..}