module Game.LambdaHack.Server.ItemServer
( rollItem, rollAndRegisterItem, registerItem
, placeItemsInDungeon, embedItemsInDungeon, 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 Data.Maybe
import Game.LambdaHack.Atomic
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
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 qualified Game.LambdaHack.Common.PointArray as PointArray
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Content.ItemKind (ItemKind)
import Game.LambdaHack.Content.TileKind (TileKind)
import qualified Game.LambdaHack.Content.TileKind as TK
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
createLevelItem :: (MonadAtomic m, MonadServer m)
=> Point -> LevelId -> m ()
createLevelItem pos lid = do
Level{litemFreq} <- getLevel lid
let container = CFloor lid pos
void $ rollAndRegisterItem lid litemFreq container True Nothing
embedItem :: (MonadAtomic m, MonadServer m)
=> LevelId -> Point -> Kind.Id TileKind -> m ()
embedItem lid pos tk = do
Kind.COps{cotile} <- getsState scops
let embeds = Tile.embedItems cotile tk
causes = Tile.causeEffects cotile tk
itemFreq = zip embeds (repeat 1)
++ if not (null causes) && null embeds
then [("hero", 1)]
else []
container = CEmbed lid pos
void $ rollAndRegisterItem lid itemFreq container False Nothing
rollItem :: (MonadAtomic m, MonadServer m)
=> LevelId -> Freqs ItemKind
-> m (Maybe (ItemKnown, ItemFull, ItemSeed, GroupName ItemKind))
rollItem lid itemFreq = do
cops <- getsState scops
flavour <- getsServer sflavour
discoRev <- getsServer sdiscoKindRev
totalDepth <- getsState stotalDepth
Level{ldepth} <- getLevel lid
rndToAction $ newItem cops flavour discoRev itemFreq lid ldepth totalDepth
rollAndRegisterItem :: (MonadAtomic m, MonadServer m)
=> LevelId -> Freqs ItemKind -> Container -> Bool
-> Maybe Int
-> m (Maybe (ItemId, (ItemFull, GroupName ItemKind)))
rollAndRegisterItem lid itemFreq container verbose mk = do
m4 <- rollItem lid itemFreq
case m4 of
Nothing -> return Nothing
Just (itemKnown, itemFullRaw, seed, itemGroup) -> do
let itemFull = itemFullRaw {itemK = fromMaybe (itemK itemFullRaw) mk}
iid <- registerItem (itemBase itemFull) itemKnown seed
(itemK itemFull) container verbose
return $ Just (iid, (itemFull, itemGroup))
placeItemsInDungeon :: forall m. (MonadAtomic m, MonadServer m) => m ()
placeItemsInDungeon = do
Kind.COps{cotile} <- getsState scops
let initialItems lid (Level{lfloor, ltile, litemNum, lxsize, lysize}) = do
let factionDist = max lxsize lysize 5
placeItems :: [Point] -> Int -> m ()
placeItems _ 0 = return ()
placeItems lfloorKeys n = do
let dist p = minimum $ maxBound : map (chessDist p) lfloorKeys
pos <- rndToAction $ findPosTry 100 ltile
(\_ t -> Tile.isWalkable cotile t
&& (not $ Tile.hasFeature cotile TK.NoItem t))
[ \p t -> Tile.hasFeature cotile TK.OftenItem t
&& dist p > factionDist `div` 5
, \p t -> Tile.hasFeature cotile TK.OftenItem t
&& dist p > factionDist `div` 7
, \p t -> Tile.hasFeature cotile TK.OftenItem t
&& dist p > factionDist `div` 9
, \p t -> Tile.hasFeature cotile TK.OftenItem t
&& dist p > factionDist `div` 12
, \p _ -> dist p > factionDist `div` 5
, \p t -> Tile.hasFeature cotile TK.OftenItem t
|| dist p > factionDist `div` 7
, \p t -> Tile.hasFeature cotile TK.OftenItem t
|| dist p > factionDist `div` 9
, \p t -> Tile.hasFeature cotile TK.OftenItem t
|| dist p > factionDist `div` 12
, \p _ -> dist p > 1
, \p _ -> dist p > 0
]
createLevelItem pos lid
placeItems (pos : lfloorKeys) (n 1)
placeItems (EM.keys lfloor) litemNum
dungeon <- getsState sdungeon
mapWithKeyM_ initialItems dungeon
embedItemsInDungeon :: (MonadAtomic m, MonadServer m) => m ()
embedItemsInDungeon = do
let embedItems lid (Level{ltile}) =
PointArray.mapWithKeyM_A (embedItem lid) ltile
dungeon <- getsState sdungeon
mapWithKeyM_ embedItems 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 -> ItemQuant -> 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 -> ItemQuant -> m a) -> Actor -> m ()
mapActorCStore_ cstore f b = do
bag <- getsState $ getBodyActorBag b cstore
mapM_ (uncurry f) $ EM.assocs bag