{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}
module Game.LambdaHack.Server.ItemRev
( ItemKnown(..), NewItem(..), 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.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 (Int -> ItemKnown -> ShowS
[ItemKnown] -> ShowS
ItemKnown -> String
(Int -> ItemKnown -> ShowS)
-> (ItemKnown -> String)
-> ([ItemKnown] -> ShowS)
-> Show ItemKnown
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemKnown] -> ShowS
$cshowList :: [ItemKnown] -> ShowS
show :: ItemKnown -> String
$cshow :: ItemKnown -> String
showsPrec :: Int -> ItemKnown -> ShowS
$cshowsPrec :: Int -> ItemKnown -> ShowS
Show, ItemKnown -> ItemKnown -> Bool
(ItemKnown -> ItemKnown -> Bool)
-> (ItemKnown -> ItemKnown -> Bool) -> Eq ItemKnown
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ItemKnown -> ItemKnown -> Bool
$c/= :: ItemKnown -> ItemKnown -> Bool
== :: ItemKnown -> ItemKnown -> Bool
$c== :: ItemKnown -> ItemKnown -> Bool
Eq, (forall x. ItemKnown -> Rep ItemKnown x)
-> (forall x. Rep ItemKnown x -> ItemKnown) -> Generic ItemKnown
forall x. Rep ItemKnown x -> ItemKnown
forall x. ItemKnown -> Rep ItemKnown x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ItemKnown x -> ItemKnown
$cfrom :: forall x. ItemKnown -> Rep ItemKnown x
Generic)
instance Binary ItemKnown
instance Hashable ItemKnown
data NewItem =
NewItem ItemKnown ItemFull ItemQuant
| NoNewItem
type ItemRev = HM.HashMap ItemKnown ItemId
type UniqueSet = ES.EnumSet (ContentId ItemKind)
buildItem :: COps -> IA.AspectRecord -> FlavourMap
-> DiscoveryKindRev -> ContentId ItemKind
-> Item
buildItem :: COps
-> AspectRecord
-> FlavourMap
-> DiscoveryKindRev
-> ContentId ItemKind
-> Item
buildItem COps{ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem :: ContentData ItemKind
coitem} arItem :: AspectRecord
arItem (FlavourMap flavourMap :: Vector Word16
flavourMap)
(DiscoveryKindRev discoRev :: Vector Word16
discoRev) ikChosen :: ContentId ItemKind
ikChosen =
let jkind :: ItemIdentity
jkind = case AspectRecord -> Maybe (GroupName ItemKind)
IA.aPresentAs AspectRecord
arItem of
Just grp :: GroupName ItemKind
grp ->
let kindHidden :: ContentId ItemKind
kindHidden = ContentData ItemKind -> GroupName ItemKind -> ContentId ItemKind
forall a. Show a => ContentData a -> GroupName a -> ContentId a
ouniqGroup ContentData ItemKind
coitem GroupName ItemKind
grp
in ItemKindIx -> ContentId ItemKind -> ItemIdentity
IdentityCovered
(Word16 -> ItemKindIx
toItemKindIx (Word16 -> ItemKindIx) -> Word16 -> ItemKindIx
forall a b. (a -> b) -> a -> b
$ Vector Word16
discoRev Vector Word16 -> Int -> Word16
forall a. Unbox a => Vector a -> Int -> a
U.! ContentId ItemKind -> Int
forall k. ContentId k -> Int
contentIdIndex ContentId ItemKind
ikChosen)
ContentId ItemKind
kindHidden
Nothing -> ContentId ItemKind -> ItemIdentity
IdentityObvious ContentId ItemKind
ikChosen
jfid :: Maybe a
jfid = Maybe a
forall a. Maybe a
Nothing
jflavour :: Flavour
jflavour = Int -> Flavour
forall a. Enum a => Int -> a
toEnum (Int -> Flavour) -> Int -> Flavour
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a. Enum a => a -> Int
fromEnum (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ Vector Word16
flavourMap Vector Word16 -> Int -> Word16
forall a. Unbox a => Vector a -> Int -> a
U.! ContentId ItemKind -> Int
forall k. ContentId k -> Int
contentIdIndex ContentId ItemKind
ikChosen
in $WItem :: ItemIdentity -> Maybe FactionId -> Flavour -> Item
Item{..}
newItemKind :: COps -> UniqueSet -> Freqs ItemKind
-> Dice.AbsDepth -> Dice.AbsDepth -> Int
-> Frequency (ContentId IK.ItemKind, ItemKind)
newItemKind :: COps
-> UniqueSet
-> Freqs ItemKind
-> AbsDepth
-> AbsDepth
-> Int
-> Frequency (ContentId ItemKind, ItemKind)
newItemKind COps{ContentData ItemKind
coitem :: ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem, ItemSpeedup
coItemSpeedup :: COps -> ItemSpeedup
coItemSpeedup :: ItemSpeedup
coItemSpeedup} uniqueSet :: UniqueSet
uniqueSet itemFreq :: Freqs ItemKind
itemFreq
(Dice.AbsDepth ldepth :: Int
ldepth) (Dice.AbsDepth totalDepth :: Int
totalDepth) lvlSpawned :: Int
lvlSpawned =
Bool
-> Frequency (ContentId ItemKind, ItemKind)
-> Frequency (ContentId ItemKind, ItemKind)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (((GroupName ItemKind, Int) -> Bool) -> Freqs ItemKind -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(_, n :: Int
n) -> Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) Freqs ItemKind
itemFreq) (Frequency (ContentId ItemKind, ItemKind)
-> Frequency (ContentId ItemKind, ItemKind))
-> Frequency (ContentId ItemKind, ItemKind)
-> Frequency (ContentId ItemKind, ItemKind)
forall a b. (a -> b) -> a -> b
$
let numSpawnedCoeff :: Int
numSpawnedCoeff = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
lvlSpawned Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- 5
ldSpawned :: Int
ldSpawned = Int
ldepth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numSpawnedCoeff
f :: Int
-> [(Int, (ContentId ItemKind, ItemKind))]
-> Int
-> ContentId ItemKind
-> ItemKind
-> [(Int, (ContentId ItemKind, ItemKind))]
f _ acc :: [(Int, (ContentId ItemKind, ItemKind))]
acc _ ik :: ContentId ItemKind
ik _ | ContentId ItemKind
ik ContentId ItemKind -> UniqueSet -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` UniqueSet
uniqueSet = [(Int, (ContentId ItemKind, ItemKind))]
acc
f !Int
q ![(Int, (ContentId ItemKind, ItemKind))]
acc !Int
p !ContentId ItemKind
ik !ItemKind
kind =
let ld :: Int
ld = if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Unique
(AspectRecord -> Bool) -> AspectRecord -> Bool
forall a b. (a -> b) -> a -> b
$ KindMean -> AspectRecord
IA.kmMean (KindMean -> AspectRecord) -> KindMean -> AspectRecord
forall a b. (a -> b) -> a -> b
$ ContentId ItemKind -> ItemSpeedup -> KindMean
getKindMean ContentId ItemKind
ik ItemSpeedup
coItemSpeedup
then Int
ldepth
else Int
ldSpawned
rarity :: Int
rarity = Int -> Int -> Rarity -> Int
linearInterpolation Int
ld Int
totalDepth (ItemKind -> Rarity
IK.irarity ItemKind
kind)
!fr :: Int
fr = Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rarity
in (Int
fr, (ContentId ItemKind
ik, ItemKind
kind)) (Int, (ContentId ItemKind, ItemKind))
-> [(Int, (ContentId ItemKind, ItemKind))]
-> [(Int, (ContentId ItemKind, ItemKind))]
forall a. a -> [a] -> [a]
: [(Int, (ContentId ItemKind, ItemKind))]
acc
g :: (GroupName ItemKind, Int)
-> [(Int, (ContentId ItemKind, ItemKind))]
g (!GroupName ItemKind
itemGroup, !Int
q) = ContentData ItemKind
-> GroupName ItemKind
-> ([(Int, (ContentId ItemKind, ItemKind))]
-> Int
-> ContentId ItemKind
-> ItemKind
-> [(Int, (ContentId ItemKind, ItemKind))])
-> [(Int, (ContentId ItemKind, ItemKind))]
-> [(Int, (ContentId ItemKind, ItemKind))]
forall a b.
ContentData a
-> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData ItemKind
coitem GroupName ItemKind
itemGroup (Int
-> [(Int, (ContentId ItemKind, ItemKind))]
-> Int
-> ContentId ItemKind
-> ItemKind
-> [(Int, (ContentId ItemKind, ItemKind))]
f Int
q) []
freqDepth :: [(Int, (ContentId ItemKind, ItemKind))]
freqDepth = ((GroupName ItemKind, Int)
-> [(Int, (ContentId ItemKind, ItemKind))])
-> Freqs ItemKind -> [(Int, (ContentId ItemKind, ItemKind))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (GroupName ItemKind, Int)
-> [(Int, (ContentId ItemKind, ItemKind))]
g Freqs ItemKind
itemFreq
in Text
-> [(Int, (ContentId ItemKind, ItemKind))]
-> Frequency (ContentId ItemKind, ItemKind)
forall a. Text -> [(Int, a)] -> Frequency a
toFreq "newItemKind" [(Int, (ContentId ItemKind, ItemKind))]
freqDepth
newItem :: COps -> Frequency (ContentId IK.ItemKind, ItemKind)
-> FlavourMap -> DiscoveryKindRev
-> Dice.AbsDepth -> Dice.AbsDepth
-> Rnd NewItem
newItem :: COps
-> Frequency (ContentId ItemKind, ItemKind)
-> FlavourMap
-> DiscoveryKindRev
-> AbsDepth
-> AbsDepth
-> Rnd NewItem
newItem cops :: COps
cops freq :: Frequency (ContentId ItemKind, ItemKind)
freq flavourMap :: FlavourMap
flavourMap discoRev :: DiscoveryKindRev
discoRev levelDepth :: AbsDepth
levelDepth totalDepth :: AbsDepth
totalDepth =
if Frequency (ContentId ItemKind, ItemKind) -> Bool
forall a. Frequency a -> Bool
nullFreq Frequency (ContentId ItemKind, ItemKind)
freq
then NewItem -> Rnd NewItem
forall (m :: * -> *) a. Monad m => a -> m a
return NewItem
NoNewItem
else do
(itemKindId :: ContentId ItemKind
itemKindId, itemKind :: ItemKind
itemKind) <- Frequency (ContentId ItemKind, ItemKind)
-> Rnd (ContentId ItemKind, ItemKind)
forall a. Show a => Frequency a -> Rnd a
frequency Frequency (ContentId ItemKind, ItemKind)
freq
Int
itemN <- AbsDepth -> AbsDepth -> Dice -> Rnd Int
castDice AbsDepth
levelDepth AbsDepth
totalDepth (ItemKind -> Dice
IK.icount ItemKind
itemKind)
AspectRecord
arItem <- [Aspect] -> AbsDepth -> AbsDepth -> Rnd AspectRecord
IA.rollAspectRecord (ItemKind -> [Aspect]
IK.iaspects ItemKind
itemKind) AbsDepth
levelDepth AbsDepth
totalDepth
let itemBase :: Item
itemBase = COps
-> AspectRecord
-> FlavourMap
-> DiscoveryKindRev
-> ContentId ItemKind
-> Item
buildItem COps
cops AspectRecord
arItem FlavourMap
flavourMap DiscoveryKindRev
discoRev ContentId ItemKind
itemKindId
itemIdentity :: ItemIdentity
itemIdentity = Item -> ItemIdentity
jkind Item
itemBase
!itemK :: Int
itemK = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 1 Int
itemN
!itemTimer :: [ItemTimer]
itemTimer = [ItemTimer
itemTimerZero | Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Periodic AspectRecord
arItem]
itemSuspect :: Bool
itemSuspect = Bool
False
itemDisco :: ItemDisco
itemDisco = AspectRecord -> ItemDisco
ItemDiscoFull AspectRecord
arItem
itemFull :: ItemFull
itemFull = $WItemFull :: Item
-> ContentId ItemKind -> ItemKind -> ItemDisco -> Bool -> ItemFull
ItemFull {..}
itemKnown :: ItemKnown
itemKnown = ItemIdentity -> AspectRecord -> Maybe FactionId -> ItemKnown
ItemKnown ItemIdentity
itemIdentity AspectRecord
arItem (Item -> Maybe FactionId
jfid Item
itemBase)
itemQuant :: ItemQuant
itemQuant = if Int
itemK Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Bool -> Bool -> Bool
&& [ItemTimer] -> Bool
forall a. [a] -> Bool
null [ItemTimer]
itemTimer
then ItemQuant
quantSingle
else (Int
itemK, [ItemTimer]
itemTimer)
NewItem -> Rnd NewItem
forall (m :: * -> *) a. Monad m => a -> m a
return (NewItem -> Rnd NewItem) -> NewItem -> Rnd NewItem
forall a b. (a -> b) -> a -> b
$! ItemKnown -> ItemFull -> ItemQuant -> NewItem
NewItem ItemKnown
itemKnown ItemFull
itemFull ItemQuant
itemQuant
newtype DiscoveryKindRev = DiscoveryKindRev (U.Vector Word16)
deriving (Int -> DiscoveryKindRev -> ShowS
[DiscoveryKindRev] -> ShowS
DiscoveryKindRev -> String
(Int -> DiscoveryKindRev -> ShowS)
-> (DiscoveryKindRev -> String)
-> ([DiscoveryKindRev] -> ShowS)
-> Show DiscoveryKindRev
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DiscoveryKindRev] -> ShowS
$cshowList :: [DiscoveryKindRev] -> ShowS
show :: DiscoveryKindRev -> String
$cshow :: DiscoveryKindRev -> String
showsPrec :: Int -> DiscoveryKindRev -> ShowS
$cshowsPrec :: Int -> DiscoveryKindRev -> ShowS
Show, Get DiscoveryKindRev
[DiscoveryKindRev] -> Put
DiscoveryKindRev -> Put
(DiscoveryKindRev -> Put)
-> Get DiscoveryKindRev
-> ([DiscoveryKindRev] -> Put)
-> Binary DiscoveryKindRev
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [DiscoveryKindRev] -> Put
$cputList :: [DiscoveryKindRev] -> Put
get :: Get DiscoveryKindRev
$cget :: Get DiscoveryKindRev
put :: DiscoveryKindRev -> Put
$cput :: DiscoveryKindRev -> Put
Binary)
emptyDiscoveryKindRev :: DiscoveryKindRev
emptyDiscoveryKindRev :: DiscoveryKindRev
emptyDiscoveryKindRev = Vector Word16 -> DiscoveryKindRev
DiscoveryKindRev Vector Word16
forall a. Unbox a => Vector a
U.empty
serverDiscos :: COps -> DiscoveryKindRev
-> Rnd (DiscoveryKind, DiscoveryKindRev)
serverDiscos :: COps -> DiscoveryKindRev -> Rnd (DiscoveryKind, DiscoveryKindRev)
serverDiscos COps{ContentData ItemKind
coitem :: ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem} (DiscoveryKindRev discoRev0 :: Vector Word16
discoRev0) = do
let ixs :: [Word16]
ixs = [0..Int -> Word16
forall a. Enum a => Int -> a
toEnum (ContentData ItemKind -> Int
forall a. ContentData a -> Int
olength ContentData ItemKind
coitem Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)]
inMetaGame :: ContentId ItemKind -> Bool
inMetaGame kindId :: ContentId ItemKind
kindId =
Flag -> Aspect
IK.SetFlag Flag
Ability.MetaGame Aspect -> [Aspect] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ItemKind -> [Aspect]
IK.iaspects (ContentData ItemKind -> ContentId ItemKind -> ItemKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ItemKind
coitem ContentId ItemKind
kindId)
keepMeta :: Int -> Word16 -> Word16
keepMeta i :: Int
i ix :: Word16
ix = if ContentId ItemKind -> Bool
inMetaGame (Int -> ContentId ItemKind
forall a. Enum a => Int -> a
toEnum Int
i) then Word16
ix else Word16
forall a. Bounded a => a
maxBound
[Word16]
shuffled <-
if Vector Word16 -> Bool
forall a. Unbox a => Vector a -> Bool
U.null Vector Word16
discoRev0
then [Word16] -> Rnd [Word16]
forall a. Eq a => [a] -> Rnd [a]
shuffle [Word16]
ixs
else Vector Word16 -> Int -> [Word16] -> Rnd [Word16]
shuffleExcept ((Int -> Word16 -> Word16) -> Vector Word16 -> Vector Word16
forall a b.
(Unbox a, Unbox b) =>
(Int -> a -> b) -> Vector a -> Vector b
U.imap Int -> Word16 -> Word16
keepMeta Vector Word16
discoRev0) (ContentData ItemKind -> Int
forall a. ContentData a -> Int
olength ContentData ItemKind
coitem) [Word16]
ixs
let f :: (EnumMap ItemKindIx a, [Word16])
-> a -> p -> (EnumMap ItemKindIx a, [Word16])
f (!EnumMap ItemKindIx a
ikMap, (!Word16
ix) : rest :: [Word16]
rest) !a
kmKind _ =
(ItemKindIx -> a -> EnumMap ItemKindIx a -> EnumMap ItemKindIx a
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert (Word16 -> ItemKindIx
toItemKindIx Word16
ix) a
kmKind EnumMap ItemKindIx a
ikMap, [Word16]
rest)
f (ikMap :: EnumMap ItemKindIx a
ikMap, []) ik :: a
ik _ =
String -> (EnumMap ItemKindIx a, [Word16])
forall a. (?callStack::CallStack) => String -> a
error (String -> (EnumMap ItemKindIx a, [Word16]))
-> String -> (EnumMap ItemKindIx a, [Word16])
forall a b. (a -> b) -> a -> b
$ "too short ixs" String -> (a, EnumMap ItemKindIx a) -> String
forall v. Show v => String -> v -> String
`showFailure` (a
ik, EnumMap ItemKindIx a
ikMap)
(discoS :: DiscoveryKind
discoS, _) = ContentData ItemKind
-> ((DiscoveryKind, [Word16])
-> ContentId ItemKind -> ItemKind -> (DiscoveryKind, [Word16]))
-> (DiscoveryKind, [Word16])
-> (DiscoveryKind, [Word16])
forall a b. ContentData a -> (b -> ContentId a -> a -> b) -> b -> b
ofoldlWithKey' ContentData ItemKind
coitem (DiscoveryKind, [Word16])
-> ContentId ItemKind -> ItemKind -> (DiscoveryKind, [Word16])
forall a p.
Show a =>
(EnumMap ItemKindIx a, [Word16])
-> a -> p -> (EnumMap ItemKindIx a, [Word16])
f (DiscoveryKind
forall k a. EnumMap k a
EM.empty, [Word16]
shuffled)
udiscoRev :: Vector Word16
udiscoRev = Int -> [Word16] -> Vector Word16
forall a. Unbox a => Int -> [a] -> Vector a
U.fromListN (ContentData ItemKind -> Int
forall a. ContentData a -> Int
olength ContentData ItemKind
coitem) [Word16]
shuffled
(DiscoveryKind, DiscoveryKindRev)
-> Rnd (DiscoveryKind, DiscoveryKindRev)
forall (m :: * -> *) a. Monad m => a -> m a
return (DiscoveryKind
discoS, Vector Word16 -> DiscoveryKindRev
DiscoveryKindRev Vector Word16
udiscoRev)
newtype FlavourMap = FlavourMap (U.Vector Word16)
deriving (Int -> FlavourMap -> ShowS
[FlavourMap] -> ShowS
FlavourMap -> String
(Int -> FlavourMap -> ShowS)
-> (FlavourMap -> String)
-> ([FlavourMap] -> ShowS)
-> Show FlavourMap
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FlavourMap] -> ShowS
$cshowList :: [FlavourMap] -> ShowS
show :: FlavourMap -> String
$cshow :: FlavourMap -> String
showsPrec :: Int -> FlavourMap -> ShowS
$cshowsPrec :: Int -> FlavourMap -> ShowS
Show, Get FlavourMap
[FlavourMap] -> Put
FlavourMap -> Put
(FlavourMap -> Put)
-> Get FlavourMap -> ([FlavourMap] -> Put) -> Binary FlavourMap
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [FlavourMap] -> Put
$cputList :: [FlavourMap] -> Put
get :: Get FlavourMap
$cget :: Get FlavourMap
put :: FlavourMap -> Put
$cput :: FlavourMap -> Put
Binary)
emptyFlavourMap :: FlavourMap
emptyFlavourMap :: FlavourMap
emptyFlavourMap = Vector Word16 -> FlavourMap
FlavourMap Vector Word16
forall a. Unbox a => Vector a
U.empty
stdFlav :: ES.EnumSet Flavour
stdFlav :: EnumSet Flavour
stdFlav = [Flavour] -> EnumSet Flavour
forall k. Enum k => [k] -> EnumSet k
ES.fromList [ FancyName -> Color -> Flavour
Flavour FancyName
fn Color
bc
| FancyName
fn <- [FancyName
forall a. Bounded a => a
minBound..FancyName
forall a. Bounded a => a
maxBound], Color
bc <- [Color]
Color.stdCol ]
rollFlavourMap :: U.Vector Word16
-> 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 :: Vector Word16
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
-> ContentId ItemKind
-> ItemKind
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
rollFlavourMap uFlavMeta :: Vector Word16
uFlavMeta !Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
rnd !ContentId ItemKind
key !ItemKind
ik = case ItemKind -> [Flavour]
IK.iflavour ItemKind
ik of
[] -> String
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
forall a. (?callStack::CallStack) => String -> a
error "empty iflavour"
[flavour :: Flavour
flavour] -> do
(!EnumMap (ContentId ItemKind) Flavour
assocs, !EnumMap Char (EnumSet Flavour)
availableMap) <- Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ContentId ItemKind
-> Flavour
-> EnumMap (ContentId ItemKind) Flavour
-> EnumMap (ContentId ItemKind) Flavour
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ContentId ItemKind
key Flavour
flavour EnumMap (ContentId ItemKind) Flavour
assocs
, EnumMap Char (EnumSet Flavour)
availableMap )
flvs :: [Flavour]
flvs -> do
(!EnumMap (ContentId ItemKind) Flavour
assocs, !EnumMap Char (EnumSet Flavour)
availableMap) <- Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
rnd
let a0 :: Word16
a0 = Vector Word16
uFlavMeta Vector Word16 -> Int -> Word16
forall a. Unbox a => Vector a -> Int -> a
U.! Int -> Int
forall a. Enum a => Int -> a
toEnum (ContentId ItemKind -> Int
forall a. Enum a => a -> Int
fromEnum ContentId ItemKind
key)
if Word16
a0 Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
forall a. Bounded a => a
maxBound then do
if [Flavour] -> Int
forall a. [a] -> Int
length [Flavour]
flvs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 6 then do
Flavour
flavour <- [Flavour] -> Rnd Flavour
forall a. [a] -> Rnd a
oneOf [Flavour]
flvs
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ContentId ItemKind
-> Flavour
-> EnumMap (ContentId ItemKind) Flavour
-> EnumMap (ContentId ItemKind) Flavour
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ContentId ItemKind
key Flavour
flavour EnumMap (ContentId ItemKind) Flavour
assocs
, EnumMap Char (EnumSet Flavour)
availableMap )
else do
let available :: EnumSet Flavour
available = EnumMap Char (EnumSet Flavour)
availableMap EnumMap Char (EnumSet Flavour) -> Char -> EnumSet Flavour
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemKind -> Char
IK.isymbol ItemKind
ik
proper :: EnumSet Flavour
proper = [Flavour] -> EnumSet Flavour
forall k. Enum k => [k] -> EnumSet k
ES.fromList [Flavour]
flvs EnumSet Flavour -> EnumSet Flavour -> EnumSet Flavour
forall k. EnumSet k -> EnumSet k -> EnumSet k
`ES.intersection` EnumSet Flavour
available
Bool
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not (EnumSet Flavour -> Bool
forall k. EnumSet k -> Bool
ES.null EnumSet Flavour
proper)
Bool
-> (String,
([Flavour], EnumSet Flavour, ItemKind,
EnumMap Char (EnumSet Flavour)))
-> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "not enough flavours for items"
String
-> ([Flavour], EnumSet Flavour, ItemKind,
EnumMap Char (EnumSet Flavour))
-> (String,
([Flavour], EnumSet Flavour, ItemKind,
EnumMap Char (EnumSet Flavour)))
forall v. String -> v -> (String, v)
`swith` ([Flavour]
flvs, EnumSet Flavour
available, ItemKind
ik, EnumMap Char (EnumSet Flavour)
availableMap)) (Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour)))
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
forall a b. (a -> b) -> a -> b
$ do
Flavour
flavour <- [Flavour] -> Rnd Flavour
forall a. [a] -> Rnd a
oneOf ([Flavour] -> Rnd Flavour) -> [Flavour] -> Rnd Flavour
forall a b. (a -> b) -> a -> b
$ EnumSet Flavour -> [Flavour]
forall k. Enum k => EnumSet k -> [k]
ES.elems EnumSet Flavour
proper
let availableReduced :: EnumSet Flavour
availableReduced = Flavour -> EnumSet Flavour -> EnumSet Flavour
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.delete Flavour
flavour EnumSet Flavour
available
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ContentId ItemKind
-> Flavour
-> EnumMap (ContentId ItemKind) Flavour
-> EnumMap (ContentId ItemKind) Flavour
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ContentId ItemKind
key Flavour
flavour EnumMap (ContentId ItemKind) Flavour
assocs
, Char
-> EnumSet Flavour
-> EnumMap Char (EnumSet Flavour)
-> EnumMap Char (EnumSet Flavour)
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert (ItemKind -> Char
IK.isymbol ItemKind
ik) EnumSet Flavour
availableReduced EnumMap Char (EnumSet Flavour)
availableMap )
else (EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
forall (m :: * -> *) a. Monad m => a -> m a
return ( ContentId ItemKind
-> Flavour
-> EnumMap (ContentId ItemKind) Flavour
-> EnumMap (ContentId ItemKind) Flavour
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ContentId ItemKind
key (Int -> Flavour
forall a. Enum a => Int -> a
toEnum (Int -> Flavour) -> Int -> Flavour
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a. Enum a => a -> Int
fromEnum Word16
a0) EnumMap (ContentId ItemKind) Flavour
assocs
, EnumMap Char (EnumSet Flavour)
availableMap )
dungeonFlavourMap :: COps -> FlavourMap -> Rnd FlavourMap
dungeonFlavourMap :: COps -> FlavourMap -> Rnd FlavourMap
dungeonFlavourMap COps{ContentData ItemKind
coitem :: ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem} (FlavourMap uFlav0 :: Vector Word16
uFlav0) = do
let inMetaGame :: ContentId ItemKind -> Bool
inMetaGame kindId :: ContentId ItemKind
kindId =
Flag -> Aspect
IK.SetFlag Flag
Ability.MetaGame Aspect -> [Aspect] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ItemKind -> [Aspect]
IK.iaspects (ContentData ItemKind -> ContentId ItemKind -> ItemKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ItemKind
coitem ContentId ItemKind
kindId)
keepMeta :: Int -> Word16 -> Word16
keepMeta i :: Int
i fl :: Word16
fl = if ContentId ItemKind -> Bool
inMetaGame (Int -> ContentId ItemKind
forall a. Enum a => Int -> a
toEnum Int
i) then Word16
fl else Word16
forall a. Bounded a => a
maxBound
uFlavMeta :: Vector Word16
uFlavMeta = if Vector Word16 -> Bool
forall a. Unbox a => Vector a -> Bool
U.null Vector Word16
uFlav0
then Int -> Word16 -> Vector Word16
forall a. Unbox a => Int -> a -> Vector a
U.replicate (ContentData ItemKind -> Int
forall a. ContentData a -> Int
olength ContentData ItemKind
coitem) Word16
forall a. Bounded a => a
maxBound
else (Int -> Word16 -> Word16) -> Vector Word16 -> Vector Word16
forall a b.
(Unbox a, Unbox b) =>
(Int -> a -> b) -> Vector a -> Vector b
U.imap Int -> Word16 -> Word16
keepMeta Vector Word16
uFlav0
flavToAvailable :: EM.EnumMap Char (ES.EnumSet Flavour) -> Int -> Word16
-> EM.EnumMap Char (ES.EnumSet Flavour)
flavToAvailable :: EnumMap Char (EnumSet Flavour)
-> Int -> Word16 -> EnumMap Char (EnumSet Flavour)
flavToAvailable em :: EnumMap Char (EnumSet Flavour)
em i :: Int
i fl :: Word16
fl =
let ik :: ItemKind
ik = ContentData ItemKind -> ContentId ItemKind -> ItemKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ItemKind
coitem (Int -> ContentId ItemKind
forall a. Enum a => Int -> a
toEnum Int
i)
setBase :: EnumSet Flavour
setBase = EnumSet Flavour
-> Char -> EnumMap Char (EnumSet Flavour) -> EnumSet Flavour
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault EnumSet Flavour
stdFlav (ItemKind -> Char
IK.isymbol ItemKind
ik) EnumMap Char (EnumSet Flavour)
em
setMeta :: EnumSet Flavour
setMeta = if Word16
fl Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
forall a. Bounded a => a
maxBound
then EnumSet Flavour
setBase
else Flavour -> EnumSet Flavour -> EnumSet Flavour
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.delete (Int -> Flavour
forall a. Enum a => Int -> a
toEnum (Int -> Flavour) -> Int -> Flavour
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a. Enum a => a -> Int
fromEnum Word16
fl) EnumSet Flavour
setBase
in Char
-> EnumSet Flavour
-> EnumMap Char (EnumSet Flavour)
-> EnumMap Char (EnumSet Flavour)
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert (ItemKind -> Char
IK.isymbol ItemKind
ik) EnumSet Flavour
setMeta EnumMap Char (EnumSet Flavour)
em
availableMap :: EnumMap Char (EnumSet Flavour)
availableMap = (EnumMap Char (EnumSet Flavour)
-> Int -> Word16 -> EnumMap Char (EnumSet Flavour))
-> EnumMap Char (EnumSet Flavour)
-> Vector Word16
-> EnumMap Char (EnumSet Flavour)
forall b a. Unbox b => (a -> Int -> b -> a) -> a -> Vector b -> a
U.ifoldl' EnumMap Char (EnumSet Flavour)
-> Int -> Word16 -> EnumMap Char (EnumSet Flavour)
flavToAvailable EnumMap Char (EnumSet Flavour)
forall k a. EnumMap k a
EM.empty Vector Word16
uFlavMeta
(assocsFlav :: EnumMap (ContentId ItemKind) Flavour
assocsFlav, _) <- ContentData ItemKind
-> (Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
-> ContentId ItemKind
-> ItemKind
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour)))
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
forall a b. ContentData a -> (b -> ContentId a -> a -> b) -> b -> b
ofoldlWithKey' ContentData ItemKind
coitem (Vector Word16
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
-> ContentId ItemKind
-> ItemKind
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
rollFlavourMap Vector Word16
uFlavMeta)
((EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap Char (EnumSet Flavour))
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumMap (ContentId ItemKind) Flavour
forall k a. EnumMap k a
EM.empty, EnumMap Char (EnumSet Flavour)
availableMap))
let uFlav :: Vector Word16
uFlav = Int -> [Word16] -> Vector Word16
forall a. Unbox a => Int -> [a] -> Vector a
U.fromListN (ContentData ItemKind -> Int
forall a. ContentData a -> Int
olength ContentData ItemKind
coitem)
([Word16] -> Vector Word16) -> [Word16] -> Vector Word16
forall a b. (a -> b) -> a -> b
$ (Flavour -> Word16) -> [Flavour] -> [Word16]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word16
forall a. Enum a => Int -> a
toEnum (Int -> Word16) -> (Flavour -> Int) -> Flavour -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flavour -> Int
forall a. Enum a => a -> Int
fromEnum) ([Flavour] -> [Word16]) -> [Flavour] -> [Word16]
forall a b. (a -> b) -> a -> b
$ EnumMap (ContentId ItemKind) Flavour -> [Flavour]
forall k a. EnumMap k a -> [a]
EM.elems EnumMap (ContentId ItemKind) Flavour
assocsFlav
FlavourMap -> Rnd FlavourMap
forall (m :: * -> *) a. Monad m => a -> m a
return (FlavourMap -> Rnd FlavourMap) -> FlavourMap -> Rnd FlavourMap
forall a b. (a -> b) -> a -> b
$! Vector Word16 -> FlavourMap
FlavourMap Vector Word16
uFlav