module Game.LambdaHack.Server.ItemM
( registerItem, embedItem, rollItem, rollAndRegisterItem
, placeItemsInDungeon, embedItemsInDungeon, mapActorCStore_
#ifdef EXPOSE_INTERNAL
, onlyRegisterItem, createLevelItem
#endif
) where
import Prelude ()
import Game.LambdaHack.Common.Prelude
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Data.Function
import qualified Data.HashMap.Strict as HM
import Data.Ord
import Game.LambdaHack.Atomic
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.ContentData
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.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Common.PointArray as PointArray
import Game.LambdaHack.Common.Random
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Content.CaveKind (citemFreq, citemNum)
import Game.LambdaHack.Content.ItemKind (ItemKind)
import qualified Game.LambdaHack.Content.ItemKind as IK
import Game.LambdaHack.Content.TileKind (TileKind)
import Game.LambdaHack.Server.ItemRev
import Game.LambdaHack.Server.MonadServer
import Game.LambdaHack.Server.ServerOptions
import Game.LambdaHack.Server.State
onlyRegisterItem :: MonadServerAtomic m => ItemKnown -> IA.ItemSeed -> m ItemId
onlyRegisterItem itemKnown@(_, aspectRecord, _) seed = do
itemRev <- getsServer sitemRev
case HM.lookup itemKnown itemRev of
Just iid -> return iid
Nothing -> do
icounter <- getsServer sicounter
executedOnServer <-
execUpdAtomicSer $ UpdDiscoverServer icounter aspectRecord
let !_A = assert executedOnServer ()
modifyServer $ \ser ->
ser { sitemSeedD = EM.insert icounter seed (sitemSeedD ser)
, sitemRev = HM.insert itemKnown icounter (sitemRev ser)
, sicounter = succ icounter }
return $! icounter
registerItem :: MonadServerAtomic m
=> ItemFullKit -> ItemKnown -> IA.ItemSeed -> Container -> Bool
-> m ItemId
registerItem (ItemFull{itemBase, itemKindId, itemKind}, kit)
itemKnown seed container verbose = do
iid <- onlyRegisterItem itemKnown seed
let cmd = if verbose then UpdCreateItem else UpdSpotItem False
execUpdAtomic $ cmd iid itemBase kit container
let worth = itemPrice (fst kit) itemKind
unless (worth == 0) $ execUpdAtomic $ UpdAlterGold worth
knowItems <- getsServer $ sknowItems . soptions
when knowItems $ case container of
CTrunk{} -> return ()
_ -> execUpdAtomic $ UpdDiscover container iid itemKindId seed
return iid
createLevelItem :: MonadServerAtomic m => Point -> LevelId -> m ()
createLevelItem pos lid = do
COps{cocave} <- getsState scops
Level{lkind} <- getLevel lid
let container = CFloor lid pos
litemFreq = citemFreq $ okind cocave lkind
void $ rollAndRegisterItem lid litemFreq container True Nothing
embedItem :: MonadServerAtomic m
=> LevelId -> Point -> ContentId TileKind -> m ()
embedItem lid pos tk = do
COps{cotile} <- getsState scops
let embeds = Tile.embeddedItems cotile tk
container = CEmbed lid pos
f grp = rollAndRegisterItem lid [(grp, 1)] container False Nothing
mapM_ f embeds
rollItem :: MonadServerAtomic m
=> Int -> LevelId -> Freqs ItemKind
-> m (Maybe (ItemKnown, ItemFullKit, IA.ItemSeed, GroupName ItemKind))
rollItem lvlSpawned lid itemFreq = do
cops <- getsState scops
flavour <- getsServer sflavour
discoRev <- getsServer sdiscoKindRev
uniqueSet <- getsServer suniqueSet
totalDepth <- getsState stotalDepth
Level{ldepth} <- getLevel lid
m4 <- rndToAction $ newItem cops flavour discoRev uniqueSet
itemFreq lvlSpawned lid ldepth totalDepth
case m4 of
Just (_, (ItemFull{itemKindId, itemKind}, _), _, _) ->
when (IK.Unique `elem` IK.ifeature itemKind) $
modifyServer $ \ser ->
ser {suniqueSet = ES.insert itemKindId (suniqueSet ser)}
_ -> return ()
return m4
rollAndRegisterItem :: MonadServerAtomic m
=> LevelId -> Freqs ItemKind -> Container -> Bool
-> Maybe Int
-> m (Maybe (ItemId, (ItemFullKit, GroupName ItemKind)))
rollAndRegisterItem lid itemFreq container verbose mk = do
m4 <- rollItem 0 lid itemFreq
case m4 of
Nothing -> return Nothing
Just (itemKnown, (itemFull, kit), seed, itemGroup) -> do
let kit2 = (fromMaybe (fst kit) mk, snd kit)
iid <- registerItem (itemFull, kit2) itemKnown seed container verbose
return $ Just (iid, ((itemFull, kit2), itemGroup))
placeItemsInDungeon :: forall m. MonadServerAtomic m
=> EM.EnumMap LevelId [Point] -> m ()
placeItemsInDungeon alliancePositions = do
COps{cocave, coTileSpeedup} <- getsState scops
totalDepth <- getsState stotalDepth
let initialItems (lid, Level{lkind, ldepth, lxsize, lysize, ltile}) = do
litemNum <- rndToAction $ castDice ldepth totalDepth
(citemNum $ okind cocave lkind)
let placeItems :: Int -> m ()
placeItems n | n == litemNum = return ()
placeItems !n = do
Level{lfloor} <- getLevel lid
let distAndOften !p !t =
let f !k _ b = chessDist p k > 6 && b
in Tile.isOftenItem coTileSpeedup t
&& EM.foldrWithKey f True lfloor
alPos = EM.findWithDefault [] lid alliancePositions
distAllianceAndNotFloor !p _ =
let f !k b = chessDist p k > 4 && b
in p `EM.notMember` lfloor && foldr f True alPos
pos <- rndToAction $ findPosTry2 200 ltile
(\_ !t -> Tile.isWalkable coTileSpeedup t
&& not (Tile.isNoItem coTileSpeedup t))
([distAndOften | n * 100 < lxsize * lysize]
++ [\_ !t -> Tile.isOftenItem coTileSpeedup t])
distAllianceAndNotFloor
[distAllianceAndNotFloor]
createLevelItem pos lid
placeItems (n + 1)
placeItems 0
dungeon <- getsState sdungeon
let absLid = abs . fromEnum
fromEasyToHard = sortBy (comparing absLid `on` fst) $ EM.assocs dungeon
mapM_ initialItems fromEasyToHard
embedItemsInDungeon :: MonadServerAtomic m => m ()
embedItemsInDungeon = do
let embedItems (lid, Level{ltile}) = PointArray.imapMA_ (embedItem lid) ltile
dungeon <- getsState sdungeon
let absLid = abs . fromEnum
fromEasyToHard = sortBy (comparing absLid `on` fst) $ EM.assocs dungeon
mapM_ embedItems fromEasyToHard
mapActorCStore_ :: MonadServer m
=> CStore -> (ItemId -> ItemQuant -> m a) -> Actor -> m ()
mapActorCStore_ cstore f b = do
bag <- getsState $ getBodyStoreBag b cstore
mapM_ (uncurry f) $ EM.assocs bag