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

import Prelude ()

import Game.LambdaHack.Core.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.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.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           Game.LambdaHack.Core.Frequency
import           Game.LambdaHack.Common.Point
import qualified Game.LambdaHack.Common.PointArray as PointArray
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 :: ItemKnown -> m ItemId
onlyRegisterItem itemKnown :: ItemKnown
itemKnown@(ItemKnown _ arItem :: AspectRecord
arItem _) = do
  ItemRev
itemRev <- (StateServer -> ItemRev) -> m ItemRev
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> ItemRev
sitemRev
  case ItemKnown -> ItemRev -> Maybe ItemId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup ItemKnown
itemKnown ItemRev
itemRev of
    Just iid :: ItemId
iid -> ItemId -> m ItemId
forall (m :: * -> *) a. Monad m => a -> m a
return ItemId
iid
    Nothing -> do
      ItemId
icounter <- (StateServer -> ItemId) -> m ItemId
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> ItemId
sicounter
      Bool
executedOnServer <-
        UpdAtomic -> m Bool
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m Bool
execUpdAtomicSer (UpdAtomic -> m Bool) -> UpdAtomic -> m Bool
forall a b. (a -> b) -> a -> b
$ ItemId -> AspectRecord -> UpdAtomic
UpdDiscoverServer ItemId
icounter AspectRecord
arItem
      let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert Bool
executedOnServer ()
      (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser ->
        StateServer
ser { sitemRev :: ItemRev
sitemRev = ItemKnown -> ItemId -> ItemRev -> ItemRev
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert ItemKnown
itemKnown ItemId
icounter (StateServer -> ItemRev
sitemRev StateServer
ser)
            , sicounter :: ItemId
sicounter = ItemId -> ItemId
forall a. Enum a => a -> a
succ ItemId
icounter }
      ItemId -> m ItemId
forall (m :: * -> *) a. Monad m => a -> m a
return (ItemId -> m ItemId) -> ItemId -> m ItemId
forall a b. (a -> b) -> a -> b
$! ItemId
icounter

registerItem :: MonadServerAtomic m
             => ItemFullKit -> ItemKnown -> Container -> Bool
             -> m ItemId
registerItem :: ItemFullKit -> ItemKnown -> Container -> Bool -> m ItemId
registerItem (itemFull :: ItemFull
itemFull@ItemFull{Item
itemBase :: ItemFull -> Item
itemBase :: Item
itemBase, ContentId ItemKind
itemKindId :: ItemFull -> ContentId ItemKind
itemKindId :: ContentId ItemKind
itemKindId, ItemKind
itemKind :: ItemFull -> ItemKind
itemKind :: ItemKind
itemKind}, kit :: ItemQuant
kit)
             itemKnown :: ItemKnown
itemKnown@(ItemKnown _ arItem :: AspectRecord
arItem _) container :: Container
container verbose :: Bool
verbose = do
  ItemId
iid <- ItemKnown -> m ItemId
forall (m :: * -> *). MonadServerAtomic m => ItemKnown -> m ItemId
onlyRegisterItem ItemKnown
itemKnown
  let slore :: SLore
slore = AspectRecord -> Container -> SLore
IA.loreFromContainer AspectRecord
arItem Container
container
  (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser ->
    StateServer
ser {sgenerationAn :: GenerationAnalytics
sgenerationAn = (EnumMap ItemId Int -> EnumMap ItemId Int)
-> SLore -> GenerationAnalytics -> GenerationAnalytics
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust ((Int -> Int -> Int)
-> ItemId -> Int -> EnumMap ItemId Int -> EnumMap ItemId Int
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) ItemId
iid (ItemQuant -> Int
forall a b. (a, b) -> a
fst ItemQuant
kit)) SLore
slore
                                   (StateServer -> GenerationAnalytics
sgenerationAn StateServer
ser)}
  let cmd :: ItemId -> Item -> ItemQuant -> Container -> UpdAtomic
cmd = if Bool
verbose then ItemId -> Item -> ItemQuant -> Container -> UpdAtomic
UpdCreateItem else Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic
UpdSpotItem Bool
False
  UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ItemId -> Item -> ItemQuant -> Container -> UpdAtomic
cmd ItemId
iid Item
itemBase ItemQuant
kit Container
container
  let worth :: Int
worth = Int -> ItemKind -> Int
itemPrice (ItemQuant -> Int
forall a b. (a, b) -> a
fst ItemQuant
kit) ItemKind
itemKind
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
worth Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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
  Bool
knowItems <- (StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> Bool) -> m Bool)
-> (StateServer -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ServerOptions -> Bool
sknowItems (ServerOptions -> Bool)
-> (StateServer -> ServerOptions) -> StateServer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ServerOptions
soptions
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
knowItems (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ case Container
container of
    CTrunk{} -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    _ -> 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
container of
    CActor _ cstore :: CStore
cstore | CStore
cstore CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore
CEqp, CStore
COrgan] ->
      Int -> ItemId -> ItemFull -> [Time] -> Container -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Int -> ItemId -> ItemFull -> [Time] -> Container -> m ()
randomResetTimeout (ItemQuant -> Int
forall a b. (a, b) -> a
fst ItemQuant
kit) ItemId
iid ItemFull
itemFull [] Container
container
    _ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  ItemId -> m ItemId
forall (m :: * -> *) a. Monad m => a -> m a
return ItemId
iid

randomResetTimeout :: MonadServerAtomic m
                   => Int -> ItemId -> ItemFull -> [Time] -> Container
                   -> m ()
randomResetTimeout :: Int -> ItemId -> ItemFull -> [Time] -> Container -> m ()
randomResetTimeout k :: Int
k iid :: ItemId
iid itemFull :: ItemFull
itemFull beforeIt :: [Time]
beforeIt toC :: Container
toC = do
  LevelId
lid <- (State -> LevelId) -> m LevelId
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
  Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime LevelId
lid
  Maybe Time
mrndTimeout <- Rnd (Maybe Time) -> m (Maybe Time)
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction (Rnd (Maybe Time) -> m (Maybe Time))
-> Rnd (Maybe Time) -> m (Maybe Time)
forall a b. (a -> b) -> a -> b
$ Time -> ItemFull -> Rnd (Maybe Time)
computeRndTimeout Time
localTime ItemFull
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 Maybe Time
mrndTimeout of
    Just rndT :: Time
rndT -> do
      ItemBag
bagAfter <- (State -> ItemBag) -> m ItemBag
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 :: [Time]
afterIt = case ItemId
iid ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bagAfter of
            Nothing -> [Char] -> [Time]
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> [Time]) -> [Char] -> [Time]
forall a b. (a -> b) -> a -> b
$ "" [Char] -> (ItemId, ItemBag, Container) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (ItemId
iid, ItemBag
bagAfter, Container
toC)
            Just (_, it2 :: [Time]
it2) -> [Time]
it2
          resetIt :: [Time]
resetIt = [Time]
beforeIt [Time] -> [Time] -> [Time]
forall a. [a] -> [a] -> [a]
++ Int -> Time -> [Time]
forall a. Int -> a -> [a]
replicate Int
k Time
rndT
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Time]
afterIt [Time] -> [Time] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Time]
resetIt) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ItemId -> Container -> [Time] -> [Time] -> UpdAtomic
UpdTimeItem ItemId
iid Container
toC [Time]
afterIt [Time]
resetIt
    Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- no @Timeout@ aspect; don't touch

computeRndTimeout :: Time -> ItemFull -> Rnd (Maybe Time)
computeRndTimeout :: Time -> ItemFull -> Rnd (Maybe Time)
computeRndTimeout localTime :: Time
localTime ItemFull{itemDisco :: ItemFull -> ItemDisco
itemDisco=ItemDiscoFull itemAspect :: AspectRecord
itemAspect} = do
  let t :: Int
t = AspectRecord -> Int
IA.aTimeout AspectRecord
itemAspect
  if Int
t Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 then do
    Int
rndT <- (Int, Int) -> Rnd Int
forall a. Random a => (a, a) -> Rnd a
randomR (0, Int
t)
    let rndTurns :: Delta Time
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)
    Maybe Time -> Rnd (Maybe Time)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Time -> Rnd (Maybe Time)) -> Maybe Time -> Rnd (Maybe Time)
forall a b. (a -> b) -> a -> b
$ Time -> Maybe Time
forall a. a -> Maybe a
Just (Time -> Maybe Time) -> Time -> Maybe Time
forall a b. (a -> b) -> a -> b
$ Time -> Delta Time -> Time
timeShift Time
localTime Delta Time
rndTurns
  else Maybe Time -> Rnd (Maybe Time)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Time
forall a. Maybe a
Nothing
computeRndTimeout _ _ = [Char] -> Rnd (Maybe Time)
forall a. (?callStack::CallStack) => [Char] -> a
error "computeRndTimeout: server ignorant about an item"

createLevelItem :: MonadServerAtomic m => Point -> LevelId -> m ()
createLevelItem :: Point -> LevelId -> m ()
createLevelItem pos :: Point
pos lid :: LevelId
lid = do
  COps{ContentData CaveKind
cocave :: COps -> ContentData CaveKind
cocave :: ContentData CaveKind
cocave} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Level{ContentId CaveKind
lkind :: Level -> ContentId CaveKind
lkind :: ContentId CaveKind
lkind} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
  let container :: Container
container = LevelId -> Point -> Container
CFloor LevelId
lid Point
pos
      litemFreq :: Freqs ItemKind
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
  m (Maybe (ItemId, ItemFullKit)) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Maybe (ItemId, ItemFullKit)) -> m ())
-> m (Maybe (ItemId, ItemFullKit)) -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId
-> Freqs ItemKind
-> Container
-> Bool
-> Maybe Int
-> m (Maybe (ItemId, ItemFullKit))
forall (m :: * -> *).
MonadServerAtomic m =>
LevelId
-> Freqs ItemKind
-> Container
-> Bool
-> Maybe Int
-> m (Maybe (ItemId, ItemFullKit))
rollAndRegisterItem LevelId
lid Freqs ItemKind
litemFreq Container
container Bool
True Maybe Int
forall a. Maybe a
Nothing

embedItem :: MonadServerAtomic m
          => LevelId -> Point -> ContentId TileKind -> m ()
embedItem :: LevelId -> Point -> ContentId TileKind -> m ()
embedItem lid :: LevelId
lid pos :: Point
pos tk :: ContentId TileKind
tk = do
  COps{ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile :: ContentData TileKind
cotile} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  let embeds :: [GroupName ItemKind]
embeds = ContentData TileKind -> ContentId TileKind -> [GroupName ItemKind]
Tile.embeddedItems ContentData TileKind
cotile ContentId TileKind
tk
      container :: Container
container = LevelId -> Point -> Container
CEmbed LevelId
lid Point
pos
      f :: GroupName ItemKind -> m (Maybe (ItemId, ItemFullKit))
f grp :: GroupName ItemKind
grp = LevelId
-> Freqs ItemKind
-> Container
-> Bool
-> Maybe Int
-> m (Maybe (ItemId, ItemFullKit))
forall (m :: * -> *).
MonadServerAtomic m =>
LevelId
-> Freqs ItemKind
-> Container
-> Bool
-> Maybe Int
-> m (Maybe (ItemId, ItemFullKit))
rollAndRegisterItem LevelId
lid [(GroupName ItemKind
grp, 1)] Container
container Bool
False Maybe Int
forall a. Maybe a
Nothing
  (GroupName ItemKind -> m (Maybe (ItemId, ItemFullKit)))
-> [GroupName ItemKind] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ GroupName ItemKind -> m (Maybe (ItemId, ItemFullKit))
f [GroupName ItemKind]
embeds

prepareItemKind :: MonadServerAtomic m
                => Int -> LevelId -> Freqs ItemKind
                -> m (Frequency (ContentId IK.ItemKind, ItemKind))
prepareItemKind :: Int
-> LevelId
-> Freqs ItemKind
-> m (Frequency (ContentId ItemKind, ItemKind))
prepareItemKind lvlSpawned :: Int
lvlSpawned lid :: LevelId
lid itemFreq :: Freqs ItemKind
itemFreq = do
  COps
cops <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  UniqueSet
uniqueSet <- (StateServer -> UniqueSet) -> m UniqueSet
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> UniqueSet
suniqueSet
  AbsDepth
totalDepth <- (State -> AbsDepth) -> m AbsDepth
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> AbsDepth
stotalDepth
  Level{AbsDepth
ldepth :: Level -> AbsDepth
ldepth :: AbsDepth
ldepth} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
  Frequency (ContentId ItemKind, ItemKind)
-> m (Frequency (ContentId ItemKind, ItemKind))
forall (m :: * -> *) a. Monad m => a -> m a
return (Frequency (ContentId ItemKind, ItemKind)
 -> m (Frequency (ContentId ItemKind, ItemKind)))
-> Frequency (ContentId ItemKind, ItemKind)
-> m (Frequency (ContentId ItemKind, ItemKind))
forall a b. (a -> b) -> a -> b
$! COps
-> UniqueSet
-> Freqs ItemKind
-> AbsDepth
-> AbsDepth
-> Int
-> Frequency (ContentId ItemKind, ItemKind)
newItemKind COps
cops UniqueSet
uniqueSet Freqs ItemKind
itemFreq AbsDepth
ldepth AbsDepth
totalDepth Int
lvlSpawned

rollItemAspect :: MonadServerAtomic m
               => Frequency (ContentId IK.ItemKind, ItemKind) -> LevelId
               -> m (Maybe (ItemKnown, ItemFullKit))
rollItemAspect :: Frequency (ContentId ItemKind, ItemKind)
-> LevelId -> m (Maybe (ItemKnown, ItemFullKit))
rollItemAspect freq :: Frequency (ContentId ItemKind, ItemKind)
freq lid :: LevelId
lid = do
  COps
cops <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  FlavourMap
flavour <- (StateServer -> FlavourMap) -> m FlavourMap
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> FlavourMap
sflavour
  DiscoveryKindRev
discoRev <- (StateServer -> DiscoveryKindRev) -> m DiscoveryKindRev
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> DiscoveryKindRev
sdiscoKindRev
  AbsDepth
totalDepth <- (State -> AbsDepth) -> m AbsDepth
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> AbsDepth
stotalDepth
  Level{AbsDepth
ldepth :: AbsDepth
ldepth :: Level -> AbsDepth
ldepth} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
  Maybe (ItemKnown, ItemFullKit)
m2 <- Rnd (Maybe (ItemKnown, ItemFullKit))
-> m (Maybe (ItemKnown, ItemFullKit))
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction (Rnd (Maybe (ItemKnown, ItemFullKit))
 -> m (Maybe (ItemKnown, ItemFullKit)))
-> Rnd (Maybe (ItemKnown, ItemFullKit))
-> m (Maybe (ItemKnown, ItemFullKit))
forall a b. (a -> b) -> a -> b
$ COps
-> Frequency (ContentId ItemKind, ItemKind)
-> FlavourMap
-> DiscoveryKindRev
-> AbsDepth
-> AbsDepth
-> Rnd (Maybe (ItemKnown, ItemFullKit))
newItem COps
cops Frequency (ContentId ItemKind, ItemKind)
freq FlavourMap
flavour DiscoveryKindRev
discoRev AbsDepth
ldepth AbsDepth
totalDepth
  case Maybe (ItemKnown, ItemFullKit)
m2 of
    Just (itemKnown :: ItemKnown
itemKnown, ifk :: ItemFullKit
ifk@(itemFull :: ItemFull
itemFull@ItemFull{ContentId ItemKind
itemKindId :: ContentId ItemKind
itemKindId :: ItemFull -> ContentId ItemKind
itemKindId}, _)) -> do
      let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
      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
$ \ser :: StateServer
ser ->
          StateServer
ser {suniqueSet :: UniqueSet
suniqueSet = ContentId ItemKind -> UniqueSet -> UniqueSet
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.insert ContentId ItemKind
itemKindId (StateServer -> UniqueSet
suniqueSet StateServer
ser)}
      Maybe (ItemKnown, ItemFullKit)
-> m (Maybe (ItemKnown, ItemFullKit))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ItemKnown, ItemFullKit)
 -> m (Maybe (ItemKnown, ItemFullKit)))
-> Maybe (ItemKnown, ItemFullKit)
-> m (Maybe (ItemKnown, ItemFullKit))
forall a b. (a -> b) -> a -> b
$ (ItemKnown, ItemFullKit) -> Maybe (ItemKnown, ItemFullKit)
forall a. a -> Maybe a
Just (ItemKnown
itemKnown, ItemFullKit
ifk)
    Nothing -> Maybe (ItemKnown, ItemFullKit)
-> m (Maybe (ItemKnown, ItemFullKit))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ItemKnown, ItemFullKit)
forall a. Maybe a
Nothing

rollAndRegisterItem :: MonadServerAtomic m
                    => LevelId -> Freqs ItemKind -> Container -> Bool
                    -> Maybe Int
                    -> m (Maybe (ItemId, ItemFullKit))
rollAndRegisterItem :: LevelId
-> Freqs ItemKind
-> Container
-> Bool
-> Maybe Int
-> m (Maybe (ItemId, ItemFullKit))
rollAndRegisterItem lid :: LevelId
lid itemFreq :: Freqs ItemKind
itemFreq container :: Container
container verbose :: Bool
verbose mk :: Maybe Int
mk = do
  -- Power depth of new items unaffected by number of spawned actors.
  Frequency (ContentId ItemKind, ItemKind)
freq <- Int
-> LevelId
-> Freqs ItemKind
-> m (Frequency (ContentId ItemKind, ItemKind))
forall (m :: * -> *).
MonadServerAtomic m =>
Int
-> LevelId
-> Freqs ItemKind
-> m (Frequency (ContentId ItemKind, ItemKind))
prepareItemKind 0 LevelId
lid Freqs ItemKind
itemFreq
  Maybe (ItemKnown, ItemFullKit)
m2 <- Frequency (ContentId ItemKind, ItemKind)
-> LevelId -> m (Maybe (ItemKnown, ItemFullKit))
forall (m :: * -> *).
MonadServerAtomic m =>
Frequency (ContentId ItemKind, ItemKind)
-> LevelId -> m (Maybe (ItemKnown, ItemFullKit))
rollItemAspect Frequency (ContentId ItemKind, ItemKind)
freq LevelId
lid
  case Maybe (ItemKnown, ItemFullKit)
m2 of
    Nothing -> Maybe (ItemId, ItemFullKit) -> m (Maybe (ItemId, ItemFullKit))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ItemId, ItemFullKit)
forall a. Maybe a
Nothing
    Just (itemKnown :: ItemKnown
itemKnown, (itemFull :: ItemFull
itemFull, kit :: ItemQuant
kit)) -> do
      let kit2 :: ItemQuant
kit2 = (Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (ItemQuant -> Int
forall a b. (a, b) -> a
fst ItemQuant
kit) Maybe Int
mk, ItemQuant -> [Time]
forall a b. (a, b) -> b
snd ItemQuant
kit)
      ItemId
iid <- ItemFullKit -> ItemKnown -> Container -> Bool -> m ItemId
forall (m :: * -> *).
MonadServerAtomic m =>
ItemFullKit -> ItemKnown -> Container -> Bool -> m ItemId
registerItem (ItemFull
itemFull, ItemQuant
kit2) ItemKnown
itemKnown Container
container Bool
verbose
      Maybe (ItemId, ItemFullKit) -> m (Maybe (ItemId, ItemFullKit))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ItemId, ItemFullKit) -> m (Maybe (ItemId, ItemFullKit)))
-> Maybe (ItemId, ItemFullKit) -> m (Maybe (ItemId, ItemFullKit))
forall a b. (a -> b) -> a -> b
$ (ItemId, ItemFullKit) -> Maybe (ItemId, ItemFullKit)
forall a. a -> Maybe a
Just (ItemId
iid, (ItemFull
itemFull, ItemQuant
kit2))

placeItemsInDungeon :: forall m. MonadServerAtomic m
                    => EM.EnumMap LevelId [Point] -> m ()
placeItemsInDungeon :: EnumMap LevelId [Point] -> m ()
placeItemsInDungeon alliancePositions :: EnumMap LevelId [Point]
alliancePositions = do
  COps{ContentData CaveKind
cocave :: ContentData CaveKind
cocave :: COps -> ContentData CaveKind
cocave, TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  AbsDepth
totalDepth <- (State -> AbsDepth) -> m AbsDepth
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> AbsDepth
stotalDepth
  let initialItems :: (LevelId, Level) -> m ()
initialItems (lid :: LevelId
lid, lvl :: Level
lvl@Level{ContentId CaveKind
lkind :: ContentId CaveKind
lkind :: Level -> ContentId CaveKind
lkind, AbsDepth
ldepth :: AbsDepth
ldepth :: Level -> AbsDepth
ldepth}) = do
        Int
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 :: [Point]
alPos = [Point] -> LevelId -> EnumMap LevelId [Point] -> [Point]
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault [] LevelId
lid EnumMap LevelId [Point]
alliancePositions
            placeItems :: Int -> m ()
            placeItems :: Int -> m ()
placeItems n :: Int
n | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
litemNum = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            placeItems !Int
n = do
              Level{ItemFloor
lfloor :: Level -> ItemFloor
lfloor :: ItemFloor
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 distAllianceAndNotFloor :: Point -> ContentId TileKind -> Bool
distAllianceAndNotFloor !Point
p _ =
                    let f :: Point -> Bool -> Bool
f !Point
k b :: Bool
b = Point -> Point -> Int
chessDist Point
p Point
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 4 Bool -> Bool -> Bool
&& Bool
b
                    in Point
p Point -> ItemFloor -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.notMember` ItemFloor
lfloor Bool -> Bool -> Bool
&& (Point -> Bool -> Bool) -> Bool -> [Point] -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Point -> Bool -> Bool
f Bool
True [Point]
alPos
              Maybe Point
mpos <- Rnd (Maybe Point) -> m (Maybe Point)
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction (Rnd (Maybe Point) -> m (Maybe Point))
-> Rnd (Maybe Point) -> m (Maybe Point)
forall a b. (a -> b) -> a -> b
$ Int
-> Level
-> (Point -> ContentId TileKind -> Bool)
-> [Point -> ContentId TileKind -> Bool]
-> (Point -> ContentId TileKind -> Bool)
-> [Point -> ContentId TileKind -> Bool]
-> Rnd (Maybe Point)
findPosTry2 20 Level
lvl
                (\_ !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))
                [ \_ !ContentId TileKind
t -> TileSpeedup -> ContentId TileKind -> Bool
Tile.isVeryOftenItem TileSpeedup
coTileSpeedup ContentId TileKind
t
                , \_ !ContentId TileKind
t -> TileSpeedup -> ContentId TileKind -> Bool
Tile.isCommonItem TileSpeedup
coTileSpeedup ContentId TileKind
t ]
                Point -> ContentId TileKind -> Bool
distAllianceAndNotFloor
                [ Point -> ContentId TileKind -> Bool
distAllianceAndNotFloor
                , Point -> ContentId TileKind -> Bool
distAllianceAndNotFloor ]
              case Maybe Point
mpos of
                Just pos :: Point
pos -> do
                  Point -> LevelId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Point -> LevelId -> m ()
createLevelItem Point
pos LevelId
lid
                  Int -> m ()
placeItems (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1)
                Nothing -> Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
debugPossiblyPrint
                  "Server: placeItemsInDungeon: failed to find positions"
        Int -> m ()
placeItems 0
  Dungeon
dungeon <- (State -> Dungeon) -> m Dungeon
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 absLid :: LevelId -> Int
absLid = Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> (LevelId -> Int) -> LevelId -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LevelId -> Int
forall a. Enum a => a -> Int
fromEnum
      fromEasyToHard :: [(LevelId, Level)]
fromEasyToHard = ((LevelId, Level) -> (LevelId, Level) -> Ordering)
-> [(LevelId, Level)] -> [(LevelId, Level)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((LevelId -> Int) -> LevelId -> LevelId -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing LevelId -> Int
absLid (LevelId -> LevelId -> Ordering)
-> ((LevelId, Level) -> LevelId)
-> (LevelId, Level)
-> (LevelId, Level)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (LevelId, Level) -> LevelId
forall a b. (a, b) -> a
fst) ([(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
  ((LevelId, Level) -> m ()) -> [(LevelId, Level)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LevelId, Level) -> m ()
initialItems [(LevelId, Level)]
fromEasyToHard

embedItemsInDungeon :: MonadServerAtomic m => m ()
embedItemsInDungeon :: m ()
embedItemsInDungeon = do
  let embedItems :: (LevelId, Level) -> m ()
embedItems (lid :: LevelId
lid, Level{TileMap
ltile :: Level -> TileMap
ltile :: 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 ()
embedItem LevelId
lid) TileMap
ltile
  Dungeon
dungeon <- (State -> Dungeon) -> m Dungeon
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 absLid :: LevelId -> Int
absLid = Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> (LevelId -> Int) -> LevelId -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LevelId -> Int
forall a. Enum a => a -> Int
fromEnum
      fromEasyToHard :: [(LevelId, Level)]
fromEasyToHard = ((LevelId, Level) -> (LevelId, Level) -> Ordering)
-> [(LevelId, Level)] -> [(LevelId, Level)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((LevelId -> Int) -> LevelId -> LevelId -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing LevelId -> Int
absLid (LevelId -> LevelId -> Ordering)
-> ((LevelId, Level) -> LevelId)
-> (LevelId, Level)
-> (LevelId, Level)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (LevelId, Level) -> LevelId
forall a b. (a, b) -> a
fst) ([(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
  ((LevelId, Level) -> m ()) -> [(LevelId, Level)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LevelId, Level) -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
(LevelId, Level) -> m ()
embedItems [(LevelId, Level)]
fromEasyToHard

-- | Mapping over actor's items from a give store.
mapActorCStore_ :: MonadServer m
                => CStore -> (ItemId -> ItemQuant -> m a) -> Actor -> m ()
mapActorCStore_ :: CStore -> (ItemId -> ItemQuant -> m a) -> Actor -> m ()
mapActorCStore_ cstore :: CStore
cstore f :: ItemId -> ItemQuant -> m a
f b :: Actor
b = do
  ItemBag
bag <- (State -> ItemBag) -> m ItemBag
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
  ((ItemId, ItemQuant) -> m a) -> [(ItemId, ItemQuant)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((ItemId -> ItemQuant -> m a) -> (ItemId, ItemQuant) -> m a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ItemId -> ItemQuant -> m a
f) ([(ItemId, ItemQuant)] -> m ()) -> [(ItemId, ItemQuant)] -> m ()
forall a b. (a -> b) -> a -> b
$ ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
bag