    {-# 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