Safe Haskell | None |
---|---|
Language | Haskell2010 |
Weapons, treasure and all the other items in the game.
Synopsis
- data Item = Item {}
- data ItemIdentity
- data ItemKindIx
- data ItemDisco
- data ItemFull = ItemFull {}
- type ItemFullKit = (ItemFull, ItemQuant)
- type DiscoveryKind = EnumMap ItemKindIx (ContentId ItemKind)
- type DiscoveryAspect = EnumMap ItemId AspectRecord
- type ItemIxMap = EnumMap ItemKindIx (EnumSet ItemId)
- data Benefit = Benefit {}
- type DiscoveryBenefit = EnumMap ItemId Benefit
- data ItemTimer
- type ItemTimers = [ItemTimer]
- type ItemQuant = (Int, ItemTimers)
- type ItemBag = EnumMap ItemId ItemQuant
- type ItemDict = EnumMap ItemId Item
- toItemKindIx :: Word16 -> ItemKindIx
- quantSingle :: ItemQuant
- itemToFull6 :: COps -> DiscoveryKind -> DiscoveryAspect -> ItemId -> Item -> ItemFull
- aspectRecordFull :: ItemFull -> AspectRecord
- strongestSlot :: DiscoveryBenefit -> EqpSlot -> [(ItemId, ItemFullKit)] -> [(Int, (ItemId, ItemFullKit))]
- itemTimerZero :: ItemTimer
- createItemTimer :: Time -> Delta Time -> ItemTimer
- shiftItemTimer :: Delta Time -> ItemTimer -> ItemTimer
- deltaOfItemTimer :: Time -> ItemTimer -> Delta Time
- charging :: Time -> ItemTimer -> Bool
- ncharges :: Time -> ItemQuant -> Int
- hasCharge :: Time -> ItemQuant -> Bool
- strongestMelee :: Bool -> Maybe DiscoveryBenefit -> Time -> [(ItemId, ItemFullKit)] -> [(Double, Bool, Int, Int, ItemId, ItemFullKit)]
- unknownMeleeBonus :: [ItemFull] -> Bool
- unknownSpeedBonus :: [ItemFull] -> Bool
- conditionMeleeBonus :: [ItemFullKit] -> Int
- conditionSpeedBonus :: [ItemFullKit] -> Int
- armorHurtCalculation :: Bool -> Skills -> Skills -> Int
- mergeItemQuant :: ItemQuant -> ItemQuant -> ItemQuant
- listToolsToConsume :: [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)] -> [((CStore, Bool), (ItemId, ItemFullKit))]
- subtractIidfromGrps :: (EnumMap CStore ItemBag, [(CStore, (ItemId, ItemFull))], [(Bool, Int, GroupName ItemKind)]) -> ((CStore, Bool), (ItemId, ItemFullKit)) -> (EnumMap CStore ItemBag, [(CStore, (ItemId, ItemFull))], [(Bool, Int, GroupName ItemKind)])
- valueAtEqpSlot :: EqpSlot -> AspectRecord -> Int
- unknownAspect :: (Aspect -> [Dice]) -> ItemFull -> Bool
- countIidConsumed :: ItemFullKit -> [(Bool, Int, GroupName ItemKind)] -> (Int, Int, [(Bool, Int, GroupName ItemKind)])
Documentation
Game items in actor possesion or strewn around the dungeon. The information contained in this time is available to the player from the moment the item is first seen and is never mutated.
Some items are not created identified (IdentityCovered
).
Then they are presented as having a template kind that is really
not their own, though usually close. Full kind information about
item's kind is available through the ItemKindIx
index once the item
is identified and full information about the value of item's aspect record
is available elsewhere (both IdentityObvious
and IdentityCovered
items may or may not need identification of their aspect record).
Instances
Eq Item Source # | |
Show Item Source # | |
Generic Item Source # | |
Binary Item Source # | |
type Rep Item Source # | |
Defined in Game.LambdaHack.Common.Item type Rep Item = D1 ('MetaData "Item" "Game.LambdaHack.Common.Item" "LambdaHack-0.10.2.0-inplace" 'False) (C1 ('MetaCons "Item" 'PrefixI 'True) (S1 ('MetaSel ('Just "jkind") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 ItemIdentity) :*: (S1 ('MetaSel ('Just "jfid") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 (Maybe FactionId)) :*: S1 ('MetaSel ('Just "jflavour") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Flavour)))) |
data ItemIdentity Source #
Either the explicit obvious kind of the item or the kind it's hidden under, with the details covered under the index indirection.
Instances
data ItemKindIx Source #
An index of the kind identifier of an item. Clients have partial knowledge how these idexes map to kind ids. They gain knowledge by identifying items. The indexes and kind identifiers are 1-1.
Instances
The secret part of the information about an item. If a faction
knows the aspect record of the item, this is the complete secret information.
Items that don't need second identification (the kmConst
flag is set)
may be identified or not and both cases are OK (their display flavour
will differ and that may be the point).
Full information about an item.
type ItemFullKit = (ItemFull, ItemQuant) Source #
type DiscoveryKind = EnumMap ItemKindIx (ContentId ItemKind) Source #
The map of item kind indexes to item kind ids. The full map, as known by the server, is 1-1. Because it's sparse and changes, we don't represent it as an (unboxed) vector, until it becomes a bottleneck (if ever, likely on JS, where only vectors are fast).
type DiscoveryAspect = EnumMap ItemId AspectRecord Source #
The map of item ids to item aspect record. The full map is known by the server.
type ItemIxMap = EnumMap ItemKindIx (EnumSet ItemId) Source #
The map of item kind indexes to identifiers of items that have that kind. Used to update data about items when their kinds become known, e.g., AI item use benefit data.
The fields are, in order: 1. whether the item should be kept in equipment (not in stash) 2. the total benefit from picking the item up (to use or to put in equipment) 3. the benefit of applying the item to self 4. the (usually negative, for him) value of hitting a foe in melee with it 5. the (usually negative, for him) value of flinging the item at an opponent
Instances
Show Benefit Source # | |
Generic Benefit Source # | |
Binary Benefit Source # | |
type Rep Benefit Source # | |
Defined in Game.LambdaHack.Common.Item type Rep Benefit = D1 ('MetaData "Benefit" "Game.LambdaHack.Common.Item" "LambdaHack-0.10.2.0-inplace" 'False) (C1 ('MetaCons "Benefit" 'PrefixI 'True) ((S1 ('MetaSel ('Just "benInEqp") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Bool) :*: S1 ('MetaSel ('Just "benPickup") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Double)) :*: (S1 ('MetaSel ('Just "benApply") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Double) :*: (S1 ('MetaSel ('Just "benMelee") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Double) :*: S1 ('MetaSel ('Just "benFling") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 Double))))) |
The absolute level's local time at which an item's copy becomes operational again. Even if item is not identified and so its timeout unknown, it's enough to compare this to the local level time to learn whether an item is recharged.
This schema causes timeout jumps for items in stash, but timeout is reset when items move, so this is a minor problem. Global time can't be used even only for items in stash, or exploit would be possible when an actor on a desolate level waits to recharge items for actors on a busy level. It's probably impossible to avoid such exploits or, otherwise, timeout jumps, particularly for faction where many actors move on many levels and so an item in stash is not used by a single actor at a time.
type ItemTimers = [ItemTimer] Source #
type ItemQuant = (Int, ItemTimers) Source #
Number of items in a bag, together with recharging timer, in case of items that need recharging, exists only temporarily or auto-activate at regular intervals. Data invariant: the length of the timer should be less or equal to the number of items.
type ItemBag = EnumMap ItemId ItemQuant Source #
A bag of items, e.g., one of the stores of an actor or the items on a particular floor position or embedded in a particular map tile.
type ItemDict = EnumMap ItemId Item Source #
All items in the dungeon (including those carried by actors), indexed by item identifier.
toItemKindIx :: Word16 -> ItemKindIx Source #
itemToFull6 :: COps -> DiscoveryKind -> DiscoveryAspect -> ItemId -> Item -> ItemFull Source #
strongestSlot :: DiscoveryBenefit -> EqpSlot -> [(ItemId, ItemFullKit)] -> [(Int, (ItemId, ItemFullKit))] Source #
strongestMelee :: Bool -> Maybe DiscoveryBenefit -> Time -> [(ItemId, ItemFullKit)] -> [(Double, Bool, Int, Int, ItemId, ItemFullKit)] Source #
unknownMeleeBonus :: [ItemFull] -> Bool Source #
unknownSpeedBonus :: [ItemFull] -> Bool Source #
conditionMeleeBonus :: [ItemFullKit] -> Int Source #
conditionSpeedBonus :: [ItemFullKit] -> Int Source #
armorHurtCalculation :: Bool -> Skills -> Skills -> Int Source #
Damage calculation. The armor and hurt skills are additive. They can't be multiplicative, because then 100% armor would minimize damage regardless of even 200% hurt skill. However, additive skills make the relative effectiveness of weapons dependent on the enemy, so even with -100% hurt skill a kinetic weapon can't be removed from the list, because an enemy may have negative armor skill. This is bad, but also KISS.
listToolsToConsume :: [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)] -> [((CStore, Bool), (ItemId, ItemFullKit))] Source #
subtractIidfromGrps :: (EnumMap CStore ItemBag, [(CStore, (ItemId, ItemFull))], [(Bool, Int, GroupName ItemKind)]) -> ((CStore, Bool), (ItemId, ItemFullKit)) -> (EnumMap CStore ItemBag, [(CStore, (ItemId, ItemFull))], [(Bool, Int, GroupName ItemKind)]) Source #
Internal operations
valueAtEqpSlot :: EqpSlot -> AspectRecord -> Int Source #