{-# LANGUAGE TupleSections #-} -- | Handle effects. They are most often caused by requests sent by clients -- but sometimes also caused by projectiles or periodically activated items. module Game.LambdaHack.Server.HandleEffectM ( applyItem, meleeEffectAndDestroy, effectAndDestroy, itemEffectEmbedded , dropCStoreItem, highestImpression, dominateFidSfx, pickDroppable , refillHP, cutCalm #ifdef EXPOSE_INTERNAL -- * Internal operations , UseResult(..) , applyMeleeDamage, imperishableKit, itemEffectDisco, effectSem , effectBurn, effectExplode, effectRefillHP, effectRefillCalm , effectDominate, dominateFid, effectImpress, effectSummon , effectAscend, findStairExit, switchLevels1, switchLevels2, effectEscape , effectParalyze, effectInsertMove, effectTeleport, effectCreateItem , effectDropItem, allGroupItems, effectPolyItem, effectIdentify, identifyIid , effectDetect, effectDetectX , effectSendFlying, sendFlyingVector, effectDropBestWeapon , effectActivateInv, effectTransformContainer, effectApplyPerfume, effectOneOf , effectRecharging, effectTemporary, effectComposite #endif ) where import Prelude () import Game.LambdaHack.Common.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 Game.LambdaHack.Atomic import Game.LambdaHack.Client import Game.LambdaHack.Common.Actor import Game.LambdaHack.Common.ActorState import qualified Game.LambdaHack.Common.Dice as Dice 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.Random 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.Vector import Game.LambdaHack.Content.ItemKind (ItemKind) import qualified Game.LambdaHack.Content.ItemKind as IK import Game.LambdaHack.Content.ModeKind import Game.LambdaHack.Server.CommonM import Game.LambdaHack.Server.ItemM import Game.LambdaHack.Server.MonadServer import Game.LambdaHack.Server.PeriodicM import Game.LambdaHack.Server.ServerOptions import Game.LambdaHack.Server.State -- * Semantics of effects data UseResult = UseDud | UseId | UseUp deriving (Eq, Ord) applyItem :: MonadServerAtomic m => ActorId -> ItemId -> CStore -> m () applyItem aid iid cstore = do execSfxAtomic $ SfxApply aid iid cstore let c = CActor aid cstore meleeEffectAndDestroy aid aid iid c applyMeleeDamage :: MonadServerAtomic m => ActorId -> ActorId -> ItemId -> m Bool applyMeleeDamage source target iid = do itemKind <- getsState $ getIidKindServer iid if IK.idamage itemKind == 0 then return False else do -- speedup sb <- getsState $ getActorBody source hurtMult <- getsState $ armorHurtBonus source target totalDepth <- getsState stotalDepth Level{ldepth} <- getLevel (blid sb) dmg <- rndToAction $ castDice ldepth totalDepth $ IK.idamage itemKind let rawDeltaHP = fromIntegral hurtMult * xM dmg `divUp` 100 speedDeltaHP = case btrajectory sb of Just (_, speed) -> - modifyDamageBySpeed rawDeltaHP speed Nothing -> - rawDeltaHP if speedDeltaHP < 0 then do -- damage the target, never heal refillHP source target speedDeltaHP return True else return False refillHP :: MonadServerAtomic m => ActorId -> ActorId -> Int64 -> m () refillHP source target speedDeltaHP = assert (speedDeltaHP /= 0) $ do tbOld <- getsState $ getActorBody target ar <- getsState $ getActorAspect target -- We ignore light poison, tiny blasts and similar -1HP per turn annoyances. let serious = speedDeltaHP < minusM && source /= target && not (bproj tbOld) hpMax = IA.aMaxHP ar deltaHP0 | serious = -- if overfull, at least cut back to max min speedDeltaHP (xM hpMax - bhp tbOld) | otherwise = speedDeltaHP deltaHP = if | deltaHP0 > 0 && bhp tbOld > xM 999 -> -- UI limit tenthM -- avoid nop, to avoid loops | deltaHP0 < 0 && bhp tbOld < - xM 999 -> -tenthM | otherwise -> deltaHP0 execUpdAtomic $ UpdRefillHP target deltaHP when serious $ cutCalm target -- If leader just lost all HP, change the leader to let players rescue him, -- especially if he's slowed by the attackers. tb <- getsState $ getActorBody target when (bhp tb <= 0 && bhp tbOld > 0) $ do mleader <- getsState $ gleader . (EM.! bfid tb) . sfactionD when (Just target == mleader) $ do actorD <- getsState sactorD let ours (_, b) = bfid b == bfid tb && not (bproj b) && bhp b > 0 -- Only consider actors with positive HP. positive = filter ours $ EM.assocs actorD onLevel <- getsState $ fidActorRegularIds (bfid tb) (blid tb) case onLevel ++ map fst positive of [] -> return () aid : _ -> execUpdAtomic $ UpdLeadFaction (bfid tb) mleader $ Just aid -- Here melee damage is applied. This is necessary so that the same -- AI benefit calculation may be used for flinging and for applying items. meleeEffectAndDestroy :: MonadServerAtomic m => ActorId -> ActorId -> ItemId -> Container -> m () meleeEffectAndDestroy source target iid c = do meleePerformed <- applyMeleeDamage source target iid bag <- getsState $ getContainerBag c case iid `EM.lookup` bag of Nothing -> error $ "" `showFailure` (source, target, iid, c) Just kit -> do itemFull <- getsState $ itemToFull iid let IK.ItemKind{IK.ieffects} = itemKind itemFull effectAndDestroy meleePerformed source target iid c False ieffects (itemFull, kit) effectAndDestroy :: MonadServerAtomic m => Bool -> ActorId -> ActorId -> ItemId -> Container -> Bool -> [IK.Effect] -> ItemFullKit -> m () effectAndDestroy meleePerformed _ _ iid container periodic [] (itemFull@ItemFull{itemBase}, kit@(_, itemTimer)) = -- No identification occurs if effects are null. This case is also a speedup. if meleePerformed then do -- melee may cause item destruction let (imperishable, kit2) = imperishableKit True periodic itemTimer itemFull kit unless imperishable $ execUpdAtomic $ UpdLoseItem False iid itemBase kit2 container else return () effectAndDestroy meleePerformed source target iid container periodic effs ( itemFull@ItemFull{itemBase, itemDisco, itemKind} , kit@(itemK, itemTimer) ) = do let timeout = IA.aTimeout $ itemAspect itemDisco permanent = let tmpEffect :: IK.Effect -> Bool tmpEffect IK.Temporary{} = True tmpEffect (IK.Recharging IK.Temporary{}) = True tmpEffect (IK.OnSmash IK.Temporary{}) = True tmpEffect _ = False in not $ any tmpEffect effs lid <- getsState $ lidFromC container localTime <- getsState $ getLocalTime lid let it1 = let timeoutTurns = timeDeltaScale (Delta timeTurn) timeout charging startT = timeShift startT timeoutTurns > localTime in filter charging itemTimer len = length it1 recharged = len < itemK it2 = if timeout /= 0 && recharged then if periodic && not permanent -- copies are spares only then replicate (itemK - length it1) localTime ++ it1 else localTime : it1 -- copies all fire, in turn else itemTimer !_A = assert (len <= itemK `blame` (source, target, iid, container)) () -- We use up the charge even if eventualy every effect fizzles. Tough luck. -- At least we don't destroy the item in such case. Also, we ID it regardless. unless (itemTimer == it2) $ execUpdAtomic $ UpdTimeItem iid container itemTimer it2 -- If the activation is not periodic, trigger at least the effects -- that are not recharging and so don't depend on @recharged@. -- Also, if the item was meleed with, let it get destroyed, if perishable, -- and let it get identified, even if no effect was eventually triggered. -- Otherwise don't even id the item --- no risk of destruction, no id. when (not periodic || recharged || meleePerformed) $ do -- We have to destroy the item before the effect affects the item -- or the actor holding it or standing on it (later on we could -- lose track of the item and wouldn't be able to destroy it) . -- This is OK, because we don't remove the item type from various -- item dictionaries, just an individual copy from the container, -- so, e.g., the item can be identified after it's removed. let (imperishable, kit2) = imperishableKit permanent periodic it2 itemFull kit unless imperishable $ execUpdAtomic $ UpdLoseItem False iid itemBase kit2 container -- At this point, the item is potentially no longer in container @c@, -- so we don't pass @c@ along. triggeredEffect <- itemEffectDisco source target iid itemKind container recharged periodic effs let triggered = if meleePerformed then UseUp else triggeredEffect sb <- getsState $ getActorBody source -- Announce no effect, which is rare and wastes time, so noteworthy. unless (triggered == UseUp -- effects triggered; feedback comes from them || periodic -- don't spam via fizzled periodic effects || bproj sb -- don't spam, projectiles can be very numerous ) $ execSfxAtomic $ SfxMsgFid (bfid sb) $ if any IK.forApplyEffect effs then SfxFizzles -- something didn't work, despite promising effects else SfxNothingHappens -- fully expected -- If none of item's effects was performed, we try to recreate the item. -- Regardless, we don't rewind the time, because some info is gained -- (that the item does not exhibit any effects in the given context). unless (triggered == UseUp || imperishable) $ execUpdAtomic $ UpdSpotItem False iid itemBase kit2 container imperishableKit :: Bool -> Bool -> ItemTimer -> ItemFull -> ItemQuant -> (Bool, ItemQuant) imperishableKit permanent periodic it2 ItemFull{itemKind} (itemK, _) = let fragile = IK.Fragile `elem` IK.ifeature itemKind durable = IK.Durable `elem` IK.ifeature itemKind imperishable = durable && not fragile || periodic && permanent kit = if permanent || periodic then (1, take 1 it2) else (itemK, it2) in (imperishable, kit) -- The item is triggered exactly once. If there are more copies, -- they are left to be triggered next time. itemEffectEmbedded :: MonadServerAtomic m => ActorId -> LevelId -> Point -> ItemId -> m () itemEffectEmbedded aid lid tpos iid = do -- First embedded item may move actor to another level, so @lid@ -- may be unequal to @blid sb@. let c = CEmbed lid tpos meleeEffectAndDestroy aid aid iid c -- | The source actor affects the target actor, with a given item. -- If any of the effects fires up, the item gets identified. -- Note that using raw damage (beating the enemy with the magic wand, -- for example) does not identify the item. -- -- Note that if we activate a durable item, e.g., armor, from the ground, -- it will get identified, which is perfectly fine, until we want to add -- sticky armor that can't be easily taken off (and, e.g., has some maluses). itemEffectDisco :: MonadServerAtomic m => ActorId -> ActorId -> ItemId -> ItemKind -> Container -> Bool -> Bool -> [IK.Effect] -> m UseResult itemEffectDisco source target iid itemKind c recharged periodic effs = do urs <- mapM (effectSem source target iid c recharged periodic) effs let ur = case urs of [] -> UseDud _ -> maximum urs -- Note: @UseId@ suffices for identification, @UseUp@ is not necessary. when (ur >= UseId && not (IK.onlyMinorEffects itemKind)) $ do kindId <- getsState $ getIidKindIdServer iid seed <- getsServer $ (EM.! iid) . sitemSeedD execUpdAtomic $ UpdDiscover c iid kindId seed return ur -- | The source actor affects the target actor, with a given effect and power. -- Both actors are on the current level and can be the same actor. -- The item may or may not still be in the container. -- The boolean result indicates if the effect actually fired up, -- as opposed to fizzled. effectSem :: MonadServerAtomic m => ActorId -> ActorId -> ItemId -> Container -> Bool -> Bool -> IK.Effect -> m UseResult effectSem source target iid c recharged periodic effect = do let recursiveCall = effectSem source target iid c recharged periodic sb <- getsState $ getActorBody source pos <- getsState $ posFromC c -- @execSfx@ usually comes last in effect semantics, but not always -- and we are likely to introduce more variety. let execSfx = execSfxAtomic $ SfxEffect (bfid sb) target effect 0 case effect of IK.Burn nDm -> effectBurn nDm source target IK.Explode t -> effectExplode execSfx t target IK.RefillHP p -> effectRefillHP p source target IK.RefillCalm p -> effectRefillCalm execSfx p source target IK.Dominate -> effectDominate source target IK.Impress -> effectImpress recursiveCall execSfx source target IK.Summon grp nDm -> effectSummon grp nDm iid source target periodic IK.Ascend p -> effectAscend recursiveCall execSfx p source target pos IK.Escape{} -> effectEscape source target IK.Paralyze nDm -> effectParalyze execSfx nDm source target IK.InsertMove nDm -> effectInsertMove execSfx nDm source target IK.Teleport nDm -> effectTeleport execSfx nDm source target IK.CreateItem store grp tim -> effectCreateItem (Just $ bfid sb) Nothing target store grp tim IK.DropItem n k store grp -> effectDropItem execSfx n k store grp target IK.PolyItem -> effectPolyItem execSfx source target IK.Identify -> effectIdentify execSfx iid source target IK.Detect d radius -> effectDetect execSfx d radius target pos IK.SendFlying tmod -> effectSendFlying execSfx tmod source target Nothing IK.PushActor tmod -> effectSendFlying execSfx tmod source target (Just True) IK.PullActor tmod -> effectSendFlying execSfx tmod source target (Just False) IK.DropBestWeapon -> effectDropBestWeapon execSfx target IK.ActivateInv symbol -> effectActivateInv execSfx target symbol IK.ApplyPerfume -> effectApplyPerfume execSfx target IK.OneOf l -> effectOneOf recursiveCall l IK.OnSmash _ -> return UseDud -- ignored under normal circumstances IK.Recharging e -> effectRecharging recursiveCall e recharged IK.Temporary _ -> effectTemporary execSfx source iid c IK.Composite l -> effectComposite recursiveCall l -- * Individual semantic functions for effects -- ** Burn -- Damage from fire. Not affected by armor. effectBurn :: MonadServerAtomic m => Dice.Dice -> ActorId -> ActorId -> m UseResult effectBurn nDm source target = do tb <- getsState $ getActorBody target totalDepth <- getsState stotalDepth Level{ldepth} <- getLevel (blid tb) n0 <- rndToAction $ castDice ldepth totalDepth nDm let n = max 1 n0 -- avoid 0 and negative burn deltaHP = - xM n sb <- getsState $ getActorBody source -- Display the effect more accurately. let reportedEffect = IK.Burn $ Dice.intToDice n execSfxAtomic $ SfxEffect (bfid sb) target reportedEffect deltaHP refillHP source target deltaHP return UseUp -- ** Explode effectExplode :: MonadServerAtomic m => m () -> GroupName ItemKind -> ActorId -> m UseResult effectExplode execSfx cgroup target = do execSfx tb <- getsState $ getActorBody target let itemFreq = [(cgroup, 1)] -- Explosion particles are placed among organs of the victim: container = CActor target COrgan m2 <- rollAndRegisterItem (blid tb) itemFreq container False Nothing let (iid, ((ItemFull{itemBase}, (itemK, _)), _)) = fromMaybe (error $ "" `showFailure` cgroup) m2 Point x y = bpos tb semirandom = case jkind itemBase of IdentityObvious ik -> fromEnum ik IdentityCovered ix _ -> fromEnum ix projectN k100 (n, _) = do -- We pick a point at the border, not inside, to have a uniform -- distribution for the points the line goes through at each distance -- from the source. Otherwise, e.g., the points on cardinal -- and diagonal lines from the source would be more common. let veryrandom = (k100 `xor` (semirandom + n)) `mod` 5 fuzz = 5 + veryrandom k | itemK >= 8 && n < 4 = 0 -- speed up if only a handful remains | n < 16 && n >= 12 = 12 | n < 12 && n >= 8 = 8 | n < 8 && n >= 4 = 4 | otherwise = min n 16 -- fire in groups of 16 including old duds psDir4 = [ Point (x - 12) (y + 12) , Point (x + 12) (y + 12) , Point (x - 12) (y - 12) , Point (x + 12) (y - 12) ] psDir8 = [ Point (x - 12) y , Point (x + 12) y , Point x (y + 12) , Point x (y - 12) ] psFuzz = [ 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 ] semireverse = if semirandom `mod` 2 == 0 then id else reverse ps = take k $ concat $ semireverse [ zip (repeat True) -- diagonal particles don't reach that far $ take 4 (drop ((k100 + itemK + fuzz) `mod` 4) $ cycle psDir4) , zip (repeat False) -- only some cardinal reach far $ take 4 (drop ((k100 + n) `mod` 4) $ cycle psDir8) ] ++ [zip (repeat True) $ take 8 (drop ((k100 + fuzz) `mod` 8) $ cycle psFuzz)] forM_ ps $ \(centerRaw, tpxy) -> do let req = ReqProject tpxy veryrandom iid COrgan center = centerRaw && itemK >= 8 -- if few, keep them regular mfail <- projectFail target tpxy veryrandom center iid COrgan True case mfail of Nothing -> return () Just ProjectBlockTerrain -> return () Just ProjectBlockActor | not $ bproj tb -> return () Just failMsg -> execFailure target req failMsg tryFlying 0 = return () tryFlying k100 = do -- Explosion particles are placed among organs of the victim: bag2 <- getsState $ borgan . getActorBody target let mn2 = EM.lookup iid bag2 case mn2 of Nothing -> return () Just n2 -> do projectN k100 n2 tryFlying $ k100 - 1 -- Particles that fail to take off, bounce off obstacles up to 100 times -- in total, trying to fly in different directions. tryFlying 100 bag3 <- getsState $ borgan . getActorBody target let mn3 = EM.lookup iid bag3 -- Give up and destroy the remaining particles, if any. maybe (return ()) (\kit -> execUpdAtomic $ UpdLoseItem False iid itemBase kit container) mn3 return UseUp -- we neglect verifying that at least one projectile got off -- ** RefillHP -- Unaffected by armor. effectRefillHP :: MonadServerAtomic m => Int -> ActorId -> ActorId -> m UseResult effectRefillHP power0 source target = do sb <- getsState $ getActorBody source tb <- getsState $ getActorBody target curChalSer <- getsServer $ scurChalSer . soptions fact <- getsState $ (EM.! bfid tb) . sfactionD let power = if power0 <= -1 then power0 else max 1 power0 -- avoid 0 deltaHP = xM power if | cfish curChalSer && deltaHP > 0 && fhasUI (gplayer fact) && bfid sb /= bfid tb -> do execSfxAtomic $ SfxMsgFid (bfid tb) SfxColdFish return UseId | otherwise -> do let reportedEffect = IK.RefillHP power execSfxAtomic $ SfxEffect (bfid sb) target reportedEffect deltaHP refillHP source target deltaHP return UseUp cutCalm :: MonadServerAtomic m => ActorId -> m () cutCalm target = do tb <- getsState $ getActorBody target ar <- getsState $ getActorAspect target let upperBound = if hpTooLow tb ar then 0 -- to trigger domination, etc. else xM $ IA.aMaxCalm ar deltaCalm = min minusM1 (upperBound - bcalm tb) -- HP loss decreases Calm by at least @minusM1@ to avoid "hears something", -- which is emitted when decreasing Calm by @minusM@. udpateCalm target deltaCalm -- ** RefillCalm effectRefillCalm :: MonadServerAtomic m => m () -> Int -> ActorId -> ActorId -> m UseResult effectRefillCalm execSfx power0 source target = do tb <- getsState $ getActorBody target ar <- getsState $ getActorAspect target let power = if power0 <= -1 then power0 else max 1 power0 -- avoid 0 rawDeltaCalm = xM power calmMax = IA.aMaxCalm ar serious = rawDeltaCalm < minusM && source /= target && not (bproj tb) deltaCalm0 | serious = -- if overfull, at least cut back to max min rawDeltaCalm (xM calmMax - bcalm tb) | otherwise = rawDeltaCalm deltaCalm = if | deltaCalm0 > 0 && bcalm tb > xM 999 -> -- UI limit tenthM -- avoid nop, to avoid loops | deltaCalm0 < 0 && bcalm tb < - xM 999 -> -tenthM | otherwise -> deltaCalm0 execSfx udpateCalm target deltaCalm return UseUp -- ** Dominate effectDominate :: MonadServerAtomic m => ActorId -> ActorId -> m UseResult effectDominate source target = do sb <- getsState $ getActorBody source tb <- getsState $ getActorBody target if | bproj tb -> return UseDud | bfid tb == bfid sb -> return UseDud -- accidental hit; ignore | otherwise -> do fact <- getsState $ (EM.! bfid tb) . sfactionD hiImpression <- highestImpression target permitted <- if fleaderMode (gplayer fact) == LeaderNull -- To tame/hack animal/robot, you need to impress them first. && hiImpression /= Just (bfid sb) then do execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxUnimpressed target return False else return True if permitted then do b <- dominateFidSfx target (bfid sb) return $! if b then UseUp else UseDud else return UseDud highestImpression :: MonadServerAtomic m => ActorId -> m (Maybe FactionId) highestImpression target = do tb <- getsState $ getActorBody target getKind <- getsState $ flip getIidKindServer getItem <- getsState $ flip getItemBody let isImpression iid = maybe False (> 0) $ lookup "impressed" $ IK.ifreq $ getKind iid impressions = EM.filterWithKey (\iid _ -> isImpression iid) $ borgan tb f (_, (k, _)) = k maxImpression = maximumBy (Ord.comparing f) $ EM.assocs impressions if EM.null impressions then return Nothing else case jfid $ getItem $ fst maxImpression of Nothing -> return Nothing Just fid -> assert (fid /= bfid tb) $ return $ Just fid dominateFidSfx :: MonadServerAtomic m => ActorId -> FactionId -> m Bool dominateFidSfx target fid = do tb <- getsState $ getActorBody target -- Actors that don't move freely can't be dominated, for otherwise, -- when they are the last survivors, they could get stuck and the game -- wouldn't end. Also, they are a hassle to guide through the dungeon. canTra <- getsState $ canTraverse target if canTra && not (bproj tb) && bhp tb > 0 then do let execSfx = execSfxAtomic $ SfxEffect fid target IK.Dominate 0 execSfx -- if actor ours, possibly the last occasion to see him gameOver <- dominateFid fid target unless gameOver -- avoid spam execSfx -- see the actor as theirs, unless position not visible return True else return False dominateFid :: MonadServerAtomic m => FactionId -> ActorId -> m Bool dominateFid fid target = do tb0 <- getsState $ getActorBody target -- At this point the actor's body exists and his items are not dropped. deduceKilled target electLeader (bfid tb0) (blid tb0) target fact <- getsState $ (EM.! bfid tb0) . sfactionD -- Prevent the faction's stash from being lost in case they are not spawners. when (isNothing $ gleader fact) $ moveStores False target CSha CInv tb <- getsState $ getActorBody target ais <- getsState $ getCarriedAssocsAndTrunk tb ar <- getsState $ getActorAspect target getKind <- getsState $ flip getIidKindServer let isImpression iid = maybe False (> 0) $ lookup "impressed" $ IK.ifreq $ getKind iid dropAllImpressions = EM.filterWithKey (\iid _ -> not $ isImpression iid) borganNoImpression = dropAllImpressions $ borgan tb btime <- getsServer $ (EM.! target) . (EM.! blid tb) . (EM.! bfid tb) . sactorTime execUpdAtomic $ UpdLoseActor target tb ais let bNew = tb { bfid = fid , bcalm = max (xM 10) $ xM (IA.aMaxCalm ar) `div` 2 , bhp = min (xM $ IA.aMaxHP ar) $ bhp tb + xM 10 , borgan = borganNoImpression} aisNew <- getsState $ getCarriedAssocsAndTrunk bNew modifyServer $ \ser -> ser {sactorTime = updateActorTime fid (blid tb) target btime $ sactorTime ser} execUpdAtomic $ UpdSpotActor target bNew aisNew factionD <- getsState sfactionD let inGame fact2 = case gquit fact2 of Nothing -> True Just Status{stOutcome=Camping} -> True _ -> False gameOver = not $ any inGame $ EM.elems factionD if gameOver then return True -- avoid spam identifying item at this point else do -- Add some nostalgia for the old faction. void $ effectCreateItem (Just $ bfid tb) (Just 10) target COrgan "impressed" IK.timerNone getKindId <- getsState $ flip getIidKindIdServer let discoverIf (iid, cstore) = do let itemKindId = getKindId iid c = CActor target cstore -- We avoid forcing the dominated actor to drop all items, -- so they are not picked up by the new controllers, so id them here. discoverIfMinorEffects c iid itemKindId aic = (btrunk tb, if bproj tb then CEqp else COrgan) : filter ((/= btrunk tb) . fst) (getCarriedIidCStore tb) mapM_ discoverIf aic -- Focus on the dominated actor, by making him a leader. supplantLeader fid target return False -- ** Impress effectImpress :: MonadServerAtomic m => (IK.Effect -> m UseResult) -> m () -> ActorId -> ActorId -> m UseResult effectImpress recursiveCall execSfx source target = do sb <- getsState $ getActorBody source tb <- getsState $ getActorBody target if | bproj tb -> return UseDud | bfid tb == bfid sb -> -- Unimpress wrt others, but only once. The recursive Sfx suffices. recursiveCall $ IK.DropItem 1 1 COrgan "impressed" | otherwise -> do -- Actors that don't move freely and so are stupid, can't be impressed. canTra <- getsState $ canTraverse target if canTra then do unless (bhp tb <= 0) execSfx -- avoid spam just before death effectCreateItem (Just $ bfid sb) (Just 1) target COrgan "impressed" IK.timerNone else return UseDud -- no message, because common and not crucial -- ** Summon -- Note that the Calm expended doesn't depend on the number of actors summoned. effectSummon :: MonadServerAtomic m => GroupName ItemKind -> Dice.Dice -> ItemId -> ActorId -> ActorId -> Bool -> m UseResult effectSummon grp nDm iid source target periodic = do -- Obvious effect, nothing announced. COps{coTileSpeedup} <- getsState scops sb <- getsState $ getActorBody source tb <- getsState $ getActorBody target actorAspect <- getsState sactorAspect totalDepth <- getsState stotalDepth Level{ldepth} <- getLevel (blid tb) itemKind <- getsState $ getIidKindServer iid power0 <- rndToAction $ castDice ldepth totalDepth nDm let power = max power0 1 -- KISS, always at least one summon -- We put @source@ instead of @target@ and @power@ instead of dice -- to make the message more accurate. effect = IK.Summon grp $ Dice.intToDice power execSfx = execSfxAtomic $ SfxEffect (bfid sb) source effect 0 sar = actorAspect EM.! source tar = actorAspect EM.! target durable = IK.Durable `elem` IK.ifeature itemKind deltaCalm = - xM 30 -- Verify Calm only at periodic activations or if the item is durable. -- Otherwise summon uses up the item, which prevents summoning getting -- out of hand. I don't verify Calm otherwise, to prevent an exploit -- via draining one's calm on purpose when an item with good activation -- has a nasty summoning side-effect (the exploit still works on durables). if | (periodic || durable) && not (bproj sb) && (bcalm sb < - deltaCalm || not (calmEnough sb sar)) -> do unless (bproj sb) $ execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxSummonLackCalm source return UseId | otherwise -> do execSfx unless (bproj sb) $ udpateCalm source deltaCalm let validTile t = not $ Tile.isNoActor coTileSpeedup t ps <- getsState $ nearbyFreePoints validTile (bpos tb) (blid tb) localTime <- getsState $ getLocalTime (blid tb) -- Make sure summoned actors start acting after the victim. let actorTurn = ticksPerMeter $ momentarySpeed tb tar targetTime = timeShift localTime actorTurn afterTime = timeShift targetTime $ Delta timeClip bs <- forM (take power ps) $ \p -> do -- Mark as summoned to prevent immediate chain summoning. maid <- addAnyActor True [(grp, 1)] (blid tb) afterTime (Just p) case maid of Nothing -> return False -- not enough space in dungeon? Just aid -> do b <- getsState $ getActorBody aid mleader <- getsState $ gleader . (EM.! bfid b) . sfactionD when (isNothing mleader) $ supplantLeader (bfid b) aid return True return $! if or bs then UseUp else UseId -- ** Ascend -- Note that projectiles can be teleported, too, for extra fun. effectAscend :: MonadServerAtomic m => (IK.Effect -> m UseResult) -> m () -> Bool -> ActorId -> ActorId -> Point -> m UseResult effectAscend recursiveCall execSfx up source target pos = do b1 <- getsState $ getActorBody target let lid1 = blid b1 (lid2, pos2) <- getsState $ whereTo lid1 pos (Just up) . sdungeon sb <- getsState $ getActorBody source if | braced b1 -> do execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxBracedImmune target return UseId | lid2 == lid1 && pos2 == pos -> do execSfxAtomic $ SfxMsgFid (bfid sb) SfxLevelNoMore -- We keep it useful even in shallow dungeons. recursiveCall $ IK.Teleport 30 -- powerful teleport | otherwise -> do execSfx btime_bOld <- getsServer $ (EM.! target) . (EM.! lid1) . (EM.! bfid b1) . sactorTime pos3 <- findStairExit (bfid sb) up lid2 pos2 let switch1 = void $ switchLevels1 (target, b1) switch2 = do -- Make the initiator of the stair move the leader, -- to let him clear the stairs for others to follow. let mlead = if bproj b1 then Nothing else Just target -- Move the actor to where the inhabitants were, if any. switchLevels2 lid2 pos3 (target, b1) btime_bOld mlead -- The actor will be added to the new level, -- but there can be other actors at his new position. inhabitants <- getsState $ posToAssocs pos3 lid2 case inhabitants of [] -> do switch1 switch2 (_, b2) : _ -> do -- Alert about the switch. -- Only tell one player, even if many actors, because then -- they are projectiles, so not too important. execSfxAtomic $ SfxMsgFid (bfid b2) SfxLevelPushed -- Move the actor out of the way. switch1 -- Move the inhabitants out of the way and to where the actor was. let moveInh inh = do -- Preserve the old leader, since the actor is pushed, -- so possibly has nothing worhwhile to do on the new level -- (and could try to switch back, if made a leader, -- leading to a loop). btime_inh <- getsServer $ (EM.! fst inh) . (EM.! lid2) . (EM.! bfid (snd inh)) . sactorTime inhMLead <- switchLevels1 inh switchLevels2 lid1 (bpos b1) inh btime_inh inhMLead mapM_ moveInh inhabitants -- Move the actor to his destination. switch2 return UseUp findStairExit :: MonadStateRead m => FactionId -> Bool -> LevelId -> Point -> m Point findStairExit side moveUp lid pos = do COps{coTileSpeedup} <- getsState scops fact <- getsState $ (EM.! side) . sfactionD lvl <- getLevel lid let defLanding = uncurry Vector $ if moveUp then (1, 0) else (-1, 0) center = uncurry Vector $ if moveUp then (-1, 0) else (1, 0) (mvs2, mvs1) = break (== defLanding) moves mvs = center : filter (/= center) (mvs1 ++ mvs2) ps = filter (Tile.isWalkable coTileSpeedup . (lvl `at`)) $ map (shift pos) mvs posOcc :: State -> Int -> Point -> Bool posOcc s k p = case posToAssocs p lid s of [] -> k == 0 (_, b) : _ | bproj b -> k == 3 (_, b) : _ | isFoe side fact (bfid b) -> k == 1 -- non-proj foe _ -> k == 2 -- moving a non-projectile friend unocc <- getsState posOcc case concatMap (\k -> filter (unocc k) ps) [0..3] of [] -> error $ "" `showFailure` ps posRes : _ -> return posRes switchLevels1 :: MonadServerAtomic m => (ActorId, Actor) -> m (Maybe ActorId) switchLevels1 (aid, bOld) = do let side = bfid bOld mleader <- getsState $ gleader . (EM.! side) . sfactionD -- Prevent leader pointing to a non-existing actor. mlead <- if not (bproj bOld) && isJust mleader then do execUpdAtomic $ UpdLeadFaction side mleader Nothing return mleader -- outside of a client we don't know the real tgt of aid, hence fst else return Nothing -- Remove the actor from the old level. -- Onlookers see somebody disappear suddenly. -- @UpdDestroyActor@ is too loud, so use @UpdLoseActor@ instead. ais <- getsState $ getCarriedAssocsAndTrunk bOld execUpdAtomic $ UpdLoseActor aid bOld ais return mlead switchLevels2 ::MonadServerAtomic m => LevelId -> Point -> (ActorId, Actor) -> Time -> Maybe ActorId -> m () switchLevels2 lidNew posNew (aid, bOld) btime_bOld mlead = do let lidOld = blid bOld side = bfid bOld let !_A = assert (lidNew /= lidOld `blame` "stairs looped" `swith` lidNew) () -- Sync actor's items' timeouts with the new local time of the level. -- We need to sync organs and equipment due to periodic activations, -- but also inventory pack (as well as some organs and equipment), -- due to timeouts after use, e.g., for some weapons (they recharge also -- in the pack; however, this doesn't encourage micromanagement for periodic -- items, because the timeout is randomised upon move to equipment). -- -- We don't rebase timeouts for items in stash, because they are -- used by many actors on levels with different local times, -- so there is no single rebase that would match all. -- This is not a big problem: after a single use by an actor the timeout is -- set to his current local time, so further uses by that actor have -- not anomalously short or long recharge times. If the recharge time -- is very long, the player has an option of moving the item from stash -- to pack and back, to reset the timeout. An abuse is possible when recently -- used item is put from inventory to stash and at once used on another level -- taking advantage of local time difference, but this only works once -- and using the item back again at the original level makes the recharge -- time longer, in turn. timeOld <- getsState $ getLocalTime lidOld timeLastActive <- getsState $ getLocalTime lidNew let delta = timeLastActive `timeDeltaToFrom` timeOld shiftByDelta = (`timeShift` delta) computeNewTimeout :: ItemQuant -> ItemQuant computeNewTimeout (k, it) = (k, map shiftByDelta it) rebaseTimeout :: ItemBag -> ItemBag rebaseTimeout = EM.map computeNewTimeout bNew = bOld { blid = lidNew , bpos = posNew , boldpos = Just posNew -- new level, new direction , borgan = rebaseTimeout $ borgan bOld , beqp = rebaseTimeout $ beqp bOld , binv = rebaseTimeout $ binv bOld } ais <- getsState $ getCarriedAssocsAndTrunk bOld -- Sync the actor time with the level time. -- This time shift may cause a double move of a foe of the same speed, -- but this is OK --- the foe didn't have a chance to move -- before, because the arena went inactive, so he moves now one more time. let btime = shiftByDelta btime_bOld modifyServer $ \ser -> ser {sactorTime = updateActorTime (bfid bNew) lidNew aid btime $ sactorTime ser} -- Materialize the actor at the new location. -- Onlookers see somebody appear suddenly. The actor himself -- sees new surroundings and has to reset his perception. execUpdAtomic $ UpdCreateActor aid bNew ais case mlead of Nothing -> return () Just leader -> supplantLeader side leader -- ** Escape -- | The faction leaves the dungeon. effectEscape :: MonadServerAtomic m => ActorId -> ActorId -> m UseResult effectEscape source target = do -- Obvious effect, nothing announced. sb <- getsState $ getActorBody source b <- getsState $ getActorBody target let fid = bfid b fact <- getsState $ (EM.! fid) . sfactionD if | bproj b -> return UseDud -- basically a misfire | not (fcanEscape $ gplayer fact) -> do execSfxAtomic $ SfxMsgFid (bfid sb) SfxEscapeImpossible return UseId | otherwise -> do deduceQuits (bfid b) $ Status Escape (fromEnum $ blid b) Nothing return UseUp -- ** Paralyze -- | Advance target actor time by this many time clips. Not by actor moves, -- to hurt fast actors more. effectParalyze :: MonadServerAtomic m => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult effectParalyze execSfx nDm source target = do tb <- getsState $ getActorBody target totalDepth <- getsState stotalDepth Level{ldepth} <- getLevel (blid tb) actorStasis <- getsServer sactorStasis power0 <- rndToAction $ castDice ldepth totalDepth nDm let power = max power0 1 -- KISS, avoid special case t = timeDeltaScale (Delta timeClip) power if | bproj tb -> return UseDud | ES.member target actorStasis -> do sb <- getsState $ getActorBody source execSfxAtomic $ SfxMsgFid (bfid sb) SfxStasisProtects return UseId | otherwise -> do execSfx modifyServer $ \ser -> ser { sactorTime = ageActor (bfid tb) (blid tb) target t $ sactorTime ser , sactorStasis = ES.insert target (sactorStasis ser) } -- actor's time warped, so he is in stasis, -- immune to further warps return UseUp -- ** InsertMove -- | Give target actor the given number of extra moves. Don't give -- an absolute amount of time units, to benefit slow actors more. effectInsertMove :: MonadServerAtomic m => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult effectInsertMove execSfx nDm source target = do tb <- getsState $ getActorBody target ar <- getsState $ getActorAspect target totalDepth <- getsState stotalDepth Level{ldepth} <- getLevel (blid tb) actorStasis <- getsServer sactorStasis power0 <- rndToAction $ castDice ldepth totalDepth nDm let power = max power0 1 -- KISS, avoid special case actorTurn = ticksPerMeter $ momentarySpeed tb ar t = timeDeltaScale actorTurn (-power) -- Projectiles permitted; can't be suspended mid-air, as in @effectParalyze@ -- but can be propelled. if | ES.member target actorStasis -> do sb <- getsState $ getActorBody source execSfxAtomic $ SfxMsgFid (bfid sb) SfxStasisProtects return UseId | otherwise -> do execSfx modifyServer $ \ser -> ser { sactorTime = ageActor (bfid tb) (blid tb) target t $ sactorTime ser , sactorStasis = ES.insert target (sactorStasis ser) } -- actor's time warped, so he is in stasis, -- immune to further warps return UseUp -- ** Teleport -- | Teleport the target actor. -- Note that projectiles can be teleported, too, for extra fun. effectTeleport :: MonadServerAtomic m => m () -> Dice.Dice -> ActorId -> ActorId -> m UseResult effectTeleport execSfx nDm source target = do COps{coTileSpeedup} <- getsState scops sb <- getsState $ getActorBody source tb <- getsState $ getActorBody target totalDepth <- getsState stotalDepth lvl@Level{ldepth, ltile} <- getLevel (blid tb) range <- rndToAction $ castDice ldepth totalDepth nDm let spos = bpos tb 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 coTileSpeedup t && (not (dMinMax 9 p) -- don't loop, very rare || not (Tile.isNoActor coTileSpeedup t) && null (posToAidsLvl p lvl))) [ dist 1 , dist $ 1 + range `div` 9 , dist $ 1 + range `div` 7 , dist $ 1 + range `div` 5 , dist 5 , dist 7 , dist 9 ] if | braced tb -> do execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxBracedImmune target return UseId | not (dMinMax 9 tpos) -> do -- very rare execSfxAtomic $ SfxMsgFid (bfid sb) SfxTransImpossible return UseId | otherwise -> do execSfx execUpdAtomic $ UpdMoveActor target spos tpos return UseUp -- ** CreateItem effectCreateItem :: MonadServerAtomic m => Maybe FactionId -> Maybe Int -> ActorId -> CStore -> GroupName ItemKind -> IK.TimerDice -> m UseResult effectCreateItem jfidRaw mcount target store grp tim = do tb <- getsState $ getActorBody target totalDepth <- getsState stotalDepth Level{ldepth} <- getLevel (blid tb) let fscale unit nDm = do k0 <- rndToAction $ castDice ldepth totalDepth nDm let k = max 1 k0 -- KISS, don't freak out if dice permit 0 return $! timeDeltaScale unit k fgame = fscale (Delta timeTurn) factor nDm = do ar <- getsState $ getActorAspect target -- A tiny bit added to make sure length 1 effect doesn't end before -- the end of first turn, which would make, e.g., speed, useless. let actorTurn = timeDeltaPercent (ticksPerMeter $ momentarySpeed tb ar) 101 fscale actorTurn nDm delta <- IK.foldTimer (return $ Delta timeZero) fgame factor tim let c = CActor target store bagBefore <- getsState $ getBodyStoreBag tb store let litemFreq = [(grp, 1)] -- Power depth of new items unaffected by number of spawned actors. m4 <- rollItem 0 (blid tb) litemFreq let (itemKnownRaw, (itemFullRaw, kitRaw), seed, _) = fromMaybe (error $ "" `showFailure` (blid tb, litemFreq, c)) m4 -- Avoid too many different item identifiers (one for each faction) -- for blasts or common item generating tiles. Temporary organs are -- allowed to be duplicated, because they provide really useful info -- (perpetrator). However, if timer is none, they are not duplicated -- to make sure that, e.g., poisons stack with each other regardless -- of perpetrator and we don't get "no longer poisoned" message -- while still poisoned due to another faction. With timed aspects, -- e.g., slowness, the message is less misleading, and it's interesting -- that I'm twice slower due to aspects from two factions and not -- as deadly as being poisoned at twice the rate from two factions. jfid = if store == COrgan && not (IK.isTimerNone tim) || grp == "impressed" then jfidRaw else Nothing (itemKnown, itemFull) = let (kindIx, ar, _) = itemKnownRaw in ( (kindIx, ar, jfid) , itemFullRaw {itemBase = (itemBase itemFullRaw) {jfid}} ) kitNew = case mcount of Just itemK -> (itemK, []) Nothing -> kitRaw itemRev <- getsServer sitemRev let mquant = case HM.lookup itemKnown itemRev of Nothing -> Nothing Just iid -> (iid,) <$> iid `EM.lookup` bagBefore case mquant of Just (iid, (_, afterIt@(timer : rest))) | not $ IK.isTimerNone tim -> do -- Already has such items and timer change requested, so only increase -- the timer of the first item by the delta, but don't create items. let newIt = timer `timeShift` delta : rest if afterIt /= newIt then do execUpdAtomic $ UpdTimeItem iid c afterIt newIt -- It's hard for the client to tell this timer change from charge use, -- timer reset on pickup, etc., so we create the msg manually. execSfxAtomic $ SfxMsgFid (bfid tb) $ SfxTimerExtended (blid tb) target iid store return UseUp else return UseDud -- probably incorrect content, but let it be _ -> do -- No such items or some items, but void delta, so create items. -- If it's, e.g., a periodic poison, the new items will stack with any -- already existing items. iid <- registerItem (itemFull, kitNew) itemKnown seed c True -- If created not on the ground, ID it, because it won't be on pickup. when (store /= CGround) $ discoverIfMinorEffects c iid (itemKindId itemFull) -- Now, if timer change requested, change the timer, but in the new items, -- possibly increased in number wrt old items. when (not $ IK.isTimerNone tim) $ do tb2 <- getsState $ getActorBody target bagAfter <- getsState $ getBodyStoreBag tb2 store localTime <- getsState $ getLocalTime (blid tb) let newTimer = localTime `timeShift` delta (afterK, afterIt) = fromMaybe (error $ "" `showFailure` (iid, bagAfter, c)) (iid `EM.lookup` bagAfter) newIt = replicate afterK newTimer when (afterIt /= newIt) $ execUpdAtomic $ UpdTimeItem iid c afterIt newIt return UseUp -- ** DropItem -- | Make the target actor drop items in a store from the given group. effectDropItem :: MonadServerAtomic m => m () -> Int -> Int -> CStore -> GroupName ItemKind -> ActorId -> m UseResult effectDropItem execSfx ngroup kcopy store grp target = do b <- getsState $ getActorBody target is <- allGroupItems store grp target if null is then return UseDud else do unless (store == COrgan) execSfx mapM_ (uncurry (dropCStoreItem True store target b kcopy)) $ take ngroup is return UseUp allGroupItems :: MonadServerAtomic m => CStore -> GroupName ItemKind -> ActorId -> m [(ItemId, ItemQuant)] allGroupItems store grp target = do b <- getsState $ getActorBody target getKind <- getsState $ flip getIidKindServer let hasGroup (iid, _) = maybe False (> 0) $ lookup grp $ IK.ifreq $ getKind iid assocsCStore <- getsState $ EM.assocs . getBodyStoreBag b store return $! filter hasGroup assocsCStore -- | Drop a single actor's item. Note that if there are multiple copies, -- at most one explodes to avoid excessive carnage and UI clutter -- (let's say, the multiple explosions interfere with each other or perhaps -- larger quantities of explosives tend to be packaged more safely). dropCStoreItem :: MonadServerAtomic m => Bool -> CStore -> ActorId -> Actor -> Int -> ItemId -> ItemQuant -> m () dropCStoreItem verbose store aid b kMax iid kit@(k, _) = do itemFull@ItemFull{itemKind} <- getsState $ itemToFull iid let c = CActor aid store fragile = IK.Fragile `elem` IK.ifeature itemKind durable = IK.Durable `elem` IK.ifeature itemKind isDestroyed = bproj b && (bhp b <= 0 && not durable || fragile) || fragile && durable -- hack for tmp organs if isDestroyed then do let effs = IK.strengthOnSmash itemKind -- Activate even if effects null, to destroy the item. effectAndDestroy False aid aid iid c False effs (itemFull, kit) else do cDrop <- pickDroppable aid b mvCmd <- generalMoveItem verbose iid (min kMax k) (CActor aid store) cDrop mapM_ execUpdAtomic mvCmd pickDroppable :: MonadStateRead m => ActorId -> Actor -> m Container pickDroppable aid b = do COps{coTileSpeedup} <- getsState scops lvl <- getLevel (blid b) let validTile t = not $ Tile.isNoItem coTileSpeedup t if validTile $ lvl `at` bpos b then return $! CActor aid CGround else do ps <- getsState $ nearbyFreePoints validTile (bpos b) (blid b) return $! case filter (adjacent $ bpos b) $ take 8 ps of [] -> CActor aid CGround -- fallback; still correct, though not ideal pos : _ -> CFloor (blid b) pos -- ** PolyItem effectPolyItem :: MonadServerAtomic m => m () -> ActorId -> ActorId -> m UseResult effectPolyItem execSfx source target = do sb <- getsState $ getActorBody source let cstore = CGround kitAss <- getsState $ kitAssocs target [cstore] case kitAss of [] -> do execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxPurposeNothing cstore return UseId (iid, ( ItemFull{itemBase, itemKindId, itemKind} , (itemK, itemTimer) )) : _ -> do let maxCount = Dice.maxDice $ IK.icount itemKind if | IK.Unique `elem` IK.ifeature itemKind -> do execSfxAtomic $ SfxMsgFid (bfid sb) SfxPurposeUnique return UseId | maybe True (<= 0) $ lookup "common item" $ IK.ifreq itemKind -> do execSfxAtomic $ SfxMsgFid (bfid sb) SfxPurposeNotCommon return UseId | itemK < maxCount -> do execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxPurposeTooFew maxCount itemK return UseId | otherwise -> do -- Only the required number of items is used up, not all of them. let c = CActor target cstore kit = (maxCount, take maxCount itemTimer) execSfx identifyIid iid c itemKindId execUpdAtomic $ UpdDestroyItem iid itemBase kit c effectCreateItem (Just $ bfid sb) Nothing target cstore "common item" IK.timerNone -- ** Identify effectIdentify :: MonadServerAtomic m => m () -> ItemId -> ActorId -> ActorId -> m UseResult effectIdentify execSfx iidId source target = do COps{coItemSpeedup} <- getsState scops sb <- getsState $ getActorBody source s <- getsServer $ (EM.! bfid sb) . sclientStates let tryFull store as = case as of [] -> return False (iid, _) : rest | iid == iidId -> tryFull store rest -- don't id itself (iid, ItemFull{itemBase, itemKindId, itemKind}) : rest -> do let kindIsKnown = case jkind itemBase of IdentityObvious _ -> True IdentityCovered ix _ -> ix `EM.member` sdiscoKind s if iid `EM.member` sdiscoAspect s -- already fully identified || IK.isHumanTrinket itemKind -- hack; keep them non-identified || store == CGround && IK.onlyMinorEffects itemKind -- will be identified when picked up, so don't bother || IA.kmConst (IK.getKindMean itemKindId coItemSpeedup) && kindIsKnown -- constant aspects and known kind; no need to identify further then tryFull store rest else do let c = CActor target store execSfx identifyIid iid c itemKindId return True tryStore stores = case stores of [] -> do execSfxAtomic $ SfxMsgFid (bfid sb) SfxIdentifyNothing return UseId -- the message tells it's ID effect store : rest -> do allAssocs <- getsState $ fullAssocs target [store] go <- tryFull store allAssocs if go then return UseUp else tryStore rest tryStore [CGround, CEqp, CInv, CSha] identifyIid :: MonadServerAtomic m => ItemId -> Container -> ContentId ItemKind -> m () identifyIid iid c itemKindId = do seed <- getsServer $ (EM.! iid) . sitemSeedD execUpdAtomic $ UpdDiscover c iid itemKindId seed -- ** Detect effectDetect :: MonadServerAtomic m => m () -> IK.DetectKind -> Int -> ActorId -> Point -> m UseResult effectDetect execSfx d radius target pos = do COps{coTileSpeedup} <- getsState scops b <- getsState $ getActorBody target lvl <- getLevel $ blid b let (predicate, action) = case d of IK.DetectAll -> (const True, const $ return False) IK.DetectActor -> ((`EM.member` lactor lvl), const $ return False) IK.DetectItem -> ((`EM.member` lfloor lvl), const $ return False) IK.DetectExit -> let (ls1, ls2) = lstair lvl in ((`elem` ls1 ++ ls2 ++ lescape lvl), const $ return False) IK.DetectHidden -> let predicateH p = Tile.isHideAs coTileSpeedup $ lvl `at` p revealEmbed p = do embeds <- getsState $ getEmbedBag (blid b) p unless (EM.null embeds) $ do s <- getState let ais = map (\iid -> (iid, getItemBody iid s)) (EM.keys embeds) execUpdAtomic $ UpdSpotItemBag (CEmbed (blid b) p) embeds ais actionH l = do let f p = when (p /= pos) $ do let t = lvl `at` p execUpdAtomic $ UpdSearchTile target p t -- This is safe searching; embedded items -- are not triggered, but they are revealed. revealEmbed p mapM_ f l return $! not $ null l in (predicateH, actionH) IK.DetectEmbed -> ((`EM.member` lembed lvl), const $ return False) effectDetectX d predicate action execSfx radius target effectDetectX :: MonadServerAtomic m => IK.DetectKind -> (Point -> Bool) -> ([Point] -> m Bool) -> m () -> Int -> ActorId -> m UseResult effectDetectX d predicate action execSfx radius target = do b <- getsState $ getActorBody target Level{lxsize, lysize} <- getLevel $ blid b sperFidOld <- getsServer sperFid let perOld = sperFidOld EM.! bfid b EM.! blid b Point x0 y0 = bpos b perList = filter predicate [ Point x y | y <- [max 0 (y0 - radius) .. min (lysize - 1) (y0 + radius)] , x <- [max 0 (x0 - radius) .. min (lxsize - 1) (x0 + radius)] ] extraPer = emptyPer {psight = PerVisible $ ES.fromDistinctAscList perList} inPer = diffPer extraPer perOld unless (nullPer inPer) $ do -- Perception is modified on the server and sent to the client -- together with all the revealed info. let perNew = addPer inPer perOld fper = EM.adjust (EM.insert (blid b) perNew) (bfid b) modifyServer $ \ser -> ser {sperFid = fper $ sperFid ser} execSendPer (bfid b) (blid b) emptyPer inPer perNew pointsModified <- action perList if not (nullPer inPer) || pointsModified then do execSfx -- Perception is reverted. This is necessary to ensure save and restore -- doesn't change game state. unless (nullPer inPer) $ do modifyServer $ \ser -> ser {sperFid = sperFidOld} execSendPer (bfid b) (blid b) inPer emptyPer perOld else execSfxAtomic $ SfxMsgFid (bfid b) $ SfxVoidDetection d return UseUp -- even if nothing spotted, in itself it's still useful data -- ** SendFlying -- | Send the target actor flying like a projectile. The arguments correspond -- to @ToThrow@ and @Linger@ properties of items. If the actors are adjacent, -- the vector is directed outwards, if no, inwards, if it's the same actor, -- boldpos is used, if it can't, a random outward vector of length 10 -- is picked. effectSendFlying :: MonadServerAtomic m => m () -> IK.ThrowMod -> ActorId -> ActorId -> Maybe Bool -> m UseResult effectSendFlying execSfx IK.ThrowMod{..} source target modePush = do v <- sendFlyingVector source target modePush tb <- getsState $ getActorBody target Level{lxsize, lysize} <- getLevel (blid tb) let eps = 0 fpos = bpos tb `shift` v if braced tb then do sb <- getsState $ getActorBody source execSfxAtomic $ SfxMsgFid (bfid sb) $ SfxBracedImmune target return UseId -- the message reveals what's going on else case bla lxsize lysize eps (bpos tb) fpos of Nothing -> error $ "" `showFailure` (fpos, tb) Just [] -> error $ "projecting from the edge of level" `showFailure` (fpos, tb) Just (pos : rest) -> do weightAssocs <- getsState $ fullAssocs target [CInv, CEqp, COrgan] let weight = sum $ map (IK.iweight . itemKind . snd) weightAssocs path = bpos tb : pos : rest (trajectory, (speed, range)) = computeTrajectory weight throwVelocity throwLinger path ts = Just (trajectory, speed) if null trajectory || btrajectory tb == ts then return UseId -- e.g., actor is too heavy; but a jerk is noticeable else do execSfx execUpdAtomic $ UpdTrajectory target (btrajectory tb) ts -- Give the actor back all the time spent flying (range/speed) -- and also let the push start ASAP. So, he will not lose -- any turn of movement (but he may need to retrace the push). let delta = timeDeltaScale (ticksPerMeter speed) (-range) modifyServer $ \ser -> ser {sactorTime = ageActor (bfid tb) (blid tb) target delta $ sactorTime ser} return UseUp sendFlyingVector :: MonadServerAtomic m => ActorId -> ActorId -> Maybe Bool -> m Vector sendFlyingVector source target modePush = do sb <- getsState $ getActorBody source let boldpos_sb = fromMaybe (bpos sb) (boldpos sb) if source == target then 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 pushV = vectorToFrom (bpos tb) (bpos sb) pullV = vectorToFrom (bpos sb) (bpos tb) return $! case modePush of Just True -> pushV Just False -> pullV Nothing | adjacent (bpos sb) (bpos tb) -> pushV Nothing -> pullV -- ** DropBestWeapon -- | Make the target actor drop his best weapon (stack). effectDropBestWeapon :: MonadServerAtomic m => m () -> ActorId -> m UseResult effectDropBestWeapon execSfx target = do tb <- getsState $ getActorBody target localTime <- getsState $ getLocalTime (blid tb) kitAssRaw <- getsState $ kitAssocs target [CEqp] let kitAss = filter (IK.isMelee . itemKind . fst . snd) kitAssRaw case strongestMelee Nothing localTime kitAss of (_, (iid, _)) : _ -> do execSfx let kit = beqp tb EM.! iid dropCStoreItem True CEqp target tb 1 iid kit -- not the whole stack return UseUp [] -> return UseDud -- ** ActivateInv -- | Activate all items with the given symbol -- in the target actor's equipment (there's no variant that activates -- a random one, to avoid the incentive for carrying garbage). -- Only one item of each stack is activated (and possibly consumed). effectActivateInv :: MonadServerAtomic m => m () -> ActorId -> Char -> m UseResult effectActivateInv execSfx target symbol = do let c = CActor target CInv effectTransformContainer execSfx symbol c $ \iid _ -> meleeEffectAndDestroy target target iid c effectTransformContainer :: forall m. MonadServerAtomic m => m () -> Char -> Container -> (ItemId -> ItemQuant -> m ()) -> m UseResult effectTransformContainer execSfx symbol c m = do getKind <- getsState $ flip getIidKindServer let hasSymbol (iid, _kit) = do let jsymbol = IK.isymbol $ getKind iid return $! jsymbol == symbol assocsCStore <- getsState $ EM.assocs . getContainerBag c is <- if symbol == ' ' then return assocsCStore else filterM hasSymbol assocsCStore if null is then return UseDud else do execSfx mapM_ (uncurry m) is -- Even if no item produced any visible effect, rummaging through -- the inventory uses up the effect and produced discernible vibrations. return UseUp -- ** ApplyPerfume effectApplyPerfume :: MonadServerAtomic m => m () -> ActorId -> m UseResult effectApplyPerfume execSfx target = do tb <- getsState $ getActorBody target Level{lsmell} <- getLevel $ blid tb unless (EM.null lsmell) $ do execSfx let f p fromSm = execUpdAtomic $ UpdAlterSmell (blid tb) p fromSm timeZero mapWithKeyM_ f lsmell return UseUp -- even if no smell before, the perfume is noticeable -- ** OneOf effectOneOf :: MonadServerAtomic m => (IK.Effect -> m UseResult) -> [IK.Effect] -> m UseResult effectOneOf recursiveCall l = do let call1 = do ef <- rndToAction $ oneOf l recursiveCall ef call99 = replicate 99 call1 f call result = do ur <- call -- We avoid 99 calls to a fizzling effect that only prints -- a failure message and IDs the item. if ur == UseDud then result else return ur foldr f (return UseDud) call99 -- no @execSfx@, because individual effects sent them -- ** Recharging effectRecharging :: MonadServerAtomic m => (IK.Effect -> m UseResult) -> IK.Effect -> Bool -> m UseResult effectRecharging recursiveCall e recharged = if recharged then recursiveCall e else return UseDud -- ** Temporary effectTemporary :: MonadServerAtomic m => m () -> ActorId -> ItemId -> Container -> m UseResult effectTemporary execSfx source iid c = do case c of CActor _ COrgan -> do b <- getsState $ getActorBody source case iid `EM.lookup` borgan b of Just _ -> return () -- still some copies left of a multi-copy tmp organ Nothing -> execSfx -- last copy just destroyed _ -> execSfx return UseUp -- temporary, so usually used up just by sitting there -- ** Composite effectComposite :: forall m. MonadServerAtomic m => (IK.Effect -> m UseResult) -> [IK.Effect] -> m UseResult effectComposite recursiveCall l = do let f :: IK.Effect -> m UseResult -> m UseResult f eff result = do ur <- recursiveCall eff when (ur == UseUp) $ void result -- UseResult comes from the first return ur foldr f (return UseDud) l -- no @execSfx@, because individual effects sent them