module Game.LambdaHack.Common.State
(
State
, sdungeon, stotalDepth, sactorD, sitemD, sitemIxMap, sfactionD, stime, scops
, sgold, shigh, sgameModeId, sdiscoKind, sdiscoAspect, sactorMaxSkills
, defStateGlobal, emptyState, localFromGlobal
, updateDungeon, updateDepth, updateActorD, updateItemD, updateItemIxMap
, updateFactionD, updateTime, updateCOpsAndCachedData, updateGold
, updateDiscoKind, updateDiscoAspect, updateActorMaxSkills
, getItemBody, aspectRecordFromItem, aspectRecordFromIid
, maxSkillsFromActor, maxSkillsInDungeon
#ifdef EXPOSE_INTERNAL
, unknownLevel, unknownTileMap
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import Data.Binary
import qualified Data.EnumMap.Strict as EM
import qualified Game.LambdaHack.Definition.Ability as Ability
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.Area
import Game.LambdaHack.Definition.Defs
import qualified Game.LambdaHack.Core.Dice as Dice
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, unknownId)
data State = State
{ _sdungeon :: Dungeon
, _stotalDepth :: Dice.AbsDepth
, _sactorD :: ActorDict
, _sitemD :: ItemDict
, _sitemIxMap :: ItemIxMap
, _sfactionD :: FactionDict
, _stime :: Time
, _scops :: COps
, _sgold :: Int
, _shigh :: HighScore.ScoreDict
, _sgameModeId :: ContentId ModeKind
, _sdiscoKind :: DiscoveryKind
, _sdiscoAspect :: DiscoveryAspect
, _sactorMaxSkills :: ActorMaxSkills
}
deriving (Show, Eq)
instance Binary State where
put State{..} = do
put _sdungeon
put _stotalDepth
put _sactorD
put _sitemD
put _sitemIxMap
put _sfactionD
put _stime
put _sgold
put _shigh
put _sgameModeId
put _sdiscoKind
put _sdiscoAspect
get = do
_sdungeon <- get
_stotalDepth <- get
_sactorD <- get
_sitemD <- get
_sitemIxMap <- get
_sfactionD <- get
_stime <- get
_sgold <- get
_shigh <- get
_sgameModeId <- get
_sdiscoKind <- get
_sdiscoAspect <- get
let _scops = emptyCOps
_sactorMaxSkills = EM.empty
return $! State{..}
sdungeon :: State -> Dungeon
sdungeon = _sdungeon
stotalDepth :: State -> Dice.AbsDepth
stotalDepth = _stotalDepth
sactorD :: State -> ActorDict
sactorD = _sactorD
sitemD :: State -> ItemDict
sitemD = _sitemD
sitemIxMap :: State -> ItemIxMap
sitemIxMap = _sitemIxMap
sfactionD :: State -> FactionDict
sfactionD = _sfactionD
stime :: State -> Time
stime = _stime
scops :: State -> COps
scops = _scops
sgold :: State -> Int
sgold = _sgold
shigh :: State -> HighScore.ScoreDict
shigh = _shigh
sgameModeId :: State -> ContentId ModeKind
sgameModeId = _sgameModeId
sdiscoKind :: State -> DiscoveryKind
sdiscoKind = _sdiscoKind
sdiscoAspect :: State -> DiscoveryAspect
sdiscoAspect = _sdiscoAspect
sactorMaxSkills :: State -> ActorMaxSkills
sactorMaxSkills = _sactorMaxSkills
unknownLevel :: COps -> ContentId CaveKind -> Dice.AbsDepth -> Area
-> ([Point], [Point]) -> [Point] -> Int -> Bool
-> Level
unknownLevel COps{corule, cotile}
lkind ldepth larea lstair lescape lexpl lnight =
let outerId = ouniqGroup cotile "unknown outer fence"
in Level { lkind
, ldepth
, lfloor = EM.empty
, lembed = EM.empty
, lbig = EM.empty
, lproj = EM.empty
, ltile = unknownTileMap larea outerId (rXmax corule) (rYmax corule)
, lentry = EM.empty
, larea
, lsmell = EM.empty
, lstair
, lescape
, lseen = 0
, lexpl
, ltime = timeZero
, lnight
}
unknownTileMap :: Area -> ContentId TileKind -> X -> Y -> TileMap
unknownTileMap larea outerId rXmax rYmax =
let unknownMap = PointArray.replicateA rXmax rYmax unknownId
outerUpdate = zip (areaInnerBorder larea) $ repeat outerId
in unknownMap PointArray.// outerUpdate
defStateGlobal :: Dungeon -> Dice.AbsDepth -> FactionDict -> COps
-> HighScore.ScoreDict -> ContentId ModeKind -> DiscoveryKind
-> State
defStateGlobal _sdungeon _stotalDepth _sfactionD _scops _shigh _sgameModeId
_sdiscoKind =
State
{ _sactorD = EM.empty
, _sitemD = EM.empty
, _sitemIxMap = EM.empty
, _stime = timeZero
, _sgold = 0
, _sdiscoAspect = EM.empty
, _sactorMaxSkills = EM.empty
, ..
}
emptyState :: State
emptyState =
State
{ _sdungeon = EM.empty
, _stotalDepth = Dice.AbsDepth 0
, _sactorD = EM.empty
, _sitemD = EM.empty
, _sitemIxMap = EM.empty
, _sfactionD = EM.empty
, _stime = timeZero
, _scops = emptyCOps
, _sgold = 0
, _shigh = HighScore.empty
, _sgameModeId = toEnum 0
, _sdiscoKind = EM.empty
, _sdiscoAspect = EM.empty
, _sactorMaxSkills = EM.empty
}
localFromGlobal :: State -> State
localFromGlobal State{..} =
State
{ _sdungeon =
EM.map (\Level{..} ->
unknownLevel _scops lkind ldepth larea
lstair lescape lexpl lnight)
_sdungeon
, ..
}
updateDungeon :: (Dungeon -> Dungeon) -> State -> State
updateDungeon f s = s {_sdungeon = f (_sdungeon s)}
updateDepth :: (Dice.AbsDepth -> Dice.AbsDepth) -> State -> State
updateDepth f s = s {_stotalDepth = f (_stotalDepth s)}
updateActorD :: (ActorDict -> ActorDict) -> State -> State
updateActorD f s = s {_sactorD = f (_sactorD s)}
updateItemD :: (ItemDict -> ItemDict) -> State -> State
updateItemD f s = s {_sitemD = f (_sitemD s)}
updateItemIxMap :: (ItemIxMap -> ItemIxMap) -> State -> State
updateItemIxMap f s = s {_sitemIxMap = f (_sitemIxMap s)}
updateFactionD :: (FactionDict -> FactionDict) -> State -> State
updateFactionD f s = s {_sfactionD = f (_sfactionD s)}
updateTime :: (Time -> Time) -> State -> State
updateTime f s = s {_stime = f (_stime s)}
updateCOpsAndCachedData :: (COps -> COps) -> State -> State
updateCOpsAndCachedData f s =
let s2 = s {_scops = f (_scops s)}
in s2 {_sactorMaxSkills = maxSkillsInDungeon s2}
updateGold :: (Int -> Int) -> State -> State
updateGold f s = s {_sgold = f (_sgold s)}
updateDiscoKind :: (DiscoveryKind -> DiscoveryKind) -> State -> State
updateDiscoKind f s = s {_sdiscoKind = f (_sdiscoKind s)}
updateDiscoAspect :: (DiscoveryAspect -> DiscoveryAspect) -> State -> State
updateDiscoAspect f s = s {_sdiscoAspect = f (_sdiscoAspect s)}
updateActorMaxSkills :: (ActorMaxSkills -> ActorMaxSkills) -> State -> State
updateActorMaxSkills f s = s {_sactorMaxSkills = f (_sactorMaxSkills s)}
getItemBody :: ItemId -> State -> Item
getItemBody iid s = sitemD s EM.! iid
aspectRecordFromItem :: ItemId -> Item -> State -> IA.AspectRecord
aspectRecordFromItem iid item s =
let kindId = case jkind item of
IdentityObvious ik -> ik
IdentityCovered ix ik -> fromMaybe ik $ ix `EM.lookup` sdiscoKind s
COps{coItemSpeedup} = scops s
mean = IA.kmMean $ getKindMean kindId coItemSpeedup
in fromMaybe mean $ EM.lookup iid $ sdiscoAspect s
aspectRecordFromIid :: ItemId -> State -> IA.AspectRecord
aspectRecordFromIid iid s = aspectRecordFromItem iid (getItemBody iid s) s
maxSkillsFromActor :: Actor -> State -> Ability.Skills
maxSkillsFromActor b s =
let processIid (iid, (k, _)) = (IA.aSkills $ aspectRecordFromIid iid s, k)
processBag sks = Ability.sumScaledSkills $ map processIid sks
in processBag $ EM.assocs (borgan b) ++ EM.assocs (beqp b)
maxSkillsInDungeon :: State -> ActorMaxSkills
maxSkillsInDungeon s =
EM.map (`maxSkillsFromActor` s) $ sactorD s