{-# LANGUAGE DeriveGeneric, TupleSections #-}
-- | Actors in the game: heroes, monsters, etc.
module Game.LambdaHack.Common.Actor
  ( -- * The@ Acto@r type, its components and operations on them
    Actor(..), ResDelta(..), ActorMaxSkills, Watchfulness(..)
  , deltasSerious, deltasSeriousThisTurn
  , deltasHears, deltaBenign, deltaWasBenign
  , actorCanMelee, actorCanMeleeToHarm, actorWorthChasing, actorWorthKilling
  , gearSpeed, actorTemplate, actorWaits, actorWaitsOrSleeps, actorDying
  , hpTooLow, calmEnough, calmFull, hpFull, canSleep, prefersSleep
  , checkAdjacent, eqpOverfull, eqpFreeN
  , getCarriedIidsAndTrunk, getCarriedIidCStore
    -- * Assorted
  , ActorDict, monsterGenChance, smellTimeout
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Binary
import qualified Data.EnumMap.Strict as EM
import           Data.Int (Int64)
import           GHC.Generics (Generic)

import           Game.LambdaHack.Common.Item
import           Game.LambdaHack.Common.Misc
import           Game.LambdaHack.Common.Point
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Common.Vector
import qualified Game.LambdaHack.Core.Dice as Dice
import qualified Game.LambdaHack.Definition.Ability as Ability
import           Game.LambdaHack.Definition.Defs

-- | Actor attributes that are changing throughout the game.
-- If they appear to be dublets of aspects from actor kinds, e.g. HP,
-- they may be results of casting the dice specified in their respective
-- actor kind and/or may be modified temporarily, but return
-- to the original value from their respective kind over time.
--
-- Other properties of an actor, in particular its current aspects,
-- are derived from the actor's trunk, organs and equipment.
-- A class of the aspects, the boolean ones, are called flags.
-- Another class are skills. Stats are a subclass that determines
-- if particular actions are permitted for the actor (or faction).
data Actor = Actor
  { -- The trunk of the actor's body (present also in @borgan@ or @beqp@)
    Actor -> ItemId
btrunk      :: ItemId       -- ^ the trunk organ of the actor's body
  , Actor -> Maybe Int
bnumber     :: Maybe Int    -- ^ continued team character identity
                                --   index number in this game

    -- Resources
  , Actor -> Int64
bhp         :: Int64        -- ^ current hit points * 1M
  , Actor -> ResDelta
bhpDelta    :: ResDelta     -- ^ HP delta this turn * 1M
  , Actor -> Int64
bcalm       :: Int64        -- ^ current calm * 1M
  , Actor -> ResDelta
bcalmDelta  :: ResDelta     -- ^ calm delta this turn * 1M

    -- Location
  , Actor -> Point
bpos        :: Point        -- ^ current position
  , Actor -> Maybe Point
boldpos     :: Maybe Point  -- ^ previous position, if any
  , Actor -> LevelId
blid        :: LevelId      -- ^ current level
  , Actor -> FactionId
bfid        :: FactionId    -- ^ faction the actor currently belongs to
  , Actor -> Maybe ([Vector], Speed)
btrajectory :: Maybe ([Vector], Speed)
                                -- ^ trajectory the actor must
                                --   travel and his travel speed

    -- Items
  , Actor -> ItemBag
borgan      :: ItemBag      -- ^ organs
  , Actor -> ItemBag
beqp        :: ItemBag      -- ^ personal equipment
  , Actor -> Int
bweapon     :: Int          -- ^ number of weapons among eqp and organs
  , Actor -> Int
bweapBenign :: Int          -- ^ number of benign items among weapons

    -- Assorted
  , Actor -> Watchfulness
bwatch      :: Watchfulness -- ^ state of the actor's watchfulness
  , Actor -> Bool
bproj       :: Bool         -- ^ is a projectile? affects being able
                                --   to fly through other projectiles, etc.
  }
  deriving (Int -> Actor -> ShowS
[Actor] -> ShowS
Actor -> String
(Int -> Actor -> ShowS)
-> (Actor -> String) -> ([Actor] -> ShowS) -> Show Actor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Actor] -> ShowS
$cshowList :: [Actor] -> ShowS
show :: Actor -> String
$cshow :: Actor -> String
showsPrec :: Int -> Actor -> ShowS
$cshowsPrec :: Int -> Actor -> ShowS
Show, Actor -> Actor -> Bool
(Actor -> Actor -> Bool) -> (Actor -> Actor -> Bool) -> Eq Actor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Actor -> Actor -> Bool
$c/= :: Actor -> Actor -> Bool
== :: Actor -> Actor -> Bool
$c== :: Actor -> Actor -> Bool
Eq, (forall x. Actor -> Rep Actor x)
-> (forall x. Rep Actor x -> Actor) -> Generic Actor
forall x. Rep Actor x -> Actor
forall x. Actor -> Rep Actor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Actor x -> Actor
$cfrom :: forall x. Actor -> Rep Actor x
Generic)

instance Binary Actor

-- | Representation of recent changes to HP of Calm of an actor.
-- This is reset every time the actor perfoms an action, so this is
-- aggregated over actor turn (move), not time turn.
-- The resource changes recorded in the tuple are, respectively,
-- negative and positive.
data ResDelta = ResDelta
  { ResDelta -> (Int64, Int64)
resCurrentTurn  :: (Int64, Int64)  -- ^ resource change this move
  , ResDelta -> (Int64, Int64)
resPreviousTurn :: (Int64, Int64)  -- ^ resource change previous move
  }
  deriving (Int -> ResDelta -> ShowS
[ResDelta] -> ShowS
ResDelta -> String
(Int -> ResDelta -> ShowS)
-> (ResDelta -> String) -> ([ResDelta] -> ShowS) -> Show ResDelta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResDelta] -> ShowS
$cshowList :: [ResDelta] -> ShowS
show :: ResDelta -> String
$cshow :: ResDelta -> String
showsPrec :: Int -> ResDelta -> ShowS
$cshowsPrec :: Int -> ResDelta -> ShowS
Show, ResDelta -> ResDelta -> Bool
(ResDelta -> ResDelta -> Bool)
-> (ResDelta -> ResDelta -> Bool) -> Eq ResDelta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResDelta -> ResDelta -> Bool
$c/= :: ResDelta -> ResDelta -> Bool
== :: ResDelta -> ResDelta -> Bool
$c== :: ResDelta -> ResDelta -> Bool
Eq, (forall x. ResDelta -> Rep ResDelta x)
-> (forall x. Rep ResDelta x -> ResDelta) -> Generic ResDelta
forall x. Rep ResDelta x -> ResDelta
forall x. ResDelta -> Rep ResDelta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResDelta x -> ResDelta
$cfrom :: forall x. ResDelta -> Rep ResDelta x
Generic)

instance Binary ResDelta

type ActorMaxSkills = EM.EnumMap ActorId Ability.Skills

-- | All actors on the level, indexed by actor identifier.
type ActorDict = EM.EnumMap ActorId Actor

data Watchfulness = WWatch | WWait Int | WSleep | WWake
  deriving (Int -> Watchfulness -> ShowS
[Watchfulness] -> ShowS
Watchfulness -> String
(Int -> Watchfulness -> ShowS)
-> (Watchfulness -> String)
-> ([Watchfulness] -> ShowS)
-> Show Watchfulness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Watchfulness] -> ShowS
$cshowList :: [Watchfulness] -> ShowS
show :: Watchfulness -> String
$cshow :: Watchfulness -> String
showsPrec :: Int -> Watchfulness -> ShowS
$cshowsPrec :: Int -> Watchfulness -> ShowS
Show, Watchfulness -> Watchfulness -> Bool
(Watchfulness -> Watchfulness -> Bool)
-> (Watchfulness -> Watchfulness -> Bool) -> Eq Watchfulness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Watchfulness -> Watchfulness -> Bool
$c/= :: Watchfulness -> Watchfulness -> Bool
== :: Watchfulness -> Watchfulness -> Bool
$c== :: Watchfulness -> Watchfulness -> Bool
Eq, (forall x. Watchfulness -> Rep Watchfulness x)
-> (forall x. Rep Watchfulness x -> Watchfulness)
-> Generic Watchfulness
forall x. Rep Watchfulness x -> Watchfulness
forall x. Watchfulness -> Rep Watchfulness x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Watchfulness x -> Watchfulness
$cfrom :: forall x. Watchfulness -> Rep Watchfulness x
Generic)

instance Binary Watchfulness

deltasSerious :: ResDelta -> Bool
deltasSerious :: ResDelta -> Bool
deltasSerious ResDelta{(Int64, Int64)
resPreviousTurn :: (Int64, Int64)
resCurrentTurn :: (Int64, Int64)
resPreviousTurn :: ResDelta -> (Int64, Int64)
resCurrentTurn :: ResDelta -> (Int64, Int64)
..} = (Int64, Int64) -> Int64
forall a b. (a, b) -> a
fst (Int64, Int64)
resCurrentTurn Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
minusM2
                             Bool -> Bool -> Bool
|| (Int64, Int64) -> Int64
forall a b. (a, b) -> a
fst (Int64, Int64)
resPreviousTurn Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
minusM2

deltasSeriousThisTurn :: ResDelta -> Bool
deltasSeriousThisTurn :: ResDelta -> Bool
deltasSeriousThisTurn ResDelta{(Int64, Int64)
resPreviousTurn :: (Int64, Int64)
resCurrentTurn :: (Int64, Int64)
resPreviousTurn :: ResDelta -> (Int64, Int64)
resCurrentTurn :: ResDelta -> (Int64, Int64)
..} = (Int64, Int64) -> Int64
forall a b. (a, b) -> a
fst (Int64, Int64)
resCurrentTurn Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
minusM2

deltasHears :: ResDelta -> Bool
deltasHears :: ResDelta -> Bool
deltasHears ResDelta{(Int64, Int64)
resPreviousTurn :: (Int64, Int64)
resCurrentTurn :: (Int64, Int64)
resPreviousTurn :: ResDelta -> (Int64, Int64)
resCurrentTurn :: ResDelta -> (Int64, Int64)
..} = (Int64, Int64) -> Int64
forall a b. (a, b) -> a
fst (Int64, Int64)
resCurrentTurn Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
minusM1
                           Bool -> Bool -> Bool
|| (Int64, Int64) -> Int64
forall a b. (a, b) -> a
fst (Int64, Int64)
resPreviousTurn Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
minusM1

deltaBenign :: ResDelta -> Bool
deltaBenign :: ResDelta -> Bool
deltaBenign ResDelta{(Int64, Int64)
resCurrentTurn :: (Int64, Int64)
resCurrentTurn :: ResDelta -> (Int64, Int64)
resCurrentTurn} =
  (Int64, Int64) -> Int64
forall a b. (a, b) -> a
fst (Int64, Int64)
resCurrentTurn Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
0  -- only the current one

deltaWasBenign :: ResDelta -> Bool
deltaWasBenign :: ResDelta -> Bool
deltaWasBenign ResDelta{(Int64, Int64)
resPreviousTurn :: (Int64, Int64)
resPreviousTurn :: ResDelta -> (Int64, Int64)
resPreviousTurn} =
  (Int64, Int64) -> Int64
forall a b. (a, b) -> a
fst (Int64, Int64)
resPreviousTurn Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
0  -- only the previous one

actorCanMelee :: ActorMaxSkills -> ActorId -> Actor -> Bool
{-# INLINE actorCanMelee #-}
actorCanMelee :: ActorMaxSkills -> ActorId -> Actor -> Bool
actorCanMelee ActorMaxSkills
actorMaxSkills ActorId
aid Actor
b =
  let actorMaxSk :: Skills
actorMaxSk = ActorMaxSkills
actorMaxSkills ActorMaxSkills -> ActorId -> Skills
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid
      condUsableWeapon :: Bool
condUsableWeapon = Actor -> Int
bweapon Actor
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
      canMelee :: Bool
canMelee = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMelee Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
  in Bool
condUsableWeapon Bool -> Bool -> Bool
&& Bool
canMelee

actorCanMeleeToHarm :: ActorMaxSkills -> ActorId -> Actor -> Bool
{-# INLINE actorCanMeleeToHarm #-}
actorCanMeleeToHarm :: ActorMaxSkills -> ActorId -> Actor -> Bool
actorCanMeleeToHarm ActorMaxSkills
actorMaxSkills ActorId
aid Actor
b =
  let actorMaxSk :: Skills
actorMaxSk = ActorMaxSkills
actorMaxSkills ActorMaxSkills -> ActorId -> Skills
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid
      condUsableWeapon :: Bool
condUsableWeapon = Actor -> Int
bweapon Actor
b Int -> Int -> Int
forall a. Num a => a -> a -> a
- Actor -> Int
bweapBenign Actor
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
      canMelee :: Bool
canMelee = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMelee Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
  in Bool
condUsableWeapon Bool -> Bool -> Bool
&& Bool
canMelee

-- Don't target/melee nonmoving actors, including sleeping, because nonmoving
-- can't be lured nor ambushed nor can chase us. However, do target
-- if they have loot or can attack at range or may become very powerful
-- through regeneration if left alone.
actorWorthChasing :: ActorMaxSkills -> ActorId -> Actor -> Bool
actorWorthChasing :: ActorMaxSkills -> ActorId -> Actor -> Bool
actorWorthChasing ActorMaxSkills
actorMaxSkills ActorId
aid Actor
b =
  let hasLoot :: Bool
hasLoot = Bool -> Bool
not (ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null (ItemBag -> Bool) -> ItemBag -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> ItemBag
beqp Actor
b)
        -- even consider "unreported inventory", for speed and KISS
      actorMaxSk :: Skills
actorMaxSk = ActorMaxSkills
actorMaxSkills ActorMaxSkills -> ActorId -> Skills
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid
  in Actor -> Bool
bproj Actor
b
     Bool -> Bool -> Bool
|| (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMove Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
         Bool -> Bool -> Bool
|| Actor -> Watchfulness
bwatch Actor
b Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
== Watchfulness
WWake  -- probably will start moving very soon
         Bool -> Bool -> Bool
|| Bool
hasLoot
         Bool -> Bool -> Bool
|| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkProject Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
         Bool -> Bool -> Bool
|| Actor -> Watchfulness
bwatch Actor
b Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
== Watchfulness
WSleep
            Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxHP Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
30)
              -- too dangerous when regenerates through sleep;
              -- heroes usually fall into this category
        Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0

-- Whether worth killing if already chased down.
actorWorthKilling :: ActorMaxSkills -> ActorId -> Actor -> Bool
actorWorthKilling :: ActorMaxSkills -> ActorId -> Actor -> Bool
actorWorthKilling ActorMaxSkills
actorMaxSkills ActorId
aid Actor
b =
  ActorMaxSkills -> ActorId -> Actor -> Bool
actorWorthChasing ActorMaxSkills
actorMaxSkills ActorId
aid Actor
b
  Bool -> Bool -> Bool
|| ActorMaxSkills -> ActorId -> Actor -> Bool
actorCanMeleeToHarm ActorMaxSkills
actorMaxSkills ActorId
aid Actor
b Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0

-- | The speed from organs and gear; being pushed is ignored.
gearSpeed :: Ability.Skills -> Speed
gearSpeed :: Skills -> Speed
gearSpeed Skills
actorMaxSk = Int -> Speed
toSpeed (Int -> Speed) -> Int -> Speed
forall a b. (a -> b) -> a -> b
$
  Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
minSpeed (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSpeed Skills
actorMaxSk)  -- see @minimalSpeed@

actorTemplate :: ItemId -> Maybe Int -> Int64 -> Int64 -> Point -> LevelId
              -> FactionId -> Bool
              -> Actor
actorTemplate :: ItemId
-> Maybe Int
-> Int64
-> Int64
-> Point
-> LevelId
-> FactionId
-> Bool
-> Actor
actorTemplate ItemId
btrunk Maybe Int
bnumber Int64
bhp Int64
bcalm Point
bpos LevelId
blid FactionId
bfid Bool
bproj =
  let btrajectory :: Maybe a
btrajectory = Maybe a
forall a. Maybe a
Nothing
      boldpos :: Maybe a
boldpos = Maybe a
forall a. Maybe a
Nothing
      borgan :: EnumMap k a
borgan = EnumMap k a
forall k a. EnumMap k a
EM.empty
      beqp :: EnumMap k a
beqp = EnumMap k a
forall k a. EnumMap k a
EM.empty
      bweapon :: Int
bweapon = Int
0
      bweapBenign :: Int
bweapBenign = Int
0
      bwatch :: Watchfulness
bwatch = Watchfulness
WWatch  -- overriden elsewhere, sometimes
      bhpDelta :: ResDelta
bhpDelta = (Int64, Int64) -> (Int64, Int64) -> ResDelta
ResDelta (Int64
0, Int64
0) (Int64
0, Int64
0)
      bcalmDelta :: ResDelta
bcalmDelta = (Int64, Int64) -> (Int64, Int64) -> ResDelta
ResDelta (Int64
0, Int64
0) (Int64
0, Int64
0)
  in Actor :: ItemId
-> Maybe Int
-> Int64
-> ResDelta
-> Int64
-> ResDelta
-> Point
-> Maybe Point
-> LevelId
-> FactionId
-> Maybe ([Vector], Speed)
-> ItemBag
-> ItemBag
-> Int
-> Int
-> Watchfulness
-> Bool
-> Actor
Actor{Bool
Int
Int64
Maybe Int
Maybe ([Vector], Speed)
Maybe Point
ItemBag
Point
LevelId
FactionId
ItemId
Watchfulness
ResDelta
forall a. Maybe a
forall k a. EnumMap k a
bcalmDelta :: ResDelta
bhpDelta :: ResDelta
bwatch :: Watchfulness
bweapBenign :: Int
bweapon :: Int
beqp :: forall k a. EnumMap k a
borgan :: forall k a. EnumMap k a
boldpos :: forall a. Maybe a
btrajectory :: forall a. Maybe a
bproj :: Bool
bfid :: FactionId
blid :: LevelId
bpos :: Point
bcalm :: Int64
bhp :: Int64
bnumber :: Maybe Int
btrunk :: ItemId
bproj :: Bool
bwatch :: Watchfulness
bweapBenign :: Int
bweapon :: Int
beqp :: ItemBag
borgan :: ItemBag
btrajectory :: Maybe ([Vector], Speed)
bfid :: FactionId
blid :: LevelId
boldpos :: Maybe Point
bpos :: Point
bcalmDelta :: ResDelta
bcalm :: Int64
bhpDelta :: ResDelta
bhp :: Int64
bnumber :: Maybe Int
btrunk :: ItemId
..}

actorWaits :: Actor -> Bool
{-# INLINE actorWaits #-}
actorWaits :: Actor -> Bool
actorWaits Actor
b = case Actor -> Watchfulness
bwatch Actor
b of
  WWait{} -> Bool
True
  Watchfulness
_ -> Bool
False

actorWaitsOrSleeps :: Actor -> Bool
{-# INLINE actorWaitsOrSleeps #-}
actorWaitsOrSleeps :: Actor -> Bool
actorWaitsOrSleeps Actor
b = case Actor -> Watchfulness
bwatch Actor
b of
  WWait{} -> Bool
True
  Watchfulness
WSleep -> Bool
True
  Watchfulness
_ -> Bool
False

-- | Projectile that ran out of steam or collided with obstacle, dies.
-- Even if it pierced through an obstacle, but lost its payload
-- while altering the obstacle during piercing, it dies, too.
actorDying :: Actor -> Bool
actorDying :: Actor -> Bool
actorDying Actor
b = Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0
               Bool -> Bool -> Bool
|| Actor -> Bool
bproj Actor
b Bool -> Bool -> Bool
&& (Bool
-> (([Vector], Speed) -> Bool) -> Maybe ([Vector], Speed) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ([Vector] -> Bool
forall a. [a] -> Bool
null ([Vector] -> Bool)
-> (([Vector], Speed) -> [Vector]) -> ([Vector], Speed) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Vector], Speed) -> [Vector]
forall a b. (a, b) -> a
fst) (Actor -> Maybe ([Vector], Speed)
btrajectory Actor
b)
                              Bool -> Bool -> Bool
|| ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null (Actor -> ItemBag
beqp Actor
b))

hpTooLow :: Actor -> Ability.Skills -> Bool
hpTooLow :: Actor -> Skills -> Bool
hpTooLow Actor
b Skills
actorMaxSk =
  Int64
5 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int -> Int64
xM (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxHP Skills
actorMaxSk) Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Int64
xM Int
40
  Bool -> Bool -> Bool
|| Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
oneM

-- | Check if actor calm enough to perform some actions.
--
-- If max Calm is zero, always holds, to permit removing disastrous
-- equipped items, which would otherwise be stuck forever.
calmEnough :: Actor -> Ability.Skills -> Bool
calmEnough :: Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk =
  let calmMax :: Int
calmMax = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxCalm Skills
actorMaxSk
  in Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int -> Int64
xM Int
calmMax Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
3 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Actor -> Int64
bcalm Actor
b

calmFull :: Actor -> Ability.Skills -> Bool
calmFull :: Actor -> Skills -> Bool
calmFull Actor
b Skills
actorMaxSk =
  let calmMax :: Int
calmMax = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxCalm Skills
actorMaxSk
  in Int -> Int64
xM Int
calmMax Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Actor -> Int64
bcalm Actor
b

hpFull :: Actor -> Ability.Skills -> Bool
hpFull :: Actor -> Skills -> Bool
hpFull Actor
b Skills
actorMaxSk = Int -> Int64
xM (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxHP Skills
actorMaxSk) Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Actor -> Int64
bhp Actor
b

-- | Has the skill and can wake up easily, so can sleep safely.
canSleep :: Ability.Skills -> Bool
canSleep :: Skills -> Bool
canSleep Skills
actorMaxSk = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkWait Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
3
                      Bool -> Bool -> Bool
&& (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSight Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                          Bool -> Bool -> Bool
|| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkHearing Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)

-- | Can't loot, not too aggresive, so sometimes prefers to sleep
-- instead of exploring.
prefersSleep :: Ability.Skills -> Bool
prefersSleep :: Skills -> Bool
prefersSleep Skills
actorMaxSk = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMoveItem Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
                          Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkAggression Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2

checkAdjacent :: Actor -> Actor -> Bool
checkAdjacent :: Actor -> Actor -> Bool
checkAdjacent Actor
sb Actor
tb = Actor -> LevelId
blid Actor
sb LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
tb Bool -> Bool -> Bool
&& Point -> Point -> Bool
adjacent (Actor -> Point
bpos Actor
sb) (Actor -> Point
bpos Actor
tb)

eqpOverfull :: Actor -> Int -> Bool
eqpOverfull :: Actor -> Int -> Bool
eqpOverfull Actor
b Int
n = let size :: Int
size = [Int] -> Int
forall a. Num a => [a] -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, ItemTimers) -> Int) -> [(Int, ItemTimers)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, ItemTimers) -> Int
forall a b. (a, b) -> a
fst ([(Int, ItemTimers)] -> [Int]) -> [(Int, ItemTimers)] -> [Int]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [(Int, ItemTimers)]
forall k a. EnumMap k a -> [a]
EM.elems (ItemBag -> [(Int, ItemTimers)]) -> ItemBag -> [(Int, ItemTimers)]
forall a b. (a -> b) -> a -> b
$ Actor -> ItemBag
beqp Actor
b
                  in Bool -> Bool -> Bool
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
10 Bool -> (Actor, Int, Int) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (Actor
b, Int
n, Int
size))
                     (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Int
size Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10

eqpFreeN :: Actor -> Int
eqpFreeN :: Actor -> Int
eqpFreeN Actor
b = let size :: Int
size = [Int] -> Int
forall a. Num a => [a] -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, ItemTimers) -> Int) -> [(Int, ItemTimers)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, ItemTimers) -> Int
forall a b. (a, b) -> a
fst ([(Int, ItemTimers)] -> [Int]) -> [(Int, ItemTimers)] -> [Int]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [(Int, ItemTimers)]
forall k a. EnumMap k a -> [a]
EM.elems (ItemBag -> [(Int, ItemTimers)]) -> ItemBag -> [(Int, ItemTimers)]
forall a b. (a -> b) -> a -> b
$ Actor -> ItemBag
beqp Actor
b
             in Bool -> Int -> Int
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
size Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
10 Bool -> (Actor, Int) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (Actor
b, Int
size))
                (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
size

getCarriedIidsAndTrunk :: Actor -> [ItemId]
getCarriedIidsAndTrunk :: Actor -> [ItemId]
getCarriedIidsAndTrunk Actor
b =
  -- The trunk is important for a case of spotting a caught projectile
  -- with a stolen projecting item. This actually does happen.
  let trunk :: ItemBag
trunk = ItemId -> (Int, ItemTimers) -> ItemBag
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton (Actor -> ItemId
btrunk Actor
b) (Int, ItemTimers)
quantSingle
  in ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (ItemBag -> [ItemId]) -> ItemBag -> [ItemId]
forall a b. (a -> b) -> a -> b
$ ((Int, ItemTimers) -> (Int, ItemTimers) -> (Int, ItemTimers))
-> [ItemBag] -> ItemBag
forall a k. (a -> a -> a) -> [EnumMap k a] -> EnumMap k a
EM.unionsWith (Int, ItemTimers) -> (Int, ItemTimers) -> (Int, ItemTimers)
forall a b. a -> b -> a
const [Actor -> ItemBag
beqp Actor
b, Actor -> ItemBag
borgan Actor
b, ItemBag
trunk]

getCarriedIidCStore :: Actor -> [(ItemId, CStore)]
getCarriedIidCStore :: Actor -> [(ItemId, CStore)]
getCarriedIidCStore Actor
b =
  let bagCarried :: (t, EnumMap t a) -> [(t, t)]
bagCarried (t
cstore, EnumMap t a
bag) = (t -> (t, t)) -> [t] -> [(t, t)]
forall a b. (a -> b) -> [a] -> [b]
map (,t
cstore) ([t] -> [(t, t)]) -> [t] -> [(t, t)]
forall a b. (a -> b) -> a -> b
$ EnumMap t a -> [t]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys EnumMap t a
bag
  in ((CStore, ItemBag) -> [(ItemId, CStore)])
-> [(CStore, ItemBag)] -> [(ItemId, CStore)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (CStore, ItemBag) -> [(ItemId, CStore)]
forall t t a. Enum t => (t, EnumMap t a) -> [(t, t)]
bagCarried [(CStore
CEqp, Actor -> ItemBag
beqp Actor
b), (CStore
COrgan, Actor -> ItemBag
borgan Actor
b)]

-- | Chance, in parts per million, that a new monster is generated.
-- Depends on the number of monsters already present, and on the level depth
-- and its cave kind.
--
-- Note that sometimes monsters spawn in groups, increasing danger,
-- but many monsters are generated asleep, decreasing initial danger.
monsterGenChance :: Dice.AbsDepth -> Dice.AbsDepth -> Int -> Int -> Int
monsterGenChance :: AbsDepth -> AbsDepth -> Int -> Int -> Int
monsterGenChance (Dice.AbsDepth Int
ldepth) (Dice.AbsDepth Int
totalDepth)
                 Int
lvlSpawned Int
actorCoeff =
  Bool -> Int -> Int
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
totalDepth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
ldepth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$  -- ensured by content validation
    -- Heroes have to endure a level-depth-proportional wave of almost
    -- immediate spawners for each level. Then the monsters start
    -- to trickle more and more slowly, at the speed dictated
    -- by @actorCoeff@ specified in cave kind. Finally, spawning flattens out
    -- to ensure that camping is never safe.
    let scaledDepth :: Int
scaledDepth = Int
ldepth Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
totalDepth
        maxCoeff :: Int
maxCoeff = Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
30
          -- spawning on a level with benign @actorCoeff@ flattens out
          -- after 30+depth spawns and on a level with fast spawning
          -- flattens out later, but ending at the same level
        coeff :: Int
coeff = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
maxCoeff
                (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
actorCoeff Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
lvlSpawned Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
scaledDepth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
        million :: Int
million = Int
1000000
    in Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
million Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
coeff

-- | How long until an actor's smell vanishes from a tile.
smellTimeout :: Delta Time
smellTimeout :: Delta Time
smellTimeout = Delta Time -> Int -> Delta Time
timeDeltaScale (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeTurn) Int
200