-- | The main loop of the server, processing human and computer player
-- moves turn by turn.
module Game.LambdaHack.Server.LoopM
  ( loopSer
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , factionArena, arenasForLoop, handleFidUpd, loopUpd, endClip
  , manageCalmAndDomination, applyPeriodicLevel
  , handleTrajectories, hTrajectories, advanceTrajectory
  , handleActors, hActors, handleUIunderAI, dieSer, restartGame
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES

import           Game.LambdaHack.Atomic
import           Game.LambdaHack.Client (ReqUI (..), Response (..))
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.State
import qualified Game.LambdaHack.Common.Tile as Tile
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Common.Vector
import           Game.LambdaHack.Content.FactionKind
import qualified Game.LambdaHack.Content.ItemKind as IK
import           Game.LambdaHack.Content.ModeKind
import           Game.LambdaHack.Content.RuleKind
import qualified Game.LambdaHack.Definition.Ability as Ability
import           Game.LambdaHack.Definition.Defs
import           Game.LambdaHack.Server.CommonM
import           Game.LambdaHack.Server.HandleEffectM
import           Game.LambdaHack.Server.HandleRequestM
import           Game.LambdaHack.Server.MonadServer
import           Game.LambdaHack.Server.PeriodicM
import           Game.LambdaHack.Server.ProtocolM
import           Game.LambdaHack.Server.ServerOptions
import           Game.LambdaHack.Server.StartM
import           Game.LambdaHack.Server.State

-- | Start a game session, including the clients, and then loop,
-- communicating with the clients.
--
-- The loop is started in server state that is empty, see 'emptyStateServer'.
loopSer :: (MonadServerAtomic m, MonadServerComm m)
        => ServerOptions
             -- ^ player-supplied server options
        -> (Bool -> FactionId -> ChanServer -> IO ())
             -- ^ function that initializes a client and runs its main loop
        -> m ()
loopSer :: forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
ServerOptions -> (Bool -> FactionId -> ChanServer -> IO ()) -> m ()
loopSer ServerOptions
serverOptions Bool -> FactionId -> ChanServer -> IO ()
executorClient = do
  -- Recover states and launch clients.
  (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser -> StateServer
ser { soptionsNxt = serverOptions
                             , soptions = serverOptions }
  cops <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  let updConn Bool
startsNewGame = (FactionId -> ChanServer -> IO ()) -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
(FactionId -> ChanServer -> IO ()) -> m ()
updateConn ((FactionId -> ChanServer -> IO ()) -> m ())
-> (FactionId -> ChanServer -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> FactionId -> ChanServer -> IO ()
executorClient Bool
startsNewGame
  restored <- tryRestore
  case restored of
    Just (State
sRaw, StateServer
ser) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ServerOptions -> Bool
snewGameSer ServerOptions
serverOptions -> do  -- a restored game
      UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ State -> UpdAtomic
UpdResumeServer
                    (State -> UpdAtomic) -> State -> UpdAtomic
forall a b. (a -> b) -> a -> b
$ (COps -> COps) -> State -> State
updateCOpsAndCachedData (COps -> COps -> COps
forall a b. a -> b -> a
const COps
cops) State
sRaw
      StateServer -> m ()
forall (m :: * -> *). MonadServer m => StateServer -> m ()
putServer StateServer
ser {soptionsNxt = serverOptions}
      m ()
forall (m :: * -> *). MonadServer m => m ()
applyDebug
      factionD <- (State -> FactionDict) -> m FactionDict
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
      let f FactionId
fid = let cmd :: UpdAtomic
cmd = State -> UpdAtomic
UpdResumeServer
                            (State -> UpdAtomic) -> State -> UpdAtomic
forall a b. (a -> b) -> a -> b
$ (COps -> COps) -> State -> State
updateCOpsAndCachedData (COps -> COps -> COps
forall a b. a -> b -> a
const COps
cops)
                            (State -> State) -> State -> State
forall a b. (a -> b) -> a -> b
$ StateServer -> EnumMap FactionId State
sclientStates StateServer
ser EnumMap FactionId State -> FactionId -> State
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid
                  in FactionId -> UpdAtomic -> m Bool
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> UpdAtomic -> m Bool
execUpdAtomicFidCatch FactionId
fid UpdAtomic
cmd
      mapM_ (void <$> f) $ EM.keys factionD
      updConn False
      initPer
      pers <- getsServer sperFid
      let clear = Perception -> b -> Perception
forall a b. a -> b -> a
const Perception
emptyPer
          persFid FactionId
fid | ServerOptions -> Bool
sknowEvents ServerOptions
serverOptions = (Perception -> Perception)
-> EnumMap LevelId Perception -> EnumMap LevelId Perception
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map Perception -> Perception
forall {b}. b -> Perception
clear (PerFid
pers PerFid -> FactionId -> EnumMap LevelId Perception
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid)
                      | Bool
otherwise = PerFid
pers PerFid -> FactionId -> EnumMap LevelId Perception
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid
      mapM_ (\FactionId
fid -> FactionId -> UpdAtomic -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
FactionId -> UpdAtomic -> m ()
sendUpdate FactionId
fid (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> EnumMap LevelId Perception -> UpdAtomic
UpdResume FactionId
fid (FactionId -> EnumMap LevelId Perception
persFid FactionId
fid))
            (EM.keys factionD)
      arenasNew <- arenasForLoop
      modifyServer $ \StateServer
ser2 -> StateServer
ser2 {sarenas = arenasNew, svalidArenas = True}
      -- We dump RNG seeds here, based on @soptionsNxt@, in case the game
      -- wasn't run with @--dumpInitRngs@ previously, but we need the seeds,
      -- e.g., to diagnose a crash.
      rngs <- getsServer srngs
      when (sdumpInitRngs serverOptions) $ dumpRngs rngs
    Maybe (State, StateServer)
_ -> do  -- starting new game for this savefile (--newGame or fresh save)
      factionDold <- (State -> FactionDict) -> m FactionDict
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
      s <- gameReset serverOptions Nothing Nothing
             -- get RNG from item boost
      -- Set up commandline options.
      let optionsBarRngs =
            ServerOptions
serverOptions {sdungeonRng = Nothing, smainRng = Nothing}
      modifyServer $ \StateServer
ser -> StateServer
ser { soptionsNxt = optionsBarRngs
                                 , soptions = optionsBarRngs }
      execUpdAtomic $ UpdRestartServer s
      updConn True
      initPer
      reinitGame factionDold
      writeSaveAll False False
  loopUpd $ updConn True

factionArena :: MonadStateRead m => Faction -> m (Maybe LevelId)
factionArena :: forall (m :: * -> *).
MonadStateRead m =>
Faction -> m (Maybe LevelId)
factionArena Faction
fact = case Faction -> Maybe ActorId
gleader Faction
fact of
  -- Even spawners need an active arena for their leader,
  -- or they start clogging stairs.
  Just ActorId
leader -> do
    b <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
    return $ Just $ blid b
  Maybe ActorId
Nothing -> Maybe LevelId -> m (Maybe LevelId)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe LevelId
forall a. Maybe a
Nothing
    -- This means Allure heroes can kill all aliens on lvl 4, retreat,
    -- hide and sleep on lvl 3 and they are guaranteed aliens don't spawn.
    -- However, animals still spawn, if slowly, and aliens resume
    -- spawning when heroes move on again.

arenasForLoop :: MonadStateRead m => m (ES.EnumSet LevelId)
{-# INLINE arenasForLoop #-}
arenasForLoop :: forall (m :: * -> *). MonadStateRead m => m (EnumSet LevelId)
arenasForLoop = do
  factionD <- (State -> FactionDict) -> m FactionDict
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
  marenas <- mapM factionArena $ EM.elems factionD
  let arenas = [LevelId] -> EnumSet LevelId
forall k. Enum k => [k] -> EnumSet k
ES.fromList ([LevelId] -> EnumSet LevelId) -> [LevelId] -> EnumSet LevelId
forall a b. (a -> b) -> a -> b
$ [Maybe LevelId] -> [LevelId]
forall a. [Maybe a] -> [a]
catMaybes [Maybe LevelId]
marenas
      !_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not (EnumSet LevelId -> Bool
forall k. EnumSet k -> Bool
ES.null EnumSet LevelId
arenas)
                    Bool -> (String, FactionDict) -> Bool
forall v. Show v => Bool -> v -> Bool
`blame` String
"game over not caught earlier"
                    String -> FactionDict -> (String, FactionDict)
forall v. String -> v -> (String, v)
`swith` FactionDict
factionD) ()
  return $! arenas

handleFidUpd :: forall m. (MonadServerAtomic m, MonadServerComm m)
             => (FactionId -> m ()) -> FactionId -> Faction -> m ()
{-# INLINE handleFidUpd #-}
handleFidUpd :: forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
(FactionId -> m ()) -> FactionId -> Faction -> m ()
handleFidUpd FactionId -> m ()
updatePerFid FactionId
fid Faction
fact = do
  -- Update perception on all levels at once,
  -- in case a leader is changed to actor on another
  -- (possibly not even currently active) level.
  -- This runs for all factions even if save is requested by UI.
  -- Let players ponder new game state while the engine is busy saving.
  -- Also, this ensures perception before game save is exactly the same
  -- as at game resume, which is an invariant we check elsewhere.
  -- However, if perception is not updated after the action, the actor
  -- may not see his vicinity, so may not see enemy that displaces (or hits) him
  -- resulting in breaking the displace action and temporary leader loss,
  -- which is fine, though a bit alarming. So, we update it at the end.
  FactionId -> m ()
updatePerFid FactionId
fid
  -- Move a single actor only. Note that the skipped actors are not marked
  -- as waiting. Normally they will act in the next clip or the next few,
  -- so that's natural. But if there are dozens of them, this is wierd.
  -- E.g., they don't move, but still make nearby foes lose Calm.
  -- However, for KISS, we leave it be.
  --
  -- Bail out if immediate loop break- requested by UI. No check
  -- for @sbreakLoop@ needed, for the same reasons as in @handleActors@.
  let handle :: [LevelId] -> m Bool
      handle :: [LevelId] -> m Bool
handle [] = Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      handle (LevelId
lid : [LevelId]
rest) = do
        breakASAP <- (StateServer -> Bool) -> m Bool
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> Bool
sbreakASAP
        if breakASAP
        then return False
        else do
          nonWaitMove <- handleActors lid fid
          if nonWaitMove
          then return True
          else handle rest
      killDying :: [LevelId] -> m ()
      killDying :: [LevelId] -> m ()
killDying = (LevelId -> m ()) -> [LevelId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ LevelId -> m ()
killDyingLid
      killDyingLid :: LevelId -> m ()
      killDyingLid :: LevelId -> m ()
killDyingLid LevelId
lid = do
        localTime <- (State -> Time) -> m Time
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime LevelId
lid
        levelTime <- getsServer $ (EM.! lid) . (EM.! fid) . sactorTime
        let l = ((ActorId, Time) -> Bool) -> [(ActorId, Time)] -> [(ActorId, Time)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(ActorId
_, Time
atime) -> Time
atime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= Time
localTime) ([(ActorId, Time)] -> [(ActorId, Time)])
-> [(ActorId, Time)] -> [(ActorId, Time)]
forall a b. (a -> b) -> a -> b
$ EnumMap ActorId Time -> [(ActorId, Time)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap ActorId Time
levelTime
            killAid (ActorId
aid, b
_) = do
              b1 <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
              when (bhp b1 <= 0) $ dieSer aid b1
        mapM_ killAid l
  -- Start on arena with leader, if available. This is crucial to ensure
  -- that no actor (even ours) moves before UI declares save(&exit).
  fa <- Faction -> m (Maybe LevelId)
forall (m :: * -> *).
MonadStateRead m =>
Faction -> m (Maybe LevelId)
factionArena Faction
fact
  arenas <- getsServer sarenas
  let myArenas = case Maybe LevelId
fa of
        Just LevelId
myArena -> LevelId
myArena LevelId -> [LevelId] -> [LevelId]
forall a. a -> [a] -> [a]
: LevelId -> [LevelId] -> [LevelId]
forall a. Eq a => a -> [a] -> [a]
delete LevelId
myArena (EnumSet LevelId -> [LevelId]
forall k. Enum k => EnumSet k -> [k]
ES.elems EnumSet LevelId
arenas)
        Maybe LevelId
Nothing -> EnumSet LevelId -> [LevelId]
forall k. Enum k => EnumSet k -> [k]
ES.elems EnumSet LevelId
arenas
  nonWaitMove <- handle myArenas
  breakASAP <- getsServer sbreakASAP
  unless breakASAP $ killDying myArenas
  -- We update perception at the end, see comment above. This is usually
  -- cheap, and when not, if it's AI faction, it's a waste, but if it's UI,
  -- that's exactly where it prevents lost attack messages, etc.
  -- If the move was a wait, perception unchanged, so no need to update,
  -- unless the actor starts sleeping, in which case his perception
  -- is reduced a bit later, so no harm done.
  when nonWaitMove $ updatePerFid fid

-- | Handle a clip (the smallest fraction of a game turn for which a frame may
-- potentially be generated). Run the leader and other actors moves.
-- Eventually advance the time and repeat.
loopUpd :: forall m. (MonadServerAtomic m, MonadServerComm m)
        => m () -> m ()
loopUpd :: forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
m () -> m ()
loopUpd m ()
updConn = do
  let updatePerFid :: FactionId -> m ()
      {-# NOINLINE updatePerFid #-}
      updatePerFid :: FactionId -> m ()
updatePerFid FactionId
fid = do  -- {-# SCC updatePerFid #-} do
        perValid <- (StateServer -> EnumMap LevelId Bool) -> m (EnumMap LevelId Bool)
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> EnumMap LevelId Bool) -> m (EnumMap LevelId Bool))
-> (StateServer -> EnumMap LevelId Bool)
-> m (EnumMap LevelId Bool)
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId (EnumMap LevelId Bool)
-> FactionId -> EnumMap LevelId Bool
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (EnumMap FactionId (EnumMap LevelId Bool) -> EnumMap LevelId Bool)
-> (StateServer -> EnumMap FactionId (EnumMap LevelId Bool))
-> StateServer
-> EnumMap LevelId Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> EnumMap FactionId (EnumMap LevelId Bool)
sperValidFid
        mapM_ (\(LevelId
lid, Bool
valid) -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
valid (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> LevelId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> LevelId -> m ()
updatePer FactionId
fid LevelId
lid)
              (EM.assocs perValid)
      handleFid :: (FactionId, Faction) -> m ()
      {-# NOINLINE handleFid #-}
      handleFid :: (FactionId, Faction) -> m ()
handleFid (FactionId
fid, Faction
fact) = do
        breakASAP <- (StateServer -> Bool) -> m Bool
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> Bool
sbreakASAP
        -- Don't process other factions, even their perceptions,
        -- if UI saves and/or exits.
        unless breakASAP $ handleFidUpd updatePerFid fid fact
      loopConditionally :: m ()
loopConditionally = do
        factionD <- (State -> FactionDict) -> m FactionDict
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
        -- Update perception one last time to satisfy save/resume assertions,
        -- because we may get here at arbitrary moment due to game over
        -- and so have outdated perception.
        mapM_ updatePerFid (EM.keys factionD)
        modifyServer $ \StateServer
ser -> StateServer
ser { sbreakLoop = False
                                   , sbreakASAP = False }
        endOrLoop loopUpdConn (restartGame updConn loopUpdConn)
      loopUpdConn :: m ()
loopUpdConn = do
        factionD <- (State -> FactionDict) -> m FactionDict
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
        -- Start handling actors with the single UI faction,
        -- to safely save/exit. Note that this hack fails if there are many UI
        -- factions (when we reenable multiplayer). Then players will request
        -- save&exit and others will vote on it and it will happen
        -- after the clip has ended, not at the start.
        -- Note that at most a single actor with a time-consuming action
        -- is processed per faction, so it's fair, but many loops are needed.
        let hasUI (a
_, Faction
fact) = FactionKind -> Bool
fhasUI (Faction -> FactionKind
gkind Faction
fact)
            (factionUI, factionsRest) = case break hasUI $ EM.assocs factionD of
              ([(FactionId, Faction)]
noUI1, (FactionId, Faction)
ui : [(FactionId, Faction)]
noUI2) -> ((FactionId, Faction)
ui, [(FactionId, Faction)]
noUI1 [(FactionId, Faction)]
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. [a] -> [a] -> [a]
++ [(FactionId, Faction)]
noUI2)
              ([(FactionId, Faction)], [(FactionId, Faction)])
_ -> String -> ((FactionId, Faction), [(FactionId, Faction)])
forall a. (?callStack::CallStack) => String -> a
error String
"no UI faction in the game"
        mapM_ handleFid $ factionUI : factionsRest
        breakASAP <- getsServer sbreakASAP
        breakLoop <- getsServer sbreakLoop
        if breakASAP || breakLoop
        then loopConditionally
        else do
          -- Projectiles are processed last and not at all if the UI leader
          -- decides to save or exit or restart or if there is game over.
          -- This and UI leader acting before any other ordinary actors
          -- ensures state is not changed and so the clip doesn't need
          -- to be carried through before save.
          arenas <- getsServer sarenas
          mapM_ (\FactionId
fid -> (LevelId -> m ()) -> [LevelId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (LevelId -> FactionId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
LevelId -> FactionId -> m ()
`handleTrajectories` FactionId
fid) ([LevelId] -> m ()) -> [LevelId] -> m ()
forall a b. (a -> b) -> a -> b
$ EnumSet LevelId -> [LevelId]
forall k. Enum k => EnumSet k -> [k]
ES.elems EnumSet LevelId
arenas)
                (EM.keys factionD)
          endClip updatePerFid  -- must be last, in case performs a bkp save
          -- The condition can be changed in @handleTrajectories@ by pushing
          -- onto an escape and in @endClip@.
          breakLoop2 <- getsServer sbreakLoop
          if breakLoop2
          then loopConditionally
          else loopUpdConn  -- process next iteration unconditionally
  m ()
loopUpdConn

-- | Handle the end of every clip. Do whatever has to be done
-- every fixed number of clips, e.g., monster generation.
-- Advance time. Perform periodic saves, if applicable.
--
-- This is never run if UI requested save or exit or restart and it's correct,
-- because we know nobody moved and no time was or needs to be advanced
-- and arenas are not changed. After game was saved and exited,
-- on game resume the first clip is performed with empty arenas,
-- so arena time is not updated and nobody moves, nor anything happens,
-- but arenas are here correctly updated.
endClip :: forall m. MonadServerAtomic m => (FactionId -> m ()) -> m ()
{-# INLINE endClip #-}
endClip :: forall (m :: * -> *).
MonadServerAtomic m =>
(FactionId -> m ()) -> m ()
endClip FactionId -> m ()
updatePerFid = do
  COps{corule} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  time <- getsState stime
  let clipN = Time
time Time -> Time -> Int
`timeFit` Time
timeClip
  -- No check if @sbreakASAP@ is set, because then the function is not called.
  breakLoop <- getsServer sbreakLoop
  -- We don't send a lot of useless info to the client if the game has already
  -- ended. At best wasteful, at worst the player sees strange messages.
  unless breakLoop $ do
    -- I need to send time updates, because I can't add time to each command,
    -- because I'd need to send also all arenas, which should be updated,
    -- and this is too expensive data for each, e.g., projectile move.
    -- I send even if nothing changes so that UI time display can progress.
    -- Possibly @arenas@ are invalid here, but all moves were performed
    -- according to this value, so time should be replenished according
    -- to this value as well.
    -- This is crucial, because tiny time discrepancies can accumulate
    -- magnified by hunders of actors that share the clip slots due to the
    -- restriction that at most one faction member acts each clip.
    arenas <- getsServer sarenas
    execUpdAtomic $ UpdAgeGame arenas
    -- Perform periodic dungeon maintenance.
    when (clipN `mod` rleadLevelClips corule == 0) leadLevelSwitch
    case clipN `mod` clipsInTurn of
      Int
0 ->
        -- Spawn monsters at most once per 3 turns.
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
clipN Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
clipsInTurn) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
          m ()
forall (m :: * -> *). MonadServerAtomic m => m ()
spawnMonster
      Int
4 ->
        -- Periodic activation only once per turn, for speed,
        -- but on all active arenas. Calm updates and domination
        -- happen there as well. Once per turn is too rare for accurate
        -- expiration of short conditions, e.g., 1-turn haste. TODO.
        m ()
forall (m :: * -> *). MonadServerAtomic m => m ()
applyPeriodicLevel
      Int
_ -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  -- @applyPeriodicLevel@ might have, e.g., dominated actors, ending the game.
  -- It could not have unended the game, though.
  breakLoop2 <- getsServer sbreakLoop
  unless breakLoop2 $ do
    -- Possibly a leader change due to @leadLevelSwitch@, so update arenas here
    -- for 100% accuracy at least at the start of actor moves, before they
    -- change leaders as part of their moves.
    --
    -- After game resume, this is the first non-vacuus computation.
    -- Next call to @loopUpdConn@ really moves actors and updates arena times
    -- so we start in exactly the same place that UI save ended in.
    validArenas <- getsServer svalidArenas
    unless validArenas $ do
      arenasNew <- arenasForLoop
      modifyServer $ \StateServer
ser -> StateServer
ser {sarenas = arenasNew, svalidArenas = True}
  -- Update all perception for visual feedback and to make sure saving
  -- and resuming game doesn't affect gameplay (by updating perception).
  -- Perception updates in @handleFidUpd@ are not enough, because
  -- periodic actions could have invalidated them.
  factionD <- getsState sfactionD
  mapM_ updatePerFid (EM.keys factionD)
  -- Saving on the browser causes a huge lag, hence autosave disabled.
#ifndef USE_JSFILE
  unless breakLoop2 $  -- if by chance requested and periodic saves coincide
    -- Periodic save needs to be at the end, so that restore can start
    -- at the beginning. Double save on first turn is avoided with @succ@.
    when (succ clipN `mod` rwriteSaveClips corule == 0) $
      writeSaveAll False False
#endif

-- | Check if the given actor is dominated and update his calm.
manageCalmAndDomination :: MonadServerAtomic m => ActorId -> Actor -> m ()
manageCalmAndDomination :: forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Actor -> m ()
manageCalmAndDomination ActorId
aid Actor
b = do
  performedDomination <-
    if Actor -> Int64
bcalm Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0 then Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False else do  -- triggered by zeroed Calm
      hiImpression <- Actor -> m (Maybe (FactionId, Int))
forall (m :: * -> *).
MonadServerAtomic m =>
Actor -> m (Maybe (FactionId, Int))
highestImpression Actor
b
      case hiImpression of
        Maybe (FactionId, Int)
Nothing -> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        Just (FactionId
hiImpressionFid, Int
hiImpressionK) -> do
          fact <- (State -> Faction) -> m Faction
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
          if fhasPointman (gkind fact)
               -- animals/robots/human drones never Calm-dominated
             || hiImpressionK >= 10
               -- unless very high impression, e.g., in a dominated hero
          then dominateFidSfx aid aid (btrunk b) hiImpressionFid
          else return False
  unless performedDomination $ do
    newCalmDelta <- getsState $ regenCalmDelta aid b
    unless (newCalmDelta == 0) $
      -- Update delta for the current player turn.
      updateCalm aid newCalmDelta

-- | Trigger periodic items for all actors on the given level.
applyPeriodicLevel :: MonadServerAtomic m => m ()
applyPeriodicLevel :: forall (m :: * -> *). MonadServerAtomic m => m ()
applyPeriodicLevel = do
  arenas <- (StateServer -> EnumSet LevelId) -> m (EnumSet LevelId)
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> EnumSet LevelId
sarenas
  let applyPeriodicItem ActorId
_ CStore
_ (ItemId
_, (a
_, [])) = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        -- periodic items always have at least one timer
      applyPeriodicItem ActorId
aid CStore
cstore (ItemId
iid, (a, [a])
_) = do
        itemFull <- (State -> ItemFull) -> m ItemFull
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
        let arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
        when (IA.checkFlag Ability.Periodic arItem) $ do
          -- Check if the item is still in the bag (previous items act!).
          b2 <- getsState $ getActorBody aid
          bag <- getsState $ getBodyStoreBag b2 cstore
          case iid `EM.lookup` bag of
            Maybe ItemQuant
Nothing -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()  -- item dropped
            Just (Int
k, ItemTimers
_) -> do
              -- Activate even if effects null or vacuous, to possibly
              -- destroy the item.
              let effApplyFlags :: EffApplyFlags
effApplyFlags = EffApplyFlags
                    { effToUse :: EffToUse
effToUse            = EffToUse
EffBare  -- no periodic crafting
                    , effVoluntary :: Bool
effVoluntary        = Bool
True
                    , effUseAllCopies :: Bool
effUseAllCopies     = Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
                    , effKineticPerformed :: Bool
effKineticPerformed = Bool
False
                    , effActivation :: ActivationFlag
effActivation       = ActivationFlag
Ability.ActivationPeriodic
                    , effMayDestroy :: Bool
effMayDestroy       = Bool
True
                    }
              m UseResult -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m UseResult -> m ()) -> m UseResult -> m ()
forall a b. (a -> b) -> a -> b
$ EffApplyFlags
-> ActorId
-> ActorId
-> ActorId
-> ItemId
-> Container
-> ItemFull
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
EffApplyFlags
-> ActorId
-> ActorId
-> ActorId
-> ItemId
-> Container
-> ItemFull
-> m UseResult
effectAndDestroyAndAddKill
                       EffApplyFlags
effApplyFlags
                       ActorId
aid ActorId
aid ActorId
aid ItemId
iid (ActorId -> CStore -> Container
CActor ActorId
aid CStore
cstore) ItemFull
itemFull
      applyPeriodicActor (ActorId
aid, Actor
b) =
        -- While it's fun when projectiles flash or speed up mid-air,
        -- it's very exotic and quite time-intensive whenever hundreds
        -- of projectiles exist due to ongoing explosions.
        -- Nothing activates when actor dying to prevent a regenerating
        -- actor from resurrecting each turn, resulting in silly gameover stats.
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Actor -> Bool
bproj Actor
b) Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
0 Bool -> Bool -> Bool
&& Actor -> LevelId
blid Actor
b LevelId -> EnumSet LevelId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` EnumSet LevelId
arenas) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
          -- Equipment goes first, to refresh organs before they expire,
          -- to avoid the message that organ expired.
          ((ItemId, ItemQuant) -> m ()) -> [(ItemId, ItemQuant)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (ActorId -> CStore -> (ItemId, ItemQuant) -> m ()
forall {m :: * -> *} {a} {a}.
MonadServerAtomic m =>
ActorId -> CStore -> (ItemId, (a, [a])) -> m ()
applyPeriodicItem ActorId
aid CStore
CEqp) ([(ItemId, ItemQuant)] -> m ()) -> [(ItemId, ItemQuant)] -> m ()
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)])
-> ItemBag -> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> a -> b
$ Actor -> ItemBag
beqp Actor
b
          ((ItemId, ItemQuant) -> m ()) -> [(ItemId, ItemQuant)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (ActorId -> CStore -> (ItemId, ItemQuant) -> m ()
forall {m :: * -> *} {a} {a}.
MonadServerAtomic m =>
ActorId -> CStore -> (ItemId, (a, [a])) -> m ()
applyPeriodicItem ActorId
aid CStore
COrgan) ([(ItemId, ItemQuant)] -> m ()) -> [(ItemId, ItemQuant)] -> m ()
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)])
-> ItemBag -> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> a -> b
$ Actor -> ItemBag
borgan Actor
b
          -- While we are at it, also update his Calm.
          ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Actor -> m ()
manageCalmAndDomination ActorId
aid Actor
b
  allActors <- getsState sactorD
  mapM_ applyPeriodicActor $ EM.assocs allActors

handleTrajectories :: MonadServerAtomic m => LevelId -> FactionId -> m ()
handleTrajectories :: forall (m :: * -> *).
MonadServerAtomic m =>
LevelId -> FactionId -> m ()
handleTrajectories LevelId
lid FactionId
fid = do
  localTime <- (State -> Time) -> m Time
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime LevelId
lid
  levelTime <- getsServer $ (EM.! lid) . (EM.! fid) . strajTime
  let l = [ActorId] -> [ActorId]
forall a. Ord a => [a] -> [a]
sort ([ActorId] -> [ActorId]) -> [ActorId] -> [ActorId]
forall a b. (a -> b) -> a -> b
$ ((ActorId, Time) -> ActorId) -> [(ActorId, Time)] -> [ActorId]
forall a b. (a -> b) -> [a] -> [b]
map (ActorId, Time) -> ActorId
forall a b. (a, b) -> a
fst
          ([(ActorId, Time)] -> [ActorId]) -> [(ActorId, Time)] -> [ActorId]
forall a b. (a -> b) -> a -> b
$ ((ActorId, Time) -> Bool) -> [(ActorId, Time)] -> [(ActorId, Time)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(ActorId
_, Time
atime) -> Time
atime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= Time
localTime) ([(ActorId, Time)] -> [(ActorId, Time)])
-> [(ActorId, Time)] -> [(ActorId, Time)]
forall a b. (a -> b) -> a -> b
$ EnumMap ActorId Time -> [(ActorId, Time)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap ActorId Time
levelTime
  -- The @strajTime@ map may be outdated before @hTrajectories@
  -- call (due to other actors following their trajectories),
  -- so it's only used to decide which actors are processed in this
  -- @handleTrajectories@ call. If an actor is added to the map,
  -- the recursive call to @handleTrajectories@ will detect that
  -- and process him later on.
  -- If the actor is no longer on the level or no longer belongs
  -- to the faction, it is nevertheless processed without a problem.
  -- We are guaranteed the actor still exists.
  mapM_ hTrajectories l
  -- Avoid frames between fadeout and fadein.
  breakLoop <- getsServer sbreakLoop
  unless (null l || breakLoop) $
    handleTrajectories lid fid  -- for speeds > tile/clip

hTrajectories :: MonadServerAtomic m => ActorId -> m ()
{-# INLINE hTrajectories #-}
hTrajectories :: forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
hTrajectories ActorId
aid = do
  b1 <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
  let removePushed Actor
b =
        -- No longer fulfills criteria and was not removed by dying; remove him.
        (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
          StateServer
ser { strajTime =
                  EM.adjust (EM.adjust (EM.delete aid) (blid b)) (bfid b)
                            (strajTime ser)
              , strajPushedBy = EM.delete aid (strajPushedBy ser) }
      removeTrajectory Actor
b =
        -- Non-projectile actor stops flying (a projectile with empty trajectory
        -- would be intercepted earlier on as dead).
        -- Will be removed from @strajTime@ in recursive call
        -- to @handleTrajectories@.
        Bool -> m () -> m ()
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
b)
        (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
aid (Actor -> Maybe ([Vector], Speed)
btrajectory Actor
b) Maybe ([Vector], Speed)
forall a. Maybe a
Nothing
  breakLoop <- getsServer sbreakLoop
  if breakLoop then return ()  -- don't move if game over via pushing
  else if actorDying b1 then dieSer aid b1
  else case btrajectory b1 of
    Maybe ([Vector], Speed)
Nothing -> Actor -> m ()
removePushed Actor
b1
    Just ([], Speed
_) -> Actor -> m ()
removeTrajectory Actor
b1 m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Actor -> m ()
removePushed Actor
b1
    Just{} -> do
      ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Actor -> m ()
advanceTrajectory ActorId
aid Actor
b1
      -- Here, @advanceTrajectory@ might have affected @actorDying@,
      -- so we check again ASAP to make sure the body of the projectile
      -- (or pushed actor) doesn't block movement of other actors,
      -- but vanishes promptly.
      -- Bodies of actors that die not flying remain on the battlefied until
      -- their natural next turn, to give them a chance of rescue.
      -- Note that domination of pushed actors is not checked
      -- nor is their calm updated. They are helpless wrt movement,
      -- but also invulnerable in this respect.
      b2 <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
      if actorDying b2
      then dieSer aid b2
      else case btrajectory b2 of
        Maybe ([Vector], Speed)
Nothing -> Actor -> m ()
removePushed Actor
b2
        Just ([], Speed
_) -> Actor -> m ()
removeTrajectory Actor
b2 m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Actor -> m ()
removePushed Actor
b2
        Just{} -> -- delay next iteration only if still flying
          ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
advanceTimeTraj ActorId
aid
  -- if @actorDying@ due to @bhp b <= 0@:
  -- If @b@ is a projectile, it means hits an actor or is hit by actor.
  -- Then the carried item is destroyed and that's all.
  -- If @b@ is not projectile, it dies, his items drop to the ground
  -- and possibly a new leader is elected.
  --
  -- if @actorDying@ due to @btrajectory@ null:
  -- A projectile drops to the ground due to obstacles or range.
  -- The carried item is not destroyed, unless it's fragile,
  -- but drops to the ground.

-- | Manage trajectory of a projectile or a pushed other actor.
--
-- Colliding with a wall or actor doesn't take time, because
-- the projectile does not move (the move is blocked).
-- Not advancing time forces dead projectiles to be destroyed ASAP.
-- Otherwise, with some timings, it can stay on the game map dead,
-- blocking path of human-controlled actors and alarming the hapless human.
advanceTrajectory :: MonadServerAtomic m => ActorId -> Actor -> m ()
advanceTrajectory :: forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Actor -> m ()
advanceTrajectory ActorId
aid Actor
b1 = do
  COps{coTileSpeedup} <- (State -> COps) -> m COps
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  lvl <- getLevel $ blid b1
  arTrunk <- getsState $ (EM.! btrunk b1) . sdiscoAspect
  let registerKill KillHow
killHow =
        -- Kill counts for each blast particle is TMI.
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> Bool
bproj Actor
b1
              Bool -> Bool -> Bool
&& Bool -> Bool
not (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arTrunk)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
          killer <- (StateServer -> ActorId) -> m ActorId
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> ActorId) -> m ActorId)
-> (StateServer -> ActorId) -> m ActorId
forall a b. (a -> b) -> a -> b
$ ActorId -> ActorId -> EnumMap ActorId ActorId -> ActorId
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault ActorId
aid ActorId
aid (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
          addKillToAnalytics killer killHow (bfid b1) (btrunk b1)
  case btrajectory b1 of
    Just (Vector
d : [Vector]
lv, Speed
speed) -> do
      let tpos :: Point
tpos = Actor -> Point
bpos Actor
b1 Point -> Vector -> Point
`shift` Vector
d  -- target position
      if TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup (ContentId TileKind -> Bool) -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ Level
lvl Level -> Point -> ContentId TileKind
`at` Point
tpos then do
           -- Hit will clear trajectories in @reqMelee@,
           -- so no need to do that here.
           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
aid (Actor -> Maybe ([Vector], Speed)
btrajectory Actor
b1) (([Vector], Speed) -> Maybe ([Vector], Speed)
forall a. a -> Maybe a
Just ([Vector]
lv, Speed
speed))
           Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Vector] -> Bool
forall a. [a] -> Bool
null [Vector]
lv) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ KillHow -> m ()
registerKill KillHow
KillDropLaunch
           let occupied :: Bool
occupied = Point -> Level -> Bool
occupiedBigLvl Point
tpos Level
lvl Bool -> Bool -> Bool
|| Point -> Level -> Bool
occupiedProjLvl Point
tpos Level
lvl
               reqMoveHit :: m ()
reqMoveHit = Bool -> Bool -> ActorId -> Vector -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> Bool -> ActorId -> Vector -> m ()
reqMoveGeneric Bool
False Bool
True ActorId
aid Vector
d
               reqDisp :: ActorId -> m ()
reqDisp = Bool -> ActorId -> ActorId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> ActorId -> ActorId -> m ()
reqDisplaceGeneric Bool
False ActorId
aid
           if | Actor -> Bool
bproj Actor
b1 -> m ()
reqMoveHit  -- projectiles always hit
              | Bool
occupied ->
                -- Non-projectiles displace if they are ending their flight
                -- or if only a projectile is in the way.
                -- So, no chaos of displacing a whole line of enemies.
                case (Point -> Level -> Maybe ActorId
posToBigLvl Point
tpos Level
lvl, Point -> Level -> [ActorId]
posToProjsLvl Point
tpos Level
lvl) of
                  (Maybe ActorId
Nothing, []) -> String -> m ()
forall a. (?callStack::CallStack) => String -> a
error String
"advanceTrajectory: not occupied"
                  (Maybe ActorId
Nothing, [ActorId
target]) -> ActorId -> m ()
reqDisp ActorId
target
                  (Maybe ActorId
Nothing, [ActorId]
_) -> m ()
reqMoveHit  -- can't displace multiple
                  (Just ActorId
target, []) ->
                    if [Vector] -> Bool
forall a. [a] -> Bool
null [Vector]
lv then ActorId -> m ()
reqDisp ActorId
target else m ()
reqMoveHit
                  (Just ActorId
_, [ActorId]
_) -> m ()
reqMoveHit  -- can't displace multiple
              | Bool
otherwise -> m ()
reqMoveHit  -- if not occupied, just move
      else do
           -- Will be removed from @strajTime@ in recursive call
           -- to @handleTrajectories@.
           Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> Bool
bproj Actor
b1) (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
$ ActorId -> Point -> SfxAtomic
SfxCollideTile ActorId
aid Point
tpos
           embedsPre <- (State -> ItemBag) -> m ItemBag
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> State -> ItemBag
getEmbedBag (Actor -> LevelId
blid Actor
b1) Point
tpos
           -- No crafting by projectiles that bump tiles nor by pushed actors.
           -- The only way is if they land in a tile (are engulfed by it)
           -- and have enough skill. But projectiles transform when hitting,
           -- if terrain permits, not just bump off the obstacle.
           mfail <- reqAlterFail (not $ bproj b1) EffBare False aid tpos
           embedsPost <- getsState $ getEmbedBag (blid b1) tpos
           b2 <- getsState $ getActorBody aid
           let tpos2 = Actor -> Point
bpos Actor
b2 Point -> Vector -> Point
`shift` Vector
d  -- possibly another level and/or bpos
           lvl2 <- getLevel $ blid b2
           case mfail of
             Maybe ReqFailure
Nothing | TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup (ContentId TileKind -> Bool) -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ Level
lvl2 Level -> Point -> ContentId TileKind
`at` Point
tpos2 ->
               -- Too late to announce anything, but given that the way
               -- is opened, continue flight. Don't even normally lose any HP,
               -- because it's not a hard collision, but altering.
               -- However, if embed was possibly triggered/removed, lose HP.
               if ItemBag
embedsPre ItemBag -> ItemBag -> Bool
forall a. Eq a => a -> a -> Bool
/= ItemBag
embedsPost Bool -> Bool -> Bool
&& Bool -> Bool
not (ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null ItemBag
embedsPre) then
                 if Actor -> Int64
bhp Actor
b2 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
oneM then do
                   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
aid Int64
minusM
                   b3 <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
                   advanceTrajectory aid b3
                 else do
                   -- Projectile has too low HP to pierce; terminate its flight.
                   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
aid (Actor -> Maybe ([Vector], Speed)
btrajectory Actor
b2)
                                 (Maybe ([Vector], Speed) -> UpdAtomic)
-> Maybe ([Vector], Speed) -> UpdAtomic
forall a b. (a -> b) -> a -> b
$ ([Vector], Speed) -> Maybe ([Vector], Speed)
forall a. a -> Maybe a
Just ([], Speed
speed)
                   KillHow -> m ()
registerKill KillHow
KillTileLaunch
               else
                 -- Try again with the cleared path and possibly actors
                 -- spawned in the way, etc.
                 ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Actor -> m ()
advanceTrajectory ActorId
aid Actor
b2
             Maybe ReqFailure
_ -> do
               -- Altering failed to open the passage, probably just a wall,
               -- so lose HP due to being pushed into an obstacle.
               -- Never kill in this way.
               -- Note that sometimes this may come already after one faction
               -- wins the game and end game screens are show. This is OK-ish.
               -- @Nothing@ trajectory of signals an obstacle hit.
               -- If projectile, second call of @actorDying@ above
               -- will take care of dropping dead.
               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
aid (Actor -> Maybe ([Vector], Speed)
btrajectory Actor
b2) Maybe ([Vector], Speed)
forall a. Maybe a
Nothing
               -- If projectile, losing HP due to hitting an obstacle
               -- not needed, because trajectory is halted, so projectile
               -- will die soon anyway
               if Actor -> Bool
bproj Actor
b2
               then KillHow -> m ()
registerKill KillHow
KillTileLaunch
               else Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> Int64
bhp Actor
b2 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
oneM) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
                 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
aid Int64
minusM
                 let effect :: Effect
effect = Int -> Effect
IK.RefillHP (-Int
2)  -- -2 is a lie to ensure display
                 SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> ActorId -> ItemId -> Effect -> Int64 -> SfxAtomic
SfxEffect (Actor -> FactionId
bfid Actor
b2) ActorId
aid (Actor -> ItemId
btrunk Actor
b2) Effect
effect (-Int64
1)
    Maybe ([Vector], Speed)
_ -> String -> m ()
forall a. (?callStack::CallStack) => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Nothing or empty trajectory" String -> (ActorId, Actor) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid, Actor
b1)

handleActors :: (MonadServerAtomic m, MonadServerComm m)
             => LevelId -> FactionId -> m Bool
handleActors :: forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
LevelId -> FactionId -> m Bool
handleActors LevelId
lid FactionId
fid = do
  localTime <- (State -> Time) -> m Time
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime LevelId
lid
  levelTime <- getsServer $ (EM.! lid) . (EM.! fid) . sactorTime
  let l = [ActorId] -> [ActorId]
forall a. Ord a => [a] -> [a]
sort ([ActorId] -> [ActorId]) -> [ActorId] -> [ActorId]
forall a b. (a -> b) -> a -> b
$ ((ActorId, Time) -> ActorId) -> [(ActorId, Time)] -> [ActorId]
forall a b. (a -> b) -> [a] -> [b]
map (ActorId, Time) -> ActorId
forall a b. (a, b) -> a
fst
          ([(ActorId, Time)] -> [ActorId]) -> [(ActorId, Time)] -> [ActorId]
forall a b. (a -> b) -> a -> b
$ ((ActorId, Time) -> Bool) -> [(ActorId, Time)] -> [(ActorId, Time)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(ActorId
_, Time
atime) -> Time
atime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= Time
localTime) ([(ActorId, Time)] -> [(ActorId, Time)])
-> [(ActorId, Time)] -> [(ActorId, Time)]
forall a b. (a -> b) -> a -> b
$ EnumMap ActorId Time -> [(ActorId, Time)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap ActorId Time
levelTime
  -- The @sactorTime@ map may be outdated before @hActors@
  -- call (due to other actors on the list acting),
  -- so it's only used to decide which actors are processed in this call.
  -- If the actor is no longer on the level or no longer belongs
  -- to the faction, it is nevertheless processed without a problem
  -- (the client may act wrt slightly outdated Perception and that's all).
  -- We are guaranteed the actor still exists.
  mleader <- getsState $ gleader . (EM.! fid) . sfactionD
  -- Leader acts first, so that UI leader can save&exit before state changes.
  hActors $ case mleader of
    Just ActorId
aid | ActorId
aid ActorId -> [ActorId] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ActorId]
l -> ActorId
aid ActorId -> [ActorId] -> [ActorId]
forall a. a -> [a] -> [a]
: ActorId -> [ActorId] -> [ActorId]
forall a. Eq a => a -> [a] -> [a]
delete ActorId
aid [ActorId]
l
    Maybe ActorId
_ -> [ActorId]
l

hActors :: forall m. (MonadServerAtomic m, MonadServerComm m)
        => [ActorId] -> m Bool
hActors :: forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
[ActorId] -> m Bool
hActors [] = Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
hActors as :: [ActorId]
as@(ActorId
aid : [ActorId]
rest) = do
 b1 <- (State -> Actor) -> m Actor
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
aid
 let !_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
b1) ()
 if bhp b1 <= 0 then
   -- Will be killed in a later pass, making it possible to revive him now.
   hActors rest
 else do
  let side = Actor -> FactionId
bfid Actor
b1
  fact <- getsState $ (EM.! side) . sfactionD
  breakLoop <- getsServer sbreakLoop
  let mleader = Faction -> Maybe ActorId
gleader Faction
fact
      aidIsLeader = Maybe ActorId
mleader Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid
      mainUIactor = FactionKind -> Bool
fhasUI (Faction -> FactionKind
gkind Faction
fact)
                    Bool -> Bool -> Bool
&& (Bool
aidIsLeader Bool -> Bool -> Bool
|| Bool -> Bool
not (FactionKind -> Bool
fhasPointman (Faction -> FactionKind
gkind Faction
fact)))
      -- Checking @breakLoop@, to avoid doubly setting faction status to Camping
      -- in case AI-controlled UI client asks to exit game at exactly
      -- the same moment as natural game over was detected.
      mainUIunderAI = Bool
mainUIactor Bool -> Bool -> Bool
&& Faction -> Bool
gunderAI Faction
fact Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
breakLoop
  when mainUIunderAI $
    handleUIunderAI side aid
  factNew <- getsState $ (EM.! side) . sfactionD
  let doQueryAI = Bool -> Bool
not Bool
mainUIactor Bool -> Bool -> Bool
|| Faction -> Bool
gunderAI Faction
factNew
  breakASAP <- getsServer sbreakASAP
  -- If breaking out of the game loop, pretend there was a non-wait move.
  -- we don't need additionally to check @sbreakLoop@, because it occurs alone
  -- only via action of an actor and at most one action is performed here.
  if breakASAP then return True else do
    let mswitchLeader :: Maybe ActorId -> m ActorId
        {-# NOINLINE mswitchLeader #-}
        mswitchLeader (Just ActorId
aidNew) = FactionId -> ActorId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> ActorId -> m ()
switchLeader FactionId
side ActorId
aidNew m () -> m ActorId -> m ActorId
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ActorId -> m ActorId
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
aidNew
        mswitchLeader Maybe ActorId
Nothing = ActorId -> m ActorId
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
aid
    (aidNew, mtimed) <-
      if doQueryAI then do
        (cmd, maid) <- sendQueryAI side aid
        aidNew <- mswitchLeader maid
        mtimed <- handleRequestAI cmd
        return (aidNew, mtimed)
      else do
        (cmd, maid) <- sendQueryUI RespQueryUI side aid
        aidNew <- mswitchLeader maid
        mtimed <- handleRequestUI side aidNew cmd
        return (aidNew, mtimed)
    case mtimed of
      Just RequestTimed
timed -> do
        nonWaitMove <- FactionId -> ActorId -> RequestTimed -> m Bool
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> ActorId -> RequestTimed -> m Bool
handleRequestTimed FactionId
side ActorId
aidNew RequestTimed
timed
        -- Even if the actor got a free turn of time via a scroll,
        -- he will not act again this clip, only next clip.
        -- Clip is small, so not a big deal and it's faster and avoids
        -- complete game time freezes, e.g., due to an exploit.
        if nonWaitMove then return True else hActors rest
      Maybe RequestTimed
Nothing -> do
        breakASAP2 <- (StateServer -> Bool) -> m Bool
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> Bool
sbreakASAP
        -- If breaking out of the game lopp, pretend there was a non-wait move.
        if breakASAP2 then return True else hActors as

handleUIunderAI :: (MonadServerAtomic m, MonadServerComm m)
                => FactionId -> ActorId -> m ()
handleUIunderAI :: forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
FactionId -> ActorId -> m ()
handleUIunderAI FactionId
side ActorId
aid = do
  cmdS <- Response -> FactionId -> ActorId -> m (ReqUI, Maybe ActorId)
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
Response -> FactionId -> ActorId -> m (ReqUI, Maybe ActorId)
sendQueryUI Response
RespQueryUIunderAI FactionId
side ActorId
aid
  case fst cmdS of
    ReqUI
ReqUINop -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    ReqUI
ReqUIAutomate -> UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> Bool -> UpdAtomic
UpdAutoFaction FactionId
side Bool
False
    ReqUI
ReqUIGameDropAndExit -> ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
reqGameDropAndExit ActorId
aid
    ReqUI
ReqUIGameSaveAndExit -> ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
reqGameSaveAndExit ActorId
aid
    ReqUI
_ -> String -> m ()
forall a. (?callStack::CallStack) => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"" String -> (ReqUI, Maybe ActorId) -> String
forall v. Show v => String -> v -> String
`showFailure` (ReqUI, Maybe ActorId)
cmdS

dieSer :: MonadServerAtomic m => ActorId -> Actor -> m ()
dieSer :: forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Actor -> m ()
dieSer ActorId
aid Actor
b2 = do
  if Actor -> Bool
bproj Actor
b2 then
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ([Vector], Speed) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ([Vector], Speed) -> Bool)
-> Maybe ([Vector], Speed) -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Maybe ([Vector], Speed)
btrajectory Actor
b2) (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
aid (Actor -> Maybe ([Vector], Speed)
btrajectory Actor
b2) Maybe ([Vector], Speed)
forall a. Maybe a
Nothing
        -- needed only to ensure display of the last position of projectile
  else do
    kindId <- (State -> ContentId ItemKind) -> m (ContentId ItemKind)
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ContentId ItemKind) -> m (ContentId ItemKind))
-> (State -> ContentId ItemKind) -> m (ContentId ItemKind)
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ContentId ItemKind
getIidKindIdServer (ItemId -> State -> ContentId ItemKind)
-> ItemId -> State -> ContentId ItemKind
forall a b. (a -> b) -> a -> b
$ Actor -> ItemId
btrunk Actor
b2
    execUpdAtomic $ UpdRecordKill aid kindId 1
    -- At this point the actor's body exists and his items are not dropped.
    deduceKilled aid
    -- Most probabaly already done, but just in case (e.g., when actor
    -- created with 0 HP):
    electLeader (bfid b2) (blid b2) aid
  -- If an explosion blast, before the particle is destroyed, it tries
  -- to modify terrain with it as well as do some easy crafting,
  -- e.g., cooking on fire.
  arTrunk <- (State -> AspectRecord) -> m AspectRecord
forall a. (State -> a) -> m a
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> AspectRecord) -> m AspectRecord)
-> (State -> AspectRecord) -> m AspectRecord
forall a b. (a -> b) -> a -> b
$ (EnumMap ItemId AspectRecord -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> ItemId
btrunk Actor
b2) (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 spentProj = Actor -> Bool
bproj Actor
b2 Bool -> Bool -> Bool
&& ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null (Actor -> ItemBag
beqp Actor
b2)
      isBlast = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arTrunk
      -- Let thrown food cook in fire (crafting) and other projectiles
      -- transform terrain they fall onto. Big actors are inert at death.
      (effScope, bumping) = if bproj b2
                            then (EffBareAndOnCombine, False)
                            else (EffBare, True)
  when (not spentProj && isBlast) $
    void $ reqAlterFail bumping effScope False aid (bpos b2)
  b3 <- getsState $ getActorBody aid
  -- Items need to do dropped now, so that they can be transformed by effects
  -- of the embedded items, if they are activated.
  -- If the actor was a projectile and no effect was triggered by hitting
  -- an enemy, the item still exists and @OnSmash@ effects will be triggered.
  dropAllEquippedItems aid b3
  -- Also destroy, not just drop, all organs, to trigger any effects.
  -- Note that some effects may be invoked on an actor that has
  -- no trunk any more. Conditions are ignored to avoid spam about them ending.
  bag <- getsState $ getBodyStoreBag b3 COrgan
  discoAspect <- getsState sdiscoAspect
  let f = m UseResult -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m UseResult -> m ())
-> (ItemId -> ItemQuant -> m UseResult)
-> ItemId
-> ItemQuant
-> m ()
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> Bool
-> Bool
-> CStore
-> ActorId
-> Actor
-> Int
-> ItemId
-> ItemQuant
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> Bool
-> CStore
-> ActorId
-> Actor
-> Int
-> ItemId
-> ItemQuant
-> m UseResult
dropCStoreItem Bool
False Bool
True CStore
COrgan ActorId
aid Actor
b3 Int
forall a. Bounded a => a
maxBound
      isCondition = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition (AspectRecord -> Bool)
-> (ItemId -> AspectRecord) -> ItemId -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap ItemId AspectRecord
discoAspect EnumMap ItemId AspectRecord -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.!)
  mapM_ (uncurry f) $ filter (not . isCondition . fst) $ EM.assocs bag
  -- As the last act of heroism, the actor (even if projectile)
  -- changes the terrain with its embedded items, if possible.
  -- Note that all the resulting effects are invoked on an actor that has
  -- no trunk any more.
  when (not spentProj && not isBlast) $
    void $ reqAlterFail bumping effScope False aid (bpos b2)
      -- old bpos; OK, safer
  b4 <- getsState $ getActorBody aid
  execUpdAtomic $ UpdDestroyActor aid b4 []

restartGame :: MonadServerAtomic m
            => m () -> m () -> Maybe (GroupName ModeKind) -> m ()
restartGame :: forall (m :: * -> *).
MonadServerAtomic m =>
m () -> m () -> Maybe (GroupName ModeKind) -> m ()
restartGame m ()
updConn m ()
loop Maybe (GroupName ModeKind)
mgameMode = do
  -- This goes only to the old UI client.
  SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic SfxAtomic
SfxRestart
  soptionsNxt <- (StateServer -> ServerOptions) -> m ServerOptions
forall a. (StateServer -> a) -> m a
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> ServerOptions
soptionsNxt
  srandom <- getsServer srandom
  factionDold <- getsState sfactionD
  -- Create new factions.
  s <- gameReset soptionsNxt mgameMode (Just srandom)
  -- Note how we also no longer assert exploration, because there may not be
  -- enough time left in the debug run to explore again in a new game.
  let optionsBarRngs = ServerOptions
soptionsNxt { sdungeonRng = Nothing
                                   , smainRng = Nothing
                                   , sassertExplored = Nothing }
  modifyServer $ \StateServer
ser -> StateServer
ser { soptionsNxt = optionsBarRngs
                             , soptions = optionsBarRngs }
  -- This reaches only the intersection of old and new clients.
  execUpdAtomic $ UpdRestartServer s
  -- Spawn new clients, as needed, according to new factions.
  updConn
  initPer
  reinitGame factionDold
  -- Save a just started noConfirm game to preserve history of the just
  -- ended normal game, in case the user exits brutally.
  writeSaveAll False True
  loop