{-# 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
  ( applyItem, kineticEffectAndDestroy, effectAndDestroyAndAddKill
  , itemEffectEmbedded, highestImpression, dominateFidSfx
  , dropAllItems, pickDroppable
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , UseResult(..)
  , applyKineticDamage, refillHP, cutCalm, 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, effectDropItem, dropCStoreItem
  , effectPolyItem, effectRerollItem, effectDupItem, effectIdentify
  , identifyIid, effectDetect, effectDetectX, effectSendFlying
  , sendFlyingVector, effectDropBestWeapon, effectActivateInv
  , effectTransformContainer, effectApplyPerfume, effectOneOf
  , effectVerbNoLonger, effectVerbMsg, effectComposite
#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.Ord as Ord
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.ItemKind (ItemKind)
import qualified Game.LambdaHack.Content.ItemKind as IK
import           Game.LambdaHack.Content.ModeKind
import           Game.LambdaHack.Content.RuleKind
import qualified Game.LambdaHack.Core.Dice as Dice
import           Game.LambdaHack.Core.Random
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
/= :: UseResult -> UseResult -> Bool
$c/= :: UseResult -> UseResult -> Bool
== :: UseResult -> UseResult -> Bool
$c== :: 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
min :: UseResult -> UseResult -> UseResult
$cmin :: UseResult -> UseResult -> UseResult
max :: UseResult -> UseResult -> UseResult
$cmax :: UseResult -> UseResult -> UseResult
>= :: UseResult -> UseResult -> Bool
$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
compare :: UseResult -> UseResult -> Ordering
$ccompare :: UseResult -> UseResult -> Ordering
$cp1Ord :: Eq UseResult
Ord)

applyItem :: MonadServerAtomic m => ActorId -> ItemId -> CStore -> m ()
applyItem :: ActorId -> ItemId -> CStore -> m ()
applyItem aid :: ActorId
aid iid :: ItemId
iid cstore :: 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 -> CStore -> SfxAtomic
SfxApply ActorId
aid ItemId
iid CStore
cstore
  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@.
  Bool
-> ActorId
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Bool
-> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> ActorId
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Bool
-> m ()
kineticEffectAndDestroy Bool
True ActorId
aid ActorId
aid ActorId
aid ItemId
iid Container
c Bool
True

applyKineticDamage :: MonadServerAtomic m
                   => ActorId -> ActorId -> ItemId -> m Bool
applyKineticDamage :: ActorId -> ActorId -> ItemId -> m Bool
applyKineticDamage source :: ActorId
source target :: ActorId
target iid :: ItemId
iid = do
  ItemKind
itemKind <- (State -> ItemKind) -> m ItemKind
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
== 0 then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False else do  -- speedup
    Actor
sb <- (State -> Actor) -> m Actor
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 (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 (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
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 = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral 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` 100
        speedDeltaHP :: Int64
speedDeltaHP = case Actor -> Maybe ([Vector], Speed)
btrajectory Actor
sb of
          Just (_, speed :: Speed
speed) | Actor -> Bool
bproj Actor
sb -> - Int64 -> Speed -> Int64
modifyDamageBySpeed Int64
rawDeltaHP Speed
speed
          _ -> - Int64
rawDeltaHP
    if Int64
speedDeltaHP Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< 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 (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    else Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

refillHP :: MonadServerAtomic m => ActorId -> ActorId -> Int64 -> m ()
refillHP :: ActorId -> ActorId -> Int64 -> m ()
refillHP source :: ActorId
source target :: ActorId
target speedDeltaHP :: 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
/= 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Actor
tbOld <- (State -> Actor) -> m Actor
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 (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
> 0 Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
tbOld Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int64
xM 999 ->  -- UI limit
                     Int64
tenthM  -- avoid nop, to avoid loops
                   | Int64
deltaHP0 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
tbOld Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< - Int -> Int64
xM 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 (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 (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 ()
unless (Actor -> Bool
bproj Actor
tb Bool -> Bool -> Bool
|| Player -> LeaderMode
fleaderMode (Faction -> Player
gplayer Faction
fact) LeaderMode -> LeaderMode -> Bool
forall a. Eq a => a -> a -> Bool
== LeaderMode
LeaderNull) (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
<= 0 Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
tbOld Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> 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 (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 :: ActorId -> m ()
cutCalm target :: ActorId
target = do
  Actor
tb <- (State -> Actor) -> m Actor
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 (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 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
                        => Bool -> ActorId -> ActorId -> ActorId
                        -> ItemId -> Container -> Bool
                        -> m ()
kineticEffectAndDestroy :: Bool
-> ActorId
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Bool
-> m ()
kineticEffectAndDestroy voluntary :: Bool
voluntary killer :: ActorId
killer source :: ActorId
source target :: ActorId
target iid :: ItemId
iid c :: Container
c mayDestroy :: Bool
mayDestroy = do
  ItemBag
bag <- (State -> ItemBag) -> m ItemBag
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
    Nothing -> [Char] -> m ()
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> m ()) -> [Char] -> m ()
forall a b. (a -> b) -> a -> b
$ "" [Char] -> (ActorId, ActorId, ItemId, Container) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (ActorId
source, ActorId
target, ItemId
iid, Container
c)
    Just kit :: ItemQuant
kit -> do
      ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
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 (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 (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 -> ItemFull -> ItemQuant -> Bool
hasCharge Time
localTime ItemFull
itemFull 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.
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
recharged (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        Bool
kineticPerformed <- 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 (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
kineticPerformed  -- speedup
              Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
tb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
tbOld Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
          Actor
sb <- (State -> Actor) -> m Actor
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 (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
voluntary 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)
        Bool
-> ActorId
-> Bool
-> Bool
-> Bool
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Bool
-> ItemFull
-> Bool
-> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> ActorId
-> Bool
-> Bool
-> Bool
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Bool
-> ItemFull
-> Bool
-> m ()
effectAndDestroyAndAddKill
          Bool
voluntary ActorId
killer Bool
False (ItemQuant -> Int
forall a b. (a, b) -> a
fst ItemQuant
kit Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 1) Bool
kineticPerformed
          ActorId
source ActorId
target ItemId
iid Container
c Bool
False ItemFull
itemFull Bool
mayDestroy

effectAndDestroyAndAddKill :: MonadServerAtomic m
                           => Bool -> ActorId -> Bool -> Bool
                           -> Bool -> ActorId -> ActorId -> ItemId -> Container
                           -> Bool -> ItemFull -> Bool
                           -> m ()
effectAndDestroyAndAddKill :: Bool
-> ActorId
-> Bool
-> Bool
-> Bool
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Bool
-> ItemFull
-> Bool
-> m ()
effectAndDestroyAndAddKill voluntary :: Bool
voluntary killer :: ActorId
killer onSmashOnly :: Bool
onSmashOnly useAllCopies :: Bool
useAllCopies
                           kineticPerformed :: Bool
kineticPerformed source :: ActorId
source target :: ActorId
target iid :: ItemId
iid container :: Container
container
                           periodic :: Bool
periodic itemFull :: ItemFull
itemFull mayDestroy :: Bool
mayDestroy = do
  Actor
tbOld <- (State -> Actor) -> m Actor
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
  Bool
-> Bool
-> Bool
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Bool
-> ItemFull
-> Bool
-> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> Bool
-> Bool
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Bool
-> ItemFull
-> Bool
-> m ()
effectAndDestroy Bool
onSmashOnly Bool
useAllCopies Bool
kineticPerformed ActorId
source ActorId
target
                   ItemId
iid Container
container Bool
periodic ItemFull
itemFull Bool
mayDestroy
  Actor
tb <- (State -> Actor) -> m Actor
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
<= 0 Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
tbOld Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Actor
sb <- (State -> Actor) -> m Actor
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 (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
voluntary 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)

effectAndDestroy :: MonadServerAtomic m
                 => Bool -> Bool -> Bool
                 -> ActorId -> ActorId -> ItemId -> Container
                 -> Bool -> ItemFull -> Bool
                 -> m ()
effectAndDestroy :: Bool
-> Bool
-> Bool
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Bool
-> ItemFull
-> Bool
-> m ()
effectAndDestroy onSmashOnly :: Bool
onSmashOnly useAllCopies :: Bool
useAllCopies kineticPerformed :: Bool
kineticPerformed
                 source :: ActorId
source target :: ActorId
target iid :: ItemId
iid container :: Container
container periodic :: Bool
periodic
                 itemFull :: ItemFull
itemFull@ItemFull{Item
itemBase :: ItemFull -> Item
itemBase :: Item
itemBase, ItemDisco
itemDisco :: ItemFull -> ItemDisco
itemDisco :: ItemDisco
itemDisco, ContentId ItemKind
itemKindId :: ItemFull -> ContentId ItemKind
itemKindId :: ContentId ItemKind
itemKindId, ItemKind
itemKind :: ItemFull -> ItemKind
itemKind :: ItemKind
itemKind}
                 mayDestroy :: Bool
mayDestroy = do
  ItemBag
bag <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Container -> State -> ItemBag
getContainerBag Container
container
  let (itemK :: Int
itemK, itemTimer :: ItemTimer
itemTimer) = ItemBag
bag ItemBag -> ItemId -> ItemQuant
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
      effs :: [Effect]
effs = if Bool
onSmashOnly
             then ItemKind -> [Effect]
IK.strengthOnSmash ItemKind
itemKind
             else ItemKind -> [Effect]
IK.ieffects ItemKind
itemKind
      arItem :: AspectRecord
arItem = case ItemDisco
itemDisco of
        ItemDiscoFull itemAspect :: AspectRecord
itemAspect -> AspectRecord
itemAspect
        _ -> [Char] -> AspectRecord
forall a. (?callStack::CallStack) => [Char] -> a
error "effectAndDestroy: server ignorant about an item"
      timeout :: Int
timeout = AspectRecord -> Int
IA.aTimeout AspectRecord
arItem
  LevelId
lid <- (State -> LevelId) -> m LevelId
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 (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 :: ItemTimer
it1 = let timeoutTurns :: Delta Time
timeoutTurns = Delta Time -> Int -> Delta Time
timeDeltaScale (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeTurn) Int
timeout
                charging :: Time -> Bool
charging startT :: Time
startT = Time -> Delta Time -> Time
timeShift Time
startT Delta Time
timeoutTurns Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
> Time
localTime
            in (Time -> Bool) -> ItemTimer -> ItemTimer
forall a. (a -> Bool) -> [a] -> [a]
filter Time -> Bool
charging ItemTimer
itemTimer
      len :: Int
len = ItemTimer -> Int
forall a. [a] -> Int
length ItemTimer
it1
      recharged :: Bool
recharged = Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
itemK Bool -> Bool -> Bool
|| Bool
onSmashOnly
  -- If the item has no charges and the effects are not @OnSmash@
  -- 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@, only effects are triggered).
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
recharged (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let it2 :: ItemTimer
it2 = if Int
timeout Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 0 Bool -> Bool -> Bool
&& Bool
recharged
              then if Bool
periodic Bool -> Bool -> Bool
&& Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Fragile AspectRecord
arItem
                   then Int -> Time -> ItemTimer
forall a. Int -> a -> [a]
replicate (Int
itemK Int -> Int -> Int
forall a. Num a => a -> a -> a
- ItemTimer -> Int
forall a. [a] -> Int
length ItemTimer
it1) Time
localTime ItemTimer -> ItemTimer -> ItemTimer
forall a. [a] -> [a] -> [a]
++ ItemTimer
it1
                           -- copies are spares only; one fires, all discharge
                   else Time
localTime Time -> ItemTimer -> ItemTimer
forall a. a -> [a] -> [a]
: ItemTimer
it1
                           -- copies all fire, turn by turn; one discharges
              else ItemTimer
itemTimer
        kit2 :: ItemQuant
kit2 = (1, Int -> ItemTimer -> ItemTimer
forall a. Int -> [a] -> [a]
take 1 ItemTimer
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 a. Show a => Bool -> a -> 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 (ItemTimer
itemTimer ItemTimer -> ItemTimer -> Bool
forall a. Eq a => a -> a -> Bool
== ItemTimer
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 -> ItemTimer -> ItemTimer -> UpdAtomic
UpdTimeItem ItemId
iid Container
container ItemTimer
itemTimer ItemTimer
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
mayDestroy Bool -> Bool -> Bool
|| Bool -> ItemFull -> Bool
imperishableKit Bool
periodic 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 -> Item -> ItemQuant -> Container -> UpdAtomic
UpdLoseItem Bool
False ItemId
iid Item
itemBase 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.
    -- If the item activation is not periodic, but the item itself is,
    -- only the first effect gets activated (and the item may be destroyed,
    -- unlike with periodic activations).
    let effsManual :: [Effect]
effsManual = if Bool -> Bool
not Bool
periodic
                        Bool -> Bool -> Bool
&& Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Periodic AspectRecord
arItem
                        Bool -> Bool -> Bool
&& Bool -> Bool
not (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition AspectRecord
arItem)
                     then Int -> [Effect] -> [Effect]
forall a. Int -> [a] -> [a]
take 1 [Effect]
effs  -- may be empty
                     else [Effect]
effs
    UseResult
triggeredEffect <- Bool
-> Bool
-> ActorId
-> ActorId
-> ItemId
-> ContentId ItemKind
-> ItemKind
-> Container
-> Bool
-> [Effect]
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> Bool
-> ActorId
-> ActorId
-> ItemId
-> ContentId ItemKind
-> ItemKind
-> Container
-> Bool
-> [Effect]
-> m UseResult
itemEffectDisco Bool
useAllCopies Bool
kineticPerformed
                                       ActorId
source ActorId
target ItemId
iid ContentId ItemKind
itemKindId ItemKind
itemKind
                                       Container
container Bool
periodic [Effect]
effsManual
    let triggered :: UseResult
triggered = if Bool
kineticPerformed then UseResult
UseUp else UseResult
triggeredEffect
    Actor
sb <- (State -> Actor) -> m Actor
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
    -- Announce no effect, which is rare and wastes time, so noteworthy.
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (UseResult
triggered UseResult -> UseResult -> Bool
forall a. Eq a => a -> a -> Bool
== UseResult
UseUp  -- effects triggered; feedback comes from them
            Bool -> Bool -> Bool
|| Bool
periodic  -- don't spam via fizzled periodic effects
            Bool -> Bool -> Bool
|| Actor -> Bool
bproj Actor
sb  -- don't spam, projectiles can be very numerous
            ) (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
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]
effsManual
        then SfxMsg
SfxFizzles  -- something didn't work, despite promising effects
        else SfxMsg
SfxNothingHappens  -- fully expected
    -- 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 -> Item -> ItemQuant -> Container -> UpdAtomic
UpdSpotItem Bool
False ItemId
iid Item
itemBase ItemQuant
kit2 Container
container

imperishableKit :: Bool -> ItemFull -> Bool
imperishableKit :: Bool -> ItemFull -> Bool
imperishableKit periodic :: Bool
periodic itemFull :: 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
|| Bool
periodic 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.
itemEffectEmbedded :: MonadServerAtomic m
                   => Bool -> ActorId -> LevelId -> Point -> ItemId -> m ()
itemEffectEmbedded :: Bool -> ActorId -> LevelId -> Point -> ItemId -> m ()
itemEffectEmbedded voluntary :: Bool
voluntary aid :: ActorId
aid lid :: LevelId
lid tpos :: Point
tpos iid :: ItemId
iid = 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.
  Bool
-> ActorId
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Bool
-> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> ActorId
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Bool
-> m ()
kineticEffectAndDestroy Bool
voluntary ActorId
aid ActorId
aid ActorId
aid ItemId
iid Container
c Bool
True

-- | 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
                => Bool -> Bool-> ActorId -> ActorId -> ItemId
                -> ContentId ItemKind -> ItemKind
                -> Container -> Bool -> [IK.Effect]
                -> m UseResult
itemEffectDisco :: Bool
-> Bool
-> ActorId
-> ActorId
-> ItemId
-> ContentId ItemKind
-> ItemKind
-> Container
-> Bool
-> [Effect]
-> m UseResult
itemEffectDisco useAllCopies :: Bool
useAllCopies kineticPerformed :: Bool
kineticPerformed
                source :: ActorId
source target :: ActorId
target iid :: ItemId
iid itemKindId :: ContentId ItemKind
itemKindId itemKind :: ItemKind
itemKind
                c :: Container
c periodic :: Bool
periodic effs :: [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)
mapM (Bool
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Bool
-> Effect
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Bool
-> Effect
-> m UseResult
effectSem Bool
useAllCopies ActorId
source ActorId
target ItemId
iid Container
c Bool
periodic) [Effect]
effs
  let ur :: UseResult
ur = case [UseResult]
urs of
        [] -> UseResult
UseDud  -- there was no effects
        _ -> [UseResult] -> UseResult
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
kineticPerformed) (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 (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
          => Bool -> ActorId -> ActorId -> ItemId -> Container -> Bool
          -> IK.Effect
          -> m UseResult
effectSem :: Bool
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Bool
-> Effect
-> m UseResult
effectSem useAllCopies :: Bool
useAllCopies source :: ActorId
source target :: ActorId
target iid :: ItemId
iid c :: Container
c periodic :: Bool
periodic effect :: Effect
effect = do
  let recursiveCall :: Effect -> m UseResult
recursiveCall = Bool
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Bool
-> Effect
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Bool
-> Effect
-> m UseResult
effectSem Bool
useAllCopies ActorId
source ActorId
target ItemId
iid Container
c Bool
periodic
  Actor
sb <- (State -> Actor) -> m Actor
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
  Point
pos <- (State -> Point) -> m Point
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
c
  -- @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 -> Effect -> Int64 -> SfxAtomic
SfxEffect (Actor -> FactionId
bfid Actor
sb) ActorId
target Effect
effect 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 -> Effect -> Int64 -> SfxAtomic
SfxEffect (Actor -> FactionId
bfid Actor
sb) ActorId
source Effect
effect 0
  case Effect
effect of
    IK.Burn nDm :: Dice
nDm -> Dice -> ActorId -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
Dice -> ActorId -> ActorId -> m UseResult
effectBurn Dice
nDm ActorId
source ActorId
target
    IK.Explode t :: GroupName ItemKind
t -> m () -> GroupName ItemKind -> ActorId -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> GroupName ItemKind -> ActorId -> ActorId -> m UseResult
effectExplode m ()
execSfx GroupName ItemKind
t ActorId
source ActorId
target
    IK.RefillHP p :: Int
p -> Int -> ActorId -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
Int -> ActorId -> ActorId -> m UseResult
effectRefillHP Int
p ActorId
source ActorId
target
    IK.RefillCalm p :: 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
    IK.Dominate -> ActorId -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> ActorId -> m UseResult
effectDominate ActorId
source ActorId
target
    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
    IK.PutToSleep -> m () -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ActorId -> m UseResult
effectPutToSleep m ()
execSfx ActorId
target
    IK.Yell -> m () -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ActorId -> m UseResult
effectYell m ()
execSfx ActorId
target
    IK.Summon grp :: GroupName ItemKind
grp nDm :: Dice
nDm -> GroupName ItemKind
-> Dice -> ItemId -> ActorId -> ActorId -> Bool -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
GroupName ItemKind
-> Dice -> ItemId -> ActorId -> ActorId -> Bool -> m UseResult
effectSummon GroupName ItemKind
grp Dice
nDm ItemId
iid ActorId
source ActorId
target Bool
periodic
    IK.Ascend p :: Bool
p -> (Effect -> m UseResult)
-> m () -> Bool -> ActorId -> ActorId -> Point -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
(Effect -> m UseResult)
-> m () -> Bool -> ActorId -> ActorId -> Point -> m UseResult
effectAscend Effect -> m UseResult
recursiveCall m ()
execSfx Bool
p ActorId
source ActorId
target Point
pos
    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 nDm :: 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 nDm :: 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 nDm :: 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 nDm :: 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 store :: CStore
store grp :: GroupName ItemKind
grp tim :: TimerDice
tim ->
      Maybe FactionId
-> Maybe Int
-> ActorId
-> ActorId
-> CStore
-> GroupName ItemKind
-> TimerDice
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
Maybe FactionId
-> Maybe Int
-> ActorId
-> ActorId
-> 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
forall a. Maybe a
Nothing ActorId
source ActorId
target CStore
store GroupName ItemKind
grp TimerDice
tim
    IK.DropItem n :: Int
n k :: Int
k store :: CStore
store grp :: 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.PolyItem -> m () -> ItemId -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ItemId -> ActorId -> m UseResult
effectPolyItem m ()
execSfx ItemId
iid ActorId
target
    IK.RerollItem -> m () -> ItemId -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ItemId -> ActorId -> m UseResult
effectRerollItem m ()
execSfx ItemId
iid ActorId
target
    IK.DupItem -> m () -> ItemId -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ItemId -> ActorId -> m UseResult
effectDupItem m ()
execSfx ItemId
iid ActorId
target
    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 d :: DetectKind
d radius :: Int
radius -> m () -> DetectKind -> Int -> ActorId -> Point -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> DetectKind -> Int -> ActorId -> Point -> m UseResult
effectDetect m ()
execSfx DetectKind
d Int
radius ActorId
target Point
pos
    IK.SendFlying tmod :: 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 tmod :: 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 tmod :: 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)
    IK.DropBestWeapon -> m () -> ItemId -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ItemId -> ActorId -> m UseResult
effectDropBestWeapon m ()
execSfx ItemId
iid ActorId
target
    IK.ActivateInv symbol :: Char
symbol -> m () -> ItemId -> ActorId -> ActorId -> Char -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ItemId -> ActorId -> ActorId -> Char -> m UseResult
effectActivateInv m ()
execSfx ItemId
iid ActorId
source ActorId
target Char
symbol
    IK.ApplyPerfume -> m () -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ActorId -> m UseResult
effectApplyPerfume m ()
execSfx ActorId
target
    IK.OneOf l :: [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 _ -> UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud  -- ignored under normal circumstances
    IK.VerbNoLonger _ -> Bool -> m () -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> m () -> ActorId -> m UseResult
effectVerbNoLonger Bool
useAllCopies m ()
execSfxSource ActorId
source
    IK.VerbMsg _ -> m () -> ActorId -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> ActorId -> m UseResult
effectVerbMsg m ()
execSfxSource ActorId
source
    IK.Composite l :: [Effect]
l -> (Effect -> m UseResult) -> [Effect] -> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
(Effect -> m UseResult) -> [Effect] -> m UseResult
effectComposite Effect -> m UseResult
recursiveCall [Effect]
l

-- * Individual semantic functions for effects

-- ** Burn

-- Damage from fire. Not affected by armor.
effectBurn :: MonadServerAtomic m
           => Dice.Dice -> ActorId -> ActorId -> m UseResult
effectBurn :: Dice -> ActorId -> ActorId -> m UseResult
effectBurn nDm :: Dice
nDm source :: ActorId
source target :: ActorId
target = do
  Actor
tb <- (State -> Actor) -> m Actor
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 (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
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 1 Int
n0  -- avoid 0 and negative burn
      deltaHP :: Int64
deltaHP = - Int -> Int64
xM Int
n
  Actor
sb <- (State -> Actor) -> m Actor
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 -> Effect -> Int64 -> SfxAtomic
SfxEffect (Actor -> FactionId
bfid Actor
sb) ActorId
target 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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp

-- ** Explode

effectExplode :: MonadServerAtomic m
              => m () -> GroupName ItemKind -> ActorId -> ActorId -> m UseResult
effectExplode :: m () -> GroupName ItemKind -> ActorId -> ActorId -> m UseResult
effectExplode execSfx :: m ()
execSfx cgroup :: GroupName ItemKind
cgroup source :: ActorId
source target :: ActorId
target = do
  m ()
execSfx
  Actor
tb <- (State -> Actor) -> m Actor
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 itemFreq :: [(GroupName ItemKind, Int)]
itemFreq = [(GroupName ItemKind
cgroup, 1)]
      -- Explosion particles are placed among organs of the victim:
      container :: Container
container = ActorId -> CStore -> Container
CActor ActorId
target CStore
COrgan
  Maybe (ItemId, ItemFullKit)
m2 <- LevelId
-> [(GroupName ItemKind, Int)]
-> Container
-> Bool
-> Maybe Int
-> m (Maybe (ItemId, ItemFullKit))
forall (m :: * -> *).
MonadServerAtomic m =>
LevelId
-> [(GroupName ItemKind, Int)]
-> Container
-> Bool
-> Maybe Int
-> m (Maybe (ItemId, ItemFullKit))
rollAndRegisterItem (Actor -> LevelId
blid Actor
tb) [(GroupName ItemKind, Int)]
itemFreq Container
container Bool
False Maybe Int
forall a. Maybe a
Nothing
  let (iid :: ItemId
iid, (ItemFull{Item
itemBase :: Item
itemBase :: ItemFull -> Item
itemBase, ItemKind
itemKind :: ItemKind
itemKind :: ItemFull -> ItemKind
itemKind}, (itemK :: Int
itemK, _))) =
        (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] -> GroupName ItemKind -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` GroupName ItemKind
cgroup) Maybe (ItemId, ItemFullKit)
m2
      Point x :: Int
x y :: Int
y = Actor -> Point
bpos Actor
tb
      semirandom :: Int
semirandom = Text -> Int
T.length (ItemKind -> Text
IK.idesc ItemKind
itemKind)
      projectN :: Int -> Int -> m ()
projectN k100 :: Int
k100 n :: Int
n = do
        -- 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.
        let veryrandom :: Int
veryrandom = (Int
k100 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)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 5
            fuzz :: Int
fuzz = 5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
veryrandom
            k :: Int
k | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 16 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 12 = 12
              | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 12 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 8 = 8
              | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 8 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 4 = 4
              | Bool
otherwise = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n 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
- 12) (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 12)
              , Int -> Int -> Point
Point (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 12) (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 12)
              , Int -> Int -> Point
Point (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- 12) (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- 12)
              , Int -> Int -> Point
Point (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 12) (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- 12) ]
            psDir8 :: [Point]
psDir8 =
              [ Int -> Int -> Point
Point (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- 12) Int
y
              , Int -> Int -> Point
Point (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 12) Int
y
              , Int -> Int -> Point
Point Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 12)
              , Int -> Int -> Point
Point Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- 12) ]
            psFuzz :: [Point]
psFuzz =
              [ Int -> Int -> Point
Point (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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
+ 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
- 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
+ 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
- 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
+ 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
- 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
+ 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
veryrandom Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 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 4 (Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
drop ((Int
k100 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` 4) ([Point] -> [Point]) -> [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ [Point] -> [Point]
forall a. [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 4 (Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
drop ((Int
k100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 4) ([Point] -> [Point]) -> [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ [Point] -> [Point]
forall a. [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 8 (Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
drop ((Int
k100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fuzz) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 8) ([Point] -> [Point]) -> [Point] -> [Point]
forall a b. (a -> b) -> a -> b
$ [Point] -> [Point]
forall a. [a] -> [a]
cycle [Point]
psFuzz)]
        [(Bool, Point)] -> ((Bool, Point) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Bool, Point)]
ps (((Bool, Point) -> m ()) -> m ())
-> ((Bool, Point) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(centerRaw :: Bool
centerRaw, tpxy :: Point
tpxy) -> do
          let center :: Bool
center = Bool
centerRaw Bool -> Bool -> Bool
&& Int
itemK Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 8  -- if few, keep them regular
          Maybe ReqFailure
mfail <- ActorId
-> ActorId
-> Point
-> Int
-> Bool
-> ItemId
-> CStore
-> Bool
-> m (Maybe ReqFailure)
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId
-> ActorId
-> Point
-> Int
-> Bool
-> ItemId
-> CStore
-> Bool
-> m (Maybe ReqFailure)
projectFail ActorId
source ActorId
target Point
tpxy Int
veryrandom Bool
center
                               ItemId
iid CStore
COrgan Bool
True
          case Maybe ReqFailure
mfail of
            Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just ProjectBlockTerrain -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just ProjectBlockActor | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Bool
bproj Actor
tb -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just failMsg :: 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 0 = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      tryFlying k100 :: Int
k100 = do
        -- Explosion particles were placed among organs of the victim:
        ItemBag
bag2 <- (State -> ItemBag) -> m ItemBag
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 half remains,
        -- 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 (n2 :: Int
n2, _) | Int
n2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
itemK Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2 -> do
            Int -> Int -> m ()
projectN Int
k100 Int
n2
            Int -> m ()
tryFlying (Int -> m ()) -> Int -> m ()
forall a b. (a -> b) -> a -> b
$ Int
k100 Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
          _ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  -- Some of the particles that fail to take off, bounce off obstacles
  -- up to 100 times in total, trying to fly in different directions.
  Int -> m ()
tryFlying 100
  ItemBag
bag3 <- (State -> ItemBag) -> m ItemBag
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 (m :: * -> *) a. Monad m => a -> m a
return ()) (\kit :: ItemQuant
kit -> 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
UpdLoseItem Bool
False ItemId
iid Item
itemBase ItemQuant
kit Container
container) Maybe ItemQuant
mn3
  UseResult -> m UseResult
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 -> m UseResult
effectRefillHP :: Int -> ActorId -> ActorId -> m UseResult
effectRefillHP power0 :: Int
power0 source :: ActorId
source target :: ActorId
target = do
  Actor
sb <- (State -> Actor) -> m Actor
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 (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 (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 (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
<= -1 then Int
power0 else Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 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
> 0
       Bool -> Bool -> Bool
&& Player -> Bool
fhasUI (Faction -> Player
gplayer 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 -> 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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
     | Bool
otherwise -> 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 -> Effect -> Int64 -> SfxAtomic
SfxEffect (Actor -> FactionId
bfid Actor
sb) ActorId
target 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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp

-- ** RefillCalm

effectRefillCalm :: MonadServerAtomic m
                 => m () -> Int -> ActorId -> ActorId -> m UseResult
effectRefillCalm :: m () -> Int -> ActorId -> ActorId -> m UseResult
effectRefillCalm execSfx :: m ()
execSfx power0 :: Int
power0 source :: ActorId
source target :: ActorId
target = do
  Actor
tb <- (State -> Actor) -> m Actor
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 (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
<= -1 then Int
power0 else Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 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
> 0 Bool -> Bool -> Bool
&& Actor -> Int64
bcalm Actor
tb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int -> Int64
xM 999 ->  -- UI limit
                       Int64
tenthM  -- avoid nop, to avoid loops
                     | Int64
deltaCalm0 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< 0 Bool -> Bool -> Bool
&& Actor -> Int64
bcalm Actor
tb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< - Int -> Int64
xM 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 (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 -> m UseResult
effectDominate :: ActorId -> ActorId -> m UseResult
effectDominate source :: ActorId
source target :: ActorId
target = do
  Actor
sb <- (State -> Actor) -> m Actor
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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud  -- accidental hit; ignore
     | Bool
otherwise -> do
       Faction
fact <- (State -> Faction) -> m Faction
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
             Nothing -> Bool
False  -- no impression, no domination
             Just (hiImpressionFid :: FactionId
hiImpressionFid, hiImpressionK :: 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
&& (Player -> LeaderMode
fleaderMode (Faction -> Player
gplayer Faction
fact) LeaderMode -> LeaderMode -> Bool
forall a. Eq a => a -> a -> Bool
/= LeaderMode
LeaderNull
                    Bool -> Bool -> Bool
|| Int
hiImpressionK Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 10)
                     -- to tame/hack animal/robot, impress them a lot first
       if Bool
permitted then do
         Bool
b <- ActorId -> ActorId -> FactionId -> m Bool
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> ActorId -> FactionId -> m Bool
dominateFidSfx ActorId
source ActorId
target (Actor -> FactionId
bfid Actor
sb)
         UseResult -> m UseResult
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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud

highestImpression :: MonadServerAtomic m
                  => Actor -> m (Maybe (FactionId, Int))
highestImpression :: Actor -> m (Maybe (FactionId, Int))
highestImpression tb :: Actor
tb = do
  ItemId -> ItemKind
getKind <- (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
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 (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 iid :: 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
> 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 "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 (\iid :: ItemId
iid _ -> 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 (_, (k :: a
k, _)) = 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
Ord.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 (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
    Nothing -> Maybe (FactionId, Int) -> m (Maybe (FactionId, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (FactionId, Int)
forall a. Maybe a
Nothing
    Just fid :: 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 (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 -> FactionId -> m Bool
dominateFidSfx :: ActorId -> ActorId -> FactionId -> m Bool
dominateFidSfx source :: ActorId
source target :: ActorId
target fid :: FactionId
fid = do
  Actor
tb <- (State -> Actor) -> m Actor
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 (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
> 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 -> Effect -> Int64 -> SfxAtomic
SfxEffect FactionId
fid ActorId
target Effect
IK.Dominate 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 (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  else
    Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

dominateFid :: MonadServerAtomic m => FactionId -> ActorId -> ActorId -> m ()
dominateFid :: FactionId -> ActorId -> ActorId -> m ()
dominateFid fid :: FactionId
fid source :: ActorId
source target :: ActorId
target = do
  Actor
tb0 <- (State -> Actor) -> m Actor
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
  Faction
fact <- (State -> Faction) -> m Faction
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
tb0) (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
  -- 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.
  -- Prevent the faction's stash from being lost in case they are
  -- not spawners. Drop items while still of the original faction
  -- to mark them on the map for other party members to collect.
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ActorId -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe ActorId -> Bool) -> Maybe ActorId -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> Maybe ActorId
gleader Faction
fact) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ActorId -> CStore -> CStore -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> ActorId -> CStore -> CStore -> m ()
moveStores Bool
False ActorId
target CStore
CSha CStore
CInv
  ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Actor -> m ()
dropAllItems ActorId
target Actor
tb0
  Actor
tb <- (State -> Actor) -> m Actor
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, Item)]
ais <- (State -> [(ItemId, Item)]) -> m [(ItemId, Item)]
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
$ Actor -> State -> [(ItemId, Item)]
getCarriedAssocsAndTrunk Actor
tb
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
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 (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 iid :: 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
> 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 "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 (\iid :: ItemId
iid _ -> 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 (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> Time) -> m Time)
-> (StateServer -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ (EnumMap ActorId Time -> ActorId -> Time
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
target) (EnumMap ActorId Time -> Time)
-> (StateServer -> EnumMap ActorId Time) -> StateServer -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap LevelId (EnumMap ActorId Time)
-> LevelId -> EnumMap ActorId Time
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> LevelId
blid Actor
tb) (EnumMap LevelId (EnumMap ActorId Time) -> EnumMap ActorId Time)
-> (StateServer -> EnumMap LevelId (EnumMap ActorId Time))
-> StateServer
-> EnumMap ActorId Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
-> FactionId -> EnumMap LevelId (EnumMap ActorId Time)
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
tb) (EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
 -> EnumMap LevelId (EnumMap ActorId Time))
-> (StateServer
    -> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time)))
-> StateServer
-> EnumMap LevelId (EnumMap ActorId Time)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
sactorTime
  UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Actor -> [(ItemId, Item)] -> UpdAtomic
UpdLoseActor ActorId
target Actor
tb [(ItemId, Item)]
ais
  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 :: FactionId
bfid = FactionId
fid
                , bcalm :: Int64
bcalm = Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max (Int -> Int64
xM 10) (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ Int -> Int64
xM Int
maxCalm Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` 2
                , bhp :: Int64
bhp = Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
min (Int -> Int64
xM Int
maxHp) (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ Actor -> Int64
bhp Actor
tb Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int -> Int64
xM 10
                , borgan :: ItemBag
borgan = ItemBag
borganNoImpression}
  [(ItemId, Item)]
aisNew <- (State -> [(ItemId, Item)]) -> m [(ItemId, Item)]
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
$ Actor -> State -> [(ItemId, Item)]
getCarriedAssocsAndTrunk Actor
bNew
  (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser ->
    StateServer
ser {sactorTime :: EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
sactorTime = FactionId
-> LevelId
-> ActorId
-> Time
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
updateActorTime FactionId
fid (Actor -> LevelId
blid Actor
tb) ActorId
target Time
btime
                      (EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
 -> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time)))
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
forall a b. (a -> b) -> a -> b
$ StateServer
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
sactorTime StateServer
ser}
  UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Actor -> [(ItemId, Item)] -> UpdAtomic
UpdSpotActor ActorId
target Actor
bNew [(ItemId, Item)]
aisNew
  -- 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 (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
  let inGame :: Faction -> Bool
inGame fact2 :: Faction
fact2 = case Faction -> Maybe Status
gquit Faction
fact2 of
        Nothing -> Bool
True
        Just Status{stOutcome :: Status -> Outcome
stOutcome=Outcome
Camping} -> Bool
True
        _ -> 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
-> CStore
-> GroupName ItemKind
-> TimerDice
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
Maybe FactionId
-> Maybe Int
-> ActorId
-> ActorId
-> 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 10) ActorId
source ActorId
target CStore
COrgan
                            "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 (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 (iid :: ItemId
iid, cstore :: 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 b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ItemId, CStore) -> m ()
discoverIf [(ItemId, CStore)]
aic

-- | Drop all actor's items.
dropAllItems :: MonadServerAtomic m => ActorId -> Actor -> m ()
dropAllItems :: ActorId -> Actor -> m ()
dropAllItems aid :: ActorId
aid b :: Actor
b = do
  CStore -> (ItemId -> ItemQuant -> m ()) -> Actor -> m ()
forall (m :: * -> *) a.
MonadServer m =>
CStore -> (ItemId -> ItemQuant -> m a) -> Actor -> m ()
mapActorCStore_ CStore
CInv (Bool
-> CStore -> ActorId -> Actor -> Int -> ItemId -> ItemQuant -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> CStore -> ActorId -> Actor -> Int -> ItemId -> ItemQuant -> m ()
dropCStoreItem Bool
False CStore
CInv ActorId
aid Actor
b Int
forall a. Bounded a => a
maxBound) Actor
b
  CStore -> (ItemId -> ItemQuant -> m ()) -> Actor -> m ()
forall (m :: * -> *) a.
MonadServer m =>
CStore -> (ItemId -> ItemQuant -> m a) -> Actor -> m ()
mapActorCStore_ CStore
CEqp (Bool
-> CStore -> ActorId -> Actor -> Int -> ItemId -> ItemQuant -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> CStore -> ActorId -> Actor -> Int -> ItemId -> ItemQuant -> m ()
dropCStoreItem 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 :: (Effect -> m UseResult)
-> m () -> ActorId -> ActorId -> m UseResult
effectImpress recursiveCall :: Effect -> m UseResult
recursiveCall execSfx :: m ()
execSfx source :: ActorId
source target :: ActorId
target = do
  Actor
sb <- (State -> Actor) -> m Actor
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 (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 (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 1 1 CStore
COrgan "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 (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
<= 0)
           m ()
execSfx  -- avoid spam just before death
         Maybe FactionId
-> Maybe Int
-> ActorId
-> ActorId
-> CStore
-> GroupName ItemKind
-> TimerDice
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
Maybe FactionId
-> Maybe Int
-> ActorId
-> ActorId
-> 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 1) ActorId
source ActorId
target CStore
COrgan
                          "impressed" TimerDice
IK.timerNone
       else UseResult -> m UseResult
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 :: m () -> ActorId -> m UseResult
effectPutToSleep execSfx :: m ()
execSfx target :: ActorId
target = do
  Actor
tb <- (State -> Actor) -> m Actor
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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud
     | Actor -> Watchfulness
bwatch Actor
tb Watchfulness -> [Watchfulness] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Watchfulness
WSleep, Watchfulness
WWake] -> UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId  -- can't increase sleep
     | Bool
otherwise -> do
       Skills
actorMaxSk <- (State -> Skills) -> m Skills
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 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
> 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 n :: Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 -> do
           Int
nAll <- GroupName ItemKind -> ActorId -> m Int
forall (m :: * -> *).
MonadServerAtomic m =>
GroupName ItemKind -> ActorId -> m Int
removeConditionSingle "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
== 0) ()
           () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
         _ -> () -> m ()
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 (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 :: m () -> ActorId -> m UseResult
effectYell execSfx :: m ()
execSfx target :: ActorId
target = do
  Actor
tb <- (State -> Actor) -> m Actor
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
|| Actor -> Int64
bhp Actor
tb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 then  -- avoid yelling projectiles or corpses
    UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud  -- the yell never manifested
  else do
    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 (ResDelta -> Bool
deltaBenign (ResDelta -> Bool) -> ResDelta -> Bool
forall a b. (a -> b) -> a -> b
$ 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 (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 -> Bool
             -> m UseResult
effectSummon :: GroupName ItemKind
-> Dice -> ItemId -> ActorId -> ActorId -> Bool -> m UseResult
effectSummon grp :: GroupName ItemKind
grp nDm :: Dice
nDm iid :: ItemId
iid source :: ActorId
source target :: ActorId
target periodic :: Bool
periodic = do
  -- Obvious effect, nothing announced.
  cops :: COps
cops@COps{TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Actor
sb <- (State -> Actor) -> m Actor
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 (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 (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 (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 (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> AbsDepth
stotalDepth
  lvl :: Level
lvl@Level{AbsDepth
ldepth :: AbsDepth
ldepth :: Level -> AbsDepth
ldepth, BigActorMap
lbig :: Level -> BigActorMap
lbig :: 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 (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 (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
  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 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 warning :: 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 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 | (Bool
periodic 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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
     | Int
nFriends Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 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 (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
>= 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 (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
       let validTile :: ContentId TileKind -> Bool
validTile t :: ContentId TileKind
t = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TileSpeedup -> ContentId TileKind -> Bool
Tile.isNoActor TileSpeedup
coTileSpeedup ContentId TileKind
t
           ps :: [Point]
ps = COps -> Level -> (ContentId TileKind -> Bool) -> Point -> [Point]
nearbyFreePoints COps
cops Level
lvl ContentId TileKind -> Bool
validTile (Actor -> Point
bpos Actor
tb)
       Time
localTime <- (State -> Time) -> m Time
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
       Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Point] -> Int
forall a. [a] -> Int
length (Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
take Int
power [Point]
ps) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
power) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
          Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
debugPossiblyPrint
            "Server: effectSummon: failed to find enough free positions"
       [Bool]
bs <- [Point] -> (Point -> m Bool) -> m [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Int -> [Point] -> [Point]
forall a. Int -> [a] -> [a]
take Int
power [Point]
ps) ((Point -> m Bool) -> m [Bool]) -> (Point -> m Bool) -> m [Bool]
forall a b. (a -> b) -> a -> b
$ \p :: Point
p -> do
         -- Mark as summoned to prevent immediate chain summoning.
         -- Summon from current depth, not deeper due to many spawns already.
         Maybe ActorId
maid <- Bool
-> Int
-> [(GroupName ItemKind, Int)]
-> LevelId
-> Time
-> Maybe Point
-> m (Maybe ActorId)
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> Int
-> [(GroupName ItemKind, Int)]
-> LevelId
-> Time
-> Maybe Point
-> m (Maybe ActorId)
addAnyActor Bool
True 0 [(GroupName ItemKind
grp, 1)] (Actor -> LevelId
blid Actor
tb) Time
afterTime (Point -> Maybe Point
forall a. a -> Maybe a
Just Point
p)
         case Maybe ActorId
maid of
           Nothing -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False  -- suspect content; server debug elsewhere
           Just aid :: ActorId
aid -> do
             Actor
b <- (State -> Actor) -> m Actor
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
aid
             Maybe ActorId
mleader <- (State -> Maybe ActorId) -> m (Maybe ActorId)
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
b) (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 (Maybe ActorId -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ActorId
mleader) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> ActorId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> ActorId -> m ()
setFreshLeader (Actor -> FactionId
bfid Actor
b) ActorId
aid
             Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
       if [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Bool]
bs then do
         SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> ActorId -> Effect -> Int64 -> SfxAtomic
SfxEffect (Actor -> FactionId
bfid Actor
sb) ActorId
source Effect
effect 0
         UseResult -> m UseResult
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 (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 -> Point
             -> m UseResult
effectAscend :: (Effect -> m UseResult)
-> m () -> Bool -> ActorId -> ActorId -> Point -> m UseResult
effectAscend recursiveCall :: Effect -> m UseResult
recursiveCall execSfx :: m ()
execSfx up :: Bool
up source :: ActorId
source target :: ActorId
target pos :: Point
pos = do
  Actor
b1 <- (State -> Actor) -> m Actor
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 lid1 :: LevelId
lid1 = Actor -> LevelId
blid Actor
b1
  [(LevelId, Point)]
destinations <- (State -> [(LevelId, Point)]) -> m [(LevelId, Point)]
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 (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 | 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 (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 30  -- powerful teleport
     | Bool
otherwise -> do
       (lid2 :: LevelId
lid2, pos2 :: 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 (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
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
-> Maybe Time
lookupActorTime (Actor -> FactionId
bfid Actor
b1) LevelId
lid1 ActorId
target (EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
 -> Maybe Time)
-> (StateServer
    -> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time)))
-> StateServer
-> Maybe Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
sactorTime
       Maybe Time
mbtimeTraj_bOld <-
         (StateServer -> Maybe Time) -> m (Maybe Time)
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
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
-> Maybe Time
lookupActorTime (Actor -> FactionId
bfid Actor
b1) LevelId
lid1 ActorId
target (EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
 -> Maybe Time)
-> (StateServer
    -> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time)))
-> StateServer
-> Maybe Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
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 (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
         [] -> do
           m ()
switch1
           m ()
switch2
         (_, b2 :: Actor
b2) : _ -> 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 inh :: (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 (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
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
-> 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)
                                (EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
 -> Maybe Time)
-> (StateServer
    -> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time)))
-> StateServer
-> Maybe Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
sactorTime
                 Maybe Time
mbtimeTraj_inh <-
                   (StateServer -> Maybe Time) -> m (Maybe Time)
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
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
-> 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)
                                (EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
 -> Maybe Time)
-> (StateServer
    -> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time)))
-> StateServer
-> Maybe Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
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 b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ActorId, Actor) -> m ()
moveInh [(ActorId, Actor)]
inhabitants
           -- Move the actor to his destination.
           m ()
switch2
       UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp

findStairExit :: MonadStateRead m
              => FactionId -> Bool -> LevelId -> Point -> m Point
findStairExit :: FactionId -> Bool -> LevelId -> Point -> m Point
findStairExit side :: FactionId
side moveUp :: Bool
moveUp lid :: LevelId
lid pos :: Point
pos = do
  COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Faction
fact <- (State -> Faction) -> m Faction
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 (1, 0) else (-1, 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 (-1, 0) else (1, 0)
      (mvs2 :: [Vector]
mvs2, mvs1 :: [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 s :: State
s k :: Int
k p :: 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
== 0
        (_, b :: Actor
b) : _ | Actor -> Bool
bproj Actor
b -> Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 3
        (_, b :: Actor
b) : _ | 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
== 1  -- non-proj foe
        _ -> Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2  -- moving a non-projectile friend
  Int -> Point -> Bool
unocc <- (State -> Int -> Point -> Bool) -> m (Int -> Point -> Bool)
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 (\k :: Int
k -> (Point -> Bool) -> [Point] -> [Point]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> Point -> Bool
unocc Int
k) [Point]
ps) [0..3] of
    [] -> [Char] -> m Point
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> m Point) -> [Char] -> m Point
forall a b. (a -> b) -> a -> b
$ "" [Char] -> [Point] -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` [Point]
ps
    posRes :: Point
posRes : _ -> Point -> m Point
forall (m :: * -> *) a. Monad m => a -> m a
return Point
posRes

switchLevels1 :: MonadServerAtomic m => (ActorId, Actor) -> m (Maybe ActorId)
switchLevels1 :: (ActorId, Actor) -> m (Maybe ActorId)
switchLevels1 (aid :: ActorId
aid, bOld :: Actor
bOld) = do
  let side :: FactionId
side = Actor -> FactionId
bfid Actor
bOld
  Maybe ActorId
mleader <- (State -> Maybe ActorId) -> m (Maybe ActorId)
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 (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 (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.
  [(ItemId, Item)]
ais <- (State -> [(ItemId, Item)]) -> m [(ItemId, Item)]
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
$ Actor -> State -> [(ItemId, Item)]
getCarriedAssocsAndTrunk Actor
bOld
  UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Actor -> [(ItemId, Item)] -> UpdAtomic
UpdLoseActor ActorId
aid Actor
bOld [(ItemId, Item)]
ais
  Maybe ActorId -> m (Maybe ActorId)
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 :: LevelId
-> Point
-> (ActorId, Actor)
-> Maybe Time
-> Maybe Time
-> Maybe ActorId
-> m ()
switchLevels2 lidNew :: LevelId
lidNew posNew :: Point
posNew (aid :: ActorId
aid, bOld :: Actor
bOld) mbtime_bOld :: Maybe Time
mbtime_bOld mbtimeTraj_bOld :: Maybe Time
mbtimeTraj_bOld mlead :: 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 a. Show a => Bool -> a -> Bool
`blame` "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 inventory pack (as well as some organs and equipment),
  -- due to timeouts after use, e.g., for some weapons (they recharge also
  -- in the pack; 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 from stash
  -- to pack and back, to reset the timeout. An abuse is possible when recently
  -- used item is put from inventory 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 (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 (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
      shiftByDelta :: Time -> Time
shiftByDelta = (Time -> Delta Time -> Time
`timeShift` Delta Time
delta)
      computeNewTimeout :: ItemQuant -> ItemQuant
      computeNewTimeout :: ItemQuant -> ItemQuant
computeNewTimeout (k :: Int
k, it :: ItemTimer
it) = (Int
k, (Time -> Time) -> ItemTimer -> ItemTimer
forall a b. (a -> b) -> [a] -> [b]
map Time -> Time
shiftByDelta ItemTimer
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 :: LevelId
blid = LevelId
lidNew
                  , bpos :: Point
bpos = Point
posNew
                  , boldpos :: Maybe Point
boldpos = Point -> Maybe Point
forall a. a -> Maybe a
Just Point
posNew  -- new level, new direction
                  , borgan :: ItemBag
borgan = ItemBag -> ItemBag
rebaseTimeout (ItemBag -> ItemBag) -> ItemBag -> ItemBag
forall a b. (a -> b) -> a -> b
$ Actor -> ItemBag
borgan Actor
bOld
                  , beqp :: ItemBag
beqp = ItemBag -> ItemBag
rebaseTimeout (ItemBag -> ItemBag) -> ItemBag -> ItemBag
forall a b. (a -> b) -> a -> b
$ Actor -> ItemBag
beqp Actor
bOld
                  , binv :: ItemBag
binv = ItemBag -> ItemBag
rebaseTimeout (ItemBag -> ItemBag) -> ItemBag -> ItemBag
forall a b. (a -> b) -> a -> b
$ Actor -> ItemBag
binv Actor
bOld }
  [(ItemId, Item)]
ais <- (State -> [(ItemId, Item)]) -> m [(ItemId, Item)]
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
$ Actor -> State -> [(ItemId, Item)]
getCarriedAssocsAndTrunk Actor
bOld
  -- 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 (m :: * -> *) a. Monad m => a -> m a
return ())
        (\btime_bOld :: 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
$ \ser :: StateServer
ser ->
      StateServer
ser {sactorTime :: EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
sactorTime = FactionId
-> LevelId
-> ActorId
-> Time
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
updateActorTime (Actor -> FactionId
bfid Actor
bNew) LevelId
lidNew ActorId
aid
                                        (Time -> Time
shiftByDelta Time
btime_bOld)
                        (EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
 -> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time)))
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
forall a b. (a -> b) -> a -> b
$ StateServer
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
sactorTime StateServer
ser})
        Maybe Time
mbtime_bOld
  m () -> (Time -> m ()) -> Maybe Time -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
        (\btime_bOld :: 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
$ \ser :: StateServer
ser ->
      StateServer
ser {strajTime :: EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
strajTime = FactionId
-> LevelId
-> ActorId
-> Time
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
updateActorTime (Actor -> FactionId
bfid Actor
bNew) LevelId
lidNew ActorId
aid
                                       (Time -> Time
shiftByDelta Time
btime_bOld)
                       (EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
 -> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time)))
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
forall a b. (a -> b) -> a -> b
$ StateServer
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
strajTime StateServer
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 -> [(ItemId, Item)] -> UpdAtomic
UpdCreateActor ActorId
aid Actor
bNew [(ItemId, Item)]
ais
  case Maybe ActorId
mlead of
    Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Just leader :: ActorId
leader ->
      -- 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 ActorId
leader

-- ** Escape

-- | The faction leaves the dungeon.
effectEscape :: MonadServerAtomic m => m () -> ActorId -> ActorId -> m UseResult
effectEscape :: m () -> ActorId -> ActorId -> m UseResult
effectEscape execSfx :: m ()
execSfx source :: ActorId
source target :: ActorId
target = do
  -- Obvious effect, nothing announced.
  Actor
sb <- (State -> Actor) -> m Actor
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 (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 (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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud  -- basically a misfire
     | Bool -> Bool
not (Player -> Bool
fcanEscape (Player -> Bool) -> Player -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> Player
gplayer 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 (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 (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 :: m () -> Dice -> ActorId -> ActorId -> m UseResult
effectParalyze execSfx :: m ()
execSfx nDm :: Dice
nDm source :: ActorId
source target :: ActorId
target = do
  Actor
tb <- (State -> Actor) -> m Actor
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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud else  -- shortcut for speed
    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 :: m () -> Dice -> ActorId -> ActorId -> m UseResult
paralyze execSfx :: m ()
execSfx nDm :: Dice
nDm source :: ActorId
source target :: ActorId
target = do
  Actor
tb <- (State -> Actor) -> m Actor
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 (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
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 1  -- KISS, avoid special case
  EnumSet ActorId
actorStasis <- (StateServer -> EnumSet ActorId) -> m (EnumSet ActorId)
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 -> do
       Actor
sb <- (State -> Actor) -> m Actor
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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
     | Bool
otherwise -> 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
$ \ser :: StateServer
ser ->
         StateServer
ser { sactorTime :: EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
sactorTime = FactionId
-> LevelId
-> ActorId
-> Delta Time
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
ageActor (Actor -> FactionId
bfid Actor
tb) (Actor -> LevelId
blid Actor
tb) ActorId
target Delta Time
t
                            (EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
 -> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time)))
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
forall a b. (a -> b) -> a -> b
$ StateServer
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
sactorTime StateServer
ser
             , sactorStasis :: EnumSet ActorId
sactorStasis = ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.insert ActorId
target (StateServer -> EnumSet ActorId
sactorStasis StateServer
ser) }
                 -- actor's time warped, so he is in stasis,
                 -- immune to further warps
       UseResult -> m UseResult
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 :: m () -> Dice -> ActorId -> ActorId -> m UseResult
effectParalyzeInWater execSfx :: m ()
execSfx nDm :: Dice
nDm source :: ActorId
source target :: ActorId
target = do
  Actor
tb <- (State -> Actor) -> m Actor
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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud else do  -- shortcut for speed
    Skills
actorMaxSk <- (State -> Skills) -> m Skills
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 (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 :: m () -> Dice -> ActorId -> ActorId -> m UseResult
effectInsertMove execSfx :: m ()
execSfx nDm :: Dice
nDm source :: ActorId
source target :: ActorId
target = do
  Actor
tb <- (State -> Actor) -> m Actor
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 (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 (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
tb)
  EnumSet ActorId
actorStasis <- (StateServer -> EnumSet ActorId) -> m (EnumSet ActorId)
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 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 10) (-Int
power)
  if | Actor -> Bool
bproj Actor
tb -> UseResult -> m UseResult
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 (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 (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
$ \ser :: StateServer
ser ->
         StateServer
ser { sactorTime :: EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
sactorTime = FactionId
-> LevelId
-> ActorId
-> Delta Time
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
ageActor (Actor -> FactionId
bfid Actor
tb) (Actor -> LevelId
blid Actor
tb) ActorId
target Delta Time
t
                            (EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
 -> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time)))
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
forall a b. (a -> b) -> a -> b
$ StateServer
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
sactorTime StateServer
ser
             , sactorStasis :: EnumSet ActorId
sactorStasis = ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.insert ActorId
target (StateServer -> EnumSet ActorId
sactorStasis StateServer
ser) }
                 -- actor's time warped, so he is in stasis,
                 -- immune to further warps
       UseResult -> m UseResult
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 :: m () -> Dice -> ActorId -> ActorId -> m UseResult
effectTeleport execSfx :: m ()
execSfx nDm :: Dice
nDm source :: ActorId
source target :: ActorId
target = do
  Actor
sb <- (State -> Actor) -> m Actor
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 (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
actorWaits Actor
tb Bool -> Bool -> Bool
&& ActorId
source ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
target
       -- immune only against not own effects, to enable teleport as beneficial
       -- necklace drawback; also consistent with sleep not protecting
  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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
  else do
    COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
    AbsDepth
totalDepth <- (State -> AbsDepth) -> m AbsDepth
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> AbsDepth
stotalDepth
    lvl :: Level
lvl@Level{AbsDepth
ldepth :: AbsDepth
ldepth :: Level -> 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 _ = 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 200 Level
lvl
      (\p :: 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 1
      , Int -> Point -> ContentId TileKind -> Bool
dist (Int -> Point -> ContentId TileKind -> Bool)
-> Int -> Point -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
range Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 9
      , Int -> Point -> ContentId TileKind -> Bool
dist (Int -> Point -> ContentId TileKind -> Bool)
-> Int -> Point -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
range Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 7
      , Int -> Point -> ContentId TileKind -> Bool
dist (Int -> Point -> ContentId TileKind -> Bool)
-> Int -> Point -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
range Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 5
      , Int -> Point -> ContentId TileKind -> Bool
dist 5
      , Int -> Point -> ContentId TileKind -> Bool
dist 7
      , Int -> Point -> ContentId TileKind -> Bool
dist 9
      ]
    case Maybe Point
mtpos of
      Nothing -> do  -- really very rare, so debug
        Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
debugPossiblyPrint
          "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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
      Just tpos :: 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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp

-- ** CreateItem

effectCreateItem :: MonadServerAtomic m
                 => Maybe FactionId -> Maybe Int -> ActorId -> ActorId -> CStore
                 -> GroupName ItemKind -> IK.TimerDice
                 -> m UseResult
effectCreateItem :: Maybe FactionId
-> Maybe Int
-> ActorId
-> ActorId
-> CStore
-> GroupName ItemKind
-> TimerDice
-> m UseResult
effectCreateItem jfidRaw :: Maybe FactionId
jfidRaw mcount :: Maybe Int
mcount source :: ActorId
source target :: ActorId
target store :: CStore
store grp :: GroupName ItemKind
grp tim :: TimerDice
tim = do
  Actor
sb <- (State -> Actor) -> m Actor
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 (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 (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
tb)
  let fscale :: Delta Time -> Dice -> m (Delta Time)
fscale unit :: Delta Time
unit nDm :: 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
ldepth AbsDepth
totalDepth Dice
nDm
        let k :: Int
k = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 1 Int
k0  -- KISS, don't freak out if dice permit 0
        Delta Time -> m (Delta Time)
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 nDm :: Dice
nDm = do
        Skills
actorMaxSk <- (State -> Skills) -> m Skills
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
        -- A tiny bit added to make sure length 1 effect doesn't end before
        -- the end of first turn, which would make, e.g., speed, useless.
        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) 101
        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 (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 (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
  -- Power depth of new items unaffected by number of spawned actors.
  Frequency (ContentId ItemKind, ItemKind)
freq <- Int
-> LevelId
-> [(GroupName ItemKind, Int)]
-> m (Frequency (ContentId ItemKind, ItemKind))
forall (m :: * -> *).
MonadServerAtomic m =>
Int
-> LevelId
-> [(GroupName ItemKind, Int)]
-> m (Frequency (ContentId ItemKind, ItemKind))
prepareItemKind 0 (Actor -> LevelId
blid Actor
tb) [(GroupName ItemKind
grp, 1)]
  Maybe (ItemKnown, ItemFullKit)
m2 <- Frequency (ContentId ItemKind, ItemKind)
-> LevelId -> m (Maybe (ItemKnown, ItemFullKit))
forall (m :: * -> *).
MonadServerAtomic m =>
Frequency (ContentId ItemKind, ItemKind)
-> LevelId -> m (Maybe (ItemKnown, ItemFullKit))
rollItemAspect Frequency (ContentId ItemKind, ItemKind)
freq (Actor -> LevelId
blid Actor
tb)
  let (itemKnownRaw :: ItemKnown
itemKnownRaw, (itemFullRaw :: ItemFull
itemFullRaw, kitRaw :: ItemQuant
kitRaw)) =
        (ItemKnown, ItemFullKit)
-> Maybe (ItemKnown, ItemFullKit) -> (ItemKnown, ItemFullKit)
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> (ItemKnown, ItemFullKit)
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> (ItemKnown, ItemFullKit))
-> [Char] -> (ItemKnown, ItemFullKit)
forall a b. (a -> b) -> a -> b
$ "" [Char]
-> (LevelId, Frequency (ContentId ItemKind, ItemKind), Container)
-> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (Actor -> LevelId
blid Actor
tb, Frequency (ContentId ItemKind, ItemKind)
freq, Container
c)) Maybe (ItemKnown, ItemFullKit)
m2
      -- 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.
      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
== "impressed"
             then Maybe FactionId
jfidRaw
             else Maybe FactionId
forall a. Maybe a
Nothing
      (itemKnown :: ItemKnown
itemKnown, itemFull :: ItemFull
itemFull) =
        let ItemKnown kindIx :: ItemIdentity
kindIx ar :: AspectRecord
ar _ = ItemKnown
itemKnownRaw
        in ( ItemIdentity -> AspectRecord -> Maybe FactionId -> ItemKnown
ItemKnown ItemIdentity
kindIx AspectRecord
ar Maybe FactionId
jfid
           , ItemFull
itemFullRaw {itemBase :: Item
itemBase = (ItemFull -> Item
itemBase ItemFull
itemFullRaw) {Maybe FactionId
jfid :: Maybe FactionId
jfid :: Maybe FactionId
jfid}} )
      kitNew :: ItemQuant
kitNew = case Maybe Int
mcount of
        Just itemK :: Int
itemK -> (Int
itemK, [])
        Nothing -> ItemQuant
kitRaw
  ItemRev
itemRev <- (StateServer -> ItemRev) -> m ItemRev
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
        Nothing -> Maybe (ItemId, ItemQuant)
forall a. Maybe a
Nothing
        Just iid :: 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 (iid :: ItemId
iid, (_, afterIt :: ItemTimer
afterIt@(timer :: Time
timer : rest :: ItemTimer
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 :: ItemTimer
newIt = Time
timer Time -> Delta Time -> Time
`timeShift` Delta Time
delta Time -> ItemTimer -> ItemTimer
forall a. a -> [a] -> [a]
: ItemTimer
rest
      if ItemTimer
afterIt ItemTimer -> ItemTimer -> Bool
forall a. Eq a => a -> a -> Bool
/= ItemTimer
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 -> ItemTimer -> ItemTimer -> UpdAtomic
UpdTimeItem ItemId
iid Container
c ItemTimer
afterIt ItemTimer
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
$ LevelId -> ActorId -> ItemId -> CStore -> Delta Time -> SfxMsg
SfxTimerExtended (Actor -> LevelId
blid Actor
tb) 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
$ LevelId -> ActorId -> ItemId -> CStore -> Delta Time -> SfxMsg
SfxTimerExtended (Actor -> LevelId
blid Actor
tb) ActorId
target ItemId
iid CStore
store Delta Time
delta
        UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp
      else UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud  -- probably incorrect content, but let it be
    _ -> do
      -- 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 <- ItemFullKit -> ItemKnown -> Container -> Bool -> m ItemId
forall (m :: * -> *).
MonadServerAtomic m =>
ItemFullKit -> ItemKnown -> Container -> Bool -> m ItemId
registerItem (ItemFull
itemFull, ItemQuant
kitNew) ItemKnown
itemKnown Container
c Bool
True
      -- If created not on the ground, ID it, because it won't be on pickup.
      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)
      -- Now, if timer change requested, change the timer, but in the new items,
      -- possibly increased in number wrt old items.
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TimerDice -> Bool
IK.isTimerNone TimerDice
tim) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        Actor
tb2 <- (State -> Actor) -> m Actor
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
        ItemBag
bagAfter <- (State -> ItemBag) -> m ItemBag
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
tb2 CStore
store
        Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
tb)
        let newTimer :: Time
newTimer = Time
localTime Time -> Delta Time -> Time
`timeShift` Delta Time
delta
            (afterK :: Int
afterK, afterIt :: ItemTimer
afterIt) =
              ItemQuant -> Maybe ItemQuant -> ItemQuant
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> ItemQuant
forall a. (?callStack::CallStack) => [Char] -> a
error ([Char] -> ItemQuant) -> [Char] -> ItemQuant
forall a b. (a -> b) -> a -> b
$ "" [Char] -> (ItemId, ItemBag, Container) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (ItemId
iid, ItemBag
bagAfter, Container
c))
                        (ItemId
iid ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bagAfter)
            newIt :: ItemTimer
newIt = Int -> Time -> ItemTimer
forall a. Int -> a -> [a]
replicate Int
afterK Time
newTimer
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ItemTimer
afterIt ItemTimer -> ItemTimer -> Bool
forall a. Eq a => a -> a -> Bool
/= ItemTimer
newIt) (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 -> ItemTimer -> ItemTimer -> UpdAtomic
UpdTimeItem ItemId
iid Container
c ItemTimer
afterIt ItemTimer
newIt
      UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp

-- ** DropItem

-- | Make the target actor drop items in a store from the given group.
-- The item itself is immune (any copies).
effectDropItem :: MonadServerAtomic m
               => m () -> ItemId -> Int -> Int -> CStore
               -> GroupName ItemKind -> ActorId
               -> m UseResult
effectDropItem :: m ()
-> ItemId
-> Int
-> Int
-> CStore
-> GroupName ItemKind
-> ActorId
-> m UseResult
effectDropItem execSfx :: m ()
execSfx iidId :: ItemId
iidId ngroup :: Int
ngroup kcopy :: Int
kcopy store :: CStore
store grp :: GroupName ItemKind
grp target :: ActorId
target = do
  Actor
tb <- (State -> Actor) -> m Actor
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 (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 (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 (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
iidId) (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 (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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore
CEqp, CStore
CInv, CStore
CSha]
       Bool -> Bool -> Bool
&& Player -> Bool
fhasGender (Faction -> Player
gplayer 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
== 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 (Player -> Bool
fhasUI (Player -> Bool)
-> ((FactionId, Faction) -> Player) -> (FactionId, Faction) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Faction -> Player
gplayer (Faction -> Player)
-> ((FactionId, Faction) -> Faction)
-> (FactionId, Faction)
-> Player
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 (\(fi :: FactionId
fi, fa :: 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 (Player -> Bool
fhasUI (Player -> Bool)
-> ((FactionId, Faction) -> Player) -> (FactionId, Faction) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Faction -> Player
gplayer  (Faction -> Player)
-> ((FactionId, Faction) -> Faction)
-> (FactionId, Faction)
-> Player
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 (\(fi :: FactionId
fi, fa :: 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
- all consumables always end up in a pack and the whole pack
is always left behind, because consumables are not shared among
actors via shared stash (yet); we could pack consumables to stash
by default, but it's too confusing and risky for beginner players
and doesn't work for heroes that have not enough Calm ATM and AI
would still need to learn to spread consumables from stash to packs afterwards
- 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 general abilities described as desirable above
-}
       UseResult -> m UseResult
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
       ((ItemId, ItemQuant) -> m ()) -> [(ItemId, ItemQuant)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((ItemId -> ItemQuant -> m ()) -> (ItemId, ItemQuant) -> m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (Bool
-> CStore -> ActorId -> Actor -> Int -> ItemId -> ItemQuant -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> CStore -> ActorId -> Actor -> Int -> ItemId -> ItemQuant -> m ()
dropCStoreItem 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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp

-- | 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 -> CStore -> ActorId -> Actor -> Int
               -> ItemId -> ItemQuant
               -> m ()
dropCStoreItem :: Bool
-> CStore -> ActorId -> Actor -> Int -> ItemId -> ItemQuant -> m ()
dropCStoreItem verbose :: Bool
verbose store :: CStore
store aid :: ActorId
aid b :: Actor
b kMax :: Int
kMax iid :: ItemId
iid (k :: Int
k, _) = do
  itemFull :: ItemFull
itemFull@ItemFull{Item
itemBase :: Item
itemBase :: ItemFull -> Item
itemBase} <- (State -> ItemFull) -> m ItemFull
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
      c :: Container
c = ActorId -> CStore -> Container
CActor ActorId
aid CStore
store
      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 = Actor -> Bool
bproj Actor
b Bool -> Bool -> Bool
&& (Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
durable Bool -> Bool -> Bool
|| Bool
fragile)
                    Bool -> Bool -> Bool
|| Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition AspectRecord
arItem
  if Bool
isDestroyed then do
    let -- We don't know if it's voluntary, so we conservatively assume
        -- it is and we blame @aid@.
        voluntary :: Bool
voluntary = Bool
True
        onSmashOnly :: Bool
onSmashOnly = Bool
True
        useAllCopies :: Bool
useAllCopies = Int
kMax Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
k
    Bool
-> ActorId
-> Bool
-> Bool
-> Bool
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Bool
-> ItemFull
-> Bool
-> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> ActorId
-> Bool
-> Bool
-> Bool
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Bool
-> ItemFull
-> Bool
-> m ()
effectAndDestroyAndAddKill Bool
voluntary ActorId
aid Bool
onSmashOnly Bool
useAllCopies Bool
False
                               ActorId
aid ActorId
aid ItemId
iid Container
c Bool
False ItemFull
itemFull Bool
True
    -- One copy was destroyed (or none if the item was discharged),
    -- so let's mop up.
    ItemBag
bag <- (State -> ItemBag) -> m ItemBag
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 (m :: * -> *) a. Monad m => a -> m a
return ())
          (\(k1 :: Int
k1, it :: ItemTimer
it) ->
             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 -> ItemTimer -> ItemTimer
forall a. Int -> [a] -> [a]
take Int
k2 ItemTimer
it)
             in Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
k2 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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
UpdLoseItem Bool
False ItemId
iid Item
itemBase 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)
  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 b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic [UpdAtomic]
mvCmd

pickDroppable :: MonadStateRead m => Bool -> ActorId -> Actor -> m Container
pickDroppable :: Bool -> ActorId -> Actor -> m Container
pickDroppable respectNoItem :: Bool
respectNoItem aid :: ActorId
aid b :: Actor
b = do
  cops :: COps
cops@COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
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 t :: 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 (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 (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 8 [Point]
ps of
      [] -> ActorId -> CStore -> Container
CActor ActorId
aid CStore
CGround  -- fallback; still correct, though not ideal
      pos :: Point
pos : _ -> LevelId -> Point -> Container
CFloor (Actor -> LevelId
blid Actor
b) Point
pos

-- ** PolyItem

-- Can't apply to the item itself (any copies).
effectPolyItem :: MonadServerAtomic m
               => m () -> ItemId -> ActorId -> m UseResult
effectPolyItem :: m () -> ItemId -> ActorId -> m UseResult
effectPolyItem execSfx :: m ()
execSfx iidId :: ItemId
iidId target :: ActorId
target = do
  Actor
tb <- (State -> Actor) -> m Actor
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 (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
iidId) (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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
    (iid :: ItemId
iid, ( itemFull :: ItemFull
itemFull@ItemFull{Item
itemBase :: Item
itemBase :: ItemFull -> Item
itemBase, ContentId ItemKind
itemKindId :: ContentId ItemKind
itemKindId :: ItemFull -> ContentId ItemKind
itemKindId, ItemKind
itemKind :: ItemKind
itemKind :: ItemFull -> ItemKind
itemKind}
          , (itemK :: Int
itemK, itemTimer :: ItemTimer
itemTimer) )) : _ -> 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 (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
<= 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 "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 (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 (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 -> ItemTimer -> ItemTimer
forall a. Int -> [a] -> [a]
take Int
maxCount ItemTimer
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
$ ItemId -> Item -> ItemQuant -> Container -> UpdAtomic
UpdDestroyItem ItemId
iid Item
itemBase ItemQuant
kit Container
c
           Maybe FactionId
-> Maybe Int
-> ActorId
-> ActorId
-> CStore
-> GroupName ItemKind
-> TimerDice
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
Maybe FactionId
-> Maybe Int
-> ActorId
-> ActorId
-> 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 CStore
cstore "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 :: m () -> ItemId -> ActorId -> m UseResult
effectRerollItem execSfx :: m ()
execSfx iidId :: ItemId
iidId target :: ActorId
target = do
  COps{ItemSpeedup
coItemSpeedup :: COps -> ItemSpeedup
coItemSpeedup :: ItemSpeedup
coItemSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Actor
tb <- (State -> Actor) -> m Actor
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 (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
iidId) (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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
    (iid :: ItemId
iid, ( ItemFull{ Item
itemBase :: Item
itemBase :: ItemFull -> Item
itemBase, ContentId ItemKind
itemKindId :: ContentId ItemKind
itemKindId :: ItemFull -> ContentId ItemKind
itemKindId, ItemKind
itemKind :: ItemKind
itemKind :: ItemFull -> ItemKind
itemKind
                    , itemDisco :: ItemFull -> ItemDisco
itemDisco=ItemDiscoFull itemAspect :: AspectRecord
itemAspect }
          , (_, itemTimer :: ItemTimer
itemTimer) )) : _ ->
      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 -> 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 (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
               kit :: ItemQuant
kit = (1, Int -> ItemTimer -> ItemTimer
forall a. Int -> [a] -> [a]
take 1 ItemTimer
itemTimer)  -- prevent micromanagement
               freq :: Frequency (ContentId ItemKind, ItemKind)
freq = (ContentId ItemKind, ItemKind)
-> Frequency (ContentId ItemKind, ItemKind)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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
$ ItemId -> Item -> ItemQuant -> Container -> UpdAtomic
UpdDestroyItem ItemId
iid Item
itemBase ItemQuant
kit Container
c
           Dungeon
dungeon <- (State -> Dungeon) -> m Dungeon
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Dungeon
sdungeon
           let maxLid :: LevelId
maxLid = (LevelId, Level) -> LevelId
forall a b. (a, b) -> a
fst ((LevelId, Level) -> LevelId) -> (LevelId, Level) -> LevelId
forall a b. (a -> b) -> a -> b
$ ((LevelId, Level) -> (LevelId, Level) -> Ordering)
-> [(LevelId, Level)] -> (LevelId, Level)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (((LevelId, Level) -> AbsDepth)
-> (LevelId, Level) -> (LevelId, Level) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
Ord.comparing (Level -> AbsDepth
ldepth (Level -> AbsDepth)
-> ((LevelId, Level) -> Level) -> (LevelId, Level) -> AbsDepth
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LevelId, Level) -> Level
forall a b. (a, b) -> b
snd))
                            ([(LevelId, Level)] -> (LevelId, Level))
-> [(LevelId, Level)] -> (LevelId, Level)
forall a b. (a -> b) -> a -> b
$ Dungeon -> [(LevelId, Level)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs Dungeon
dungeon
               roll100 :: Int -> m (ItemKnown, ItemFullKit)
               roll100 :: Int -> m (ItemKnown, ItemFullKit)
roll100 n :: Int
n = do
                 Maybe (ItemKnown, ItemFullKit)
m2 <- Frequency (ContentId ItemKind, ItemKind)
-> LevelId -> m (Maybe (ItemKnown, ItemFullKit))
forall (m :: * -> *).
MonadServerAtomic m =>
Frequency (ContentId ItemKind, ItemKind)
-> LevelId -> m (Maybe (ItemKnown, ItemFullKit))
rollItemAspect Frequency (ContentId ItemKind, ItemKind)
freq LevelId
maxLid
                 case Maybe (ItemKnown, ItemFullKit)
m2 of
                   Nothing ->
                     [Char] -> m (ItemKnown, ItemFullKit)
forall a. (?callStack::CallStack) => [Char] -> a
error "effectRerollItem: can't create rerolled item"
                   Just i2 :: (ItemKnown, ItemFullKit)
i2@(ItemKnown _ ar2 :: AspectRecord
ar2 _, _) ->
                     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
> 0
                     then Int -> m (ItemKnown, ItemFullKit)
roll100 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1)
                     else (ItemKnown, ItemFullKit) -> m (ItemKnown, ItemFullKit)
forall (m :: * -> *) a. Monad m => a -> m a
return (ItemKnown, ItemFullKit)
i2
           (itemKnown :: ItemKnown
itemKnown, (itemFull :: ItemFull
itemFull, _)) <- Int -> m (ItemKnown, ItemFullKit)
roll100 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
$ ItemFullKit -> ItemKnown -> Container -> Bool -> m ItemId
forall (m :: * -> *).
MonadServerAtomic m =>
ItemFullKit -> ItemKnown -> Container -> Bool -> m ItemId
registerItem (ItemFull
itemFull, ItemQuant
kit) ItemKnown
itemKnown Container
c Bool
True
           UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp
    _ -> [Char] -> m UseResult
forall a. (?callStack::CallStack) => [Char] -> a
error "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 :: m () -> ItemId -> ActorId -> m UseResult
effectDupItem execSfx :: m ()
execSfx iidId :: ItemId
iidId target :: ActorId
target = do
  Actor
tb <- (State -> Actor) -> m Actor
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 (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
iidId) (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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
    (iid :: ItemId
iid, ( itemFull :: ItemFull
itemFull@ItemFull{Item
itemBase :: Item
itemBase :: ItemFull -> Item
itemBase, ContentId ItemKind
itemKindId :: ContentId ItemKind
itemKindId :: ItemFull -> ContentId ItemKind
itemKindId, ItemKind
itemKind :: ItemKind
itemKind :: ItemFull -> ItemKind
itemKind}
          , _ )) : _ -> 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 (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
> 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 "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 (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
           UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ItemId -> Item -> ItemQuant -> Container -> UpdAtomic
UpdCreateItem ItemId
iid Item
itemBase (1, []) Container
c
           UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp

-- ** Identify

effectIdentify :: MonadServerAtomic m
               => m () -> ItemId -> ActorId -> m UseResult
effectIdentify :: m () -> ItemId -> ActorId -> m UseResult
effectIdentify execSfx :: m ()
execSfx iidId :: ItemId
iidId target :: ActorId
target = do
  COps{ItemSpeedup
coItemSpeedup :: ItemSpeedup
coItemSpeedup :: COps -> ItemSpeedup
coItemSpeedup} <- (State -> COps) -> m COps
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 (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 (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 (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 store :: CStore
store as :: [(ItemId, ItemFull)]
as = case [(ItemId, ItemFull)]
as of
        [] -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        (iid :: ItemId
iid, _) : rest :: [(ItemId, ItemFull)]
rest | ItemId
iid ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
== ItemId
iidId -> CStore -> [(ItemId, ItemFull)] -> m Bool
tryFull CStore
store [(ItemId, ItemFull)]
rest  -- don't id itself
        (iid :: ItemId
iid, ItemFull{Item
itemBase :: Item
itemBase :: ItemFull -> Item
itemBase, ContentId ItemKind
itemKindId :: ContentId ItemKind
itemKindId :: ItemFull -> ContentId ItemKind
itemKindId, ItemKind
itemKind :: ItemKind
itemKind :: ItemFull -> ItemKind
itemKind}) : rest :: [(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 _ -> Bool
True
                IdentityCovered ix :: ItemKindIx
ix _ -> 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 (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      tryStore :: [CStore] -> m UseResult
tryStore stores :: [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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId  -- the message tells it's ID effect
        store :: CStore
store : rest :: [CStore]
rest -> do
          [(ItemId, ItemFull)]
allAssocs <- (State -> [(ItemId, ItemFull)]) -> m [(ItemId, ItemFull)]
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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp else [CStore] -> m UseResult
tryStore [CStore]
rest
  [CStore] -> m UseResult
tryStore [CStore
CGround, CStore
CEqp, CStore
CInv, CStore
CSha]

identifyIid :: MonadServerAtomic m
            => ItemId -> Container -> ContentId ItemKind -> ItemKind -> m ()
identifyIid :: ItemId -> Container -> ContentId ItemKind -> ItemKind -> m ()
identifyIid iid :: ItemId
iid c :: Container
c itemKindId :: ContentId ItemKind
itemKindId itemKind :: 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 (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 -> Point -> m UseResult
effectDetect :: m () -> DetectKind -> Int -> ActorId -> Point -> m UseResult
effectDetect execSfx :: m ()
execSfx d :: DetectKind
d radius :: Int
radius target :: ActorId
target pos :: Point
pos = do
  COps{ContentData ItemKind
coitem :: COps -> ContentData ItemKind
coitem :: ContentData ItemKind
coitem, TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Actor
b <- (State -> Actor) -> m Actor
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
s <- m State
forall (m :: * -> *). MonadStateRead m => m State
getState
  ItemId -> ItemKind
getKind <- (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
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 lootPredicate :: Point -> Bool
lootPredicate p :: 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
              Nothing -> Bool
False
              Just (_, body :: Actor
body) ->
                let belongings :: [ItemId]
belongings = ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (Actor -> ItemBag
beqp Actor
body) [ItemId] -> [ItemId] -> [ItemId]
forall a. [a] -> [a] -> [a]
++ ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys (Actor -> ItemBag
binv Actor
body)
                      -- shared stash ignored, because hard to get
                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 "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 iid :: 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 iid :: 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 acc :: Bool
acc _ _ itemKind :: ItemKind
itemKind = Bool
acc Bool -> Bool -> Bool
&& ItemKind -> Bool
itemKindIsLoot ItemKind
itemKind
      effectHasLoot :: Effect -> Bool
effectHasLoot (IK.CreateItem cstore :: CStore
cstore grp :: GroupName ItemKind
grp _) =
        CStore
cstore CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore
CGround, CStore
CEqp, CStore
CInv, CStore
CSha]
        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 IK.PolyItem = Bool
True
      effectHasLoot IK.RerollItem = Bool
True
      effectHasLoot IK.DupItem = Bool
True
      effectHasLoot (IK.OneOf l :: [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 eff :: Effect
eff) = Effect -> Bool
effectHasLoot Effect
eff
      effectHasLoot (IK.Composite l :: [Effect]
l) = (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Effect -> Bool
effectHasLoot [Effect]
l
      effectHasLoot _ = Bool
False
      (predicate :: Point -> Bool
predicate, action :: [Point] -> m Bool
action) = case DetectKind
d of
        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 (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
        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 (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
        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 (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
        IK.DetectExit ->
          let (ls1 :: [Point]
ls1, ls2 :: [Point]
ls2) = Level -> ([Point], [Point])
lstair Level
lvl
          in ((Point -> [Point] -> 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 (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
        IK.DetectHidden ->
          let predicateH :: Point -> Bool
predicateH p :: Point
p = TileSpeedup -> ContentId TileKind -> Bool
Tile.isHideAs TileSpeedup
coTileSpeedup (ContentId TileKind -> Bool) -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p
              revealEmbed :: Point -> m ()
revealEmbed p :: Point
p = do
                ItemBag
embeds <- (State -> ItemBag) -> m ItemBag
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
$ do
                  let ais :: [(ItemId, Item)]
ais = (ItemId -> (ItemId, Item)) -> [ItemId] -> [(ItemId, Item)]
forall a b. (a -> b) -> [a] -> [b]
map (\iid :: ItemId
iid -> (ItemId
iid, ItemId -> State -> Item
getItemBody ItemId
iid State
s))
                                (ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
embeds)
                  UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ Container -> ItemBag -> [(ItemId, Item)] -> UpdAtomic
UpdSpotItemBag (LevelId -> Point -> Container
CEmbed (Actor -> LevelId
blid Actor
b) Point
p) ItemBag
embeds [(ItemId, Item)]
ais
              actionH :: [Point] -> m Bool
actionH l :: [Point]
l = do
                let f :: Point -> m ()
f p :: 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
                        Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                        Just entry :: 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 b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Point -> m ()
f [Point]
l
                Bool -> m Bool
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  -- KISS, even if client knows all
          in (Point -> Bool
predicateH, [Point] -> m Bool
actionH)
        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 (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

effectDetectX :: MonadServerAtomic m
              => IK.DetectKind -> (Point -> Bool) -> ([Point] -> m Bool)
              -> m () -> Int -> ActorId -> m UseResult
effectDetectX :: DetectKind
-> (Point -> Bool)
-> ([Point] -> m Bool)
-> m ()
-> Int
-> ActorId
-> m UseResult
effectDetectX d :: DetectKind
d predicate :: Point -> Bool
predicate action :: [Point] -> m Bool
action execSfx :: m ()
execSfx radius :: Int
radius target :: ActorId
target = do
  COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rXmax :: RuleContent -> Int
rXmax :: Int
rXmax, Int
rYmax :: RuleContent -> Int
rYmax :: Int
rYmax}} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Actor
b <- (State -> Actor) -> m Actor
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 (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> PerFid
sperFid
  let perOld :: Perception
perOld = PerFid
sperFidOld PerFid -> FactionId -> PerLid
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b PerLid -> LevelId -> Perception
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> LevelId
blid Actor
b
      Point x0 :: Int
x0 y0 :: 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 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
rYmax Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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 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
rXmax Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) (Int
x0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
radius)]
        ]
      extraPer :: Perception
extraPer = Perception
emptyPer {psight :: PerVisible
psight = EnumSet Point -> PerVisible
PerVisible (EnumSet Point -> PerVisible) -> EnumSet Point -> PerVisible
forall a b. (a -> b) -> a -> b
$ [Point] -> EnumSet Point
forall k. Enum k => [k] -> EnumSet k
ES.fromDistinctAscList [Point]
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 = (PerLid -> PerLid) -> FactionId -> PerFid -> PerFid
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust (LevelId -> Perception -> PerLid -> PerLid
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
$ \ser :: StateServer
ser -> StateServer
ser {sperFid :: PerFid
sperFid = PerFid -> PerFid
fper (PerFid -> PerFid) -> PerFid -> PerFid
forall a b. (a -> b) -> a -> b
$ StateServer -> PerFid
sperFid StateServer
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
$ \ser :: StateServer
ser -> StateServer
ser {sperFid :: PerFid
sperFid = PerFid
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 (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 :: m ()
-> ThrowMod
-> ActorId
-> ActorId
-> Container
-> Maybe Bool
-> m UseResult
effectSendFlying execSfx :: m ()
execSfx IK.ThrowMod{..} source :: ActorId
source target :: ActorId
target c :: Container
c modePush :: Maybe Bool
modePush = do
  Vector
v <- ActorId -> ActorId -> Maybe Bool -> m Vector
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> ActorId -> Maybe Bool -> m Vector
sendFlyingVector ActorId
source ActorId
target Maybe Bool
modePush
  Actor
sb <- (State -> Actor) -> m Actor
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 (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 = 0
      fpos :: Point
fpos = Actor -> Point
bpos Actor
tb Point -> Vector -> Point
`shift` Vector
v
      isEmbed :: Bool
isEmbed = case Container
c of
        CEmbed{} -> Bool
True
        _ -> Bool
False
  if Actor -> Int64
bhp Actor
tb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0  -- avoid dragging around corpses
     Bool -> Bool -> Bool
|| Actor -> Bool
bproj Actor
tb Bool -> Bool -> Bool
&& Bool
isEmbed then  -- fyling projectiles can't slip on the floor
    UseResult -> m UseResult
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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp  -- waste it to prevent repeated throwing at immobile actors
  else do
   COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rXmax :: Int
rXmax :: RuleContent -> Int
rXmax, Int
rYmax :: Int
rYmax :: RuleContent -> Int
rYmax}} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
   case Int -> Int -> Int -> Point -> Point -> Maybe [Point]
bla Int
rXmax Int
rYmax Int
eps (Actor -> Point
bpos Actor
tb) Point
fpos of
    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] -> (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
$ "projecting from the edge of level"
                       [Char] -> (Point, Actor) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` (Point
fpos, Actor
tb)
    Just (pos :: Point
pos : rest :: [Point]
rest) -> do
      [(ItemId, ItemFull)]
weightAssocs <- (State -> [(ItemId, ItemFull)]) -> m [(ItemId, ItemFull)]
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
CInv, 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
          (trajectory :: [Vector]
trajectory, (speed :: Speed
speed, _)) =
            -- 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)
      if [Vector] -> Bool
forall a. [a] -> Bool
null [Vector]
trajectory
      then UseResult -> m UseResult
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
        -- Old and new trajectories are not added; the old one is replaced.
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (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) (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
-> 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 (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 (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
$ \ser :: StateServer
ser ->
          StateServer
ser {strajPushedBy :: EnumMap ActorId ActorId
strajPushedBy = ActorId
-> ActorId -> EnumMap ActorId ActorId -> EnumMap ActorId ActorId
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert ActorId
target ActorId
originator (EnumMap ActorId ActorId -> EnumMap ActorId ActorId)
-> EnumMap ActorId ActorId -> EnumMap ActorId ActorId
forall a b. (a -> b) -> a -> b
$ StateServer -> EnumMap ActorId ActorId
strajPushedBy StateServer
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 (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.
          let overheadTime :: Time
overheadTime = Time -> Delta Time -> Time
timeShift Time
localTime (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeClip)
          (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser ->
            StateServer
ser {strajTime :: EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
strajTime =
                   FactionId
-> LevelId
-> ActorId
-> Time
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
updateActorTime (Actor -> FactionId
bfid Actor
tb) (Actor -> LevelId
blid Actor
tb) ActorId
target Time
overheadTime
                   (EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
 -> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time)))
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
forall a b. (a -> b) -> a -> b
$ StateServer
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
strajTime StateServer
ser}
        UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp

sendFlyingVector :: MonadServerAtomic m
                 => ActorId -> ActorId -> Maybe Bool -> m Vector
sendFlyingVector :: ActorId -> ActorId -> Maybe Bool -> m Vector
sendFlyingVector source :: ActorId
source target :: ActorId
target modePush :: Maybe Bool
modePush = do
  Actor
sb <- (State -> Actor) -> m Actor
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 boldpos_sb :: Point
boldpos_sb = Point -> Maybe Point -> Point
forall a. a -> Maybe a -> a
fromMaybe (Actor -> Point
bpos Actor
sb) (Actor -> Maybe Point
boldpos Actor
sb)
  if ActorId
source ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId
target then
    if Point
boldpos_sb Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
sb 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. Random a => (a, a) -> Rnd a
randomR (-10, 10)
      [Vector] -> Rnd Vector
forall a. [a] -> Rnd a
oneOf [Int -> Int -> Vector
Vector 10 Int
z, Int -> Int -> Vector
Vector (-10) Int
z, Int -> Int -> Vector
Vector Int
z 10, Int -> Int -> Vector
Vector Int
z (-10)]
    else
      Vector -> m Vector
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector -> m Vector) -> Vector -> m Vector
forall a b. (a -> b) -> a -> b
$! Point -> Point -> Vector
vectorToFrom (Actor -> Point
bpos Actor
sb) Point
boldpos_sb
  else do
    Actor
tb <- (State -> Actor) -> m Actor
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 (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 True -> Vector
pushV
                Just False -> Vector
pullV
                Nothing | Point -> Point -> Bool
adjacent (Actor -> Point
bpos Actor
sb) (Actor -> Point
bpos Actor
tb) -> Vector
pushV
                Nothing -> Vector
pullV

-- ** DropBestWeapon

-- | Make the target actor drop his best weapon.
-- The item itself is immune (any copies).
effectDropBestWeapon :: MonadServerAtomic m
                     => m () -> ItemId -> ActorId -> m UseResult
effectDropBestWeapon :: m () -> ItemId -> ActorId -> m UseResult
effectDropBestWeapon execSfx :: m ()
execSfx iidId :: ItemId
iidId target :: ActorId
target = do
  Actor
tb <- (State -> Actor) -> m Actor
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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud else do
    Time
localTime <- (State -> Time) -> m Time
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)
    [(ItemId, ItemFullKit)]
kitAssRaw <- (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
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 kitAss :: [(ItemId, ItemFullKit)]
kitAss = ((ItemId, ItemFullKit) -> Bool)
-> [(ItemId, ItemFullKit)] -> [(ItemId, ItemFullKit)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(iid :: ItemId
iid, (i :: ItemFull
i, _)) ->
                          Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Meleeable (ItemFull -> AspectRecord
aspectRecordFull ItemFull
i)
                          Bool -> Bool -> Bool
&& ItemId
iid ItemId -> ItemId -> Bool
forall a. Eq a => a -> a -> Bool
/= ItemId
iidId) [(ItemId, ItemFullKit)]
kitAssRaw
        ignoreCharges :: Bool
ignoreCharges = Bool
True
    case Bool
-> Maybe DiscoveryBenefit
-> Time
-> [(ItemId, ItemFullKit)]
-> [(Double, (Int, (ItemId, ItemFullKit)))]
strongestMelee Bool
ignoreCharges Maybe DiscoveryBenefit
forall a. Maybe a
Nothing Time
localTime [(ItemId, ItemFullKit)]
kitAss of
      (_, (_, (iid :: ItemId
iid, _))) : _ -> do
        m ()
execSfx
        let kit :: ItemQuant
kit = Actor -> ItemBag
beqp Actor
tb ItemBag -> ItemId -> ItemQuant
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
        Bool
-> CStore -> ActorId -> Actor -> Int -> ItemId -> ItemQuant -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> CStore -> ActorId -> Actor -> Int -> ItemId -> ItemQuant -> m ()
dropCStoreItem Bool
True CStore
CEqp ActorId
target Actor
tb 1 ItemId
iid ItemQuant
kit  -- not the whole stack
        UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp
      [] ->
        UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud

-- ** ActivateInv

-- | Activate all items with the given symbol
-- in the target actor's equipment (there's no variant that activates
-- a random one, to avoid the incentive for carrying garbage).
-- Only one item of each stack is activated (and possibly consumed).
-- Won't activate the item itself (any copies).
effectActivateInv :: MonadServerAtomic m
                  => m () -> ItemId -> ActorId -> ActorId -> Char -> m UseResult
effectActivateInv :: m () -> ItemId -> ActorId -> ActorId -> Char -> m UseResult
effectActivateInv execSfx :: m ()
execSfx iidId :: ItemId
iidId source :: ActorId
source target :: ActorId
target symbol :: Char
symbol = do
  let c :: Container
c = ActorId -> CStore -> Container
CActor ActorId
target CStore
CInv
  m ()
-> ItemId
-> Char
-> Container
-> (ItemId -> ItemQuant -> m ())
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
m ()
-> ItemId
-> Char
-> Container
-> (ItemId -> ItemQuant -> m ())
-> m UseResult
effectTransformContainer m ()
execSfx ItemId
iidId Char
symbol Container
c ((ItemId -> ItemQuant -> m ()) -> m UseResult)
-> (ItemId -> ItemQuant -> m ()) -> m UseResult
forall a b. (a -> b) -> a -> b
$ \iid :: ItemId
iid _ ->
    -- We don't know if it's voluntary, so we conservatively assume it is
    -- and we blame @source@.
    Bool
-> ActorId
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Bool
-> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> ActorId
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Bool
-> m ()
kineticEffectAndDestroy Bool
True ActorId
source ActorId
target ActorId
target ItemId
iid Container
c Bool
True

effectTransformContainer :: forall m. MonadServerAtomic m
                         => m () -> ItemId -> Char -> Container
                         -> (ItemId -> ItemQuant -> m ())
                         -> m UseResult
effectTransformContainer :: m ()
-> ItemId
-> Char
-> Container
-> (ItemId -> ItemQuant -> m ())
-> m UseResult
effectTransformContainer execSfx :: m ()
execSfx iidId :: ItemId
iidId symbol :: Char
symbol c :: Container
c m :: ItemId -> ItemQuant -> m ()
m = do
  ItemId -> ItemKind
getKind <- (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
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 hasSymbol :: (ItemId, ItemQuant) -> m Bool
hasSymbol (iid :: ItemId
iid, _kit :: ItemQuant
_kit) = do
        let jsymbol :: Char
jsymbol = ItemKind -> Char
IK.isymbol (ItemKind -> Char) -> ItemKind -> Char
forall a b. (a -> b) -> a -> b
$ ItemId -> ItemKind
getKind ItemId
iid
        Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$! Char
jsymbol Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
symbol
  [(ItemId, ItemQuant)]
assocsCStore <- (State -> [(ItemId, ItemQuant)]) -> m [(ItemId, ItemQuant)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemQuant)]) -> m [(ItemId, ItemQuant)])
-> (State -> [(ItemId, ItemQuant)]) -> m [(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 -> [(ItemId, ItemQuant)])
-> (State -> ItemBag) -> State -> [(ItemId, ItemQuant)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Container -> State -> ItemBag
getContainerBag Container
c
  [(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
iidId) (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)] -> [(ItemId, ItemQuant)])
-> m [(ItemId, ItemQuant)] -> m [(ItemId, ItemQuant)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if Char
symbol Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' '
                                      then [(ItemId, ItemQuant)] -> m [(ItemId, ItemQuant)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(ItemId, ItemQuant)]
assocsCStore
                                      else ((ItemId, ItemQuant) -> m Bool)
-> [(ItemId, ItemQuant)] -> m [(ItemId, ItemQuant)]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (ItemId, ItemQuant) -> m Bool
hasSymbol [(ItemId, ItemQuant)]
assocsCStore
  if [(ItemId, ItemQuant)] -> Bool
forall a. [a] -> Bool
null [(ItemId, ItemQuant)]
is
  then UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud
  else do
    m ()
execSfx
    ((ItemId, ItemQuant) -> m ()) -> [(ItemId, ItemQuant)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((ItemId -> ItemQuant -> m ()) -> (ItemId, ItemQuant) -> m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ItemId -> ItemQuant -> m ()
m) [(ItemId, ItemQuant)]
is
    -- Even if no item produced any visible effect, rummaging through
    -- the inventory uses up the effect and produced discernible vibrations.
    UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp

-- ** ApplyPerfume

effectApplyPerfume :: MonadServerAtomic m => m () -> ActorId -> m UseResult
effectApplyPerfume :: m () -> ActorId -> m UseResult
effectApplyPerfume execSfx :: m ()
execSfx target :: ActorId
target = do
  Actor
tb <- (State -> Actor) -> m Actor
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 :: Level -> SmellMap
lsmell :: 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 p :: Point
p fromSm :: 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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp  -- even if no smell before, the perfume is noticeable

-- ** OneOf

effectOneOf :: MonadServerAtomic m
            => (IK.Effect -> m UseResult) -> [IK.Effect] -> m UseResult
effectOneOf :: (Effect -> m UseResult) -> [Effect] -> m UseResult
effectOneOf recursiveCall :: Effect -> m UseResult
recursiveCall l :: [Effect]
l = do
  let call1 :: m UseResult
call1 = do
        Effect
ef <- 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
ef
      call99 :: [m UseResult]
call99 = Int -> m UseResult -> [m UseResult]
forall a. Int -> a -> [a]
replicate 99 m UseResult
call1
      f :: m UseResult -> m UseResult -> m UseResult
f call :: m UseResult
call result :: m UseResult
result = do
        UseResult
ur <- m UseResult
call
        -- We avoid 99 calls to a fizzling effect that only prints
        -- a failure message and IDs 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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
ur
  (m UseResult -> m UseResult -> m UseResult)
-> m UseResult -> [m UseResult] -> m UseResult
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr m UseResult -> m UseResult -> m UseResult
forall (m :: * -> *).
Monad m =>
m UseResult -> m UseResult -> m UseResult
f (UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud) [m UseResult]
call99
  -- no @execSfx@, because individual effects sent them

-- ** VerbNoLonger

effectVerbNoLonger :: MonadServerAtomic m
                   => Bool -> m () -> ActorId -> m UseResult
effectVerbNoLonger :: Bool -> m () -> ActorId -> m UseResult
effectVerbNoLonger useAllCopies :: Bool
useAllCopies execSfx :: m ()
execSfx source :: ActorId
source = do
  Actor
b <- (State -> Actor) -> m Actor
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
useAllCopies  -- @UseUp@ below ensures that if all used, all destroyed
        Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
b)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$  -- no spam when projectiles activate
    m ()
execSfx  -- announce that all copies have run out (or whatever message)
  UseResult -> m UseResult
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 :: m () -> ActorId -> m UseResult
effectVerbMsg execSfx :: m ()
execSfx source :: ActorId
source = do
  Actor
b <- (State -> Actor) -> m Actor
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 (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp  -- announcing always successful and this helps
                -- to destroy the item

-- ** Composite

effectComposite :: forall m. MonadServerAtomic m
                => (IK.Effect -> m UseResult) -> [IK.Effect] -> m UseResult
effectComposite :: (Effect -> m UseResult) -> [Effect] -> m UseResult
effectComposite recursiveCall :: Effect -> m UseResult
recursiveCall l :: [Effect]
l = do
  let f :: IK.Effect -> m UseResult -> m UseResult
      f :: Effect -> m UseResult -> m UseResult
f eff :: Effect
eff result :: m UseResult
result = do
        UseResult
ur <- Effect -> m UseResult
recursiveCall Effect
eff
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (UseResult
ur UseResult -> UseResult -> Bool
forall a. Eq a => a -> a -> Bool
== UseResult
UseUp) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ m UseResult -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m UseResult
result  -- UseResult comes from the first
        UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
ur
  (Effect -> m UseResult -> m UseResult)
-> m UseResult -> [Effect] -> m UseResult
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Effect -> m UseResult -> m UseResult
f (UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud) [Effect]
l
  -- no @execSfx@, because individual effects sent them