module Game.LambdaHack.Common.State
(
State
, sdungeon, stotalDepth, sactorD, sitemD, sitemIxMap, sfactionD, stime, scops
, sgold, shigh, sgameModeId, sdiscoKind, sdiscoAspect, sactorAspect
, defStateGlobal, emptyState, localFromGlobal
, updateDungeon, updateDepth, updateActorD, updateItemD, updateItemIxMap
, updateFactionD, updateTime, updateCOpsAndCachedData, updateGold
, updateDiscoKind, updateDiscoAspect, updateActorAspect
, getItemBody, aspectRecordFromItem, aspectRecordFromIid
, aspectRecordFromActor, actorAspectInDungeon
#ifdef EXPOSE_INTERNAL
, unknownLevel, unknownTileMap
#endif
) where
import Prelude ()
import Game.LambdaHack.Common.Prelude
import Data.Binary
import qualified Data.EnumMap.Strict as EM
import Game.LambdaHack.Common.Actor
import qualified Game.LambdaHack.Common.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.Content.CaveKind (CaveKind)
import qualified Game.LambdaHack.Content.ItemKind as IK
import Game.LambdaHack.Content.ModeKind
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
, _sactorAspect :: ActorAspect
}
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
_sactorAspect = 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
sactorAspect :: State -> ActorAspect
sactorAspect = _sactorAspect
unknownLevel :: COps -> ContentId CaveKind -> Dice.AbsDepth -> X -> Y
-> ([Point], [Point]) -> [Point] -> Int -> Bool
-> Level
unknownLevel COps{cotile}
lkind ldepth lxsize lysize lstair lescape lexpl lnight =
let outerId = ouniqGroup cotile "unknown outer fence"
in Level { lkind
, ldepth
, lfloor = EM.empty
, lembed = EM.empty
, lactor = EM.empty
, ltile = unknownTileMap outerId lxsize lysize
, lxsize
, lysize
, lsmell = EM.empty
, lstair
, lescape
, lseen = 0
, lexpl
, ltime = timeZero
, lnight
}
unknownTileMap :: ContentId TileKind -> Int -> Int -> TileMap
unknownTileMap outerId lxsize lysize =
let unknownMap = PointArray.replicateA lxsize lysize unknownId
borders = [ Point x y
| x <- [0, lxsize - 1], y <- [1..lysize - 2] ]
++ [ Point x y
| x <- [0..lxsize - 1], y <- [0, lysize - 1] ]
outerUpdate = zip borders $ 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
, _sactorAspect = 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
, _sactorAspect = EM.empty
}
localFromGlobal :: State -> State
localFromGlobal State{..} =
State
{ _sdungeon =
EM.map (\Level{..} ->
unknownLevel _scops lkind ldepth lxsize lysize
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 {_sactorAspect = actorAspectInDungeon 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)}
updateActorAspect :: (ActorAspect -> ActorAspect) -> State -> State
updateActorAspect f s = s {_sactorAspect = f (_sactorAspect 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 $ IK.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
aspectRecordFromActor :: Actor -> State -> IA.AspectRecord
aspectRecordFromActor b s =
let processIid (iid, (k, _)) = (aspectRecordFromIid iid s, k)
processBag ass = IA.sumAspectRecord $ map processIid ass
in processBag $ EM.assocs (borgan b) ++ EM.assocs (beqp b)
actorAspectInDungeon :: State -> ActorAspect
actorAspectInDungeon s =
EM.map (`aspectRecordFromActor` s) $ sactorD s