module Game.LambdaHack.Server.ItemServer
( rollAndRegisterItem, registerItem, createItems, placeItemsInDungeon
, fullAssocsServer, activeItemsServer, itemToFullServer, mapActorCStore_
) where
import Control.Monad
import qualified Data.EnumMap.Strict as EM
import qualified Data.HashMap.Strict as HM
import Data.Key (mapWithKeyM_)
import Game.LambdaHack.Atomic
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import qualified Game.LambdaHack.Common.Feature as F
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Server.ItemRev
import Game.LambdaHack.Server.MonadServer
import Game.LambdaHack.Server.State
registerItem :: (MonadAtomic m, MonadServer m)
=> Item -> ItemKnown -> ItemSeed -> Int -> Container -> Bool
-> m ItemId
registerItem item itemKnown@(_, iae) seed k container verbose = do
itemRev <- getsServer sitemRev
let cmd = if verbose then UpdCreateItem else UpdSpotItem
case HM.lookup itemKnown itemRev of
Just iid -> do
execUpdAtomic $ cmd iid item k container
return iid
Nothing -> do
icounter <- getsServer sicounter
modifyServer $ \ser ->
ser { sicounter = succ icounter
, sitemRev = HM.insert itemKnown icounter (sitemRev ser)
, sitemSeedD = EM.insert icounter seed (sitemSeedD ser)
, sdiscoEffect = EM.insert icounter iae (sdiscoEffect ser)}
execUpdAtomic $ cmd icounter item k container
return $! icounter
createItems :: (MonadAtomic m, MonadServer m)
=> Int -> Point -> LevelId -> m ()
createItems n pos lid = do
Level{litemFreq} <- getLevel lid
let container = CFloor lid pos
replicateM_ n $ void $ rollAndRegisterItem lid litemFreq container True
rollAndRegisterItem :: (MonadAtomic m, MonadServer m)
=> LevelId -> Freqs -> Container -> Bool
-> m (Maybe (ItemId, (ItemFull, GroupName)))
rollAndRegisterItem lid itemFreq container verbose = do
cops <- getsState scops
flavour <- getsServer sflavour
discoRev <- getsServer sdiscoKindRev
totalDepth <- getsState stotalDepth
Level{ldepth} <- getLevel lid
m4 <- rndToAction
$ newItem cops flavour discoRev itemFreq lid ldepth totalDepth
case m4 of
Nothing -> return Nothing
Just (itemKnown, itemFull, seed, k, itemGroup) -> do
iid <- registerItem (itemBase itemFull) itemKnown seed k container verbose
return $ Just (iid, (itemFull, itemGroup))
placeItemsInDungeon :: (MonadAtomic m, MonadServer m) => m ()
placeItemsInDungeon = do
Kind.COps{cotile} <- getsState scops
let initialItems lid (Level{ltile, litemNum, lxsize, lysize}) = do
let factionDist = max lxsize lysize 5
replicateM litemNum $ do
Level{lfloor} <- getLevel lid
let dist p = minimum $ maxBound : map (chessDist p) (EM.keys lfloor)
pos <- rndToAction $ findPosTry 100 ltile
(\_ t -> Tile.isWalkable cotile t
&& (not $ Tile.hasFeature cotile F.NoItem t))
[ \p t -> Tile.hasFeature cotile F.OftenItem t
&& dist p > factionDist `div` 5
, \p t -> Tile.hasFeature cotile F.OftenItem t
&& dist p > factionDist `div` 7
, \p t -> Tile.hasFeature cotile F.OftenItem t
&& dist p > factionDist `div` 9
, \p t -> Tile.hasFeature cotile F.OftenItem t
&& dist p > factionDist `div` 12
, \p _ -> dist p > factionDist `div` 5
, \p t -> Tile.hasFeature cotile F.OftenItem t
|| dist p > factionDist `div` 7
, \p t -> Tile.hasFeature cotile F.OftenItem t
|| dist p > factionDist `div` 9
, \p t -> Tile.hasFeature cotile F.OftenItem t
|| dist p > factionDist `div` 12
, \p _ -> dist p > 1
, \p _ -> EM.notMember p lfloor
]
createItems 1 pos lid
dungeon <- getsState sdungeon
mapWithKeyM_ initialItems dungeon
fullAssocsServer :: MonadServer m
=> ActorId -> [CStore] -> m [(ItemId, ItemFull)]
fullAssocsServer aid cstores = do
cops <- getsState scops
discoKind <- getsServer sdiscoKind
discoEffect <- getsServer sdiscoEffect
getsState $ fullAssocs cops discoKind discoEffect aid cstores
activeItemsServer :: MonadServer m => ActorId -> m [ItemFull]
activeItemsServer aid = do
activeAssocs <- fullAssocsServer aid [CEqp, COrgan]
return $! map snd activeAssocs
itemToFullServer :: MonadServer m => m (ItemId -> Int -> ItemFull)
itemToFullServer = do
cops <- getsState scops
discoKind <- getsServer sdiscoKind
discoEffect <- getsServer sdiscoEffect
s <- getState
let itemToF iid = itemToFull cops discoKind discoEffect iid (getItemBody iid s)
return itemToF
mapActorCStore_ :: MonadServer m
=> CStore -> (ItemId -> Int -> m a) -> Actor -> m ()
mapActorCStore_ cstore f b = do
bag <- getsState $ getBodyActorBag b cstore
mapM_ (uncurry f) $ EM.assocs bag