{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving, TupleSections #-}
-- | Weapons, treasure and all the other items in the game.
module Game.LambdaHack.Common.Item
  ( Item(..), ItemIdentity(..)
  , ItemKindIx, ItemDisco(..), ItemFull(..), ItemFullKit
  , DiscoveryKind, DiscoveryAspect, ItemIxMap, Benefit(..), DiscoveryBenefit
  , ItemTimer, ItemTimers, ItemQuant, ItemBag, ItemDict
  , toItemKindIx, quantSingle, itemToFull6, aspectRecordFull, strongestSlot
  , itemTimerZero, createItemTimer, shiftItemTimer
  , deltaOfItemTimer, charging, ncharges, hasCharge
  , strongestMelee, unknownMeleeBonus, unknownSpeedBonus
  , conditionMeleeBonus, conditionSpeedBonus, armorHurtCalculation
  , mergeItemQuant, listToolsToConsume, subtractIidfromGrps, sortIids
  , TileAction (..), parseTileAction
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , valueAtEqpSlot, unknownAspect, countIidConsumed
#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           Data.Hashable (Hashable)
import qualified Data.Ix as Ix
import           GHC.Generics (Generic)

import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import qualified Game.LambdaHack.Content.ItemKind as IK
import qualified Game.LambdaHack.Content.TileKind as TK
import qualified Game.LambdaHack.Core.Dice as Dice
import           Game.LambdaHack.Definition.Ability (EqpSlot (..))
import qualified Game.LambdaHack.Definition.Ability as Ability
import           Game.LambdaHack.Definition.Defs
import           Game.LambdaHack.Definition.Flavour

-- | 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).
data Item = Item
  { Item -> ItemIdentity
jkind    :: ItemIdentity     -- ^ the kind of the item, or an indirection
  , Item -> Maybe FactionId
jfid     :: Maybe FactionId  -- ^ the faction that created the item, if any
  , Item -> Flavour
jflavour :: Flavour          -- ^ flavour, always the real one,
                                 --   it's not hidden; people may not recognize
                                 --   shape, but they remember colour and old
                                 --   vs fancy look
  }
  deriving (Int -> Item -> ShowS
[Item] -> ShowS
Item -> String
(Int -> Item -> ShowS)
-> (Item -> String) -> ([Item] -> ShowS) -> Show Item
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Item] -> ShowS
$cshowList :: [Item] -> ShowS
show :: Item -> String
$cshow :: Item -> String
showsPrec :: Int -> Item -> ShowS
$cshowsPrec :: Int -> Item -> ShowS
Show, Item -> Item -> Bool
(Item -> Item -> Bool) -> (Item -> Item -> Bool) -> Eq Item
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Item -> Item -> Bool
$c/= :: Item -> Item -> Bool
== :: Item -> Item -> Bool
$c== :: Item -> Item -> Bool
Eq, (forall x. Item -> Rep Item x)
-> (forall x. Rep Item x -> Item) -> Generic Item
forall x. Rep Item x -> Item
forall x. Item -> Rep Item x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Item x -> Item
$cfrom :: forall x. Item -> Rep Item x
Generic)

instance Binary Item

-- | Either the explicit obvious kind of the item or the kind it's hidden under,
-- with the details covered under the index indirection.
data ItemIdentity =
    IdentityObvious (ContentId IK.ItemKind)
  | IdentityCovered ItemKindIx (ContentId IK.ItemKind)
  deriving (Int -> ItemIdentity -> ShowS
[ItemIdentity] -> ShowS
ItemIdentity -> String
(Int -> ItemIdentity -> ShowS)
-> (ItemIdentity -> String)
-> ([ItemIdentity] -> ShowS)
-> Show ItemIdentity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemIdentity] -> ShowS
$cshowList :: [ItemIdentity] -> ShowS
show :: ItemIdentity -> String
$cshow :: ItemIdentity -> String
showsPrec :: Int -> ItemIdentity -> ShowS
$cshowsPrec :: Int -> ItemIdentity -> ShowS
Show, ItemIdentity -> ItemIdentity -> Bool
(ItemIdentity -> ItemIdentity -> Bool)
-> (ItemIdentity -> ItemIdentity -> Bool) -> Eq ItemIdentity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ItemIdentity -> ItemIdentity -> Bool
$c/= :: ItemIdentity -> ItemIdentity -> Bool
== :: ItemIdentity -> ItemIdentity -> Bool
$c== :: ItemIdentity -> ItemIdentity -> Bool
Eq, (forall x. ItemIdentity -> Rep ItemIdentity x)
-> (forall x. Rep ItemIdentity x -> ItemIdentity)
-> Generic ItemIdentity
forall x. Rep ItemIdentity x -> ItemIdentity
forall x. ItemIdentity -> Rep ItemIdentity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ItemIdentity x -> ItemIdentity
$cfrom :: forall x. ItemIdentity -> Rep ItemIdentity x
Generic)

instance Hashable ItemIdentity

instance Binary ItemIdentity

-- | The map of item ids to item aspect record. The full map is known
-- by the server.
type DiscoveryAspect = EM.EnumMap ItemId IA.AspectRecord

-- | 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.
newtype ItemKindIx = ItemKindIx Word16
  deriving (Int -> ItemKindIx -> ShowS
[ItemKindIx] -> ShowS
ItemKindIx -> String
(Int -> ItemKindIx -> ShowS)
-> (ItemKindIx -> String)
-> ([ItemKindIx] -> ShowS)
-> Show ItemKindIx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemKindIx] -> ShowS
$cshowList :: [ItemKindIx] -> ShowS
show :: ItemKindIx -> String
$cshow :: ItemKindIx -> String
showsPrec :: Int -> ItemKindIx -> ShowS
$cshowsPrec :: Int -> ItemKindIx -> ShowS
Show, ItemKindIx -> ItemKindIx -> Bool
(ItemKindIx -> ItemKindIx -> Bool)
-> (ItemKindIx -> ItemKindIx -> Bool) -> Eq ItemKindIx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ItemKindIx -> ItemKindIx -> Bool
$c/= :: ItemKindIx -> ItemKindIx -> Bool
== :: ItemKindIx -> ItemKindIx -> Bool
$c== :: ItemKindIx -> ItemKindIx -> Bool
Eq, Eq ItemKindIx
Eq ItemKindIx
-> (ItemKindIx -> ItemKindIx -> Ordering)
-> (ItemKindIx -> ItemKindIx -> Bool)
-> (ItemKindIx -> ItemKindIx -> Bool)
-> (ItemKindIx -> ItemKindIx -> Bool)
-> (ItemKindIx -> ItemKindIx -> Bool)
-> (ItemKindIx -> ItemKindIx -> ItemKindIx)
-> (ItemKindIx -> ItemKindIx -> ItemKindIx)
-> Ord ItemKindIx
ItemKindIx -> ItemKindIx -> Bool
ItemKindIx -> ItemKindIx -> Ordering
ItemKindIx -> ItemKindIx -> ItemKindIx
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ItemKindIx -> ItemKindIx -> ItemKindIx
$cmin :: ItemKindIx -> ItemKindIx -> ItemKindIx
max :: ItemKindIx -> ItemKindIx -> ItemKindIx
$cmax :: ItemKindIx -> ItemKindIx -> ItemKindIx
>= :: ItemKindIx -> ItemKindIx -> Bool
$c>= :: ItemKindIx -> ItemKindIx -> Bool
> :: ItemKindIx -> ItemKindIx -> Bool
$c> :: ItemKindIx -> ItemKindIx -> Bool
<= :: ItemKindIx -> ItemKindIx -> Bool
$c<= :: ItemKindIx -> ItemKindIx -> Bool
< :: ItemKindIx -> ItemKindIx -> Bool
$c< :: ItemKindIx -> ItemKindIx -> Bool
compare :: ItemKindIx -> ItemKindIx -> Ordering
$ccompare :: ItemKindIx -> ItemKindIx -> Ordering
$cp1Ord :: Eq ItemKindIx
Ord, Int -> ItemKindIx
ItemKindIx -> Int
ItemKindIx -> [ItemKindIx]
ItemKindIx -> ItemKindIx
ItemKindIx -> ItemKindIx -> [ItemKindIx]
ItemKindIx -> ItemKindIx -> ItemKindIx -> [ItemKindIx]
(ItemKindIx -> ItemKindIx)
-> (ItemKindIx -> ItemKindIx)
-> (Int -> ItemKindIx)
-> (ItemKindIx -> Int)
-> (ItemKindIx -> [ItemKindIx])
-> (ItemKindIx -> ItemKindIx -> [ItemKindIx])
-> (ItemKindIx -> ItemKindIx -> [ItemKindIx])
-> (ItemKindIx -> ItemKindIx -> ItemKindIx -> [ItemKindIx])
-> Enum ItemKindIx
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ItemKindIx -> ItemKindIx -> ItemKindIx -> [ItemKindIx]
$cenumFromThenTo :: ItemKindIx -> ItemKindIx -> ItemKindIx -> [ItemKindIx]
enumFromTo :: ItemKindIx -> ItemKindIx -> [ItemKindIx]
$cenumFromTo :: ItemKindIx -> ItemKindIx -> [ItemKindIx]
enumFromThen :: ItemKindIx -> ItemKindIx -> [ItemKindIx]
$cenumFromThen :: ItemKindIx -> ItemKindIx -> [ItemKindIx]
enumFrom :: ItemKindIx -> [ItemKindIx]
$cenumFrom :: ItemKindIx -> [ItemKindIx]
fromEnum :: ItemKindIx -> Int
$cfromEnum :: ItemKindIx -> Int
toEnum :: Int -> ItemKindIx
$ctoEnum :: Int -> ItemKindIx
pred :: ItemKindIx -> ItemKindIx
$cpred :: ItemKindIx -> ItemKindIx
succ :: ItemKindIx -> ItemKindIx
$csucc :: ItemKindIx -> ItemKindIx
Enum, Ord ItemKindIx
Ord ItemKindIx
-> ((ItemKindIx, ItemKindIx) -> [ItemKindIx])
-> ((ItemKindIx, ItemKindIx) -> ItemKindIx -> Int)
-> ((ItemKindIx, ItemKindIx) -> ItemKindIx -> Int)
-> ((ItemKindIx, ItemKindIx) -> ItemKindIx -> Bool)
-> ((ItemKindIx, ItemKindIx) -> Int)
-> ((ItemKindIx, ItemKindIx) -> Int)
-> Ix ItemKindIx
(ItemKindIx, ItemKindIx) -> Int
(ItemKindIx, ItemKindIx) -> [ItemKindIx]
(ItemKindIx, ItemKindIx) -> ItemKindIx -> Bool
(ItemKindIx, ItemKindIx) -> ItemKindIx -> Int
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Int)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> Int)
-> ((a, a) -> Int)
-> Ix a
unsafeRangeSize :: (ItemKindIx, ItemKindIx) -> Int
$cunsafeRangeSize :: (ItemKindIx, ItemKindIx) -> Int
rangeSize :: (ItemKindIx, ItemKindIx) -> Int
$crangeSize :: (ItemKindIx, ItemKindIx) -> Int
inRange :: (ItemKindIx, ItemKindIx) -> ItemKindIx -> Bool
$cinRange :: (ItemKindIx, ItemKindIx) -> ItemKindIx -> Bool
unsafeIndex :: (ItemKindIx, ItemKindIx) -> ItemKindIx -> Int
$cunsafeIndex :: (ItemKindIx, ItemKindIx) -> ItemKindIx -> Int
index :: (ItemKindIx, ItemKindIx) -> ItemKindIx -> Int
$cindex :: (ItemKindIx, ItemKindIx) -> ItemKindIx -> Int
range :: (ItemKindIx, ItemKindIx) -> [ItemKindIx]
$crange :: (ItemKindIx, ItemKindIx) -> [ItemKindIx]
$cp1Ix :: Ord ItemKindIx
Ix.Ix, Eq ItemKindIx
Eq ItemKindIx
-> (Int -> ItemKindIx -> Int)
-> (ItemKindIx -> Int)
-> Hashable ItemKindIx
Int -> ItemKindIx -> Int
ItemKindIx -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ItemKindIx -> Int
$chash :: ItemKindIx -> Int
hashWithSalt :: Int -> ItemKindIx -> Int
$chashWithSalt :: Int -> ItemKindIx -> Int
$cp1Hashable :: Eq ItemKindIx
Hashable, Get ItemKindIx
[ItemKindIx] -> Put
ItemKindIx -> Put
(ItemKindIx -> Put)
-> Get ItemKindIx -> ([ItemKindIx] -> Put) -> Binary ItemKindIx
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [ItemKindIx] -> Put
$cputList :: [ItemKindIx] -> Put
get :: Get ItemKindIx
$cget :: Get ItemKindIx
put :: ItemKindIx -> Put
$cput :: ItemKindIx -> Put
Binary)

-- | 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).
data ItemDisco =
    ItemDiscoFull IA.AspectRecord
  | ItemDiscoMean IA.KindMean
 deriving (Int -> ItemDisco -> ShowS
[ItemDisco] -> ShowS
ItemDisco -> String
(Int -> ItemDisco -> ShowS)
-> (ItemDisco -> String)
-> ([ItemDisco] -> ShowS)
-> Show ItemDisco
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemDisco] -> ShowS
$cshowList :: [ItemDisco] -> ShowS
show :: ItemDisco -> String
$cshow :: ItemDisco -> String
showsPrec :: Int -> ItemDisco -> ShowS
$cshowsPrec :: Int -> ItemDisco -> ShowS
Show, Eq ItemDisco
Eq ItemDisco
-> (ItemDisco -> ItemDisco -> Ordering)
-> (ItemDisco -> ItemDisco -> Bool)
-> (ItemDisco -> ItemDisco -> Bool)
-> (ItemDisco -> ItemDisco -> Bool)
-> (ItemDisco -> ItemDisco -> Bool)
-> (ItemDisco -> ItemDisco -> ItemDisco)
-> (ItemDisco -> ItemDisco -> ItemDisco)
-> Ord ItemDisco
ItemDisco -> ItemDisco -> Bool
ItemDisco -> ItemDisco -> Ordering
ItemDisco -> ItemDisco -> ItemDisco
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ItemDisco -> ItemDisco -> ItemDisco
$cmin :: ItemDisco -> ItemDisco -> ItemDisco
max :: ItemDisco -> ItemDisco -> ItemDisco
$cmax :: ItemDisco -> ItemDisco -> ItemDisco
>= :: ItemDisco -> ItemDisco -> Bool
$c>= :: ItemDisco -> ItemDisco -> Bool
> :: ItemDisco -> ItemDisco -> Bool
$c> :: ItemDisco -> ItemDisco -> Bool
<= :: ItemDisco -> ItemDisco -> Bool
$c<= :: ItemDisco -> ItemDisco -> Bool
< :: ItemDisco -> ItemDisco -> Bool
$c< :: ItemDisco -> ItemDisco -> Bool
compare :: ItemDisco -> ItemDisco -> Ordering
$ccompare :: ItemDisco -> ItemDisco -> Ordering
$cp1Ord :: Eq ItemDisco
Ord, ItemDisco -> ItemDisco -> Bool
(ItemDisco -> ItemDisco -> Bool)
-> (ItemDisco -> ItemDisco -> Bool) -> Eq ItemDisco
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ItemDisco -> ItemDisco -> Bool
$c/= :: ItemDisco -> ItemDisco -> Bool
== :: ItemDisco -> ItemDisco -> Bool
$c== :: ItemDisco -> ItemDisco -> Bool
Eq)

-- No speedup from making fields non-strict.
-- | Full information about an item.
data ItemFull = ItemFull
  { ItemFull -> Item
itemBase    :: Item
  , ItemFull -> ContentId ItemKind
itemKindId  :: ContentId IK.ItemKind
  , ItemFull -> ItemKind
itemKind    :: IK.ItemKind
  , ItemFull -> ItemDisco
itemDisco   :: ItemDisco
  , ItemFull -> Bool
itemSuspect :: Bool
  }
  deriving Int -> ItemFull -> ShowS
[ItemFull] -> ShowS
ItemFull -> String
(Int -> ItemFull -> ShowS)
-> (ItemFull -> String) -> ([ItemFull] -> ShowS) -> Show ItemFull
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemFull] -> ShowS
$cshowList :: [ItemFull] -> ShowS
show :: ItemFull -> String
$cshow :: ItemFull -> String
showsPrec :: Int -> ItemFull -> ShowS
$cshowsPrec :: Int -> ItemFull -> ShowS
Show

type ItemFullKit = (ItemFull, ItemQuant)

-- | 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 DiscoveryKind = EM.EnumMap ItemKindIx (ContentId IK.ItemKind)

-- | 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.
type ItemIxMap = EM.EnumMap ItemKindIx (ES.EnumSet ItemId)

-- | 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
data Benefit = Benefit
  { Benefit -> Bool
benInEqp  :: Bool
  , Benefit -> Double
benPickup :: Double
  , Benefit -> Double
benApply  :: Double
  , Benefit -> Double
benMelee  :: Double
  , Benefit -> Double
benFling  :: Double
  }
  deriving (Int -> Benefit -> ShowS
[Benefit] -> ShowS
Benefit -> String
(Int -> Benefit -> ShowS)
-> (Benefit -> String) -> ([Benefit] -> ShowS) -> Show Benefit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Benefit] -> ShowS
$cshowList :: [Benefit] -> ShowS
show :: Benefit -> String
$cshow :: Benefit -> String
showsPrec :: Int -> Benefit -> ShowS
$cshowsPrec :: Int -> Benefit -> ShowS
Show, (forall x. Benefit -> Rep Benefit x)
-> (forall x. Rep Benefit x -> Benefit) -> Generic Benefit
forall x. Rep Benefit x -> Benefit
forall x. Benefit -> Rep Benefit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Benefit x -> Benefit
$cfrom :: forall x. Benefit -> Rep Benefit x
Generic)

instance Binary Benefit

type DiscoveryBenefit = EM.EnumMap ItemId Benefit

-- | 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.
newtype ItemTimer = ItemTimer {ItemTimer -> Time
itemTimer :: Time}
  deriving (Int -> ItemTimer -> ShowS
[ItemTimer] -> ShowS
ItemTimer -> String
(Int -> ItemTimer -> ShowS)
-> (ItemTimer -> String)
-> ([ItemTimer] -> ShowS)
-> Show ItemTimer
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemTimer] -> ShowS
$cshowList :: [ItemTimer] -> ShowS
show :: ItemTimer -> String
$cshow :: ItemTimer -> String
showsPrec :: Int -> ItemTimer -> ShowS
$cshowsPrec :: Int -> ItemTimer -> ShowS
Show, ItemTimer -> ItemTimer -> Bool
(ItemTimer -> ItemTimer -> Bool)
-> (ItemTimer -> ItemTimer -> Bool) -> Eq ItemTimer
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ItemTimer -> ItemTimer -> Bool
$c/= :: ItemTimer -> ItemTimer -> Bool
== :: ItemTimer -> ItemTimer -> Bool
$c== :: ItemTimer -> ItemTimer -> Bool
Eq, Get ItemTimer
[ItemTimer] -> Put
ItemTimer -> Put
(ItemTimer -> Put)
-> Get ItemTimer -> ([ItemTimer] -> Put) -> Binary ItemTimer
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [ItemTimer] -> Put
$cputList :: [ItemTimer] -> Put
get :: Get ItemTimer
$cget :: Get ItemTimer
put :: ItemTimer -> Put
$cput :: ItemTimer -> Put
Binary)

type ItemTimers = [ItemTimer]

-- | 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 ItemQuant = (Int, ItemTimers)

-- | 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 ItemBag = EM.EnumMap ItemId ItemQuant

-- | All items in the dungeon (including those carried by actors),
-- indexed by item identifier.
type ItemDict = EM.EnumMap ItemId Item

toItemKindIx :: Word16 -> ItemKindIx
{-# INLINE toItemKindIx #-}
toItemKindIx :: Word16 -> ItemKindIx
toItemKindIx = Word16 -> ItemKindIx
ItemKindIx

quantSingle :: ItemQuant
quantSingle :: ItemQuant
quantSingle = (Int
1, [])

itemToFull6 :: COps -> DiscoveryKind -> DiscoveryAspect -> ItemId -> Item
            -> ItemFull
itemToFull6 :: COps
-> DiscoveryKind -> DiscoveryAspect -> ItemId -> Item -> ItemFull
itemToFull6 COps{ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem :: ContentData ItemKind
coitem, ItemSpeedup
coItemSpeedup :: COps -> ItemSpeedup
coItemSpeedup :: ItemSpeedup
coItemSpeedup} DiscoveryKind
discoKind DiscoveryAspect
discoAspect ItemId
iid Item
itemBase =
  let (ContentId ItemKind
itemKindId, Bool
itemSuspect) = case Item -> ItemIdentity
jkind Item
itemBase of
        IdentityObvious ContentId ItemKind
ik -> (ContentId ItemKind
ik, Bool
False)
        IdentityCovered ItemKindIx
ix ContentId ItemKind
ik ->
          (ContentId ItemKind, Bool)
-> (ContentId ItemKind -> (ContentId ItemKind, Bool))
-> Maybe (ContentId ItemKind)
-> (ContentId ItemKind, Bool)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ContentId ItemKind
ik, Bool
True) (, Bool
False) (Maybe (ContentId ItemKind) -> (ContentId ItemKind, Bool))
-> Maybe (ContentId ItemKind) -> (ContentId ItemKind, Bool)
forall a b. (a -> b) -> a -> b
$ ItemKindIx
ix ItemKindIx -> DiscoveryKind -> Maybe (ContentId ItemKind)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` DiscoveryKind
discoKind
      itemKind :: ItemKind
itemKind = ContentData ItemKind -> ContentId ItemKind -> ItemKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ItemKind
coitem ContentId ItemKind
itemKindId
      km :: KindMean
km = ContentId ItemKind -> ItemSpeedup -> KindMean
getKindMean ContentId ItemKind
itemKindId ItemSpeedup
coItemSpeedup
      -- If the kind is not identified, we know nothing about the real
      -- aspect record, so we at least assume they are variable.
      itemAspectMean :: KindMean
itemAspectMean | Bool
itemSuspect = KindMean
km {kmConst :: Bool
IA.kmConst = Bool
False}
                     | Bool
otherwise = KindMean
km
      itemDisco :: ItemDisco
itemDisco = case ItemId -> DiscoveryAspect -> Maybe AspectRecord
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ItemId
iid DiscoveryAspect
discoAspect of
        Just AspectRecord
itemAspect -> AspectRecord -> ItemDisco
ItemDiscoFull AspectRecord
itemAspect
        Maybe AspectRecord
Nothing -> KindMean -> ItemDisco
ItemDiscoMean KindMean
itemAspectMean
  in ItemFull :: Item
-> ContentId ItemKind -> ItemKind -> ItemDisco -> Bool -> ItemFull
ItemFull {Bool
ContentId ItemKind
ItemKind
ItemDisco
Item
itemDisco :: ItemDisco
itemKind :: ItemKind
itemSuspect :: Bool
itemKindId :: ContentId ItemKind
itemBase :: Item
itemSuspect :: Bool
itemDisco :: ItemDisco
itemKind :: ItemKind
itemKindId :: ContentId ItemKind
itemBase :: Item
..}

aspectRecordFull :: ItemFull -> IA.AspectRecord
aspectRecordFull :: ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull =
  case ItemFull -> ItemDisco
itemDisco ItemFull
itemFull of
    ItemDiscoFull AspectRecord
itemAspect -> AspectRecord
itemAspect
    ItemDiscoMean KindMean
itemAspectMean -> KindMean -> AspectRecord
IA.kmMean KindMean
itemAspectMean

-- This ignores items that don't go into equipment, as determined in @benInEqp@.
-- They are removed from equipment elsewhere via @harmful@.
strongestSlot :: DiscoveryBenefit -> Ability.EqpSlot -> [(ItemId, ItemFullKit)]
              -> [(Int, (ItemId, ItemFullKit))]
strongestSlot :: DiscoveryBenefit
-> EqpSlot
-> [(ItemId, ItemFullKit)]
-> [(Int, (ItemId, ItemFullKit))]
strongestSlot DiscoveryBenefit
discoBenefit EqpSlot
eqpSlot [(ItemId, ItemFullKit)]
is =
  let f :: (ItemId, ItemFullKit) -> Maybe (Int, (ItemId, ItemFullKit))
f (ItemId
iid, (ItemFull
itemFull, ItemQuant
kit)) =
        let Benefit{Bool
benInEqp :: Bool
benInEqp :: Benefit -> Bool
benInEqp, Double
benPickup :: Double
benPickup :: Benefit -> Double
benPickup, Double
benMelee :: Double
benMelee :: Benefit -> Double
benMelee} = DiscoveryBenefit
discoBenefit DiscoveryBenefit -> ItemId -> Benefit
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
        in if Bool -> Bool
not Bool
benInEqp
           then Maybe (Int, (ItemId, ItemFullKit))
forall a. Maybe a
Nothing
           else (Int, (ItemId, ItemFullKit)) -> Maybe (Int, (ItemId, ItemFullKit))
forall a. a -> Maybe a
Just ((Int, (ItemId, ItemFullKit))
 -> Maybe (Int, (ItemId, ItemFullKit)))
-> (Int, (ItemId, ItemFullKit))
-> Maybe (Int, (ItemId, ItemFullKit))
forall a b. (a -> b) -> a -> b
$
             let ben :: Int
ben = case EqpSlot
eqpSlot of
                   EqpSlot
EqpSlotWeaponFast ->
                       -- For equipping/unequipping the main reliable weapon,
                       -- we take into account not only melee damage,
                       -- but also timeout, aspects, etc.
                       Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling Double
benPickup
                   EqpSlot
EqpSlotWeaponBig ->
                       -- For equipping/unequipping the one-shot big hitter
                       -- weapon, we take into account only melee damage
                       -- and we don't even care if it's durable.
                       -- The backup is ready in the slot above, after all.
                       Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (- Double
benMelee)
                   EqpSlot
_ -> EqpSlot -> AspectRecord -> Int
valueAtEqpSlot EqpSlot
eqpSlot (AspectRecord -> Int) -> AspectRecord -> Int
forall a b. (a -> b) -> a -> b
$ ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
                 idBonus :: Int
idBonus = if ItemFull -> Bool
itemSuspect ItemFull
itemFull then Int
1000 else Int
0
                 arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
                 -- Equip good uniques for flavour and fun from unique effects.
                 uniqueBonus :: Int
uniqueBonus = if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Unique AspectRecord
arItem Bool -> Bool -> Bool
&& Int
ben Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
20
                               then Int
1000
                               else Int
0
             in (Int
ben Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
idBonus Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
uniqueBonus, (ItemId
iid, (ItemFull
itemFull, ItemQuant
kit)))
  in ((Int, (ItemId, ItemFullKit))
 -> (Int, (ItemId, ItemFullKit)) -> Ordering)
-> [(Int, (ItemId, ItemFullKit))] -> [(Int, (ItemId, ItemFullKit))]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Int, (ItemId, ItemFullKit))
 -> (Int, (ItemId, ItemFullKit)) -> Ordering)
-> (Int, (ItemId, ItemFullKit))
-> (Int, (ItemId, ItemFullKit))
-> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip (((Int, (ItemId, ItemFullKit))
  -> (Int, (ItemId, ItemFullKit)) -> Ordering)
 -> (Int, (ItemId, ItemFullKit))
 -> (Int, (ItemId, ItemFullKit))
 -> Ordering)
-> ((Int, (ItemId, ItemFullKit))
    -> (Int, (ItemId, ItemFullKit)) -> Ordering)
-> (Int, (ItemId, ItemFullKit))
-> (Int, (ItemId, ItemFullKit))
-> Ordering
forall a b. (a -> b) -> a -> b
$ ((Int, (ItemId, ItemFullKit)) -> Int)
-> (Int, (ItemId, ItemFullKit))
-> (Int, (ItemId, ItemFullKit))
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Int, (ItemId, ItemFullKit)) -> Int
forall a b. (a, b) -> a
fst) ([(Int, (ItemId, ItemFullKit))] -> [(Int, (ItemId, ItemFullKit))])
-> [(Int, (ItemId, ItemFullKit))] -> [(Int, (ItemId, ItemFullKit))]
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemFullKit) -> Maybe (Int, (ItemId, ItemFullKit)))
-> [(ItemId, ItemFullKit)] -> [(Int, (ItemId, ItemFullKit))]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ItemId, ItemFullKit) -> Maybe (Int, (ItemId, ItemFullKit))
f [(ItemId, ItemFullKit)]
is

valueAtEqpSlot :: EqpSlot -> IA.AspectRecord -> Int
valueAtEqpSlot :: EqpSlot -> AspectRecord -> Int
valueAtEqpSlot EqpSlot
eqpSlot arItem :: AspectRecord
arItem@IA.AspectRecord{Int
Maybe EqpSlot
Maybe (GroupName ItemKind)
Text
Flags
Skills
ThrowMod
aEqpSlot :: AspectRecord -> Maybe EqpSlot
aPresentAs :: AspectRecord -> Maybe (GroupName ItemKind)
aToThrow :: AspectRecord -> ThrowMod
aELabel :: AspectRecord -> Text
aFlags :: AspectRecord -> Flags
aSkills :: AspectRecord -> Skills
aTimeout :: AspectRecord -> Int
aEqpSlot :: Maybe EqpSlot
aPresentAs :: Maybe (GroupName ItemKind)
aToThrow :: ThrowMod
aELabel :: Text
aFlags :: Flags
aSkills :: Skills
aTimeout :: Int
..} =
  case EqpSlot
eqpSlot of
    EqpSlot
EqpSlotMove -> Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMove Skills
aSkills
    EqpSlot
EqpSlotMelee -> Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMelee Skills
aSkills
    EqpSlot
EqpSlotDisplace -> Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkDisplace Skills
aSkills
    EqpSlot
EqpSlotAlter -> Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkAlter Skills
aSkills
    EqpSlot
EqpSlotWait -> Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkWait Skills
aSkills
    EqpSlot
EqpSlotMoveItem -> Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMoveItem Skills
aSkills
    EqpSlot
EqpSlotProject -> Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkProject Skills
aSkills
    EqpSlot
EqpSlotApply -> Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkApply Skills
aSkills
    EqpSlot
EqpSlotSwimming -> Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSwimming Skills
aSkills
    EqpSlot
EqpSlotFlying -> Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkFlying Skills
aSkills
    EqpSlot
EqpSlotHurtMelee -> Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkHurtMelee Skills
aSkills
    EqpSlot
EqpSlotArmorMelee -> Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkArmorMelee Skills
aSkills
    EqpSlot
EqpSlotArmorRanged -> Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkArmorRanged Skills
aSkills
    EqpSlot
EqpSlotMaxHP -> Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxHP Skills
aSkills
    EqpSlot
EqpSlotSpeed -> Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSpeed Skills
aSkills
    EqpSlot
EqpSlotSight -> Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSight Skills
aSkills
    EqpSlot
EqpSlotShine -> Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkShine Skills
aSkills
    EqpSlot
EqpSlotMiscBonus ->
      Int
aTimeout  -- usually better items have longer timeout
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxCalm Skills
aSkills
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSmell Skills
aSkills
      Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkNocto Skills
aSkills
          -- powerful, but hard to boost over aSight
    EqpSlot
EqpSlotWeaponFast -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
"" String -> AspectRecord -> String
forall v. Show v => String -> v -> String
`showFailure` AspectRecord
arItem  -- sum of all benefits
    EqpSlot
EqpSlotWeaponBig -> String -> Int
forall a. HasCallStack => String -> a
error (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
"" String -> AspectRecord -> String
forall v. Show v => String -> v -> String
`showFailure` AspectRecord
arItem  -- sum of all benefits

itemTimerZero :: ItemTimer
itemTimerZero :: ItemTimer
itemTimerZero = Time -> ItemTimer
ItemTimer Time
timeZero

createItemTimer :: Time -> Delta Time -> ItemTimer
createItemTimer :: Time -> Delta Time -> ItemTimer
createItemTimer Time
localTime Delta Time
delta = Time -> ItemTimer
ItemTimer (Time -> ItemTimer) -> Time -> ItemTimer
forall a b. (a -> b) -> a -> b
$ Time
localTime Time -> Delta Time -> Time
`timeShift` Delta Time
delta

shiftItemTimer :: Delta Time -> ItemTimer -> ItemTimer
shiftItemTimer :: Delta Time -> ItemTimer -> ItemTimer
shiftItemTimer Delta Time
delta ItemTimer
t = Time -> ItemTimer
ItemTimer (Time -> ItemTimer) -> Time -> ItemTimer
forall a b. (a -> b) -> a -> b
$ ItemTimer -> Time
itemTimer ItemTimer
t Time -> Delta Time -> Time
`timeShift` Delta Time
delta

deltaOfItemTimer :: Time -> ItemTimer -> Delta Time
deltaOfItemTimer :: Time -> ItemTimer -> Delta Time
deltaOfItemTimer Time
localTime ItemTimer
t = Time -> Time -> Delta Time
timeDeltaToFrom (ItemTimer -> Time
itemTimer ItemTimer
t) Time
localTime

charging :: Time -> ItemTimer -> Bool
charging :: Time -> ItemTimer -> Bool
charging Time
localTime = (Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
localTime) (Time -> Bool) -> (ItemTimer -> Time) -> ItemTimer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemTimer -> Time
itemTimer

ncharges :: Time -> ItemQuant -> Int
ncharges :: Time -> ItemQuant -> Int
ncharges Time
localTime (Int
itemK, [ItemTimer]
itemTimers) =
  Int
itemK Int -> Int -> Int
forall a. Num a => a -> a -> a
- [ItemTimer] -> Int
forall a. [a] -> Int
length ((ItemTimer -> Bool) -> [ItemTimer] -> [ItemTimer]
forall a. (a -> Bool) -> [a] -> [a]
filter (Time -> ItemTimer -> Bool
charging Time
localTime) [ItemTimer]
itemTimers)

hasCharge :: Time -> ItemQuant -> Bool
hasCharge :: Time -> ItemQuant -> Bool
hasCharge Time
localTime ItemQuant
kit = Time -> ItemQuant -> Int
ncharges Time
localTime ItemQuant
kit Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0

strongestMelee :: Bool -> Maybe DiscoveryBenefit -> Time
               -> [(ItemId, ItemFullKit)]
               -> [(Double, Bool, Int, Int, ItemId, ItemFullKit)]
strongestMelee :: Bool
-> Maybe DiscoveryBenefit
-> Time
-> [(ItemId, ItemFullKit)]
-> [(Double, Bool, Int, Int, ItemId, ItemFullKit)]
strongestMelee Bool
_ Maybe DiscoveryBenefit
_ Time
_ [] = []
strongestMelee Bool
ignoreCharges Maybe DiscoveryBenefit
mdiscoBenefit Time
localTime [(ItemId, ItemFullKit)]
kitAss =
  -- For fighting, as opposed to equipping, we value weapon only for
  -- its raw damage and harming effects and at this very moment only,
  -- not in the future. Hehce, we exclude discharged weapons.
  let f :: (ItemId, ItemFullKit)
-> Maybe (Double, Bool, Int, Int, ItemId, ItemFullKit)
f (ItemId
iid, ifk :: ItemFullKit
ifk@(ItemFull
itemFull, ItemQuant
kit)) =
        let rawDmg :: Double
rawDmg = ItemKind -> Double
IK.damageUsefulness (ItemKind -> Double) -> ItemKind -> Double
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFull
            unIDedBonus :: Double
unIDedBonus = if ItemFull -> Bool
itemSuspect ItemFull
itemFull then Double
1000 else Double
0
            totalValue :: Double
totalValue = case Maybe DiscoveryBenefit
mdiscoBenefit of
              Just DiscoveryBenefit
discoBenefit ->
                let Benefit{Double
benMelee :: Double
benMelee :: Benefit -> Double
benMelee} = DiscoveryBenefit
discoBenefit DiscoveryBenefit -> ItemId -> Benefit
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
                in Double
benMelee Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
unIDedBonus
              Maybe DiscoveryBenefit
Nothing -> - Double
rawDmg  -- special case: not interested about ID
            arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
            timeout :: Int
timeout = AspectRecord -> Int
IA.aTimeout AspectRecord
arItem
            -- This is crucial for weapons for which AI is too silly
            -- to value the effects at more than 0, even though they are strong
            -- and also to prefer weapons with burn or wound over pure damage,
            -- which is a good rule of thumb before late game at least.
            hasEffect :: Bool
hasEffect = (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Effect -> Bool
IK.forApplyEffect
                            (ItemKind -> [Effect]
IK.ieffects (ItemKind -> [Effect]) -> ItemKind -> [Effect]
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFull)
            ncha :: Int
ncha = Time -> ItemQuant -> Int
ncharges Time
localTime ItemQuant
kit
        in if Bool
ignoreCharges Bool -> Bool -> Bool
|| Int
ncha Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
           then (Double, Bool, Int, Int, ItemId, ItemFullKit)
-> Maybe (Double, Bool, Int, Int, ItemId, ItemFullKit)
forall a. a -> Maybe a
Just (Double
totalValue, Bool
hasEffect, Int
timeout, Int
ncha, ItemId
iid, ItemFullKit
ifk)
           else Maybe (Double, Bool, Int, Int, ItemId, ItemFullKit)
forall a. Maybe a
Nothing
  -- We can't filter out weapons that are not harmful to victim
  -- (@benMelee >= 0), because actors use them if nothing else available,
  -- e.g., geysers, bees. This is intended and fun.
  in ((Double, Bool, Int, Int, ItemId, ItemFullKit)
 -> (Double, Bool, Int, ContentId ItemKind))
-> [(Double, Bool, Int, Int, ItemId, ItemFullKit)]
-> [(Double, Bool, Int, Int, ItemId, ItemFullKit)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\(Double
value, Bool
hasEffect, Int
timeout, Int
_, ItemId
_, (ItemFull
itemFull, ItemQuant
_)) ->
                -- Weapon with higher timeout activated first to increase
                -- the chance of using it again during this fight.
                -- No timeout is ever better, because no wait incurred.
                -- Optimal packing problem: start with the biggest.
                let timN :: Int
timN = if Int
timeout Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then -Int
99999 else - Int
timeout
                in (Double
value, Bool -> Bool
not Bool
hasEffect, Int
timN, ItemFull -> ContentId ItemKind
itemKindId ItemFull
itemFull))
            (((ItemId, ItemFullKit)
 -> Maybe (Double, Bool, Int, Int, ItemId, ItemFullKit))
-> [(ItemId, ItemFullKit)]
-> [(Double, Bool, Int, Int, ItemId, ItemFullKit)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ItemId, ItemFullKit)
-> Maybe (Double, Bool, Int, Int, ItemId, ItemFullKit)
f [(ItemId, ItemFullKit)]
kitAss)

unknownAspect :: (IK.Aspect -> [Dice.Dice]) -> ItemFull -> Bool
unknownAspect :: (Aspect -> [Dice]) -> ItemFull -> Bool
unknownAspect Aspect -> [Dice]
f itemFull :: ItemFull
itemFull@ItemFull{itemKind :: ItemFull -> ItemKind
itemKind=IK.ItemKind{[Aspect]
iaspects :: ItemKind -> [Aspect]
iaspects :: [Aspect]
iaspects}, Bool
ContentId ItemKind
ItemDisco
Item
itemSuspect :: Bool
itemDisco :: ItemDisco
itemKindId :: ContentId ItemKind
itemBase :: Item
itemSuspect :: ItemFull -> Bool
itemDisco :: ItemFull -> ItemDisco
itemKindId :: ItemFull -> ContentId ItemKind
itemBase :: ItemFull -> Item
..} =
  case ItemDisco
itemDisco of
    ItemDiscoMean IA.KindMean{Bool
kmConst :: Bool
kmConst :: KindMean -> Bool
kmConst} ->
      let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
          unknown :: Dice -> Bool
unknown Dice
x = let (Int
minD, Int
maxD) = Dice -> (Int, Int)
Dice.infsupDice Dice
x
                      in Int
minD Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
maxD
      in Bool
itemSuspect Bool -> Bool -> Bool
&& Bool -> Bool
not (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.MinorAspects AspectRecord
arItem)
         Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
kmConst Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or ((Aspect -> [Bool]) -> [Aspect] -> [Bool]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Dice -> Bool) -> [Dice] -> [Bool]
forall a b. (a -> b) -> [a] -> [b]
map Dice -> Bool
unknown ([Dice] -> [Bool]) -> (Aspect -> [Dice]) -> Aspect -> [Bool]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Aspect -> [Dice]
f) [Aspect]
iaspects)
    ItemDiscoFull{} -> Bool
False  -- all known

-- We assume @SkHurtMelee@ never appears inside @Odds@. If it does,
-- not much harm.
unknownMeleeBonus :: [ItemFull] -> Bool
unknownMeleeBonus :: [ItemFull] -> Bool
unknownMeleeBonus =
  let p :: Aspect -> [Dice]
p (IK.AddSkill Skill
Ability.SkHurtMelee Dice
k) = [Dice
k]
      p Aspect
_ = []
      f :: ItemFull -> Bool -> Bool
f ItemFull
itemFull Bool
b = Bool
b Bool -> Bool -> Bool
|| (Aspect -> [Dice]) -> ItemFull -> Bool
unknownAspect Aspect -> [Dice]
p ItemFull
itemFull
  in (ItemFull -> Bool -> Bool) -> Bool -> [ItemFull] -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ItemFull -> Bool -> Bool
f Bool
False

-- We assume @SkSpeed@ never appears inside @Odds@. If it does,
-- not much harm.
unknownSpeedBonus :: [ItemFull] -> Bool
unknownSpeedBonus :: [ItemFull] -> Bool
unknownSpeedBonus =
  let p :: Aspect -> [Dice]
p (IK.AddSkill Skill
Ability.SkSpeed Dice
k) = [Dice
k]
      p Aspect
_ = []
      f :: ItemFull -> Bool -> Bool
f ItemFull
itemFull Bool
b = Bool
b Bool -> Bool -> Bool
|| (Aspect -> [Dice]) -> ItemFull -> Bool
unknownAspect Aspect -> [Dice]
p ItemFull
itemFull
  in (ItemFull -> Bool -> Bool) -> Bool -> [ItemFull] -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ItemFull -> Bool -> Bool
f Bool
False

conditionMeleeBonus :: [ItemFullKit] -> Int
conditionMeleeBonus :: [ItemFullKit] -> Int
conditionMeleeBonus [ItemFullKit]
kitAss =
  let f :: (ItemFull, (Int, b)) -> Int -> Int
f (ItemFull
itemFull, (Int
itemK, b
_)) Int
k =
        let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
        in if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition AspectRecord
arItem
           then Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
itemK Int -> Int -> Int
forall a. Num a => a -> a -> a
* Skill -> AspectRecord -> Int
IA.getSkill Skill
Ability.SkHurtMelee AspectRecord
arItem
           else Int
k
  in (ItemFullKit -> Int -> Int) -> Int -> [ItemFullKit] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ItemFullKit -> Int -> Int
forall b. (ItemFull, (Int, b)) -> Int -> Int
f Int
0 [ItemFullKit]
kitAss

conditionSpeedBonus :: [ItemFullKit] -> Int
conditionSpeedBonus :: [ItemFullKit] -> Int
conditionSpeedBonus [ItemFullKit]
kitAss =
  let f :: (ItemFull, (Int, b)) -> Int -> Int
f (ItemFull
itemFull, (Int
itemK, b
_)) Int
k =
        let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
        in if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition AspectRecord
arItem
           then Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
itemK Int -> Int -> Int
forall a. Num a => a -> a -> a
* Skill -> AspectRecord -> Int
IA.getSkill Skill
Ability.SkSpeed AspectRecord
arItem
           else Int
k
  in (ItemFullKit -> Int -> Int) -> Int -> [ItemFullKit] -> Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ItemFullKit -> Int -> Int
forall b. (ItemFull, (Int, b)) -> Int -> Int
f Int
0 [ItemFullKit]
kitAss

-- | 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.
armorHurtCalculation :: Bool -> Ability.Skills -> Ability.Skills -> Int
armorHurtCalculation :: Bool -> Skills -> Skills -> Int
armorHurtCalculation Bool
proj Skills
sMaxSk Skills
tMaxSk =
  let trim200 :: a -> a
trim200 a
n = a -> a -> a
forall a. Ord a => a -> a -> a
min a
200 (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Ord a => a -> a -> a
max (-a
200) a
n
      itemBonus :: Int
itemBonus =
        Int -> Int
forall a. (Ord a, Num a) => a -> a
trim200 (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkHurtMelee Skills
sMaxSk)
        Int -> Int -> Int
forall a. Num a => a -> a -> a
- if Bool
proj
          then Int -> Int
forall a. (Ord a, Num a) => a -> a
trim200 (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkArmorRanged Skills
tMaxSk)
          else Int -> Int
forall a. (Ord a, Num a) => a -> a
trim200 (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkArmorMelee Skills
tMaxSk)
  in Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (-Int
95) Int
itemBonus  -- at least 5% of damage gets through

mergeItemQuant :: ItemQuant -> ItemQuant -> ItemQuant
mergeItemQuant :: ItemQuant -> ItemQuant -> ItemQuant
mergeItemQuant (Int
k2, [ItemTimer]
it2) (Int
k1, [ItemTimer]
it1) = (Int
k1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k2, [ItemTimer]
it1 [ItemTimer] -> [ItemTimer] -> [ItemTimer]
forall a. [a] -> [a] -> [a]
++ [ItemTimer]
it2)

listToolsToConsume :: [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
                   -> [((CStore, Bool), (ItemId, ItemFullKit))]
listToolsToConsume :: [(ItemId, ItemFullKit)]
-> [(ItemId, ItemFullKit)]
-> [((CStore, Bool), (ItemId, ItemFullKit))]
listToolsToConsume [(ItemId, ItemFullKit)]
kitAssG [(ItemId, ItemFullKit)]
kitAssE =
  let isDurable :: (a, (ItemFull, b)) -> Bool
isDurable = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Durable
                  (AspectRecord -> Bool)
-> ((a, (ItemFull, b)) -> AspectRecord)
-> (a, (ItemFull, b))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemFull -> AspectRecord
aspectRecordFull (ItemFull -> AspectRecord)
-> ((a, (ItemFull, b)) -> ItemFull)
-> (a, (ItemFull, b))
-> AspectRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemFull, b) -> ItemFull
forall a b. (a, b) -> a
fst ((ItemFull, b) -> ItemFull)
-> ((a, (ItemFull, b)) -> (ItemFull, b))
-> (a, (ItemFull, b))
-> ItemFull
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, (ItemFull, b)) -> (ItemFull, b)
forall a b. (a, b) -> b
snd
      ([(ItemId, ItemFullKit)]
kitAssGT, [(ItemId, ItemFullKit)]
kitAssGF) = ((ItemId, ItemFullKit) -> Bool)
-> [(ItemId, ItemFullKit)]
-> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (ItemId, ItemFullKit) -> Bool
forall a b. (a, (ItemFull, b)) -> Bool
isDurable [(ItemId, ItemFullKit)]
kitAssG
      ([(ItemId, ItemFullKit)]
kitAssET, [(ItemId, ItemFullKit)]
kitAssEF) = ((ItemId, ItemFullKit) -> Bool)
-> [(ItemId, ItemFullKit)]
-> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (ItemId, ItemFullKit) -> Bool
forall a b. (a, (ItemFull, b)) -> Bool
isDurable [(ItemId, ItemFullKit)]
kitAssE
      -- Non-durable tools take precedence, because durable
      -- are applied and, usually being weapons,
      -- may be harmful or may have unintended effects.
      -- CGround takes precedence, too.
  in [(CStore, Bool)]
-> [(ItemId, ItemFullKit)]
-> [((CStore, Bool), (ItemId, ItemFullKit))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((CStore, Bool) -> [(CStore, Bool)]
forall a. a -> [a]
repeat (CStore
CGround, Bool
False)) [(ItemId, ItemFullKit)]
kitAssGF
     [((CStore, Bool), (ItemId, ItemFullKit))]
-> [((CStore, Bool), (ItemId, ItemFullKit))]
-> [((CStore, Bool), (ItemId, ItemFullKit))]
forall a. [a] -> [a] -> [a]
++ [(CStore, Bool)]
-> [(ItemId, ItemFullKit)]
-> [((CStore, Bool), (ItemId, ItemFullKit))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((CStore, Bool) -> [(CStore, Bool)]
forall a. a -> [a]
repeat (CStore
CEqp, Bool
False)) [(ItemId, ItemFullKit)]
kitAssEF
     [((CStore, Bool), (ItemId, ItemFullKit))]
-> [((CStore, Bool), (ItemId, ItemFullKit))]
-> [((CStore, Bool), (ItemId, ItemFullKit))]
forall a. [a] -> [a] -> [a]
++ [(CStore, Bool)]
-> [(ItemId, ItemFullKit)]
-> [((CStore, Bool), (ItemId, ItemFullKit))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((CStore, Bool) -> [(CStore, Bool)]
forall a. a -> [a]
repeat (CStore
CGround, Bool
True)) [(ItemId, ItemFullKit)]
kitAssGT
     [((CStore, Bool), (ItemId, ItemFullKit))]
-> [((CStore, Bool), (ItemId, ItemFullKit))]
-> [((CStore, Bool), (ItemId, ItemFullKit))]
forall a. [a] -> [a] -> [a]
++ [(CStore, Bool)]
-> [(ItemId, ItemFullKit)]
-> [((CStore, Bool), (ItemId, ItemFullKit))]
forall a b. [a] -> [b] -> [(a, b)]
zip ((CStore, Bool) -> [(CStore, Bool)]
forall a. a -> [a]
repeat (CStore
CEqp, Bool
True)) [(ItemId, ItemFullKit)]
kitAssET

countIidConsumed :: ItemFullKit
                 -> [(Bool, Int, GroupName IK.ItemKind)]
                 -> (Int, Int, [(Bool, Int, GroupName IK.ItemKind)])
countIidConsumed :: ItemFullKit
-> [(Bool, Int, GroupName ItemKind)]
-> (Int, Int, [(Bool, Int, GroupName ItemKind)])
countIidConsumed (ItemFull{ItemKind
itemKind :: ItemKind
itemKind :: ItemFull -> ItemKind
itemKind}, (Int
k, [ItemTimer]
_)) [(Bool, Int, GroupName ItemKind)]
grps0 =
  let hasGroup :: GroupName ItemKind -> Bool
hasGroup GroupName ItemKind
grp =
        Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ GroupName ItemKind -> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup GroupName ItemKind
grp ([(GroupName ItemKind, Int)] -> Maybe Int)
-> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ItemKind -> [(GroupName ItemKind, Int)]
IK.ifreq ItemKind
itemKind
      matchGroup :: (Int, Int, [(Bool, Int, GroupName ItemKind)])
-> (Bool, Int, GroupName ItemKind)
-> (Int, Int, [(Bool, Int, GroupName ItemKind)])
matchGroup (Int
nToApplyIfDurable, Int
nToDestroyAlways, [(Bool, Int, GroupName ItemKind)]
grps)
                 (Bool
destroyAlways, Int
n, GroupName ItemKind
grp) =
        if GroupName ItemKind -> Bool
hasGroup GroupName ItemKind
grp
        then let mkn :: Int
mkn = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
k Int
n  -- even if durable, use each copy only once
                 grps2 :: [(Bool, Int, GroupName ItemKind)]
grps2 = if Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
mkn Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                         then (Bool
destroyAlways, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
mkn, GroupName ItemKind
grp) (Bool, Int, GroupName ItemKind)
-> [(Bool, Int, GroupName ItemKind)]
-> [(Bool, Int, GroupName ItemKind)]
forall a. a -> [a] -> [a]
: [(Bool, Int, GroupName ItemKind)]
grps
                         else [(Bool, Int, GroupName ItemKind)]
grps
             in if Bool
destroyAlways
                then ( Int
nToApplyIfDurable
                     , Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
nToDestroyAlways Int
mkn
                     , [(Bool, Int, GroupName ItemKind)]
grps2 )
                else ( Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
nToApplyIfDurable Int
mkn
                     , Int
nToDestroyAlways
                     , [(Bool, Int, GroupName ItemKind)]
grps2 )
        else ( Int
nToApplyIfDurable
             , Int
nToDestroyAlways
             , (Bool
destroyAlways, Int
n, GroupName ItemKind
grp) (Bool, Int, GroupName ItemKind)
-> [(Bool, Int, GroupName ItemKind)]
-> [(Bool, Int, GroupName ItemKind)]
forall a. a -> [a] -> [a]
: [(Bool, Int, GroupName ItemKind)]
grps )
  in ((Int, Int, [(Bool, Int, GroupName ItemKind)])
 -> (Bool, Int, GroupName ItemKind)
 -> (Int, Int, [(Bool, Int, GroupName ItemKind)]))
-> (Int, Int, [(Bool, Int, GroupName ItemKind)])
-> [(Bool, Int, GroupName ItemKind)]
-> (Int, Int, [(Bool, Int, GroupName ItemKind)])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Int, Int, [(Bool, Int, GroupName ItemKind)])
-> (Bool, Int, GroupName ItemKind)
-> (Int, Int, [(Bool, Int, GroupName ItemKind)])
matchGroup (Int
0, Int
0, []) [(Bool, Int, GroupName ItemKind)]
grps0

subtractIidfromGrps :: ( EM.EnumMap CStore ItemBag
                       , [(CStore, (ItemId, ItemFull))]
                       , [(Bool, Int, GroupName IK.ItemKind)] )
                    -> ((CStore, Bool), (ItemId, ItemFullKit))
                    -> ( EM.EnumMap CStore ItemBag
                       , [(CStore, (ItemId, ItemFull))]
                       , [(Bool, Int, GroupName IK.ItemKind)] )
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)])
subtractIidfromGrps (EnumMap CStore ItemBag
bagsToLose1, [(CStore, (ItemId, ItemFull))]
iidsToApply1, [(Bool, Int, GroupName ItemKind)]
grps1)
                    ((CStore
store, Bool
durable), (ItemId
iid, itemFullKit :: ItemFullKit
itemFullKit@(ItemFull
itemFull, (Int
_, [ItemTimer]
it)))) =
  let (Int
nToApplyIfDurable, Int
nToDestroyAlways, [(Bool, Int, GroupName ItemKind)]
grps2) =
        ItemFullKit
-> [(Bool, Int, GroupName ItemKind)]
-> (Int, Int, [(Bool, Int, GroupName ItemKind)])
countIidConsumed ItemFullKit
itemFullKit [(Bool, Int, GroupName ItemKind)]
grps1
      (Int
nToApply, Int
nToDestroy) = if Bool
durable
                               then (Int
nToApplyIfDurable, Int
nToDestroyAlways)
                               else (Int
0, Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
nToApplyIfDurable Int
nToDestroyAlways)
  in ( if Int
nToDestroy Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
       then EnumMap CStore ItemBag
bagsToLose1  -- avoid vacuus @UpdDestroyItem@
       else let kit2 :: ItemQuant
kit2 = (Int
nToDestroy, Int -> [ItemTimer] -> [ItemTimer]
forall a. Int -> [a] -> [a]
take Int
nToDestroy [ItemTimer]
it)
                removedBags :: EnumMap CStore ItemBag
removedBags = CStore -> ItemBag -> EnumMap CStore ItemBag
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton CStore
store (ItemBag -> EnumMap CStore ItemBag)
-> ItemBag -> EnumMap CStore ItemBag
forall a b. (a -> b) -> a -> b
$ ItemId -> ItemQuant -> ItemBag
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton ItemId
iid ItemQuant
kit2
            in (ItemBag -> ItemBag -> ItemBag)
-> EnumMap CStore ItemBag
-> EnumMap CStore ItemBag
-> EnumMap CStore ItemBag
forall a k.
(a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
EM.unionWith ((ItemQuant -> ItemQuant -> ItemQuant)
-> ItemBag -> ItemBag -> ItemBag
forall a k.
(a -> a -> a) -> EnumMap k a -> EnumMap k a -> EnumMap k a
EM.unionWith ItemQuant -> ItemQuant -> ItemQuant
mergeItemQuant)
                            EnumMap CStore ItemBag
removedBags EnumMap CStore ItemBag
bagsToLose1
     , Int
-> (CStore, (ItemId, ItemFull)) -> [(CStore, (ItemId, ItemFull))]
forall a. Int -> a -> [a]
replicate Int
nToApply (CStore
store, (ItemId
iid, ItemFull
itemFull)) [(CStore, (ItemId, ItemFull))]
-> [(CStore, (ItemId, ItemFull))] -> [(CStore, (ItemId, ItemFull))]
forall a. [a] -> [a] -> [a]
++ [(CStore, (ItemId, ItemFull))]
iidsToApply1
     , [(Bool, Int, GroupName ItemKind)]
grps2 )

sortIids :: (ItemId -> ItemFull)
         -> [(ItemId, ItemQuant)]
         -> [(ItemId, ItemQuant)]
sortIids :: (ItemId -> ItemFull)
-> [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
sortIids ItemId -> ItemFull
itemToF =
  -- If appearance and aspects the same, keep the order from before sort.
  let kindAndAppearance :: (ItemId, ItemQuant)
-> (Bool, ContentId ItemKind, ItemDisco, ContentSymbol ItemKind,
    Text, Flavour, Maybe FactionId)
kindAndAppearance (ItemId
iid, ItemQuant
_) =
        let ItemFull{itemBase :: ItemFull -> Item
itemBase=Item{Maybe FactionId
Flavour
ItemIdentity
jflavour :: Flavour
jfid :: Maybe FactionId
jkind :: ItemIdentity
jflavour :: Item -> Flavour
jfid :: Item -> Maybe FactionId
jkind :: Item -> ItemIdentity
..}, Bool
ContentId ItemKind
ItemKind
ItemDisco
itemSuspect :: Bool
itemDisco :: ItemDisco
itemKind :: ItemKind
itemKindId :: ContentId ItemKind
itemSuspect :: ItemFull -> Bool
itemDisco :: ItemFull -> ItemDisco
itemKind :: ItemFull -> ItemKind
itemKindId :: ItemFull -> ContentId ItemKind
..} = ItemId -> ItemFull
itemToF ItemId
iid
        in ( Bool -> Bool
not Bool
itemSuspect, ContentId ItemKind
itemKindId, ItemDisco
itemDisco
           , ItemKind -> ContentSymbol ItemKind
IK.isymbol ItemKind
itemKind, ItemKind -> Text
IK.iname ItemKind
itemKind
           , Flavour
jflavour, Maybe FactionId
jfid )
  in ((ItemId, ItemQuant)
 -> (Bool, ContentId ItemKind, ItemDisco, ContentSymbol ItemKind,
     Text, Flavour, Maybe FactionId))
-> [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (ItemId, ItemQuant)
-> (Bool, ContentId ItemKind, ItemDisco, ContentSymbol ItemKind,
    Text, Flavour, Maybe FactionId)
kindAndAppearance

data TileAction =
    EmbedAction (ItemId, ItemQuant)
  | ToAction (GroupName TK.TileKind)
  | WithAction [(Int, GroupName IK.ItemKind)] (GroupName TK.TileKind)
  deriving Int -> TileAction -> ShowS
[TileAction] -> ShowS
TileAction -> String
(Int -> TileAction -> ShowS)
-> (TileAction -> String)
-> ([TileAction] -> ShowS)
-> Show TileAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TileAction] -> ShowS
$cshowList :: [TileAction] -> ShowS
show :: TileAction -> String
$cshow :: TileAction -> String
showsPrec :: Int -> TileAction -> ShowS
$cshowsPrec :: Int -> TileAction -> ShowS
Show

parseTileAction :: Bool -> Bool -> [(IK.ItemKind, (ItemId, ItemQuant))]
                -> TK.Feature
                -> Maybe TileAction
parseTileAction :: Bool
-> Bool
-> [(ItemKind, (ItemId, ItemQuant))]
-> Feature
-> Maybe TileAction
parseTileAction Bool
bproj Bool
underFeet [(ItemKind, (ItemId, ItemQuant))]
embedKindList Feature
feat = case Feature
feat of
  TK.Embed GroupName ItemKind
igroup ->
      -- Greater or equal 0 to also cover template UNKNOWN items
      -- not yet identified by the client.
    let f :: (ItemKind, (ItemId, ItemQuant)) -> Bool
f (ItemKind
itemKind, (ItemId, ItemQuant)
_) =
          Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (-Int
1) (GroupName ItemKind -> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup GroupName ItemKind
igroup ([(GroupName ItemKind, Int)] -> Maybe Int)
-> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ItemKind -> [(GroupName ItemKind, Int)]
IK.ifreq ItemKind
itemKind) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
    in case ((ItemKind, (ItemId, ItemQuant)) -> Bool)
-> [(ItemKind, (ItemId, ItemQuant))]
-> Maybe (ItemKind, (ItemId, ItemQuant))
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (ItemKind, (ItemId, ItemQuant)) -> Bool
f [(ItemKind, (ItemId, ItemQuant))]
embedKindList of
      Maybe (ItemKind, (ItemId, ItemQuant))
Nothing -> Maybe TileAction
forall a. Maybe a
Nothing
      Just (ItemKind
_, (ItemId, ItemQuant)
iidkit) -> TileAction -> Maybe TileAction
forall a. a -> Maybe a
Just (TileAction -> Maybe TileAction) -> TileAction -> Maybe TileAction
forall a b. (a -> b) -> a -> b
$ (ItemId, ItemQuant) -> TileAction
EmbedAction (ItemId, ItemQuant)
iidkit
  TK.OpenTo GroupName TileKind
tgroup | Bool -> Bool
not (Bool
underFeet Bool -> Bool -> Bool
|| Bool
bproj) -> TileAction -> Maybe TileAction
forall a. a -> Maybe a
Just (TileAction -> Maybe TileAction) -> TileAction -> Maybe TileAction
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> TileAction
ToAction GroupName TileKind
tgroup
  TK.CloseTo GroupName TileKind
tgroup | Bool -> Bool
not (Bool
underFeet Bool -> Bool -> Bool
|| Bool
bproj) -> TileAction -> Maybe TileAction
forall a. a -> Maybe a
Just (TileAction -> Maybe TileAction) -> TileAction -> Maybe TileAction
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> TileAction
ToAction GroupName TileKind
tgroup
  TK.ChangeTo GroupName TileKind
tgroup | Bool -> Bool
not Bool
bproj -> TileAction -> Maybe TileAction
forall a. a -> Maybe a
Just (TileAction -> Maybe TileAction) -> TileAction -> Maybe TileAction
forall a b. (a -> b) -> a -> b
$ GroupName TileKind -> TileAction
ToAction GroupName TileKind
tgroup
  TK.OpenWith ProjectileTriggers
proj [(Int, GroupName ItemKind)]
grps GroupName TileKind
tgroup | Bool -> Bool
not Bool
underFeet ->
    if ProjectileTriggers
proj ProjectileTriggers -> ProjectileTriggers -> Bool
forall a. Eq a => a -> a -> Bool
== ProjectileTriggers
TK.ProjNo Bool -> Bool -> Bool
&& Bool
bproj
    then Maybe TileAction
forall a. Maybe a
Nothing
    else TileAction -> Maybe TileAction
forall a. a -> Maybe a
Just (TileAction -> Maybe TileAction) -> TileAction -> Maybe TileAction
forall a b. (a -> b) -> a -> b
$ [(Int, GroupName ItemKind)] -> GroupName TileKind -> TileAction
WithAction [(Int, GroupName ItemKind)]
grps GroupName TileKind
tgroup
  TK.CloseWith ProjectileTriggers
proj [(Int, GroupName ItemKind)]
grps GroupName TileKind
tgroup | Bool -> Bool
not Bool
underFeet ->
    -- Not when standing on tile, not to autoclose doors under actor
    -- or close via dropping an item inside.
    if ProjectileTriggers
proj ProjectileTriggers -> ProjectileTriggers -> Bool
forall a. Eq a => a -> a -> Bool
== ProjectileTriggers
TK.ProjNo Bool -> Bool -> Bool
&& Bool
bproj
    then Maybe TileAction
forall a. Maybe a
Nothing
    else TileAction -> Maybe TileAction
forall a. a -> Maybe a
Just (TileAction -> Maybe TileAction) -> TileAction -> Maybe TileAction
forall a b. (a -> b) -> a -> b
$ [(Int, GroupName ItemKind)] -> GroupName TileKind -> TileAction
WithAction [(Int, GroupName ItemKind)]
grps GroupName TileKind
tgroup
  TK.ChangeWith ProjectileTriggers
proj [(Int, GroupName ItemKind)]
grps GroupName TileKind
tgroup ->
    if ProjectileTriggers
proj ProjectileTriggers -> ProjectileTriggers -> Bool
forall a. Eq a => a -> a -> Bool
== ProjectileTriggers
TK.ProjNo Bool -> Bool -> Bool
&& Bool
bproj
    then Maybe TileAction
forall a. Maybe a
Nothing
    else TileAction -> Maybe TileAction
forall a. a -> Maybe a
Just (TileAction -> Maybe TileAction) -> TileAction -> Maybe TileAction
forall a b. (a -> b) -> a -> b
$ [(Int, GroupName ItemKind)] -> GroupName TileKind -> TileAction
WithAction [(Int, GroupName ItemKind)]
grps GroupName TileKind
tgroup
  Feature
_ -> Maybe TileAction
forall a. Maybe a
Nothing