{-# LANGUAGE TupleSections #-}
-- | Handle effects. They are most often caused by requests sent by clients
-- but sometimes also caused by projectiles or periodically activated items.
module Game.LambdaHack.Server.HandleEffectM
  ( UseResult(..), EffToUse(..), EffApplyFlags(..)
  , applyItem, cutCalm, kineticEffectAndDestroy, effectAndDestroyAndAddKill
  , itemEffectEmbedded, highestImpression, dominateFidSfx
  , dropAllEquippedItems, pickDroppable, consumeItems, dropCStoreItem
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , applyKineticDamage, refillHP, effectAndDestroy, imperishableKit
  , itemEffectDisco, effectSem
  , effectBurn, effectExplode, effectRefillHP, effectRefillCalm
  , effectDominate, dominateFid, effectImpress, effectPutToSleep, effectYell
  , effectSummon, effectAscend, findStairExit, switchLevels1, switchLevels2
  , effectEscape, effectParalyze, paralyze, effectParalyzeInWater
  , effectInsertMove, effectTeleport, effectCreateItem
  , effectDestroyItem, effectDropItem, effectConsumeItems
  , effectRecharge, effectPolyItem, effectRerollItem, effectDupItem
  , effectIdentify, identifyIid, effectDetect, effectDetectX, effectSendFlying
  , sendFlyingVector, effectApplyPerfume, effectAtMostOneOf, effectOneOf
  , effectAndEffect, effectAndEffectSem, effectOrEffect, effectSeqEffect
  , effectWhen, effectUnless, effectIfThenElse
  , effectVerbNoLonger, effectVerbMsg, effectVerbMsgFail
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Bits (xor)
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import qualified Data.HashMap.Strict as HM
import           Data.Int (Int64)
import           Data.Key (mapWithKeyM_)
import qualified Data.Text as T

import           Game.LambdaHack.Atomic
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.Analytics
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Level
import           Game.LambdaHack.Common.Misc
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.Perception
import           Game.LambdaHack.Common.Point
import           Game.LambdaHack.Common.ReqFailure
import           Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Common.Vector
import           Game.LambdaHack.Content.FactionKind
import           Game.LambdaHack.Content.ItemKind (ItemKind)
import qualified Game.LambdaHack.Content.ItemKind as IK
import           Game.LambdaHack.Content.RuleKind
import qualified Game.LambdaHack.Core.Dice as Dice
import           Game.LambdaHack.Core.Random
import           Game.LambdaHack.Definition.Ability (ActivationFlag (..))
import qualified Game.LambdaHack.Definition.Ability as Ability
import           Game.LambdaHack.Definition.Defs
import           Game.LambdaHack.Server.CommonM
import           Game.LambdaHack.Server.ItemM
import           Game.LambdaHack.Server.ItemRev
import           Game.LambdaHack.Server.MonadServer
import           Game.LambdaHack.Server.PeriodicM
import           Game.LambdaHack.Server.ServerOptions
import           Game.LambdaHack.Server.State

-- * Semantics of effects

data UseResult = UseDud | UseId | UseUp
  deriving (UseResult -> UseResult -> Bool
(UseResult -> UseResult -> Bool)
-> (UseResult -> UseResult -> Bool) -> Eq UseResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UseResult -> UseResult -> Bool
== :: UseResult -> UseResult -> Bool
$c/= :: UseResult -> UseResult -> Bool
/= :: UseResult -> UseResult -> Bool
Eq, Eq UseResult
Eq UseResult =>
(UseResult -> UseResult -> Ordering)
-> (UseResult -> UseResult -> Bool)
-> (UseResult -> UseResult -> Bool)
-> (UseResult -> UseResult -> Bool)
-> (UseResult -> UseResult -> Bool)
-> (UseResult -> UseResult -> UseResult)
-> (UseResult -> UseResult -> UseResult)
-> Ord UseResult
UseResult -> UseResult -> Bool
UseResult -> UseResult -> Ordering
UseResult -> UseResult -> UseResult
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
$ccompare :: UseResult -> UseResult -> Ordering
compare :: UseResult -> UseResult -> Ordering
$c< :: UseResult -> UseResult -> Bool
< :: UseResult -> UseResult -> Bool
$c<= :: UseResult -> UseResult -> Bool
<= :: UseResult -> UseResult -> Bool
$c> :: UseResult -> UseResult -> Bool
> :: UseResult -> UseResult -> Bool
$c>= :: UseResult -> UseResult -> Bool
>= :: UseResult -> UseResult -> Bool
$cmax :: UseResult -> UseResult -> UseResult
max :: UseResult -> UseResult -> UseResult
$cmin :: UseResult -> UseResult -> UseResult
min :: UseResult -> UseResult -> UseResult
Ord)

data EffToUse = EffBare | EffBareAndOnCombine | EffOnCombine
  deriving EffToUse -> EffToUse -> Bool
(EffToUse -> EffToUse -> Bool)
-> (EffToUse -> EffToUse -> Bool) -> Eq EffToUse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EffToUse -> EffToUse -> Bool
== :: EffToUse -> EffToUse -> Bool
$c/= :: EffToUse -> EffToUse -> Bool
/= :: EffToUse -> EffToUse -> Bool
Eq

data EffApplyFlags = EffApplyFlags
  { EffApplyFlags -> EffToUse
effToUse            :: EffToUse
  , EffApplyFlags -> Bool
effVoluntary        :: Bool
  , EffApplyFlags -> Bool
effUseAllCopies     :: Bool
  , EffApplyFlags -> Bool
effKineticPerformed :: Bool
  , EffApplyFlags -> ActivationFlag
effActivation       :: Ability.ActivationFlag
  , EffApplyFlags -> Bool
effMayDestroy       :: Bool
  }

applyItem :: MonadServerAtomic m => ActorId -> ItemId -> CStore -> m ()
applyItem :: forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> ItemId -> CStore -> m ()
applyItem ActorId
aid ItemId
iid CStore
cstore = do
  SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> ItemId -> SfxAtomic
SfxApply ActorId
aid ItemId
iid
  let c :: Container
c = ActorId -> CStore -> Container
CActor ActorId
aid CStore
cstore
  -- Treated as if the actor hit himself with the item as a weapon,
  -- incurring both the kinetic damage and effect, hence the same call
  -- as in @reqMelee@.
  let effApplyFlags :: EffApplyFlags
effApplyFlags = EffApplyFlags
        { effToUse :: EffToUse
effToUse            = EffToUse
EffBareAndOnCombine
        , effVoluntary :: Bool
effVoluntary        = Bool
True
        , effUseAllCopies :: Bool
effUseAllCopies     = Bool
False
        , effKineticPerformed :: Bool
effKineticPerformed = Bool
False
        , effActivation :: ActivationFlag
effActivation       = ActivationFlag
ActivationTrigger
        , effMayDestroy :: Bool
effMayDestroy       = Bool
True
        }
  m UseResult -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m UseResult -> m ()) -> m UseResult -> m ()
forall a b. (a -> b) -> a -> b
$ EffApplyFlags
-> ActorId
-> ActorId
-> ActorId
-> ItemId
-> Container
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
EffApplyFlags
-> ActorId
-> ActorId
-> ActorId
-> ItemId
-> Container
-> m UseResult
kineticEffectAndDestroy EffApplyFlags
effApplyFlags ActorId
aid ActorId
aid ActorId
aid ItemId
iid Container
c

applyKineticDamage :: MonadServerAtomic m
                   => ActorId -> ActorId -> ItemId -> m Bool
applyKineticDamage :: forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> ActorId -> ItemId -> m Bool
applyKineticDamage ActorId
source ActorId
target ItemId
iid = do
  itemKind <- (State -> ItemKind) -> m ItemKind
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemKind) -> m ItemKind)
-> (State -> ItemKind) -> m ItemKind
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemKind
getIidKindServer ItemId
iid
  if IK.idamage itemKind == 0 then return False else do  -- speedup
    sb <- getsState $ getActorBody source
    hurtMult <- getsState $ armorHurtBonus source target
    totalDepth <- getsState stotalDepth
    Level{ldepth} <- getLevel (blid sb)
    dmg <- rndToAction $ castDice ldepth totalDepth $ IK.idamage itemKind
    let rawDeltaHP = forall target source. From source target => source -> target
into @Int64 Int
hurtMult Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int -> Int64
xM Int
dmg Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`divUp` Int64
100
        speedDeltaHP = case Actor -> Maybe ([Vector], Speed)
btrajectory Actor
sb of
          Just ([Vector]
_, Speed
speed) | Actor -> Bool
bproj Actor
sb -> - Int64 -> Speed -> Int64
modifyDamageBySpeed Int64
rawDeltaHP Speed
speed
          Maybe ([Vector], Speed)
_ -> - Int64
rawDeltaHP
    if speedDeltaHP < 0 then do  -- damage the target, never heal
      refillHP source target speedDeltaHP
      return True
    else return False

refillHP :: MonadServerAtomic m => ActorId -> ActorId -> Int64 -> m ()
refillHP :: forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> ActorId -> Int64 -> m ()
refillHP ActorId
source ActorId
target Int64
speedDeltaHP = Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int64
speedDeltaHP Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Int64
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  tbOld <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
  actorMaxSk <- getsState $ getActorMaxSkills target
  -- We don't ignore even tiny HP drains, because they can be very weak
  -- enemy projectiles and so will recur and in total can be deadly
  -- and also AI should rather be stupidly aggressive than stupidly lethargic.
  let serious = ActorId
source ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
target Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
tbOld)
      hpMax = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxHP Skills
actorMaxSk
      deltaHP0 | Bool
serious Bool -> Bool -> Bool
&& Int64
speedDeltaHP Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
minusM =
                 -- If overfull, at least cut back to max, unless minor drain.
                 Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min Int64
speedDeltaHP (Int -> Int64
xM Int
hpMax Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Actor -> Int64
bhp Actor
tbOld)
               | Bool
otherwise = Int64
speedDeltaHP
      deltaHP = if | Int64
deltaHP0 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0 Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
tbOld Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int64
xM Int
999 ->  -- UI limit
                     Int64
tenthM  -- avoid nop, to avoid loops
                   | Int64
deltaHP0 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0 Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
tbOld Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< - Int -> Int64
xM Int
999 ->
                     -Int64
tenthM
                   | Bool
otherwise -> Int64
deltaHP0
  execUpdAtomic $ UpdRefillHP target deltaHP
  when serious $ cutCalm target
  tb <- getsState $ getActorBody target
  fact <- getsState $ (EM.! bfid tb) . sfactionD
  when (not (bproj tb) && fhasPointman (gkind fact)) $
    -- If leader just lost all HP, change the leader early (not when destroying
    -- the actor), to let players rescue him, especially if he's slowed
    -- by the attackers.
    when (bhp tb <= 0 && bhp tbOld > 0) $ do
      -- If all other party members dying, leadership will switch
      -- to one of them, which seems questionable, but it's rare
      -- and the disruption servers to underline the dire circumstance.
      electLeader (bfid tb) (blid tb) target
      mleader <- getsState $ gleader . (EM.! bfid tb) . sfactionD
      -- If really nobody else in the party, make him the leader back again
      -- on the oft chance that he gets revived by a projectile, etc.
      when (isNothing mleader) $
        execUpdAtomic $ UpdLeadFaction (bfid tb) Nothing $ Just target

cutCalm :: MonadServerAtomic m => ActorId -> m ()
cutCalm :: forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
cutCalm ActorId
target = do
  tb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
  actorMaxSk <- getsState $ getActorMaxSkills target
  let upperBound = if Actor -> Skills -> Bool
hpTooLow Actor
tb Skills
actorMaxSk
                   then Int64
2  -- to trigger domination on next attack, etc.
                   else Int -> Int64
xM (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxCalm Skills
actorMaxSk
      deltaCalm = Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min Int64
minusM2 (Int64
upperBound Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Actor -> Int64
bcalm Actor
tb)
  -- HP loss decreases Calm by at least @minusM2@ to avoid "hears something",
  -- which is emitted when decreasing Calm by @minusM1@.
  updateCalm target deltaCalm

-- Here kinetic damage is applied. This is necessary so that the same
-- AI benefit calculation may be used for flinging and for applying items.
kineticEffectAndDestroy :: MonadServerAtomic m
                        => EffApplyFlags
                        -> ActorId -> ActorId -> ActorId -> ItemId -> Container
                        -> m UseResult
kineticEffectAndDestroy :: forall (m :: * -> *).
MonadServerAtomic m =>
EffApplyFlags
-> ActorId
-> ActorId
-> ActorId
-> ItemId
-> Container
-> m UseResult
kineticEffectAndDestroy effApplyFlags0 :: EffApplyFlags
effApplyFlags0@EffApplyFlags{Bool
ActivationFlag
EffToUse
effToUse :: EffApplyFlags -> EffToUse
effVoluntary :: EffApplyFlags -> Bool
effUseAllCopies :: EffApplyFlags -> Bool
effKineticPerformed :: EffApplyFlags -> Bool
effActivation :: EffApplyFlags -> ActivationFlag
effMayDestroy :: EffApplyFlags -> Bool
effToUse :: EffToUse
effVoluntary :: Bool
effUseAllCopies :: Bool
effKineticPerformed :: Bool
effActivation :: ActivationFlag
effMayDestroy :: Bool
..}
                        ActorId
killer ActorId
source ActorId
target ItemId
iid Container
c = do
  bag <- (State -> ItemBag) -> m ItemBag
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Container -> State -> ItemBag
getContainerBag Container
c
  case iid `EM.lookup` bag of
    Maybe ItemQuant
Nothing -> [Char] -> m UseResult
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> m UseResult) -> [Char] -> m UseResult
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> (ActorId, ActorId, ItemId, Container) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (ActorId
source, ActorId
target, ItemId
iid, Container
c)
    Just ItemQuant
kit -> do
      itemFull <- (State -> ItemFull) -> m ItemFull
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
      tbOld <- getsState $ getActorBody target
      localTime <- getsState $ getLocalTime (blid tbOld)
      let recharged = Time -> ItemQuant -> Bool
hasCharge Time
localTime ItemQuant
kit
      -- If neither kinetic hit nor any effect is activated, there's no chance
      -- the items can be destroyed or even timeout changes, so we abort early.
      if not recharged then return UseDud else do
        effKineticPerformed2 <- applyKineticDamage source target iid
        tb <- getsState $ getActorBody target
        -- Sometimes victim heals just after we registered it as killed,
        -- but that's OK, an actor killed two times is similar enough
        -- to two killed.
        when (effKineticPerformed2  -- speedup
              && bhp tb <= 0 && bhp tbOld > 0) $ do
          sb <- getsState $ getActorBody source
          arWeapon <- getsState $ (EM.! iid) . sdiscoAspect
          let killHow | Bool -> Bool
not (Actor -> Bool
bproj Actor
sb) =
                        if Bool
effVoluntary
                        then KillHow
KillKineticMelee
                        else KillHow
KillKineticPush
                      | Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arWeapon = KillHow
KillKineticBlast
                      | Bool
otherwise = KillHow
KillKineticRanged
          addKillToAnalytics killer killHow (bfid tbOld) (btrunk tbOld)
        let effApplyFlags = EffApplyFlags
effApplyFlags0
              { effUseAllCopies     = fst kit <= 1
              , effKineticPerformed = effKineticPerformed2
              }
        effectAndDestroyAndAddKill effApplyFlags
                                   killer source target iid c itemFull

effectAndDestroyAndAddKill :: MonadServerAtomic m
                           => EffApplyFlags
                           -> ActorId -> ActorId -> ActorId -> ItemId
                           -> Container -> ItemFull
                           -> m UseResult
effectAndDestroyAndAddKill :: forall (m :: * -> *).
MonadServerAtomic m =>
EffApplyFlags
-> ActorId
-> ActorId
-> ActorId
-> ItemId
-> Container
-> ItemFull
-> m UseResult
effectAndDestroyAndAddKill effApplyFlags0 :: EffApplyFlags
effApplyFlags0@EffApplyFlags{Bool
ActivationFlag
EffToUse
effToUse :: EffApplyFlags -> EffToUse
effVoluntary :: EffApplyFlags -> Bool
effUseAllCopies :: EffApplyFlags -> Bool
effKineticPerformed :: EffApplyFlags -> Bool
effActivation :: EffApplyFlags -> ActivationFlag
effMayDestroy :: EffApplyFlags -> Bool
effToUse :: EffToUse
effVoluntary :: Bool
effUseAllCopies :: Bool
effKineticPerformed :: Bool
effActivation :: ActivationFlag
effMayDestroy :: Bool
..}
                           ActorId
killer ActorId
source ActorId
target ItemId
iid Container
c ItemFull
itemFull = do
  tbOld <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
  triggered <- effectAndDestroy effApplyFlags0 source target iid c itemFull
  tb <- getsState $ getActorBody target
  -- Sometimes victim heals just after we registered it as killed,
  -- but that's OK, an actor killed two times is similar enough to two killed.
  when (bhp tb <= 0 && bhp tbOld > 0) $ do
    sb <- getsState $ getActorBody source
    arWeapon <- getsState $ (EM.! iid) . sdiscoAspect
    let killHow | Bool -> Bool
not (Actor -> Bool
bproj Actor
sb) =
                  if Bool
effVoluntary then KillHow
KillOtherMelee else KillHow
KillOtherPush
                | Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arWeapon = KillHow
KillOtherBlast
                | Bool
otherwise = KillHow
KillOtherRanged
    addKillToAnalytics killer killHow (bfid tbOld) (btrunk tbOld)
  return triggered

effectAndDestroy :: MonadServerAtomic m
                 => EffApplyFlags
                 -> ActorId -> ActorId -> ItemId -> Container -> ItemFull
                 -> m UseResult
effectAndDestroy :: forall (m :: * -> *).
MonadServerAtomic m =>
EffApplyFlags
-> ActorId
-> ActorId
-> ItemId
-> Container
-> ItemFull
-> m UseResult
effectAndDestroy effApplyFlags0 :: EffApplyFlags
effApplyFlags0@EffApplyFlags{Bool
ActivationFlag
EffToUse
effToUse :: EffApplyFlags -> EffToUse
effVoluntary :: EffApplyFlags -> Bool
effUseAllCopies :: EffApplyFlags -> Bool
effKineticPerformed :: EffApplyFlags -> Bool
effActivation :: EffApplyFlags -> ActivationFlag
effMayDestroy :: EffApplyFlags -> Bool
effToUse :: EffToUse
effVoluntary :: Bool
effUseAllCopies :: Bool
effKineticPerformed :: Bool
effActivation :: ActivationFlag
effMayDestroy :: Bool
..} ActorId
source ActorId
target ItemId
iid Container
container
                 itemFull :: ItemFull
itemFull@ItemFull{ItemDisco
itemDisco :: ItemDisco
itemDisco :: ItemFull -> ItemDisco
itemDisco, ContentId ItemKind
itemKindId :: ContentId ItemKind
itemKindId :: ItemFull -> ContentId ItemKind
itemKindId, ItemKind
itemKind :: ItemKind
itemKind :: ItemFull -> ItemKind
itemKind} = do
  bag <- (State -> ItemBag) -> m ItemBag
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Container -> State -> ItemBag
getContainerBag Container
container
  let (itemK, itemTimers) = bag EM.! iid
      effs = case EffToUse
effToUse of
        EffToUse
EffBare -> if ActivationFlag
effActivation ActivationFlag -> ActivationFlag -> Bool
forall a. Eq a => a -> a -> Bool
== ActivationFlag
ActivationOnSmash
                   then ItemKind -> [Effect]
IK.strengthOnSmash ItemKind
itemKind
                   else ItemKind -> [Effect]
IK.ieffects ItemKind
itemKind
        EffToUse
EffBareAndOnCombine ->
          ItemKind -> [Effect]
IK.ieffects ItemKind
itemKind [Effect] -> [Effect] -> [Effect]
forall a. [a] -> [a] -> [a]
++ ItemKind -> [Effect]
IK.strengthOnCombine ItemKind
itemKind
        EffToUse
EffOnCombine -> ItemKind -> [Effect]
IK.strengthOnCombine ItemKind
itemKind
      arItem = case ItemDisco
itemDisco of
        ItemDiscoFull AspectRecord
itemAspect -> AspectRecord
itemAspect
        ItemDisco
_ -> [Char] -> AspectRecord
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
"effectAndDestroy: server ignorant about an item"
      timeout = AspectRecord -> Int
IA.aTimeout AspectRecord
arItem
  lid <- getsState $ lidFromC container
  localTime <- getsState $ getLocalTime lid
  let it1 = (ItemTimer -> Bool) -> ItemTimers -> ItemTimers
forall a. (a -> Bool) -> [a] -> [a]
filter (Time -> ItemTimer -> Bool
charging Time
localTime) ItemTimers
itemTimers
      len = ItemTimers -> Int
forall a. [a] -> Int
length ItemTimers
it1
      recharged = Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
itemK
                  Bool -> Bool -> Bool
|| ActivationFlag
effActivation ActivationFlag -> [ActivationFlag] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ActivationFlag
ActivationOnSmash, ActivationFlag
ActivationConsume]
  -- If the item has no charges and the special cases don't apply
  -- we speed up by shortcutting early, because we don't need to activate
  -- effects and we know kinetic hit was not performed (no charges to do so
  -- and in case of @OnSmash@ and @ActivationConsume@,
  -- only effects are triggered).
  if not recharged then return UseDud else do
    let timeoutTurns = Delta Time -> Int -> Delta Time
timeDeltaScale (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeTurn) Int
timeout
        newItemTimer = Time -> Delta Time -> ItemTimer
createItemTimer Time
localTime Delta Time
timeoutTurns
        it2 = if Int
timeout Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Bool
recharged
              then if ActivationFlag
effActivation ActivationFlag -> ActivationFlag -> Bool
forall a. Eq a => a -> a -> Bool
== ActivationFlag
ActivationPeriodic
                      Bool -> Bool -> Bool
&& Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Fragile AspectRecord
arItem
                   then Int -> ItemTimer -> ItemTimers
forall a. Int -> a -> [a]
replicate (Int
itemK Int -> Int -> Int
forall a. Num a => a -> a -> a
- ItemTimers -> Int
forall a. [a] -> Int
length ItemTimers
it1) ItemTimer
newItemTimer ItemTimers -> ItemTimers -> ItemTimers
forall a. [a] -> [a] -> [a]
++ ItemTimers
it1
                           -- copies are spares only; one fires, all discharge
                   else Int -> ItemTimers -> ItemTimers
forall a. Int -> [a] -> [a]
take (Int
itemK Int -> Int -> Int
forall a. Num a => a -> a -> a
- ItemTimers -> Int
forall a. [a] -> Int
length ItemTimers
it1) [ItemTimer
newItemTimer] ItemTimers -> ItemTimers -> ItemTimers
forall a. [a] -> [a] -> [a]
++ ItemTimers
it1
                           -- copies all fire, turn by turn; <= 1 discharges
              else ItemTimers
itemTimers
        kit2 = (Int
1, Int -> ItemTimers -> ItemTimers
forall a. Int -> [a] -> [a]
take Int
1 ItemTimers
it2)
        !_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
itemK Bool -> (ActorId, ActorId, ItemId, Container) -> Bool
forall v. Show v => Bool -> v -> Bool
`blame` (ActorId
source, ActorId
target, ItemId
iid, Container
container)) ()
    -- We use up the charge even if eventualy every effect fizzles. Tough luck.
    -- At least we don't destroy the item in such case.
    -- Also, we ID it regardless.
    unless (itemTimers == it2) $
      execUpdAtomic $ UpdTimeItem iid container itemTimers it2
    -- We have to destroy the item before the effect affects the item
    -- or affects the actor holding it or standing on it (later on we could
    -- lose track of the item and wouldn't be able to destroy it) .
    -- This is OK, because we don't remove the item type from various
    -- item dictionaries, just an individual copy from the container,
    -- so, e.g., the item can be identified after it's removed.
    let imperishable = Bool -> Bool
not Bool
effMayDestroy
                       Bool -> Bool -> Bool
|| ActivationFlag -> ItemFull -> Bool
imperishableKit ActivationFlag
effActivation ItemFull
itemFull
    unless imperishable $
      execUpdAtomic $ UpdLoseItem False iid kit2 container
    -- At this point, the item is potentially no longer in container
    -- @container@, therefore beware of assuming so in the code below.
    triggeredEffect <- itemEffectDisco effApplyFlags0 source target iid
                                       itemKindId itemKind container effs
    sb <- getsState $ getActorBody source
    let triggered = if Bool
effKineticPerformed then UseResult
UseUp else UseResult
triggeredEffect
        mEmbedPos = case Container
container of
          CEmbed LevelId
_ Point
p -> Point -> Maybe Point
forall a. a -> Maybe a
Just Point
p
          Container
_ -> Maybe Point
forall a. Maybe a
Nothing
    if | triggered == UseUp
         && mEmbedPos /= Just (bpos sb)  -- treading water, etc.
         && effActivation `notElem` [ActivationTrigger, ActivationMeleeable]
              -- do not repeat almost the same msg
         && (effActivation /= ActivationOnSmash  -- only tells condition ends
             && effActivation /= ActivationPeriodic
             || not (IA.checkFlag Ability.Condition arItem)) -> do
           -- Effects triggered; main feedback comes from them,
           -- but send info so that clients can log it.
           let verbose = ActivationFlag
effActivation ActivationFlag -> ActivationFlag -> Bool
forall a. Eq a => a -> a -> Bool
== ActivationFlag
ActivationUnderRanged
                         Bool -> Bool -> Bool
|| ActivationFlag
effActivation ActivationFlag -> ActivationFlag -> Bool
forall a. Eq a => a -> a -> Bool
== ActivationFlag
ActivationUnderMelee
           execSfxAtomic $ SfxItemApplied verbose iid container
       | triggered /= UseUp
         && effActivation /= ActivationOnSmash
         && effActivation /= ActivationPeriodic
              -- periodic effects repeat and so spam
         && effActivation
            `notElem` [ActivationUnderRanged, ActivationUnderMelee]
              -- and so do effects under attack
         && not (bproj sb)  -- projectiles can be very numerous
         && isNothing mEmbedPos  ->  -- embeds may be just flavour
           -- Announce no effect, which is rare and wastes time, so noteworthy.
           execSfxAtomic $ SfxMsgFid (bfid sb) $
             if any IK.forApplyEffect effs
             then SfxFizzles iid container
                    -- something didn't work despite promising effects
             else SfxNothingHappens iid container  -- fully expected
       | otherwise -> return ()  -- all the spam cases
    -- If none of item's effects nor a kinetic hit were performed,
    -- we recreate the item (assuming we deleted the item above).
    -- Regardless, we don't rewind the time, because some info is gained
    -- (that the item does not exhibit any effects in the given context).
    unless (imperishable || triggered == UseUp) $
      execUpdAtomic $ UpdSpotItem False iid kit2 container
    return triggered

imperishableKit :: ActivationFlag -> ItemFull -> Bool
imperishableKit :: ActivationFlag -> ItemFull -> Bool
imperishableKit ActivationFlag
effActivation ItemFull
itemFull =
  let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
  in Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Durable AspectRecord
arItem
     Bool -> Bool -> Bool
|| ActivationFlag
effActivation ActivationFlag -> ActivationFlag -> Bool
forall a. Eq a => a -> a -> Bool
== ActivationFlag
ActivationPeriodic
        Bool -> Bool -> Bool
&& Bool -> Bool
not (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Fragile AspectRecord
arItem)

-- The item is triggered exactly once. If there are more copies,
-- they are left to be triggered next time.
-- If the embed no longer exists at the given position, effect fizzles.
itemEffectEmbedded :: MonadServerAtomic m
                   => EffToUse -> Bool -> ActorId -> LevelId -> Point -> ItemId
                   -> m UseResult
itemEffectEmbedded :: forall (m :: * -> *).
MonadServerAtomic m =>
EffToUse
-> Bool -> ActorId -> LevelId -> Point -> ItemId -> m UseResult
itemEffectEmbedded EffToUse
effToUse Bool
effVoluntary ActorId
aid LevelId
lid Point
tpos ItemId
iid = do
  embeds2 <- (State -> ItemBag) -> m ItemBag
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> State -> ItemBag
getEmbedBag LevelId
lid Point
tpos
    -- might have changed due to other embedded items invocations
  if iid `EM.notMember` embeds2
  then return UseDud
  else do
    -- First embedded item may move actor to another level, so @lid@
    -- may be unequal to @blid sb@.
    let c = LevelId -> Point -> Container
CEmbed LevelId
lid Point
tpos
    -- Treated as if the actor hit himself with the embedded item as a weapon,
    -- incurring both the kinetic damage and effect, hence the same call
    -- as in @reqMelee@. Information whether this happened due to being pushed
    -- is preserved, but how did the pushing is lost, so we blame the victim.
    let effApplyFlags = EffApplyFlags
          { EffToUse
effToUse :: EffToUse
effToUse :: EffToUse
effToUse
          , Bool
effVoluntary :: Bool
effVoluntary :: Bool
effVoluntary
          , effUseAllCopies :: Bool
effUseAllCopies     = Bool
False
          , effKineticPerformed :: Bool
effKineticPerformed = Bool
False
          , effActivation :: ActivationFlag
effActivation       = if EffToUse
effToUse EffToUse -> EffToUse -> Bool
forall a. Eq a => a -> a -> Bool
== EffToUse
EffOnCombine
                                  then ActivationFlag
ActivationOnCombine
                                  else ActivationFlag
ActivationEmbed
          , effMayDestroy :: Bool
effMayDestroy       = Bool
True
          }
    kineticEffectAndDestroy effApplyFlags aid aid aid iid c

-- | The source actor affects the target actor, with a given item.
-- If any of the effects fires up, the item gets identified.
-- Even using raw damage (beating the enemy with the magic wand,
-- for example) identifies the item. This means a costly @UpdDiscover@
-- is processed for each random timeout weapon hit and for most projectiles,
-- but at least not for most explosion particles nor plain organs.
-- And if not needed, the @UpdDiscover@ are eventually not sent to clients.
-- So, enemy missiles that hit us are no longer mysterious until picked up,
-- which is for the better, because the client knows their charging status
-- and so can generate accurate messages in the case when not recharged.
-- This also means that thrown consumables in flasks sturdy enough to cause
-- damage are always identified at hit, even if no effect activated.
-- So throwing them at foes is a better identification method than applying.
--
-- Note that if we activate a durable non-passive item, e.g., a spiked shield,
-- from the ground, it will get identified, which is perfectly fine,
-- until we want to add sticky armor that can't be easily taken off
-- (and, e.g., has some maluses).
itemEffectDisco :: MonadServerAtomic m
                => EffApplyFlags
                -> ActorId -> ActorId -> ItemId
                -> ContentId ItemKind -> ItemKind -> Container -> [IK.Effect]
                -> m UseResult
itemEffectDisco :: forall (m :: * -> *).
MonadServerAtomic m =>
EffApplyFlags
-> ActorId
-> ActorId
-> ItemId
-> ContentId ItemKind
-> ItemKind
-> Container
-> [Effect]
-> m UseResult
itemEffectDisco effApplyFlags0 :: EffApplyFlags
effApplyFlags0@EffApplyFlags{Bool
ActivationFlag
EffToUse
effToUse :: EffApplyFlags -> EffToUse
effVoluntary :: EffApplyFlags -> Bool
effUseAllCopies :: EffApplyFlags -> Bool
effKineticPerformed :: EffApplyFlags -> Bool
effActivation :: EffApplyFlags -> ActivationFlag
effMayDestroy :: EffApplyFlags -> Bool
effToUse :: EffToUse
effVoluntary :: Bool
effUseAllCopies :: Bool
effKineticPerformed :: Bool
effActivation :: ActivationFlag
effMayDestroy :: Bool
..}
                ActorId
source ActorId
target ItemId
iid ContentId ItemKind
itemKindId ItemKind
itemKind Container
c [Effect]
effs = do
  urs <- (Effect -> m UseResult) -> [Effect] -> m [UseResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (EffApplyFlags
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Effect
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
EffApplyFlags
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Effect
-> m UseResult
effectSem EffApplyFlags
effApplyFlags0 ActorId
source ActorId
target ItemId
iid Container
c) [Effect]
effs
  let ur = case [UseResult]
urs of
        [] -> UseResult
UseDud  -- there was no effects
        [UseResult]
_ -> [UseResult] -> UseResult
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [UseResult]
urs
  -- Note: @UseId@ suffices for identification, @UseUp@ is not necessary.
  when (ur >= UseId || effKineticPerformed) $
    identifyIid iid c itemKindId itemKind
  return ur

-- | Source actor affects target actor, with a given effect and it strength.
-- Both actors are on the current level and can be the same actor.
-- The item may or may not still be in the container.
effectSem :: MonadServerAtomic m
          => EffApplyFlags
          -> ActorId -> ActorId -> ItemId -> Container -> IK.Effect
          -> m UseResult
effectSem :: forall (m :: * -> *).
MonadServerAtomic m =>
EffApplyFlags
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Effect
-> m UseResult
effectSem effApplyFlags0 :: EffApplyFlags
effApplyFlags0@EffApplyFlags{Bool
ActivationFlag
EffToUse
effToUse :: EffApplyFlags -> EffToUse
effVoluntary :: EffApplyFlags -> Bool
effUseAllCopies :: EffApplyFlags -> Bool
effKineticPerformed :: EffApplyFlags -> Bool
effActivation :: EffApplyFlags -> ActivationFlag
effMayDestroy :: EffApplyFlags -> Bool
effToUse :: EffToUse
effVoluntary :: Bool
effUseAllCopies :: Bool
effKineticPerformed :: Bool
effActivation :: ActivationFlag
effMayDestroy :: Bool
..}
          ActorId
source ActorId
target ItemId
iid Container
c Effect
effect = do
  let recursiveCall :: Effect -> m UseResult
recursiveCall = EffApplyFlags
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Effect
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
EffApplyFlags
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Effect
-> m UseResult
effectSem EffApplyFlags
effApplyFlags0 ActorId
source ActorId
target ItemId
iid Container
c
  sb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
source
  -- @execSfx@ usually comes last in effect semantics, but not always
  -- and we are likely to introduce more variety.
  let execSfx = SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> ActorId -> ItemId -> Effect -> Int64 -> SfxAtomic
SfxEffect (Actor -> FactionId
bfid Actor
sb) ActorId
target ItemId
iid Effect
effect Int64
0
      execSfxSource = SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> ActorId -> ItemId -> Effect -> Int64 -> SfxAtomic
SfxEffect (Actor -> FactionId
bfid Actor
sb) ActorId
source ItemId
iid Effect
effect Int64
0
  case effect of
    IK.Burn Dice
nDm -> Dice -> ActorId -> ActorId -> ItemId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
Dice -> ActorId -> ActorId -> ItemId -> m UseResult
effectBurn Dice
nDm ActorId
source ActorId
target ItemId
iid
    IK.Explode GroupName ItemKind
t -> m ()
-> GroupName ItemKind
-> ActorId
-> ActorId
-> Container
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m ()
-> GroupName ItemKind
-> ActorId
-> ActorId
-> Container
-> m UseResult
effectExplode m ()
execSfx GroupName ItemKind
t ActorId
source ActorId
target Container
c
    IK.RefillHP Int
p -> Int -> ActorId -> ActorId -> ItemId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
Int -> ActorId -> ActorId -> ItemId -> m UseResult
effectRefillHP Int
p ActorId
source ActorId
target ItemId
iid
    IK.RefillCalm Int
p -> m () -> Int -> ActorId -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> Int -> ActorId -> ActorId -> m UseResult
effectRefillCalm m ()
execSfx Int
p ActorId
source ActorId
target
    Effect
IK.Dominate -> ActorId -> ActorId -> ItemId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> ActorId -> ItemId -> m UseResult
effectDominate ActorId
source ActorId
target ItemId
iid
    Effect
IK.Impress -> (Effect -> m UseResult)
-> m () -> ActorId -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
(Effect -> m UseResult)
-> m () -> ActorId -> ActorId -> m UseResult
effectImpress Effect -> m UseResult
recursiveCall m ()
execSfx ActorId
source ActorId
target
    Effect
IK.PutToSleep -> m () -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ActorId -> m UseResult
effectPutToSleep m ()
execSfx ActorId
target
    Effect
IK.Yell -> m () -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ActorId -> m UseResult
effectYell m ()
execSfx ActorId
target
    IK.Summon GroupName ItemKind
grp Dice
nDm -> GroupName ItemKind
-> Dice
-> ItemId
-> ActorId
-> ActorId
-> ActivationFlag
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
GroupName ItemKind
-> Dice
-> ItemId
-> ActorId
-> ActorId
-> ActivationFlag
-> m UseResult
effectSummon GroupName ItemKind
grp Dice
nDm ItemId
iid ActorId
source ActorId
target ActivationFlag
effActivation
    IK.Ascend Bool
p -> (Effect -> m UseResult)
-> m () -> Bool -> ActorId -> ActorId -> Container -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
(Effect -> m UseResult)
-> m () -> Bool -> ActorId -> ActorId -> Container -> m UseResult
effectAscend Effect -> m UseResult
recursiveCall m ()
execSfx Bool
p ActorId
source ActorId
target Container
c
    IK.Escape{} -> m () -> ActorId -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ActorId -> ActorId -> m UseResult
effectEscape m ()
execSfx ActorId
source ActorId
target
    IK.Paralyze Dice
nDm -> m () -> Dice -> ActorId -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> Dice -> ActorId -> ActorId -> m UseResult
effectParalyze m ()
execSfx Dice
nDm ActorId
source ActorId
target
    IK.ParalyzeInWater Dice
nDm -> m () -> Dice -> ActorId -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> Dice -> ActorId -> ActorId -> m UseResult
effectParalyzeInWater m ()
execSfx Dice
nDm ActorId
source ActorId
target
    IK.InsertMove Dice
nDm -> m () -> Dice -> ActorId -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> Dice -> ActorId -> ActorId -> m UseResult
effectInsertMove m ()
execSfx Dice
nDm ActorId
source ActorId
target
    IK.Teleport Dice
nDm -> m () -> Dice -> ActorId -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> Dice -> ActorId -> ActorId -> m UseResult
effectTeleport m ()
execSfx Dice
nDm ActorId
source ActorId
target
    IK.CreateItem Maybe Int
mcount CStore
store GroupName ItemKind
grp TimerDice
tim ->
      Maybe FactionId
-> Maybe Int
-> ActorId
-> ActorId
-> Maybe ItemId
-> CStore
-> GroupName ItemKind
-> TimerDice
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
Maybe FactionId
-> Maybe Int
-> ActorId
-> ActorId
-> Maybe ItemId
-> CStore
-> GroupName ItemKind
-> TimerDice
-> m UseResult
effectCreateItem (FactionId -> Maybe FactionId
forall a. a -> Maybe a
Just (FactionId -> Maybe FactionId) -> FactionId -> Maybe FactionId
forall a b. (a -> b) -> a -> b
$ Actor -> FactionId
bfid Actor
sb) Maybe Int
mcount ActorId
source ActorId
target (ItemId -> Maybe ItemId
forall a. a -> Maybe a
Just ItemId
iid)
                       CStore
store GroupName ItemKind
grp TimerDice
tim
    IK.DestroyItem Int
n Int
k CStore
store GroupName ItemKind
grp ->
      m ()
-> Int
-> Int
-> CStore
-> ActorId
-> GroupName ItemKind
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m ()
-> Int
-> Int
-> CStore
-> ActorId
-> GroupName ItemKind
-> m UseResult
effectDestroyItem m ()
execSfx Int
n Int
k CStore
store ActorId
target GroupName ItemKind
grp
    IK.ConsumeItems [(Int, GroupName ItemKind)]
tools [(Int, GroupName ItemKind)]
raw -> m ()
-> ItemId
-> ActorId
-> [(Int, GroupName ItemKind)]
-> [(Int, GroupName ItemKind)]
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m ()
-> ItemId
-> ActorId
-> [(Int, GroupName ItemKind)]
-> [(Int, GroupName ItemKind)]
-> m UseResult
effectConsumeItems m ()
execSfx ItemId
iid ActorId
target [(Int, GroupName ItemKind)]
tools [(Int, GroupName ItemKind)]
raw
    IK.DropItem Int
n Int
k CStore
store GroupName ItemKind
grp -> m ()
-> ItemId
-> Int
-> Int
-> CStore
-> GroupName ItemKind
-> ActorId
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m ()
-> ItemId
-> Int
-> Int
-> CStore
-> GroupName ItemKind
-> ActorId
-> m UseResult
effectDropItem m ()
execSfx ItemId
iid Int
n Int
k CStore
store GroupName ItemKind
grp ActorId
target
    IK.Recharge Int
n Dice
dice -> Bool -> m () -> ItemId -> Int -> Dice -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> m () -> ItemId -> Int -> Dice -> ActorId -> m UseResult
effectRecharge Bool
True m ()
execSfx ItemId
iid Int
n Dice
dice ActorId
target
    IK.Discharge Int
n Dice
dice -> Bool -> m () -> ItemId -> Int -> Dice -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> m () -> ItemId -> Int -> Dice -> ActorId -> m UseResult
effectRecharge Bool
False m ()
execSfx ItemId
iid Int
n Dice
dice ActorId
target
    Effect
IK.PolyItem -> m () -> ItemId -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ItemId -> ActorId -> m UseResult
effectPolyItem m ()
execSfx ItemId
iid ActorId
target
    Effect
IK.RerollItem -> m () -> ItemId -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ItemId -> ActorId -> m UseResult
effectRerollItem m ()
execSfx ItemId
iid ActorId
target
    Effect
IK.DupItem -> m () -> ItemId -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ItemId -> ActorId -> m UseResult
effectDupItem m ()
execSfx ItemId
iid ActorId
target
    Effect
IK.Identify -> m () -> ItemId -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ItemId -> ActorId -> m UseResult
effectIdentify m ()
execSfx ItemId
iid ActorId
target
    IK.Detect DetectKind
d Int
radius -> m () -> DetectKind -> Int -> ActorId -> Container -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> DetectKind -> Int -> ActorId -> Container -> m UseResult
effectDetect m ()
execSfx DetectKind
d Int
radius ActorId
target Container
c
    IK.SendFlying ThrowMod
tmod ->
      m ()
-> ThrowMod
-> ActorId
-> ActorId
-> Container
-> Maybe Bool
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m ()
-> ThrowMod
-> ActorId
-> ActorId
-> Container
-> Maybe Bool
-> m UseResult
effectSendFlying m ()
execSfx ThrowMod
tmod ActorId
source ActorId
target Container
c Maybe Bool
forall a. Maybe a
Nothing
    IK.PushActor ThrowMod
tmod ->
      m ()
-> ThrowMod
-> ActorId
-> ActorId
-> Container
-> Maybe Bool
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m ()
-> ThrowMod
-> ActorId
-> ActorId
-> Container
-> Maybe Bool
-> m UseResult
effectSendFlying m ()
execSfx ThrowMod
tmod ActorId
source ActorId
target Container
c (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True)
    IK.PullActor ThrowMod
tmod ->
      m ()
-> ThrowMod
-> ActorId
-> ActorId
-> Container
-> Maybe Bool
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m ()
-> ThrowMod
-> ActorId
-> ActorId
-> Container
-> Maybe Bool
-> m UseResult
effectSendFlying m ()
execSfx ThrowMod
tmod ActorId
source ActorId
target Container
c (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False)
    Effect
IK.ApplyPerfume -> m () -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ActorId -> m UseResult
effectApplyPerfume m ()
execSfx ActorId
target
    IK.AtMostOneOf [Effect]
l -> (Effect -> m UseResult) -> [Effect] -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
(Effect -> m UseResult) -> [Effect] -> m UseResult
effectAtMostOneOf Effect -> m UseResult
recursiveCall [Effect]
l
    IK.OneOf [Effect]
l -> (Effect -> m UseResult) -> [Effect] -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
(Effect -> m UseResult) -> [Effect] -> m UseResult
effectOneOf Effect -> m UseResult
recursiveCall [Effect]
l
    IK.OnSmash Effect
_ -> UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud  -- ignored under normal circumstances
    IK.OnCombine Effect
_ -> UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud  -- ignored under normal circumstances
    IK.OnUser Effect
eff -> EffApplyFlags
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Effect
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
EffApplyFlags
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Effect
-> m UseResult
effectSem EffApplyFlags
effApplyFlags0 ActorId
source ActorId
source ItemId
iid Container
c Effect
eff
    Effect
IK.NopEffect -> UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud  -- all there is
    IK.AndEffect Effect
eff1 Effect
eff2 -> (Effect -> m UseResult)
-> ActorId -> Effect -> Effect -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
(Effect -> m UseResult)
-> ActorId -> Effect -> Effect -> m UseResult
effectAndEffect Effect -> m UseResult
recursiveCall ActorId
source Effect
eff1 Effect
eff2
    IK.OrEffect Effect
eff1 Effect
eff2 -> (Effect -> m UseResult)
-> FactionId -> Effect -> Effect -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
(Effect -> m UseResult)
-> FactionId -> Effect -> Effect -> m UseResult
effectOrEffect Effect -> m UseResult
recursiveCall (Actor -> FactionId
bfid Actor
sb) Effect
eff1 Effect
eff2
    IK.SeqEffect [Effect]
effs -> (Effect -> m UseResult) -> [Effect] -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
(Effect -> m UseResult) -> [Effect] -> m UseResult
effectSeqEffect Effect -> m UseResult
recursiveCall [Effect]
effs
    IK.When Condition
cond Effect
eff ->
      (Effect -> m UseResult)
-> ActorId -> Condition -> Effect -> ActivationFlag -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
(Effect -> m UseResult)
-> ActorId -> Condition -> Effect -> ActivationFlag -> m UseResult
effectWhen Effect -> m UseResult
recursiveCall ActorId
source Condition
cond Effect
eff ActivationFlag
effActivation
    IK.Unless Condition
cond Effect
eff ->
      (Effect -> m UseResult)
-> ActorId -> Condition -> Effect -> ActivationFlag -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
(Effect -> m UseResult)
-> ActorId -> Condition -> Effect -> ActivationFlag -> m UseResult
effectUnless Effect -> m UseResult
recursiveCall ActorId
source Condition
cond Effect
eff ActivationFlag
effActivation
    IK.IfThenElse Condition
cond Effect
eff1 Effect
eff2 ->
      (Effect -> m UseResult)
-> ActorId
-> Condition
-> Effect
-> Effect
-> ActivationFlag
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
(Effect -> m UseResult)
-> ActorId
-> Condition
-> Effect
-> Effect
-> ActivationFlag
-> m UseResult
effectIfThenElse Effect -> m UseResult
recursiveCall ActorId
source Condition
cond Effect
eff1 Effect
eff2 ActivationFlag
effActivation
    IK.VerbNoLonger{} -> Bool -> m () -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> m () -> ActorId -> m UseResult
effectVerbNoLonger Bool
effUseAllCopies m ()
execSfxSource ActorId
source
    IK.VerbMsg{} -> m () -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ActorId -> m UseResult
effectVerbMsg m ()
execSfxSource ActorId
source
    IK.VerbMsgFail{} -> m () -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ActorId -> m UseResult
effectVerbMsgFail m ()
execSfxSource ActorId
source

conditionSem :: MonadServer m
             => ActorId -> IK.Condition -> ActivationFlag -> m Bool
conditionSem :: forall (m :: * -> *).
MonadServer m =>
ActorId -> Condition -> ActivationFlag -> m Bool
conditionSem ActorId
source Condition
cond ActivationFlag
effActivation = do
  sb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
source
  return $! case cond of
    IK.HpLeq Int
n -> Actor -> Int64
bhp Actor
sb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Int64
xM Int
n
    IK.HpGeq Int
n -> Actor -> Int64
bhp Actor
sb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Int64
xM Int
n
    IK.CalmLeq Int
n -> Actor -> Int64
bcalm Actor
sb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Int64
xM Int
n
    IK.CalmGeq Int
n -> Actor -> Int64
bcalm Actor
sb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Int64
xM Int
n
    IK.TriggeredBy ActivationFlag
activationFlag -> ActivationFlag
activationFlag ActivationFlag -> ActivationFlag -> Bool
forall a. Eq a => a -> a -> Bool
== ActivationFlag
effActivation

-- * Individual semantic functions for effects

-- ** Burn

-- Damage from fire. Not affected by armor.
effectBurn :: MonadServerAtomic m
           => Dice.Dice -> ActorId -> ActorId -> ItemId -> m UseResult
effectBurn :: forall (m :: * -> *).
MonadServerAtomic m =>
Dice -> ActorId -> ActorId -> ItemId -> m UseResult
effectBurn Dice
nDm ActorId
source ActorId
target ItemId
iid = do
  tb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
  totalDepth <- getsState stotalDepth
  Level{ldepth} <- getLevel (blid tb)
  n0 <- rndToAction $ castDice ldepth totalDepth nDm
  let n = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
n0  -- avoid 0 and negative burn; validated in content anyway
      deltaHP = - Int -> Int64
xM Int
n
  sb <- getsState $ getActorBody source
  -- Display the effect more accurately.
  let reportedEffect = Dice -> Effect
IK.Burn (Dice -> Effect) -> Dice -> Effect
forall a b. (a -> b) -> a -> b
$ Int -> Dice
Dice.intToDice Int
n
  execSfxAtomic $ SfxEffect (bfid sb) target iid reportedEffect deltaHP
  refillHP source target deltaHP
  return UseUp

-- ** Explode

effectExplode :: MonadServerAtomic m
              => m () -> GroupName ItemKind -> ActorId -> ActorId -> Container
              -> m UseResult
effectExplode :: forall (m :: * -> *).
MonadServerAtomic m =>
m ()
-> GroupName ItemKind
-> ActorId
-> ActorId
-> Container
-> m UseResult
effectExplode m ()
execSfx GroupName ItemKind
cgroup ActorId
source ActorId
target Container
containerOrigin = do
  m ()
execSfx
  tb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
  oxy@(Point x y) <- getsState $ posFromC containerOrigin
  let itemFreq = [(GroupName ItemKind
cgroup, Int
1)]
      -- Explosion particles are placed among organs of the victim.
      -- TODO: when changing this code, perhaps use @containerOrigin@
      -- in place of @container@, but then remove @borgan@ from several
      -- functions that have the store hardwired.
      container = ActorId -> CStore -> Container
CActor ActorId
target CStore
COrgan
  -- Power depth of new items unaffected by number of spawned actors.
  Level{ldepth} <- getLevel $ blid tb
  freq <- prepareItemKind 0 ldepth itemFreq
  m2 <- rollAndRegisterItem False ldepth freq container Nothing
  acounter <- getsServer $ fromEnum . sacounter
  let (iid, (ItemFull{itemKind}, (itemK, _))) =
        fromMaybe (error $ "" `showFailure` cgroup) m2
      semiRandom = Text -> Int
T.length (ItemKind -> Text
IK.idesc ItemKind
itemKind)
      -- We pick a point at the border, not inside, to have a uniform
      -- distribution for the points the line goes through at each distance
      -- from the source. Otherwise, e.g., the points on cardinal
      -- and diagonal lines from the source would be more common.
      projectN Int
k10 Int
n = do
        -- Shape is deterministic for the explosion kind, except that is has
        -- two variants chosen according to time-dependent @veryRandom@.
        -- Choice from the variants prevents diagonal or cardinal directions
        -- being always safe for a given explosion kind.
        let shapeRandom :: Int
shapeRandom = Int
k10 Int -> Int -> Int
forall a. Bits a => a -> a -> a
`xor` (Int
semiRandom Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n)
            veryRandom :: Int
veryRandom = Int
shapeRandom Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
acounter Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
acounter Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
3
            fuzz :: Int
fuzz = Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
shapeRandom Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
5
            k :: Int
k | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
16 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
12 = Int
12
              | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
12 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
8 = Int
8
              | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
4 = Int
4
              | Bool
otherwise = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
16  -- fire in groups of 16 including old duds
            psDir4 :: [Point]
psDir4 =
              [ Int -> Int -> Point
Point (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
12) (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12)
              , Int -> Int -> Point
Point (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12) (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12)
              , Int -> Int -> Point
Point (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
12) (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
12)
              , Int -> Int -> Point
Point (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12) (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
12) ]
            psDir8 :: [Point]
psDir8 =
              [ Int -> Int -> Point
Point (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
12) Int
y
              , Int -> Int -> Point
Point (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12) Int
y
              , Int -> Int -> Point
Point Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12)
              , Int -> Int -> Point
Point Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
12) ]
            psFuzz :: [Point]
psFuzz =
              [ Int -> Int -> Point
Point (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
12) (Int -> Point) -> Int -> Point
forall a b. (a -> b) -> a -> b
$ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fuzz
              , Int -> Int -> Point
Point (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12) (Int -> Point) -> Int -> Point
forall a b. (a -> b) -> a -> b
$ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fuzz
              , Int -> Int -> Point
Point (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
12) (Int -> Point) -> Int -> Point
forall a b. (a -> b) -> a -> b
$ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
fuzz
              , Int -> Int -> Point
Point (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12) (Int -> Point) -> Int -> Point
forall a b. (a -> b) -> a -> b
$ Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
fuzz
              , (Int -> Int -> Point) -> Int -> Int -> Point
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Point
Point (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
12) (Int -> Point) -> Int -> Point
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fuzz
              , (Int -> Int -> Point) -> Int -> Int -> Point
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Point
Point (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12) (Int -> Point) -> Int -> Point
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fuzz
              , (Int -> Int -> Point) -> Int -> Int -> Point
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Point
Point (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
12) (Int -> Point) -> Int -> Point
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
fuzz
              , (Int -> Int -> Point) -> Int -> Int -> Point
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Point
Point (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12) (Int -> Point) -> Int -> Point
forall a b. (a -> b) -> a -> b
$ Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
fuzz ]
            randomReverse :: [[(Bool, Point)]] -> [[(Bool, Point)]]
randomReverse = if Int -> Bool
forall a. Integral a => a -> Bool
even Int
veryRandom then [[(Bool, Point)]] -> [[(Bool, Point)]]
forall a. a -> a
id else [[(Bool, Point)]] -> [[(Bool, Point)]]
forall a. [a] -> [a]
reverse
            ps :: [(Bool, Point)]
ps = Int -> [(Bool, Point)] -> [(Bool, Point)]
forall a. Int -> [a] -> [a]
take Int
k ([(Bool, Point)] -> [(Bool, Point)])
-> [(Bool, Point)] -> [(Bool, Point)]
forall a b. (a -> b) -> a -> b
$ [[(Bool, Point)]] -> [(Bool, Point)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Bool, Point)]] -> [(Bool, Point)])
-> [[(Bool, Point)]] -> [(Bool, Point)]
forall a b. (a -> b) -> a -> b
$
              [[(Bool, Point)]] -> [[(Bool, Point)]]
randomReverse
                [ [Bool] -> [Point] -> [(Bool, Point)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Bool -> [Bool]
forall a. a -> [a]
repeat Bool
True)  -- diagonal particles don't reach that far
                  ([Point] -> [(Bool, Point)]) -> [Point] -> [(Bool, Point)]
forall a b. (a -> b) -> a -> b
$ Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
take Int
4 (Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
drop ((Int
k10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
itemK Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fuzz) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4) ([Point] -> [Point]) -> [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ [Point] -> [Point]
forall a. (?callStack::CallStack) => [a] -> [a]
cycle [Point]
psDir4)
                , [Bool] -> [Point] -> [(Bool, Point)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False)  -- only some cardinal reach far
                  ([Point] -> [(Bool, Point)]) -> [Point] -> [(Bool, Point)]
forall a b. (a -> b) -> a -> b
$ Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
take Int
4 (Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
drop ((Int
k10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4) ([Point] -> [Point]) -> [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ [Point] -> [Point]
forall a. (?callStack::CallStack) => [a] -> [a]
cycle [Point]
psDir8) ]
              [[(Bool, Point)]] -> [[(Bool, Point)]] -> [[(Bool, Point)]]
forall a. [a] -> [a] -> [a]
++ [[Bool] -> [Point] -> [(Bool, Point)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Bool -> [Bool]
forall a. a -> [a]
repeat Bool
True)
                  ([Point] -> [(Bool, Point)]) -> [Point] -> [(Bool, Point)]
forall a b. (a -> b) -> a -> b
$ Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
take Int
8 (Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
drop ((Int
k10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fuzz) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8) ([Point] -> [Point]) -> [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ [Point] -> [Point]
forall a. (?callStack::CallStack) => [a] -> [a]
cycle [Point]
psFuzz)]
        [(Bool, Point)] -> ((Bool, Point) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t a -> (a -> m ()) -> m ()
forM_ [(Bool, Point)]
ps (((Bool, Point) -> m ()) -> m ())
-> ((Bool, Point) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(Bool
centerRaw, Point
tpxy) -> do
          let center :: Bool
center = Bool
centerRaw Bool -> Bool -> Bool
&& Int
itemK Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
8  -- if few, keep them regular
          mfail <- ActorId
-> ActorId
-> Point
-> Point
-> Int
-> Bool
-> ItemId
-> CStore
-> Bool
-> m (Maybe ReqFailure)
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId
-> ActorId
-> Point
-> Point
-> Int
-> Bool
-> ItemId
-> CStore
-> Bool
-> m (Maybe ReqFailure)
projectFail ActorId
source ActorId
target Point
oxy Point
tpxy Int
shapeRandom Bool
center
                               ItemId
iid CStore
COrgan Bool
True
          case mfail of
            Maybe ReqFailure
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just ReqFailure
ProjectBlockTerrain -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just ReqFailure
ProjectBlockActor -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just ReqFailure
failMsg ->
              SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid (Actor -> FactionId
bfid Actor
tb) (SfxMsg -> SfxAtomic) -> SfxMsg -> SfxAtomic
forall a b. (a -> b) -> a -> b
$ ReqFailure -> SfxMsg
SfxUnexpected ReqFailure
failMsg
      tryFlying Int
0 = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      tryFlying Int
k10 = do
        -- Explosion particles were placed among organs of the victim:
        bag2 <- (State -> ItemBag) -> m ItemBag
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Actor -> ItemBag
borgan (Actor -> ItemBag) -> (State -> Actor) -> State -> ItemBag
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActorId -> State -> Actor
getActorBody ActorId
target
        -- We stop bouncing old particles when less than two thirds remain,
        -- to prevent hoarding explosives to use only in cramped spaces.
        case EM.lookup iid bag2 of
          Just (Int
n2, ItemTimers
_) | Int
n2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
itemK Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
3 -> do
            Int -> Int -> m ()
projectN Int
k10 Int
n2
            Int -> m ()
tryFlying (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ Int
k10 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
          Maybe ItemQuant
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  -- Some of the particles that fail to take off, bounce off obstacles
  -- up to 10 times in total, trying to fly in different directions.
  tryFlying 10
  bag3 <- getsState $ borgan . getActorBody target
  let mn3 = ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ItemId
iid ItemBag
bag3
  -- Give up and destroy the remaining particles, if any.
  maybe (return ()) (\ItemQuant
kit -> UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic
                             (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ItemId -> ItemQuant -> Container -> UpdAtomic
UpdLoseItem Bool
False ItemId
iid ItemQuant
kit Container
container) mn3
  return UseUp  -- we neglect verifying that at least one projectile got off

-- ** RefillHP

-- Unaffected by armor.
effectRefillHP :: MonadServerAtomic m
               => Int -> ActorId -> ActorId -> ItemId -> m UseResult
effectRefillHP :: forall (m :: * -> *).
MonadServerAtomic m =>
Int -> ActorId -> ActorId -> ItemId -> m UseResult
effectRefillHP Int
power0 ActorId
source ActorId
target ItemId
iid = do
  sb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
source
  tb <- getsState $ getActorBody target
  curChalSer <- getsServer $ scurChalSer . soptions
  fact <- getsState $ (EM.! bfid tb) . sfactionD
  let power = if Int
power0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= -Int
1 then Int
power0 else Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
power0  -- avoid 0
      deltaHP = Int -> Int64
xM Int
power
  if cfish curChalSer && deltaHP > 0
     && fhasUI (gkind fact) && bfid sb /= bfid tb
  then do
     execSfxAtomic $ SfxMsgFid (bfid tb) SfxColdFish
     return UseId
  else do
    let reportedEffect = Int -> Effect
IK.RefillHP Int
power
    execSfxAtomic $ SfxEffect (bfid sb) target iid reportedEffect deltaHP
    refillHP source target deltaHP
    return UseUp

-- ** RefillCalm

effectRefillCalm :: MonadServerAtomic m
                 => m () -> Int -> ActorId -> ActorId -> m UseResult
effectRefillCalm :: forall (m :: * -> *).
MonadServerAtomic m =>
m () -> Int -> ActorId -> ActorId -> m UseResult
effectRefillCalm m ()
execSfx Int
power0 ActorId
source ActorId
target = do
  tb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
  actorMaxSk <- getsState $ getActorMaxSkills target
  let power = if Int
power0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= -Int
1 then Int
power0 else Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
power0  -- avoid 0
      rawDeltaCalm = Int -> Int64
xM Int
power
      calmMax = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxCalm Skills
actorMaxSk
      serious = Int64
rawDeltaCalm Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
minusM2 Bool -> Bool -> Bool
&& ActorId
source ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
target Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
tb)
      deltaCalm0 | Bool
serious =  -- if overfull, at least cut back to max
                     Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min Int64
rawDeltaCalm (Int -> Int64
xM Int
calmMax Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Actor -> Int64
bcalm Actor
tb)
                 | Bool
otherwise = Int64
rawDeltaCalm
      deltaCalm = if | Int64
deltaCalm0 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0 Bool -> Bool -> Bool
&& Actor -> Int64
bcalm Actor
tb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int64
xM Int
999 ->  -- UI limit
                       Int64
tenthM  -- avoid nop, to avoid loops
                     | Int64
deltaCalm0 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0 Bool -> Bool -> Bool
&& Actor -> Int64
bcalm Actor
tb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< - Int -> Int64
xM Int
999 ->
                       -Int64
tenthM
                     | Bool
otherwise -> Int64
deltaCalm0
  execSfx
  updateCalm target deltaCalm
  return UseUp

-- ** Dominate

-- The is another way to trigger domination (the normal way is by zeroed Calm).
-- Calm is here irrelevant. The other conditions are the same.
effectDominate :: MonadServerAtomic m
               => ActorId -> ActorId -> ItemId -> m UseResult
effectDominate :: forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> ActorId -> ItemId -> m UseResult
effectDominate ActorId
source ActorId
target ItemId
iid = do
  sb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
source
  tb <- getsState $ getActorBody target
  if | bproj tb -> return UseDud
     | bfid tb == bfid sb -> return UseDud  -- accidental hit; ignore
     | otherwise -> do
       fact <- getsState $ (EM.! bfid tb) . sfactionD
       hiImpression <- highestImpression tb
       let permitted = case Maybe (FactionId, Int)
hiImpression of
             Maybe (FactionId, Int)
Nothing -> Bool
False  -- no impression, no domination
             Just (FactionId
hiImpressionFid, Int
hiImpressionK) ->
                FactionId
hiImpressionFid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> FactionId
bfid Actor
sb
                  -- highest impression needs to be by us
                Bool -> Bool -> Bool
&& (FactionKind -> Bool
fhasPointman (Faction -> FactionKind
gkind Faction
fact) Bool -> Bool -> Bool
|| Int
hiImpressionK Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10)
                     -- to tame/hack animal/robot, impress them a lot first
       if permitted then do
         b <- dominateFidSfx source target iid (bfid sb)
         return $! if b then UseUp else UseDud
       else do
         execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxUnimpressed target
         when (source /= target) $
           execSfxAtomic $ SfxMsgFid (bfid tb) $ SfxUnimpressed target
         return UseDud

highestImpression :: MonadServerAtomic m
                  => Actor -> m (Maybe (FactionId, Int))
highestImpression :: forall (m :: * -> *).
MonadServerAtomic m =>
Actor -> m (Maybe (FactionId, Int))
highestImpression Actor
tb = do
  getKind <- (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind))
-> (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemKind) -> State -> ItemId -> ItemKind
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemKind
getIidKindServer
  getItem <- getsState $ flip getItemBody
  let isImpression ItemId
iid =
        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
IK.S_IMPRESSED ([(GroupName ItemKind, Int)] -> Maybe Int)
-> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ItemKind -> [(GroupName ItemKind, Int)]
IK.ifreq (ItemKind -> [(GroupName ItemKind, Int)])
-> ItemKind -> [(GroupName ItemKind, Int)]
forall a b. (a -> b) -> a -> b
$ ItemId -> ItemKind
getKind ItemId
iid
      impressions = (ItemId -> ItemQuant -> Bool) -> ItemBag -> ItemBag
forall k a.
Enum k =>
(k -> a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filterWithKey (\ItemId
iid ItemQuant
_ -> ItemId -> Bool
isImpression ItemId
iid) (ItemBag -> ItemBag) -> ItemBag -> ItemBag
forall a b. (a -> b) -> a -> b
$ Actor -> ItemBag
borgan Actor
tb
      f (a
_, (a
k, b
_)) = a
k
      maxImpression = ((ItemId, ItemQuant) -> (ItemId, ItemQuant) -> Ordering)
-> [(ItemId, ItemQuant)] -> (ItemId, ItemQuant)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (((ItemId, ItemQuant) -> Int)
-> (ItemId, ItemQuant) -> (ItemId, ItemQuant) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (ItemId, ItemQuant) -> Int
forall {a} {a} {b}. (a, (a, b)) -> a
f) ([(ItemId, ItemQuant)] -> (ItemId, ItemQuant))
-> [(ItemId, ItemQuant)] -> (ItemId, ItemQuant)
forall a b. (a -> b) -> a -> b
$ ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
impressions
  if EM.null impressions
  then return Nothing
  else case jfid $ getItem $ fst maxImpression of
    Maybe FactionId
Nothing -> Maybe (FactionId, Int) -> m (Maybe (FactionId, Int))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (FactionId, Int)
forall a. Maybe a
Nothing
    Just FactionId
fid -> Bool -> m (Maybe (FactionId, Int)) -> m (Maybe (FactionId, Int))
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> FactionId
bfid Actor
tb)
                (m (Maybe (FactionId, Int)) -> m (Maybe (FactionId, Int)))
-> m (Maybe (FactionId, Int)) -> m (Maybe (FactionId, Int))
forall a b. (a -> b) -> a -> b
$ Maybe (FactionId, Int) -> m (Maybe (FactionId, Int))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (FactionId, Int) -> m (Maybe (FactionId, Int)))
-> Maybe (FactionId, Int) -> m (Maybe (FactionId, Int))
forall a b. (a -> b) -> a -> b
$ (FactionId, Int) -> Maybe (FactionId, Int)
forall a. a -> Maybe a
Just (FactionId
fid, ItemQuant -> Int
forall a b. (a, b) -> a
fst (ItemQuant -> Int) -> ItemQuant -> Int
forall a b. (a -> b) -> a -> b
$ (ItemId, ItemQuant) -> ItemQuant
forall a b. (a, b) -> b
snd (ItemId, ItemQuant)
maxImpression)

dominateFidSfx :: MonadServerAtomic m
               => ActorId ->  ActorId -> ItemId -> FactionId -> m Bool
dominateFidSfx :: forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> ActorId -> ItemId -> FactionId -> m Bool
dominateFidSfx ActorId
source ActorId
target ItemId
iid FactionId
fid = do
  tb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
  let !_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Bool
bproj Actor
tb) ()
  -- Actors that don't move freely can't be dominated, for otherwise,
  -- when they are the last survivors, they could get stuck and the game
  -- wouldn't end. Also, they are a hassle to guide through the dungeon.
  canTra <- getsState $ canTraverse target
  -- Being pushed protects from domination, for simplicity.
  -- A possible interesting exploit, but much help from content would be needed
  -- to make it practical.
  if isNothing (btrajectory tb) && canTra && bhp tb > 0 then do
    let execSfx = SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> ActorId -> ItemId -> Effect -> Int64 -> SfxAtomic
SfxEffect FactionId
fid ActorId
target ItemId
iid Effect
IK.Dominate Int64
0
    execSfx  -- if actor ours, possibly the last occasion to see him
    dominateFid fid source target
    -- If domination resulted in game over, the message won't be seen
    -- before the end game screens, but at least it will be seen afterwards
    -- and browsable in history while inside subsequent game, revealing
    -- the cause of the previous game over. Better than no message at all.
    execSfx  -- see the actor as theirs, unless position not visible
    return True
  else
    return False

dominateFid :: MonadServerAtomic m => FactionId -> ActorId -> ActorId -> m ()
dominateFid :: forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> ActorId -> ActorId -> m ()
dominateFid FactionId
fid ActorId
source ActorId
target = do
  tb0 <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
  -- Game over deduced very early, so no further animation nor message
  -- will appear before game end screens. This is good in that our last actor
  -- that yielded will still be on screen when end game messages roll.
  -- This is bad in that last enemy actor that got dominated by us
  -- may not be on screen and we have no clue how we won until
  -- we see history in the next game. Even worse if our ally dominated
  -- the enemy actor. Then we may never learn. Oh well, that's realism.
  deduceKilled target
  electLeader (bfid tb0) (blid tb0) target
  -- Drop all items so that domiation is not too nasty, especially
  -- if the dominated hero runs off or teleports away with gold
  -- or starts hitting with the most potent artifact weapon in the game.
  -- Drop items while still of the original faction
  -- to mark them on the map for other party members to collect.
  dropAllEquippedItems target tb0
  tb <- getsState $ getActorBody target
  actorMaxSk <- getsState $ getActorMaxSkills target
  getKind <- getsState $ flip getIidKindServer
  let isImpression ItemId
iid =
        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
IK.S_IMPRESSED ([(GroupName ItemKind, Int)] -> Maybe Int)
-> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ ItemKind -> [(GroupName ItemKind, Int)]
IK.ifreq (ItemKind -> [(GroupName ItemKind, Int)])
-> ItemKind -> [(GroupName ItemKind, Int)]
forall a b. (a -> b) -> a -> b
$ ItemId -> ItemKind
getKind ItemId
iid
      dropAllImpressions = (ItemId -> ItemQuant -> Bool) -> ItemBag -> ItemBag
forall k a.
Enum k =>
(k -> a -> Bool) -> EnumMap k a -> EnumMap k a
EM.filterWithKey (\ItemId
iid ItemQuant
_ -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ItemId -> Bool
isImpression ItemId
iid)
      borganNoImpression = ItemBag -> ItemBag
dropAllImpressions (ItemBag -> ItemBag) -> ItemBag -> ItemBag
forall a b. (a -> b) -> a -> b
$ Actor -> ItemBag
borgan Actor
tb
  -- Actor is not pushed nor projectile, so @sactorTime@ suffices.
  btime <- getsServer
           $ fromJust . lookupActorTime (bfid tb) (blid tb) target . sactorTime
  execUpdAtomic $ UpdLoseActor target tb
  let maxCalm = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxCalm Skills
actorMaxSk
      maxHp = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxHP Skills
actorMaxSk
      bNew = Actor
tb { bfid = fid
                , bcalm = max (xM 10) $ xM maxCalm `div` 2
                , bhp = min (xM maxHp) $ bhp tb + xM 10
                , borgan = borganNoImpression}
  modifyServer $ \StateServer
ser ->
    StateServer
ser {sactorTime = updateActorTime fid (blid tb) target btime
                      $ sactorTime ser}
  execUpdAtomic $ UpdSpotActor target bNew
  -- Focus on the dominated actor, by making him a leader.
  setFreshLeader fid target
  factionD <- getsState sfactionD
  let inGame Faction
fact2 = case Faction -> Maybe Status
gquit Faction
fact2 of
        Maybe Status
Nothing -> Bool
True
        Just Status{stOutcome :: Status -> Outcome
stOutcome=Outcome
Camping} -> Bool
True
        Maybe Status
_ -> Bool
False
      gameOver = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (Faction -> Bool) -> [Faction] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Faction -> Bool
inGame ([Faction] -> Bool) -> [Faction] -> Bool
forall a b. (a -> b) -> a -> b
$ EnumMap FactionId Faction -> [Faction]
forall k a. EnumMap k a -> [a]
EM.elems EnumMap FactionId Faction
factionD
  -- Avoid the spam of identifying items, if game over.
  unless gameOver $ do
    -- Add some nostalgia for the old faction.
    void $ effectCreateItem (Just $ bfid tb) (Just 10) source target Nothing
                            COrgan IK.S_IMPRESSED IK.timerNone
    -- Identify organs that won't get identified by use.
    getKindId <- getsState $ flip getIidKindIdServer
    let discoverIf (ItemId
iid, CStore
cstore) = do
          let itemKindId :: ContentId ItemKind
itemKindId = ItemId -> ContentId ItemKind
getKindId ItemId
iid
              c :: Container
c = ActorId -> CStore -> Container
CActor ActorId
target CStore
cstore
          Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (CStore
cstore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
/= CStore
CGround) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
            Container -> ItemId -> ContentId ItemKind -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Container -> ItemId -> ContentId ItemKind -> m ()
discoverIfMinorEffects Container
c ItemId
iid ContentId ItemKind
itemKindId
        aic = (Actor -> ItemId
btrunk Actor
tb, CStore
COrgan)
              (ItemId, CStore) -> [(ItemId, CStore)] -> [(ItemId, CStore)]
forall a. a -> [a] -> [a]
: ((ItemId, CStore) -> Bool)
-> [(ItemId, CStore)] -> [(ItemId, CStore)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> ItemId
btrunk Actor
tb) (ItemId -> Bool)
-> ((ItemId, CStore) -> ItemId) -> (ItemId, CStore) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, CStore) -> ItemId
forall a b. (a, b) -> a
fst) (Actor -> [(ItemId, CStore)]
getCarriedIidCStore Actor
tb)
    mapM_ discoverIf aic

-- | Drop all actor's equipped items.
dropAllEquippedItems :: MonadServerAtomic m => ActorId -> Actor -> m ()
dropAllEquippedItems :: forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Actor -> m ()
dropAllEquippedItems ActorId
aid Actor
b =
  CStore -> (ItemId -> ItemQuant -> m ()) -> Actor -> m ()
forall (m :: * -> *).
MonadServer m =>
CStore -> (ItemId -> ItemQuant -> m ()) -> Actor -> m ()
mapActorCStore_ CStore
CEqp
                  (m UseResult -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m UseResult -> m ())
-> (ItemId -> ItemQuant -> m UseResult)
-> ItemId
-> ItemQuant
-> m ()
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> Bool
-> Bool
-> CStore
-> ActorId
-> Actor
-> Int
-> ItemId
-> ItemQuant
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> Bool
-> CStore
-> ActorId
-> Actor
-> Int
-> ItemId
-> ItemQuant
-> m UseResult
dropCStoreItem Bool
False Bool
False CStore
CEqp ActorId
aid Actor
b Int
forall a. Bounded a => a
maxBound)
                  Actor
b

-- ** Impress

effectImpress :: MonadServerAtomic m
              => (IK.Effect -> m UseResult) -> m () -> ActorId -> ActorId
              -> m UseResult
effectImpress :: forall (m :: * -> *).
MonadServerAtomic m =>
(Effect -> m UseResult)
-> m () -> ActorId -> ActorId -> m UseResult
effectImpress Effect -> m UseResult
recursiveCall m ()
execSfx ActorId
source ActorId
target = do
  sb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
source
  tb <- getsState $ getActorBody target
  if | bproj tb -> return UseDud
     | bfid tb == bfid sb ->
       -- Unimpress wrt others, but only once. The recursive Sfx suffices.
       recursiveCall $ IK.DropItem 1 1 COrgan IK.S_IMPRESSED
     | otherwise -> do
       -- Actors that don't move freely and so are stupid, can't be impressed.
       canTra <- getsState $ canTraverse target
       if canTra then do
         unless (bhp tb <= 0)
           execSfx  -- avoid spam just before death
         effectCreateItem (Just $ bfid sb) (Just 1) source target Nothing COrgan
                          IK.S_IMPRESSED IK.timerNone
       else return UseDud  -- no message, because common and not crucial

-- ** PutToSleep

effectPutToSleep :: MonadServerAtomic m => m () -> ActorId -> m UseResult
effectPutToSleep :: forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ActorId -> m UseResult
effectPutToSleep m ()
execSfx ActorId
target = do
  tb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
  if | bproj tb -> return UseDud
     | bwatch tb `elem` [WSleep, WWake] ->
         return UseDud  -- can't increase sleep
     | otherwise -> do
       actorMaxSk <- getsState $ getActorMaxSkills target
       if not $ canSleep actorMaxSk then
         return UseId  -- no message about the cause, so at least ID
       else do
         let maxCalm = Int -> Int64
xM (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxCalm Skills
actorMaxSk
             deltaCalm = Int64
maxCalm Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Actor -> Int64
bcalm Actor
tb
         when (deltaCalm > 0) $
           updateCalm target deltaCalm  -- max Calm, but asleep vulnerability
         execSfx
         case bwatch tb of
           WWait Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> do
             nAll <- GroupName ItemKind -> ActorId -> m Int
forall (m :: * -> *).
MonadServerAtomic m =>
GroupName ItemKind -> ActorId -> m Int
removeConditionSingle GroupName ItemKind
IK.S_BRACED ActorId
target
             let !_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
nAll Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) ()
             return ()
           Watchfulness
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         -- Forced sleep. No check if the actor can sleep naturally.
         addSleep target
         return UseUp

-- ** Yell

-- This is similar to 'reqYell', but also mentions that the actor is startled,
-- because, presumably, he yells involuntarily. It doesn't wake him up
-- via Calm instantly, just like yelling in a dream not always does.
effectYell :: MonadServerAtomic m => m () -> ActorId -> m UseResult
effectYell :: forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ActorId -> m UseResult
effectYell m ()
execSfx ActorId
target = do
  tb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
  if bhp tb <= 0 then  -- avoid yelling corpses
    return UseDud  -- the yell never manifested
  else do
    unless (bproj tb)
      execSfx
    execSfxAtomic $ SfxTaunt False target
    when (not (bproj tb) && deltaBenign (bcalmDelta tb)) $
      execUpdAtomic $ UpdRefillCalm target minusM
    return UseUp

-- ** Summon

-- Note that the Calm expended doesn't depend on the number of actors summoned.
effectSummon :: MonadServerAtomic m
             => GroupName ItemKind -> Dice.Dice -> ItemId
             -> ActorId -> ActorId -> ActivationFlag
             -> m UseResult
effectSummon :: forall (m :: * -> *).
MonadServerAtomic m =>
GroupName ItemKind
-> Dice
-> ItemId
-> ActorId
-> ActorId
-> ActivationFlag
-> m UseResult
effectSummon GroupName ItemKind
grp Dice
nDm ItemId
iid ActorId
source ActorId
target ActivationFlag
effActivation = do
  -- Obvious effect, nothing announced.
  sb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
source
  tb <- getsState $ getActorBody target
  sMaxSk <- getsState $ getActorMaxSkills source
  tMaxSk <- getsState $ getActorMaxSkills target
  totalDepth <- getsState stotalDepth
  Level{ldepth, lbig} <- getLevel (blid tb)
  nFriends <- getsState $ length . friendRegularAssocs (bfid sb) (blid sb)
  discoAspect <- getsState sdiscoAspect
  power0 <- rndToAction $ castDice ldepth totalDepth nDm
  fact <- getsState $ (EM.! bfid sb) . sfactionD
  let arItem = EnumMap ItemId AspectRecord
discoAspect EnumMap ItemId AspectRecord -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
      power = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
power0 Int
1  -- KISS, always at least one summon
      -- We put @source@ instead of @target@ and @power@ instead of dice
      -- to make the message more accurate.
      effect = GroupName ItemKind -> Dice -> Effect
IK.Summon GroupName ItemKind
grp (Dice -> Effect) -> Dice -> Effect
forall a b. (a -> b) -> a -> b
$ Int -> Dice
Dice.intToDice Int
power
      durable = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Durable AspectRecord
arItem
      warnBothActors SfxMsg
warning =
       Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> Bool
bproj Actor
sb) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
         SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid (Actor -> FactionId
bfid Actor
sb) SfxMsg
warning
         Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActorId
source ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
target) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
           SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid (Actor -> FactionId
bfid Actor
tb) SfxMsg
warning
      deltaCalm = - Int -> Int64
xM Int
30
  -- Verify Calm only at periodic activations or if the item is durable.
  -- Otherwise summon uses up the item, which prevents summoning getting
  -- out of hand. I don't verify Calm otherwise, to prevent an exploit
  -- via draining one's calm on purpose when an item with good activation
  -- has a nasty summoning side-effect (the exploit still works on durables).
  if | bproj tb
       || source /= target && not (isFoe (bfid sb) fact (bfid tb)) ->
       return UseDud  -- hitting friends or projectiles to summon is too cheap
     | (effActivation == ActivationPeriodic || durable) && not (bproj sb)
       && (bcalm sb < - deltaCalm || not (calmEnough sb sMaxSk)) -> do
       warnBothActors $ SfxSummonLackCalm source
       return UseId
     | nFriends >= 20 -> do
       -- We assume the actor tries to summon his teammates or allies.
       -- As he repeats such summoning, he is going to bump into this limit.
       -- If he summons others, see the next condition.
       warnBothActors $ SfxSummonTooManyOwn source
       return UseId
     | EM.size lbig >= 200 -> do  -- lower than the 300 limit for spawning
       -- Even if the actor summons foes, he is prevented from exploiting it
       -- too many times and stopping natural monster spawning on the level
       -- (e.g., by filling the level with harmless foes).
       warnBothActors $ SfxSummonTooManyAll source
       return UseId
     | otherwise -> do
       unless (bproj sb) $ updateCalm source deltaCalm
       localTime <- getsState $ getLocalTime (blid tb)
       -- Make sure summoned actors start acting after the victim.
       let actorTurn = Speed -> Delta Time
ticksPerMeter (Speed -> Delta Time) -> Speed -> Delta Time
forall a b. (a -> b) -> a -> b
$ Skills -> Speed
gearSpeed Skills
tMaxSk
           targetTime = Time -> Delta Time -> Time
timeShift Time
localTime Delta Time
actorTurn
           afterTime = Time -> Delta Time -> Time
timeShift Time
targetTime (Delta Time -> Time) -> Delta Time -> Time
forall a b. (a -> b) -> a -> b
$ Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeClip
       -- Mark as summoned to prevent immediate chain summoning.
       -- Summon from current depth, not deeper due to many spawns already.
       anySummoned <- addManyActors True 0 [(grp, 1)] (blid tb) afterTime
                                    (Just $ bpos tb) power
       if anySummoned then do
         execSfxAtomic $ SfxEffect (bfid sb) source iid effect 0
         return UseUp
       else do
         -- We don't display detailed warnings when @addAnyActor@ fails,
         -- e.g., because the actor groups can't be generated on a given level.
         -- However, we at least don't claim any summoning happened
         -- and we offer a general summoning failure messages.
         warnBothActors $ SfxSummonFailure source
         return UseId

-- ** Ascend

-- Note that projectiles can be teleported, too, for extra fun.
effectAscend :: MonadServerAtomic m
             => (IK.Effect -> m UseResult)
             -> m () -> Bool -> ActorId -> ActorId -> Container
             -> m UseResult
effectAscend :: forall (m :: * -> *).
MonadServerAtomic m =>
(Effect -> m UseResult)
-> m () -> Bool -> ActorId -> ActorId -> Container -> m UseResult
effectAscend Effect -> m UseResult
recursiveCall m ()
execSfx Bool
up ActorId
source ActorId
target Container
container = do
  b1 <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
  pos <- getsState $ posFromC container
  let lid1 = Actor -> LevelId
blid Actor
b1
  destinations <- getsState $ whereTo lid1 pos up . sdungeon
  sb <- getsState $ getActorBody source
  actorMaxSk <- getsState $ getActorMaxSkills target
  if | source /= target && Ability.getSk Ability.SkMove actorMaxSk <= 0 -> do
       execSfxAtomic $ SfxMsgFid (bfid sb) SfxTransImpossible
       when (source /= target) $
         execSfxAtomic $ SfxMsgFid (bfid b1) SfxTransImpossible
       return UseId
     | actorWaits b1 && source /= target -> do
       execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxBracedImmune target
       when (source /= target) $
         execSfxAtomic $ SfxMsgFid (bfid b1) $ SfxBracedImmune target
       return UseId
     | null destinations -> do
       execSfxAtomic $ SfxMsgFid (bfid sb) SfxLevelNoMore
       when (source /= target) $
         execSfxAtomic $ SfxMsgFid (bfid b1) SfxLevelNoMore
       -- We keep it useful even in shallow dungeons.
       recursiveCall $ IK.Teleport 30  -- powerful teleport
     | otherwise -> do
       (lid2, pos2) <- rndToAction $ oneOf destinations
       execSfx
       mbtime_bOld <-
         getsServer $ lookupActorTime (bfid b1) lid1 target . sactorTime
       mbtimeTraj_bOld <-
         getsServer $ lookupActorTime (bfid b1) lid1 target . strajTime
       pos3 <- findStairExit (bfid sb) up lid2 pos2
       let switch1 = m (Maybe ActorId) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Maybe ActorId) -> m ()) -> m (Maybe ActorId) -> m ()
forall a b. (a -> b) -> a -> b
$ (ActorId, Actor) -> m (Maybe ActorId)
forall (m :: * -> *).
MonadServerAtomic m =>
(ActorId, Actor) -> m (Maybe ActorId)
switchLevels1 (ActorId
target, Actor
b1)
           switch2 = do
             -- Make the initiator of the stair move the leader,
             -- to let him clear the stairs for others to follow.
             let mlead :: Maybe ActorId
mlead = if Actor -> Bool
bproj Actor
b1 then Maybe ActorId
forall a. Maybe a
Nothing else ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
target
             -- Move the actor to where the inhabitants were, if any.
             LevelId
-> Point
-> (ActorId, Actor)
-> Maybe Time
-> Maybe Time
-> Maybe ActorId
-> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
LevelId
-> Point
-> (ActorId, Actor)
-> Maybe Time
-> Maybe Time
-> Maybe ActorId
-> m ()
switchLevels2 LevelId
lid2 Point
pos3 (ActorId
target, Actor
b1)
                           Maybe Time
mbtime_bOld Maybe Time
mbtimeTraj_bOld Maybe ActorId
mlead
       -- The actor will be added to the new level,
       -- but there can be other actors at his new position.
       inhabitants <- getsState $ posToAidAssocs pos3 lid2
       case inhabitants of
         (ActorId
_, Actor
b2) : [(ActorId, Actor)]
_ | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Bool
bproj Actor
b1 -> do
           -- Alert about the switch.
           SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid (Actor -> FactionId
bfid Actor
sb) SfxMsg
SfxLevelPushed
           -- Only tell one pushed player, even if many actors, because then
           -- they are projectiles, so not too important.
           Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActorId
source ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
target) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
             SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid (Actor -> FactionId
bfid Actor
b2) SfxMsg
SfxLevelPushed
           -- Move the actor out of the way.
           m ()
switch1
           -- Move the inhabitants out of the way and to where the actor was.
           let moveInh :: (ActorId, Actor) -> m ()
moveInh (ActorId, Actor)
inh = do
                 -- Preserve the old leader, since the actor is pushed,
                 -- so possibly has nothing worhwhile to do on the new level
                 -- (and could try to switch back, if made a leader,
                 -- leading to a loop).
                 mbtime_inh <-
                   (StateServer -> Maybe Time) -> m (Maybe Time)
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> Maybe Time) -> m (Maybe Time))
-> (StateServer -> Maybe Time) -> m (Maybe Time)
forall a b. (a -> b) -> a -> b
$ FactionId -> LevelId -> ActorId -> ActorTime -> Maybe Time
lookupActorTime (Actor -> FactionId
bfid ((ActorId, Actor) -> Actor
forall a b. (a, b) -> b
snd (ActorId, Actor)
inh)) LevelId
lid2 ((ActorId, Actor) -> ActorId
forall a b. (a, b) -> a
fst (ActorId, Actor)
inh)
                                (ActorTime -> Maybe Time)
-> (StateServer -> ActorTime) -> StateServer -> Maybe Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ActorTime
sactorTime
                 mbtimeTraj_inh <-
                   getsServer $ lookupActorTime (bfid (snd inh)) lid2 (fst inh)
                                . strajTime
                 inhMLead <- switchLevels1 inh
                 switchLevels2 lid1 (bpos b1) inh
                               mbtime_inh mbtimeTraj_inh inhMLead
           ((ActorId, Actor) -> m ()) -> [(ActorId, Actor)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (ActorId, Actor) -> m ()
moveInh [(ActorId, Actor)]
inhabitants
           -- Move the actor to his destination.
           m ()
switch2
         [(ActorId, Actor)]
_ -> do  -- no inhabitants or the stair-taker a projectile
           m ()
switch1
           m ()
switch2
       return UseUp

findStairExit :: MonadStateRead m
              => FactionId -> Bool -> LevelId -> Point -> m Point
findStairExit :: forall (m :: * -> *).
MonadStateRead m =>
FactionId -> Bool -> LevelId -> Point -> m Point
findStairExit FactionId
side Bool
moveUp LevelId
lid Point
pos = do
  COps{coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  fact <- getsState $ (EM.! side) . sfactionD
  lvl <- getLevel lid
  let defLanding = (Int -> Int -> Vector) -> (Int, Int) -> Vector
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Vector
Vector ((Int, Int) -> Vector) -> (Int, Int) -> Vector
forall a b. (a -> b) -> a -> b
$ if Bool
moveUp then (Int
1, Int
0) else (-Int
1, Int
0)
      center = (Int -> Int -> Vector) -> (Int, Int) -> Vector
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> Vector
Vector ((Int, Int) -> Vector) -> (Int, Int) -> Vector
forall a b. (a -> b) -> a -> b
$ if Bool
moveUp then (-Int
1, Int
0) else (Int
1, Int
0)
      (mvs2, mvs1) = break (== defLanding) moves
      mvs = Vector
center Vector -> [Vector] -> [Vector]
forall a. a -> [a] -> [a]
: (Vector -> Bool) -> [Vector] -> [Vector]
forall a. (a -> Bool) -> [a] -> [a]
filter (Vector -> Vector -> Bool
forall a. Eq a => a -> a -> Bool
/= Vector
center) ([Vector]
mvs1 [Vector] -> [Vector] -> [Vector]
forall a. [a] -> [a] -> [a]
++ [Vector]
mvs2)
      ps = (Point -> Bool) -> [Point] -> [Point]
forall a. (a -> Bool) -> [a] -> [a]
filter (TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup (ContentId TileKind -> Bool)
-> (Point -> ContentId TileKind) -> Point -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Level
lvl Level -> Point -> ContentId TileKind
`at`))
           ([Point] -> [Point]) -> [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ (Vector -> Point) -> [Vector] -> [Point]
forall a b. (a -> b) -> [a] -> [b]
map (Point -> Vector -> Point
shift Point
pos) [Vector]
mvs
      posOcc :: State -> Int -> Point -> Bool
      posOcc State
s Int
k Point
p = case Point -> LevelId -> State -> [(ActorId, Actor)]
posToAidAssocs Point
p LevelId
lid State
s of
        [] -> Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
        (ActorId
_, Actor
b) : [(ActorId, Actor)]
_ | Actor -> Bool
bproj Actor
b -> Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
3
        (ActorId
_, Actor
b) : [(ActorId, Actor)]
_ | FactionId -> Faction -> FactionId -> Bool
isFoe FactionId
side Faction
fact (Actor -> FactionId
bfid Actor
b) -> Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1  -- non-proj foe
        [(ActorId, Actor)]
_ -> Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2  -- moving a non-projectile friend
  unocc <- getsState posOcc
  case concatMap (\Int
k -> (Point -> Bool) -> [Point] -> [Point]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Point -> Bool
unocc Int
k) [Point]
ps) [0..3] of
    [] -> [Char] -> m Point
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> m Point) -> [Char] -> m Point
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> [Point] -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` [Point]
ps
    Point
posRes : [Point]
_ -> Point -> m Point
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Point
posRes

switchLevels1 :: MonadServerAtomic m => (ActorId, Actor) -> m (Maybe ActorId)
switchLevels1 :: forall (m :: * -> *).
MonadServerAtomic m =>
(ActorId, Actor) -> m (Maybe ActorId)
switchLevels1 (ActorId
aid, Actor
bOld) = do
  let side :: FactionId
side = Actor -> FactionId
bfid Actor
bOld
  mleader <- (State -> Maybe ActorId) -> m (Maybe ActorId)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe ActorId) -> m (Maybe ActorId))
-> (State -> Maybe ActorId) -> m (Maybe ActorId)
forall a b. (a -> b) -> a -> b
$ Faction -> Maybe ActorId
gleader (Faction -> Maybe ActorId)
-> (State -> Faction) -> State -> Maybe ActorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  -- Prevent leader pointing to a non-existing actor.
  mlead <-
    if not (bproj bOld) && isJust mleader then do
      execUpdAtomic $ UpdLeadFaction side mleader Nothing
      return mleader
        -- outside of a client we don't know the real tgt of aid, hence fst
    else return Nothing
  -- Remove the actor from the old level.
  -- Onlookers see somebody disappear suddenly.
  -- @UpdDestroyActor@ is too loud, so use @UpdLoseActor@ instead.
  execUpdAtomic $ UpdLoseActor aid bOld
  return mlead

switchLevels2 ::MonadServerAtomic m
              => LevelId -> Point -> (ActorId, Actor)
              -> Maybe Time -> Maybe Time -> Maybe ActorId
              -> m ()
switchLevels2 :: forall (m :: * -> *).
MonadServerAtomic m =>
LevelId
-> Point
-> (ActorId, Actor)
-> Maybe Time
-> Maybe Time
-> Maybe ActorId
-> m ()
switchLevels2 LevelId
lidNew Point
posNew (ActorId
aid, Actor
bOld) Maybe Time
mbtime_bOld Maybe Time
mbtimeTraj_bOld Maybe ActorId
mlead = do
  let lidOld :: LevelId
lidOld = Actor -> LevelId
blid Actor
bOld
      side :: FactionId
side = Actor -> FactionId
bfid Actor
bOld
  let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (LevelId
lidNew LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= LevelId
lidOld Bool -> ([Char], LevelId) -> Bool
forall v. Show v => Bool -> v -> Bool
`blame` [Char]
"stairs looped" [Char] -> LevelId -> ([Char], LevelId)
forall v. [Char] -> v -> ([Char], v)
`swith` LevelId
lidNew) ()
  -- Sync actor's items' timeouts with the new local time of the level.
  -- We need to sync organs and equipment due to periodic activations,
  -- but also due to timeouts after use, e.g., for some weapons
  -- (they recharge also in the stash; however, this doesn't encourage
  -- micromanagement for periodic items, because the timeout is randomised
  -- upon move to equipment).
  --
  -- We don't rebase timeouts for items in stash, because they are
  -- used by many actors on levels with different local times,
  -- so there is no single rebase that would match all.
  -- This is not a big problem: after a single use by an actor the timeout is
  -- set to his current local time, so further uses by that actor have
  -- not anomalously short or long recharge times. If the recharge time
  -- is very long, the player has an option of moving the item away from stash
  -- and back, to reset the timeout. An abuse is possible when recently
  -- used item is put from equipment to stash and at once used on another level
  -- taking advantage of local time difference, but this only works once
  -- and using the item back again at the original level makes the recharge
  -- time longer, in turn.
  timeOld <- (State -> Time) -> m Time
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime LevelId
lidOld
  timeLastActive <- getsState $ getLocalTime lidNew
  let delta = Time
timeLastActive Time -> Time -> Delta Time
`timeDeltaToFrom` Time
timeOld
      computeNewTimeout :: ItemQuant -> ItemQuant
      computeNewTimeout (Int
k, ItemTimers
it) = (Int
k, (ItemTimer -> ItemTimer) -> ItemTimers -> ItemTimers
forall a b. (a -> b) -> [a] -> [b]
map (Delta Time -> ItemTimer -> ItemTimer
shiftItemTimer Delta Time
delta) ItemTimers
it)
      rebaseTimeout :: ItemBag -> ItemBag
      rebaseTimeout = (ItemQuant -> ItemQuant) -> ItemBag -> ItemBag
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map ItemQuant -> ItemQuant
computeNewTimeout
      bNew = Actor
bOld { blid = lidNew
                  , bpos = posNew
                  , boldpos = Just posNew  -- new level, new direction
                  , borgan = rebaseTimeout $ borgan bOld
                  , beqp = rebaseTimeout $ beqp bOld }
      shiftByDelta = (Time -> Delta Time -> Time
`timeShift` Delta Time
delta)
  -- Sync the actor time with the level time.
  -- This time shift may cause a double move of a foe of the same speed,
  -- but this is OK --- the foe didn't have a chance to move
  -- before, because the arena went inactive, so he moves now one more time.
  maybe (return ())
        (\Time
btime_bOld ->
    (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
      StateServer
ser {sactorTime = updateActorTime (bfid bNew) lidNew aid
                                        (shiftByDelta btime_bOld)
                        $ sactorTime ser})
        mbtime_bOld
  maybe (return ())
        (\Time
btime_bOld ->
    (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
      StateServer
ser {strajTime = updateActorTime (bfid bNew) lidNew aid
                                       (shiftByDelta btime_bOld)
                       $ strajTime ser})
        mbtimeTraj_bOld
  -- Materialize the actor at the new location.
  -- Onlookers see somebody appear suddenly. The actor himself
  -- sees new surroundings and has to reset his perception.
  execUpdAtomic $ UpdSpotActor aid bNew
  forM_ mlead $
    -- The leader is fresh in the sense that he's on a new level
    -- and so doesn't have up to date Perception.
    setFreshLeader side

-- ** Escape

-- | The faction leaves the dungeon.
effectEscape :: MonadServerAtomic m => m () -> ActorId -> ActorId -> m UseResult
effectEscape :: forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ActorId -> ActorId -> m UseResult
effectEscape m ()
execSfx ActorId
source ActorId
target = do
  -- Obvious effect, nothing announced.
  sb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
source
  tb <- getsState $ getActorBody target
  let fid = Actor -> FactionId
bfid Actor
tb
  fact <- getsState $ (EM.! fid) . sfactionD
  if | bproj tb ->
       return UseDud  -- basically a misfire
     | not (fcanEscape $ gkind fact) -> do
       execSfxAtomic $ SfxMsgFid (bfid sb) SfxEscapeImpossible
       when (source /= target) $
         execSfxAtomic $ SfxMsgFid (bfid tb) SfxEscapeImpossible
       return UseId
     | otherwise -> do
       execSfx
       deduceQuits (bfid tb) $ Status Escape (fromEnum $ blid tb) Nothing
       return UseUp

-- ** Paralyze

-- | Advance target actor time by this many time clips. Not by actor moves,
-- to hurt fast actors more.
effectParalyze :: MonadServerAtomic m
               => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult
effectParalyze :: forall (m :: * -> *).
MonadServerAtomic m =>
m () -> Dice -> ActorId -> ActorId -> m UseResult
effectParalyze m ()
execSfx Dice
nDm ActorId
source ActorId
target = do
  tb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
  if bproj tb then return UseDud  -- shortcut for speed
  else paralyze execSfx nDm source target

paralyze :: MonadServerAtomic m
         => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult
paralyze :: forall (m :: * -> *).
MonadServerAtomic m =>
m () -> Dice -> ActorId -> ActorId -> m UseResult
paralyze m ()
execSfx Dice
nDm ActorId
source ActorId
target = do
  tb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
  totalDepth <- getsState stotalDepth
  Level{ldepth} <- getLevel (blid tb)
  power0 <- rndToAction $ castDice ldepth totalDepth nDm
  let power = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
power0 Int
1  -- KISS, avoid special case
  actorStasis <- getsServer sactorStasis
  if ES.member target actorStasis then do
    sb <- getsState $ getActorBody source
    execSfxAtomic $ SfxMsgFid (bfid sb) SfxStasisProtects
    when (source /= target) $
      execSfxAtomic $ SfxMsgFid (bfid tb) SfxStasisProtects
    return UseId
  else do
    execSfx
    let t = Delta Time -> Int -> Delta Time
timeDeltaScale (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeClip) Int
power
    -- Only the normal time, not the trajectory time, is affected.
    modifyServer $ \StateServer
ser ->
      StateServer
ser { sactorTime = ageActor (bfid tb) (blid tb) target t
                         $ sactorTime ser
          , sactorStasis = ES.insert target (sactorStasis ser) }
              -- actor's time warped, so he is in stasis,
              -- immune to further warps
    return UseUp

-- ** ParalyzeInWater

-- | Advance target actor time by this many time clips. Not by actor moves,
-- to hurt fast actors more. Due to water, so resistable.
effectParalyzeInWater :: MonadServerAtomic m
                      => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult
effectParalyzeInWater :: forall (m :: * -> *).
MonadServerAtomic m =>
m () -> Dice -> ActorId -> ActorId -> m UseResult
effectParalyzeInWater m ()
execSfx Dice
nDm ActorId
source ActorId
target = do
  tb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
  if bproj tb then return UseDud else do  -- shortcut for speed
    actorMaxSk <- getsState $ getActorMaxSkills target
    let swimmingOrFlying = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkSwimming Skills
actorMaxSk)
                               (Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkFlying Skills
actorMaxSk)
    if Dice.supDice nDm > swimmingOrFlying
    then paralyze execSfx nDm source target  -- no help at all
    else  -- fully resisted
      -- Don't spam:
      -- sb <- getsState $ getActorBody source
      -- execSfxAtomic $ SfxMsgFid (bfid sb) SfxWaterParalysisResisted
      return UseId

-- ** InsertMove

-- | Give target actor the given number of tenths of extra move. Don't give
-- an absolute amount of time units, to benefit slow actors more.
effectInsertMove :: MonadServerAtomic m
                 => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult
effectInsertMove :: forall (m :: * -> *).
MonadServerAtomic m =>
m () -> Dice -> ActorId -> ActorId -> m UseResult
effectInsertMove m ()
execSfx Dice
nDm ActorId
source ActorId
target = do
  tb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
  actorMaxSk <- getsState $ getActorMaxSkills target
  totalDepth <- getsState stotalDepth
  Level{ldepth} <- getLevel (blid tb)
  actorStasis <- getsServer sactorStasis
  power0 <- rndToAction $ castDice ldepth totalDepth nDm
  let power = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
power0 Int
1  -- KISS, avoid special case
      actorTurn = Speed -> Delta Time
ticksPerMeter (Speed -> Delta Time) -> Speed -> Delta Time
forall a b. (a -> b) -> a -> b
$ Skills -> Speed
gearSpeed Skills
actorMaxSk
      t = Delta Time -> Int -> Delta Time
timeDeltaScale (Delta Time -> Int -> Delta Time
timeDeltaPercent Delta Time
actorTurn Int
10) (-Int
power)
  if | bproj tb -> return UseDud  -- shortcut for speed
     | ES.member target actorStasis -> do
       sb <- getsState $ getActorBody source
       execSfxAtomic $ SfxMsgFid (bfid sb) SfxStasisProtects
       when (source /= target) $
         execSfxAtomic $ SfxMsgFid (bfid tb) SfxStasisProtects
       return UseId
     | otherwise -> do
       execSfx
       -- Only the normal time, not the trajectory time, is affected.
       modifyServer $ \StateServer
ser ->
         StateServer
ser { sactorTime = ageActor (bfid tb) (blid tb) target t
                            $ sactorTime ser
             , sactorStasis = ES.insert target (sactorStasis ser) }
                 -- actor's time warped, so he is in stasis,
                 -- immune to further warps
       return UseUp

-- ** Teleport

-- | Teleport the target actor.
-- Note that projectiles can be teleported, too, for extra fun.
effectTeleport :: MonadServerAtomic m
               => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult
effectTeleport :: forall (m :: * -> *).
MonadServerAtomic m =>
m () -> Dice -> ActorId -> ActorId -> m UseResult
effectTeleport m ()
execSfx Dice
nDm ActorId
source ActorId
target = do
  sb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
source
  tb <- getsState $ getActorBody target
  actorMaxSk <- getsState $ getActorMaxSkills target
  if | source /= target && Ability.getSk Ability.SkMove actorMaxSk <= 0 -> do
       execSfxAtomic $ SfxMsgFid (bfid sb) SfxTransImpossible
       when (source /= target) $
         execSfxAtomic $ SfxMsgFid (bfid tb) SfxTransImpossible
       return UseId
     | source /= target && actorWaits tb -> do
         -- immune only against not own effects, to enable teleport
         -- as beneficial's necklace drawback; also consistent
         -- with sleep not protecting
       execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxBracedImmune target
       when (source /= target) $
         execSfxAtomic $ SfxMsgFid (bfid tb) $ SfxBracedImmune target
       return UseId
     | otherwise -> do
       COps{coTileSpeedup} <- getsState scops
       totalDepth <- getsState stotalDepth
       lvl@Level{ldepth} <- getLevel (blid tb)
       range <- rndToAction $ castDice ldepth totalDepth nDm
       let spos = Actor -> Point
bpos Actor
tb
           dMinMax !Int
delta !Point
pos =
             let d :: Int
d = Point -> Point -> Int
chessDist Point
spos Point
pos
             in Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
range Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
delta Bool -> Bool -> Bool
&& Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
range Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta
           dist !Int
delta !Point
pos ContentId TileKind
_ = Int -> Point -> Bool
dMinMax Int
delta Point
pos
       mtpos <- rndToAction $ findPosTry 200 lvl
         (\Point
p !ContentId TileKind
t -> TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup ContentId TileKind
t
                   Bool -> Bool -> Bool
&& Bool -> Bool
not (TileSpeedup -> ContentId TileKind -> Bool
Tile.isNoActor TileSpeedup
coTileSpeedup ContentId TileKind
t)
                   Bool -> Bool -> Bool
&& Bool -> Bool
not (Point -> Level -> Bool
occupiedBigLvl Point
p Level
lvl)
                   Bool -> Bool -> Bool
&& Bool -> Bool
not (Point -> Level -> Bool
occupiedProjLvl Point
p Level
lvl))
         [ dist 1
         , dist $ 1 + range `div` 9
         , dist $ 1 + range `div` 7
         , dist $ 1 + range `div` 5
         , dist 5
         , dist 7
         , dist 9
         ]
       case mtpos of
         Maybe Point
Nothing -> do  -- really very rare, so debug
           Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
debugPossiblyPrint
             Text
"Server: effectTeleport: failed to find any free position"
           SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid (Actor -> FactionId
bfid Actor
sb) SfxMsg
SfxTransImpossible
           Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ActorId
source ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
target) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
             SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid (Actor -> FactionId
bfid Actor
tb) SfxMsg
SfxTransImpossible
           UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
         Just Point
tpos -> do
           m ()
execSfx
           UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Point -> Point -> UpdAtomic
UpdMoveActor ActorId
target Point
spos Point
tpos
           UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp

-- ** CreateItem

effectCreateItem :: MonadServerAtomic m
                 => Maybe FactionId -> Maybe Int -> ActorId -> ActorId
                 -> Maybe ItemId -> CStore -> GroupName ItemKind -> IK.TimerDice
                 -> m UseResult
effectCreateItem :: forall (m :: * -> *).
MonadServerAtomic m =>
Maybe FactionId
-> Maybe Int
-> ActorId
-> ActorId
-> Maybe ItemId
-> CStore
-> GroupName ItemKind
-> TimerDice
-> m UseResult
effectCreateItem Maybe FactionId
jfidRaw Maybe Int
mcount ActorId
source ActorId
target Maybe ItemId
miidOriginal CStore
store GroupName ItemKind
grp TimerDice
tim = do
 tb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
 if bproj tb && store == COrgan  -- other stores OK not to lose possible loot
 then return UseDud  -- don't make a projectile hungry, etc.
 else do
  cops <- getsState scops
  sb <- getsState $ getActorBody source
  actorMaxSk <- getsState $ getActorMaxSkills target
  totalDepth <- getsState stotalDepth
  lvlTb <- getLevel (blid tb)
  let -- If the number of items independent of depth in @mcount@,
      -- make also the timer, the item kind choice and aspects
      -- independent of depth, via fixing the generation depth of the item
      -- to @totalDepth@. Prime example of provided @mcount@ is crafting.
      -- TODO: base this on a resource that can be consciously spent,
      -- not on a skill that grows over time or that only one actor
      -- maxes out and so needs to always be chosen for crafting.
      -- See https://www.reddit.com/r/roguelikedev/comments/phukcq/game_design_question_how_to_base_item_generation/
      depth = if Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
mcount then AbsDepth
totalDepth else Level -> AbsDepth
ldepth Level
lvlTb
      fscale Delta Time
unit Dice
nDm = do
        k0 <- Rnd Int -> m Int
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction (Rnd Int -> m Int) -> Rnd Int -> m Int
forall a b. (a -> b) -> a -> b
$ AbsDepth -> AbsDepth -> Dice -> Rnd Int
castDice AbsDepth
depth AbsDepth
totalDepth Dice
nDm
        let k = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
k0  -- KISS, don't freak out if dice permit 0
        return $! timeDeltaScale unit k
      fgame = Delta Time -> Dice -> m (Delta Time)
fscale (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeTurn)
      factor Dice
nDm = do
        -- A bit added to make sure length 1 effect doesn't randomly
        -- end, or not, before the end of first turn, which would make,
        -- e.g., hasting, useless. This needs to be higher than 10%
        -- to compensate for overhead of animals, etc. (no leaders).
        let actorTurn :: Delta Time
actorTurn =
              Delta Time -> Int -> Delta Time
timeDeltaPercent (Speed -> Delta Time
ticksPerMeter (Speed -> Delta Time) -> Speed -> Delta Time
forall a b. (a -> b) -> a -> b
$ Skills -> Speed
gearSpeed Skills
actorMaxSk) Int
111
        Delta Time -> Dice -> m (Delta Time)
fscale Delta Time
actorTurn Dice
nDm
  delta <- IK.foldTimer (return $ Delta timeZero) fgame factor tim
  let c = ActorId -> CStore -> Container
CActor ActorId
target CStore
store
  bagBefore <- getsState $ getBodyStoreBag tb store
  uniqueSet <- getsServer suniqueSet
  -- Power depth of new items unaffected by number of spawned actors, so 0.
  let freq = COps
-> UniqueSet
-> [(GroupName ItemKind, Int)]
-> AbsDepth
-> AbsDepth
-> Int
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
newItemKind COps
cops UniqueSet
uniqueSet [(GroupName ItemKind
grp, Int
1)] AbsDepth
depth AbsDepth
totalDepth Int
0
  m2 <- rollItemAspect freq depth
  case m2 of
    NewItem
NoNewItem -> UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud  -- e.g., unique already generated
    NewItem GroupName ItemKind
_ ItemKnown
itemKnownRaw ItemFull
itemFullRaw (Int
kRaw, ItemTimers
itRaw) -> do
      -- Avoid too many different item identifiers (one for each faction)
      -- for blasts or common item generating tiles. Conditions are
      -- allowed to be duplicated, because they provide really useful info
      -- (perpetrator). However, if timer is none, they are not duplicated
      -- to make sure that, e.g., poisons stack with each other regardless
      -- of perpetrator and we don't get "no longer poisoned" message
      -- while still poisoned due to another faction. With timed aspects,
      -- e.g., slowness, the message is less misleading, and it's interesting
      -- that I'm twice slower due to aspects from two factions and not
      -- as deadly as being poisoned at twice the rate from two factions.
      let jfid :: Maybe FactionId
jfid = if CStore
store CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
COrgan Bool -> Bool -> Bool
&& Bool -> Bool
not (TimerDice -> Bool
IK.isTimerNone TimerDice
tim)
                    Bool -> Bool -> Bool
|| GroupName ItemKind
grp GroupName ItemKind -> GroupName ItemKind -> Bool
forall a. Eq a => a -> a -> Bool
== GroupName ItemKind
IK.S_IMPRESSED
                 then Maybe FactionId
jfidRaw
                 else Maybe FactionId
forall a. Maybe a
Nothing
          ItemKnown ItemIdentity
kindIx AspectRecord
arItem Maybe FactionId
_ = ItemKnown
itemKnownRaw
          (ItemKnown
itemKnown, ItemFull
itemFull) =
            ( ItemIdentity -> AspectRecord -> Maybe FactionId -> ItemKnown
ItemKnown ItemIdentity
kindIx AspectRecord
arItem Maybe FactionId
jfid
            , ItemFull
itemFullRaw {itemBase = (itemBase itemFullRaw) {jfid}} )
      itemRev <- (StateServer -> ItemRev) -> m ItemRev
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> ItemRev
sitemRev
      let mquant = case ItemKnown -> ItemRev -> Maybe ItemId
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup ItemKnown
itemKnown ItemRev
itemRev of
            Maybe ItemId
Nothing -> Maybe (ItemId, ItemQuant)
forall a. Maybe a
Nothing
            Just ItemId
iid -> (ItemId
iid,) (ItemQuant -> (ItemId, ItemQuant))
-> Maybe ItemQuant -> Maybe (ItemId, ItemQuant)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ItemId
iid ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bagBefore
      case mquant of
        Just (ItemId
iid, (Int
_, afterIt :: ItemTimers
afterIt@(ItemTimer
timer : ItemTimers
rest))) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TimerDice -> Bool
IK.isTimerNone TimerDice
tim -> do
          -- Already has such items and timer change requested, so only increase
          -- the timer of the first item by the delta, but don't create items.
          let newIt :: ItemTimers
newIt = Delta Time -> ItemTimer -> ItemTimer
shiftItemTimer Delta Time
delta ItemTimer
timer ItemTimer -> ItemTimers -> ItemTimers
forall a. a -> [a] -> [a]
: ItemTimers
rest
          if ItemTimers
afterIt ItemTimers -> ItemTimers -> Bool
forall a. Eq a => a -> a -> Bool
/= ItemTimers
newIt then do
            UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ItemId -> Container -> ItemTimers -> ItemTimers -> UpdAtomic
UpdTimeItem ItemId
iid Container
c ItemTimers
afterIt ItemTimers
newIt
            -- It's hard for the client to tell this timer change from charge
            -- use, timer reset on pickup, etc., so we create the msg manually.
            -- Sending to both involved factions lets the player notice
            -- both the extensions he caused and suffered. Other faction causing
            -- that on themselves or on others won't be noticed. TMI.
            SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid (Actor -> FactionId
bfid Actor
sb)
                          (SfxMsg -> SfxAtomic) -> SfxMsg -> SfxAtomic
forall a b. (a -> b) -> a -> b
$ ActorId -> ItemId -> CStore -> Delta Time -> SfxMsg
SfxTimerExtended ActorId
target ItemId
iid CStore
store Delta Time
delta
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> FactionId
bfid Actor
sb FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> FactionId
bfid Actor
tb) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
              SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid (Actor -> FactionId
bfid Actor
tb)
                            (SfxMsg -> SfxAtomic) -> SfxMsg -> SfxAtomic
forall a b. (a -> b) -> a -> b
$ ActorId -> ItemId -> CStore -> Delta Time -> SfxMsg
SfxTimerExtended ActorId
target ItemId
iid CStore
store Delta Time
delta
            UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp
          else UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud  -- probably incorrect content, but let it be
        Maybe (ItemId, ItemQuant)
_ -> do
          localTime <- (State -> Time) -> m Time
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
tb)
          let newTimer = Time -> Delta Time -> ItemTimer
createItemTimer Time
localTime Delta Time
delta
              extraIt Int
k = if TimerDice -> Bool
IK.isTimerNone TimerDice
tim
                          then ItemTimers
itRaw  -- don't break @applyPeriodicLevel@
                          else Int -> ItemTimer -> ItemTimers
forall a. Int -> a -> [a]
replicate Int
k ItemTimer
newTimer
                                 -- randomized and overwritten in @registerItem@
                                 -- if an organ or created in equipment
              kitNew = case Maybe Int
mcount of
                Just Int
itemK -> (Int
itemK, Int -> ItemTimers
extraIt Int
itemK)
                Maybe Int
Nothing -> (Int
kRaw, Int -> ItemTimers
extraIt Int
kRaw)
          case miidOriginal of
            Just ItemId
iidOriginal | CStore
store CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
/= CStore
COrgan ->
              SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid (Actor -> FactionId
bfid Actor
tb)
                            (SfxMsg -> SfxAtomic) -> SfxMsg -> SfxAtomic
forall a b. (a -> b) -> a -> b
$ ItemId -> Int -> LevelId -> SfxMsg
SfxItemYield ItemId
iidOriginal (ItemQuant -> Int
forall a b. (a, b) -> a
fst ItemQuant
kitNew) (Actor -> LevelId
blid Actor
tb)
            Maybe ItemId
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          -- No such items or some items, but void delta, so create items.
          -- If it's, e.g., a periodic poison, the new items will stack with any
          -- already existing items.
          iid <- registerItem True (itemFull, kitNew) itemKnown c
          -- If created not on the ground, ID it, because it won't be on pickup.
          -- If ground and stash coincide, unindentified item enters stash,
          -- so will be identified when equipped, used or dropped
          -- and picked again.
          if isJust mcount  -- not a random effect, so probably crafting
             && not (IA.isHumanTrinket (itemKind itemFull))
          then execUpdAtomic $ UpdDiscover c iid (itemKindId itemFull) arItem
          else when (store /= CGround) $
            discoverIfMinorEffects c iid (itemKindId itemFull)
          return UseUp

-- ** DestroyItem

-- | Make the target actor destroy items in a store from the given group.
-- The item that caused the effect itself is *not* immune, because often
-- the item needs to destroy itself, e.g., to model wear and tear.
-- In such a case, the item may need to be identified, in a container,
-- when it no longer exists, at least in the container. This is OK.
-- Durable items are not immune, unlike the tools in @ConsumeItems@.
effectDestroyItem :: MonadServerAtomic m
                  => m () -> Int -> Int -> CStore -> ActorId
                  -> GroupName ItemKind
                  -> m UseResult
effectDestroyItem :: forall (m :: * -> *).
MonadServerAtomic m =>
m ()
-> Int
-> Int
-> CStore
-> ActorId
-> GroupName ItemKind
-> m UseResult
effectDestroyItem m ()
execSfx Int
ngroup Int
kcopy CStore
store ActorId
target GroupName ItemKind
grp = do
  tb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
  is <- allGroupItems store grp target
  if null is then return UseDud
  else do
    execSfx
    urs <- mapM (uncurry (dropCStoreItem True True store target tb kcopy))
                (take ngroup is)
    return $! case urs of
      [] -> UseResult
UseDud  -- there was no effects
      [UseResult]
_ -> [UseResult] -> UseResult
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [UseResult]
urs

-- | Drop a single actor's item (though possibly multiple copies).
-- Note that if there are multiple copies, at most one explodes
-- to avoid excessive carnage and UI clutter (let's say,
-- the multiple explosions interfere with each other or perhaps
-- larger quantities of explosives tend to be packaged more safely).
-- Note also that @OnSmash@ effects are activated even if item discharged.
dropCStoreItem :: MonadServerAtomic m
               => Bool -> Bool -> CStore -> ActorId -> Actor -> Int
               -> ItemId -> ItemQuant
               -> m UseResult
dropCStoreItem :: forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> Bool
-> CStore
-> ActorId
-> Actor
-> Int
-> ItemId
-> ItemQuant
-> m UseResult
dropCStoreItem Bool
verbose Bool
destroy CStore
store ActorId
aid Actor
b Int
kMax ItemId
iid (Int
k, ItemTimers
_) = do
 let c :: Container
c = ActorId -> CStore -> Container
CActor ActorId
aid CStore
store
 bag0 <- (State -> ItemBag) -> m ItemBag
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Container -> State -> ItemBag
getContainerBag Container
c
  -- @OnSmash@ effects of previous items may remove next items, so better check.
 if iid `EM.notMember` bag0 then return UseDud else do
  itemFull <- getsState $ itemToFull iid
  let arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
      fragile = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Fragile AspectRecord
arItem
      durable = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Durable AspectRecord
arItem
      isDestroyed = Bool
destroy
                    Bool -> Bool -> Bool
|| Actor -> Bool
bproj Actor
b Bool -> Bool -> Bool
&& (Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
durable Bool -> Bool -> Bool
|| Bool
fragile)
                    Bool -> Bool -> Bool
|| CStore
store CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
COrgan  -- just as organs are destroyed at death
                                        -- but also includes conditions
  if isDestroyed then do
    let effApplyFlags = EffApplyFlags
          { effToUse :: EffToUse
effToUse            = EffToUse
EffBare
              -- the embed could be combined at this point but @iid@ cannot
          , effVoluntary :: Bool
effVoluntary        = Bool
True
              -- we don't know if it's effVoluntary, so we conservatively assume
              -- it is and we blame @aid@
          , effUseAllCopies :: Bool
effUseAllCopies     = Int
kMax Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
k
          , effKineticPerformed :: Bool
effKineticPerformed = Bool
False
          , effActivation :: ActivationFlag
effActivation       = ActivationFlag
ActivationOnSmash
          , effMayDestroy :: Bool
effMayDestroy       = Bool
True
          }
    void $ effectAndDestroyAndAddKill effApplyFlags aid aid aid iid c itemFull
    -- One copy was destroyed (or none if the item was discharged),
    -- so let's mop up.
    bag <- getsState $ getContainerBag c
    maybe (return ())
          (\(Int
k1, ItemTimers
it) -> do
             let destroyedSoFar :: Int
destroyedSoFar = Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
k1
                 k2 :: Int
k2 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
kMax Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
destroyedSoFar) Int
k1
                 kit2 :: ItemQuant
kit2 = (Int
k2, Int -> ItemTimers -> ItemTimers
forall a. Int -> [a] -> [a]
take Int
k2 ItemTimers
it)
                 -- Don't spam if the effect already probably made noise
                 -- and also the number could be surprising to the player.
                 verbose2 :: Bool
verbose2 = Bool
verbose Bool -> Bool -> Bool
&& Int
k1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
k
             Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
k2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
               UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic
UpdDestroyItem Bool
verbose2 ItemId
iid (ItemFull -> Item
itemBase ItemFull
itemFull)
                                              ItemQuant
kit2 Container
c)
          (EM.lookup iid bag)
    return UseUp
  else do
    cDrop <- pickDroppable False aid b  -- drop over fog, etc.
    mvCmd <- generalMoveItem verbose iid (min kMax k) (CActor aid store) cDrop
    mapM_ execUpdAtomic mvCmd
    return UseUp

pickDroppable :: MonadStateRead m => Bool -> ActorId -> Actor -> m Container
pickDroppable :: forall (m :: * -> *).
MonadStateRead m =>
Bool -> ActorId -> Actor -> m Container
pickDroppable Bool
respectNoItem ActorId
aid Actor
b = do
  cops@COps{coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  lvl <- getLevel (blid b)
  let validTile ContentId TileKind
t = Bool -> Bool
not (Bool
respectNoItem Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isNoItem TileSpeedup
coTileSpeedup ContentId TileKind
t)
  if validTile $ lvl `at` bpos b
  then return $! CActor aid CGround
  else do
    let ps = COps -> Level -> (ContentId TileKind -> Bool) -> Point -> [Point]
nearbyFreePoints COps
cops Level
lvl ContentId TileKind -> Bool
validTile (Actor -> Point
bpos Actor
b)
    return $! case filter (adjacent $ bpos b) $ take 8 ps of
      [] -> ActorId -> CStore -> Container
CActor ActorId
aid CStore
CGround  -- fallback; still correct, though not ideal
      Point
pos : [Point]
_ -> LevelId -> Point -> Container
CFloor (Actor -> LevelId
blid Actor
b) Point
pos

-- ** ConsumeItems

-- | Make the target actor destroy the given items, if all present,
-- or none at all, if any is missing. To be used in crafting.
-- The item that caused the effect itself is not considered (any copies).
effectConsumeItems :: MonadServerAtomic m
                   => m () -> ItemId -> ActorId
                   -> [(Int, GroupName ItemKind)]
                   -> [(Int, GroupName ItemKind)]
                   -> m UseResult
effectConsumeItems :: forall (m :: * -> *).
MonadServerAtomic m =>
m ()
-> ItemId
-> ActorId
-> [(Int, GroupName ItemKind)]
-> [(Int, GroupName ItemKind)]
-> m UseResult
effectConsumeItems m ()
execSfx ItemId
iidOriginal ActorId
target [(Int, GroupName ItemKind)]
tools0 [(Int, GroupName ItemKind)]
raw0 = do
  kitAssG <- (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)])
-> (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall a b. (a -> b) -> a -> b
$ ActorId -> [CStore] -> State -> [(ItemId, ItemFullKit)]
kitAssocs ActorId
target [CStore
CGround]
  let kitAss = [(ItemId, ItemFullKit)]
-> [(ItemId, ItemFullKit)]
-> [((CStore, Bool), (ItemId, ItemFullKit))]
listToolsToConsume [(ItemId, ItemFullKit)]
kitAssG []  -- equipment too dangerous to use
      is = (((CStore, Bool), (ItemId, ItemFullKit)) -> Bool)
-> [((CStore, Bool), (ItemId, ItemFullKit))]
-> [((CStore, Bool), (ItemId, ItemFullKit))]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
/= ItemId
iidOriginal) (ItemId -> Bool)
-> (((CStore, Bool), (ItemId, ItemFullKit)) -> ItemId)
-> ((CStore, Bool), (ItemId, ItemFullKit))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, ItemFullKit) -> ItemId
forall a b. (a, b) -> a
fst ((ItemId, ItemFullKit) -> ItemId)
-> (((CStore, Bool), (ItemId, ItemFullKit))
    -> (ItemId, ItemFullKit))
-> ((CStore, Bool), (ItemId, ItemFullKit))
-> ItemId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((CStore, Bool), (ItemId, ItemFullKit)) -> (ItemId, ItemFullKit)
forall a b. (a, b) -> b
snd) [((CStore, Bool), (ItemId, ItemFullKit))]
kitAss
      grps0 = ((Int, GroupName ItemKind) -> (Bool, Int, GroupName ItemKind))
-> [(Int, GroupName ItemKind)] -> [(Bool, Int, GroupName ItemKind)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
x, GroupName ItemKind
y) -> (Bool
False, Int
x, GroupName ItemKind
y)) [(Int, GroupName ItemKind)]
tools0  -- apply if durable
              [(Bool, Int, GroupName ItemKind)]
-> [(Bool, Int, GroupName ItemKind)]
-> [(Bool, Int, GroupName ItemKind)]
forall a. [a] -> [a] -> [a]
++ ((Int, GroupName ItemKind) -> (Bool, Int, GroupName ItemKind))
-> [(Int, GroupName ItemKind)] -> [(Bool, Int, GroupName ItemKind)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
x, GroupName ItemKind
y) -> (Bool
True, Int
x, GroupName ItemKind
y)) [(Int, GroupName ItemKind)]
raw0  -- destroy always
      (bagsToLose3, iidsToApply3, grps3) =
        foldl' subtractIidfromGrps (EM.empty, [], grps0) is
  if null grps3 then do
    execSfx
    consumeItems target bagsToLose3 iidsToApply3
    return UseUp
  else return UseDud

consumeItems :: MonadServerAtomic m
             => ActorId -> EM.EnumMap CStore ItemBag
             -> [(CStore, (ItemId, ItemFull))]
             -> m ()
consumeItems :: forall (m :: * -> *).
MonadServerAtomic m =>
ActorId
-> EnumMap CStore ItemBag -> [(CStore, (ItemId, ItemFull))] -> m ()
consumeItems ActorId
target EnumMap CStore ItemBag
bagsToLose [(CStore, (ItemId, ItemFull))]
iidsToApply = do
  COps{coitem} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  tb <- getsState $ getActorBody target
  arTrunk <- getsState $ (EM.! btrunk tb) . sdiscoAspect
  let isBlast = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arTrunk
      identifyStoreBag CStore
store ItemBag
bag =
        (ItemId -> m ()) -> [ItemId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (CStore -> ItemId -> m ()
identifyStoreIid CStore
store) ([ItemId] -> m ()) -> [ItemId] -> m ()
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
bag
      identifyStoreIid CStore
store ItemId
iid = do
        discoAspect2 <- (State -> EnumMap ItemId AspectRecord)
-> m (EnumMap ItemId AspectRecord)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap ItemId AspectRecord
sdiscoAspect
          -- might have changed due to embedded items invocations
        itemKindId <- getsState $ getIidKindIdServer iid
        let arItem = EnumMap ItemId AspectRecord
discoAspect2 EnumMap ItemId AspectRecord -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
            c = ActorId -> CStore -> Container
CActor ActorId
target CStore
store
            itemKind = ContentData ItemKind -> ContentId ItemKind -> ItemKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ItemKind
coitem ContentId ItemKind
itemKindId
        unless (IA.isHumanTrinket itemKind) $  -- a hack
          execUpdAtomic $ UpdDiscover c iid itemKindId arItem
  -- We don't invoke @OnSmash@ effects, so we avoid the risk
  -- of the first removed item displacing the actor, destroying
  -- or scattering some pending items ahead of time, etc.
  -- The embed should provide any requisite fireworks instead.
  forM_ (EM.assocs bagsToLose) $ \(CStore
store, ItemBag
bagToLose) ->
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null ItemBag
bagToLose) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      CStore -> ItemBag -> m ()
identifyStoreBag CStore
store ItemBag
bagToLose
      -- Not @UpdLoseItemBag@, to be verbose.
      -- The bag is small, anyway.
      let c :: Container
c = ActorId -> CStore -> Container
CActor ActorId
target CStore
store
      itemD <- (State -> ItemDict) -> m ItemDict
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ItemDict
sitemD
      mapWithKeyM_ (\Key (EnumMap ItemId)
iid ItemQuant
kit -> do
                      let verbose :: Bool
verbose = Bool -> Bool
not Bool
isBlast  -- no spam
                          item :: Item
item = ItemDict
itemD ItemDict -> ItemId -> Item
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Key (EnumMap ItemId)
ItemId
iid
                      UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic
UpdDestroyItem Bool
verbose Key (EnumMap ItemId)
ItemId
iid Item
item ItemQuant
kit Container
c)
                   bagToLose
  -- But afterwards we do apply normal effects of durable items,
  -- even if the actor or other items displaced in the process,
  -- as long as a number of the items is still there.
  -- So if a harmful double-purpose tool-component is both to be used
  -- and destroyed, it will be lost, but at least it won't harm anybody.
  let applyItemIfPresent (CStore
store, (ItemId
iid, ItemFull
itemFull)) = do
        let c :: Container
c = ActorId -> CStore -> Container
CActor ActorId
target CStore
store
        bag <- (State -> ItemBag) -> m ItemBag
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Container -> State -> ItemBag
getContainerBag Container
c
        when (iid `EM.member` bag) $ do
          execSfxAtomic $ SfxApply target iid
          -- Treated as if the actor only activated the item on himself,
          -- without kinetic damage, to avoid the exploit of wearing armor
          -- when using tools or transforming terrain.
          -- Also, timeouts of the item ignored to prevent exploit
          -- by discharging the item before using it.
          let effApplyFlags = EffApplyFlags
                { effToUse :: EffToUse
effToUse            = EffToUse
EffBare  -- crafting not intended
                , effVoluntary :: Bool
effVoluntary        = Bool
True
                , effUseAllCopies :: Bool
effUseAllCopies     = Bool
False
                , effKineticPerformed :: Bool
effKineticPerformed = Bool
False
                , effActivation :: ActivationFlag
effActivation       = ActivationFlag
ActivationConsume
                , effMayDestroy :: Bool
effMayDestroy       = Bool
False
                }
          void $ effectAndDestroyAndAddKill effApplyFlags
                                            target target target iid c itemFull
  mapM_ applyItemIfPresent iidsToApply

-- ** DropItem

-- | Make the target actor drop items in a store from the given group.
-- The item that caused the effect itself is immune (any copies).
effectDropItem :: MonadServerAtomic m
               => m () -> ItemId -> Int -> Int -> CStore
               -> GroupName ItemKind -> ActorId
               -> m UseResult
effectDropItem :: forall (m :: * -> *).
MonadServerAtomic m =>
m ()
-> ItemId
-> Int
-> Int
-> CStore
-> GroupName ItemKind
-> ActorId
-> m UseResult
effectDropItem m ()
execSfx ItemId
iidOriginal Int
ngroup Int
kcopy CStore
store GroupName ItemKind
grp ActorId
target = do
  tb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
  fact <- getsState $ (EM.! bfid tb) . sfactionD
  isRaw <- allGroupItems store grp target
  curChalSer <- getsServer $ scurChalSer . soptions
  factionD <- getsState sfactionD
  let is = ((ItemId, ItemQuant) -> Bool)
-> [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
/= ItemId
iidOriginal) (ItemId -> Bool)
-> ((ItemId, ItemQuant) -> ItemId) -> (ItemId, ItemQuant) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, ItemQuant) -> ItemId
forall a b. (a, b) -> a
fst) [(ItemId, ItemQuant)]
isRaw
  if | bproj tb || null is -> return UseDud
     | ngroup == maxBound && kcopy == maxBound
       && store `elem` [CStash, CEqp]
       && fhasGender (gkind fact)  -- hero in Allure's decontamination chamber
       && (cdiff curChalSer == 1   -- at lowest difficulty for its faction
           && any (fhasUI . gkind . snd)
                  (filter (\(FactionId
fi, Faction
fa) -> FactionId -> Faction -> FactionId -> Bool
isFriend FactionId
fi Faction
fa (Actor -> FactionId
bfid Actor
tb))
                          (EM.assocs factionD))
           || cdiff curChalSer == difficultyBound
              && any (fhasUI . gkind  . snd)
                     (filter (\(FactionId
fi, Faction
fa) -> FactionId -> Faction -> FactionId -> Bool
isFoe FactionId
fi Faction
fa (Actor -> FactionId
bfid Actor
tb))
                             (EM.assocs factionD))) ->
{-
A hardwired hack, because AI heroes don't cope with Allure's decontamination
chamber; beginners may struggle too, so this is trigered by difficulty.
- AI heroes don't switch leader to the hero past laboratory to equip
weapons from stash between the in-lab hero picks up the loot pile
and himself enters the decontamination chamber
- the items of the last actor would be lost anyway, unless AI
is taught the foolproof solution of this puzzle, which is yet a bit more
specific than the two abilities above
-}
       return UseUp
     | otherwise -> do
       unless (store == COrgan) execSfx
       urs <- mapM (uncurry (dropCStoreItem True False store target tb kcopy))
                   (take ngroup is)
       return $! case urs of
         [] -> UseResult
UseDud  -- there was no effects
         [UseResult]
_ -> [UseResult] -> UseResult
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [UseResult]
urs

-- ** Recharge and Discharge

effectRecharge :: forall m. MonadServerAtomic m
               => Bool -> m () -> ItemId -> Int -> Dice.Dice -> ActorId
               -> m UseResult
effectRecharge :: forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> m () -> ItemId -> Int -> Dice -> ActorId -> m UseResult
effectRecharge Bool
reducingCooldown m ()
execSfx ItemId
iidOriginal Int
n0 Dice
dice ActorId
target = do
 tb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
 if bproj tb then return UseDud else do  -- slows down, but rarely any effect
  localTime <- getsState $ getLocalTime (blid tb)
  totalDepth <- getsState stotalDepth
  Level{ldepth} <- getLevel $ blid tb
  power <- rndToAction $ castDice ldepth totalDepth dice
  let timeUnit = if Bool
reducingCooldown
                 then Time -> Time
absoluteTimeNegate Time
timeClip
                 else Time
timeClip
      delta = Delta Time -> Int -> Delta Time
timeDeltaScale (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeUnit) Int
power
      localTimer = Time -> Delta Time -> ItemTimer
createItemTimer Time
localTime (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeZero)
      addToCooldown :: CStore -> (Int, UseResult) -> (ItemId, ItemFullKit)
                    -> m (Int, UseResult)
      addToCooldown CStore
_ (Int
0, UseResult
ur) (ItemId, ItemFullKit)
_ = (Int, UseResult) -> m (Int, UseResult)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
0, UseResult
ur)
      addToCooldown CStore
store (Int
n, UseResult
ur) (ItemId
iid, (ItemFull
_, (Int
k0, ItemTimers
itemTimers0))) = do
        let itemTimers :: ItemTimers
itemTimers = (ItemTimer -> Bool) -> ItemTimers -> ItemTimers
forall a. (a -> Bool) -> [a] -> [a]
filter (Time -> ItemTimer -> Bool
charging Time
localTime) ItemTimers
itemTimers0
            kt :: Int
kt = ItemTimers -> Int
forall a. [a] -> Int
length ItemTimers
itemTimers
            lenToShift :: Int
lenToShift = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ if Bool
reducingCooldown then Int
kt else Int
k0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
kt
            (ItemTimers
itToShift, ItemTimers
itToKeep) =
              if Bool
reducingCooldown
              then Int -> ItemTimers -> (ItemTimers, ItemTimers)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
lenToShift ItemTimers
itemTimers
              else (Int -> ItemTimer -> ItemTimers
forall a. Int -> a -> [a]
replicate Int
lenToShift ItemTimer
localTimer, ItemTimers
itemTimers)
            -- No problem if this overcharges; equivalent to pruned timer.
            it2 :: ItemTimers
it2 = (ItemTimer -> ItemTimer) -> ItemTimers -> ItemTimers
forall a b. (a -> b) -> [a] -> [b]
map (Delta Time -> ItemTimer -> ItemTimer
shiftItemTimer Delta Time
delta) ItemTimers
itToShift ItemTimers -> ItemTimers -> ItemTimers
forall a. [a] -> [a] -> [a]
++ ItemTimers
itToKeep
        if ItemTimers
itemTimers0 ItemTimers -> ItemTimers -> Bool
forall a. Eq a => a -> a -> Bool
== ItemTimers
it2
        then (Int, UseResult) -> m (Int, UseResult)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n, UseResult
ur)
        else do
          let c :: Container
c = ActorId -> CStore -> Container
CActor ActorId
target CStore
store
          UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ItemId -> Container -> ItemTimers -> ItemTimers -> UpdAtomic
UpdTimeItem ItemId
iid Container
c ItemTimers
itemTimers0 ItemTimers
it2
          (Int, UseResult) -> m (Int, UseResult)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lenToShift, UseResult
UseUp)
      selectWeapon i :: (ItemId, ItemFullKit)
i@(ItemId
iid, (ItemFull
itemFull, ItemQuant
_)) ([(ItemId, ItemFullKit)]
weapons, [(ItemId, ItemFullKit)]
others) =
        let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
        in if | AspectRecord -> Int
IA.aTimeout AspectRecord
arItem Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                Bool -> Bool -> Bool
|| ItemId
iid ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
== ItemId
iidOriginal -> ([(ItemId, ItemFullKit)]
weapons, [(ItemId, ItemFullKit)]
others)
              | Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable AspectRecord
arItem -> ((ItemId, ItemFullKit)
i (ItemId, ItemFullKit)
-> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
forall a. a -> [a] -> [a]
: [(ItemId, ItemFullKit)]
weapons, [(ItemId, ItemFullKit)]
others)
              | Bool
otherwise -> ([(ItemId, ItemFullKit)]
weapons, (ItemId, ItemFullKit)
i (ItemId, ItemFullKit)
-> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
forall a. a -> [a] -> [a]
: [(ItemId, ItemFullKit)]
others)
      partitionWeapon = ((ItemId, ItemFullKit)
 -> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
 -> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)]))
-> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
-> [(ItemId, ItemFullKit)]
-> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ItemId, ItemFullKit)
-> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
-> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
selectWeapon ([],[])
      ignoreCharges = Bool
True  -- handled above depending on @reducingCooldown@
      benefits = Maybe a
forall a. Maybe a
Nothing  -- only raw damage counts (client knows benefits)
      sortWeapons [(ItemId, ItemFullKit)]
ass =
        ((Double, Bool, Int, Int, ItemId, ItemFullKit)
 -> (ItemId, ItemFullKit))
-> [(Double, Bool, Int, Int, ItemId, ItemFullKit)]
-> [(ItemId, ItemFullKit)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Double
_, Bool
_, Int
_, Int
_, ItemId
iid, ItemFullKit
itemFullKit) -> (ItemId
iid, ItemFullKit
itemFullKit))
        ([(Double, Bool, Int, Int, ItemId, ItemFullKit)]
 -> [(ItemId, ItemFullKit)])
-> [(Double, Bool, Int, Int, ItemId, ItemFullKit)]
-> [(ItemId, ItemFullKit)]
forall a b. (a -> b) -> a -> b
$ Bool
-> Maybe DiscoveryBenefit
-> Time
-> [(ItemId, ItemFullKit)]
-> [(Double, Bool, Int, Int, ItemId, ItemFullKit)]
strongestMelee Bool
ignoreCharges Maybe DiscoveryBenefit
forall a. Maybe a
benefits Time
localTime [(ItemId, ItemFullKit)]
ass
  eqpAss <- getsState $ kitAssocs target [CEqp]
  let (eqpAssWeapons, eqpAssOthers) = partitionWeapon eqpAss
  organAss <- getsState $ kitAssocs target [COrgan]
  let (organAssWeapons, organAssOthers) = partitionWeapon organAss
  (nEqpWeapons, urEqpWeapons) <-
    foldM (addToCooldown CEqp) (n0, UseDud)
    $ sortWeapons eqpAssWeapons
  (nOrganWeapons, urOrganWeapons) <-
    foldM (addToCooldown COrgan) (nEqpWeapons, urEqpWeapons)
    $ sortWeapons organAssWeapons
  (nEqpOthers, urEqpOthers) <-
    foldM (addToCooldown CEqp) (nOrganWeapons, urOrganWeapons) eqpAssOthers
  (_nOrganOthers, urOrganOthers) <-
    foldM (addToCooldown COrgan) (nEqpOthers, urEqpOthers) organAssOthers
  if urOrganOthers == UseDud then return UseDud
  else do
    execSfx
    return UseUp

-- ** PolyItem

-- Can't apply to the item itself (any copies).
effectPolyItem :: MonadServerAtomic m
               => m () -> ItemId -> ActorId -> m UseResult
effectPolyItem :: forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ItemId -> ActorId -> m UseResult
effectPolyItem m ()
execSfx ItemId
iidOriginal ActorId
target = do
  tb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
  let cstore = CStore
CGround
  kitAss <- getsState $ kitAssocs target [cstore]
  case filter ((/= iidOriginal) . fst) kitAss of
    [] -> do
      SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid (Actor -> FactionId
bfid Actor
tb) SfxMsg
SfxPurposeNothing
      -- Do not spam the source actor player about the failures.
      UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
    (ItemId
iid, ( itemFull :: ItemFull
itemFull@ItemFull{Item
itemBase :: ItemFull -> Item
itemBase :: Item
itemBase, ContentId ItemKind
itemKindId :: ItemFull -> ContentId ItemKind
itemKindId :: ContentId ItemKind
itemKindId, ItemKind
itemKind :: ItemFull -> ItemKind
itemKind :: ItemKind
itemKind}
          , (Int
itemK, ItemTimers
itemTimer) )) : [(ItemId, ItemFullKit)]
_ -> do
      let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
          maxCount :: Int
maxCount = Dice -> Int
Dice.supDice (Dice -> Int) -> Dice -> Int
forall a b. (a -> b) -> a -> b
$ ItemKind -> Dice
IK.icount ItemKind
itemKind
      if | Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Unique AspectRecord
arItem -> do
           SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid (Actor -> FactionId
bfid Actor
tb) SfxMsg
SfxPurposeUnique
           UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
         | Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (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
IK.COMMON_ITEM ([(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 -> do
           SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid (Actor -> FactionId
bfid Actor
tb) SfxMsg
SfxPurposeNotCommon
           UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
         | Int
itemK Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxCount -> do
           SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid (Actor -> FactionId
bfid Actor
tb)
                         (SfxMsg -> SfxAtomic) -> SfxMsg -> SfxAtomic
forall a b. (a -> b) -> a -> b
$ Int -> Int -> SfxMsg
SfxPurposeTooFew Int
maxCount Int
itemK
           UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
         | Bool
otherwise -> do
           -- Only the required number of items is used up, not all of them.
           let c :: Container
c = ActorId -> CStore -> Container
CActor ActorId
target CStore
cstore
               kit :: ItemQuant
kit = (Int
maxCount, Int -> ItemTimers -> ItemTimers
forall a. Int -> [a] -> [a]
take Int
maxCount ItemTimers
itemTimer)
           m ()
execSfx
           ItemId -> Container -> ContentId ItemKind -> ItemKind -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ItemId -> Container -> ContentId ItemKind -> ItemKind -> m ()
identifyIid ItemId
iid Container
c ContentId ItemKind
itemKindId ItemKind
itemKind
           UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic
UpdDestroyItem Bool
True ItemId
iid Item
itemBase ItemQuant
kit Container
c
           Maybe FactionId
-> Maybe Int
-> ActorId
-> ActorId
-> Maybe ItemId
-> CStore
-> GroupName ItemKind
-> TimerDice
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
Maybe FactionId
-> Maybe Int
-> ActorId
-> ActorId
-> Maybe ItemId
-> CStore
-> GroupName ItemKind
-> TimerDice
-> m UseResult
effectCreateItem (FactionId -> Maybe FactionId
forall a. a -> Maybe a
Just (FactionId -> Maybe FactionId) -> FactionId -> Maybe FactionId
forall a b. (a -> b) -> a -> b
$ Actor -> FactionId
bfid Actor
tb) Maybe Int
forall a. Maybe a
Nothing
                            ActorId
target ActorId
target Maybe ItemId
forall a. Maybe a
Nothing CStore
cstore
                            GroupName ItemKind
IK.COMMON_ITEM TimerDice
IK.timerNone

-- ** RerollItem

-- Can't apply to the item itself (any copies).
effectRerollItem :: forall m . MonadServerAtomic m
                 => m () -> ItemId -> ActorId -> m UseResult
effectRerollItem :: forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ItemId -> ActorId -> m UseResult
effectRerollItem m ()
execSfx ItemId
iidOriginal ActorId
target = do
  COps{coItemSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  tb <- getsState $ getActorBody target
  let cstore = CStore
CGround  -- if ever changed, call @discoverIfMinorEffects@
  kitAss <- getsState $ kitAssocs target [cstore]
  case filter ((/= iidOriginal) . fst) kitAss of
    [] -> do
      SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid (Actor -> FactionId
bfid Actor
tb) SfxMsg
SfxRerollNothing
      -- Do not spam the source actor player about the failures.
      UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
    (ItemId
iid, ( ItemFull{ Item
itemBase :: ItemFull -> Item
itemBase :: Item
itemBase, ContentId ItemKind
itemKindId :: ItemFull -> ContentId ItemKind
itemKindId :: ContentId ItemKind
itemKindId, ItemKind
itemKind :: ItemFull -> ItemKind
itemKind :: ItemKind
itemKind
                    , itemDisco :: ItemFull -> ItemDisco
itemDisco=ItemDiscoFull AspectRecord
itemAspect }
          , (Int
_, ItemTimers
itemTimer) )) : [(ItemId, ItemFullKit)]
_ ->
      if KindMean -> Bool
IA.kmConst (KindMean -> Bool) -> KindMean -> Bool
forall a b. (a -> b) -> a -> b
$ ContentId ItemKind -> ItemSpeedup -> KindMean
getKindMean ContentId ItemKind
itemKindId ItemSpeedup
coItemSpeedup then do
        SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid (Actor -> FactionId
bfid Actor
tb) SfxMsg
SfxRerollNotRandom
        UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
      else do
        let c :: Container
c = ActorId -> CStore -> Container
CActor ActorId
target CStore
cstore
            kit :: ItemQuant
kit = (Int
1, Int -> ItemTimers -> ItemTimers
forall a. Int -> [a] -> [a]
take Int
1 ItemTimers
itemTimer)  -- prevent micromanagement
            freq :: Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq = (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
forall a. a -> Frequency a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GroupName ItemKind
IK.HORROR, ContentId ItemKind
itemKindId, ItemKind
itemKind)
        m ()
execSfx
        ItemId -> Container -> ContentId ItemKind -> ItemKind -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ItemId -> Container -> ContentId ItemKind -> ItemKind -> m ()
identifyIid ItemId
iid Container
c ContentId ItemKind
itemKindId ItemKind
itemKind
        UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic
UpdDestroyItem Bool
False ItemId
iid Item
itemBase ItemQuant
kit Container
c
        totalDepth <- (State -> AbsDepth) -> m AbsDepth
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> AbsDepth
stotalDepth
        let roll100 :: Int -> m (ItemKnown, ItemFull)
            roll100 Int
n = do
              -- Not only rerolled, but at highest depth possible,
              -- resulting in highest potential for bonuses.
              m2 <- Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> AbsDepth -> m NewItem
forall (m :: * -> *).
MonadServerAtomic m =>
Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> AbsDepth -> m NewItem
rollItemAspect Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq AbsDepth
totalDepth
              case m2 of
                NewItem
NoNewItem ->
                  [Char] -> m (ItemKnown, ItemFull)
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
"effectRerollItem: can't create rerolled item"
                NewItem GroupName ItemKind
_ itemKnown :: ItemKnown
itemKnown@(ItemKnown ItemIdentity
_ AspectRecord
ar2 Maybe FactionId
_) ItemFull
itemFull ItemQuant
_ ->
                  if AspectRecord
ar2 AspectRecord -> AspectRecord -> Bool
forall a. Eq a => a -> a -> Bool
== AspectRecord
itemAspect Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                  then Int -> m (ItemKnown, ItemFull)
roll100 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
                  else (ItemKnown, ItemFull) -> m (ItemKnown, ItemFull)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (ItemKnown
itemKnown, ItemFull
itemFull)
        (itemKnown, itemFull) <- roll100 100
        void $ registerItem True (itemFull, kit) itemKnown c
        return UseUp
    [(ItemId, ItemFullKit)]
_ -> [Char] -> m UseResult
forall a. (?callStack::CallStack) => [Char] -> a
error [Char]
"effectRerollItem: server ignorant about an item"

-- ** DupItem

-- Can't apply to the item itself (any copies).
effectDupItem :: MonadServerAtomic m => m () -> ItemId -> ActorId -> m UseResult
effectDupItem :: forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ItemId -> ActorId -> m UseResult
effectDupItem m ()
execSfx ItemId
iidOriginal ActorId
target = do
  tb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
  let cstore = CStore
CGround  -- beware of other options, e.g., creating in eqp
                        -- and not setting timeout to a random value
  kitAss <- getsState $ kitAssocs target [cstore]
  case filter ((/= iidOriginal) . fst) kitAss of
    [] -> do
      SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid (Actor -> FactionId
bfid Actor
tb) SfxMsg
SfxDupNothing
      -- Do not spam the source actor player about the failures.
      UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
    (ItemId
iid, ( itemFull :: ItemFull
itemFull@ItemFull{ContentId ItemKind
itemKindId :: ItemFull -> ContentId ItemKind
itemKindId :: ContentId ItemKind
itemKindId, ItemKind
itemKind :: ItemFull -> ItemKind
itemKind :: ItemKind
itemKind}
          , ItemQuant
_ )) : [(ItemId, ItemFullKit)]
_ -> do
      let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
      if | Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Unique AspectRecord
arItem -> do
           SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid (Actor -> FactionId
bfid Actor
tb) SfxMsg
SfxDupUnique
           UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
         | 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
IK.VALUABLE ([(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 -> do
           SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid (Actor -> FactionId
bfid Actor
tb) SfxMsg
SfxDupValuable
           UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
         | Bool
otherwise -> do
           let c :: Container
c = ActorId -> CStore -> Container
CActor ActorId
target CStore
cstore
           m ()
execSfx
           ItemId -> Container -> ContentId ItemKind -> ItemKind -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ItemId -> Container -> ContentId ItemKind -> ItemKind -> m ()
identifyIid ItemId
iid Container
c ContentId ItemKind
itemKindId ItemKind
itemKind
           let slore :: SLore
slore = AspectRecord -> Container -> SLore
IA.loreFromContainer AspectRecord
arItem Container
c
           (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
             StateServer
ser {sgenerationAn = EM.adjust (EM.insertWith (+) iid 1) slore
                                            (sgenerationAn ser)}
           UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ItemId -> Item -> ItemQuant -> Container -> UpdAtomic
UpdCreateItem Bool
True ItemId
iid (ItemFull -> Item
itemBase ItemFull
itemFull)
                                         ItemQuant
quantSingle Container
c
           UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp

-- ** Identify

effectIdentify :: MonadServerAtomic m
               => m () -> ItemId -> ActorId -> m UseResult
effectIdentify :: forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ItemId -> ActorId -> m UseResult
effectIdentify m ()
execSfx ItemId
iidOriginal ActorId
target = do
  COps{coItemSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  discoAspect <- getsState sdiscoAspect
  -- The actor that causes the application does not determine what item
  -- is identifiable, becuase it's the target actor that identifies
  -- his possesions.
  tb <- getsState $ getActorBody target
  sClient <- getsServer $ (EM.! bfid tb) . sclientStates
  let tryFull CStore
store [(ItemId, ItemFull)]
as = case [(ItemId, ItemFull)]
as of
        [] -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        (ItemId
iid, ItemFull
_) : [(ItemId, ItemFull)]
rest | ItemId
iid ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
== ItemId
iidOriginal -> CStore -> [(ItemId, ItemFull)] -> m Bool
tryFull CStore
store [(ItemId, ItemFull)]
rest  -- don't id itself
        (ItemId
iid, ItemFull{Item
itemBase :: ItemFull -> Item
itemBase :: Item
itemBase, ContentId ItemKind
itemKindId :: ItemFull -> ContentId ItemKind
itemKindId :: ContentId ItemKind
itemKindId, ItemKind
itemKind :: ItemFull -> ItemKind
itemKind :: ItemKind
itemKind}) : [(ItemId, ItemFull)]
rest -> do
          let arItem :: AspectRecord
arItem = EnumMap ItemId AspectRecord
discoAspect EnumMap ItemId AspectRecord -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
              kindIsKnown :: Bool
kindIsKnown = case Item -> ItemIdentity
jkind Item
itemBase of
                IdentityObvious ContentId ItemKind
_ -> Bool
True
                IdentityCovered ItemKindIx
ix ContentId ItemKind
_ -> ItemKindIx
ix ItemKindIx -> EnumMap ItemKindIx (ContentId ItemKind) -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` State -> EnumMap ItemKindIx (ContentId ItemKind)
sdiscoKind State
sClient
          if ItemId
iid ItemId -> EnumMap ItemId AspectRecord -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` State -> EnumMap ItemId AspectRecord
sdiscoAspect State
sClient  -- already fully identified
             Bool -> Bool -> Bool
|| ItemKind -> Bool
IA.isHumanTrinket ItemKind
itemKind  -- hack; keep them non-identified
             Bool -> Bool -> Bool
|| CStore
store CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CGround Bool -> Bool -> Bool
&& AspectRecord -> ItemKind -> Bool
IA.onlyMinorEffects AspectRecord
arItem ItemKind
itemKind
               -- will be identified when picked up, so don't bother
             Bool -> Bool -> Bool
|| KindMean -> Bool
IA.kmConst (ContentId ItemKind -> ItemSpeedup -> KindMean
getKindMean ContentId ItemKind
itemKindId ItemSpeedup
coItemSpeedup)
                Bool -> Bool -> Bool
&& Bool
kindIsKnown
               -- constant aspects and known kind; no need to identify further;
               -- this should normally not be needed, since clients should
               -- identify such items for free
          then CStore -> [(ItemId, ItemFull)] -> m Bool
tryFull CStore
store [(ItemId, ItemFull)]
rest
          else do
            let c :: Container
c = ActorId -> CStore -> Container
CActor ActorId
target CStore
store
            m ()
execSfx
            ItemId -> Container -> ContentId ItemKind -> ItemKind -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ItemId -> Container -> ContentId ItemKind -> ItemKind -> m ()
identifyIid ItemId
iid Container
c ContentId ItemKind
itemKindId ItemKind
itemKind
            Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      tryStore [CStore]
stores = case [CStore]
stores of
        [] -> do
          SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid (Actor -> FactionId
bfid Actor
tb) SfxMsg
SfxIdentifyNothing
          UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId  -- the message tells it's ID effect
        CStore
store : [CStore]
rest -> do
          allAssocs <- (State -> [(ItemId, ItemFull)]) -> m [(ItemId, ItemFull)]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemFull)]) -> m [(ItemId, ItemFull)])
-> (State -> [(ItemId, ItemFull)]) -> m [(ItemId, ItemFull)]
forall a b. (a -> b) -> a -> b
$ ActorId -> [CStore] -> State -> [(ItemId, ItemFull)]
fullAssocs ActorId
target [CStore
store]
          go <- tryFull store allAssocs
          if go then return UseUp else tryStore rest
  tryStore [CGround, CStash, CEqp]

-- The item need not be in the container. It's used for a message only.
identifyIid :: MonadServerAtomic m
            => ItemId -> Container -> ContentId ItemKind -> ItemKind -> m ()
identifyIid :: forall (m :: * -> *).
MonadServerAtomic m =>
ItemId -> Container -> ContentId ItemKind -> ItemKind -> m ()
identifyIid ItemId
iid Container
c ContentId ItemKind
itemKindId ItemKind
itemKind =
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ItemKind -> Bool
IA.isHumanTrinket ItemKind
itemKind) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    discoAspect <- (State -> EnumMap ItemId AspectRecord)
-> m (EnumMap ItemId AspectRecord)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap ItemId AspectRecord
sdiscoAspect
    execUpdAtomic $ UpdDiscover c iid itemKindId $ discoAspect EM.! iid

-- ** Detect

effectDetect :: MonadServerAtomic m
             => m () -> IK.DetectKind -> Int -> ActorId -> Container
             -> m UseResult
effectDetect :: forall (m :: * -> *).
MonadServerAtomic m =>
m () -> DetectKind -> Int -> ActorId -> Container -> m UseResult
effectDetect m ()
execSfx DetectKind
d Int
radius ActorId
target Container
container = do
  COps{coitem, coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  b <- getsState $ getActorBody target
  lvl <- getLevel $ blid b
  sClient <- getsServer $ (EM.! bfid b) . sclientStates
  let lvlClient = (Dungeon -> LevelId -> Level
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> LevelId
blid Actor
b) (Dungeon -> Level) -> (State -> Dungeon) -> State -> Level
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Dungeon
sdungeon (State -> Level) -> State -> Level
forall a b. (a -> b) -> a -> b
$ State
sClient
  s <- getState
  getKind <- getsState $ flip getIidKindServer
  factionD <- getsState sfactionD
  let lootPredicate Point
p =
        Point
p Point -> EnumMap Point ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` Level -> EnumMap Point ItemBag
lfloor Level
lvl
        Bool -> Bool -> Bool
|| (case Point -> LevelId -> State -> Maybe (ActorId, Actor)
posToBigAssoc Point
p (Actor -> LevelId
blid Actor
b) State
s of
              Maybe (ActorId, Actor)
Nothing -> Bool
False
              Just (ActorId
_, Actor
body) ->
                let belongings :: [ItemId]
belongings = ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (Actor -> ItemBag
beqp Actor
body)  -- shared stash ignored
                in (ItemId -> Bool) -> [ItemId] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ItemId -> Bool
belongingIsLoot [ItemId]
belongings)
        Bool -> Bool -> Bool
|| (ItemId -> Bool) -> [ItemId] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ItemId -> Bool
embedHasLoot (ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (ItemBag -> [ItemId]) -> ItemBag -> [ItemId]
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> State -> ItemBag
getEmbedBag (Actor -> LevelId
blid Actor
b) Point
p State
s)
      itemKindIsLoot = Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Int -> Bool) -> (ItemKind -> Maybe Int) -> ItemKind -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupName ItemKind -> [(GroupName ItemKind, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup GroupName ItemKind
IK.UNREPORTED_INVENTORY ([(GroupName ItemKind, Int)] -> Maybe Int)
-> (ItemKind -> [(GroupName ItemKind, Int)])
-> ItemKind
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemKind -> [(GroupName ItemKind, Int)]
IK.ifreq
      belongingIsLoot ItemId
iid = ItemKind -> Bool
itemKindIsLoot (ItemKind -> Bool) -> ItemKind -> Bool
forall a b. (a -> b) -> a -> b
$ ItemId -> ItemKind
getKind ItemId
iid
      embedHasLoot ItemId
iid = (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Effect -> Bool
effectHasLoot ([Effect] -> Bool) -> [Effect] -> Bool
forall a b. (a -> b) -> a -> b
$ ItemKind -> [Effect]
IK.ieffects (ItemKind -> [Effect]) -> ItemKind -> [Effect]
forall a b. (a -> b) -> a -> b
$ ItemId -> ItemKind
getKind ItemId
iid
      reported Bool
acc p
_ p
_ ItemKind
itemKind = Bool
acc Bool -> Bool -> Bool
&& ItemKind -> Bool
itemKindIsLoot ItemKind
itemKind
      effectHasLoot (IK.CreateItem Maybe Int
_ CStore
cstore GroupName ItemKind
grp TimerDice
_) =
        CStore
cstore CStore -> [CStore] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore
CGround, CStore
CStash, CStore
CEqp]
        Bool -> Bool -> Bool
&& ContentData ItemKind
-> GroupName ItemKind
-> (Bool -> Int -> ContentId ItemKind -> ItemKind -> Bool)
-> Bool
-> Bool
forall a b.
ContentData a
-> GroupName a -> (b -> Int -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData ItemKind
coitem GroupName ItemKind
grp Bool -> Int -> ContentId ItemKind -> ItemKind -> Bool
forall {p} {p}. Bool -> p -> p -> ItemKind -> Bool
reported Bool
True
      effectHasLoot Effect
IK.PolyItem = Bool
True
      effectHasLoot Effect
IK.RerollItem = Bool
True
      effectHasLoot Effect
IK.DupItem = Bool
True
      effectHasLoot (IK.AtMostOneOf [Effect]
l) = (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Effect -> Bool
effectHasLoot [Effect]
l
      effectHasLoot (IK.OneOf [Effect]
l) = (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Effect -> Bool
effectHasLoot [Effect]
l
      effectHasLoot (IK.OnSmash Effect
eff) = Effect -> Bool
effectHasLoot Effect
eff
      effectHasLoot (IK.OnUser Effect
eff) = Effect -> Bool
effectHasLoot Effect
eff
      effectHasLoot (IK.AndEffect Effect
eff1 Effect
eff2) =
        Effect -> Bool
effectHasLoot Effect
eff1 Bool -> Bool -> Bool
|| Effect -> Bool
effectHasLoot Effect
eff2
      effectHasLoot (IK.OrEffect Effect
eff1 Effect
eff2) =
        Effect -> Bool
effectHasLoot Effect
eff1 Bool -> Bool -> Bool
|| Effect -> Bool
effectHasLoot Effect
eff2
      effectHasLoot (IK.SeqEffect [Effect]
effs) =
        (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Effect -> Bool
effectHasLoot [Effect]
effs
      effectHasLoot (IK.When Condition
_ Effect
eff) = Effect -> Bool
effectHasLoot Effect
eff
      effectHasLoot (IK.Unless Condition
_ Effect
eff) = Effect -> Bool
effectHasLoot Effect
eff
      effectHasLoot (IK.IfThenElse Condition
_ Effect
eff1 Effect
eff2) =
        Effect -> Bool
effectHasLoot Effect
eff1 Bool -> Bool -> Bool
|| Effect -> Bool
effectHasLoot Effect
eff2
      effectHasLoot Effect
_ = Bool
False
      stashPredicate Point
p = ((FactionId, Faction) -> Bool) -> [(FactionId, Faction)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Point -> (FactionId, Faction) -> Bool
onStash Point
p) ([(FactionId, Faction)] -> Bool) -> [(FactionId, Faction)] -> Bool
forall a b. (a -> b) -> a -> b
$ EnumMap FactionId Faction -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap FactionId Faction
factionD
      onStash Point
p (FactionId
fid, Faction
fact) = case Faction -> Maybe (LevelId, Point)
gstash Faction
fact of
        Just (LevelId
lid, Point
pos) -> Point
pos Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
p Bool -> Bool -> Bool
&& LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
b Bool -> Bool -> Bool
&& FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> FactionId
bfid Actor
b
        Maybe (LevelId, Point)
Nothing -> Bool
False
      (predicate, action) = case d of
        DetectKind
IK.DetectAll -> (Bool -> Point -> Bool
forall a b. a -> b -> a
const Bool
True, m Bool -> [Point] -> m Bool
forall a b. a -> b -> a
const (m Bool -> [Point] -> m Bool) -> m Bool -> [Point] -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
        DetectKind
IK.DetectActor -> ((Point -> BigActorMap -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` Level -> BigActorMap
lbig Level
lvl), m Bool -> [Point] -> m Bool
forall a b. a -> b -> a
const (m Bool -> [Point] -> m Bool) -> m Bool -> [Point] -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
        DetectKind
IK.DetectLoot -> (Point -> Bool
lootPredicate, m Bool -> [Point] -> m Bool
forall a b. a -> b -> a
const (m Bool -> [Point] -> m Bool) -> m Bool -> [Point] -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
        DetectKind
IK.DetectExit ->
          let ([Point]
ls1, [Point]
ls2) = Level -> ([Point], [Point])
lstair Level
lvl
          in ((Point -> [Point] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Point]
ls1 [Point] -> [Point] -> [Point]
forall a. [a] -> [a] -> [a]
++ [Point]
ls2 [Point] -> [Point] -> [Point]
forall a. [a] -> [a] -> [a]
++ Level -> [Point]
lescape Level
lvl), m Bool -> [Point] -> m Bool
forall a b. a -> b -> a
const (m Bool -> [Point] -> m Bool) -> m Bool -> [Point] -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
        DetectKind
IK.DetectHidden ->
          let predicateH :: Point -> Bool
predicateH Point
p = let tClient :: ContentId TileKind
tClient = Level
lvlClient Level -> Point -> ContentId TileKind
`at` Point
p
                                 tServer :: ContentId TileKind
tServer = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p
                             in TileSpeedup -> ContentId TileKind -> Bool
Tile.isHideAs TileSpeedup
coTileSpeedup ContentId TileKind
tServer
                                Bool -> Bool -> Bool
&& ContentId TileKind
tClient ContentId TileKind -> ContentId TileKind -> Bool
forall a. Eq a => a -> a -> Bool
/= ContentId TileKind
tServer
                -- the actor searches only tiles he doesn't know already,
                -- preventing misleading messages (and giving less information
                -- to eavesdropping parties)
              revealEmbed :: Point -> m ()
revealEmbed Point
p = do
                embeds <- (State -> ItemBag) -> m ItemBag
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> State -> ItemBag
getEmbedBag (Actor -> LevelId
blid Actor
b) Point
p
                unless (EM.null embeds) $
                  execUpdAtomic $ UpdSpotItemBag True (CEmbed (blid b) p) embeds
              actionH :: [Point] -> m Bool
actionH [Point]
l = do
                pos <- (State -> Point) -> m Point
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Point) -> m Point) -> (State -> Point) -> m Point
forall a b. (a -> b) -> a -> b
$ Container -> State -> Point
posFromC Container
container
                let f Point
p = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Point
p Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point
pos) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
                      let t :: ContentId TileKind
t = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p
                      UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Point -> ContentId TileKind -> UpdAtomic
UpdSearchTile ActorId
target Point
p ContentId TileKind
t
                      -- This is safe searching; embedded items
                      -- are not triggered, but they are revealed.
                      Point -> m ()
revealEmbed Point
p
                      case Point -> EnumMap Point PlaceEntry -> Maybe PlaceEntry
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup Point
p (EnumMap Point PlaceEntry -> Maybe PlaceEntry)
-> EnumMap Point PlaceEntry -> Maybe PlaceEntry
forall a b. (a -> b) -> a -> b
$ Level -> EnumMap Point PlaceEntry
lentry Level
lvl of
                        Maybe PlaceEntry
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        Just PlaceEntry
entry ->
                          UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId -> [(Point, PlaceEntry)] -> UpdAtomic
UpdSpotEntry (Actor -> LevelId
blid Actor
b) [(Point
p, PlaceEntry
entry)]
                mapM_ f l
                return $! not $ null l
          in (Point -> Bool
predicateH, [Point] -> m Bool
actionH)
        DetectKind
IK.DetectEmbed -> ((Point -> EnumMap Point ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` Level -> EnumMap Point ItemBag
lembed Level
lvl), m Bool -> [Point] -> m Bool
forall a b. a -> b -> a
const (m Bool -> [Point] -> m Bool) -> m Bool -> [Point] -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
        DetectKind
IK.DetectStash -> (Point -> Bool
stashPredicate, m Bool -> [Point] -> m Bool
forall a b. a -> b -> a
const (m Bool -> [Point] -> m Bool) -> m Bool -> [Point] -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
  effectDetectX d predicate action execSfx radius target

-- This is not efficient at all, so optimize iff detection is added
-- to periodic organs or common periodic items or often activated embeds.
effectDetectX :: MonadServerAtomic m
              => IK.DetectKind -> (Point -> Bool) -> ([Point] -> m Bool)
              -> m () -> Int -> ActorId -> m UseResult
effectDetectX :: forall (m :: * -> *).
MonadServerAtomic m =>
DetectKind
-> (Point -> Bool)
-> ([Point] -> m Bool)
-> m ()
-> Int
-> ActorId
-> m UseResult
effectDetectX DetectKind
d Point -> Bool
predicate [Point] -> m Bool
action m ()
execSfx Int
radius ActorId
target = do
  COps{corule=RuleContent{rWidthMax, rHeightMax}} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  b <- getsState $ getActorBody target
  sperFidOld <- getsServer sperFid
  let perOld = PerFid
sperFidOld PerFid -> FactionId -> EnumMap LevelId Perception
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b EnumMap LevelId Perception -> LevelId -> Perception
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> LevelId
blid Actor
b
      Point x0 y0 = bpos b
      perList = (Point -> Bool) -> [Point] -> [Point]
forall a. (a -> Bool) -> [a] -> [a]
filter Point -> Bool
predicate
        [ Int -> Int -> Point
Point Int
x Int
y
        | Int
y <- [Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
y0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
radius) .. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
rHeightMax Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
y0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
radius)]
        , Int
x <- [Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
x0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
radius) .. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int
rWidthMax Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
x0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
radius)]
        ]
      extraPer = Perception
emptyPer {psight = PerVisible $ ES.fromDistinctAscList perList}
      inPer = Perception -> Perception -> Perception
diffPer Perception
extraPer Perception
perOld
  unless (nullPer inPer) $ do
    -- Perception is modified on the server and sent to the client
    -- together with all the revealed info.
    let perNew = Perception -> Perception -> Perception
addPer Perception
inPer Perception
perOld
        fper = (EnumMap LevelId Perception -> EnumMap LevelId Perception)
-> FactionId -> PerFid -> PerFid
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust (LevelId
-> Perception
-> EnumMap LevelId Perception
-> EnumMap LevelId Perception
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert (Actor -> LevelId
blid Actor
b) Perception
perNew) (Actor -> FactionId
bfid Actor
b)
    modifyServer $ \StateServer
ser -> StateServer
ser {sperFid = fper $ sperFid ser}
    execSendPer (bfid b) (blid b) emptyPer inPer perNew
  pointsModified <- action perList
  if not (nullPer inPer) || pointsModified then do
    execSfx
    -- Perception is reverted. This is necessary to ensure save and restore
    -- doesn't change game state.
    unless (nullPer inPer) $ do
      modifyServer $ \StateServer
ser -> StateServer
ser {sperFid = sperFidOld}
      execSendPer (bfid b) (blid b) inPer emptyPer perOld
  else
    execSfxAtomic $ SfxMsgFid (bfid b) $ SfxVoidDetection d
  return UseUp  -- even if nothing spotted, in itself it's still useful data

-- ** SendFlying

-- | Send the target actor flying like a projectile. If the actors are adjacent,
-- the vector is directed outwards, if no, inwards, if it's the same actor,
-- boldpos is used, if it can't, a random outward vector of length 10
-- is picked.
effectSendFlying :: MonadServerAtomic m
                 => m () -> IK.ThrowMod -> ActorId -> ActorId -> Container
                 -> Maybe Bool
                 -> m UseResult
effectSendFlying :: forall (m :: * -> *).
MonadServerAtomic m =>
m ()
-> ThrowMod
-> ActorId
-> ActorId
-> Container
-> Maybe Bool
-> m UseResult
effectSendFlying m ()
execSfx IK.ThrowMod{Int
throwVelocity :: Int
throwLinger :: Int
throwHP :: Int
throwHP :: ThrowMod -> Int
throwLinger :: ThrowMod -> Int
throwVelocity :: ThrowMod -> Int
..} ActorId
source ActorId
target Container
container Maybe Bool
modePush = do
  v <- ActorId -> ActorId -> Container -> Maybe Bool -> m Vector
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> ActorId -> Container -> Maybe Bool -> m Vector
sendFlyingVector ActorId
source ActorId
target Container
container Maybe Bool
modePush
  sb <- getsState $ getActorBody source
  tb <- getsState $ getActorBody target
  let eps = Int
0
      fpos = Actor -> Point
bpos Actor
tb Point -> Vector -> Point
`shift` Vector
v
      isEmbed = case Container
container of
        CEmbed{} -> Bool
True
        Container
_ -> Bool
False
  if bhp tb <= 0  -- avoid dragging around corpses
     || bproj tb && isEmbed then  -- flying projectiles can't slip on the floor
    return UseDud  -- the impact never manifested
  else if actorWaits tb
          && source /= target
          && isNothing (btrajectory tb) then do
    execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxBracedImmune target
    when (source /= target) $
      execSfxAtomic $ SfxMsgFid (bfid tb) $ SfxBracedImmune target
    return UseUp  -- waste it to prevent repeated throwing at immobile actors
  else do
   case bresenhamsLineAlgorithm eps (bpos tb) fpos of
    Maybe [Point]
Nothing -> [Char] -> m UseResult
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> m UseResult) -> [Char] -> m UseResult
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> (Point, Actor) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (Point
fpos, Actor
tb)
    Just [] -> [Char] -> m UseResult
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> m UseResult) -> [Char] -> m UseResult
forall a b. (a -> b) -> a -> b
$ [Char]
"projecting from the edge of level"
                       [Char] -> (Point, Actor) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (Point
fpos, Actor
tb)
    Just (Point
pos : [Point]
rest) -> do
      weightAssocs <- (State -> [(ItemId, ItemFull)]) -> m [(ItemId, ItemFull)]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemFull)]) -> m [(ItemId, ItemFull)])
-> (State -> [(ItemId, ItemFull)]) -> m [(ItemId, ItemFull)]
forall a b. (a -> b) -> a -> b
$ ActorId -> [CStore] -> State -> [(ItemId, ItemFull)]
fullAssocs ActorId
target [CStore
CEqp, CStore
COrgan]
      let weight = [Int] -> Int
forall a. Num a => [a] -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemFull) -> Int) -> [(ItemId, ItemFull)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (ItemKind -> Int
IK.iweight (ItemKind -> Int)
-> ((ItemId, ItemFull) -> ItemKind) -> (ItemId, ItemFull) -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemFull -> ItemKind
itemKind (ItemFull -> ItemKind)
-> ((ItemId, ItemFull) -> ItemFull)
-> (ItemId, ItemFull)
-> ItemKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, ItemFull) -> ItemFull
forall a b. (a, b) -> b
snd) [(ItemId, ItemFull)]
weightAssocs
          path = Actor -> Point
bpos Actor
tb Point -> [Point] -> [Point]
forall a. a -> [a] -> [a]
: Point
pos Point -> [Point] -> [Point]
forall a. a -> [a] -> [a]
: [Point]
rest
          (trajectory, (speed, _)) =
            -- Note that the @ThrowMod@ aspect of the actor's trunk is ignored.
            computeTrajectory weight throwVelocity throwLinger path
          ts = ([Vector], Speed) -> Maybe ([Vector], Speed)
forall a. a -> Maybe a
Just ([Vector]
trajectory, Speed
speed)
      -- Old and new trajectories are not added; the old one is replaced.
      if btrajectory tb == ts
      then return UseId  -- e.g., actor is too heavy; but a jerk is noticeable
      else do
        execSfx
        execUpdAtomic $ UpdTrajectory target (btrajectory tb) ts
        -- If propeller is a projectile, it pushes involuntarily,
        -- so its originator is to blame.
        -- However, we can't easily see whether a pushed non-projectile actor
        -- pushed another due to colliding or voluntarily, so we assign
        -- blame to him.
        originator <- if bproj sb
                      then getsServer $ EM.findWithDefault source source
                                        . strajPushedBy
                      else return source
        modifyServer $ \StateServer
ser ->
          StateServer
ser {strajPushedBy = EM.insert target originator $ strajPushedBy ser}
        -- In case of pre-existing pushing, don't touch the time
        -- so that the pending @advanceTimeTraj@ can do its job
        -- (it will, because non-empty trajectory is here set, unless, e.g.,
        -- subsequent effects from the same item change the trajectory).
        when (isNothing $ btrajectory tb) $ do
          -- Set flying time to almost now, so that the push happens ASAP,
          -- because it's the first one, so almost no delay is needed.
          localTime <- getsState $ getLocalTime (blid tb)
          -- But add a slight overhead to avoid displace-slide loops
          -- of 3 actors in a line. However, add even more overhead
          -- to normal actor move, so that it doesn't manage to land
          -- a hit before it flies away safely.
          let overheadTime = Time -> Delta Time -> Time
timeShift Time
localTime (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeClip)
              doubleClip = Delta Time -> Int -> Delta Time
timeDeltaScale (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeClip) Int
2
          modifyServer $ \StateServer
ser ->
            StateServer
ser { strajTime =
                    updateActorTime (bfid tb) (blid tb) target overheadTime
                    $ strajTime ser
                , sactorTime =
                    ageActor (bfid tb) (blid tb) target doubleClip
                    $ sactorTime ser }
        return UseUp

sendFlyingVector :: MonadServerAtomic m
                 => ActorId -> ActorId -> Container -> Maybe Bool -> m Vector
sendFlyingVector :: forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> ActorId -> Container -> Maybe Bool -> m Vector
sendFlyingVector ActorId
source ActorId
target Container
container Maybe Bool
modePush = do
  sb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
source
  if source == target then do
    pos <- getsState $ posFromC container
    lid <- getsState $ lidFromC container
    let (start, end) =
          -- Without the level the pushing stair trap moved actor back upstairs.
          if bpos sb /= pos && blid sb == lid
          then (bpos sb, pos)
          else (fromMaybe (bpos sb) (boldpos sb), bpos sb)
    if start == end then rndToAction $ do
      z <- randomR (-10, 10)
      oneOf [Vector 10 z, Vector (-10) z, Vector z 10, Vector z (-10)]
    else do
      let pushV = Point -> Point -> Vector
vectorToFrom Point
end Point
start
          pullV = Point -> Point -> Vector
vectorToFrom Point
start Point
end
      return $! case modePush of
                  Just Bool
True -> Vector
pushV
                  Just Bool
False -> Vector
pullV
                  Maybe Bool
Nothing -> Vector
pushV
  else do
    tb <- getsState $ getActorBody target
    let pushV = Point -> Point -> Vector
vectorToFrom (Actor -> Point
bpos Actor
tb) (Actor -> Point
bpos Actor
sb)
        pullV = Point -> Point -> Vector
vectorToFrom (Actor -> Point
bpos Actor
sb) (Actor -> Point
bpos Actor
tb)
    return $! case modePush of
                Just Bool
True -> Vector
pushV
                Just Bool
False -> Vector
pullV
                Maybe Bool
Nothing | Point -> Point -> Bool
adjacent (Actor -> Point
bpos Actor
sb) (Actor -> Point
bpos Actor
tb) -> Vector
pushV
                Maybe Bool
Nothing -> Vector
pullV

-- ** ApplyPerfume

effectApplyPerfume :: MonadServerAtomic m => m () -> ActorId -> m UseResult
effectApplyPerfume :: forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ActorId -> m UseResult
effectApplyPerfume m ()
execSfx ActorId
target = do
  tb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
  Level{lsmell} <- getLevel $ blid tb
  unless (EM.null lsmell) $ do
    execSfx
    let f Point
p Time
fromSm = UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> Time -> Time -> UpdAtomic
UpdAlterSmell (Actor -> LevelId
blid Actor
tb) Point
p Time
fromSm Time
timeZero
    mapWithKeyM_ f lsmell
  return UseUp  -- even if no smell before, the perfume is noticeable

-- ** AtMostOneOf

effectAtMostOneOf :: MonadServerAtomic m
                  => (IK.Effect -> m UseResult) -> [IK.Effect] -> m UseResult
effectAtMostOneOf :: forall (m :: * -> *).
MonadServerAtomic m =>
(Effect -> m UseResult) -> [Effect] -> m UseResult
effectAtMostOneOf Effect -> m UseResult
recursiveCall [Effect]
l = do
  chosen <- Rnd Effect -> m Effect
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction (Rnd Effect -> m Effect) -> Rnd Effect -> m Effect
forall a b. (a -> b) -> a -> b
$ [Effect] -> Rnd Effect
forall a. [a] -> Rnd a
oneOf [Effect]
l
  recursiveCall chosen
  -- no @execSfx@, because the individual effect sents it

-- ** OneOf

effectOneOf :: MonadServerAtomic m
            => (IK.Effect -> m UseResult) -> [IK.Effect] -> m UseResult
effectOneOf :: forall (m :: * -> *).
MonadServerAtomic m =>
(Effect -> m UseResult) -> [Effect] -> m UseResult
effectOneOf Effect -> m UseResult
recursiveCall [Effect]
l = do
  shuffled <- Rnd [Effect] -> m [Effect]
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction (Rnd [Effect] -> m [Effect]) -> Rnd [Effect] -> m [Effect]
forall a b. (a -> b) -> a -> b
$ [Effect] -> Rnd [Effect]
forall a. Eq a => [a] -> Rnd [a]
shuffle [Effect]
l
  let f Effect
eff m UseResult
result = do
        ur <- Effect -> m UseResult
recursiveCall Effect
eff
        -- We stop at @UseId@ activation and in this ways avoid potentially
        -- many calls to fizzling effects that only spam a failure message
        -- and ID the item.
        if ur == UseDud then result else return ur
  foldr f (return UseDud) shuffled
  -- no @execSfx@, because the individual effect sents it

-- ** AndEffect

effectAndEffect :: forall m. MonadServerAtomic m
                => (IK.Effect -> m UseResult) -> ActorId
                -> IK.Effect -> IK.Effect
                -> m UseResult
effectAndEffect :: forall (m :: * -> *).
MonadServerAtomic m =>
(Effect -> m UseResult)
-> ActorId -> Effect -> Effect -> m UseResult
effectAndEffect Effect -> m UseResult
recursiveCall ActorId
source eff1 :: Effect
eff1@IK.ConsumeItems{} Effect
eff2 = do
  -- So far, this is the only idiom used for crafting. If others appear,
  -- either formalize it by a specialized crafting effect constructor
  -- or add here and to effect printing code.
  sb <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
source
  curChalSer <- getsServer $ scurChalSer . soptions
  fact <- getsState $ (EM.! bfid sb) . sfactionD
  if cgoods curChalSer && fhasUI (gkind fact) then do
    execSfxAtomic $ SfxMsgFid (bfid sb) SfxReadyGoods
    return UseId
  else effectAndEffectSem recursiveCall eff1 eff2

effectAndEffect Effect -> m UseResult
recursiveCall ActorId
_ Effect
eff1 Effect
eff2 =
  (Effect -> m UseResult) -> Effect -> Effect -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
(Effect -> m UseResult) -> Effect -> Effect -> m UseResult
effectAndEffectSem Effect -> m UseResult
recursiveCall Effect
eff1 Effect
eff2

effectAndEffectSem :: forall m. MonadServerAtomic m
                   => (IK.Effect -> m UseResult) -> IK.Effect -> IK.Effect
                   -> m UseResult
effectAndEffectSem :: forall (m :: * -> *).
MonadServerAtomic m =>
(Effect -> m UseResult) -> Effect -> Effect -> m UseResult
effectAndEffectSem Effect -> m UseResult
recursiveCall Effect
eff1 Effect
eff2 = do
  ur1 <- Effect -> m UseResult
recursiveCall Effect
eff1
  if ur1 == UseUp
  then recursiveCall eff2
  else return ur1
  -- No @execSfx@, because individual effects sent them.

-- ** OrEffect

effectOrEffect :: forall m. MonadServerAtomic m
               => (IK.Effect -> m UseResult)
               -> FactionId -> IK.Effect -> IK.Effect
               -> m UseResult
effectOrEffect :: forall (m :: * -> *).
MonadServerAtomic m =>
(Effect -> m UseResult)
-> FactionId -> Effect -> Effect -> m UseResult
effectOrEffect Effect -> m UseResult
recursiveCall FactionId
fid Effect
eff1 Effect
eff2 = do
  curChalSer <- (StateServer -> Challenge) -> m Challenge
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> Challenge) -> m Challenge)
-> (StateServer -> Challenge) -> m Challenge
forall a b. (a -> b) -> a -> b
$ ServerOptions -> Challenge
scurChalSer (ServerOptions -> Challenge)
-> (StateServer -> ServerOptions) -> StateServer -> Challenge
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ServerOptions
soptions
  fact <- getsState $ (EM.! fid) . sfactionD
  case eff1 of
    IK.AndEffect IK.ConsumeItems{} Effect
_ | Challenge -> Bool
cgoods Challenge
curChalSer
                                       Bool -> Bool -> Bool
&& FactionKind -> Bool
fhasUI (Faction -> FactionKind
gkind Faction
fact) -> do
      -- Stop forbidden crafting ASAP to avoid spam.
      SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> SfxMsg -> SfxAtomic
SfxMsgFid FactionId
fid SfxMsg
SfxReadyGoods
      UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
    Effect
_ -> do
      ur1 <- Effect -> m UseResult
recursiveCall Effect
eff1
      if ur1 == UseUp
      then return UseUp
      else recursiveCall eff2
             -- no @execSfx@, because individual effects sent them

-- ** SeqEffect

effectSeqEffect :: forall m. MonadServerAtomic m
                => (IK.Effect -> m UseResult) -> [IK.Effect]
                -> m UseResult
effectSeqEffect :: forall (m :: * -> *).
MonadServerAtomic m =>
(Effect -> m UseResult) -> [Effect] -> m UseResult
effectSeqEffect Effect -> m UseResult
recursiveCall [Effect]
effs = do
  (Effect -> m ()) -> [Effect] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (m UseResult -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m UseResult -> m ()) -> (Effect -> m UseResult) -> Effect -> m ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Effect -> m UseResult
recursiveCall) [Effect]
effs
  UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp
  -- no @execSfx@, because individual effects sent them

-- ** When

effectWhen :: forall m. MonadServerAtomic m
           => (IK.Effect -> m UseResult) -> ActorId
           -> IK.Condition -> IK.Effect -> ActivationFlag
           -> m UseResult
effectWhen :: forall (m :: * -> *).
MonadServerAtomic m =>
(Effect -> m UseResult)
-> ActorId -> Condition -> Effect -> ActivationFlag -> m UseResult
effectWhen Effect -> m UseResult
recursiveCall ActorId
source Condition
cond Effect
eff ActivationFlag
effActivation = do
  go <- ActorId -> Condition -> ActivationFlag -> m Bool
forall (m :: * -> *).
MonadServer m =>
ActorId -> Condition -> ActivationFlag -> m Bool
conditionSem ActorId
source Condition
cond ActivationFlag
effActivation
  if go then recursiveCall eff else return UseDud

-- ** Unless

effectUnless :: forall m. MonadServerAtomic m
             => (IK.Effect -> m UseResult) -> ActorId
             -> IK.Condition -> IK.Effect -> ActivationFlag
             -> m UseResult
effectUnless :: forall (m :: * -> *).
MonadServerAtomic m =>
(Effect -> m UseResult)
-> ActorId -> Condition -> Effect -> ActivationFlag -> m UseResult
effectUnless Effect -> m UseResult
recursiveCall ActorId
source Condition
cond Effect
eff ActivationFlag
effActivation = do
  go <- ActorId -> Condition -> ActivationFlag -> m Bool
forall (m :: * -> *).
MonadServer m =>
ActorId -> Condition -> ActivationFlag -> m Bool
conditionSem ActorId
source Condition
cond ActivationFlag
effActivation
  if not go then recursiveCall eff else return UseDud

-- ** IfThenElse

effectIfThenElse :: forall m. MonadServerAtomic m
                 => (IK.Effect -> m UseResult) -> ActorId
                 -> IK.Condition -> IK.Effect -> IK.Effect -> ActivationFlag
                 -> m UseResult
effectIfThenElse :: forall (m :: * -> *).
MonadServerAtomic m =>
(Effect -> m UseResult)
-> ActorId
-> Condition
-> Effect
-> Effect
-> ActivationFlag
-> m UseResult
effectIfThenElse Effect -> m UseResult
recursiveCall ActorId
source Condition
cond Effect
eff1 Effect
eff2 ActivationFlag
effActivation = do
  c <- ActorId -> Condition -> ActivationFlag -> m Bool
forall (m :: * -> *).
MonadServer m =>
ActorId -> Condition -> ActivationFlag -> m Bool
conditionSem ActorId
source Condition
cond ActivationFlag
effActivation
  if c then recursiveCall eff1 else recursiveCall eff2

-- ** VerbNoLonger

effectVerbNoLonger :: MonadServerAtomic m
                   => Bool -> m () -> ActorId -> m UseResult
effectVerbNoLonger :: forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> m () -> ActorId -> m UseResult
effectVerbNoLonger Bool
effUseAllCopies m ()
execSfx ActorId
source = do
  b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
source
  when (effUseAllCopies  -- @UseUp@ ensures that if all used, all destroyed
        && not (bproj b))  -- no spam when projectiles activate
    execSfx  -- announce that all copies have run out (or whatever message)
  return UseUp  -- help to destroy the copy, even if not all used up

-- ** VerbMsg

effectVerbMsg :: MonadServerAtomic m => m () -> ActorId -> m UseResult
effectVerbMsg :: forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ActorId -> m UseResult
effectVerbMsg m ()
execSfx ActorId
source = do
  b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
source
  unless (bproj b) execSfx  -- don't spam when projectiles activate
  return UseUp  -- announcing always successful and this helps
                -- to destroy the item

-- ** VerbMsgFail

effectVerbMsgFail :: MonadServerAtomic m => m () -> ActorId -> m UseResult
effectVerbMsgFail :: forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ActorId -> m UseResult
effectVerbMsgFail m ()
execSfx ActorId
source = do
  b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
source
  unless (bproj b) execSfx  -- don't spam when projectiles activate
  return UseId  -- not @UseDud@ so that @OneOf@ doesn't ignore it