{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}
-- | Abilities of items, actors and factions.
module Game.LambdaHack.Definition.Ability
  ( Skill(..), Skills, Flag(..), ActivationFlag(..), Flags(..)
  , Doctrine(..), EqpSlot(..)
  , getSk, addSk, checkFl, skillsToList
  , zeroSkills, addSkills, sumScaledSkills
  , nameDoctrine, describeDoctrine, doctrineSkills
  , blockOnly, meleeAdjacent, meleeAndRanged, ignoreItems
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , scaleSkills
#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           GHC.Generics (Generic)

-- | Actor and faction skills. They are a subset of actor aspects.
-- See 'Game.LambdaHack.Client.UI.EffectDescription.skillDesc'
-- for documentation.
data Skill =
  -- Stats, that is skills affecting permitted actions.
    SkMove
  | SkMelee
  | SkDisplace
  | SkAlter
  | SkWait
  | SkMoveItem
  | SkProject
  | SkApply
  -- Assorted skills.
  | SkSwimming
  | SkFlying
  | SkHurtMelee
  | SkArmorMelee
  | SkArmorRanged
  | SkMaxHP
  | SkMaxCalm
  | SkSpeed
  | SkSight  -- ^ FOV radius, where 1 means a single tile FOV area
  | SkSmell
  | SkShine
  | SkNocto
  | SkHearing
  | SkAggression
  | SkOdor
  | SkDeflectRanged  -- ^ intended to reflect how many items granting complete
                     --   invulnerability are among organs and equipment;
                     --   this is not strength of deflection nor duration, etc.
  | SkDeflectMelee   -- ^ see above
  deriving (Int -> Skill -> ShowS
[Skill] -> ShowS
Skill -> String
(Int -> Skill -> ShowS)
-> (Skill -> String) -> ([Skill] -> ShowS) -> Show Skill
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Skill] -> ShowS
$cshowList :: [Skill] -> ShowS
show :: Skill -> String
$cshow :: Skill -> String
showsPrec :: Int -> Skill -> ShowS
$cshowsPrec :: Int -> Skill -> ShowS
Show, Skill -> Skill -> Bool
(Skill -> Skill -> Bool) -> (Skill -> Skill -> Bool) -> Eq Skill
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Skill -> Skill -> Bool
$c/= :: Skill -> Skill -> Bool
== :: Skill -> Skill -> Bool
$c== :: Skill -> Skill -> Bool
Eq, Int -> Skill
Skill -> Int
Skill -> [Skill]
Skill -> Skill
Skill -> Skill -> [Skill]
Skill -> Skill -> Skill -> [Skill]
(Skill -> Skill)
-> (Skill -> Skill)
-> (Int -> Skill)
-> (Skill -> Int)
-> (Skill -> [Skill])
-> (Skill -> Skill -> [Skill])
-> (Skill -> Skill -> [Skill])
-> (Skill -> Skill -> Skill -> [Skill])
-> Enum Skill
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 :: Skill -> Skill -> Skill -> [Skill]
$cenumFromThenTo :: Skill -> Skill -> Skill -> [Skill]
enumFromTo :: Skill -> Skill -> [Skill]
$cenumFromTo :: Skill -> Skill -> [Skill]
enumFromThen :: Skill -> Skill -> [Skill]
$cenumFromThen :: Skill -> Skill -> [Skill]
enumFrom :: Skill -> [Skill]
$cenumFrom :: Skill -> [Skill]
fromEnum :: Skill -> Int
$cfromEnum :: Skill -> Int
toEnum :: Int -> Skill
$ctoEnum :: Int -> Skill
pred :: Skill -> Skill
$cpred :: Skill -> Skill
succ :: Skill -> Skill
$csucc :: Skill -> Skill
Enum, Skill
Skill -> Skill -> Bounded Skill
forall a. a -> a -> Bounded a
maxBound :: Skill
$cmaxBound :: Skill
minBound :: Skill
$cminBound :: Skill
Bounded, (forall x. Skill -> Rep Skill x)
-> (forall x. Rep Skill x -> Skill) -> Generic Skill
forall x. Rep Skill x -> Skill
forall x. Skill -> Rep Skill x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Skill x -> Skill
$cfrom :: forall x. Skill -> Rep Skill x
Generic)

-- | Strength of particular skills. This is cumulative from actor
-- organs and equipment and so pertain to an actor as well as to items.
--
-- This representation is sparse, so better than a record when there are more
-- item kinds (with few skills) than actors (with many skills),
-- especially if the number of skills grows as the engine is developed.
-- It's also easier to code and maintain.
--
-- The tree is by construction sparse, so the derived equality is semantical.
newtype Skills = Skills {Skills -> EnumMap Skill Int
skills :: EM.EnumMap Skill Int}
  deriving (Int -> Skills -> ShowS
[Skills] -> ShowS
Skills -> String
(Int -> Skills -> ShowS)
-> (Skills -> String) -> ([Skills] -> ShowS) -> Show Skills
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Skills] -> ShowS
$cshowList :: [Skills] -> ShowS
show :: Skills -> String
$cshow :: Skills -> String
showsPrec :: Int -> Skills -> ShowS
$cshowsPrec :: Int -> Skills -> ShowS
Show, Skills -> Skills -> Bool
(Skills -> Skills -> Bool)
-> (Skills -> Skills -> Bool) -> Eq Skills
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Skills -> Skills -> Bool
$c/= :: Skills -> Skills -> Bool
== :: Skills -> Skills -> Bool
$c== :: Skills -> Skills -> Bool
Eq, Eq Skills
Eq Skills
-> (Skills -> Skills -> Ordering)
-> (Skills -> Skills -> Bool)
-> (Skills -> Skills -> Bool)
-> (Skills -> Skills -> Bool)
-> (Skills -> Skills -> Bool)
-> (Skills -> Skills -> Skills)
-> (Skills -> Skills -> Skills)
-> Ord Skills
Skills -> Skills -> Bool
Skills -> Skills -> Ordering
Skills -> Skills -> Skills
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 :: Skills -> Skills -> Skills
$cmin :: Skills -> Skills -> Skills
max :: Skills -> Skills -> Skills
$cmax :: Skills -> Skills -> Skills
>= :: Skills -> Skills -> Bool
$c>= :: Skills -> Skills -> Bool
> :: Skills -> Skills -> Bool
$c> :: Skills -> Skills -> Bool
<= :: Skills -> Skills -> Bool
$c<= :: Skills -> Skills -> Bool
< :: Skills -> Skills -> Bool
$c< :: Skills -> Skills -> Bool
compare :: Skills -> Skills -> Ordering
$ccompare :: Skills -> Skills -> Ordering
$cp1Ord :: Eq Skills
Ord, Eq Skills
Eq Skills
-> (Int -> Skills -> Int) -> (Skills -> Int) -> Hashable Skills
Int -> Skills -> Int
Skills -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Skills -> Int
$chash :: Skills -> Int
hashWithSalt :: Int -> Skills -> Int
$chashWithSalt :: Int -> Skills -> Int
$cp1Hashable :: Eq Skills
Hashable, Get Skills
[Skills] -> Put
Skills -> Put
(Skills -> Put) -> Get Skills -> ([Skills] -> Put) -> Binary Skills
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Skills] -> Put
$cputList :: [Skills] -> Put
get :: Get Skills
$cget :: Get Skills
put :: Skills -> Put
$cput :: Skills -> Put
Binary)

-- | Item flag aspects.
data Flag =
    Fragile       -- ^ as a projectile, break at target tile, even if no hit;
                  --   also, at each periodic activation a copy is destroyed
                  --   and all other copies require full cooldown (timeout)
  | Lobable       -- ^ drop at target tile, even if no hit
  | Durable       -- ^ don't break even when hitting or applying
  | Equipable     -- ^ AI and UI flag: consider equipping (may or may not
                  --   have 'EqpSlot', e.g., if the benefit is periodic)
  | Benign        -- ^ AI and UI flag: the item is not meant to harm
  | Precious      -- ^ AI and UI flag: don't risk identifying by use;
                  --   also, can't throw or apply if not calm enough;
                  --   also may be used for UI flavour or AI hints
  | Blast         -- ^ the item is an explosion blast particle
  | Condition     -- ^ item is a condition (buff or de-buff) of an actor
                  --   and is displayed as such, not activated at death;
                  --   this differs from belonging to the @CONDITION@ group,
                  --   which doesn't guarantee any behaviour or display,
                  --   but governs removal by items that drop @CONDITION@
  | Unique        -- ^ at most one copy can ever be generated
  | MetaGame      -- ^ once identified, the item is known until savefile deleted
  | MinorEffects  -- ^ override: the effects on this item are considered
                  --   minor and so possibly not causing identification on use,
                  --   and so this item will identify on pick-up
  | MinorAspects  -- ^ override: don't show question marks by weapons in HUD
                  --   even when unidentified item with this flag equipped
  | -- The flags below specify all conditions under which the item activates,
    -- charges permitting, in addition to universal conditions, which are
    -- hitting an actor as projectiles and being explicitly triggered
    -- by an actor (item destruction and combining only pertain
    -- to explicitly listed effects).
    Meleeable     -- ^ meleeing with the item is permitted and so the item
                  --   activates when meleed with
  | Periodic      -- ^ at most one of any copies without cooldown (timeout)
                  --   activates each turn; the cooldown required after
                  --   activation is specified in @Timeout@ (or is zero);
                  --   the initial cooldown can also be specified
                  --   as @TimerDice@ in @CreateItem@ effect; uniquely, this
                  --   activation never destroys a copy, unless item is fragile;
                  --   all this happens only for items in equipment or organs;
                  --   kinetic damage is not applied
  | UnderRanged   -- ^ activates when non-projectile actor with this item
                  --   as equipment or organ is under ranged attack;
                  --   kinetic damage is not applied
  | UnderMelee    -- ^ activates when non-projectile actor with this item
                  --   as equipment or organ is under melee attack;
                  --   kinetic damage is not applied
  deriving (Int -> Flag -> ShowS
[Flag] -> ShowS
Flag -> String
(Int -> Flag -> ShowS)
-> (Flag -> String) -> ([Flag] -> ShowS) -> Show Flag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flag] -> ShowS
$cshowList :: [Flag] -> ShowS
show :: Flag -> String
$cshow :: Flag -> String
showsPrec :: Int -> Flag -> ShowS
$cshowsPrec :: Int -> Flag -> ShowS
Show, Flag -> Flag -> Bool
(Flag -> Flag -> Bool) -> (Flag -> Flag -> Bool) -> Eq Flag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flag -> Flag -> Bool
$c/= :: Flag -> Flag -> Bool
== :: Flag -> Flag -> Bool
$c== :: Flag -> Flag -> Bool
Eq, Int -> Flag
Flag -> Int
Flag -> [Flag]
Flag -> Flag
Flag -> Flag -> [Flag]
Flag -> Flag -> Flag -> [Flag]
(Flag -> Flag)
-> (Flag -> Flag)
-> (Int -> Flag)
-> (Flag -> Int)
-> (Flag -> [Flag])
-> (Flag -> Flag -> [Flag])
-> (Flag -> Flag -> [Flag])
-> (Flag -> Flag -> Flag -> [Flag])
-> Enum Flag
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 :: Flag -> Flag -> Flag -> [Flag]
$cenumFromThenTo :: Flag -> Flag -> Flag -> [Flag]
enumFromTo :: Flag -> Flag -> [Flag]
$cenumFromTo :: Flag -> Flag -> [Flag]
enumFromThen :: Flag -> Flag -> [Flag]
$cenumFromThen :: Flag -> Flag -> [Flag]
enumFrom :: Flag -> [Flag]
$cenumFrom :: Flag -> [Flag]
fromEnum :: Flag -> Int
$cfromEnum :: Flag -> Int
toEnum :: Int -> Flag
$ctoEnum :: Int -> Flag
pred :: Flag -> Flag
$cpred :: Flag -> Flag
succ :: Flag -> Flag
$csucc :: Flag -> Flag
Enum, Flag
Flag -> Flag -> Bounded Flag
forall a. a -> a -> Bounded a
maxBound :: Flag
$cmaxBound :: Flag
minBound :: Flag
$cminBound :: Flag
Bounded, (forall x. Flag -> Rep Flag x)
-> (forall x. Rep Flag x -> Flag) -> Generic Flag
forall x. Rep Flag x -> Flag
forall x. Flag -> Rep Flag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Flag x -> Flag
$cfrom :: forall x. Flag -> Rep Flag x
Generic)

-- | These flags correspond to the last cases of @Flag@ and addtionally
-- to all the universal circumstances of item activation,
-- under which every item activates (even if vacuusly).
data ActivationFlag =
    ActivationMeleeable
  | ActivationPeriodic
  | ActivationUnderRanged
  | ActivationUnderMelee
  | -- | From here on, all items affected regardless of their `Flag` content.
    ActivationProjectile
  | ActivationTrigger
  | ActivationOnSmash
  | ActivationOnCombine
  | ActivationEmbed
  | ActivationConsume
  deriving (Int -> ActivationFlag -> ShowS
[ActivationFlag] -> ShowS
ActivationFlag -> String
(Int -> ActivationFlag -> ShowS)
-> (ActivationFlag -> String)
-> ([ActivationFlag] -> ShowS)
-> Show ActivationFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ActivationFlag] -> ShowS
$cshowList :: [ActivationFlag] -> ShowS
show :: ActivationFlag -> String
$cshow :: ActivationFlag -> String
showsPrec :: Int -> ActivationFlag -> ShowS
$cshowsPrec :: Int -> ActivationFlag -> ShowS
Show, ActivationFlag -> ActivationFlag -> Bool
(ActivationFlag -> ActivationFlag -> Bool)
-> (ActivationFlag -> ActivationFlag -> Bool) -> Eq ActivationFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ActivationFlag -> ActivationFlag -> Bool
$c/= :: ActivationFlag -> ActivationFlag -> Bool
== :: ActivationFlag -> ActivationFlag -> Bool
$c== :: ActivationFlag -> ActivationFlag -> Bool
Eq)

newtype Flags = Flags {Flags -> EnumSet Flag
flags :: ES.EnumSet Flag}
  deriving (Int -> Flags -> ShowS
[Flags] -> ShowS
Flags -> String
(Int -> Flags -> ShowS)
-> (Flags -> String) -> ([Flags] -> ShowS) -> Show Flags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flags] -> ShowS
$cshowList :: [Flags] -> ShowS
show :: Flags -> String
$cshow :: Flags -> String
showsPrec :: Int -> Flags -> ShowS
$cshowsPrec :: Int -> Flags -> ShowS
Show, Flags -> Flags -> Bool
(Flags -> Flags -> Bool) -> (Flags -> Flags -> Bool) -> Eq Flags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flags -> Flags -> Bool
$c/= :: Flags -> Flags -> Bool
== :: Flags -> Flags -> Bool
$c== :: Flags -> Flags -> Bool
Eq, Eq Flags
Eq Flags
-> (Flags -> Flags -> Ordering)
-> (Flags -> Flags -> Bool)
-> (Flags -> Flags -> Bool)
-> (Flags -> Flags -> Bool)
-> (Flags -> Flags -> Bool)
-> (Flags -> Flags -> Flags)
-> (Flags -> Flags -> Flags)
-> Ord Flags
Flags -> Flags -> Bool
Flags -> Flags -> Ordering
Flags -> Flags -> Flags
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 :: Flags -> Flags -> Flags
$cmin :: Flags -> Flags -> Flags
max :: Flags -> Flags -> Flags
$cmax :: Flags -> Flags -> Flags
>= :: Flags -> Flags -> Bool
$c>= :: Flags -> Flags -> Bool
> :: Flags -> Flags -> Bool
$c> :: Flags -> Flags -> Bool
<= :: Flags -> Flags -> Bool
$c<= :: Flags -> Flags -> Bool
< :: Flags -> Flags -> Bool
$c< :: Flags -> Flags -> Bool
compare :: Flags -> Flags -> Ordering
$ccompare :: Flags -> Flags -> Ordering
$cp1Ord :: Eq Flags
Ord, Eq Flags
Eq Flags
-> (Int -> Flags -> Int) -> (Flags -> Int) -> Hashable Flags
Int -> Flags -> Int
Flags -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Flags -> Int
$chash :: Flags -> Int
hashWithSalt :: Int -> Flags -> Int
$chashWithSalt :: Int -> Flags -> Int
$cp1Hashable :: Eq Flags
Hashable, Get Flags
[Flags] -> Put
Flags -> Put
(Flags -> Put) -> Get Flags -> ([Flags] -> Put) -> Binary Flags
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Flags] -> Put
$cputList :: [Flags] -> Put
get :: Get Flags
$cget :: Get Flags
put :: Flags -> Put
$cput :: Flags -> Put
Binary)

-- | Doctrine of non-leader actors. Apart of determining AI operation,
-- each doctrine implies a skill modifier, that is added to the non-leader
-- skills defined in @fskillsOther@ field of @FactionKind@.
data Doctrine =
    TExplore  -- ^ if enemy nearby, attack, if no items, etc., explore unknown
  | TFollow   -- ^ always follow leader's target or his position if no target
  | TFollowNoItems   -- ^ follow but don't do any item management nor use
  | TMeleeAndRanged  -- ^ only melee and do ranged combat
  | TMeleeAdjacent   -- ^ only melee (or wait)
  | TBlock    -- ^ always only wait, even if enemy in melee range
  | TRoam     -- ^ if enemy nearby, attack, if no items, etc., roam randomly
  | TPatrol   -- ^ find an open and uncrowded area, patrol it according
              --   to sight radius and fallback temporarily to @TRoam@
              --   when enemy is seen by the faction and is within
              --   the actor's sight radius
  deriving (Int -> Doctrine -> ShowS
[Doctrine] -> ShowS
Doctrine -> String
(Int -> Doctrine -> ShowS)
-> (Doctrine -> String) -> ([Doctrine] -> ShowS) -> Show Doctrine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Doctrine] -> ShowS
$cshowList :: [Doctrine] -> ShowS
show :: Doctrine -> String
$cshow :: Doctrine -> String
showsPrec :: Int -> Doctrine -> ShowS
$cshowsPrec :: Int -> Doctrine -> ShowS
Show, Doctrine -> Doctrine -> Bool
(Doctrine -> Doctrine -> Bool)
-> (Doctrine -> Doctrine -> Bool) -> Eq Doctrine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Doctrine -> Doctrine -> Bool
$c/= :: Doctrine -> Doctrine -> Bool
== :: Doctrine -> Doctrine -> Bool
$c== :: Doctrine -> Doctrine -> Bool
Eq, Int -> Doctrine
Doctrine -> Int
Doctrine -> [Doctrine]
Doctrine -> Doctrine
Doctrine -> Doctrine -> [Doctrine]
Doctrine -> Doctrine -> Doctrine -> [Doctrine]
(Doctrine -> Doctrine)
-> (Doctrine -> Doctrine)
-> (Int -> Doctrine)
-> (Doctrine -> Int)
-> (Doctrine -> [Doctrine])
-> (Doctrine -> Doctrine -> [Doctrine])
-> (Doctrine -> Doctrine -> [Doctrine])
-> (Doctrine -> Doctrine -> Doctrine -> [Doctrine])
-> Enum Doctrine
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 :: Doctrine -> Doctrine -> Doctrine -> [Doctrine]
$cenumFromThenTo :: Doctrine -> Doctrine -> Doctrine -> [Doctrine]
enumFromTo :: Doctrine -> Doctrine -> [Doctrine]
$cenumFromTo :: Doctrine -> Doctrine -> [Doctrine]
enumFromThen :: Doctrine -> Doctrine -> [Doctrine]
$cenumFromThen :: Doctrine -> Doctrine -> [Doctrine]
enumFrom :: Doctrine -> [Doctrine]
$cenumFrom :: Doctrine -> [Doctrine]
fromEnum :: Doctrine -> Int
$cfromEnum :: Doctrine -> Int
toEnum :: Int -> Doctrine
$ctoEnum :: Int -> Doctrine
pred :: Doctrine -> Doctrine
$cpred :: Doctrine -> Doctrine
succ :: Doctrine -> Doctrine
$csucc :: Doctrine -> Doctrine
Enum, Doctrine
Doctrine -> Doctrine -> Bounded Doctrine
forall a. a -> a -> Bounded a
maxBound :: Doctrine
$cmaxBound :: Doctrine
minBound :: Doctrine
$cminBound :: Doctrine
Bounded, (forall x. Doctrine -> Rep Doctrine x)
-> (forall x. Rep Doctrine x -> Doctrine) -> Generic Doctrine
forall x. Rep Doctrine x -> Doctrine
forall x. Doctrine -> Rep Doctrine x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Doctrine x -> Doctrine
$cfrom :: forall x. Doctrine -> Rep Doctrine x
Generic)

instance Binary Doctrine

instance Hashable Doctrine

-- | AI and UI hints about the role of the item.
data EqpSlot =
    EqpSlotMove
  | EqpSlotMelee
  | EqpSlotDisplace
  | EqpSlotAlter
  | EqpSlotWait
  | EqpSlotMoveItem
  | EqpSlotProject
  | EqpSlotApply
  | EqpSlotSwimming
  | EqpSlotFlying
  | EqpSlotHurtMelee
  | EqpSlotArmorMelee
  | EqpSlotArmorRanged
  | EqpSlotMaxHP
  | EqpSlotSpeed
  | EqpSlotSight
  | EqpSlotShine
  | EqpSlotMiscBonus
  | EqpSlotWeaponFast
  | EqpSlotWeaponBig
  deriving (Int -> EqpSlot -> ShowS
[EqpSlot] -> ShowS
EqpSlot -> String
(Int -> EqpSlot -> ShowS)
-> (EqpSlot -> String) -> ([EqpSlot] -> ShowS) -> Show EqpSlot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EqpSlot] -> ShowS
$cshowList :: [EqpSlot] -> ShowS
show :: EqpSlot -> String
$cshow :: EqpSlot -> String
showsPrec :: Int -> EqpSlot -> ShowS
$cshowsPrec :: Int -> EqpSlot -> ShowS
Show, EqpSlot -> EqpSlot -> Bool
(EqpSlot -> EqpSlot -> Bool)
-> (EqpSlot -> EqpSlot -> Bool) -> Eq EqpSlot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EqpSlot -> EqpSlot -> Bool
$c/= :: EqpSlot -> EqpSlot -> Bool
== :: EqpSlot -> EqpSlot -> Bool
$c== :: EqpSlot -> EqpSlot -> Bool
Eq, Eq EqpSlot
Eq EqpSlot
-> (EqpSlot -> EqpSlot -> Ordering)
-> (EqpSlot -> EqpSlot -> Bool)
-> (EqpSlot -> EqpSlot -> Bool)
-> (EqpSlot -> EqpSlot -> Bool)
-> (EqpSlot -> EqpSlot -> Bool)
-> (EqpSlot -> EqpSlot -> EqpSlot)
-> (EqpSlot -> EqpSlot -> EqpSlot)
-> Ord EqpSlot
EqpSlot -> EqpSlot -> Bool
EqpSlot -> EqpSlot -> Ordering
EqpSlot -> EqpSlot -> EqpSlot
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 :: EqpSlot -> EqpSlot -> EqpSlot
$cmin :: EqpSlot -> EqpSlot -> EqpSlot
max :: EqpSlot -> EqpSlot -> EqpSlot
$cmax :: EqpSlot -> EqpSlot -> EqpSlot
>= :: EqpSlot -> EqpSlot -> Bool
$c>= :: EqpSlot -> EqpSlot -> Bool
> :: EqpSlot -> EqpSlot -> Bool
$c> :: EqpSlot -> EqpSlot -> Bool
<= :: EqpSlot -> EqpSlot -> Bool
$c<= :: EqpSlot -> EqpSlot -> Bool
< :: EqpSlot -> EqpSlot -> Bool
$c< :: EqpSlot -> EqpSlot -> Bool
compare :: EqpSlot -> EqpSlot -> Ordering
$ccompare :: EqpSlot -> EqpSlot -> Ordering
$cp1Ord :: Eq EqpSlot
Ord, Int -> EqpSlot
EqpSlot -> Int
EqpSlot -> [EqpSlot]
EqpSlot -> EqpSlot
EqpSlot -> EqpSlot -> [EqpSlot]
EqpSlot -> EqpSlot -> EqpSlot -> [EqpSlot]
(EqpSlot -> EqpSlot)
-> (EqpSlot -> EqpSlot)
-> (Int -> EqpSlot)
-> (EqpSlot -> Int)
-> (EqpSlot -> [EqpSlot])
-> (EqpSlot -> EqpSlot -> [EqpSlot])
-> (EqpSlot -> EqpSlot -> [EqpSlot])
-> (EqpSlot -> EqpSlot -> EqpSlot -> [EqpSlot])
-> Enum EqpSlot
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 :: EqpSlot -> EqpSlot -> EqpSlot -> [EqpSlot]
$cenumFromThenTo :: EqpSlot -> EqpSlot -> EqpSlot -> [EqpSlot]
enumFromTo :: EqpSlot -> EqpSlot -> [EqpSlot]
$cenumFromTo :: EqpSlot -> EqpSlot -> [EqpSlot]
enumFromThen :: EqpSlot -> EqpSlot -> [EqpSlot]
$cenumFromThen :: EqpSlot -> EqpSlot -> [EqpSlot]
enumFrom :: EqpSlot -> [EqpSlot]
$cenumFrom :: EqpSlot -> [EqpSlot]
fromEnum :: EqpSlot -> Int
$cfromEnum :: EqpSlot -> Int
toEnum :: Int -> EqpSlot
$ctoEnum :: Int -> EqpSlot
pred :: EqpSlot -> EqpSlot
$cpred :: EqpSlot -> EqpSlot
succ :: EqpSlot -> EqpSlot
$csucc :: EqpSlot -> EqpSlot
Enum, EqpSlot
EqpSlot -> EqpSlot -> Bounded EqpSlot
forall a. a -> a -> Bounded a
maxBound :: EqpSlot
$cmaxBound :: EqpSlot
minBound :: EqpSlot
$cminBound :: EqpSlot
Bounded, (forall x. EqpSlot -> Rep EqpSlot x)
-> (forall x. Rep EqpSlot x -> EqpSlot) -> Generic EqpSlot
forall x. Rep EqpSlot x -> EqpSlot
forall x. EqpSlot -> Rep EqpSlot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EqpSlot x -> EqpSlot
$cfrom :: forall x. EqpSlot -> Rep EqpSlot x
Generic)

instance Binary Skill where
  put :: Skill -> Put
put = Word8 -> Put
putWord8 (Word8 -> Put) -> (Skill -> Word8) -> Skill -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a. Enum a => Int -> a
toEnum (Int -> Word8) -> (Skill -> Int) -> Skill -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Skill -> Int
forall a. Enum a => a -> Int
fromEnum
  get :: Get Skill
get = (Word8 -> Skill) -> Get Word8 -> Get Skill
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Skill
forall a. Enum a => Int -> a
toEnum (Int -> Skill) -> (Word8 -> Int) -> Word8 -> Skill
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a. Enum a => a -> Int
fromEnum) Get Word8
getWord8

instance Binary Flag where
  put :: Flag -> Put
put = Word8 -> Put
putWord8 (Word8 -> Put) -> (Flag -> Word8) -> Flag -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a. Enum a => Int -> a
toEnum (Int -> Word8) -> (Flag -> Int) -> Flag -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flag -> Int
forall a. Enum a => a -> Int
fromEnum
  get :: Get Flag
get = (Word8 -> Flag) -> Get Word8 -> Get Flag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Flag
forall a. Enum a => Int -> a
toEnum (Int -> Flag) -> (Word8 -> Int) -> Word8 -> Flag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a. Enum a => a -> Int
fromEnum) Get Word8
getWord8

instance Binary EqpSlot where
  put :: EqpSlot -> Put
put = Word8 -> Put
putWord8 (Word8 -> Put) -> (EqpSlot -> Word8) -> EqpSlot -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a. Enum a => Int -> a
toEnum (Int -> Word8) -> (EqpSlot -> Int) -> EqpSlot -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EqpSlot -> Int
forall a. Enum a => a -> Int
fromEnum
  get :: Get EqpSlot
get = (Word8 -> EqpSlot) -> Get Word8 -> Get EqpSlot
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> EqpSlot
forall a. Enum a => Int -> a
toEnum (Int -> EqpSlot) -> (Word8 -> Int) -> Word8 -> EqpSlot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a. Enum a => a -> Int
fromEnum) Get Word8
getWord8

instance Hashable Skill

instance Hashable Flag

instance Hashable EqpSlot

getSk :: Skill -> Skills -> Int
{-# INLINE getSk #-}
getSk :: Skill -> Skills -> Int
getSk Skill
sk (Skills EnumMap Skill Int
skills) = Int -> Skill -> EnumMap Skill Int -> Int
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault Int
0 Skill
sk EnumMap Skill Int
skills

addSk :: Skill -> Int -> Skills -> Skills
addSk :: Skill -> Int -> Skills -> Skills
addSk Skill
sk Int
n = Skills -> Skills -> Skills
addSkills (EnumMap Skill Int -> Skills
Skills (EnumMap Skill Int -> Skills) -> EnumMap Skill Int -> Skills
forall a b. (a -> b) -> a -> b
$ Skill -> Int -> EnumMap Skill Int
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton Skill
sk Int
n)

checkFl :: Flag -> Flags -> Bool
{-# INLINE checkFl #-}
checkFl :: Flag -> Flags -> Bool
checkFl Flag
flag (Flags EnumSet Flag
flags) = Flag
flag Flag -> EnumSet Flag -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` EnumSet Flag
flags

skillsToList :: Skills -> [(Skill, Int)]
skillsToList :: Skills -> [(Skill, Int)]
skillsToList (Skills EnumMap Skill Int
sk) = EnumMap Skill Int -> [(Skill, Int)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap Skill Int
sk

zeroSkills :: Skills
zeroSkills :: Skills
zeroSkills = EnumMap Skill Int -> Skills
Skills EnumMap Skill Int
forall k a. EnumMap k a
EM.empty

-- This avoids costly compaction (required for Eq) even in case of adding
-- empty skills, etc. This function is used a lot.
addSkills :: Skills -> Skills -> Skills
addSkills :: Skills -> Skills -> Skills
addSkills (Skills EnumMap Skill Int
sk1) (Skills EnumMap Skill Int
sk2) =
  let combine :: p -> a -> a -> Maybe a
combine p
_ a
s1 a
s2 = case a
s1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
s2 of
        a
0 -> Maybe a
forall a. Maybe a
Nothing
        a
s -> a -> Maybe a
forall a. a -> Maybe a
Just a
s
  in EnumMap Skill Int -> Skills
Skills (EnumMap Skill Int -> Skills) -> EnumMap Skill Int -> Skills
forall a b. (a -> b) -> a -> b
$ (Skill -> Int -> Int -> Maybe Int)
-> (EnumMap Skill Int -> EnumMap Skill Int)
-> (EnumMap Skill Int -> EnumMap Skill Int)
-> EnumMap Skill Int
-> EnumMap Skill Int
-> EnumMap Skill Int
forall k a b c.
Enum k =>
(k -> a -> b -> Maybe c)
-> (EnumMap k a -> EnumMap k c)
-> (EnumMap k b -> EnumMap k c)
-> EnumMap k a
-> EnumMap k b
-> EnumMap k c
EM.mergeWithKey Skill -> Int -> Int -> Maybe Int
forall a p. (Num a, Eq a) => p -> a -> a -> Maybe a
combine EnumMap Skill Int -> EnumMap Skill Int
forall a. a -> a
id EnumMap Skill Int -> EnumMap Skill Int
forall a. a -> a
id EnumMap Skill Int
sk1 EnumMap Skill Int
sk2

scaleSkills :: (Skills, Int) -> Skills
scaleSkills :: (Skills, Int) -> Skills
scaleSkills (Skills
_, Int
0) = Skills
zeroSkills
scaleSkills (Skills EnumMap Skill Int
sk, Int
n) = EnumMap Skill Int -> Skills
Skills (EnumMap Skill Int -> Skills) -> EnumMap Skill Int -> Skills
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> EnumMap Skill Int -> EnumMap Skill Int
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
*) EnumMap Skill Int
sk

sumScaledSkills :: [(Skills, Int)] -> Skills
sumScaledSkills :: [(Skills, Int)] -> Skills
sumScaledSkills = ((Skills, Int) -> Skills -> Skills)
-> Skills -> [(Skills, Int)] -> Skills
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Skills -> Skills -> Skills
addSkills (Skills -> Skills -> Skills)
-> ((Skills, Int) -> Skills) -> (Skills, Int) -> Skills -> Skills
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Skills, Int) -> Skills
scaleSkills) Skills
zeroSkills

nameDoctrine :: Doctrine -> Text
nameDoctrine :: Doctrine -> Text
nameDoctrine Doctrine
TExplore        = Text
"explore"
nameDoctrine Doctrine
TFollow         = Text
"follow freely"
nameDoctrine Doctrine
TFollowNoItems  = Text
"follow only"
nameDoctrine Doctrine
TMeleeAndRanged = Text
"fight only"
nameDoctrine Doctrine
TMeleeAdjacent  = Text
"melee only"
nameDoctrine Doctrine
TBlock          = Text
"block only"
nameDoctrine Doctrine
TRoam           = Text
"roam freely"
nameDoctrine Doctrine
TPatrol         = Text
"patrol area"

describeDoctrine :: Doctrine -> Text
describeDoctrine :: Doctrine -> Text
describeDoctrine Doctrine
TExplore = Text
"investigate unknown positions, chase targets"
describeDoctrine Doctrine
TFollow = Text
"follow pointman's target or position, grab items"
describeDoctrine Doctrine
TFollowNoItems =
  Text
"follow pointman's target or position, ignore items"
describeDoctrine Doctrine
TMeleeAndRanged =
  Text
"engage in both melee and ranged combat, don't move"
describeDoctrine Doctrine
TMeleeAdjacent = Text
"engage exclusively in melee, don't move"
describeDoctrine Doctrine
TBlock = Text
"block and wait, don't move"
describeDoctrine Doctrine
TRoam = Text
"move freely, chase targets"
describeDoctrine Doctrine
TPatrol = Text
"find and patrol an area"

doctrineSkills :: Doctrine -> Skills
doctrineSkills :: Doctrine -> Skills
doctrineSkills Doctrine
TExplore = Skills
zeroSkills
doctrineSkills Doctrine
TFollow = Skills
zeroSkills
doctrineSkills Doctrine
TFollowNoItems = Skills
ignoreItems
doctrineSkills Doctrine
TMeleeAndRanged = Skills
meleeAndRanged
doctrineSkills Doctrine
TMeleeAdjacent = Skills
meleeAdjacent
doctrineSkills Doctrine
TBlock = Skills
blockOnly
doctrineSkills Doctrine
TRoam = Skills
zeroSkills
doctrineSkills Doctrine
TPatrol = Skills
zeroSkills

minusTen, blockOnly, meleeAdjacent, meleeAndRanged, ignoreItems :: Skills

-- To make sure only a lot of weak items can override move-only-leader, etc.
minusTen :: Skills
minusTen = EnumMap Skill Int -> Skills
Skills (EnumMap Skill Int -> Skills) -> EnumMap Skill Int -> Skills
forall a b. (a -> b) -> a -> b
$ [(Skill, Int)] -> EnumMap Skill Int
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromDistinctAscList
                  ([(Skill, Int)] -> EnumMap Skill Int)
-> [(Skill, Int)] -> EnumMap Skill Int
forall a b. (a -> b) -> a -> b
$ [Skill] -> [Int] -> [(Skill, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Skill
SkMove .. Skill
SkApply] (Int -> [Int]
forall a. a -> [a]
repeat (-Int
10))

blockOnly :: Skills
blockOnly = EnumMap Skill Int -> Skills
Skills (EnumMap Skill Int -> Skills) -> EnumMap Skill Int -> Skills
forall a b. (a -> b) -> a -> b
$ Skill -> EnumMap Skill Int -> EnumMap Skill Int
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete Skill
SkWait (EnumMap Skill Int -> EnumMap Skill Int)
-> EnumMap Skill Int -> EnumMap Skill Int
forall a b. (a -> b) -> a -> b
$ Skills -> EnumMap Skill Int
skills Skills
minusTen

meleeAdjacent :: Skills
meleeAdjacent = EnumMap Skill Int -> Skills
Skills (EnumMap Skill Int -> Skills) -> EnumMap Skill Int -> Skills
forall a b. (a -> b) -> a -> b
$ Skill -> EnumMap Skill Int -> EnumMap Skill Int
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete Skill
SkMelee (EnumMap Skill Int -> EnumMap Skill Int)
-> EnumMap Skill Int -> EnumMap Skill Int
forall a b. (a -> b) -> a -> b
$ Skills -> EnumMap Skill Int
skills Skills
blockOnly

-- Melee and reaction fire.
meleeAndRanged :: Skills
meleeAndRanged = EnumMap Skill Int -> Skills
Skills (EnumMap Skill Int -> Skills) -> EnumMap Skill Int -> Skills
forall a b. (a -> b) -> a -> b
$ Skill -> EnumMap Skill Int -> EnumMap Skill Int
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete Skill
SkProject (EnumMap Skill Int -> EnumMap Skill Int)
-> EnumMap Skill Int -> EnumMap Skill Int
forall a b. (a -> b) -> a -> b
$ Skills -> EnumMap Skill Int
skills Skills
meleeAdjacent

ignoreItems :: Skills
ignoreItems = EnumMap Skill Int -> Skills
Skills (EnumMap Skill Int -> Skills) -> EnumMap Skill Int -> Skills
forall a b. (a -> b) -> a -> b
$ [(Skill, Int)] -> EnumMap Skill Int
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromList
                     ([(Skill, Int)] -> EnumMap Skill Int)
-> [(Skill, Int)] -> EnumMap Skill Int
forall a b. (a -> b) -> a -> b
$ [Skill] -> [Int] -> [(Skill, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Skill
SkMoveItem, Skill
SkProject, Skill
SkApply] (Int -> [Int]
forall a. a -> [a]
repeat (-Int
10))