module Game.LambdaHack.Server.HandleEffectServer
( applyItem, itemEffect, itemEffectAndDestroy, effectsSem
, dropEqpItem, armorHurtBonus
) where
import Control.Exception.Assert.Sugar
import Control.Monad
import Data.Bits (xor)
import qualified Data.EnumMap.Strict as EM
import Data.Key (mapWithKeyM_)
import Data.Maybe
import Data.Text (Text)
import qualified NLP.Miniutter.English as MU
import Game.LambdaHack.Atomic
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import qualified Game.LambdaHack.Common.Dice as Dice
import qualified Game.LambdaHack.Common.Effect as Effect
import Game.LambdaHack.Common.Faction
import qualified Game.LambdaHack.Common.Feature as F
import Game.LambdaHack.Common.Item
import Game.LambdaHack.Common.ItemDescription
import Game.LambdaHack.Common.ItemStrongest
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Msg
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.Random
import Game.LambdaHack.Common.Request
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Vector
import Game.LambdaHack.Content.ItemKind
import Game.LambdaHack.Server.CommonServer
import Game.LambdaHack.Server.ItemServer
import Game.LambdaHack.Server.MonadServer
import Game.LambdaHack.Server.PeriodicServer
import Game.LambdaHack.Server.StartServer
import Game.LambdaHack.Server.State
applyItem :: (MonadAtomic m, MonadServer m)
=> ActorId -> ItemId -> CStore -> m ()
applyItem aid iid cstore = do
itemToF <- itemToFullServer
bag <- getsState $ getActorBag aid cstore
let k = bag EM.! iid
itemFull = itemToF iid k
execSfxAtomic $ SfxActivate aid iid 1
itemEffectAndDestroy aid aid iid itemFull cstore
itemEffectAndDestroy :: (MonadAtomic m, MonadServer m)
=> ActorId -> ActorId -> ItemId -> ItemFull -> CStore
-> m ()
itemEffectAndDestroy source target iid itemFull cstore = do
let item = itemBase itemFull
durable = Effect.Durable `elem` jfeature item
periodic = isJust $ strengthFromEqpSlot Effect.EqpSlotPeriodic itemFull
c = CActor source cstore
unless (durable && periodic) $ do
when (not durable) $
execUpdAtomic $ UpdLoseItem iid item 1 c
triggered <- itemEffect source target iid itemFull False False
when (not triggered && not durable) $
execUpdAtomic $ UpdSpotItem iid item 1 c
itemEffect :: (MonadAtomic m, MonadServer m)
=> ActorId -> ActorId -> ItemId -> ItemFull -> Bool -> Bool
-> m Bool
itemEffect source target iid itemFull onSmash periodic = do
case itemDisco itemFull of
Just ItemDisco{itemKindId, itemAE=Just ItemAspectEffect{jeffects}} -> do
let effs | onSmash = strengthOnSmash itemFull
| otherwise = jeffects
triggered <- effectsSem effs source target periodic
when triggered $ do
postb <- getsState $ getActorBody source
seed <- getsServer $ (EM.! iid) . sitemSeedD
execUpdAtomic $ UpdDiscover (blid postb) (bpos postb)
iid itemKindId seed
return triggered
_ -> assert `failure` (source, target, iid, itemFull)
effectsSem :: (MonadAtomic m, MonadServer m)
=> [Effect.Effect Int] -> ActorId -> ActorId -> Bool
-> m Bool
effectsSem effects source target periodic = do
trs <- mapM (\ef -> effectSem ef source target) effects
let triggered = or trs
sb <- getsState $ getActorBody source
unless (triggered
|| null effects
|| periodic
|| bproj sb) $
execSfxAtomic $ SfxEffect (bfid sb) target $ Effect.NoEffect ""
return triggered
effectSem :: (MonadAtomic m, MonadServer m)
=> Effect.Effect Int -> ActorId -> ActorId
-> m Bool
effectSem effect source target = do
sb <- getsState $ getActorBody source
let execSfx = execSfxAtomic $ SfxEffect (bfid sb) target effect
case effect of
Effect.NoEffect _ -> return False
Effect.RefillHP p -> effectRefillHP execSfx p source target
Effect.Hurt nDm -> effectHurt nDm source target
Effect.RefillCalm p -> effectRefillCalm execSfx p target
Effect.Dominate -> effectDominate source target
Effect.Impress -> effectImpress execSfx source target
Effect.CallFriend p -> effectCallFriend p source target
Effect.Summon freqs p -> effectSummon freqs p source target
Effect.CreateItem p -> effectCreateItem p target
Effect.ApplyPerfume -> effectApplyPerfume execSfx target
Effect.Burn p -> effectBurn execSfx p source target
Effect.Ascend p -> effectAscend execSfx p source target
Effect.Escape{} -> effectEscape target
Effect.Paralyze p -> effectParalyze execSfx p target
Effect.InsertMove p -> effectInsertMove execSfx p target
Effect.DropBestWeapon -> effectDropBestWeapon execSfx target
Effect.DropEqp symbol hit -> effectDropEqp execSfx hit target symbol
Effect.SendFlying tmod ->
effectSendFlying execSfx tmod source target Nothing
Effect.PushActor tmod ->
effectSendFlying execSfx tmod source target (Just True)
Effect.PullActor tmod ->
effectSendFlying execSfx tmod source target (Just False)
Effect.Teleport p -> effectTeleport execSfx p target
Effect.PolyItem cstore -> effectPolyItem execSfx cstore target
Effect.Identify cstore -> effectIdentify execSfx cstore target
Effect.ActivateInv symbol -> effectActivateInv execSfx target symbol
Effect.Explode t -> effectExplode execSfx t target
Effect.OneOf l -> effectOneOf l source target
Effect.OnSmash _ -> return False
Effect.TimedAspect{} -> return False
effectRefillHP :: (MonadAtomic m, MonadServer m)
=> m () -> Int -> ActorId -> ActorId -> m Bool
effectRefillHP execSfx power source target = do
tb <- getsState $ getActorBody target
hpMax <- sumOrganEqpServer Effect.EqpSlotAddMaxHP target
let deltaHP = min (xM power) (max 0 $ xM hpMax bhp tb)
if deltaHP == 0
then return False
else do
execUpdAtomic $ UpdRefillHP target deltaHP
when (deltaHP < 0 && source /= target && not (bproj tb)) $
halveCalm target
execSfx
return True
halveCalm :: (MonadAtomic m, MonadServer m)
=> ActorId -> m ()
halveCalm target = do
tb <- getsState $ getActorBody target
activeItems <- activeItemsServer target
let calmMax = sumSlotNoFilter Effect.EqpSlotAddMaxCalm activeItems
calmUpperBound = if hpTooLow tb activeItems
then 0
else xM calmMax `div` 2
deltaCalm = min minusTwoM (calmUpperBound bcalm tb)
execUpdAtomic $ UpdRefillCalm target deltaCalm
effectHurt :: (MonadAtomic m, MonadServer m)
=> Dice.Dice -> ActorId -> ActorId
-> m Bool
effectHurt nDm source target = do
sb <- getsState $ getActorBody source
tb <- getsState $ getActorBody target
n <- rndToAction $ castDice (AbsDepth 0) (AbsDepth 0) nDm
hurtBonus <- armorHurtBonus source target
let block = braced tb
mult = (100 + hurtBonus) * (if block then 50 else 100)
deltaHP = (max oneM
$ fromIntegral mult * xM n `divUp` (100 * 100))
deltaDiv = fromIntegral $ deltaHP `divUp` oneM
execUpdAtomic $ UpdRefillHP target deltaHP
when (source /= target && not (bproj tb)) $ halveCalm target
execSfxAtomic $ SfxEffect (bfid sb) target $
if source == target
then Effect.RefillHP deltaDiv
else Effect.Hurt (Dice.intToDice deltaDiv)
return True
armorHurtBonus :: (MonadAtomic m, MonadServer m)
=> ActorId -> ActorId
-> m Int
armorHurtBonus source target = do
sactiveItems <- activeItemsServer source
tactiveItems <- activeItemsServer target
sb <- getsState $ getActorBody source
return $! if bproj sb
then sumSlotNoFilter Effect.EqpSlotAddHurtRanged sactiveItems
sumSlotNoFilter Effect.EqpSlotAddArmorRanged tactiveItems
else sumSlotNoFilter Effect.EqpSlotAddHurtMelee sactiveItems
sumSlotNoFilter Effect.EqpSlotAddArmorMelee tactiveItems
effectRefillCalm :: (MonadAtomic m, MonadServer m)
=> m () -> Int -> ActorId -> m Bool
effectRefillCalm execSfx power target = do
tb <- getsState $ getActorBody target
calmMax <- sumOrganEqpServer Effect.EqpSlotAddMaxCalm target
let deltaCalm = min (xM power) (max 0 $ xM calmMax bcalm tb)
if deltaCalm == 0
then return False
else do
execUpdAtomic $ UpdRefillCalm target deltaCalm
execSfx
return True
effectDominate :: (MonadAtomic m, MonadServer m)
=> ActorId -> ActorId -> m Bool
effectDominate source target = do
sb <- getsState $ getActorBody source
tb <- getsState $ getActorBody target
if bproj tb then
return False
else if bfid tb == bfid sb then
effectSem Effect.Impress source target
else
dominateFidSfx (bfid sb) target
effectImpress :: (MonadAtomic m, MonadServer m)
=> m () -> ActorId -> ActorId -> m Bool
effectImpress execSfx source target = do
sb <- getsState $ getActorBody source
tb <- getsState $ getActorBody target
if boldfid tb == bfid sb || bproj tb then
return False
else do
execSfx
execUpdAtomic $ UpdOldFidActor target (boldfid tb) (bfid sb)
return True
effectCallFriend :: (MonadAtomic m, MonadServer m)
=> Int -> ActorId -> ActorId
-> m Bool
effectCallFriend power source target = assert (power > 0) $ do
Kind.COps{cotile} <- getsState scops
sb <- getsState $ getActorBody source
activeItems <- activeItemsServer source
let legal = source == target
&& hpEnough sb activeItems
&& bhp sb >= xM 10
if not legal then return False
else do
let hpMax = max 1 $ sumSlotNoFilter Effect.EqpSlotAddMaxHP activeItems
deltaHP = xM hpMax `div` 3
execUpdAtomic $ UpdRefillHP source deltaHP
let validTile t = not $ Tile.hasFeature cotile F.NoActor t
lid = blid sb
ps <- getsState $ nearbyFreePoints validTile (bpos sb) lid
time <- getsState $ getLocalTime lid
recruitActors (take power ps) lid time (bfid sb)
effectSummon :: (MonadAtomic m, MonadServer m)
=> Freqs -> Int -> ActorId -> ActorId -> m Bool
effectSummon actorFreq power source target = assert (power > 0) $ do
Kind.COps{cotile} <- getsState scops
sb <- getsState $ getActorBody source
activeItems <- activeItemsServer source
let legal = source == target
&& (bproj sb
|| calmEnough sb activeItems
&& bcalm sb >= xM 10)
if not legal then return False
else do
let calmMax = max 1 $ sumSlotNoFilter Effect.EqpSlotAddMaxCalm activeItems
deltaCalm = xM calmMax `div` 3
unless (bproj sb) $ execUpdAtomic $ UpdRefillCalm source deltaCalm
let validTile t = not $ Tile.hasFeature cotile F.NoActor t
ps <- getsState $ nearbyFreePoints validTile (bpos sb) (blid sb)
localTime <- getsState $ getLocalTime (blid sb)
let sourceTime = timeShift localTime $ ticksPerMeter $ bspeed sb activeItems
afterTime = timeShift sourceTime $ Delta timeClip
bs <- forM (take power ps) $ \p -> do
maid <- addAnyActor actorFreq (blid sb) afterTime (Just p)
case maid of
Nothing ->
effectSem (Effect.CallFriend 1) source target
Just aid -> do
b <- getsState $ getActorBody aid
mleader <- getsState $ gleader . (EM.! bfid b) . sfactionD
when (isNothing mleader) $
execUpdAtomic $ UpdLeadFaction (bfid b) Nothing (Just aid)
return True
return $! or bs
effectCreateItem :: (MonadAtomic m, MonadServer m)
=> Int -> ActorId -> m Bool
effectCreateItem power target = assert (power > 0) $ do
tb <- getsState $ getActorBody target
void $ createItems power (bpos tb) (blid tb)
return True
effectApplyPerfume :: (MonadAtomic m, MonadServer m)
=> m () -> ActorId -> m Bool
effectApplyPerfume execSfx target = do
tb <- getsState $ getActorBody target
Level{lsmell} <- getLevel $ blid tb
let f p fromSm =
execUpdAtomic $ UpdAlterSmell (blid tb) p (Just fromSm) Nothing
mapWithKeyM_ f lsmell
execSfx
return True
effectBurn :: (MonadAtomic m, MonadServer m)
=> m () -> Int -> ActorId -> ActorId
-> m Bool
effectBurn execSfx power source target = do
void $ effectHurt (Dice.intToDice $ 2 * power) source target
execSfx
return True
effectAscend :: (MonadAtomic m, MonadServer m)
=> m () -> Int -> ActorId -> ActorId -> m Bool
effectAscend execSfx k source aid = do
b1 <- getsState $ getActorBody aid
ais1 <- getsState $ getCarriedAssocs b1
let lid1 = blid b1
pos1 = bpos b1
(lid2, pos2) <- getsState $ whereTo lid1 pos1 k . sdungeon
if lid2 == lid1 && pos2 == pos1 then do
execSfxAtomic $ SfxMsgFid (bfid b1) "No more levels in this direction."
let effect = Effect.Teleport 30
effectSem effect source aid
else do
let switch1 = void $ switchLevels1 ((aid, b1), ais1)
switch2 = do
let mlead = Just aid
switchLevels2 lid2 pos2 ((aid, b1), ais1) mlead
!_ <- getsState $ posToActors pos1 lid1
!_ <- getsState $ posToActors pos2 lid2
return ()
inhabitants <- getsState $ posToActors pos2 lid2
case inhabitants of
[] -> do
switch1
switch2
((_, b2), _) : _ -> do
let subjects = map (partActor . snd . fst) inhabitants
subject = MU.WWandW subjects
verb = "be pushed to another level"
msg2 = makeSentence [MU.SubjectVerbSg subject verb]
execSfxAtomic $ SfxMsgFid (bfid b2) msg2
switch1
let moveInh inh = do
inhMLead <- switchLevels1 inh
switchLevels2 lid1 pos1 inh inhMLead
mapM_ moveInh inhabitants
switch2
execSfx
return True
switchLevels1 :: MonadAtomic m
=> ((ActorId, Actor), [(ItemId, Item)]) -> m (Maybe ActorId)
switchLevels1 ((aid, bOld), ais) = do
let side = bfid bOld
mleader <- getsState $ gleader . (EM.! side) . sfactionD
mlead <-
if not (bproj bOld) && isJust mleader then do
execUpdAtomic $ UpdLeadFaction side mleader Nothing
return mleader
else return Nothing
execUpdAtomic $ UpdLoseActor aid bOld ais
return mlead
switchLevels2 :: MonadAtomic m
=> LevelId -> Point
-> ((ActorId, Actor), [(ItemId, Item)]) -> Maybe ActorId
-> m ()
switchLevels2 lidNew posNew ((aid, bOld), ais) mlead = do
let lidOld = blid bOld
side = bfid bOld
assert (lidNew /= lidOld `blame` "stairs looped" `twith` lidNew) skip
timeOld <- getsState $ getLocalTime lidOld
timeLastVisited <- getsState $ getLocalTime lidNew
let delta = btime bOld `timeDeltaToFrom` timeOld
bNew = bOld { blid = lidNew
, btime = timeShift timeLastVisited delta
, bpos = posNew
, boldpos = posNew
, boldlid = lidOld }
execUpdAtomic $ UpdCreateActor aid bNew ais
when (isJust mlead) $ execUpdAtomic $ UpdLeadFaction side Nothing mlead
effectEscape :: (MonadAtomic m, MonadServer m) => ActorId -> m Bool
effectEscape target = do
b <- getsState $ getActorBody target
let fid = bfid b
fact <- getsState $ (EM.! fid) . sfactionD
if not (keepArenaFact fact) || bproj b then
return False
else do
deduceQuits b $ Status Escape (fromEnum $ blid b) ""
return True
effectParalyze :: (MonadAtomic m, MonadServer m)
=> m () -> Int -> ActorId -> m Bool
effectParalyze execSfx p target = assert (p > 0) $ do
b <- getsState $ getActorBody target
if bproj b || bhp b <= 0
then return False
else do
let t = timeDeltaScale (Delta timeClip) p
execUpdAtomic $ UpdAgeActor target t
execSfx
return True
effectInsertMove :: (MonadAtomic m, MonadServer m)
=> m () -> Int -> ActorId -> m Bool
effectInsertMove execSfx p target = assert (p > 0) $ do
b <- getsState $ getActorBody target
activeItems <- activeItemsServer target
let tpm = ticksPerMeter $ bspeed b activeItems
t = timeDeltaScale tpm (p)
execUpdAtomic $ UpdAgeActor target t
execSfx
return True
effectDropBestWeapon :: (MonadAtomic m, MonadServer m)
=> m () -> ActorId -> m Bool
effectDropBestWeapon execSfx target = do
allAssocs <- fullAssocsServer target [CEqp]
case strongestSlotNoFilter Effect.EqpSlotWeapon allAssocs of
(_, (iid, _)) : _ -> do
b <- getsState $ getActorBody target
let k = beqp b EM.! iid
dropEqpItem target b False iid k
execSfx
return True
[] ->
return False
dropEqpItem :: (MonadAtomic m, MonadServer m)
=> ActorId -> Actor -> Bool -> ItemId -> Int -> m ()
dropEqpItem aid b hit iid k = do
item <- getsState $ getItemBody iid
itemToF <- itemToFullServer
let container = CActor aid CEqp
fragile = Effect.Fragile `elem` jfeature item
durable = Effect.Durable `elem` jfeature item
isDestroyed = hit && not durable || bproj b && fragile
itemFull = itemToF iid k
if isDestroyed then do
execUpdAtomic $ UpdLoseItem iid item k container
void $ itemEffect aid aid iid itemFull True False
else do
mvCmd <- generalMoveItem iid k (CActor aid CEqp)
(CActor aid CGround)
mapM_ execUpdAtomic mvCmd
effectDropEqp :: (MonadAtomic m, MonadServer m)
=> m () -> Bool -> ActorId -> Char -> m Bool
effectDropEqp execSfx hit target symbol = do
b <- getsState $ getActorBody target
effectTransformEqp execSfx target symbol CEqp $
dropEqpItem target b hit
effectTransformEqp :: forall m. (MonadAtomic m, MonadServer m)
=> m () -> ActorId -> Char -> CStore
-> (ItemId -> Int -> m ())
-> m Bool
effectTransformEqp execSfx target symbol cstore m = do
let hasSymbol (iid, _) = do
item <- getsState $ getItemBody iid
return $! jsymbol item == symbol
assocsCStore <- getsState $ EM.assocs . getActorBag target cstore
is <- if symbol == ' '
then return assocsCStore
else filterM hasSymbol assocsCStore
if null is
then return False
else do
mapM_ (uncurry m) is
execSfx
return True
effectSendFlying :: (MonadAtomic m, MonadServer m)
=> m () -> Effect.ThrowMod
-> ActorId -> ActorId -> Maybe Bool
-> m Bool
effectSendFlying execSfx Effect.ThrowMod{..} source target modePush = do
v <- sendFlyingVector source target modePush
Kind.COps{cotile} <- getsState scops
tb <- getsState $ getActorBody target
lvl@Level{lxsize, lysize} <- getLevel (blid tb)
let eps = 0
fpos = bpos tb `shift` v
case bla lxsize lysize eps (bpos tb) fpos of
Nothing -> assert `failure` (fpos, tb)
Just [] -> assert `failure` "projecting from the edge of level"
`twith` (fpos, tb)
Just (pos : rest) -> do
let t = lvl `at` pos
if not $ Tile.isWalkable cotile t
then return False
else do
weightAssocs <- fullAssocsServer target [CInv, CEqp, COrgan]
let weight = sum $ map (jweight . itemBase . snd) weightAssocs
path = bpos tb : pos : rest
(trajectory, (speed, _)) =
computeTrajectory weight throwVelocity throwLinger path
ts = Just (trajectory, speed)
unless (btrajectory tb == ts) $
execUpdAtomic $ UpdTrajectory target (btrajectory tb) ts
execSfx
return True
sendFlyingVector :: (MonadAtomic m, MonadServer m)
=> ActorId -> ActorId -> Maybe Bool -> m Vector
sendFlyingVector source target modePush = do
sb <- getsState $ getActorBody source
if source == target then do
if boldpos sb == bpos sb then rndToAction $ do
z <- randomR (10, 10)
oneOf [Vector 10 z, Vector (10) z, Vector z 10, Vector z (10)]
else
return $! vectorToFrom (bpos sb) (boldpos sb)
else do
tb <- getsState $ getActorBody target
let (sp, tp) = if adjacent (bpos sb) (bpos tb)
then let pos = if chessDist (boldpos sb) (bpos tb)
> chessDist (bpos sb) (bpos tb)
then boldpos sb
else bpos sb
in (pos, bpos tb)
else (bpos sb, bpos tb)
pushV = vectorToFrom tp sp
pullV = vectorToFrom sp tp
return $! case modePush of
Just True -> pushV
Just False -> pullV
Nothing | adjacent (bpos sb) (bpos tb) -> pushV
Nothing -> pullV
effectTeleport :: (MonadAtomic m, MonadServer m)
=> m () -> Int -> ActorId -> m Bool
effectTeleport execSfx range target = do
Kind.COps{cotile} <- getsState scops
b <- getsState $ getActorBody target
Level{ltile} <- getLevel (blid b)
as <- getsState $ actorList (const True) (blid b)
let spos = bpos b
dMinMax delta pos =
let d = chessDist spos pos
in d >= range delta && d <= range + delta
dist delta pos _ = dMinMax delta pos
tpos <- rndToAction $ findPosTry 200 ltile
(\p t -> Tile.isWalkable cotile t
&& (not (dMinMax 9 p)
|| not (Tile.hasFeature cotile F.NoActor t)
&& unoccupied as p))
[ dist $ 1
, dist $ 1 + range `div` 9
, dist $ 1 + range `div` 7
, dist $ 1 + range `div` 5
, dist $ 5
, dist $ 7
]
if not (dMinMax 9 tpos) then
return False
else do
execUpdAtomic $ UpdMoveActor target spos tpos
execSfx
return True
effectPolyItem :: (MonadAtomic m, MonadServer m)
=> m () -> CStore -> ActorId -> m Bool
effectPolyItem execSfx cstore target = do
allAssocs <- fullAssocsServer target [cstore]
case allAssocs of
[] -> return False
(iid, itemFull@ItemFull{..}) : _ -> case itemDisco of
Just ItemDisco{itemKind} -> do
let maxCount = Dice.maxDice $ icount itemKind
if itemK >= maxCount
then do
let c = CActor target cstore
execUpdAtomic $ UpdDestroyItem iid itemBase maxCount c
execSfx
effectCreateItem 1 target
else do
tb <- getsState $ getActorBody target
execSfxAtomic $ SfxMsgFid (bfid tb) $
"The purpose is served by" <+> tshow maxCount
<+> "pieces of this item, not by" <+> tshow itemK <> "."
return False
_ -> assert `failure` (cstore, target, iid, itemFull)
effectIdentify :: (MonadAtomic m, MonadServer m)
=> m () -> CStore -> ActorId -> m Bool
effectIdentify execSfx cstore target = do
allAssocs <- fullAssocsServer target [cstore]
case allAssocs of
[] -> return False
(iid, itemFull@ItemFull{..}) : _ -> case itemDisco of
Just ItemDisco{..} -> do
let ided = Effect.Identified `elem` ifeature itemKind
itemSecret = itemNoAE itemFull
statsObvious = textAllAE False cstore itemFull
== textAllAE False cstore itemSecret
if ided && statsObvious
then return False
else do
execSfx
tb <- getsState $ getActorBody target
seed <- getsServer $ (EM.! iid) . sitemSeedD
execUpdAtomic $ UpdDiscover (blid tb) (bpos tb) iid itemKindId seed
return True
_ -> assert `failure` (cstore, target, iid, itemFull)
effectActivateInv :: (MonadAtomic m, MonadServer m)
=> m () -> ActorId -> Char -> m Bool
effectActivateInv execSfx target symbol = do
effectTransformEqp execSfx target symbol CInv $ \iid _ ->
applyItem target iid CInv
effectExplode :: (MonadAtomic m, MonadServer m)
=> m () -> Text -> ActorId -> m Bool
effectExplode execSfx cgroup target = do
tb <- getsState $ getActorBody target
let itemFreq = [(cgroup, 1)]
container = CActor target CEqp
m2 <- rollAndRegisterItem (blid tb) itemFreq container False
let (iid, (ItemFull{..}, _)) = fromMaybe (assert `failure` cgroup) m2
Point x y = bpos tb
projectN k100 n = do
let fuzz = 2 + (k100 `xor` (itemK * n)) `mod` 9
k = if itemK >= 8 && n < 8 then 0
else if n < 8 && n >= 4 then 4 else n
ps = take k $
[ Point (x 12) $ y + fuzz
, Point (x 12) $ y fuzz
, Point (x + 12) $ y + fuzz
, Point (x + 12) $ y fuzz
, flip Point (y 12) $ x + fuzz
, flip Point (y 12) $ x fuzz
, flip Point (y + 12) $ x + fuzz
, flip Point (y + 12) $ x fuzz
]
forM_ ps $ \tpxy -> do
let req = ReqProject tpxy k100 iid CEqp
mfail <- projectFail target tpxy k100 iid CEqp True
case mfail of
Nothing -> return ()
Just ProjectBlockTerrain -> return ()
Just ProjectBlockActor | not $ bproj tb -> return ()
Just failMsg -> execFailure target req failMsg
forM_ [101..201] $ \k100 -> do
bag2 <- getsState $ beqp . getActorBody target
let mn2 = EM.lookup iid bag2
maybe skip (projectN k100) mn2
bag3 <- getsState $ beqp . getActorBody target
let mn3 = EM.lookup iid bag3
maybe skip (\k -> execUpdAtomic
$ UpdLoseItem iid itemBase k container) mn3
execSfx
return True
effectOneOf :: (MonadAtomic m, MonadServer m)
=> [Effect.Effect Int] -> ActorId -> ActorId -> m Bool
effectOneOf l source target = do
ef <- rndToAction $ oneOf l
effectSem ef source target