{-# LANGUAGE TupleSections #-}
module Game.LambdaHack.Server.HandleEffectM
( applyItem, kineticEffectAndDestroy, effectAndDestroyAndAddKill
, itemEffectEmbedded, highestImpression, dominateFidSfx
, dropAllItems, pickDroppable
#ifdef EXPOSE_INTERNAL
, 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
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
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
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
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
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 =
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 ->
Int64
tenthM
| 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
$
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
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
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
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)
ActorId -> Int64 -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Int64 -> m ()
updateCalm ActorId
target Int64
deltaCalm
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
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
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
kineticPerformed
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
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
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
else Time
localTime Time -> ItemTimer -> ItemTimer
forall a. a -> [a] -> [a]
: ItemTimer
it1
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)) ()
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
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
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
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
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
Bool -> Bool -> Bool
|| Bool
periodic
Bool -> Bool -> Bool
|| Actor -> Bool
bproj Actor
sb
) (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
else SfxMsg
SfxNothingHappens
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)
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
let c :: Container
c = LevelId -> Point -> Container
CEmbed LevelId
lid Point
tpos
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
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
_ -> [UseResult] -> UseResult
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [UseResult]
urs
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
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
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
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
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
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
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
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)]
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
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
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)
([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)
([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
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
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
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 ()
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
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
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
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
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
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 =
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 ->
Int64
tenthM
| 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
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
| 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
Just (hiImpressionFid :: FactionId
hiImpressionFid, hiImpressionK :: Int
hiImpressionK) ->
FactionId
hiImpressionFid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> FactionId
bfid Actor
sb
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)
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) ()
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 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
FactionId -> ActorId -> ActorId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> ActorId -> ActorId -> m ()
dominateFid FactionId
fid ActorId
source ActorId
target
m ()
execSfx
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
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
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
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
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
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
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
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
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
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 ->
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
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
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
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
| 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
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 ()
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
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
UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud
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
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
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
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
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
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
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)
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
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
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
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
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
Effect -> m UseResult
recursiveCall (Effect -> m UseResult) -> Effect -> m UseResult
forall a b. (a -> b) -> a -> b
$ Dice -> Effect
IK.Teleport 30
| 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
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
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
[(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
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
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
m ()
switch1
let moveInh :: (ActorId, Actor) -> m ()
moveInh inh :: (ActorId, Actor)
inh = do
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
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
_ -> Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2
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
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
else Maybe ActorId -> m (Maybe ActorId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ActorId
forall a. Maybe a
Nothing
[(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) ()
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
, 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
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
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 ->
FactionId -> ActorId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> ActorId -> m ()
setFreshLeader FactionId
side ActorId
leader
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
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
| 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
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
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
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
(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) }
UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp
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
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
else
UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseId
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
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
| 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
(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) }
UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp
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
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
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
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
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
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
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
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
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
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
_ -> do
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
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)
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
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)
Bool -> Bool -> Bool
&& (Challenge -> Int
cdiff Challenge
curChalSer Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1
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))) ->
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
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
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
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
[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
pos :: Point
pos : _ -> LevelId -> Point -> Container
CFloor (Actor -> LevelId
blid Actor
b) Point
pos
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
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
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
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
[(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
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)
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"
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
[(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
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
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
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
(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
Bool -> Bool -> Bool
|| ItemKind -> Bool
IA.isHumanTrinket ItemKind
itemKind
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
Bool -> Bool -> Bool
|| KindMean -> Bool
IA.kmConst (ContentId ItemKind -> ItemSpeedup -> KindMean
getKindMean ContentId ItemKind
itemKindId ItemSpeedup
coItemSpeedup)
Bool -> Bool -> Bool
&& Bool
kindIsKnown
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
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
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)
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
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
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
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
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
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
Bool -> Bool -> Bool
|| Actor -> Bool
bproj Actor
tb Bool -> Bool -> Bool
&& Bool
isEmbed then
UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseDud
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
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, _)) =
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
else do
m ()
execSfx
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
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}
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
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 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
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
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
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 _ ->
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
UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp
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
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
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
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
Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
b)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
m ()
execSfx
UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp
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
UseResult -> m UseResult
forall (m :: * -> *) a. Monad m => a -> m a
return UseResult
UseUp
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 -> 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