-- | Server operations for items.
module Game.LambdaHack.Server.ItemM
  ( registerItem, moveStashIfNeeded, randomResetTimeout, embedItemOnPos
  , prepareItemKind, rollItemAspect, rollAndRegisterItem
  , placeItemsInDungeon, embedItemsInDungeon, mapActorCStore_
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , onlyRegisterItem, computeRndTimeout, createCaveItem, createEmbedItem
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import qualified Data.HashMap.Strict as HM

import           Game.LambdaHack.Atomic
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.Faction
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.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.Common.Time
import           Game.LambdaHack.Common.Types
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 qualified Game.LambdaHack.Core.Dice as Dice
import           Game.LambdaHack.Core.Frequency
import           Game.LambdaHack.Core.Random
import qualified Game.LambdaHack.Definition.Ability as Ability
import           Game.LambdaHack.Definition.Defs
import           Game.LambdaHack.Server.ItemRev
import           Game.LambdaHack.Server.MonadServer
import           Game.LambdaHack.Server.ServerOptions
import           Game.LambdaHack.Server.State

onlyRegisterItem :: MonadServerAtomic m => ItemKnown -> m ItemId
onlyRegisterItem :: forall (m :: * -> *). MonadServerAtomic m => ItemKnown -> m ItemId
onlyRegisterItem itemKnown :: ItemKnown
itemKnown@(ItemKnown ItemIdentity
_ AspectRecord
arItem Maybe FactionId
_) = do
  itemRev <- (StateServer -> ItemRev) -> m ItemRev
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> ItemRev
sitemRev
  case HM.lookup itemKnown itemRev of
    Just ItemId
iid -> ItemId -> m ItemId
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ItemId
iid
    Maybe ItemId
Nothing -> do
      icounter <- (StateServer -> ItemId) -> m ItemId
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> ItemId
sicounter
      executedOnServer <-
        execUpdAtomicSer $ UpdDiscoverServer icounter arItem
      let !_A = Bool -> () -> ()
forall a. HasCallStack => Bool -> a -> a
assert Bool
executedOnServer ()
      modifyServer $ \StateServer
ser ->
        StateServer
ser { sitemRev = HM.insert itemKnown icounter (sitemRev ser)
            , sicounter = succ icounter }
      return $! icounter

registerItem :: MonadServerAtomic m
             => Bool -> ItemFullKit -> ItemKnown -> Container -> m ItemId
registerItem :: forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> ItemFullKit -> ItemKnown -> Container -> m ItemId
registerItem Bool
verbose (itemFull :: ItemFull
itemFull@ItemFull{Item
itemBase :: Item
itemBase :: ItemFull -> Item
itemBase, ContentId ItemKind
itemKindId :: ContentId ItemKind
itemKindId :: ItemFull -> ContentId ItemKind
itemKindId, ItemKind
itemKind :: ItemKind
itemKind :: ItemFull -> ItemKind
itemKind}, ItemQuant
kit)
             itemKnown :: ItemKnown
itemKnown@(ItemKnown ItemIdentity
_ AspectRecord
arItem Maybe FactionId
_) Container
containerRaw = do
  container <- case Container
containerRaw of
    CActor ActorId
aid CStore
CEqp -> do
      b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
      return $! if eqpFreeN b >= fst kit
                then containerRaw
                else CActor aid CStash
    Container
_ -> Container -> m Container
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Container
containerRaw
  iid <- onlyRegisterItem itemKnown
  let slore = AspectRecord -> Container -> SLore
IA.loreFromContainer AspectRecord
arItem Container
container
  modifyServer $ \StateServer
ser ->
    StateServer
ser {sgenerationAn = EM.adjust (EM.insertWith (+) iid (fst kit)) slore
                                   (sgenerationAn ser)}
  moveStash <- moveStashIfNeeded container
  mapM_ execUpdAtomic moveStash
  execUpdAtomic $ UpdCreateItem verbose iid itemBase kit container
  let worth = Int -> ItemKind -> Int
itemPrice (ItemQuant -> Int
forall a b. (a, b) -> a
fst ItemQuant
kit) ItemKind
itemKind
  case container of
    Container
_ | Int
worth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    CActor ActorId
_ CStore
COrgan -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- destroyed on drop
    CTrunk{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- we assume any valuables in CEmbed can be dug out
    Container
_ -> UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> UpdAtomic
UpdAlterGold Int
worth
  knowItems <- getsServer $ sknowItems . soptions
  when knowItems $ case container of
    CTrunk{} -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Container
_ -> UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Container
-> ItemId -> ContentId ItemKind -> AspectRecord -> UpdAtomic
UpdDiscover Container
container ItemId
iid ContentId ItemKind
itemKindId AspectRecord
arItem
  -- The first recharging period after creation is random,
  -- between 1 and 2 standard timeouts of the item.
  -- In this way we avoid many rattlesnakes rattling in unison.
  case container of
    CActor ActorId
_ CStore
cstore | CStore
cstore CStore -> [CStore] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore
CEqp, CStore
COrgan] ->
      Int -> ItemId -> ItemFull -> [ItemTimer] -> Container -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Int -> ItemId -> ItemFull -> [ItemTimer] -> Container -> m ()
randomResetTimeout (ItemQuant -> Int
forall a b. (a, b) -> a
fst ItemQuant
kit) ItemId
iid ItemFull
itemFull [] Container
container
    Container
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  return iid

moveStashIfNeeded :: MonadStateRead m => Container -> m [UpdAtomic]
moveStashIfNeeded :: forall (m :: * -> *).
MonadStateRead m =>
Container -> m [UpdAtomic]
moveStashIfNeeded Container
c = case Container
c of
  CActor ActorId
aid CStore
CStash -> do
    b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
    mstash <- getsState $ \State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> FactionDict
sfactionD State
s FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b
    case mstash of
      Just (LevelId
lid, Point
pos) -> do
        bagStash <- (State -> ItemBag) -> m ItemBag
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> State -> ItemBag
getFloorBag LevelId
lid Point
pos
        return $! if EM.null bagStash
                  then [ UpdLoseStashFaction False (bfid b) lid pos
                       , UpdSpotStashFaction True (bfid b) (blid b) (bpos b) ]
                  else []
      Maybe (LevelId, Point)
Nothing -> [UpdAtomic] -> m [UpdAtomic]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return [Bool -> FactionId -> LevelId -> Point -> UpdAtomic
UpdSpotStashFaction Bool
True (Actor -> FactionId
bfid Actor
b) (Actor -> LevelId
blid Actor
b) (Actor -> Point
bpos Actor
b)]
  Container
_ -> [UpdAtomic] -> m [UpdAtomic]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []

randomResetTimeout :: MonadServerAtomic m
                   => Int -> ItemId -> ItemFull -> [ItemTimer] -> Container
                   -> m ()
randomResetTimeout :: forall (m :: * -> *).
MonadServerAtomic m =>
Int -> ItemId -> ItemFull -> [ItemTimer] -> Container -> m ()
randomResetTimeout Int
k ItemId
iid ItemFull
itemFull [ItemTimer]
beforeIt Container
toC = do
  lid <- (State -> LevelId) -> m LevelId
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> LevelId) -> m LevelId)
-> (State -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ Container -> State -> LevelId
lidFromC Container
toC
  localTime <- getsState $ getLocalTime lid
  mrndTimeout <- rndToAction $ computeRndTimeout localTime itemFull
  -- The created or moved item set (not the items previously at destination)
  -- has its timeouts reset to a random value between timeout and twice timeout.
  -- This prevents micromanagement via swapping items in and out of eqp
  -- and via exact prediction of first timeout after equip.
  case mrndTimeout of
    Just ItemTimer
rndT -> do
      bagAfter <- (State -> ItemBag) -> m ItemBag
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Container -> State -> ItemBag
getContainerBag Container
toC
      let afterIt = case ItemId
iid ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bagAfter of
            Maybe ItemQuant
Nothing -> [Char] -> [ItemTimer]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [ItemTimer]) -> [Char] -> [ItemTimer]
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> (ItemId, ItemBag, Container) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (ItemId
iid, ItemBag
bagAfter, Container
toC)
            Just (Int
_, [ItemTimer]
it2) -> [ItemTimer]
it2
          resetIt = [ItemTimer]
beforeIt [ItemTimer] -> [ItemTimer] -> [ItemTimer]
forall a. [a] -> [a] -> [a]
++ Int -> ItemTimer -> [ItemTimer]
forall a. Int -> a -> [a]
replicate Int
k ItemTimer
rndT
      when (afterIt /= resetIt) $
        execUpdAtomic $ UpdTimeItem iid toC afterIt resetIt
    Maybe ItemTimer
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- no @Timeout@ aspect; don't touch

computeRndTimeout :: Time -> ItemFull -> Rnd (Maybe ItemTimer)
computeRndTimeout :: Time -> ItemFull -> Rnd (Maybe ItemTimer)
computeRndTimeout Time
localTime ItemFull{itemDisco :: ItemFull -> ItemDisco
itemDisco=ItemDiscoFull AspectRecord
itemAspect} = do
  let t :: Int
t = AspectRecord -> Int
IA.aTimeout AspectRecord
itemAspect
  if Int
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then do
    rndT <- Int -> Rnd Int
forall a. Integral a => a -> Rnd a
randomR0 Int
t
    let rndTurns = Delta Time -> Int -> Delta Time
timeDeltaScale (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeTurn) (Int
t Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rndT)
    return $ Just $ createItemTimer localTime rndTurns
  else Maybe ItemTimer -> Rnd (Maybe ItemTimer)
forall a. a -> StateT SMGen Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ItemTimer
forall a. Maybe a
Nothing
computeRndTimeout Time
_ ItemFull
_ = [Char] -> Rnd (Maybe ItemTimer)
forall a. HasCallStack => [Char] -> a
error [Char]
"computeRndTimeout: server ignorant about an item"

createCaveItem :: MonadServerAtomic m => Point -> LevelId -> m ()
createCaveItem :: forall (m :: * -> *).
MonadServerAtomic m =>
Point -> LevelId -> m ()
createCaveItem Point
pos LevelId
lid = do
  COps{cocave} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Level{lkind, ldepth} <- getLevel lid
  let container = LevelId -> Point -> Container
CFloor LevelId
lid Point
pos
      litemFreq = CaveKind -> Freqs ItemKind
citemFreq (CaveKind -> Freqs ItemKind) -> CaveKind -> Freqs ItemKind
forall a b. (a -> b) -> a -> b
$ ContentData CaveKind -> ContentId CaveKind -> CaveKind
forall a. ContentData a -> ContentId a -> a
okind ContentData CaveKind
cocave ContentId CaveKind
lkind
  -- Power depth of new items unaffected by number of spawned actors.
  freq <- prepareItemKind 0 ldepth litemFreq
  mIidEtc <- rollAndRegisterItem True ldepth freq container Nothing
  createKitItems lid pos mIidEtc

createEmbedItem :: MonadServerAtomic m
                => LevelId -> Point -> GroupName ItemKind -> m ()
createEmbedItem :: forall (m :: * -> *).
MonadServerAtomic m =>
LevelId -> Point -> GroupName ItemKind -> m ()
createEmbedItem LevelId
lid Point
pos GroupName ItemKind
grp = do
  Level{ldepth} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
  let container = LevelId -> Point -> Container
CEmbed LevelId
lid Point
pos
  -- Power depth of new items unaffected by number of spawned actors.
  freq <- prepareItemKind 0 ldepth [(grp, 1)]
  mIidEtc <- rollAndRegisterItem True ldepth freq container Nothing
  createKitItems lid pos mIidEtc

-- Create, register and insert all initial kit items.
createKitItems :: MonadServerAtomic m
               => LevelId -> Point -> Maybe (ItemId, ItemFullKit) -> m ()
createKitItems :: forall (m :: * -> *).
MonadServerAtomic m =>
LevelId -> Point -> Maybe (ItemId, ItemFullKit) -> m ()
createKitItems LevelId
lid Point
pos Maybe (ItemId, ItemFullKit)
mIidEtc = case Maybe (ItemId, ItemFullKit)
mIidEtc of
  Maybe (ItemId, ItemFullKit)
Nothing -> [Char] -> m ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> (LevelId, Point, Maybe (ItemId, ItemFullKit)) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (LevelId
lid, Point
pos, Maybe (ItemId, ItemFullKit)
mIidEtc)
  Just (ItemId
_, (ItemFull
itemFull, ItemQuant
_)) -> do
    cops <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
    lvl@Level{ldepth} <- getLevel lid
    let ikit = ItemKind -> [(GroupName ItemKind, CStore)]
IK.ikit (ItemKind -> [(GroupName ItemKind, CStore)])
-> ItemKind -> [(GroupName ItemKind, CStore)]
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFull
        nearbyPassable = Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
take (Int
20 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [(GroupName ItemKind, CStore)] -> Int
forall a. [a] -> Int
length [(GroupName ItemKind, CStore)]
ikit)
                         ([Point] -> [Point]) -> [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ COps -> Level -> Point -> [Point]
nearbyPassablePoints COps
cops Level
lvl Point
pos
        walkable Point
p = TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable (COps -> TileSpeedup
coTileSpeedup COps
cops) (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p)
        good Point
p = Point -> Bool
walkable Point
p Bool -> Bool -> Bool
&& Point
p Point -> EnumMap Point ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.notMember` Level -> EnumMap Point ItemBag
lfloor Level
lvl
        kitPos = [(GroupName ItemKind, CStore)]
-> [Point] -> [((GroupName ItemKind, CStore), Point)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(GroupName ItemKind, CStore)]
ikit ([Point] -> [((GroupName ItemKind, CStore), Point)])
-> [Point] -> [((GroupName ItemKind, CStore), Point)]
forall a b. (a -> b) -> a -> b
$ (Point -> Bool) -> [Point] -> [Point]
forall a. (a -> Bool) -> [a] -> [a]
filter Point -> Bool
good [Point]
nearbyPassable
                            [Point] -> [Point] -> [Point]
forall a. [a] -> [a] -> [a]
++ (Point -> Bool) -> [Point] -> [Point]
forall a. (a -> Bool) -> [a] -> [a]
filter Point -> Bool
walkable [Point]
nearbyPassable
                            [Point] -> [Point] -> [Point]
forall a. [a] -> [a] -> [a]
++ Point -> [Point]
forall a. a -> [a]
repeat Point
pos
    forM_ kitPos $ \((GroupName ItemKind
ikGrp, CStore
cstore), Point
p) -> do
      let container :: Container
container = if CStore
cstore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CGround
                      then LevelId -> Point -> Container
CFloor LevelId
lid Point
p
                      else LevelId -> Point -> Container
CEmbed LevelId
lid Point
pos
          itemFreq :: Freqs ItemKind
itemFreq = [(GroupName ItemKind
ikGrp, Int
1)]
      -- Power depth of new items unaffected by number of spawned actors.
      freq <- Int
-> AbsDepth
-> Freqs ItemKind
-> m (Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind))
forall (m :: * -> *).
MonadServerAtomic m =>
Int
-> AbsDepth
-> Freqs ItemKind
-> m (Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind))
prepareItemKind Int
0 AbsDepth
ldepth Freqs ItemKind
itemFreq
      mresult <- rollAndRegisterItem False ldepth freq container Nothing
      assert (isJust mresult) $ return ()

-- Tiles already placed, so it's possible to scatter companion items
-- over walkable tiles.
embedItemOnPos :: MonadServerAtomic m
               => LevelId -> Point -> ContentId TileKind -> m ()
embedItemOnPos :: forall (m :: * -> *).
MonadServerAtomic m =>
LevelId -> Point -> ContentId TileKind -> m ()
embedItemOnPos LevelId
lid Point
pos ContentId TileKind
tk = do
  COps{cotile} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  let embedGroups = ContentData TileKind -> ContentId TileKind -> [GroupName ItemKind]
Tile.embeddedItems ContentData TileKind
cotile ContentId TileKind
tk
  mapM_ (createEmbedItem lid pos) embedGroups

prepareItemKind :: MonadServerAtomic m
                => Int -> Dice.AbsDepth -> Freqs ItemKind
                -> m (Frequency
                        (GroupName ItemKind, ContentId IK.ItemKind, ItemKind))
prepareItemKind :: forall (m :: * -> *).
MonadServerAtomic m =>
Int
-> AbsDepth
-> Freqs ItemKind
-> m (Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind))
prepareItemKind Int
lvlSpawned AbsDepth
ldepth Freqs ItemKind
itemFreq = do
  cops <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  uniqueSet <- getsServer suniqueSet
  totalDepth <- getsState stotalDepth
  return $! newItemKind cops uniqueSet itemFreq ldepth totalDepth lvlSpawned

rollItemAspect :: MonadServerAtomic m
               => Frequency
                    (GroupName ItemKind, ContentId IK.ItemKind, ItemKind)
               -> Dice.AbsDepth
               -> m NewItem
rollItemAspect :: forall (m :: * -> *).
MonadServerAtomic m =>
Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> AbsDepth -> m NewItem
rollItemAspect Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq AbsDepth
ldepth = do
  cops <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  flavour <- getsServer sflavour
  discoRev <- getsServer sdiscoKindRev
  totalDepth <- getsState stotalDepth
  m2 <- rndToAction $ newItem cops freq flavour discoRev ldepth totalDepth
  case m2 of
    NewItem GroupName ItemKind
_ (ItemKnown ItemIdentity
_ AspectRecord
arItem Maybe FactionId
_) ItemFull{ContentId ItemKind
itemKindId :: ItemFull -> ContentId ItemKind
itemKindId :: ContentId ItemKind
itemKindId} ItemQuant
_ -> do
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Unique AspectRecord
arItem) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
          StateServer
ser {suniqueSet = ES.insert itemKindId (suniqueSet ser)}
    NewItem
NoNewItem -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  return m2

rollAndRegisterItem :: MonadServerAtomic m
                    => Bool
                    -> Dice.AbsDepth
                    -> Frequency
                         (GroupName ItemKind, ContentId IK.ItemKind, ItemKind)
                    -> Container
                    -> Maybe Int
                    -> m (Maybe (ItemId, ItemFullKit))
rollAndRegisterItem :: forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> AbsDepth
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> Container
-> Maybe Int
-> m (Maybe (ItemId, ItemFullKit))
rollAndRegisterItem Bool
verbose AbsDepth
ldepth Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq Container
container Maybe Int
mk = do
  m2 <- Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> AbsDepth -> m NewItem
forall (m :: * -> *).
MonadServerAtomic m =>
Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> AbsDepth -> m NewItem
rollItemAspect Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq AbsDepth
ldepth
  case m2 of
    NewItem
NoNewItem -> Maybe (ItemId, ItemFullKit) -> m (Maybe (ItemId, ItemFullKit))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ItemId, ItemFullKit)
forall a. Maybe a
Nothing
    NewItem GroupName ItemKind
_ ItemKnown
itemKnown ItemFull
itemFull ItemQuant
kit -> do
      let f :: Int -> ItemQuant
f Int
k = if Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& [ItemTimer] -> Bool
forall a. [a] -> Bool
null (ItemQuant -> [ItemTimer]
forall a b. (a, b) -> b
snd ItemQuant
kit)
                then ItemQuant
quantSingle
                else (Int
k, ItemQuant -> [ItemTimer]
forall a b. (a, b) -> b
snd ItemQuant
kit)
          !kit2 :: ItemQuant
kit2 = ItemQuant -> (Int -> ItemQuant) -> Maybe Int -> ItemQuant
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ItemQuant
kit Int -> ItemQuant
f Maybe Int
mk
      iid <- Bool -> ItemFullKit -> ItemKnown -> Container -> m ItemId
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> ItemFullKit -> ItemKnown -> Container -> m ItemId
registerItem Bool
verbose (ItemFull
itemFull, ItemQuant
kit2) ItemKnown
itemKnown Container
container
      return $ Just (iid, (itemFull, kit2))

-- Tiles already placed, so it's possible to scatter over walkable tiles.
placeItemsInDungeon :: forall m. MonadServerAtomic m
                    => EM.EnumMap LevelId (EM.EnumMap FactionId Point) -> m ()
placeItemsInDungeon :: forall (m :: * -> *).
MonadServerAtomic m =>
EnumMap LevelId (EnumMap FactionId Point) -> m ()
placeItemsInDungeon EnumMap LevelId (EnumMap FactionId Point)
factionPositions = do
  COps{cocave, coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  totalDepth <- getsState stotalDepth
  let initialItems (LevelId
lid, lvl :: Level
lvl@Level{ContentId CaveKind
lkind :: Level -> ContentId CaveKind
lkind :: ContentId CaveKind
lkind, AbsDepth
ldepth :: Level -> AbsDepth
ldepth :: AbsDepth
ldepth}) = do
        litemNum <- Rnd Int -> m Int
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction (Rnd Int -> m Int) -> Rnd Int -> m Int
forall a b. (a -> b) -> a -> b
$ AbsDepth -> AbsDepth -> Dice -> Rnd Int
castDice AbsDepth
ldepth AbsDepth
totalDepth
                                  (CaveKind -> Dice
citemNum (CaveKind -> Dice) -> CaveKind -> Dice
forall a b. (a -> b) -> a -> b
$ ContentData CaveKind -> ContentId CaveKind -> CaveKind
forall a. ContentData a -> ContentId a -> a
okind ContentData CaveKind
cocave ContentId CaveKind
lkind)
        let alPos = EnumMap FactionId Point -> [Point]
forall k a. EnumMap k a -> [a]
EM.elems (EnumMap FactionId Point -> [Point])
-> EnumMap FactionId Point -> [Point]
forall a b. (a -> b) -> a -> b
$ EnumMap FactionId Point
-> LevelId
-> EnumMap LevelId (EnumMap FactionId Point)
-> EnumMap FactionId Point
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault EnumMap FactionId Point
forall k a. EnumMap k a
EM.empty LevelId
lid EnumMap LevelId (EnumMap FactionId Point)
factionPositions
            placeItems :: Int -> m ()
            placeItems Int
n | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
litemNum = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            placeItems !Int
n = do
              Level{lfloor} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
              -- Don't generate items around initial actors or in bunches.
              let distAndNotFloor !Point
p ContentId TileKind
_ =
                    let f :: Point -> Bool
f !Point
k = Point -> Point -> Int
chessDist Point
p Point
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4
                    in Point
p Point -> EnumMap Point ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.notMember` EnumMap Point ItemBag
lfloor Bool -> Bool -> Bool
&& (Point -> Bool) -> [Point] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Point -> Bool
f [Point]
alPos
              mpos <- rndToAction $ findPosTry2 10 lvl
                (\Point
_ !ContentId TileKind
t -> TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup ContentId TileKind
t
                          Bool -> Bool -> Bool
&& Bool -> Bool
not (TileSpeedup -> ContentId TileKind -> Bool
Tile.isNoItem TileSpeedup
coTileSpeedup ContentId TileKind
t))
                [ \Point
_ !ContentId TileKind
t -> TileSpeedup -> ContentId TileKind -> Bool
Tile.isVeryOftenItem TileSpeedup
coTileSpeedup ContentId TileKind
t
                , \Point
_ !ContentId TileKind
t -> TileSpeedup -> ContentId TileKind -> Bool
Tile.isCommonItem TileSpeedup
coTileSpeedup ContentId TileKind
t ]
                distAndNotFloor
                (replicate 10 distAndNotFloor)
              case mpos of
                Just Point
pos -> do
                  Point -> LevelId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Point -> LevelId -> m ()
createCaveItem Point
pos LevelId
lid
                  Int -> m ()
placeItems (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
                Maybe Point
Nothing -> Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
debugPossiblyPrint
                  Text
"Server: placeItemsInDungeon: failed to find positions"
        placeItems 0
  dungeon <- getsState sdungeon
  -- Make sure items on easy levels are generated first, to avoid all
  -- artifacts on deep levels.
  let fromEasyToHard = ((LevelId, Level) -> (LevelId, Level) -> Ordering)
-> [(LevelId, Level)] -> [(LevelId, Level)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((LevelId, Level) -> AbsDepth)
-> (LevelId, Level) -> (LevelId, Level) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Level -> AbsDepth
ldepth (Level -> AbsDepth)
-> ((LevelId, Level) -> Level) -> (LevelId, Level) -> AbsDepth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LevelId, Level) -> Level
forall a b. (a, b) -> b
snd)) ([(LevelId, Level)] -> [(LevelId, Level)])
-> [(LevelId, Level)] -> [(LevelId, Level)]
forall a b. (a -> b) -> a -> b
$ Dungeon -> [(LevelId, Level)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs Dungeon
dungeon
  mapM_ initialItems fromEasyToHard

-- Tiles already placed, so it's possible to scatter companion items
-- over walkable tiles.
embedItemsInDungeon :: MonadServerAtomic m => m ()
embedItemsInDungeon :: forall (m :: * -> *). MonadServerAtomic m => m ()
embedItemsInDungeon = do
  let embedItemsOnLevel :: (LevelId, Level) -> m ()
embedItemsOnLevel (LevelId
lid, Level{TileMap
ltile :: TileMap
ltile :: Level -> TileMap
ltile}) =
        (Point -> ContentId TileKind -> m ()) -> TileMap -> m ()
forall (m :: * -> *) c.
(Monad m, UnboxRepClass c) =>
(Point -> c -> m ()) -> Array c -> m ()
PointArray.imapMA_ (LevelId -> Point -> ContentId TileKind -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
LevelId -> Point -> ContentId TileKind -> m ()
embedItemOnPos LevelId
lid) TileMap
ltile
  dungeon <- (State -> Dungeon) -> m Dungeon
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Dungeon
sdungeon
  -- Make sure items on easy levels are generated first, to avoid all
  -- artifacts on deep levels.
  let fromEasyToHard = ((LevelId, Level) -> (LevelId, Level) -> Ordering)
-> [(LevelId, Level)] -> [(LevelId, Level)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((LevelId, Level) -> AbsDepth)
-> (LevelId, Level) -> (LevelId, Level) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Level -> AbsDepth
ldepth (Level -> AbsDepth)
-> ((LevelId, Level) -> Level) -> (LevelId, Level) -> AbsDepth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LevelId, Level) -> Level
forall a b. (a, b) -> b
snd)) ([(LevelId, Level)] -> [(LevelId, Level)])
-> [(LevelId, Level)] -> [(LevelId, Level)]
forall a b. (a -> b) -> a -> b
$ Dungeon -> [(LevelId, Level)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs Dungeon
dungeon
  mapM_ embedItemsOnLevel fromEasyToHard

-- | Mapping over actor's items from a give store.
mapActorCStore_ :: MonadServer m
                => CStore -> (ItemId -> ItemQuant -> m ()) -> Actor -> m ()
mapActorCStore_ :: forall (m :: * -> *).
MonadServer m =>
CStore -> (ItemId -> ItemQuant -> m ()) -> Actor -> m ()
mapActorCStore_ CStore
cstore ItemId -> ItemQuant -> m ()
f Actor
b = do
  bag <- (State -> ItemBag) -> m ItemBag
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
cstore
  mapM_ (uncurry f) $ EM.assocs bag