{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}
module Game.LambdaHack.Server.ItemRev
( ItemKnown(..), NewItem(..), ItemRev, UniqueSet
, newItemKind, newItem
, DiscoveryKindRev, emptyDiscoveryKindRev, serverDiscos
, FlavourMap, emptyFlavourMap, dungeonFlavourMap
, rollFlavourMap
#ifdef EXPOSE_INTERNAL
, 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
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 (GroupName ItemKind) 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} AspectRecord
arItem (FlavourMap Vector Word16
flavourMap)
(DiscoveryKindRev Vector Word16
discoRev) ContentId ItemKind
ikChosen =
let jkind :: ItemIdentity
jkind = case AspectRecord -> Maybe (GroupName ItemKind)
IA.aPresentAs AspectRecord
arItem of
Just 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 c. ContentId c -> Int
contentIdIndex ContentId ItemKind
ikChosen)
ContentId ItemKind
kindHidden
Maybe (GroupName ItemKind)
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 c. ContentId c -> Int
contentIdIndex ContentId ItemKind
ikChosen
in Item :: ItemIdentity -> Maybe FactionId -> Flavour -> Item
Item{Maybe FactionId
Flavour
ItemIdentity
forall a. Maybe a
jflavour :: Flavour
jfid :: Maybe FactionId
jkind :: ItemIdentity
jflavour :: Flavour
jfid :: forall a. Maybe a
jkind :: ItemIdentity
..}
newItemKind :: COps -> UniqueSet -> Freqs ItemKind
-> Dice.AbsDepth -> Dice.AbsDepth -> Int
-> Frequency (GroupName ItemKind, ContentId IK.ItemKind, ItemKind)
newItemKind :: COps
-> UniqueSet
-> Freqs ItemKind
-> AbsDepth
-> AbsDepth
-> Int
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
newItemKind COps{ContentData ItemKind
coitem :: ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem, ItemSpeedup
coItemSpeedup :: COps -> ItemSpeedup
coItemSpeedup :: ItemSpeedup
coItemSpeedup} UniqueSet
uniqueSet Freqs ItemKind
itemFreq
(Dice.AbsDepth Int
ldepth) (Dice.AbsDepth Int
totalDepth) Int
lvlSpawned =
Bool
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> Frequency (GroupName ItemKind, 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 (\(GroupName ItemKind
_, Int
n) -> Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) Freqs ItemKind
itemFreq) (Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind))
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> Frequency (GroupName ItemKind, 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 Int
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` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
5
ldSpawned :: Int
ldSpawned = Int
ldepth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numSpawnedCoeff
f :: GroupName ItemKind
-> Int
-> [(Int, (GroupName ItemKind, ContentId ItemKind, ItemKind))]
-> Int
-> ContentId ItemKind
-> ItemKind
-> [(Int, (GroupName ItemKind, ContentId ItemKind, ItemKind))]
f GroupName ItemKind
_ Int
_ [(Int, (GroupName ItemKind, ContentId ItemKind, ItemKind))]
acc Int
_ ContentId ItemKind
ik ItemKind
_ | ContentId ItemKind
ik ContentId ItemKind -> UniqueSet -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` UniqueSet
uniqueSet = [(Int, (GroupName ItemKind, ContentId ItemKind, ItemKind))]
acc
f !GroupName ItemKind
itemGroup !Int
q ![(Int, (GroupName ItemKind, 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, (GroupName ItemKind
itemGroup, ContentId ItemKind
ik, ItemKind
kind)) (Int, (GroupName ItemKind, ContentId ItemKind, ItemKind))
-> [(Int, (GroupName ItemKind, ContentId ItemKind, ItemKind))]
-> [(Int, (GroupName ItemKind, ContentId ItemKind, ItemKind))]
forall a. a -> [a] -> [a]
: [(Int, (GroupName ItemKind, ContentId ItemKind, ItemKind))]
acc
g :: (GroupName ItemKind, Int)
-> [(Int, (GroupName ItemKind, ContentId ItemKind, ItemKind))]
g (!GroupName ItemKind
itemGroup, !Int
q) = ContentData ItemKind
-> GroupName ItemKind
-> ([(Int, (GroupName ItemKind, ContentId ItemKind, ItemKind))]
-> Int
-> ContentId ItemKind
-> ItemKind
-> [(Int, (GroupName ItemKind, ContentId ItemKind, ItemKind))])
-> [(Int, (GroupName ItemKind, ContentId ItemKind, ItemKind))]
-> [(Int, (GroupName ItemKind, 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 (GroupName ItemKind
-> Int
-> [(Int, (GroupName ItemKind, ContentId ItemKind, ItemKind))]
-> Int
-> ContentId ItemKind
-> ItemKind
-> [(Int, (GroupName ItemKind, ContentId ItemKind, ItemKind))]
f GroupName ItemKind
itemGroup Int
q) []
freqDepth :: [(Int, (GroupName ItemKind, ContentId ItemKind, ItemKind))]
freqDepth = ((GroupName ItemKind, Int)
-> [(Int, (GroupName ItemKind, ContentId ItemKind, ItemKind))])
-> Freqs ItemKind
-> [(Int, (GroupName ItemKind, ContentId ItemKind, ItemKind))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (GroupName ItemKind, Int)
-> [(Int, (GroupName ItemKind, ContentId ItemKind, ItemKind))]
g Freqs ItemKind
itemFreq
in Text
-> [(Int, (GroupName ItemKind, ContentId ItemKind, ItemKind))]
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
forall a. Text -> [(Int, a)] -> Frequency a
toFreq Text
"newItemKind" [(Int, (GroupName ItemKind, ContentId ItemKind, ItemKind))]
freqDepth
newItem :: COps
-> Frequency (GroupName ItemKind, ContentId IK.ItemKind, ItemKind)
-> FlavourMap -> DiscoveryKindRev
-> Dice.AbsDepth -> Dice.AbsDepth
-> Rnd NewItem
newItem :: COps
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> FlavourMap
-> DiscoveryKindRev
-> AbsDepth
-> AbsDepth
-> Rnd NewItem
newItem COps
cops Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq FlavourMap
flavourMap DiscoveryKindRev
discoRev AbsDepth
levelDepth AbsDepth
totalDepth =
if Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> Bool
forall a. Frequency a -> Bool
nullFreq Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq
then NewItem -> Rnd NewItem
forall (m :: * -> *) a. Monad m => a -> m a
return NewItem
NoNewItem
else do
(GroupName ItemKind
itemGroup, ContentId ItemKind
itemKindId, ItemKind
itemKind) <- Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> Rnd (GroupName ItemKind, ContentId ItemKind, ItemKind)
forall a. Show a => Frequency a -> Rnd a
frequency Frequency (GroupName ItemKind, 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 Int
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 = ItemFull :: Item
-> ContentId ItemKind -> ItemKind -> ItemDisco -> Bool -> ItemFull
ItemFull {Bool
ContentId ItemKind
ItemKind
ItemDisco
Item
itemSuspect :: Bool
itemDisco :: ItemDisco
itemKind :: ItemKind
itemKindId :: ContentId ItemKind
itemBase :: Item
itemDisco :: ItemDisco
itemSuspect :: Bool
itemBase :: Item
itemKind :: ItemKind
itemKindId :: ContentId ItemKind
..}
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
== Int
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
$! GroupName ItemKind -> ItemKnown -> ItemFull -> ItemQuant -> NewItem
NewItem GroupName ItemKind
itemGroup 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 Vector Word16
discoRevFromPreviousGame) = do
let ixs :: [Word16]
ixs = [Word16
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
- Int
1)]
[Word16]
shuffled <-
if Vector Word16 -> Bool
forall a. Unbox a => Vector a -> Bool
U.null Vector Word16
discoRevFromPreviousGame
then [Word16] -> Rnd [Word16]
forall a. Eq a => [a] -> Rnd [a]
shuffle [Word16]
ixs
else Vector Word16 -> Int -> [Word16] -> Rnd [Word16]
shuffleExcept (ContentData ItemKind -> Vector Word16 -> Vector Word16
keepMetaGameInformation ContentData ItemKind
coitem Vector Word16
discoRevFromPreviousGame)
(ContentData ItemKind -> Int
forall a. ContentData a -> Int
olength ContentData ItemKind
coitem)
[Word16]
ixs
let 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
f :: ContentId ItemKind -> Word16 -> (ItemKindIx, ContentId ItemKind)
f :: ContentId ItemKind -> Word16 -> (ItemKindIx, ContentId ItemKind)
f ContentId ItemKind
ik Word16
ikx = (Word16 -> ItemKindIx
toItemKindIx Word16
ikx, ContentId ItemKind
ik)
discoS :: DiscoveryKind
discoS = [(ItemKindIx, ContentId ItemKind)] -> DiscoveryKind
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList ([(ItemKindIx, ContentId ItemKind)] -> DiscoveryKind)
-> [(ItemKindIx, ContentId ItemKind)] -> DiscoveryKind
forall a b. (a -> b) -> a -> b
$ (ContentId ItemKind -> Word16 -> (ItemKindIx, ContentId ItemKind))
-> [ContentId ItemKind]
-> [Word16]
-> [(ItemKindIx, ContentId ItemKind)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ContentId ItemKind -> Word16 -> (ItemKindIx, ContentId ItemKind)
f [Int -> ContentId ItemKind
forall a. Enum a => Int -> a
toEnum Int
0 ..] ([Word16] -> [(ItemKindIx, ContentId ItemKind)])
-> [Word16] -> [(ItemKindIx, ContentId ItemKind)]
forall a b. (a -> b) -> a -> b
$ Vector Word16 -> [Word16]
forall a. Unbox a => Vector a -> [a]
U.toList Vector Word16
udiscoRev
(DiscoveryKind, DiscoveryKindRev)
-> Rnd (DiscoveryKind, DiscoveryKindRev)
forall (m :: * -> *) a. Monad m => a -> m a
return (DiscoveryKind
discoS, Vector Word16 -> DiscoveryKindRev
DiscoveryKindRev Vector Word16
udiscoRev)
keepMetaGameInformation :: ContentData ItemKind
-> U.Vector Word16
-> U.Vector Word16
keepMetaGameInformation :: ContentData ItemKind -> Vector Word16 -> Vector Word16
keepMetaGameInformation ContentData ItemKind
coitem Vector Word16
informationFromPreviousGame =
let inMetaGame :: ContentId ItemKind -> Bool
inMetaGame :: ContentId ItemKind -> Bool
inMetaGame 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 :: Int -> Word16 -> Word16
keepMeta Int
i Word16
ix = if ContentId ItemKind -> Bool
inMetaGame (Int -> ContentId ItemKind
forall a. Enum a => Int -> a
toEnum Int
i)
then Word16
ix
else Word16
invalidInformationCode
in (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
informationFromPreviousGame
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
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 :: Vector Word16
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (EnumSet Flavour))
-> ContentId ItemKind
-> ItemKind
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (EnumSet Flavour))
rollFlavourMap Vector Word16
uFlavMeta !Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (EnumSet Flavour))
rnd !ContentId ItemKind
key !ItemKind
ik = case ItemKind -> [Flavour]
IK.iflavour ItemKind
ik of
[] -> String
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (EnumSet Flavour))
forall a. (?callStack::CallStack) => String -> a
error String
"empty iflavour"
[Flavour
flavour] -> do
(!EnumMap (ContentId ItemKind) Flavour
assocs, !EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)
availableMap) <- Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (EnumSet Flavour))
rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (EnumSet Flavour))
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (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 (ContentSymbol ItemKind) (EnumSet Flavour)
availableMap )
[Flavour]
flvs -> do
(!EnumMap (ContentId ItemKind) Flavour
assocs, !EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)
availableMap) <- Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (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
invalidInformationCode then do
if [Flavour] -> Int
forall a. [a] -> Int
length [Flavour]
flvs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
6 then do
Flavour
flavour <- [Flavour] -> Rnd Flavour
forall a. [a] -> Rnd a
oneOf [Flavour]
flvs
(EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (EnumSet Flavour))
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (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 (ContentSymbol ItemKind) (EnumSet Flavour)
availableMap )
else do
let available :: EnumSet Flavour
available = EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)
availableMap EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)
-> ContentSymbol ItemKind -> EnumSet Flavour
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemKind -> ContentSymbol ItemKind
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 (ContentSymbol ItemKind) (EnumSet Flavour))
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (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 (ContentSymbol ItemKind) (EnumSet Flavour)))
-> Bool
forall a. Show a => Bool -> a -> Bool
`blame` String
"not enough flavours for items"
String
-> ([Flavour], EnumSet Flavour, ItemKind,
EnumMap (ContentSymbol ItemKind) (EnumSet Flavour))
-> (String,
([Flavour], EnumSet Flavour, ItemKind,
EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)))
forall v. String -> v -> (String, v)
`swith` ([Flavour]
flvs, EnumSet Flavour
available, ItemKind
ik, EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)
availableMap)) (Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (EnumSet Flavour))
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)))
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (EnumSet Flavour))
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (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 (ContentSymbol ItemKind) (EnumSet Flavour))
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (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
, ContentSymbol ItemKind
-> EnumSet Flavour
-> EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)
-> EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert (ItemKind -> ContentSymbol ItemKind
IK.isymbol ItemKind
ik) EnumSet Flavour
availableReduced EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)
availableMap )
else (EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (EnumSet Flavour))
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (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 (ContentSymbol ItemKind) (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 Vector Word16
flavourMapFromPreviousGame) = do
let uFlavMeta :: Vector Word16
uFlavMeta = if Vector Word16 -> Bool
forall a. Unbox a => Vector a -> Bool
U.null Vector Word16
flavourMapFromPreviousGame
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
invalidInformationCode
else ContentData ItemKind -> Vector Word16 -> Vector Word16
keepMetaGameInformation ContentData ItemKind
coitem Vector Word16
flavourMapFromPreviousGame
flavToAvailable :: EM.EnumMap Char (ES.EnumSet Flavour) -> Int -> Word16
-> EM.EnumMap Char (ES.EnumSet Flavour)
flavToAvailable :: EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)
-> Int
-> Word16
-> EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)
flavToAvailable EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)
em Int
i 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
-> ContentSymbol ItemKind
-> EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)
-> EnumSet Flavour
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault ([Flavour] -> EnumSet Flavour
forall k. Enum k => [k] -> EnumSet k
ES.fromList [Flavour]
stdFlavList)
(ItemKind -> ContentSymbol ItemKind
IK.isymbol ItemKind
ik)
EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)
em
setMeta :: EnumSet Flavour
setMeta = if Word16
fl Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
invalidInformationCode
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 ContentSymbol ItemKind
-> EnumSet Flavour
-> EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)
-> EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert (ItemKind -> ContentSymbol ItemKind
IK.isymbol ItemKind
ik) EnumSet Flavour
setMeta EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)
em
availableMap :: EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)
availableMap = (EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)
-> Int
-> Word16
-> EnumMap (ContentSymbol ItemKind) (EnumSet Flavour))
-> EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)
-> Vector Word16
-> EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)
forall b a. Unbox b => (a -> Int -> b -> a) -> a -> Vector b -> a
U.ifoldl' EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)
-> Int
-> Word16
-> EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)
flavToAvailable EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)
forall k a. EnumMap k a
EM.empty Vector Word16
uFlavMeta
(EnumMap (ContentId ItemKind) Flavour
assocsFlav, EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)
_) <- ContentData ItemKind
-> (Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (EnumSet Flavour))
-> ContentId ItemKind
-> ItemKind
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (EnumSet Flavour)))
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (EnumSet Flavour))
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (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 (ContentSymbol ItemKind) (EnumSet Flavour))
-> ContentId ItemKind
-> ItemKind
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (EnumSet Flavour))
rollFlavourMap Vector Word16
uFlavMeta)
((EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (EnumSet Flavour))
-> Rnd
(EnumMap (ContentId ItemKind) Flavour,
EnumMap (ContentSymbol ItemKind) (EnumSet Flavour))
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumMap (ContentId ItemKind) Flavour
forall k a. EnumMap k a
EM.empty, EnumMap (ContentSymbol ItemKind) (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