content: -- | 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 itemKnown@(ItemKnown _ arItem _) = do
    itemRev <- getsServer sitemRev
    case HM.lookup itemKnown itemRev of
      Just iid -> return iid
      Nothing -> do
        icounter <- getsServer sicounter
        executedOnServer <-
          execUpdAtomicSer $ UpdDiscoverServer icounter arItem
        let !_A = assert executedOnServer ()
        modifyServer $ \ser ->
          ser { sitemRev = HM.insert itemKnown icounter (sitemRev ser)
              , sicounter = succ icounter }
        return $! icounter
  
  registerItem :: MonadServerAtomic m
               => Bool -> ItemFullKit -> ItemKnown -> Container -> m ItemId
  registerItem verbose (itemFull@ItemFull{itemBase, itemKindId, itemKind}, kit)
               itemKnown@(ItemKnown _ arItem _) containerRaw = do
    container <- case containerRaw of
      CActor aid CEqp -> do
        b <- getsState $ getActorBody aid
        return $! if eqpFreeN b >= fst kit
                  then containerRaw
                  else CActor aid CStash
      _ -> return containerRaw
    iid <- onlyRegisterItem itemKnown
    let slore = IA.loreFromContainer arItem container
    modifyServer $ \ser ->
      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 = itemPrice (fst kit) itemKind
    case container of
      _ | worth == 0 -> return ()
      CActor _ COrgan -> return ()  -- destroyed on drop
      CTrunk{} -> return ()  -- we assume any valuables in CEmbed can be dug out
      _ -> execUpdAtomic $ UpdAlterGold worth
    knowItems <- getsServer $ sknowItems . soptions
    when knowItems $ case container of
      CTrunk{} -> return ()
      _ -> execUpdAtomic $ UpdDiscover container iid itemKindId 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 _ cstore | cstore `elem` [CEqp, COrgan] ->
        randomResetTimeout (fst kit) iid itemFull [] container
      _ -> return ()
    return iid
  
  moveStashIfNeeded :: MonadStateRead m => Container -> m [UpdAtomic]
  moveStashIfNeeded c = case c of
    CActor aid CStash -> do
      b <- getsState $ getActorBody aid
      mstash <- getsState $ \s -> gstash $ sfactionD s EM.! bfid b
      case mstash of
        Just (lid, pos) -> do
          bagStash <- getsState $ getFloorBag lid pos
          return $! if EM.null bagStash
                    then [ UpdLoseStashFaction False (bfid b) lid pos
                         , UpdSpotStashFaction True (bfid b) (blid b) (bpos b) ]
                    else []
        Nothing -> return [UpdSpotStashFaction True (bfid b) (blid b) (bpos b)]
    _ -> return []
  
  randomResetTimeout :: MonadServerAtomic m
                     => Int -> ItemId -> ItemFull -> [ItemTimer] -> Container
                     -> m ()
  randomResetTimeout k iid itemFull beforeIt toC = do
    lid <- getsState $ lidFromC 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 rndT -> do
        bagAfter <- getsState $ getContainerBag toC
        let afterIt = case iid `EM.lookup` bagAfter of
              Nothing -> error $ "" `showFailure` (iid, bagAfter, toC)
              Just (_, it2) -> it2
            resetIt = beforeIt ++ replicate k rndT
        when (afterIt /= resetIt) $
          execUpdAtomic $ UpdTimeItem iid toC afterIt resetIt
      Nothing -> return ()  -- no @Timeout@ aspect; don't touch
  
  computeRndTimeout :: Time -> ItemFull -> Rnd (Maybe ItemTimer)
  computeRndTimeout localTime ItemFull{itemDisco=ItemDiscoFull itemAspect} = do
    let t = IA.aTimeout itemAspect
    if t > 0 then do
      rndT <- randomR0 t
      let rndTurns = timeDeltaScale (Delta timeTurn) (t + rndT)
      return $ Just $ createItemTimer localTime rndTurns
    else return Nothing
  computeRndTimeout _ _ = error "computeRndTimeout: server ignorant about an item"
  
  createCaveItem :: MonadServerAtomic m => Point -> LevelId -> m ()
  createCaveItem pos lid = do
    COps{cocave} <- getsState scops
    Level{lkind, ldepth} <- getLevel lid
    let container = CFloor lid pos
        litemFreq = citemFreq $ okind cocave 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 lid pos grp = do
    Level{ldepth} <- getLevel lid
    let container = CEmbed lid 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 lid pos mIidEtc = case mIidEtc of
    Nothing -> error $ "" `showFailure` (lid, pos, mIidEtc)
    Just (_, (itemFull, _)) -> do
      cops <- getsState scops
      lvl@Level{ldepth} <- getLevel lid
      let ikit = IK.ikit $ itemKind itemFull
          nearbyPassable = take (20 + length ikit)
                           $ nearbyPassablePoints cops lvl pos
          walkable p = Tile.isWalkable (coTileSpeedup cops) (lvl `at` p)
          good p = walkable p && p `EM.notMember` lfloor lvl
          kitPos = zip ikit $ filter good nearbyPassable
                              ++ filter walkable nearbyPassable
                              ++ repeat pos
      forM_ kitPos $ \((ikGrp, cstore), p) -> do
        let container = if cstore == CGround
                        then CFloor lid p
                        else CEmbed lid pos
            itemFreq = [(ikGrp, 1)]
        -- Power depth of new items unaffected by number of spawned actors.
        freq <- prepareItemKind 0 ldepth 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 lid pos tk = do
    COps{cotile} <- getsState scops
    let embedGroups = Tile.embeddedItems cotile tk
    mapM_ (createEmbedItem lid pos) embedGroups
  
  prepareItemKind :: MonadServerAtomic m
                  => Int -> Dice.AbsDepth -> Freqs ItemKind
                  -> m (Frequency
                          (GroupName ItemKind, ContentId IK.ItemKind, ItemKind))
  prepareItemKind lvlSpawned ldepth itemFreq = do
    cops <- getsState 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 freq ldepth = do
    cops <- getsState scops
    flavour <- getsServer sflavour
    discoRev <- getsServer sdiscoKindRev
    totalDepth <- getsState stotalDepth
    m2 <- rndToAction $ newItem cops freq flavour discoRev ldepth totalDepth
    case m2 of
      NewItem _ (ItemKnown _ arItem _) ItemFull{itemKindId} _ -> do
        when (IA.checkFlag Ability.Unique arItem) $
          modifyServer $ \ser ->
            ser {suniqueSet = ES.insert itemKindId (suniqueSet ser)}
      NoNewItem -> return ()
    return m2
  
  rollAndRegisterItem :: MonadServerAtomic m
                      => Bool
                      -> Dice.AbsDepth
                      -> Frequency
                           (GroupName ItemKind, ContentId IK.ItemKind, ItemKind)
                      -> Container
                      -> Maybe Int
                      -> m (Maybe (ItemId, ItemFullKit))
  rollAndRegisterItem verbose ldepth freq container mk = do
    m2 <- rollItemAspect freq ldepth
    case m2 of
      NoNewItem -> return Nothing
      NewItem _ itemKnown itemFull kit -> do
        let f k = if k == 1 && null (snd kit)
                  then quantSingle
                  else (k, snd kit)
            !kit2 = maybe kit f mk
        iid <- registerItem verbose (itemFull, kit2) itemKnown 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 factionPositions = do
    COps{cocave, coTileSpeedup} <- getsState scops
    totalDepth <- getsState stotalDepth
    let initialItems (lid, lvl@Level{lkind, ldepth}) = do
          litemNum <- rndToAction $ castDice ldepth totalDepth
                                    (citemNum $ okind cocave lkind)
          let alPos = EM.elems $ EM.findWithDefault EM.empty lid factionPositions
              placeItems :: Int -> m ()
              placeItems n | n == litemNum = return ()
              placeItems !n = do
                Level{lfloor} <- getLevel lid
                -- Don't generate items around initial actors or in bunches.
                let distAndNotFloor !p _ =
                      let f !k = chessDist p k > 4
                      in p `EM.notMember` lfloor && all f alPos
                mpos <- rndToAction $ findPosTry2 10 lvl
                  (\_ !t -> Tile.isWalkable coTileSpeedup t
                            && not (Tile.isNoItem coTileSpeedup t))
                  [ \_ !t -> Tile.isVeryOftenItem coTileSpeedup t
                  , \_ !t -> Tile.isCommonItem coTileSpeedup t ]
                  distAndNotFloor
                  (replicate 10 distAndNotFloor)
                case mpos of
                  Just pos -> do
                    createCaveItem pos lid
                    placeItems (n + 1)
                  Nothing -> debugPossiblyPrint
                    "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 = sortBy (comparing (ldepth . snd)) $ EM.assocs dungeon
    mapM_ initialItems fromEasyToHard
  
  -- Tiles already placed, so it's possible to scatter companion items
  -- over walkable tiles.
  embedItemsInDungeon :: MonadServerAtomic m => m ()
  embedItemsInDungeon = do
    let embedItemsOnLevel (lid, Level{ltile}) =
          PointArray.imapMA_ (embedItemOnPos lid) ltile
    dungeon <- getsState sdungeon
    -- Make sure items on easy levels are generated first, to avoid all
    -- artifacts on deep levels.
    let fromEasyToHard = sortBy (comparing (ldepth . snd)) $ EM.assocs dungeon
    mapM_ embedItemsOnLevel fromEasyToHard
  
  -- | Mapping over actor's items from a give store.
  mapActorCStore_ :: MonadServer m
                  => CStore -> (ItemId -> ItemQuant -> m ()) -> Actor -> m ()
  mapActorCStore_ cstore f b = do
    bag <- getsState $ getBodyStoreBag b cstore
    mapM_ (uncurry f) $ EM.assocs bag
  