    -- | 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