{-# 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
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 ItemKind -> Dice
IK.idamage ItemKind
itemKind Dice -> Dice -> Bool
forall a. Eq a => a -> a -> Bool
== Dice
0 then Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False else do  -- speedup
    Actor
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
    Int
hurtMult <- (State -> Int) -> m Int
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Int) -> m Int) -> (State -> Int) -> m Int
forall a b. (a -> b) -> a -> b
$ ActorId -> ActorId -> State -> Int
armorHurtBonus ActorId
source ActorId
target
    AbsDepth
totalDepth <- (State -> AbsDepth) -> m AbsDepth
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> AbsDepth
stotalDepth
    Level{AbsDepth
ldepth :: AbsDepth
ldepth :: Level -> AbsDepth
ldepth} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (Actor -> LevelId
blid Actor
sb)
    Int
dmg <- 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
ldepth AbsDepth
totalDepth (Dice -> Rnd Int) -> Dice -> Rnd Int
forall a b. (a -> b) -> a -> b
$ ItemKind -> Dice
IK.idamage ItemKind
itemKind
    let rawDeltaHP :: Int64
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 :: Int64
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 Int64
speedDeltaHP Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
0 then do  -- damage the target, never heal
      ActorId -> ActorId -> Int64 -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> ActorId -> Int64 -> m ()
refillHP ActorId
source ActorId
target Int64
speedDeltaHP
      Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    else Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
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
  Actor
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
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
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 :: Bool
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 :: Int
hpMax = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxHP Skills
actorMaxSk
      deltaHP0 :: Int64
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 :: Int64
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
  UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Int64 -> UpdAtomic
UpdRefillHP ActorId
target Int64
deltaHP
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
serious (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
cutCalm ActorId
target
  Actor
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
  Faction
fact <- (State -> Faction) -> m Faction
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
tb) (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
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Actor -> Bool
bproj Actor
tb) Bool -> Bool -> Bool
&& FactionKind -> Bool
fhasPointman (Faction -> FactionKind
gkind Faction
fact)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    -- 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.
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> Int64
bhp Actor
tb 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
> Int64
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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.
      FactionId -> LevelId -> ActorId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> LevelId -> ActorId -> m ()
electLeader (Actor -> FactionId
bfid Actor
tb) (Actor -> LevelId
blid Actor
tb) ActorId
target
      Maybe ActorId
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.! Actor -> FactionId
bfid Actor
tb) (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
      -- 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.
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ActorId -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ActorId
mleader) (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
$ FactionId -> Maybe ActorId -> Maybe ActorId -> UpdAtomic
UpdLeadFaction (Actor -> FactionId
bfid Actor
tb) Maybe ActorId
forall a. Maybe a
Nothing (Maybe ActorId -> UpdAtomic) -> Maybe ActorId -> UpdAtomic
forall a b. (a -> b) -> a -> b
$ ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
target

cutCalm :: MonadServerAtomic m => ActorId -> m ()
cutCalm :: forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
cutCalm ActorId
target = do
  Actor
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
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
target
  let upperBound :: Int64
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
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@.
  ActorId -> Int64 -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Int64 -> m ()
updateCalm ActorId
target Int64
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
  ItemBag
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 ItemId
iid ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
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
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
      Actor
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
      Time
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
tbOld)
      let recharged :: Bool
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 Bool -> Bool
not Bool
recharged then UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud else do
        Bool
effKineticPerformed2 <- ActorId -> ActorId -> ItemId -> m Bool
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> ActorId -> ItemId -> m Bool
applyKineticDamage ActorId
source ActorId
target ItemId
iid
        Actor
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
        -- 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.
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
effKineticPerformed2  -- speedup
              Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
tb 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
> Int64
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
          Actor
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
          AspectRecord
arWeapon <- (State -> AspectRecord) -> m AspectRecord
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> AspectRecord) -> m AspectRecord)
-> (State -> AspectRecord) -> m AspectRecord
forall a b. (a -> b) -> a -> b
$ (EnumMap ItemId AspectRecord -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid) (EnumMap ItemId AspectRecord -> AspectRecord)
-> (State -> EnumMap ItemId AspectRecord) -> State -> AspectRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap ItemId AspectRecord
sdiscoAspect
          let killHow :: KillHow
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
          ActorId -> KillHow -> FactionId -> ItemId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> KillHow -> FactionId -> ItemId -> m ()
addKillToAnalytics ActorId
killer KillHow
killHow (Actor -> FactionId
bfid Actor
tbOld) (Actor -> ItemId
btrunk Actor
tbOld)
        let effApplyFlags :: EffApplyFlags
effApplyFlags = EffApplyFlags
effApplyFlags0
              { effUseAllCopies     = fst kit <= 1
              , effKineticPerformed = effKineticPerformed2
              }
        EffApplyFlags
-> ActorId
-> ActorId
-> ActorId
-> ItemId
-> Container
-> ItemFull
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
EffApplyFlags
-> ActorId
-> ActorId
-> ActorId
-> ItemId
-> Container
-> ItemFull
-> m UseResult
effectAndDestroyAndAddKill EffApplyFlags
effApplyFlags
                                   ActorId
killer ActorId
source ActorId
target ItemId
iid Container
c ItemFull
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
  Actor
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
  UseResult
triggered <- EffApplyFlags
-> ActorId
-> ActorId
-> ItemId
-> Container
-> ItemFull
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
EffApplyFlags
-> ActorId
-> ActorId
-> ItemId
-> Container
-> ItemFull
-> m UseResult
effectAndDestroy EffApplyFlags
effApplyFlags0 ActorId
source ActorId
target ItemId
iid Container
c ItemFull
itemFull
  Actor
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
  -- 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.
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> Int64
bhp Actor
tb 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
> Int64
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Actor
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
    AspectRecord
arWeapon <- (State -> AspectRecord) -> m AspectRecord
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> AspectRecord) -> m AspectRecord)
-> (State -> AspectRecord) -> m AspectRecord
forall a b. (a -> b) -> a -> b
$ (EnumMap ItemId AspectRecord -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid) (EnumMap ItemId AspectRecord -> AspectRecord)
-> (State -> EnumMap ItemId AspectRecord) -> State -> AspectRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap ItemId AspectRecord
sdiscoAspect
    let killHow :: KillHow
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
    ActorId -> KillHow -> FactionId -> ItemId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> KillHow -> FactionId -> ItemId -> m ()
addKillToAnalytics ActorId
killer KillHow
killHow (Actor -> FactionId
bfid Actor
tbOld) (Actor -> ItemId
btrunk Actor
tbOld)
  UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
  ItemBag
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 (Int
itemK, ItemTimers
itemTimers) = ItemBag
bag ItemBag -> ItemId -> ItemQuant
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
      effs :: [Effect]
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 :: AspectRecord
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 :: Int
timeout = AspectRecord -> Int
IA.aTimeout AspectRecord
arItem
  LevelId
lid <- (State -> LevelId) -> m LevelId
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> LevelId) -> m LevelId)
-> (State -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ Container -> State -> LevelId
lidFromC Container
container
  Time
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 LevelId
lid
  let it1 :: ItemTimers
it1 = (ItemTimer -> Bool) -> ItemTimers -> ItemTimers
forall a. (a -> Bool) -> [a] -> [a]
filter (Time -> ItemTimer -> Bool
charging Time
localTime) ItemTimers
itemTimers
      len :: Int
len = ItemTimers -> Int
forall a. [a] -> Int
length ItemTimers
it1
      recharged :: Bool
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 Bool -> Bool
not Bool
recharged then UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud else do
    let timeoutTurns :: Delta Time
timeoutTurns = Delta Time -> Int -> Delta Time
timeDeltaScale (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeTurn) Int
timeout
        newItemTimer :: ItemTimer
newItemTimer = Time -> Delta Time -> ItemTimer
createItemTimer Time
localTime Delta Time
timeoutTurns
        it2 :: ItemTimers
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 :: ItemQuant
kit2 = (Int
1, Int -> ItemTimers -> ItemTimers
forall a. Int -> [a] -> [a]
take Int
1 ItemTimers
it2)
        !_A :: ()
_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.
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ItemTimers
itemTimers ItemTimers -> ItemTimers -> Bool
forall a. Eq a => a -> a -> Bool
== ItemTimers
it2) (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
$ ItemId -> Container -> ItemTimers -> ItemTimers -> UpdAtomic
UpdTimeItem ItemId
iid Container
container ItemTimers
itemTimers 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
imperishable = Bool -> Bool
not Bool
effMayDestroy
                       Bool -> Bool -> Bool
|| ActivationFlag -> ItemFull -> Bool
imperishableKit ActivationFlag
effActivation ItemFull
itemFull
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
imperishable (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 -> ItemQuant -> Container -> UpdAtomic
UpdLoseItem Bool
False ItemId
iid ItemQuant
kit2 Container
container
    -- At this point, the item is potentially no longer in container
    -- @container@, therefore beware of assuming so in the code below.
    UseResult
triggeredEffect <- EffApplyFlags
-> ActorId
-> ActorId
-> ItemId
-> ContentId ItemKind
-> ItemKind
-> Container
-> [Effect]
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
EffApplyFlags
-> ActorId
-> ActorId
-> ItemId
-> ContentId ItemKind
-> ItemKind
-> Container
-> [Effect]
-> m UseResult
itemEffectDisco EffApplyFlags
effApplyFlags0 ActorId
source ActorId
target ItemId
iid
                                       ContentId ItemKind
itemKindId ItemKind
itemKind Container
container [Effect]
effs
    Actor
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
    let triggered :: UseResult
triggered = if Bool
effKineticPerformed then UseResult
UseUp else UseResult
triggeredEffect
        mEmbedPos :: Maybe Point
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 | UseResult
triggered UseResult -> UseResult -> Bool
forall a. Eq a => a -> a -> Bool
== UseResult
UseUp
         Bool -> Bool -> Bool
&& Maybe Point
mEmbedPos Maybe Point -> Maybe Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point -> Maybe Point
forall a. a -> Maybe a
Just (Actor -> Point
bpos Actor
sb)  -- treading water, etc.
         Bool -> Bool -> Bool
&& ActivationFlag
effActivation ActivationFlag -> [ActivationFlag] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ActivationFlag
ActivationTrigger, ActivationFlag
ActivationMeleeable]
              -- do not repeat almost the same msg
         Bool -> Bool -> Bool
&& (ActivationFlag
effActivation ActivationFlag -> ActivationFlag -> Bool
forall a. Eq a => a -> a -> Bool
/= ActivationFlag
ActivationOnSmash  -- only tells condition ends
             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.Condition AspectRecord
arItem)) -> do
           -- Effects triggered; main feedback comes from them,
           -- but send info so that clients can log it.
           let verbose :: Bool
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
           SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ItemId -> Container -> SfxAtomic
SfxItemApplied Bool
verbose ItemId
iid Container
container
       | UseResult
triggered UseResult -> UseResult -> Bool
forall a. Eq a => a -> a -> Bool
/= UseResult
UseUp
         Bool -> Bool -> Bool
&& ActivationFlag
effActivation ActivationFlag -> ActivationFlag -> Bool
forall a. Eq a => a -> a -> Bool
/= ActivationFlag
ActivationOnSmash
         Bool -> Bool -> Bool
&& ActivationFlag
effActivation ActivationFlag -> ActivationFlag -> Bool
forall a. Eq a => a -> a -> Bool
/= ActivationFlag
ActivationPeriodic
              -- periodic effects repeat and so spam
         Bool -> Bool -> Bool
&& ActivationFlag
effActivation
            ActivationFlag -> [ActivationFlag] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ActivationFlag
ActivationUnderRanged, ActivationFlag
ActivationUnderMelee]
              -- and so do effects under attack
         Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
sb)  -- projectiles can be very numerous
         Bool -> Bool -> Bool
&& Maybe Point -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Point
mEmbedPos  ->  -- embeds may be just flavour
           -- Announce no effect, which is rare and wastes time, so noteworthy.
           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
$
             if (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Effect -> Bool
IK.forApplyEffect [Effect]
effs
             then ItemId -> Container -> SfxMsg
SfxFizzles ItemId
iid Container
container
                    -- something didn't work despite promising effects
             else ItemId -> Container -> SfxMsg
SfxNothingHappens ItemId
iid Container
container  -- fully expected
       | Bool
otherwise -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
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).
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
imperishable Bool -> Bool -> Bool
|| UseResult
triggered UseResult -> UseResult -> Bool
forall a. Eq a => a -> a -> Bool
== UseResult
UseUp) (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 -> ItemQuant -> Container -> UpdAtomic
UpdSpotItem Bool
False ItemId
iid ItemQuant
kit2 Container
container
    UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
  ItemBag
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 ItemId
iid ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.notMember` ItemBag
embeds2
  then UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud
  else do
    -- First embedded item may move actor to another level, so @lid@
    -- may be unequal to @blid sb@.
    let c :: Container
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
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
          }
    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

-- | 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
  [UseResult]
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 :: UseResult
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.
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UseResult
ur UseResult -> UseResult -> Bool
forall a. Ord a => a -> a -> Bool
>= UseResult
UseId Bool -> Bool -> Bool
|| Bool
effKineticPerformed) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    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
  UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
  Actor
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 :: m ()
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 :: m ()
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
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
  Actor
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
  Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$! case Condition
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
  Actor
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
  AbsDepth
totalDepth <- (State -> AbsDepth) -> m AbsDepth
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> AbsDepth
stotalDepth
  Level{AbsDepth
ldepth :: Level -> AbsDepth
ldepth :: AbsDepth
ldepth} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (Actor -> LevelId
blid Actor
tb)
  Int
n0 <- 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
ldepth AbsDepth
totalDepth Dice
nDm
  let n :: Int
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 :: Int64
deltaHP = - Int -> Int64
xM Int
n
  Actor
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
  -- Display the effect more accurately.
  let reportedEffect :: Effect
reportedEffect = Dice -> Effect
IK.Burn (Dice -> Effect) -> Dice -> Effect
forall a b. (a -> b) -> a -> b
$ Int -> Dice
Dice.intToDice Int
n
  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
reportedEffect Int64
deltaHP
  ActorId -> ActorId -> Int64 -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> ActorId -> Int64 -> m ()
refillHP ActorId
source ActorId
target Int64
deltaHP
  UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
  Actor
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
oxy@(Point Int
x Int
y) <- (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
containerOrigin
  let itemFreq :: [(GroupName ItemKind, Int)]
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 :: Container
container = ActorId -> CStore -> Container
CActor ActorId
target CStore
COrgan
  -- Power depth of new items unaffected by number of spawned actors.
  Level{AbsDepth
ldepth :: Level -> AbsDepth
ldepth :: AbsDepth
ldepth} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (LevelId -> m Level) -> LevelId -> m Level
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
tb
  Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq <- Int
-> AbsDepth
-> [(GroupName ItemKind, Int)]
-> m (Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind))
forall (m :: * -> *).
MonadServerAtomic m =>
Int
-> AbsDepth
-> [(GroupName ItemKind, Int)]
-> m (Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind))
prepareItemKind Int
0 AbsDepth
ldepth [(GroupName ItemKind, Int)]
itemFreq
  Maybe (ItemId, ItemFullKit)
m2 <- Bool
-> AbsDepth
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> Container
-> Maybe Int
-> m (Maybe (ItemId, ItemFullKit))
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> AbsDepth
-> Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
-> Container
-> Maybe Int
-> m (Maybe (ItemId, ItemFullKit))
rollAndRegisterItem Bool
False AbsDepth
ldepth Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
freq Container
container Maybe Int
forall a. Maybe a
Nothing
  Int
acounter <- (StateServer -> Int) -> m Int
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> Int) -> m Int) -> (StateServer -> Int) -> m Int
forall a b. (a -> b) -> a -> b
$ ActorId -> Int
forall a. Enum a => a -> Int
fromEnum (ActorId -> Int) -> (StateServer -> ActorId) -> StateServer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ActorId
sacounter
  let (ItemId
iid, (ItemFull{ItemKind
itemKind :: ItemFull -> ItemKind
itemKind :: ItemKind
itemKind}, (Int
itemK, ItemTimers
_))) =
        (ItemId, ItemFullKit)
-> Maybe (ItemId, ItemFullKit) -> (ItemId, ItemFullKit)
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> (ItemId, ItemFullKit)
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> (ItemId, ItemFullKit))
-> [Char] -> (ItemId, ItemFullKit)
forall a b. (a -> b) -> a -> b
$ [Char]
"" [Char] -> GroupName ItemKind -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` GroupName ItemKind
cgroup) Maybe (ItemId, ItemFullKit)
m2
      semiRandom :: Int
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 -> Int -> m ()
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
          Maybe ReqFailure
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 Maybe ReqFailure
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 -> m ()
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:
        ItemBag
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 ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ItemId
iid ItemBag
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.
  Int -> m ()
tryFlying Int
10
  ItemBag
bag3 <- (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
  let mn3 :: Maybe ItemQuant
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.
  m () -> (ItemQuant -> m ()) -> Maybe ItemQuant -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
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) Maybe ItemQuant
mn3
  UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
  Actor
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
  Actor
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
  Challenge
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
  Faction
fact <- (State -> Faction) -> m Faction
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
tb) (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
  let power :: Int
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 :: Int64
deltaHP = Int -> Int64
xM Int
power
  if Challenge -> Bool
cfish Challenge
curChalSer Bool -> Bool -> Bool
&& Int64
deltaHP Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0
     Bool -> Bool -> Bool
&& FactionKind -> Bool
fhasUI (Faction -> FactionKind
gkind Faction
fact) Bool -> Bool -> Bool
&& Actor -> FactionId
bfid Actor
sb FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> FactionId
bfid Actor
tb
  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
SfxColdFish
     UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
  else do
    let reportedEffect :: Effect
reportedEffect = Int -> Effect
IK.RefillHP Int
power
    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
reportedEffect Int64
deltaHP
    ActorId -> ActorId -> Int64 -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> ActorId -> Int64 -> m ()
refillHP ActorId
source ActorId
target Int64
deltaHP
    UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
  Actor
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
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
target
  let power :: Int
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 :: Int64
rawDeltaCalm = Int -> Int64
xM Int
power
      calmMax :: Int
calmMax = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxCalm Skills
actorMaxSk
      serious :: Bool
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 :: Int64
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 :: Int64
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
  m ()
execSfx
  ActorId -> Int64 -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Int64 -> m ()
updateCalm ActorId
target Int64
deltaCalm
  UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
  Actor
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
  Actor
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 | Actor -> Bool
bproj Actor
tb -> UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud
     | Actor -> FactionId
bfid Actor
tb FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> FactionId
bfid Actor
sb -> UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud  -- accidental hit; ignore
     | Bool
otherwise -> do
       Faction
fact <- (State -> Faction) -> m Faction
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
tb) (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
       Maybe (FactionId, Int)
hiImpression <- Actor -> m (Maybe (FactionId, Int))
forall (m :: * -> *).
MonadServerAtomic m =>
Actor -> m (Maybe (FactionId, Int))
highestImpression Actor
tb
       let permitted :: Bool
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 Bool
permitted then do
         Bool
b <- ActorId -> ActorId -> ItemId -> FactionId -> m Bool
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> ActorId -> ItemId -> FactionId -> m Bool
dominateFidSfx ActorId
source ActorId
target ItemId
iid (Actor -> FactionId
bfid Actor
sb)
         UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (UseResult -> m UseResult) -> UseResult -> m UseResult
forall a b. (a -> b) -> a -> b
$! if Bool
b then UseResult
UseUp else UseResult
UseDud
       else 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 -> SfxAtomic) -> SfxMsg -> SfxAtomic
forall a b. (a -> b) -> a -> b
$ ActorId -> SfxMsg
SfxUnimpressed ActorId
target
         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 -> SfxAtomic) -> SfxMsg -> SfxAtomic
forall a b. (a -> b) -> a -> b
$ ActorId -> SfxMsg
SfxUnimpressed ActorId
target
         UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud

highestImpression :: MonadServerAtomic m
                  => Actor -> m (Maybe (FactionId, Int))
highestImpression :: forall (m :: * -> *).
MonadServerAtomic m =>
Actor -> m (Maybe (FactionId, Int))
highestImpression Actor
tb = do
  ItemId -> ItemKind
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
  ItemId -> Item
getItem <- (State -> ItemId -> Item) -> m (ItemId -> Item)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> Item) -> m (ItemId -> Item))
-> (State -> ItemId -> Item) -> m (ItemId -> Item)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> Item) -> State -> ItemId -> Item
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> Item
getItemBody
  let isImpression :: ItemId -> Bool
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 :: ItemBag
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, b)) -> a
f (a
_, (a
k, b
_)) = a
k
      maxImpression :: (ItemId, ItemQuant)
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 ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null ItemBag
impressions
  then 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
  else case Item -> Maybe FactionId
jfid (Item -> Maybe FactionId) -> Item -> Maybe FactionId
forall a b. (a -> b) -> a -> b
$ ItemId -> Item
getItem (ItemId -> Item) -> ItemId -> Item
forall a b. (a -> b) -> a -> b
$ (ItemId, ItemQuant) -> ItemId
forall a b. (a, b) -> a
fst (ItemId, ItemQuant)
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
  Actor
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 :: ()
_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.
  Bool
canTra <- (State -> Bool) -> m Bool
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Bool
canTraverse ActorId
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 Maybe ([Vector], Speed) -> Bool
forall a. Maybe a -> Bool
isNothing (Actor -> Maybe ([Vector], Speed)
btrajectory Actor
tb) Bool -> Bool -> Bool
&& Bool
canTra Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
tb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0 then do
    let execSfx :: m ()
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
    m ()
execSfx  -- if actor ours, possibly the last occasion to see him
    FactionId -> ActorId -> ActorId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> ActorId -> ActorId -> m ()
dominateFid FactionId
fid ActorId
source ActorId
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.
    m ()
execSfx  -- see the actor as theirs, unless position not visible
    Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  else
    Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
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
  Actor
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.
  ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
deduceKilled ActorId
target
  FactionId -> LevelId -> ActorId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> LevelId -> ActorId -> m ()
electLeader (Actor -> FactionId
bfid Actor
tb0) (Actor -> LevelId
blid Actor
tb0) ActorId
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.
  ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Actor -> m ()
dropAllEquippedItems ActorId
target Actor
tb0
  Actor
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
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
target
  ItemId -> ItemKind
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
  let isImpression :: ItemId -> Bool
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 :: ItemBag -> ItemBag
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
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.
  Time
btime <- (StateServer -> Time) -> m Time
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer
           ((StateServer -> Time) -> m Time)
-> (StateServer -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ Maybe Time -> Time
forall a. (?callStack::CallStack) => Maybe a -> a
fromJust (Maybe Time -> Time)
-> (StateServer -> Maybe Time) -> StateServer -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FactionId -> LevelId -> ActorId -> ActorTime -> Maybe Time
lookupActorTime (Actor -> FactionId
bfid Actor
tb) (Actor -> LevelId
blid Actor
tb) ActorId
target (ActorTime -> Maybe Time)
-> (StateServer -> ActorTime) -> StateServer -> Maybe Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ActorTime
sactorTime
  UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Actor -> UpdAtomic
UpdLoseActor ActorId
target Actor
tb
  let maxCalm :: Int
maxCalm = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxCalm Skills
actorMaxSk
      maxHp :: Int
maxHp = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMaxHP Skills
actorMaxSk
      bNew :: Actor
bNew = Actor
tb { bfid = fid
                , bcalm = max (xM 10) $ xM maxCalm `div` 2
                , bhp = min (xM maxHp) $ bhp tb + xM 10
                , borgan = borganNoImpression}
  (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 fid (blid tb) target btime
                      $ sactorTime ser}
  UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Actor -> UpdAtomic
UpdSpotActor ActorId
target Actor
bNew
  -- Focus on the dominated actor, by making him a leader.
  FactionId -> ActorId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> ActorId -> m ()
setFreshLeader FactionId
fid ActorId
target
  EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
  let inGame :: Faction -> Bool
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
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.
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
gameOver (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    -- Add some nostalgia for the old faction.
    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
$ 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) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
10) ActorId
source ActorId
target Maybe ItemId
forall a. Maybe a
Nothing
                            CStore
COrgan GroupName ItemKind
IK.S_IMPRESSED TimerDice
IK.timerNone
    -- Identify organs that won't get identified by use.
    ItemId -> ContentId ItemKind
getKindId <- (State -> ItemId -> ContentId ItemKind)
-> m (ItemId -> ContentId ItemKind)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ContentId ItemKind)
 -> m (ItemId -> ContentId ItemKind))
-> (State -> ItemId -> ContentId ItemKind)
-> m (ItemId -> ContentId ItemKind)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ContentId ItemKind)
-> State -> ItemId -> ContentId ItemKind
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ContentId ItemKind
getIidKindIdServer
    let discoverIf :: (ItemId, CStore) -> m ()
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 :: [(ItemId, CStore)]
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)
    ((ItemId, CStore) -> m ()) -> [(ItemId, CStore)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (ItemId, CStore) -> m ()
discoverIf [(ItemId, CStore)]
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
  Actor
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
  Actor
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 | Actor -> Bool
bproj Actor
tb -> UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud
     | Actor -> FactionId
bfid Actor
tb FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> FactionId
bfid Actor
sb ->
       -- Unimpress wrt others, but only once. The recursive Sfx suffices.
       Effect -> m UseResult
recursiveCall (Effect -> m UseResult) -> Effect -> m UseResult
forall a b. (a -> b) -> a -> b
$ Int -> Int -> CStore -> GroupName ItemKind -> Effect
IK.DropItem Int
1 Int
1 CStore
COrgan GroupName ItemKind
IK.S_IMPRESSED
     | Bool
otherwise -> do
       -- Actors that don't move freely and so are stupid, can't be impressed.
       Bool
canTra <- (State -> Bool) -> m Bool
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Bool
canTraverse ActorId
target
       if Bool
canTra then do
         Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> Int64
bhp Actor
tb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0)
           m ()
execSfx  -- avoid spam just before death
         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) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) ActorId
source ActorId
target Maybe ItemId
forall a. Maybe a
Nothing CStore
COrgan
                          GroupName ItemKind
IK.S_IMPRESSED TimerDice
IK.timerNone
       else UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
  Actor
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 | Actor -> Bool
bproj Actor
tb -> UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud
     | Actor -> Watchfulness
bwatch Actor
tb Watchfulness -> [Watchfulness] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Watchfulness
WSleep, Watchfulness
WWake] ->
         UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud  -- can't increase sleep
     | Bool
otherwise -> do
       Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
target
       if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Skills -> Bool
canSleep Skills
actorMaxSk then
         UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId  -- no message about the cause, so at least ID
       else do
         let maxCalm :: Int64
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
deltaCalm = Int64
maxCalm Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Actor -> Int64
bcalm Actor
tb
         Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int64
deltaCalm Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
           ActorId -> Int64 -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Int64 -> m ()
updateCalm ActorId
target Int64
deltaCalm  -- max Calm, but asleep vulnerability
         m ()
execSfx
         case Actor -> Watchfulness
bwatch Actor
tb of
           WWait Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> do
             Int
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 :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
nAll Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) ()
             () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
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.
         ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
addSleep ActorId
target
         UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
  Actor
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 Actor -> Int64
bhp Actor
tb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0 then  -- avoid yelling corpses
    UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud  -- the yell never manifested
  else do
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> Bool
bproj Actor
tb)
      m ()
execSfx
    SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ActorId -> SfxAtomic
SfxTaunt Bool
False ActorId
target
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Actor -> Bool
bproj Actor
tb) Bool -> Bool -> Bool
&& ResDelta -> Bool
deltaBenign (Actor -> ResDelta
bcalmDelta Actor
tb)) (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
$ ActorId -> Int64 -> UpdAtomic
UpdRefillCalm ActorId
target Int64
minusM
    UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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.
  Actor
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
  Actor
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
  Skills
sMaxSk <- (State -> Skills) -> m Skills
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
source
  Skills
tMaxSk <- (State -> Skills) -> m Skills
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
target
  AbsDepth
totalDepth <- (State -> AbsDepth) -> m AbsDepth
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> AbsDepth
stotalDepth
  Level{AbsDepth
ldepth :: Level -> AbsDepth
ldepth :: AbsDepth
ldepth, BigActorMap
lbig :: BigActorMap
lbig :: Level -> BigActorMap
lbig} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (Actor -> LevelId
blid Actor
tb)
  Int
nFriends <- (State -> Int) -> m Int
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Int) -> m Int) -> (State -> Int) -> m Int
forall a b. (a -> b) -> a -> b
$ [(ActorId, Actor)] -> Int
forall a. [a] -> Int
length ([(ActorId, Actor)] -> Int)
-> (State -> [(ActorId, Actor)]) -> State -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FactionId -> LevelId -> State -> [(ActorId, Actor)]
friendRegularAssocs (Actor -> FactionId
bfid Actor
sb) (Actor -> LevelId
blid Actor
sb)
  EnumMap ItemId AspectRecord
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
  Int
power0 <- 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
ldepth AbsDepth
totalDepth Dice
nDm
  Faction
fact <- (State -> Faction) -> m Faction
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
sb) (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
  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
      power :: Int
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 :: Effect
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 :: Bool
durable = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Durable AspectRecord
arItem
      warnBothActors :: SfxMsg -> m ()
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 :: Int64
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 | Actor -> Bool
bproj Actor
tb
       Bool -> Bool -> Bool
|| ActorId
source ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
target Bool -> Bool -> Bool
&& Bool -> Bool
not (FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
sb) Faction
fact (Actor -> FactionId
bfid Actor
tb)) ->
       UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud  -- hitting friends or projectiles to summon is too cheap
     | (ActivationFlag
effActivation ActivationFlag -> ActivationFlag -> Bool
forall a. Eq a => a -> a -> Bool
== ActivationFlag
ActivationPeriodic Bool -> Bool -> Bool
|| Bool
durable) Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
sb)
       Bool -> Bool -> Bool
&& (Actor -> Int64
bcalm Actor
sb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< - Int64
deltaCalm Bool -> Bool -> Bool
|| Bool -> Bool
not (Actor -> Skills -> Bool
calmEnough Actor
sb Skills
sMaxSk)) -> do
       SfxMsg -> m ()
warnBothActors (SfxMsg -> m ()) -> SfxMsg -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> SfxMsg
SfxSummonLackCalm ActorId
source
       UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
     | Int
nFriends Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
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.
       SfxMsg -> m ()
warnBothActors (SfxMsg -> m ()) -> SfxMsg -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> SfxMsg
SfxSummonTooManyOwn ActorId
source
       UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
     | BigActorMap -> Int
forall k a. EnumMap k a -> Int
EM.size BigActorMap
lbig Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
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).
       SfxMsg -> m ()
warnBothActors (SfxMsg -> m ()) -> SfxMsg -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> SfxMsg
SfxSummonTooManyAll ActorId
source
       UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
     | Bool
otherwise -> do
       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
$ ActorId -> Int64 -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Int64 -> m ()
updateCalm ActorId
source Int64
deltaCalm
       Time
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)
       -- Make sure summoned actors start acting after the victim.
       let actorTurn :: Delta Time
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
targetTime = Time -> Delta Time -> Time
timeShift Time
localTime Delta Time
actorTurn
           afterTime :: Time
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.
       Bool
anySummoned <- Bool
-> Int
-> [(GroupName ItemKind, Int)]
-> LevelId
-> Time
-> Maybe Point
-> Int
-> m Bool
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> Int
-> [(GroupName ItemKind, Int)]
-> LevelId
-> Time
-> Maybe Point
-> Int
-> m Bool
addManyActors Bool
True Int
0 [(GroupName ItemKind
grp, Int
1)] (Actor -> LevelId
blid Actor
tb) Time
afterTime
                                    (Point -> Maybe Point
forall a. a -> Maybe a
Just (Point -> Maybe Point) -> Point -> Maybe Point
forall a b. (a -> b) -> a -> b
$ Actor -> Point
bpos Actor
tb) Int
power
       if Bool
anySummoned then do
         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
         UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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.
         SfxMsg -> m ()
warnBothActors (SfxMsg -> m ()) -> SfxMsg -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> SfxMsg
SfxSummonFailure ActorId
source
         UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
  Actor
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
  Point
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 lid1 :: LevelId
lid1 = Actor -> LevelId
blid Actor
b1
  [(LevelId, Point)]
destinations <- (State -> [(LevelId, Point)]) -> m [(LevelId, Point)]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(LevelId, Point)]) -> m [(LevelId, Point)])
-> (State -> [(LevelId, Point)]) -> m [(LevelId, Point)]
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> Bool -> Dungeon -> [(LevelId, Point)]
whereTo LevelId
lid1 Point
pos Bool
up (Dungeon -> [(LevelId, Point)])
-> (State -> Dungeon) -> State -> [(LevelId, Point)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Dungeon
sdungeon
  Actor
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
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
target
  if | ActorId
source ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
target Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMove Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> 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
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
b1) SfxMsg
SfxTransImpossible
       UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
     | Actor -> Bool
actorWaits Actor
b1 Bool -> Bool -> Bool
&& ActorId
source ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
target -> 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 -> SfxAtomic) -> SfxMsg -> SfxAtomic
forall a b. (a -> b) -> a -> b
$ ActorId -> SfxMsg
SfxBracedImmune ActorId
target
       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
b1) (SfxMsg -> SfxAtomic) -> SfxMsg -> SfxAtomic
forall a b. (a -> b) -> a -> b
$ ActorId -> SfxMsg
SfxBracedImmune ActorId
target
       UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
     | [(LevelId, Point)] -> Bool
forall a. [a] -> Bool
null [(LevelId, Point)]
destinations -> 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
SfxLevelNoMore
       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
b1) SfxMsg
SfxLevelNoMore
       -- We keep it useful even in shallow dungeons.
       Effect -> m UseResult
recursiveCall (Effect -> m UseResult) -> Effect -> m UseResult
forall a b. (a -> b) -> a -> b
$ Dice -> Effect
IK.Teleport Dice
30  -- powerful teleport
     | Bool
otherwise -> do
       (LevelId
lid2, Point
pos2) <- Rnd (LevelId, Point) -> m (LevelId, Point)
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction (Rnd (LevelId, Point) -> m (LevelId, Point))
-> Rnd (LevelId, Point) -> m (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ [(LevelId, Point)] -> Rnd (LevelId, Point)
forall a. [a] -> Rnd a
oneOf [(LevelId, Point)]
destinations
       m ()
execSfx
       Maybe Time
mbtime_bOld <-
         (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 Actor
b1) LevelId
lid1 ActorId
target (ActorTime -> Maybe Time)
-> (StateServer -> ActorTime) -> StateServer -> Maybe Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ActorTime
sactorTime
       Maybe Time
mbtimeTraj_bOld <-
         (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 Actor
b1) LevelId
lid1 ActorId
target (ActorTime -> Maybe Time)
-> (StateServer -> ActorTime) -> StateServer -> Maybe Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ActorTime
strajTime
       Point
pos3 <- FactionId -> Bool -> LevelId -> Point -> m Point
forall (m :: * -> *).
MonadStateRead m =>
FactionId -> Bool -> LevelId -> Point -> m Point
findStairExit (Actor -> FactionId
bfid Actor
sb) Bool
up LevelId
lid2 Point
pos2
       let switch1 :: m ()
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 :: m ()
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.
       [(ActorId, Actor)]
inhabitants <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ Point -> LevelId -> State -> [(ActorId, Actor)]
posToAidAssocs Point
pos3 LevelId
lid2
       case [(ActorId, Actor)]
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).
                 Maybe Time
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
                 Maybe Time
mbtimeTraj_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
strajTime
                 Maybe ActorId
inhMLead <- (ActorId, Actor) -> m (Maybe ActorId)
forall (m :: * -> *).
MonadServerAtomic m =>
(ActorId, Actor) -> m (Maybe ActorId)
switchLevels1 (ActorId, Actor)
inh
                 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
lid1 (Actor -> Point
bpos Actor
b1) (ActorId, Actor)
inh
                               Maybe Time
mbtime_inh Maybe Time
mbtimeTraj_inh Maybe ActorId
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
       UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Faction
fact <- (State -> Faction) -> m Faction
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (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
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
  let defLanding :: Vector
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 :: Vector
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)
      ([Vector]
mvs2, [Vector]
mvs1) = (Vector -> Bool) -> [Vector] -> ([Vector], [Vector])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Vector -> Vector -> Bool
forall a. Eq a => a -> a -> Bool
== Vector
defLanding) [Vector]
moves
      mvs :: [Vector]
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]
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 -> 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
  Int -> Point -> Bool
unocc <- (State -> Int -> Point -> Bool) -> m (Int -> Point -> Bool)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Int -> Point -> Bool
posOcc
  case (Int -> [Point]) -> [Int] -> [Point]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Int
k -> (Point -> Bool) -> [Point] -> [Point]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Point -> Bool
unocc Int
k) [Point]
ps) [Int
0..Int
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
  Maybe ActorId
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.
  Maybe ActorId
mlead <-
    if Bool -> Bool
not (Actor -> Bool
bproj Actor
bOld) Bool -> Bool -> Bool
&& Maybe ActorId -> Bool
forall a. Maybe a -> Bool
isJust Maybe ActorId
mleader then do
      UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> Maybe ActorId -> Maybe ActorId -> UpdAtomic
UpdLeadFaction FactionId
side Maybe ActorId
mleader Maybe ActorId
forall a. Maybe a
Nothing
      Maybe ActorId -> m (Maybe ActorId)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ActorId
mleader
        -- outside of a client we don't know the real tgt of aid, hence fst
    else Maybe ActorId -> m (Maybe ActorId)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ActorId
forall a. Maybe a
Nothing
  -- Remove the actor from the old level.
  -- Onlookers see somebody disappear suddenly.
  -- @UpdDestroyActor@ is too loud, so use @UpdLoseActor@ instead.
  UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Actor -> UpdAtomic
UpdLoseActor ActorId
aid Actor
bOld
  Maybe ActorId -> m (Maybe ActorId)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ActorId
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.
  Time
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
  Time
timeLastActive <- (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
lidNew
  let delta :: Delta Time
delta = Time
timeLastActive Time -> Time -> Delta Time
`timeDeltaToFrom` Time
timeOld
      computeNewTimeout :: ItemQuant -> ItemQuant
      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 :: 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
bNew = Actor
bOld { blid = lidNew
                  , bpos = posNew
                  , boldpos = Just posNew  -- new level, new direction
                  , borgan = rebaseTimeout $ borgan bOld
                  , beqp = rebaseTimeout $ beqp bOld }
      shiftByDelta :: Time -> Time
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.
  m () -> (Time -> m ()) -> Maybe Time -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
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})
        Maybe Time
mbtime_bOld
  m () -> (Time -> m ()) -> Maybe Time -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
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})
        Maybe Time
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.
  UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Actor -> UpdAtomic
UpdSpotActor ActorId
aid Actor
bNew
  Maybe ActorId -> (ActorId -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t a -> (a -> m ()) -> m ()
forM_ Maybe ActorId
mlead ((ActorId -> m ()) -> m ()) -> (ActorId -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$
    -- The leader is fresh in the sense that he's on a new level
    -- and so doesn't have up to date Perception.
    FactionId -> ActorId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> ActorId -> m ()
setFreshLeader FactionId
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.
  Actor
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
  Actor
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 fid :: FactionId
fid = Actor -> FactionId
bfid Actor
tb
  Faction
fact <- (State -> Faction) -> m Faction
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (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
  if | Actor -> Bool
bproj Actor
tb ->
       UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud  -- basically a misfire
     | Bool -> Bool
not (FactionKind -> Bool
fcanEscape (FactionKind -> Bool) -> FactionKind -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> FactionKind
gkind Faction
fact) -> 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
SfxEscapeImpossible
       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
SfxEscapeImpossible
       UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
     | Bool
otherwise -> do
       m ()
execSfx
       FactionId -> Status -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> Status -> m ()
deduceQuits (Actor -> FactionId
bfid Actor
tb) (Status -> m ()) -> Status -> m ()
forall a b. (a -> b) -> a -> b
$ Outcome -> Int -> Maybe (GroupName ModeKind) -> Status
Status Outcome
Escape (LevelId -> Int
forall a. Enum a => a -> Int
fromEnum (LevelId -> Int) -> LevelId -> Int
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
tb) Maybe (GroupName ModeKind)
forall a. Maybe a
Nothing
       UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
  Actor
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 Actor -> Bool
bproj Actor
tb then UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud  -- shortcut for speed
  else m () -> Dice -> ActorId -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> Dice -> ActorId -> ActorId -> m UseResult
paralyze m ()
execSfx Dice
nDm ActorId
source ActorId
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
  Actor
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
  AbsDepth
totalDepth <- (State -> AbsDepth) -> m AbsDepth
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> AbsDepth
stotalDepth
  Level{AbsDepth
ldepth :: Level -> AbsDepth
ldepth :: AbsDepth
ldepth} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (Actor -> LevelId
blid Actor
tb)
  Int
power0 <- 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
ldepth AbsDepth
totalDepth Dice
nDm
  let power :: Int
power = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
power0 Int
1  -- KISS, avoid special case
  EnumSet ActorId
actorStasis <- (StateServer -> EnumSet ActorId) -> m (EnumSet ActorId)
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> EnumSet ActorId
sactorStasis
  if ActorId -> EnumSet ActorId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member ActorId
target EnumSet ActorId
actorStasis then do
    Actor
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
    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
SfxStasisProtects
    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
SfxStasisProtects
    UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
  else do
    m ()
execSfx
    let t :: Delta Time
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.
    (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 = 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
    UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
  Actor
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 Actor -> Bool
bproj Actor
tb then UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud else do  -- shortcut for speed
    Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
target
    let swimmingOrFlying :: Int
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 -> Int
Dice.supDice Dice
nDm Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
swimmingOrFlying
    then m () -> Dice -> ActorId -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> Dice -> ActorId -> ActorId -> m UseResult
paralyze m ()
execSfx Dice
nDm ActorId
source ActorId
target  -- no help at all
    else  -- fully resisted
      -- Don't spam:
      -- sb <- getsState $ getActorBody source
      -- execSfxAtomic $ SfxMsgFid (bfid sb) SfxWaterParalysisResisted
      UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
  Actor
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
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
target
  AbsDepth
totalDepth <- (State -> AbsDepth) -> m AbsDepth
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> AbsDepth
stotalDepth
  Level{AbsDepth
ldepth :: Level -> AbsDepth
ldepth :: AbsDepth
ldepth} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (Actor -> LevelId
blid Actor
tb)
  EnumSet ActorId
actorStasis <- (StateServer -> EnumSet ActorId) -> m (EnumSet ActorId)
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> EnumSet ActorId
sactorStasis
  Int
power0 <- 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
ldepth AbsDepth
totalDepth Dice
nDm
  let power :: Int
power = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
power0 Int
1  -- KISS, avoid special case
      actorTurn :: Delta Time
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
t = Delta Time -> Int -> Delta Time
timeDeltaScale (Delta Time -> Int -> Delta Time
timeDeltaPercent Delta Time
actorTurn Int
10) (-Int
power)
  if | Actor -> Bool
bproj Actor
tb -> UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud  -- shortcut for speed
     | ActorId -> EnumSet ActorId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
ES.member ActorId
target EnumSet ActorId
actorStasis -> do
       Actor
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
       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
SfxStasisProtects
       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
SfxStasisProtects
       UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
     | Bool
otherwise -> do
       m ()
execSfx
       -- Only the normal time, not the trajectory time, is affected.
       (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 = 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
       UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
  Actor
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
  Actor
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
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
target
  if | ActorId
source ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
target Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMove Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 -> 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
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
     | ActorId
source ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
target Bool -> Bool -> Bool
&& Actor -> Bool
actorWaits Actor
tb -> do
         -- immune only against not own effects, to enable teleport
         -- as beneficial's necklace drawback; also consistent
         -- with sleep not protecting
       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 -> SfxMsg
SfxBracedImmune ActorId
target
       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 -> SfxAtomic) -> SfxMsg -> SfxAtomic
forall a b. (a -> b) -> a -> b
$ ActorId -> SfxMsg
SfxBracedImmune ActorId
target
       UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
     | Bool
otherwise -> do
       COps{TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
       AbsDepth
totalDepth <- (State -> AbsDepth) -> m AbsDepth
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> AbsDepth
stotalDepth
       lvl :: Level
lvl@Level{AbsDepth
ldepth :: Level -> AbsDepth
ldepth :: AbsDepth
ldepth} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (Actor -> LevelId
blid Actor
tb)
       Int
range <- 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
ldepth AbsDepth
totalDepth Dice
nDm
       let spos :: Point
spos = Actor -> Point
bpos Actor
tb
           dMinMax :: Int -> Point -> Bool
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 -> Point -> ContentId TileKind -> Bool
dist !Int
delta !Point
pos ContentId TileKind
_ = Int -> Point -> Bool
dMinMax Int
delta Point
pos
       Maybe Point
mtpos <- Rnd (Maybe Point) -> m (Maybe Point)
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction (Rnd (Maybe Point) -> m (Maybe Point))
-> Rnd (Maybe Point) -> m (Maybe Point)
forall a b. (a -> b) -> a -> b
$ Int
-> Level
-> (Point -> ContentId TileKind -> Bool)
-> [Point -> ContentId TileKind -> Bool]
-> Rnd (Maybe Point)
findPosTry Int
200 Level
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))
         [ Int -> Point -> ContentId TileKind -> Bool
dist Int
1
         , Int -> Point -> ContentId TileKind -> Bool
dist (Int -> Point -> ContentId TileKind -> Bool)
-> Int -> Point -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
range Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
9
         , Int -> Point -> ContentId TileKind -> Bool
dist (Int -> Point -> ContentId TileKind -> Bool)
-> Int -> Point -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
range Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
7
         , Int -> Point -> ContentId TileKind -> Bool
dist (Int -> Point -> ContentId TileKind -> Bool)
-> Int -> Point -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
range Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
5
         , Int -> Point -> ContentId TileKind -> Bool
dist Int
5
         , Int -> Point -> ContentId TileKind -> Bool
dist Int
7
         , Int -> Point -> ContentId TileKind -> Bool
dist Int
9
         ]
       case Maybe Point
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
 Actor
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 Actor -> Bool
bproj Actor
tb Bool -> Bool -> Bool
&& CStore
store CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
COrgan  -- other stores OK not to lose possible loot
 then UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud  -- don't make a projectile hungry, etc.
 else do
  COps
cops <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Actor
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
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
target
  AbsDepth
totalDepth <- (State -> AbsDepth) -> m AbsDepth
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> AbsDepth
stotalDepth
  Level
lvlTb <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (Actor -> LevelId
blid Actor
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 :: AbsDepth
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 -> Dice -> m (Delta Time)
fscale Delta Time
unit Dice
nDm = do
        Int
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
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
        Delta Time -> m (Delta Time)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delta Time -> m (Delta Time)) -> Delta Time -> m (Delta Time)
forall a b. (a -> b) -> a -> b
$! Delta Time -> Int -> Delta Time
timeDeltaScale Delta Time
unit Int
k
      fgame :: Dice -> m (Delta Time)
fgame = Delta Time -> Dice -> m (Delta Time)
fscale (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeTurn)
      factor :: Dice -> m (Delta Time)
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 Time
delta <- m (Delta Time)
-> (Dice -> m (Delta Time))
-> (Dice -> m (Delta Time))
-> TimerDice
-> m (Delta Time)
forall a. a -> (Dice -> a) -> (Dice -> a) -> TimerDice -> a
IK.foldTimer (Delta Time -> m (Delta Time)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Delta Time -> m (Delta Time)) -> Delta Time -> m (Delta Time)
forall a b. (a -> b) -> a -> b
$ Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeZero) Dice -> m (Delta Time)
fgame Dice -> m (Delta Time)
factor TimerDice
tim
  let c :: Container
c = ActorId -> CStore -> Container
CActor ActorId
target CStore
store
  ItemBag
bagBefore <- (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 -> CStore -> State -> ItemBag
getBodyStoreBag Actor
tb CStore
store
  UniqueSet
uniqueSet <- (StateServer -> UniqueSet) -> m UniqueSet
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> UniqueSet
suniqueSet
  -- Power depth of new items unaffected by number of spawned actors, so 0.
  let freq :: Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
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
  NewItem
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
depth
  case NewItem
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
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 :: Maybe (ItemId, ItemQuant)
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 Maybe (ItemId, ItemQuant)
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
          Time
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 :: ItemTimer
newTimer = Time -> Delta Time -> ItemTimer
createItemTimer Time
localTime Delta Time
delta
              extraIt :: Int -> ItemTimers
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 :: ItemQuant
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 Maybe ItemId
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.
          ItemId
iid <- Bool -> ItemFullKit -> ItemKnown -> Container -> m ItemId
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> ItemFullKit -> ItemKnown -> Container -> m ItemId
registerItem Bool
True (ItemFull
itemFull, ItemQuant
kitNew) ItemKnown
itemKnown Container
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 Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust Maybe Int
mcount  -- not a random effect, so probably crafting
             Bool -> Bool -> Bool
&& Bool -> Bool
not (ItemKind -> Bool
IA.isHumanTrinket (ItemFull -> ItemKind
itemKind ItemFull
itemFull))
          then UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Container
-> ItemId -> ContentId ItemKind -> AspectRecord -> UpdAtomic
UpdDiscover Container
c ItemId
iid (ItemFull -> ContentId ItemKind
itemKindId ItemFull
itemFull) AspectRecord
arItem
          else Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CStore
store 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 (ItemFull -> ContentId ItemKind
itemKindId ItemFull
itemFull)
          UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
  Actor
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
  [(ItemId, ItemQuant)]
is <- CStore -> GroupName ItemKind -> ActorId -> m [(ItemId, ItemQuant)]
forall (m :: * -> *).
MonadServerAtomic m =>
CStore -> GroupName ItemKind -> ActorId -> m [(ItemId, ItemQuant)]
allGroupItems CStore
store GroupName ItemKind
grp ActorId
target
  if [(ItemId, ItemQuant)] -> Bool
forall a. [a] -> Bool
null [(ItemId, ItemQuant)]
is then UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud
  else do
    m ()
execSfx
    [UseResult]
urs <- ((ItemId, ItemQuant) -> m UseResult)
-> [(ItemId, ItemQuant)] -> 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 ((ItemId -> ItemQuant -> m UseResult)
-> (ItemId, ItemQuant) -> m UseResult
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (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
True Bool
True CStore
store ActorId
target Actor
tb Int
kcopy))
                (Int -> [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
forall a. Int -> [a] -> [a]
take Int
ngroup [(ItemId, ItemQuant)]
is)
    UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (UseResult -> m UseResult) -> UseResult -> m UseResult
forall a b. (a -> b) -> a -> b
$! 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

-- | 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
 ItemBag
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 ItemId
iid ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.notMember` ItemBag
bag0 then UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud else do
  ItemFull
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
  let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
      fragile :: Bool
fragile = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Fragile AspectRecord
arItem
      durable :: Bool
durable = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Durable AspectRecord
arItem
      isDestroyed :: Bool
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 Bool
isDestroyed then do
    let effApplyFlags :: EffApplyFlags
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
          }
    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
-> ItemFull
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
EffApplyFlags
-> ActorId
-> ActorId
-> ActorId
-> ItemId
-> Container
-> ItemFull
-> m UseResult
effectAndDestroyAndAddKill EffApplyFlags
effApplyFlags ActorId
aid ActorId
aid ActorId
aid ItemId
iid Container
c ItemFull
itemFull
    -- One copy was destroyed (or none if the item was discharged),
    -- so let's mop up.
    ItemBag
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
    m () -> (ItemQuant -> m ()) -> Maybe ItemQuant -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
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)
          (ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ItemId
iid ItemBag
bag)
    UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp
  else do
    Container
cDrop <- Bool -> ActorId -> Actor -> m Container
forall (m :: * -> *).
MonadStateRead m =>
Bool -> ActorId -> Actor -> m Container
pickDroppable Bool
False ActorId
aid Actor
b  -- drop over fog, etc.
    [UpdAtomic]
mvCmd <- Bool -> ItemId -> Int -> Container -> Container -> m [UpdAtomic]
forall (m :: * -> *).
MonadStateRead m =>
Bool -> ItemId -> Int -> Container -> Container -> m [UpdAtomic]
generalMoveItem Bool
verbose ItemId
iid (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
kMax Int
k) (ActorId -> CStore -> Container
CActor ActorId
aid CStore
store) Container
cDrop
    (UpdAtomic -> m ()) -> [UpdAtomic] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic [UpdAtomic]
mvCmd
    UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
cops@COps{TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (Actor -> LevelId
blid Actor
b)
  let validTile :: ContentId TileKind -> Bool
validTile ContentId TileKind
t = Bool -> Bool
not (Bool
respectNoItem Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isNoItem TileSpeedup
coTileSpeedup ContentId TileKind
t)
  if ContentId TileKind -> Bool
validTile (ContentId TileKind -> Bool) -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ Level
lvl Level -> Point -> ContentId TileKind
`at` Actor -> Point
bpos Actor
b
  then Container -> m Container
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Container -> m Container) -> Container -> m Container
forall a b. (a -> b) -> a -> b
$! ActorId -> CStore -> Container
CActor ActorId
aid CStore
CGround
  else do
    let ps :: [Point]
ps = COps -> Level -> (ContentId TileKind -> Bool) -> Point -> [Point]
nearbyFreePoints COps
cops Level
lvl ContentId TileKind -> Bool
validTile (Actor -> Point
bpos Actor
b)
    Container -> m Container
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Container -> m Container) -> Container -> m Container
forall a b. (a -> b) -> a -> b
$! case (Point -> Bool) -> [Point] -> [Point]
forall a. (a -> Bool) -> [a] -> [a]
filter (Point -> Point -> Bool
adjacent (Point -> Point -> Bool) -> Point -> Point -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Point
bpos Actor
b) ([Point] -> [Point]) -> [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
take Int
8 [Point]
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
  [(ItemId, ItemFullKit)]
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 :: [((CStore, Bool), (ItemId, ItemFullKit))]
kitAss = [(ItemId, ItemFullKit)]
-> [(ItemId, ItemFullKit)]
-> [((CStore, Bool), (ItemId, ItemFullKit))]
listToolsToConsume [(ItemId, ItemFullKit)]
kitAssG []  -- equipment too dangerous to use
      is :: [((CStore, Bool), (ItemId, ItemFullKit))]
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 :: [(Bool, Int, GroupName ItemKind)]
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
      (EnumMap CStore ItemBag
bagsToLose3, [(CStore, (ItemId, ItemFull))]
iidsToApply3, [(Bool, Int, GroupName ItemKind)]
grps3) =
        ((EnumMap CStore ItemBag, [(CStore, (ItemId, ItemFull))],
  [(Bool, Int, GroupName ItemKind)])
 -> ((CStore, Bool), (ItemId, ItemFullKit))
 -> (EnumMap CStore ItemBag, [(CStore, (ItemId, ItemFull))],
     [(Bool, Int, GroupName ItemKind)]))
-> (EnumMap CStore ItemBag, [(CStore, (ItemId, ItemFull))],
    [(Bool, Int, GroupName ItemKind)])
-> [((CStore, Bool), (ItemId, ItemFullKit))]
-> (EnumMap CStore ItemBag, [(CStore, (ItemId, ItemFull))],
    [(Bool, Int, GroupName ItemKind)])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (EnumMap CStore ItemBag, [(CStore, (ItemId, ItemFull))],
 [(Bool, Int, GroupName ItemKind)])
-> ((CStore, Bool), (ItemId, ItemFullKit))
-> (EnumMap CStore ItemBag, [(CStore, (ItemId, ItemFull))],
    [(Bool, Int, GroupName ItemKind)])
subtractIidfromGrps (EnumMap CStore ItemBag
forall k a. EnumMap k a
EM.empty, [], [(Bool, Int, GroupName ItemKind)]
grps0) [((CStore, Bool), (ItemId, ItemFullKit))]
is
  if [(Bool, Int, GroupName ItemKind)] -> Bool
forall a. [a] -> Bool
null [(Bool, Int, GroupName ItemKind)]
grps3 then do
    m ()
execSfx
    ActorId
-> EnumMap CStore ItemBag -> [(CStore, (ItemId, ItemFull))] -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId
-> EnumMap CStore ItemBag -> [(CStore, (ItemId, ItemFull))] -> m ()
consumeItems ActorId
target EnumMap CStore ItemBag
bagsToLose3 [(CStore, (ItemId, ItemFull))]
iidsToApply3
    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

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{ContentData ItemKind
coitem :: ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Actor
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
  AspectRecord
arTrunk <- (State -> AspectRecord) -> m AspectRecord
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> AspectRecord) -> m AspectRecord)
-> (State -> AspectRecord) -> m AspectRecord
forall a b. (a -> b) -> a -> b
$ (EnumMap ItemId AspectRecord -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> ItemId
btrunk Actor
tb) (EnumMap ItemId AspectRecord -> AspectRecord)
-> (State -> EnumMap ItemId AspectRecord) -> State -> AspectRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap ItemId AspectRecord
sdiscoAspect
  let isBlast :: Bool
isBlast = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arTrunk
      identifyStoreBag :: CStore -> ItemBag -> m ()
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 -> ItemId -> m ()
identifyStoreIid CStore
store ItemId
iid = do
        EnumMap ItemId AspectRecord
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
        ContentId ItemKind
itemKindId <- (State -> ContentId ItemKind) -> m (ContentId ItemKind)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ContentId ItemKind) -> m (ContentId ItemKind))
-> (State -> ContentId ItemKind) -> m (ContentId ItemKind)
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ContentId ItemKind
getIidKindIdServer ItemId
iid
        let arItem :: AspectRecord
arItem = EnumMap ItemId AspectRecord
discoAspect2 EnumMap ItemId AspectRecord -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
            c :: Container
c = ActorId -> CStore -> Container
CActor ActorId
target CStore
store
            itemKind :: ItemKind
itemKind = ContentData ItemKind -> ContentId ItemKind -> ItemKind
forall a. ContentData a -> ContentId a -> a
okind ContentData ItemKind
coitem ContentId ItemKind
itemKindId
        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
$  -- a hack
          UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Container
-> ItemId -> ContentId ItemKind -> AspectRecord -> UpdAtomic
UpdDiscover Container
c ItemId
iid ContentId ItemKind
itemKindId AspectRecord
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.
  [(CStore, ItemBag)] -> ((CStore, ItemBag) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t a -> (a -> m ()) -> m ()
forM_ (EnumMap CStore ItemBag -> [(CStore, ItemBag)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap CStore ItemBag
bagsToLose) (((CStore, ItemBag) -> m ()) -> m ())
-> ((CStore, ItemBag) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(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
      ItemDict
itemD <- (State -> ItemDict) -> m ItemDict
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ItemDict
sitemD
      (Key (EnumMap ItemId) -> ItemQuant -> m ()) -> ItemBag -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(FoldableWithKey t, Monad m) =>
(Key t -> a -> m b) -> t a -> m ()
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)
                   ItemBag
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, (ItemId, ItemFull)) -> m ()
applyItemIfPresent (CStore
store, (ItemId
iid, ItemFull
itemFull)) = do
        let c :: Container
c = ActorId -> CStore -> Container
CActor ActorId
target CStore
store
        ItemBag
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
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ItemId
iid ItemId -> ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
`EM.member` ItemBag
bag) (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
$ ActorId -> ItemId -> SfxAtomic
SfxApply ActorId
target ItemId
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
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
                }
          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
-> ItemFull
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
EffApplyFlags
-> ActorId
-> ActorId
-> ActorId
-> ItemId
-> Container
-> ItemFull
-> m UseResult
effectAndDestroyAndAddKill EffApplyFlags
effApplyFlags
                                            ActorId
target ActorId
target ActorId
target ItemId
iid Container
c ItemFull
itemFull
  ((CStore, (ItemId, ItemFull)) -> m ())
-> [(CStore, (ItemId, ItemFull))] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (CStore, (ItemId, ItemFull)) -> m ()
applyItemIfPresent [(CStore, (ItemId, ItemFull))]
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
  Actor
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
  Faction
fact <- (State -> Faction) -> m Faction
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
tb) (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
  [(ItemId, ItemQuant)]
isRaw <- CStore -> GroupName ItemKind -> ActorId -> m [(ItemId, ItemQuant)]
forall (m :: * -> *).
MonadServerAtomic m =>
CStore -> GroupName ItemKind -> ActorId -> m [(ItemId, ItemQuant)]
allGroupItems CStore
store GroupName ItemKind
grp ActorId
target
  Challenge
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
  EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
  let is :: [(ItemId, ItemQuant)]
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 | Actor -> Bool
bproj Actor
tb Bool -> Bool -> Bool
|| [(ItemId, ItemQuant)] -> Bool
forall a. [a] -> Bool
null [(ItemId, ItemQuant)]
is -> UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud
     | Int
ngroup Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
maxBound Bool -> Bool -> Bool
&& Int
kcopy Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
maxBound
       Bool -> Bool -> Bool
&& CStore
store CStore -> [CStore] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore
CStash, CStore
CEqp]
       Bool -> Bool -> Bool
&& FactionKind -> Bool
fhasGender (Faction -> FactionKind
gkind Faction
fact)  -- hero in Allure's decontamination chamber
       Bool -> Bool -> Bool
&& (Challenge -> Int
cdiff Challenge
curChalSer Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1   -- at lowest difficulty for its faction
           Bool -> Bool -> Bool
&& ((FactionId, Faction) -> Bool) -> [(FactionId, Faction)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FactionKind -> Bool
fhasUI (FactionKind -> Bool)
-> ((FactionId, Faction) -> FactionKind)
-> (FactionId, Faction)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Faction -> FactionKind
gkind (Faction -> FactionKind)
-> ((FactionId, Faction) -> Faction)
-> (FactionId, Faction)
-> FactionKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionId, Faction) -> Faction
forall a b. (a, b) -> b
snd)
                  (((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(FactionId
fi, Faction
fa) -> FactionId -> Faction -> FactionId -> Bool
isFriend FactionId
fi Faction
fa (Actor -> FactionId
bfid Actor
tb))
                          (EnumMap FactionId Faction -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap FactionId Faction
factionD))
           Bool -> Bool -> Bool
|| Challenge -> Int
cdiff Challenge
curChalSer Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
difficultyBound
              Bool -> Bool -> Bool
&& ((FactionId, Faction) -> Bool) -> [(FactionId, Faction)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (FactionKind -> Bool
fhasUI (FactionKind -> Bool)
-> ((FactionId, Faction) -> FactionKind)
-> (FactionId, Faction)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Faction -> FactionKind
gkind  (Faction -> FactionKind)
-> ((FactionId, Faction) -> Faction)
-> (FactionId, Faction)
-> FactionKind
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionId, Faction) -> Faction
forall a b. (a, b) -> b
snd)
                     (((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(FactionId
fi, Faction
fa) -> FactionId -> Faction -> FactionId -> Bool
isFoe FactionId
fi Faction
fa (Actor -> FactionId
bfid Actor
tb))
                             (EnumMap FactionId Faction -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap FactionId Faction
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
-}
       UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp
     | Bool
otherwise -> do
       Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (CStore
store CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
COrgan) m ()
execSfx
       [UseResult]
urs <- ((ItemId, ItemQuant) -> m UseResult)
-> [(ItemId, ItemQuant)] -> 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 ((ItemId -> ItemQuant -> m UseResult)
-> (ItemId, ItemQuant) -> m UseResult
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (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
True Bool
False CStore
store ActorId
target Actor
tb Int
kcopy))
                   (Int -> [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
forall a. Int -> [a] -> [a]
take Int
ngroup [(ItemId, ItemQuant)]
is)
       UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (UseResult -> m UseResult) -> UseResult -> m UseResult
forall a b. (a -> b) -> a -> b
$! 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

-- ** 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
 Actor
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 Actor -> Bool
bproj Actor
tb then UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud else do  -- slows down, but rarely any effect
  Time
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)
  AbsDepth
totalDepth <- (State -> AbsDepth) -> m AbsDepth
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> AbsDepth
stotalDepth
  Level{AbsDepth
ldepth :: Level -> AbsDepth
ldepth :: AbsDepth
ldepth} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (LevelId -> m Level) -> LevelId -> m Level
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
tb
  Int
power <- 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
ldepth AbsDepth
totalDepth Dice
dice
  let timeUnit :: Time
timeUnit = if Bool
reducingCooldown
                 then Time -> Time
absoluteTimeNegate Time
timeClip
                 else Time
timeClip
      delta :: Delta Time
delta = Delta Time -> Int -> Delta Time
timeDeltaScale (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeUnit) Int
power
      localTimer :: ItemTimer
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, 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 :: (ItemId, ItemFullKit)
-> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
-> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
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)])
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
ignoreCharges = Bool
True  -- handled above depending on @reducingCooldown@
      benefits :: Maybe a
benefits = Maybe a
forall a. Maybe a
Nothing  -- only raw damage counts (client knows benefits)
      sortWeapons :: [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
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
  [(ItemId, ItemFullKit)]
eqpAss <- (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
CEqp]
  let ([(ItemId, ItemFullKit)]
eqpAssWeapons, [(ItemId, ItemFullKit)]
eqpAssOthers) = [(ItemId, ItemFullKit)]
-> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
partitionWeapon [(ItemId, ItemFullKit)]
eqpAss
  [(ItemId, ItemFullKit)]
organAss <- (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
COrgan]
  let ([(ItemId, ItemFullKit)]
organAssWeapons, [(ItemId, ItemFullKit)]
organAssOthers) = [(ItemId, ItemFullKit)]
-> ([(ItemId, ItemFullKit)], [(ItemId, ItemFullKit)])
partitionWeapon [(ItemId, ItemFullKit)]
organAss
  (Int
nEqpWeapons, UseResult
urEqpWeapons) <-
    ((Int, UseResult) -> (ItemId, ItemFullKit) -> m (Int, UseResult))
-> (Int, UseResult)
-> [(ItemId, ItemFullKit)]
-> m (Int, UseResult)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (CStore
-> (Int, UseResult) -> (ItemId, ItemFullKit) -> m (Int, UseResult)
addToCooldown CStore
CEqp) (Int
n0, UseResult
UseDud)
    ([(ItemId, ItemFullKit)] -> m (Int, UseResult))
-> [(ItemId, ItemFullKit)] -> m (Int, UseResult)
forall a b. (a -> b) -> a -> b
$ [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
sortWeapons [(ItemId, ItemFullKit)]
eqpAssWeapons
  (Int
nOrganWeapons, UseResult
urOrganWeapons) <-
    ((Int, UseResult) -> (ItemId, ItemFullKit) -> m (Int, UseResult))
-> (Int, UseResult)
-> [(ItemId, ItemFullKit)]
-> m (Int, UseResult)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (CStore
-> (Int, UseResult) -> (ItemId, ItemFullKit) -> m (Int, UseResult)
addToCooldown CStore
COrgan) (Int
nEqpWeapons, UseResult
urEqpWeapons)
    ([(ItemId, ItemFullKit)] -> m (Int, UseResult))
-> [(ItemId, ItemFullKit)] -> m (Int, UseResult)
forall a b. (a -> b) -> a -> b
$ [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
sortWeapons [(ItemId, ItemFullKit)]
organAssWeapons
  (Int
nEqpOthers, UseResult
urEqpOthers) <-
    ((Int, UseResult) -> (ItemId, ItemFullKit) -> m (Int, UseResult))
-> (Int, UseResult)
-> [(ItemId, ItemFullKit)]
-> m (Int, UseResult)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (CStore
-> (Int, UseResult) -> (ItemId, ItemFullKit) -> m (Int, UseResult)
addToCooldown CStore
CEqp) (Int
nOrganWeapons, UseResult
urOrganWeapons) [(ItemId, ItemFullKit)]
eqpAssOthers
  (Int
_nOrganOthers, UseResult
urOrganOthers) <-
    ((Int, UseResult) -> (ItemId, ItemFullKit) -> m (Int, UseResult))
-> (Int, UseResult)
-> [(ItemId, ItemFullKit)]
-> m (Int, UseResult)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (CStore
-> (Int, UseResult) -> (ItemId, ItemFullKit) -> m (Int, UseResult)
addToCooldown CStore
COrgan) (Int
nEqpOthers, UseResult
urEqpOthers) [(ItemId, ItemFullKit)]
organAssOthers
  if UseResult
urOrganOthers UseResult -> UseResult -> Bool
forall a. Eq a => a -> a -> Bool
== UseResult
UseDud then UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud
  else do
    m ()
execSfx
    UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
  Actor
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
cstore = CStore
CGround
  [(ItemId, ItemFullKit)]
kitAss <- (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
cstore]
  case ((ItemId, ItemFullKit) -> Bool)
-> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
/= ItemId
iidOriginal) (ItemId -> Bool)
-> ((ItemId, ItemFullKit) -> ItemId)
-> (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)]
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{ItemSpeedup
coItemSpeedup :: ItemSpeedup
coItemSpeedup :: COps -> ItemSpeedup
coItemSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Actor
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
cstore = CStore
CGround  -- if ever changed, call @discoverIfMinorEffects@
  [(ItemId, ItemFullKit)]
kitAss <- (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
cstore]
  case ((ItemId, ItemFullKit) -> Bool)
-> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
/= ItemId
iidOriginal) (ItemId -> Bool)
-> ((ItemId, ItemFullKit) -> ItemId)
-> (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)]
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
        AbsDepth
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 -> m (ItemKnown, ItemFull)
roll100 Int
n = do
              -- Not only rerolled, but at highest depth possible,
              -- resulting in highest potential for bonuses.
              NewItem
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 NewItem
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
itemKnown, ItemFull
itemFull) <- Int -> m (ItemKnown, ItemFull)
roll100 Int
100
        m ItemId -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m ItemId -> m ()) -> m ItemId -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ItemFullKit -> ItemKnown -> Container -> m ItemId
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> ItemFullKit -> ItemKnown -> Container -> m ItemId
registerItem Bool
True (ItemFull
itemFull, ItemQuant
kit) ItemKnown
itemKnown Container
c
        UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
  Actor
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
cstore = CStore
CGround  -- beware of other options, e.g., creating in eqp
                        -- and not setting timeout to a random value
  [(ItemId, ItemFullKit)]
kitAss <- (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
cstore]
  case ((ItemId, ItemFullKit) -> Bool)
-> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
/= ItemId
iidOriginal) (ItemId -> Bool)
-> ((ItemId, ItemFullKit) -> ItemId)
-> (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)]
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{ItemSpeedup
coItemSpeedup :: COps -> ItemSpeedup
coItemSpeedup :: ItemSpeedup
coItemSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  EnumMap ItemId AspectRecord
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
  -- The actor that causes the application does not determine what item
  -- is identifiable, becuase it's the target actor that identifies
  -- his possesions.
  Actor
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
  State
sClient <- (StateServer -> State) -> m State
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> State) -> m State)
-> (StateServer -> State) -> m State
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId State -> FactionId -> State
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
tb) (EnumMap FactionId State -> State)
-> (StateServer -> EnumMap FactionId State) -> StateServer -> State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> EnumMap FactionId State
sclientStates
  let tryFull :: CStore -> [(ItemId, ItemFull)] -> m Bool
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] -> m UseResult
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
          [(ItemId, ItemFull)]
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]
          Bool
go <- CStore -> [(ItemId, ItemFull)] -> m Bool
tryFull CStore
store [(ItemId, ItemFull)]
allAssocs
          if Bool
go then UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp else [CStore] -> m UseResult
tryStore [CStore]
rest
  [CStore] -> m UseResult
tryStore [CStore
CGround, CStore
CStash, CStore
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
    EnumMap ItemId AspectRecord
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
    UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Container
-> ItemId -> ContentId ItemKind -> AspectRecord -> UpdAtomic
UpdDiscover Container
c ItemId
iid ContentId ItemKind
itemKindId (AspectRecord -> UpdAtomic) -> AspectRecord -> UpdAtomic
forall a b. (a -> b) -> a -> b
$ EnumMap ItemId AspectRecord
discoAspect EnumMap ItemId AspectRecord -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
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{ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem :: ContentData ItemKind
coitem, TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Actor
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
target
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (LevelId -> m Level) -> LevelId -> m Level
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b
  State
sClient <- (StateServer -> State) -> m State
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> State) -> m State)
-> (StateServer -> State) -> m State
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId State -> FactionId -> State
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (EnumMap FactionId State -> State)
-> (StateServer -> EnumMap FactionId State) -> StateServer -> State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> EnumMap FactionId State
sclientStates
  let lvlClient :: Level
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
  State
s <- m State
forall (m :: * -> *). MonadStateRead m => m State
getState
  ItemId -> ItemKind
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
  EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
  let lootPredicate :: Point -> Bool
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 :: ItemKind -> Bool
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 -> Bool
belongingIsLoot ItemId
iid = ItemKind -> Bool
itemKindIsLoot (ItemKind -> Bool) -> ItemKind -> Bool
forall a b. (a -> b) -> a -> b
$ ItemId -> ItemKind
getKind ItemId
iid
      embedHasLoot :: ItemId -> Bool
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 -> p -> p -> ItemKind -> Bool
reported Bool
acc p
_ p
_ ItemKind
itemKind = Bool
acc Bool -> Bool -> Bool
&& ItemKind -> Bool
itemKindIsLoot ItemKind
itemKind
      effectHasLoot :: Effect -> Bool
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 -> Bool
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 -> (FactionId, Faction) -> Bool
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
      (Point -> Bool
predicate, [Point] -> m Bool
action) = case DetectKind
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
                ItemBag
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
                Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null ItemBag
embeds) (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 -> Container -> ItemBag -> UpdAtomic
UpdSpotItemBag Bool
True (LevelId -> Point -> Container
CEmbed (Actor -> LevelId
blid Actor
b) Point
p) ItemBag
embeds
              actionH :: [Point] -> m Bool
actionH [Point]
l = do
                Point
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 -> m ()
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)]
                (Point -> m ()) -> [Point] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ Point -> m ()
f [Point]
l
                Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$! Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Point] -> Bool
forall a. [a] -> Bool
null [Point]
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)
  DetectKind
-> (Point -> Bool)
-> ([Point] -> m Bool)
-> m ()
-> Int
-> ActorId
-> m UseResult
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

-- 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 :: COps -> RuleContent
corule=RuleContent{Int
rWidthMax :: Int
rWidthMax :: RuleContent -> Int
rWidthMax, Int
rHeightMax :: Int
rHeightMax :: RuleContent -> Int
rHeightMax}} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Actor
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
target
  PerFid
sperFidOld <- (StateServer -> PerFid) -> m PerFid
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> PerFid
sperFid
  let perOld :: Perception
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 Int
x0 Int
y0 = Actor -> Point
bpos Actor
b
      perList :: [Point]
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
extraPer = Perception
emptyPer {psight = PerVisible $ ES.fromDistinctAscList perList}
      inPer :: Perception
inPer = Perception -> Perception -> Perception
diffPer Perception
extraPer Perception
perOld
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Perception -> Bool
nullPer Perception
inPer) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    -- Perception is modified on the server and sent to the client
    -- together with all the revealed info.
    let perNew :: Perception
perNew = Perception -> Perception -> Perception
addPer Perception
inPer Perception
perOld
        fper :: PerFid -> PerFid
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)
    (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 {sperFid = fper $ sperFid ser}
    FactionId
-> LevelId -> Perception -> Perception -> Perception -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId
-> LevelId -> Perception -> Perception -> Perception -> m ()
execSendPer (Actor -> FactionId
bfid Actor
b) (Actor -> LevelId
blid Actor
b) Perception
emptyPer Perception
inPer Perception
perNew
  Bool
pointsModified <- [Point] -> m Bool
action [Point]
perList
  if Bool -> Bool
not (Perception -> Bool
nullPer Perception
inPer) Bool -> Bool -> Bool
|| Bool
pointsModified then do
    m ()
execSfx
    -- Perception is reverted. This is necessary to ensure save and restore
    -- doesn't change game state.
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Perception -> Bool
nullPer Perception
inPer) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      (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 {sperFid = sperFidOld}
      FactionId
-> LevelId -> Perception -> Perception -> Perception -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId
-> LevelId -> Perception -> Perception -> Perception -> m ()
execSendPer (Actor -> FactionId
bfid Actor
b) (Actor -> LevelId
blid Actor
b) Perception
inPer Perception
emptyPer Perception
perOld
  else
    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
b) (SfxMsg -> SfxAtomic) -> SfxMsg -> SfxAtomic
forall a b. (a -> b) -> a -> b
$ DetectKind -> SfxMsg
SfxVoidDetection DetectKind
d
  UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
throwVelocity :: ThrowMod -> Int
throwLinger :: ThrowMod -> Int
throwHP :: ThrowMod -> Int
..} ActorId
source ActorId
target Container
container Maybe Bool
modePush = do
  Vector
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
  Actor
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
  Actor
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 eps :: Int
eps = Int
0
      fpos :: Point
fpos = Actor -> Point
bpos Actor
tb Point -> Vector -> Point
`shift` Vector
v
      isEmbed :: Bool
isEmbed = case Container
container of
        CEmbed{} -> Bool
True
        Container
_ -> Bool
False
  if Actor -> Int64
bhp Actor
tb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int64
0  -- avoid dragging around corpses
     Bool -> Bool -> Bool
|| Actor -> Bool
bproj Actor
tb Bool -> Bool -> Bool
&& Bool
isEmbed then  -- flying projectiles can't slip on the floor
    UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud  -- the impact never manifested
  else if Actor -> Bool
actorWaits Actor
tb
          Bool -> Bool -> Bool
&& ActorId
source ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
target
          Bool -> Bool -> Bool
&& Maybe ([Vector], Speed) -> Bool
forall a. Maybe a -> Bool
isNothing (Actor -> Maybe ([Vector], Speed)
btrajectory Actor
tb) 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
sb) (SfxMsg -> SfxAtomic) -> SfxMsg -> SfxAtomic
forall a b. (a -> b) -> a -> b
$ ActorId -> SfxMsg
SfxBracedImmune ActorId
target
    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 -> SfxAtomic) -> SfxMsg -> SfxAtomic
forall a b. (a -> b) -> a -> b
$ ActorId -> SfxMsg
SfxBracedImmune ActorId
target
    UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp  -- waste it to prevent repeated throwing at immobile actors
  else do
   case Int -> Point -> Point -> Maybe [Point]
bresenhamsLineAlgorithm Int
eps (Actor -> Point
bpos Actor
tb) Point
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
      [(ItemId, ItemFull)]
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
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 :: [Point]
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
          ([Vector]
trajectory, (Speed
speed, Int
_)) =
            -- Note that the @ThrowMod@ aspect of the actor's trunk is ignored.
            Int -> Int -> Int -> [Point] -> ([Vector], (Speed, Int))
computeTrajectory Int
weight Int
throwVelocity Int
throwLinger [Point]
path
          ts :: Maybe ([Vector], Speed)
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 Actor -> Maybe ([Vector], Speed)
btrajectory Actor
tb Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe ([Vector], Speed)
ts
      then UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId  -- e.g., actor is too heavy; but a jerk is noticeable
      else do
        m ()
execSfx
        UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId
-> Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> UpdAtomic
UpdTrajectory ActorId
target (Actor -> Maybe ([Vector], Speed)
btrajectory Actor
tb) Maybe ([Vector], Speed)
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.
        ActorId
originator <- if Actor -> Bool
bproj Actor
sb
                      then (StateServer -> ActorId) -> m ActorId
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> ActorId) -> m ActorId)
-> (StateServer -> ActorId) -> m ActorId
forall a b. (a -> b) -> a -> b
$ ActorId -> ActorId -> EnumMap ActorId ActorId -> ActorId
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault ActorId
source ActorId
source
                                        (EnumMap ActorId ActorId -> ActorId)
-> (StateServer -> EnumMap ActorId ActorId)
-> StateServer
-> ActorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> EnumMap ActorId ActorId
strajPushedBy
                      else ActorId -> m ActorId
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
source
        (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 {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).
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ([Vector], Speed) -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe ([Vector], Speed) -> Bool)
-> Maybe ([Vector], Speed) -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Maybe ([Vector], Speed)
btrajectory Actor
tb) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ 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.
          Time
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)
          -- 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
overheadTime = Time -> Delta Time -> Time
timeShift Time
localTime (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeClip)
              doubleClip :: Delta Time
doubleClip = Delta Time -> Int -> Delta Time
timeDeltaScale (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeClip) Int
2
          (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 tb) (blid tb) target overheadTime
                    $ strajTime ser
                , sactorTime =
                    ageActor (bfid tb) (blid tb) target doubleClip
                    $ sactorTime ser }
        UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
  Actor
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 ActorId
source ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
target then do
    Point
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
    LevelId
lid <- (State -> LevelId) -> m LevelId
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> LevelId) -> m LevelId)
-> (State -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ Container -> State -> LevelId
lidFromC Container
container
    let (Point
start, Point
end) =
          -- Without the level the pushing stair trap moved actor back upstairs.
          if Actor -> Point
bpos Actor
sb Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
/= Point
pos Bool -> Bool -> Bool
&& Actor -> LevelId
blid Actor
sb LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== LevelId
lid
          then (Actor -> Point
bpos Actor
sb, Point
pos)
          else (Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe (Actor -> Point
bpos Actor
sb) (Actor -> Maybe Point
boldpos Actor
sb), Actor -> Point
bpos Actor
sb)
    if Point
start Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
end then Rnd Vector -> m Vector
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction (Rnd Vector -> m Vector) -> Rnd Vector -> m Vector
forall a b. (a -> b) -> a -> b
$ do
      Int
z <- (Int, Int) -> Rnd Int
forall a. Integral a => (a, a) -> Rnd a
randomR (-Int
10, Int
10)
      [Vector] -> Rnd Vector
forall a. [a] -> Rnd a
oneOf [Int -> Int -> Vector
Vector Int
10 Int
z, Int -> Int -> Vector
Vector (-Int
10) Int
z, Int -> Int -> Vector
Vector Int
z Int
10, Int -> Int -> Vector
Vector Int
z (-Int
10)]
    else do
      let pushV :: Vector
pushV = Point -> Point -> Vector
vectorToFrom Point
end Point
start
          pullV :: Vector
pullV = Point -> Point -> Vector
vectorToFrom Point
start Point
end
      Vector -> m Vector
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector -> m Vector) -> Vector -> m Vector
forall a b. (a -> b) -> a -> b
$! case Maybe Bool
modePush of
                  Just Bool
True -> Vector
pushV
                  Just Bool
False -> Vector
pullV
                  Maybe Bool
Nothing -> Vector
pushV
  else do
    Actor
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 pushV :: Vector
pushV = Point -> Point -> Vector
vectorToFrom (Actor -> Point
bpos Actor
tb) (Actor -> Point
bpos Actor
sb)
        pullV :: Vector
pullV = Point -> Point -> Vector
vectorToFrom (Actor -> Point
bpos Actor
sb) (Actor -> Point
bpos Actor
tb)
    Vector -> m Vector
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector -> m Vector) -> Vector -> m Vector
forall a b. (a -> b) -> a -> b
$! case Maybe Bool
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
  Actor
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{SmellMap
lsmell :: SmellMap
lsmell :: Level -> SmellMap
lsmell} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (LevelId -> m Level) -> LevelId -> m Level
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
tb
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SmellMap -> Bool
forall k a. EnumMap k a -> Bool
EM.null SmellMap
lsmell) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    m ()
execSfx
    let f :: Point -> Time -> m ()
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
    (Key (EnumMap Point) -> Time -> m ()) -> SmellMap -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(FoldableWithKey t, Monad m) =>
(Key t -> a -> m b) -> t a -> m ()
mapWithKeyM_ Key (EnumMap Point) -> Time -> m ()
Point -> Time -> m ()
f SmellMap
lsmell
  UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
  Effect
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
  Effect -> m UseResult
recursiveCall Effect
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
  [Effect]
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 -> m UseResult -> m UseResult
f Effect
eff m UseResult
result = do
        UseResult
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 UseResult
ur UseResult -> UseResult -> Bool
forall a. Eq a => a -> a -> Bool
== UseResult
UseDud then m UseResult
result else UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
ur
  (Effect -> m UseResult -> m UseResult)
-> m UseResult -> [Effect] -> m UseResult
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Effect -> m UseResult -> m UseResult
f (UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud) [Effect]
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.
  Actor
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
  Challenge
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
  Faction
fact <- (State -> Faction) -> m Faction
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
sb) (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
  if Challenge -> Bool
cgoods Challenge
curChalSer Bool -> Bool -> Bool
&& FactionKind -> Bool
fhasUI (Faction -> FactionKind
gkind Faction
fact) 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
sb) SfxMsg
SfxReadyGoods
    UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
  else (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

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
  UseResult
ur1 <- Effect -> m UseResult
recursiveCall Effect
eff1
  if UseResult
ur1 UseResult -> UseResult -> Bool
forall a. Eq a => a -> a -> Bool
== UseResult
UseUp
  then Effect -> m UseResult
recursiveCall Effect
eff2
  else UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
  Challenge
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
  Faction
fact <- (State -> Faction) -> m Faction
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (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
  case Effect
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
      UseResult
ur1 <- Effect -> m UseResult
recursiveCall Effect
eff1
      if UseResult
ur1 UseResult -> UseResult -> Bool
forall a. Eq a => a -> a -> Bool
== UseResult
UseUp
      then UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp
      else Effect -> m UseResult
recursiveCall Effect
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
  Bool
go <- ActorId -> Condition -> ActivationFlag -> m Bool
forall (m :: * -> *).
MonadServer m =>
ActorId -> Condition -> ActivationFlag -> m Bool
conditionSem ActorId
source Condition
cond ActivationFlag
effActivation
  if Bool
go then Effect -> m UseResult
recursiveCall Effect
eff else UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
  Bool
go <- ActorId -> Condition -> ActivationFlag -> m Bool
forall (m :: * -> *).
MonadServer m =>
ActorId -> Condition -> ActivationFlag -> m Bool
conditionSem ActorId
source Condition
cond ActivationFlag
effActivation
  if Bool -> Bool
not Bool
go then Effect -> m UseResult
recursiveCall Effect
eff else UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
  Bool
c <- ActorId -> Condition -> ActivationFlag -> m Bool
forall (m :: * -> *).
MonadServer m =>
ActorId -> Condition -> ActivationFlag -> m Bool
conditionSem ActorId
source Condition
cond ActivationFlag
effActivation
  if Bool
c then Effect -> m UseResult
recursiveCall Effect
eff1 else Effect -> m UseResult
recursiveCall Effect
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
  Actor
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
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
effUseAllCopies  -- @UseUp@ ensures that if all used, all destroyed
        Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
b))  -- no spam when projectiles activate
    m ()
execSfx  -- announce that all copies have run out (or whatever message)
  UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
  Actor
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
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> Bool
bproj Actor
b) m ()
execSfx  -- don't spam when projectiles activate
  UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
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
  Actor
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
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> Bool
bproj Actor
b) m ()
execSfx  -- don't spam when projectiles activate
  UseResult -> m UseResult
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId  -- not @UseDud@ so that @OneOf@ doesn't ignore it