content: {-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}
  -- | Creation of items on the server. Types and operations that don't involve
  -- server state nor our custom monads.
  module Game.LambdaHack.Server.ItemRev
    ( ItemKnown(..), NewItem(..), ItemRev, UniqueSet
    , newItemKind, newItem
      -- * Item discovery types
    , DiscoveryKindRev, emptyDiscoveryKindRev, serverDiscos
      -- * The @FlavourMap@ type
    , FlavourMap, emptyFlavourMap, dungeonFlavourMap
      -- * Important implementation parts, exposed for tests
    , rollFlavourMap
  #ifdef EXPOSE_INTERNAL
      -- * Internal operations
    , buildItem, keepMetaGameInformation
  #endif
    ) where
  
  import Prelude ()
  
  import Game.LambdaHack.Core.Prelude
  
  import           Data.Binary
  import qualified Data.EnumMap.Strict as EM
  import qualified Data.EnumSet as ES
  import qualified Data.HashMap.Strict as HM
  import           Data.Hashable (Hashable)
  import           Data.Vector.Binary ()
  import qualified Data.Vector.Unboxed as U
  import           GHC.Generics (Generic)
  
  import           Game.LambdaHack.Common.Item
  import qualified Game.LambdaHack.Common.ItemAspect as IA
  import           Game.LambdaHack.Common.Kind
  import           Game.LambdaHack.Common.Types
  import           Game.LambdaHack.Content.ItemKind (ItemKind)
  import qualified Game.LambdaHack.Content.ItemKind as IK
  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.Definition.Flavour
  
  -- | The essential item properties, used for the @ItemRev@ hash table
  -- from items to their ids, needed to assign ids to newly generated items.
  -- All the other meaningful properties can be derived from them.
  -- Note: item seed instead of @AspectRecord@ is not enough,
  -- becaused different seeds may result in the same @AspectRecord@
  -- and we don't want such items to be distinct in UI and elsewhere.
  data ItemKnown = ItemKnown ItemIdentity IA.AspectRecord (Maybe FactionId)
    deriving (Show, Eq, Generic)
  
  instance Binary ItemKnown
  
  instance Hashable ItemKnown
  
  data NewItem =
      NewItem  (GroupName ItemKind) ItemKnown ItemFull ItemQuant
    | NoNewItem
  
  -- | Reverse item map, for item creation, to keep items and item identifiers
  -- in bijection.
  type ItemRev = HM.HashMap ItemKnown ItemId
  
  type UniqueSet = ES.EnumSet (ContentId ItemKind)
  
  -- | Build an item with the given kind and aspects.
  buildItem :: COps -> IA.AspectRecord -> FlavourMap
            -> DiscoveryKindRev -> ContentId ItemKind
            -> Item
  buildItem COps{coitem} arItem (FlavourMap flavourMap)
            (DiscoveryKindRev discoRev) ikChosen =
    let jkind = case IA.aPresentAs arItem of
          Just grp ->
            let kindHidden = ouniqGroup coitem grp
            in IdentityCovered
                 (toItemKindIx $ discoRev U.! contentIdIndex ikChosen)
                 kindHidden
          Nothing -> IdentityObvious ikChosen
        jfid     = Nothing  -- the default
        jflavour = toEnum $ fromEnum $ flavourMap U.! contentIdIndex ikChosen
    in Item{..}
  
  -- | Roll an item kind based on given @Freqs@ and kind rarities
  newItemKind :: COps -> UniqueSet -> Freqs ItemKind
              -> Dice.AbsDepth -> Dice.AbsDepth -> Int
              -> Frequency (GroupName ItemKind, ContentId IK.ItemKind, ItemKind)
  newItemKind COps{coitem, coItemSpeedup} uniqueSet itemFreq
              (Dice.AbsDepth ldepth) (Dice.AbsDepth totalDepth) lvlSpawned =
    assert (any (\(_, n) -> n > 0) itemFreq) $
    -- Effective generation depth of actors (not items) increases with spawns.
    -- Up to 10 spawns, no effect. With 20 spawns, depth + 5, and then
    -- each 10 spawns adds 5 depth.
    let numSpawnedCoeff = max 0 $ lvlSpawned `div` 2 - 5
        ldSpawned = ldepth + numSpawnedCoeff
        f _ _ acc _ ik _ | ik `ES.member` uniqueSet = acc
        f !itemGroup !q !acc !p !ik !kind =
          -- Don't consider lvlSpawned for uniques, except those that have
          -- @Unique@ under @Odds@.
          let ld = if IA.checkFlag Ability.Unique
                      $ IA.kmMean $ getKindMean ik coItemSpeedup
                   then ldepth
                   else ldSpawned
              rarity = linearInterpolation ld totalDepth (IK.irarity kind)
              !fr = q * p * rarity
          in (fr, (itemGroup, ik, kind)) : acc
        g (!itemGroup, !q) = ofoldlGroup' coitem itemGroup (f itemGroup q) []
        freqDepth = concatMap g itemFreq
    in toFreq "newItemKind" freqDepth
  
  -- | Given item kind frequency, roll item kind, generate item aspects
  -- based on level and put together the full item data set.
  newItem :: COps
          -> Frequency (GroupName ItemKind, ContentId IK.ItemKind, ItemKind)
          -> FlavourMap -> DiscoveryKindRev
          -> Dice.AbsDepth -> Dice.AbsDepth
          -> Rnd NewItem
  newItem cops freq flavourMap discoRev levelDepth totalDepth =
    if nullFreq freq
    then return NoNewItem  -- e.g., rare tile has a unique embed, only first time
    else do
      (itemGroup, itemKindId, itemKind) <- frequency freq
      -- Number of new items/actors unaffected by number of spawned actors.
      itemN <- castDice levelDepth totalDepth (IK.icount itemKind)
      arItem <- IA.rollAspectRecord (IK.iaspects itemKind) levelDepth totalDepth
      let itemBase = buildItem cops arItem flavourMap discoRev itemKindId
          itemIdentity = jkind itemBase
          !itemK = max 1 itemN
          !itemTimer = [itemTimerZero | IA.checkFlag Ability.Periodic arItem]
            -- enable optimization in @applyPeriodicLevel@
          itemSuspect = False
          -- Bonuses on items/actors unaffected by number of spawned actors.
          itemDisco = ItemDiscoFull arItem
          itemFull = ItemFull {..}
          itemKnown = ItemKnown itemIdentity arItem (jfid itemBase)
          itemQuant = if itemK == 1 && null itemTimer
                      then quantSingle
                      else (itemK, itemTimer)
      return $! NewItem itemGroup itemKnown itemFull itemQuant
  
  -- | The reverse map to @DiscoveryKind@, needed for item creation.
  -- This is total and never changes, hence implemented as vector.
  -- Morally, it's indexed by @ContentId ItemKind@ and elements are @ItemKindIx@.
  newtype DiscoveryKindRev = DiscoveryKindRev (U.Vector Word16)
    deriving (Show, Binary)
  
  emptyDiscoveryKindRev :: DiscoveryKindRev
  emptyDiscoveryKindRev = DiscoveryKindRev U.empty
  
  serverDiscos :: COps -> DiscoveryKindRev
               -> Rnd (DiscoveryKind, DiscoveryKindRev)
  serverDiscos COps{coitem} (DiscoveryKindRev discoRevFromPreviousGame) = do
    let ixs = [0..toEnum (olength coitem - 1)]
    shuffled <-
      if U.null discoRevFromPreviousGame
      then shuffle ixs
      else shuffleExcept (keepMetaGameInformation coitem discoRevFromPreviousGame)
                         (olength coitem)
                         ixs
    let udiscoRev = U.fromListN (olength coitem) shuffled
        f :: ContentId ItemKind -> Word16 -> (ItemKindIx, ContentId ItemKind)
        f ik ikx = (toItemKindIx ikx, ik)
        -- Not @fromDistinctAscList@, because it's the reverse map.
        discoS = EM.fromList $ zipWith f [toEnum 0 ..] $ U.toList udiscoRev
    return (discoS, DiscoveryKindRev udiscoRev)
  
  -- | Keep in a vector the information that is retained from playthrough
  -- to playthrough. The information being, e.g., @ItemKindIx@ or @Flavour@.
  -- The information is morally indexed by @ContentId ItemKind@ and its @Enum@
  -- instance fits in @Word16@.
  keepMetaGameInformation :: ContentData ItemKind
                          -> U.Vector Word16
                          -> U.Vector Word16
  keepMetaGameInformation coitem informationFromPreviousGame =
    let inMetaGame :: ContentId ItemKind -> Bool
        inMetaGame kindId =
          IK.SetFlag Ability.MetaGame `elem` IK.iaspects (okind coitem kindId)
        keepMeta :: Int -> Word16 -> Word16
        keepMeta i ix = if inMetaGame (toEnum i)
                        then ix
                        else invalidInformationCode
    in U.imap keepMeta informationFromPreviousGame
  
  -- | Flavours assigned by the server to item kinds, in this particular game.
  -- This is total and never changes, hence implemented as vector.
  -- Morally, it's indexed by @ContentId ItemKind@ and elements are @Flavour@.
  newtype FlavourMap = FlavourMap (U.Vector Word16)
    deriving (Show, Binary)
  
  emptyFlavourMap :: FlavourMap
  emptyFlavourMap = FlavourMap U.empty
  
  -- | Assigns flavours to item kinds. Assures no flavor is repeated for the same
  -- symbol, except for items with only one permitted flavour.
  rollFlavourMap
    :: U.Vector Word16
    -> Rnd ( EM.EnumMap (ContentId ItemKind) Flavour
           , EM.EnumMap (ContentSymbol ItemKind) (ES.EnumSet Flavour) )
    -> ContentId ItemKind -> ItemKind
    -> Rnd ( EM.EnumMap (ContentId ItemKind) Flavour
           , EM.EnumMap (ContentSymbol ItemKind) (ES.EnumSet Flavour) )
  rollFlavourMap uFlavMeta !rnd !key !ik = case IK.iflavour ik of
    [] -> error "empty iflavour"
    [flavour] -> do
      (!assocs, !availableMap) <- rnd
      return ( EM.insert key flavour assocs
             , availableMap )
    flvs -> do
      (!assocs, !availableMap) <- rnd
      let a0 = uFlavMeta U.! toEnum (fromEnum key)
      if a0 == invalidInformationCode then do
        if length flvs < 6 then do  -- too few to even attempt unique assignment
          flavour <- oneOf flvs
          return ( EM.insert key flavour assocs
                 , availableMap )
        else do
          let available = availableMap EM.! IK.isymbol ik
              proper = ES.fromList flvs `ES.intersection` available
          assert (not (ES.null proper)
                  `blame` "not enough flavours for items"
                  `swith` (flvs, available, ik, availableMap)) $ do
            flavour <- oneOf $ ES.elems proper
            let availableReduced = ES.delete flavour available
            return ( EM.insert key flavour assocs
                   , EM.insert (IK.isymbol ik) availableReduced availableMap )
      else return ( EM.insert key (toEnum $ fromEnum a0) assocs
                  , availableMap )
  
  -- | Randomly chooses flavour for all item kinds for this game.
  dungeonFlavourMap :: COps -> FlavourMap -> Rnd FlavourMap
  dungeonFlavourMap COps{coitem} (FlavourMap flavourMapFromPreviousGame) = do
    let uFlavMeta = if U.null flavourMapFromPreviousGame
                    then U.replicate (olength coitem) invalidInformationCode
                    else keepMetaGameInformation coitem flavourMapFromPreviousGame
        flavToAvailable :: EM.EnumMap Char (ES.EnumSet Flavour) -> Int -> Word16
                        -> EM.EnumMap Char (ES.EnumSet Flavour)
        flavToAvailable em i fl =
          let ik = okind coitem (toEnum i)
              setBase = EM.findWithDefault (ES.fromList stdFlavList)
                                           (IK.isymbol ik)
                                           em
              setMeta = if fl == invalidInformationCode
                        then setBase
                        else ES.delete (toEnum $ fromEnum fl) setBase
          in EM.insert (IK.isymbol ik) setMeta em
        availableMap = U.ifoldl' flavToAvailable EM.empty uFlavMeta
    (assocsFlav, _) <- ofoldlWithKey' coitem (rollFlavourMap uFlavMeta)
                                      (return (EM.empty, availableMap))
    let uFlav = U.fromListN (olength coitem)
                $ map (toEnum . fromEnum) $ EM.elems assocsFlav
    return $! FlavourMap uFlav
  