{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}
module Game.LambdaHack.Server.ItemRev
( ItemKnown(..), ItemRev, UniqueSet, buildItem, newItemKind, newItem
, DiscoveryKindRev, emptyDiscoveryKindRev, serverDiscos
, FlavourMap, emptyFlavourMap, dungeonFlavourMap
) 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 Data.Hashable (Hashable)
import qualified Data.HashMap.Strict as HM
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.Time
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 qualified Game.LambdaHack.Definition.Color as Color
import Game.LambdaHack.Definition.Defs
import Game.LambdaHack.Definition.Flavour
data ItemKnown = ItemKnown ItemIdentity IA.AspectRecord (Maybe FactionId)
deriving (Show, Eq, Generic)
instance Binary ItemKnown
instance Hashable ItemKnown
type ItemRev = HM.HashMap ItemKnown ItemId
type UniqueSet = ES.EnumSet (ContentId ItemKind)
buildItem :: COps -> IA.AspectRecord -> FlavourMap
-> DiscoveryKindRev -> ContentId ItemKind
-> Item
buildItem COps{coitem} arItem (FlavourMap flavourMap)
(DiscoveryKindRev discoRev) ikChosen =
let jkind = case IA.aHideAs arItem of
Just grp ->
let kindHidden = ouniqGroup coitem grp
in IdentityCovered
(toEnum $ fromEnum $ discoRev U.! contentIdIndex ikChosen)
kindHidden
Nothing -> IdentityObvious ikChosen
jfid = Nothing
jflavour = toEnum $ fromEnum $ flavourMap U.! contentIdIndex ikChosen
in Item{..}
newItemKind :: COps -> UniqueSet -> Freqs ItemKind
-> Dice.AbsDepth -> Dice.AbsDepth -> Int
-> Frequency (ContentId IK.ItemKind, ItemKind)
newItemKind COps{coitem, coItemSpeedup} uniqueSet itemFreq
(Dice.AbsDepth ldepth) (Dice.AbsDepth totalDepth) lvlSpawned =
let numSpawnedCoeff = max 0 $ lvlSpawned `div` 2 - 5
ldSpawned = min totalDepth $ ldepth + numSpawnedCoeff
f _ acc _ ik _ | ik `ES.member` uniqueSet = acc
f !q !acc !p !ik !kind =
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, (ik, kind)) : acc
g (!itemGroup, !q) = ofoldlGroup' coitem itemGroup (f q) []
freqDepth = concatMap g itemFreq
in toFreq "newItemKind" freqDepth
newItem :: COps -> Frequency (ContentId IK.ItemKind, ItemKind)
-> FlavourMap -> DiscoveryKindRev
-> Dice.AbsDepth -> Dice.AbsDepth
-> Rnd (Maybe (ItemKnown, ItemFullKit))
newItem cops freq flavourMap discoRev levelDepth totalDepth =
if nullFreq freq then return Nothing
else do
(itemKindId, itemKind) <- frequency freq
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 = [timeZero | IA.checkFlag Ability.Periodic arItem]
itemSuspect = False
let itemDisco = ItemDiscoFull arItem
itemFull = ItemFull {..}
return $ Just ( ItemKnown itemIdentity arItem (jfid itemBase)
, (itemFull, (itemK, itemTimer)) )
newtype DiscoveryKindRev = DiscoveryKindRev (U.Vector Word16)
deriving (Show, Binary)
emptyDiscoveryKindRev :: DiscoveryKindRev
emptyDiscoveryKindRev = DiscoveryKindRev U.empty
serverDiscos :: COps -> Rnd (DiscoveryKind, DiscoveryKindRev)
serverDiscos COps{coitem} = do
let ixs = [toEnum 0..toEnum (olength coitem - 1)]
shuffled <- shuffle ixs
let f (!ikMap, !ikRev, (!ix) : rest) !kmKind _ =
(EM.insert ix kmKind ikMap, EM.insert kmKind ix ikRev, rest)
f (ikMap, _, []) ik _ =
error $ "too short ixs" `showFailure` (ik, ikMap)
(discoS, discoRev, _) =
ofoldlWithKey' coitem f (EM.empty, EM.empty, shuffled)
udiscoRev = U.fromListN (olength coitem)
$ map (toEnum . fromEnum) $ EM.elems discoRev
return (discoS, DiscoveryKindRev udiscoRev)
newtype FlavourMap = FlavourMap (U.Vector Word16)
deriving (Show, Binary)
emptyFlavourMap :: FlavourMap
emptyFlavourMap = FlavourMap U.empty
stdFlav :: ES.EnumSet Flavour
stdFlav = ES.fromList [ Flavour fn bc
| fn <- [minBound..maxBound], bc <- Color.stdCol ]
rollFlavourMap :: Rnd ( EM.EnumMap (ContentId ItemKind) Flavour
, EM.EnumMap Char (ES.EnumSet Flavour) )
-> ContentId ItemKind -> ItemKind
-> Rnd ( EM.EnumMap (ContentId ItemKind) Flavour
, EM.EnumMap Char (ES.EnumSet Flavour) )
rollFlavourMap !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 available =
EM.findWithDefault stdFlav (IK.isymbol ik) availableMap
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.toList proper
let availableReduced = ES.delete flavour available
return ( EM.insert key flavour assocs
, EM.insert (IK.isymbol ik) availableReduced availableMap)
dungeonFlavourMap :: COps -> Rnd FlavourMap
dungeonFlavourMap COps{coitem} = do
(assocsFlav, _) <- ofoldlWithKey' coitem rollFlavourMap
(return (EM.empty, EM.empty))
let uFlav = U.fromListN (olength coitem)
$ map (toEnum . fromEnum) $ EM.elems assocsFlav
return $! FlavourMap uFlav