-- | The common, for server and clients, main game state type
-- and its operations.
module Game.LambdaHack.Common.State
  ( -- * Basic game state, local or global
    State
    -- * State components
  , sdungeon, stotalDepth, sactorD, sitemD, sitemIxMap, sfactionD, stime, scops
  , sgold, shigh, sgameModeId, sdiscoKind, sdiscoAspect, sactorMaxSkills
    -- * State construction
  , defStateGlobal, emptyState, localFromGlobal
    -- * State update
  , updateDungeon, updateDepth, updateActorD, updateItemD, updateItemIxMap
  , updateFactionD, updateTime, updateCOpsAndCachedData, updateGold
  , updateDiscoKind, updateDiscoAspect, updateActorMaxSkills
    -- * State operations
  , getItemBody, aspectRecordFromItem, aspectRecordFromIid
  , maxSkillsFromActor, maxSkillsInDungeon
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , unknownLevel
#endif
    -- * Operations both internal and used in unit tests
  , unknownTileMap
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Binary
import qualified Data.EnumMap.Strict as EM

import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.Area
import           Game.LambdaHack.Common.Faction
import qualified Game.LambdaHack.Common.HighScore as HighScore
import           Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Level
import           Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Common.PointArray as PointArray
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Content.CaveKind (CaveKind)
import           Game.LambdaHack.Content.ModeKind
import           Game.LambdaHack.Content.RuleKind
import           Game.LambdaHack.Content.TileKind (TileKind)
import qualified Game.LambdaHack.Content.TileKind as TK
import qualified Game.LambdaHack.Core.Dice as Dice
import qualified Game.LambdaHack.Definition.Ability as Ability
import           Game.LambdaHack.Definition.Defs

-- | The main game state, the basic one, pertaining to a single game,
-- not to a single playing session or an intersection of both.
-- This state persists between playing sessions, until the particular game ends.
-- Anything that persists between games is stored in server state,
-- client state or client UI session state.
--
-- Another differentiating property of this state is that it's kept
-- separately on the server and each of the clients (players, human or AI)
-- and separately updated, according to what each player can observe.
-- It's never updated directly, but always through atomic commands
-- ("CmdAtomic") that are filtered and interpreted differently
-- on server and on each client. Therefore, the type is a view on the
-- game state, not the real game state, except on the server that
-- alone stores the full game information.
data State = State
  { State -> Dungeon
_sdungeon        :: Dungeon    -- ^ remembered dungeon
  , State -> AbsDepth
_stotalDepth     :: Dice.AbsDepth
                                   -- ^ absolute dungeon depth for item creation
  , State -> ActorDict
_sactorD         :: ActorDict  -- ^ remembered actors in the dungeon
  , State -> ItemDict
_sitemD          :: ItemDict   -- ^ remembered items in the dungeon
  , State -> ItemIxMap
_sitemIxMap      :: ItemIxMap  -- ^ spotted items with the same kind index
                                   --   could be recomputed at resume, but small
  , State -> FactionDict
_sfactionD       :: FactionDict
                                   -- ^ remembered sides still in game
  , State -> Time
_stime           :: Time       -- ^ global game time, for UI display only
  , State -> COps
_scops           :: COps       -- ^ remembered content; warning: use only
                                   --   validated content, even for testing
  , State -> Int
_sgold           :: Int        -- ^ total value of human trinkets in dungeon
  , State -> ScoreDict
_shigh           :: HighScore.ScoreDict  -- ^ high score table
  , State -> ContentId ModeKind
_sgameModeId     :: ContentId ModeKind   -- ^ current game mode
  , State -> DiscoveryKind
_sdiscoKind      :: DiscoveryKind        -- ^ item kind discoveries data
  , State -> DiscoveryAspect
_sdiscoAspect    :: DiscoveryAspect
                                   -- ^ item aspect data; could be recomputed
  , State -> ActorMaxSkills
_sactorMaxSkills :: ActorMaxSkills
                                   -- ^ actor maximal skills; is recomputed
  }
  deriving (Int -> State -> ShowS
[State] -> ShowS
State -> String
(Int -> State -> ShowS)
-> (State -> String) -> ([State] -> ShowS) -> Show State
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> State -> ShowS
showsPrec :: Int -> State -> ShowS
$cshow :: State -> String
show :: State -> String
$cshowList :: [State] -> ShowS
showList :: [State] -> ShowS
Show, State -> State -> Bool
(State -> State -> Bool) -> (State -> State -> Bool) -> Eq State
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: State -> State -> Bool
== :: State -> State -> Bool
$c/= :: State -> State -> Bool
/= :: State -> State -> Bool
Eq)

instance Binary State where
  put :: State -> Put
put State{Int
ScoreDict
ActorMaxSkills
ActorDict
Dungeon
FactionDict
DiscoveryAspect
ItemDict
ItemIxMap
DiscoveryKind
AbsDepth
Time
ContentId ModeKind
COps
_sdungeon :: State -> Dungeon
_stotalDepth :: State -> AbsDepth
_sactorD :: State -> ActorDict
_sitemD :: State -> ItemDict
_sitemIxMap :: State -> ItemIxMap
_sfactionD :: State -> FactionDict
_stime :: State -> Time
_scops :: State -> COps
_sgold :: State -> Int
_shigh :: State -> ScoreDict
_sgameModeId :: State -> ContentId ModeKind
_sdiscoKind :: State -> DiscoveryKind
_sdiscoAspect :: State -> DiscoveryAspect
_sactorMaxSkills :: State -> ActorMaxSkills
_sdungeon :: Dungeon
_stotalDepth :: AbsDepth
_sactorD :: ActorDict
_sitemD :: ItemDict
_sitemIxMap :: ItemIxMap
_sfactionD :: FactionDict
_stime :: Time
_scops :: COps
_sgold :: Int
_shigh :: ScoreDict
_sgameModeId :: ContentId ModeKind
_sdiscoKind :: DiscoveryKind
_sdiscoAspect :: DiscoveryAspect
_sactorMaxSkills :: ActorMaxSkills
..} = do
    Dungeon -> Put
forall t. Binary t => t -> Put
put Dungeon
_sdungeon
    AbsDepth -> Put
forall t. Binary t => t -> Put
put AbsDepth
_stotalDepth
    ActorDict -> Put
forall t. Binary t => t -> Put
put ActorDict
_sactorD
    ItemDict -> Put
forall t. Binary t => t -> Put
put ItemDict
_sitemD
    ItemIxMap -> Put
forall t. Binary t => t -> Put
put ItemIxMap
_sitemIxMap
    FactionDict -> Put
forall t. Binary t => t -> Put
put FactionDict
_sfactionD
    Time -> Put
forall t. Binary t => t -> Put
put Time
_stime
    Int -> Put
forall t. Binary t => t -> Put
put Int
_sgold
    ScoreDict -> Put
forall t. Binary t => t -> Put
put ScoreDict
_shigh
    ContentId ModeKind -> Put
forall t. Binary t => t -> Put
put ContentId ModeKind
_sgameModeId
    DiscoveryKind -> Put
forall t. Binary t => t -> Put
put DiscoveryKind
_sdiscoKind
    DiscoveryAspect -> Put
forall t. Binary t => t -> Put
put DiscoveryAspect
_sdiscoAspect
  get :: Get State
get = do
    Dungeon
_sdungeon <- Get Dungeon
forall t. Binary t => Get t
get
    AbsDepth
_stotalDepth <- Get AbsDepth
forall t. Binary t => Get t
get
    ActorDict
_sactorD <- Get ActorDict
forall t. Binary t => Get t
get
    ItemDict
_sitemD <- Get ItemDict
forall t. Binary t => Get t
get
    ItemIxMap
_sitemIxMap <- Get ItemIxMap
forall t. Binary t => Get t
get
    FactionDict
_sfactionD <- Get FactionDict
forall t. Binary t => Get t
get
    Time
_stime <- Get Time
forall t. Binary t => Get t
get
    Int
_sgold <- Get Int
forall t. Binary t => Get t
get
    ScoreDict
_shigh <- Get ScoreDict
forall t. Binary t => Get t
get
    ContentId ModeKind
_sgameModeId <- Get (ContentId ModeKind)
forall t. Binary t => Get t
get
    DiscoveryKind
_sdiscoKind <- Get DiscoveryKind
forall t. Binary t => Get t
get
    DiscoveryAspect
_sdiscoAspect <- Get DiscoveryAspect
forall t. Binary t => Get t
get
    let _scops :: COps
_scops = COps
emptyCOps
        _sactorMaxSkills :: EnumMap k a
_sactorMaxSkills = EnumMap k a
forall k a. EnumMap k a
EM.empty
    State -> Get State
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (State -> Get State) -> State -> Get State
forall a b. (a -> b) -> a -> b
$! State{Int
ScoreDict
ActorMaxSkills
ActorDict
Dungeon
FactionDict
DiscoveryAspect
ItemDict
ItemIxMap
DiscoveryKind
AbsDepth
Time
ContentId ModeKind
COps
forall k a. EnumMap k a
_sdungeon :: Dungeon
_stotalDepth :: AbsDepth
_sactorD :: ActorDict
_sitemD :: ItemDict
_sitemIxMap :: ItemIxMap
_sfactionD :: FactionDict
_stime :: Time
_scops :: COps
_sgold :: Int
_shigh :: ScoreDict
_sgameModeId :: ContentId ModeKind
_sdiscoKind :: DiscoveryKind
_sdiscoAspect :: DiscoveryAspect
_sactorMaxSkills :: ActorMaxSkills
_sdungeon :: Dungeon
_stotalDepth :: AbsDepth
_sactorD :: ActorDict
_sitemD :: ItemDict
_sitemIxMap :: ItemIxMap
_sfactionD :: FactionDict
_stime :: Time
_sgold :: Int
_shigh :: ScoreDict
_sgameModeId :: ContentId ModeKind
_sdiscoKind :: DiscoveryKind
_sdiscoAspect :: DiscoveryAspect
_scops :: COps
_sactorMaxSkills :: forall k a. EnumMap k a
..}

sdungeon :: State -> Dungeon
sdungeon :: State -> Dungeon
sdungeon = State -> Dungeon
_sdungeon

stotalDepth :: State -> Dice.AbsDepth
stotalDepth :: State -> AbsDepth
stotalDepth = State -> AbsDepth
_stotalDepth

sactorD :: State -> ActorDict
sactorD :: State -> ActorDict
sactorD = State -> ActorDict
_sactorD

sitemD :: State -> ItemDict
sitemD :: State -> ItemDict
sitemD = State -> ItemDict
_sitemD

sitemIxMap :: State -> ItemIxMap
sitemIxMap :: State -> ItemIxMap
sitemIxMap = State -> ItemIxMap
_sitemIxMap

sfactionD :: State -> FactionDict
sfactionD :: State -> FactionDict
sfactionD = State -> FactionDict
_sfactionD

stime :: State -> Time
stime :: State -> Time
stime = State -> Time
_stime

scops :: State -> COps
scops :: State -> COps
scops = State -> COps
_scops

sgold :: State -> Int
sgold :: State -> Int
sgold = State -> Int
_sgold

shigh :: State -> HighScore.ScoreDict
shigh :: State -> ScoreDict
shigh = State -> ScoreDict
_shigh

sgameModeId :: State -> ContentId ModeKind
sgameModeId :: State -> ContentId ModeKind
sgameModeId = State -> ContentId ModeKind
_sgameModeId

sdiscoKind :: State -> DiscoveryKind
sdiscoKind :: State -> DiscoveryKind
sdiscoKind = State -> DiscoveryKind
_sdiscoKind

sdiscoAspect :: State -> DiscoveryAspect
sdiscoAspect :: State -> DiscoveryAspect
sdiscoAspect = State -> DiscoveryAspect
_sdiscoAspect

sactorMaxSkills :: State -> ActorMaxSkills
sactorMaxSkills :: State -> ActorMaxSkills
sactorMaxSkills = State -> ActorMaxSkills
_sactorMaxSkills

unknownLevel :: COps -> ContentId CaveKind -> Dice.AbsDepth -> Area
             -> ([Point], [Point]) -> [Point] -> Int -> Bool
             -> Level
unknownLevel :: COps
-> ContentId CaveKind
-> AbsDepth
-> Area
-> ([Point], [Point])
-> [Point]
-> Int
-> Bool
-> Level
unknownLevel COps{RuleContent
corule :: RuleContent
corule :: COps -> RuleContent
corule, ContentData TileKind
cotile :: ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile}
             ContentId CaveKind
lkind AbsDepth
ldepth Area
larea ([Point], [Point])
lstair [Point]
lescape Int
lexpl Bool
lnight =
  let outerId :: ContentId TileKind
outerId = ContentData TileKind -> GroupName TileKind -> ContentId TileKind
forall a. Show a => ContentData a -> GroupName a -> ContentId a
ouniqGroup ContentData TileKind
cotile GroupName TileKind
TK.S_UNKNOWN_OUTER_FENCE
  in Level { ContentId CaveKind
lkind :: ContentId CaveKind
lkind :: ContentId CaveKind
lkind
           , AbsDepth
ldepth :: AbsDepth
ldepth :: AbsDepth
ldepth
           , lfloor :: ItemFloor
lfloor = ItemFloor
forall k a. EnumMap k a
EM.empty
           , lembed :: ItemFloor
lembed = ItemFloor
forall k a. EnumMap k a
EM.empty
           , lbig :: BigActorMap
lbig = BigActorMap
forall k a. EnumMap k a
EM.empty
           , lproj :: ProjectileMap
lproj = ProjectileMap
forall k a. EnumMap k a
EM.empty
           , ltile :: TileMap
ltile = Area -> ContentId TileKind -> Int -> Int -> TileMap
unknownTileMap Area
larea ContentId TileKind
outerId (RuleContent -> Int
rWidthMax RuleContent
corule) (RuleContent -> Int
rHeightMax RuleContent
corule)
           , lentry :: EntryMap
lentry = EntryMap
forall k a. EnumMap k a
EM.empty
           , Area
larea :: Area
larea :: Area
larea
           , lsmell :: SmellMap
lsmell = SmellMap
forall k a. EnumMap k a
EM.empty
           , ([Point], [Point])
lstair :: ([Point], [Point])
lstair :: ([Point], [Point])
lstair
           , [Point]
lescape :: [Point]
lescape :: [Point]
lescape
           , lseen :: Int
lseen = Int
0
           , Int
lexpl :: Int
lexpl :: Int
lexpl
           , ltime :: Time
ltime = Time
timeZero
           , Bool
lnight :: Bool
lnight :: Bool
lnight
           }

-- | Create a map full of unknown tiles.
--
-- >>> unknownTileMap (fromJust (toArea (0,0,0,0))) TK.unknownId 2 2
-- PointArray.Array with size (2,2)
unknownTileMap :: Area -> ContentId TileKind -> X -> Y -> TileMap
unknownTileMap :: Area -> ContentId TileKind -> Int -> Int -> TileMap
unknownTileMap Area
larea ContentId TileKind
outerId Int
rWidthMax Int
rHeightMax =
  let unknownMap :: TileMap
unknownMap = Int -> Int -> ContentId TileKind -> TileMap
forall c. UnboxRepClass c => Int -> Int -> c -> Array c
PointArray.replicateA Int
rWidthMax Int
rHeightMax ContentId TileKind
TK.unknownId
      outerUpdate :: [(Point, ContentId TileKind)]
outerUpdate = [Point] -> [ContentId TileKind] -> [(Point, ContentId TileKind)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Area -> [Point]
areaInnerBorder Area
larea) ([ContentId TileKind] -> [(Point, ContentId TileKind)])
-> [ContentId TileKind] -> [(Point, ContentId TileKind)]
forall a b. (a -> b) -> a -> b
$ ContentId TileKind -> [ContentId TileKind]
forall a. a -> [a]
repeat ContentId TileKind
outerId
  in TileMap
unknownMap TileMap -> [(Point, ContentId TileKind)] -> TileMap
forall c. UnboxRepClass c => Array c -> [(Point, c)] -> Array c
PointArray.// [(Point, ContentId TileKind)]
outerUpdate

-- | Initial complete global game state.
defStateGlobal :: Dungeon -> Dice.AbsDepth -> FactionDict -> COps
               -> HighScore.ScoreDict -> ContentId ModeKind -> DiscoveryKind
               -> State
defStateGlobal :: Dungeon
-> AbsDepth
-> FactionDict
-> COps
-> ScoreDict
-> ContentId ModeKind
-> DiscoveryKind
-> State
defStateGlobal Dungeon
_sdungeon AbsDepth
_stotalDepth FactionDict
_sfactionD COps
_scops ScoreDict
_shigh ContentId ModeKind
_sgameModeId
               DiscoveryKind
_sdiscoKind =
  State
    { _sactorD :: ActorDict
_sactorD = ActorDict
forall k a. EnumMap k a
EM.empty
    , _sitemD :: ItemDict
_sitemD = ItemDict
forall k a. EnumMap k a
EM.empty
    , _sitemIxMap :: ItemIxMap
_sitemIxMap = ItemIxMap
forall k a. EnumMap k a
EM.empty
    , _stime :: Time
_stime = Time
timeZero
    , _sgold :: Int
_sgold = Int
0
    , _sdiscoAspect :: DiscoveryAspect
_sdiscoAspect = DiscoveryAspect
forall k a. EnumMap k a
EM.empty
    , _sactorMaxSkills :: ActorMaxSkills
_sactorMaxSkills = ActorMaxSkills
forall k a. EnumMap k a
EM.empty
    , ScoreDict
Dungeon
FactionDict
DiscoveryKind
AbsDepth
ContentId ModeKind
COps
_sdungeon :: Dungeon
_stotalDepth :: AbsDepth
_sfactionD :: FactionDict
_scops :: COps
_shigh :: ScoreDict
_sgameModeId :: ContentId ModeKind
_sdiscoKind :: DiscoveryKind
_sdungeon :: Dungeon
_stotalDepth :: AbsDepth
_sfactionD :: FactionDict
_scops :: COps
_shigh :: ScoreDict
_sgameModeId :: ContentId ModeKind
_sdiscoKind :: DiscoveryKind
..
    }

-- | Initial empty state.
emptyState :: State
emptyState :: State
emptyState =
  State
    { _sdungeon :: Dungeon
_sdungeon = Dungeon
forall k a. EnumMap k a
EM.empty
    , _stotalDepth :: AbsDepth
_stotalDepth = Int -> AbsDepth
Dice.AbsDepth Int
0
    , _sactorD :: ActorDict
_sactorD = ActorDict
forall k a. EnumMap k a
EM.empty
    , _sitemD :: ItemDict
_sitemD = ItemDict
forall k a. EnumMap k a
EM.empty
    , _sitemIxMap :: ItemIxMap
_sitemIxMap = ItemIxMap
forall k a. EnumMap k a
EM.empty
    , _sfactionD :: FactionDict
_sfactionD = FactionDict
forall k a. EnumMap k a
EM.empty
    , _stime :: Time
_stime = Time
timeZero
    , _scops :: COps
_scops = COps
emptyCOps
    , _sgold :: Int
_sgold = Int
0
    , _shigh :: ScoreDict
_shigh = ScoreDict
HighScore.empty
    , _sgameModeId :: ContentId ModeKind
_sgameModeId = Int -> ContentId ModeKind
forall a. Enum a => Int -> a
toEnum Int
0  -- the initial value is unused
    , _sdiscoKind :: DiscoveryKind
_sdiscoKind = DiscoveryKind
forall k a. EnumMap k a
EM.empty
    , _sdiscoAspect :: DiscoveryAspect
_sdiscoAspect = DiscoveryAspect
forall k a. EnumMap k a
EM.empty
    , _sactorMaxSkills :: ActorMaxSkills
_sactorMaxSkills = ActorMaxSkills
forall k a. EnumMap k a
EM.empty
    }

-- | Local state created by removing secret information from global
-- state components.
localFromGlobal :: State -> State
localFromGlobal :: State -> State
localFromGlobal State{Int
ScoreDict
ActorMaxSkills
ActorDict
Dungeon
FactionDict
DiscoveryAspect
ItemDict
ItemIxMap
DiscoveryKind
AbsDepth
Time
ContentId ModeKind
COps
_sdungeon :: State -> Dungeon
_stotalDepth :: State -> AbsDepth
_sactorD :: State -> ActorDict
_sitemD :: State -> ItemDict
_sitemIxMap :: State -> ItemIxMap
_sfactionD :: State -> FactionDict
_stime :: State -> Time
_scops :: State -> COps
_sgold :: State -> Int
_shigh :: State -> ScoreDict
_sgameModeId :: State -> ContentId ModeKind
_sdiscoKind :: State -> DiscoveryKind
_sdiscoAspect :: State -> DiscoveryAspect
_sactorMaxSkills :: State -> ActorMaxSkills
_sdungeon :: Dungeon
_stotalDepth :: AbsDepth
_sactorD :: ActorDict
_sitemD :: ItemDict
_sitemIxMap :: ItemIxMap
_sfactionD :: FactionDict
_stime :: Time
_scops :: COps
_sgold :: Int
_shigh :: ScoreDict
_sgameModeId :: ContentId ModeKind
_sdiscoKind :: DiscoveryKind
_sdiscoAspect :: DiscoveryAspect
_sactorMaxSkills :: ActorMaxSkills
..} =
  State
    { _sdungeon :: Dungeon
_sdungeon =
      (Level -> Level) -> Dungeon -> Dungeon
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (\Level{Bool
Int
[Point]
([Point], [Point])
ProjectileMap
ItemFloor
SmellMap
BigActorMap
EntryMap
AbsDepth
Time
ContentId CaveKind
Area
TileMap
lkind :: Level -> ContentId CaveKind
ldepth :: Level -> AbsDepth
lfloor :: Level -> ItemFloor
lembed :: Level -> ItemFloor
lbig :: Level -> BigActorMap
lproj :: Level -> ProjectileMap
ltile :: Level -> TileMap
lentry :: Level -> EntryMap
larea :: Level -> Area
lsmell :: Level -> SmellMap
lstair :: Level -> ([Point], [Point])
lescape :: Level -> [Point]
lseen :: Level -> Int
lexpl :: Level -> Int
ltime :: Level -> Time
lnight :: Level -> Bool
lkind :: ContentId CaveKind
ldepth :: AbsDepth
lfloor :: ItemFloor
lembed :: ItemFloor
lbig :: BigActorMap
lproj :: ProjectileMap
ltile :: TileMap
lentry :: EntryMap
larea :: Area
lsmell :: SmellMap
lstair :: ([Point], [Point])
lescape :: [Point]
lseen :: Int
lexpl :: Int
ltime :: Time
lnight :: Bool
..} ->
              COps
-> ContentId CaveKind
-> AbsDepth
-> Area
-> ([Point], [Point])
-> [Point]
-> Int
-> Bool
-> Level
unknownLevel COps
_scops ContentId CaveKind
lkind AbsDepth
ldepth Area
larea
                           ([Point], [Point])
lstair [Point]
lescape Int
lexpl Bool
lnight)
             Dungeon
_sdungeon
    , Int
ScoreDict
ActorMaxSkills
ActorDict
FactionDict
DiscoveryAspect
ItemDict
ItemIxMap
DiscoveryKind
AbsDepth
Time
ContentId ModeKind
COps
_stotalDepth :: AbsDepth
_sactorD :: ActorDict
_sitemD :: ItemDict
_sitemIxMap :: ItemIxMap
_sfactionD :: FactionDict
_stime :: Time
_scops :: COps
_sgold :: Int
_shigh :: ScoreDict
_sgameModeId :: ContentId ModeKind
_sdiscoKind :: DiscoveryKind
_sdiscoAspect :: DiscoveryAspect
_sactorMaxSkills :: ActorMaxSkills
_stotalDepth :: AbsDepth
_sactorD :: ActorDict
_sitemD :: ItemDict
_sitemIxMap :: ItemIxMap
_sfactionD :: FactionDict
_stime :: Time
_scops :: COps
_sgold :: Int
_shigh :: ScoreDict
_sgameModeId :: ContentId ModeKind
_sdiscoKind :: DiscoveryKind
_sdiscoAspect :: DiscoveryAspect
_sactorMaxSkills :: ActorMaxSkills
..
    }

-- | Update dungeon data within state.
updateDungeon :: (Dungeon -> Dungeon) -> State -> State
updateDungeon :: (Dungeon -> Dungeon) -> State -> State
updateDungeon Dungeon -> Dungeon
f State
s = State
s {_sdungeon = f (_sdungeon s)}

-- | Update dungeon depth.
updateDepth :: (Dice.AbsDepth -> Dice.AbsDepth) -> State -> State
updateDepth :: (AbsDepth -> AbsDepth) -> State -> State
updateDepth AbsDepth -> AbsDepth
f State
s = State
s {_stotalDepth = f (_stotalDepth s)}

-- | Update the actor dictionary.
updateActorD :: (ActorDict -> ActorDict) -> State -> State
{-# INLINE updateActorD #-}  -- just in case inliner goes hiwire
updateActorD :: (ActorDict -> ActorDict) -> State -> State
updateActorD ActorDict -> ActorDict
f State
s = State
s {_sactorD = f (_sactorD s)}

-- | Update the item dictionary.
updateItemD :: (ItemDict -> ItemDict) -> State -> State
{-# INLINE updateItemD #-}
updateItemD :: (ItemDict -> ItemDict) -> State -> State
updateItemD ItemDict -> ItemDict
f State
s = State
s {_sitemD = f (_sitemD s)}

-- | Update the item kind index map.
updateItemIxMap :: (ItemIxMap -> ItemIxMap) -> State -> State
updateItemIxMap :: (ItemIxMap -> ItemIxMap) -> State -> State
updateItemIxMap ItemIxMap -> ItemIxMap
f State
s = State
s {_sitemIxMap = f (_sitemIxMap s)}

-- | Update faction data within state.
updateFactionD :: (FactionDict -> FactionDict) -> State -> State
updateFactionD :: (FactionDict -> FactionDict) -> State -> State
updateFactionD FactionDict -> FactionDict
f State
s = State
s {_sfactionD = f (_sfactionD s)}

-- | Update global time within state.
updateTime :: (Time -> Time) -> State -> State
{-# INLINE updateTime #-}
updateTime :: (Time -> Time) -> State -> State
updateTime Time -> Time
f State
s = State
s {_stime = f (_stime s)}

-- | Update content data within state and recompute the cached data.
updateCOpsAndCachedData :: (COps -> COps) -> State -> State
updateCOpsAndCachedData :: (COps -> COps) -> State -> State
updateCOpsAndCachedData COps -> COps
f State
s =
  let s2 :: State
s2 = State
s {_scops = f (_scops s)}
  in State
s2 {_sactorMaxSkills = maxSkillsInDungeon s2}

-- | Update total gold value in the dungeon.
updateGold :: (Int -> Int) -> State -> State
updateGold :: (Int -> Int) -> State -> State
updateGold Int -> Int
f State
s = State
s {_sgold = f (_sgold s)}

updateDiscoKind :: (DiscoveryKind -> DiscoveryKind) -> State -> State
updateDiscoKind :: (DiscoveryKind -> DiscoveryKind) -> State -> State
updateDiscoKind DiscoveryKind -> DiscoveryKind
f State
s = State
s {_sdiscoKind = f (_sdiscoKind s)}

updateDiscoAspect :: (DiscoveryAspect -> DiscoveryAspect) -> State -> State
updateDiscoAspect :: (DiscoveryAspect -> DiscoveryAspect) -> State -> State
updateDiscoAspect DiscoveryAspect -> DiscoveryAspect
f State
s = State
s {_sdiscoAspect = f (_sdiscoAspect s)}

updateActorMaxSkills :: (ActorMaxSkills -> ActorMaxSkills) -> State -> State
updateActorMaxSkills :: (ActorMaxSkills -> ActorMaxSkills) -> State -> State
updateActorMaxSkills ActorMaxSkills -> ActorMaxSkills
f State
s = State
s {_sactorMaxSkills = f (_sactorMaxSkills s)}

getItemBody :: ItemId -> State -> Item
getItemBody :: ItemId -> State -> Item
getItemBody ItemId
iid State
s = State -> ItemDict
sitemD State
s ItemDict -> ItemId -> Item
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid

-- This is best guess, including mean aspect record, so we can take into
-- consideration even the kind the item hides under.
aspectRecordFromItem :: ItemId -> Item -> State -> IA.AspectRecord
aspectRecordFromItem :: ItemId -> Item -> State -> AspectRecord
aspectRecordFromItem ItemId
iid Item
item State
s =
  let kindId :: ContentId ItemKind
kindId = case Item -> ItemIdentity
jkind Item
item of
        IdentityObvious ContentId ItemKind
ik -> ContentId ItemKind
ik
        IdentityCovered ItemKindIx
ix ContentId ItemKind
ik -> ContentId ItemKind
-> Maybe (ContentId ItemKind) -> ContentId ItemKind
forall a. a -> Maybe a -> a
fromMaybe ContentId ItemKind
ik (Maybe (ContentId ItemKind) -> ContentId ItemKind)
-> Maybe (ContentId ItemKind) -> ContentId ItemKind
forall a b. (a -> b) -> a -> b
$ ItemKindIx
ix ItemKindIx -> DiscoveryKind -> Maybe (ContentId ItemKind)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` State -> DiscoveryKind
sdiscoKind State
s
      COps{ItemSpeedup
coItemSpeedup :: ItemSpeedup
coItemSpeedup :: COps -> ItemSpeedup
coItemSpeedup} = State -> COps
scops State
s
      mean :: AspectRecord
mean = KindMean -> AspectRecord
IA.kmMean (KindMean -> AspectRecord) -> KindMean -> AspectRecord
forall a b. (a -> b) -> a -> b
$ ContentId ItemKind -> ItemSpeedup -> KindMean
getKindMean ContentId ItemKind
kindId ItemSpeedup
coItemSpeedup
  in AspectRecord -> Maybe AspectRecord -> AspectRecord
forall a. a -> Maybe a -> a
fromMaybe AspectRecord
mean (Maybe AspectRecord -> AspectRecord)
-> Maybe AspectRecord -> AspectRecord
forall a b. (a -> b) -> a -> b
$ ItemId -> DiscoveryAspect -> Maybe AspectRecord
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ItemId
iid (DiscoveryAspect -> Maybe AspectRecord)
-> DiscoveryAspect -> Maybe AspectRecord
forall a b. (a -> b) -> a -> b
$ State -> DiscoveryAspect
sdiscoAspect State
s

aspectRecordFromIid :: ItemId -> State -> IA.AspectRecord
aspectRecordFromIid :: ItemId -> State -> AspectRecord
aspectRecordFromIid ItemId
iid State
s = ItemId -> Item -> State -> AspectRecord
aspectRecordFromItem ItemId
iid (ItemId -> State -> Item
getItemBody ItemId
iid State
s) State
s

maxSkillsFromActor :: Actor -> State -> Ability.Skills
maxSkillsFromActor :: Actor -> State -> Skills
maxSkillsFromActor Actor
b State
s =
  let processIid :: (ItemId, (Int, ItemTimers)) -> (Skills, Int)
processIid (ItemId
iid, (Int
k, ItemTimers
_)) = (AspectRecord -> Skills
IA.aSkills (AspectRecord -> Skills) -> AspectRecord -> Skills
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> AspectRecord
aspectRecordFromIid ItemId
iid State
s, Int
k)
      processBag :: [(ItemId, (Int, ItemTimers))] -> Skills
processBag [(ItemId, (Int, ItemTimers))]
sks = [(Skills, Int)] -> Skills
Ability.sumScaledSkills ([(Skills, Int)] -> Skills) -> [(Skills, Int)] -> Skills
forall a b. (a -> b) -> a -> b
$ ((ItemId, (Int, ItemTimers)) -> (Skills, Int))
-> [(ItemId, (Int, ItemTimers))] -> [(Skills, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId, (Int, ItemTimers)) -> (Skills, Int)
processIid [(ItemId, (Int, ItemTimers))]
sks
  in [(ItemId, (Int, ItemTimers))] -> Skills
processBag ([(ItemId, (Int, ItemTimers))] -> Skills)
-> [(ItemId, (Int, ItemTimers))] -> Skills
forall a b. (a -> b) -> a -> b
$ EnumMap ItemId (Int, ItemTimers) -> [(ItemId, (Int, ItemTimers))]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (Actor -> EnumMap ItemId (Int, ItemTimers)
borgan Actor
b) [(ItemId, (Int, ItemTimers))]
-> [(ItemId, (Int, ItemTimers))] -> [(ItemId, (Int, ItemTimers))]
forall a. [a] -> [a] -> [a]
++ EnumMap ItemId (Int, ItemTimers) -> [(ItemId, (Int, ItemTimers))]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (Actor -> EnumMap ItemId (Int, ItemTimers)
beqp Actor
b)

maxSkillsInDungeon :: State -> ActorMaxSkills
maxSkillsInDungeon :: State -> ActorMaxSkills
maxSkillsInDungeon State
s =
  (Actor -> Skills) -> ActorDict -> ActorMaxSkills
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (Actor -> State -> Skills
`maxSkillsFromActor` State
s) (ActorDict -> ActorMaxSkills) -> ActorDict -> ActorMaxSkills
forall a b. (a -> b) -> a -> b
$ State -> ActorDict
sactorD State
s