module Game.LambdaHack.Common.Item
(
ItemId, Item(..), jkind, buildItem, newItem, viewItem
, strongestSearch, strongestSword, strongestRegen
, ItemKindIx, Discovery, DiscoRev, serverDiscos
, FlavourMap, emptyFlavourMap, dungeonFlavourMap
, partItem, partItemWs, partItemAW
) where
import Control.Monad
import Data.Binary
import qualified Data.EnumMap.Strict as EM
import qualified Data.Hashable as Hashable
import qualified Data.Ix as Ix
import Data.List
import Data.Maybe
import qualified Data.Set as S
import Data.Text (Text)
import GHC.Generics (Generic)
import qualified NLP.Miniutter.English as MU
import qualified Game.LambdaHack.Common.Color as Color
import Game.LambdaHack.Common.Effect
import Game.LambdaHack.Common.Flavour
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.Msg
import Game.LambdaHack.Common.Random
import Game.LambdaHack.Content.ItemKind
import Game.LambdaHack.Content.RuleKind
import Control.Exception.Assert.Sugar
import Game.LambdaHack.Utils.Frequency
newtype ItemId = ItemId Int
deriving (Show, Eq, Ord, Enum, Binary)
newtype ItemKindIx = ItemKindIx Int
deriving (Show, Eq, Ord, Enum, Ix.Ix, Hashable.Hashable, Binary)
type Discovery = EM.EnumMap ItemKindIx (Kind.Id ItemKind)
type DiscoRev = EM.EnumMap (Kind.Id ItemKind) ItemKindIx
data Item = Item
{ jkindIx :: !ItemKindIx
, jsymbol :: !Char
, jname :: !Text
, jflavour :: !Flavour
, jeffect :: !(Effect Int)
}
deriving (Show, Eq, Ord, Generic)
instance Hashable.Hashable Item
instance Binary Item
jkind :: Discovery -> Item -> Maybe (Kind.Id ItemKind)
jkind disco i = EM.lookup (jkindIx i) disco
serverDiscos :: Kind.Ops ItemKind -> Rnd (Discovery, DiscoRev)
serverDiscos Kind.Ops{obounds, ofoldrWithKey} = do
let ixs = map ItemKindIx $ take (Ix.rangeSize obounds) [0..]
shuffle :: Eq a => [a] -> Rnd [a]
shuffle [] = return []
shuffle l = do
x <- oneOf l
fmap (x :) $ shuffle (delete x l)
shuffled <- shuffle ixs
let f ik _ (ikMap, ikRev, ix : rest) =
(EM.insert ix ik ikMap, EM.insert ik ix ikRev, rest)
f ik _ (ikMap, _, []) =
assert `failure` "too short ixs" `twith` (ik, ikMap)
(discoS, discoRev, _) =
ofoldrWithKey f (EM.empty, EM.empty, shuffled)
return (discoS, discoRev)
buildItem :: FlavourMap -> DiscoRev
-> Kind.Id ItemKind -> ItemKind -> Effect Int -> Item
buildItem (FlavourMap flavour) discoRev ikChosen kind jeffect =
let jkindIx = discoRev EM.! ikChosen
jsymbol = isymbol kind
jname = iname kind
jflavour =
case iflavour kind of
[fl] -> fl
_ -> flavour EM.! ikChosen
in Item{..}
newItem :: Kind.Ops ItemKind -> FlavourMap -> DiscoRev
-> Frequency Text -> Int -> Int
-> Rnd (Item, Int, ItemKind)
newItem cops@Kind.Ops{opick, okind} flavour discoRev itemFreq lvl depth = do
itemGroup <- frequency itemFreq
let castItem :: Int -> Rnd (Item, Int, ItemKind)
castItem 0 | nullFreq itemFreq = assert `failure` "no fallback items"
`twith` (itemFreq, lvl, depth)
castItem 0 = do
let newFreq = setFreq itemFreq itemGroup 0
newItem cops flavour discoRev newFreq lvl depth
castItem count = do
ikChosen <- fmap (fromMaybe $ assert `failure` itemGroup)
$ opick itemGroup (const True)
let kind = okind ikChosen
jcount <- castDeep lvl depth (icount kind)
if jcount == 0 then
castItem $ count 1
else do
effect <- effectTrav (ieffect kind) (castDeep lvl depth)
return ( buildItem flavour discoRev ikChosen kind effect
, jcount
, kind )
castItem 10
viewItem :: Item -> (Char, Color.Color)
viewItem i = (jsymbol i, flavourToColor $ jflavour i)
newtype FlavourMap = FlavourMap (EM.EnumMap (Kind.Id ItemKind) Flavour)
deriving (Show, Binary)
emptyFlavourMap :: FlavourMap
emptyFlavourMap = FlavourMap EM.empty
rollFlavourMap :: Kind.Id ItemKind -> ItemKind
-> Rnd (EM.EnumMap (Kind.Id ItemKind) Flavour, S.Set Flavour)
-> Rnd (EM.EnumMap (Kind.Id ItemKind) Flavour, S.Set Flavour)
rollFlavourMap key ik rnd =
let flavours = iflavour ik
in if length flavours == 1
then rnd
else do
(assocs, available) <- rnd
let proper = S.fromList flavours `S.intersection` available
flavour <- oneOf (S.toList proper)
return (EM.insert key flavour assocs, S.delete flavour available)
dungeonFlavourMap :: Kind.Ops ItemKind -> Rnd FlavourMap
dungeonFlavourMap Kind.Ops{ofoldrWithKey} =
liftM (FlavourMap . fst) $
ofoldrWithKey rollFlavourMap (return (EM.empty, S.fromList stdFlav))
strongestItem :: [(ItemId, Item)] -> (Item -> Maybe Int)
-> Maybe (Int, (ItemId, Item))
strongestItem is p =
let ks = map (p . snd) is
in case zip ks is of
[] -> Nothing
kis -> case maximum kis of
(Nothing, _) -> Nothing
(Just k, iki) -> Just (k, iki)
strongestSearch :: [(ItemId, Item)] -> Maybe (Int, (ItemId, Item))
strongestSearch is =
strongestItem is $ \ i ->
case jeffect i of Searching k -> Just k; _ -> Nothing
strongestSword :: Kind.COps -> [(ItemId, Item)] -> Maybe (Int, (ItemId, Item))
strongestSword Kind.COps{corule} is =
strongestItem is $ \ i ->
case jeffect i of
Hurt d k | jsymbol i `elem` ritemMelee (Kind.stdRuleset corule)
-> Just $ floor (meanDice d) + k
_ -> Nothing
strongestRegen :: [(ItemId, Item)] -> Maybe (Int, (ItemId, Item))
strongestRegen is =
strongestItem is $ \ i ->
case jeffect i of Regeneration k -> Just k; _ -> Nothing
partItem :: Kind.Ops ItemKind -> Discovery -> Item -> (MU.Part, MU.Part)
partItem _cops disco i =
let genericName = jname i
flav = flavourToName $ jflavour i
in case jkind disco i of
Nothing ->
(MU.Text $ flav <+> genericName, "")
Just _ ->
let eff = effectToSuffix $ jeffect i
in (MU.Text genericName, MU.Text eff)
partItemWs :: Kind.Ops ItemKind -> Discovery -> Int -> Item -> MU.Part
partItemWs coitem disco jcount i =
let (name, stats) = partItem coitem disco i
in MU.Phrase [MU.CarWs jcount name, stats]
partItemAW :: Kind.Ops ItemKind -> Discovery -> Item -> MU.Part
partItemAW coitem disco i =
let (name, stats) = partItem coitem disco i
in MU.AW $ MU.Phrase [name, stats]