    -- | Server operations performed periodically in the game loop
    -- and related operations.
    module Game.LambdaHack.Server.PeriodicM
      ( spawnMonster, addManyActors
      , advanceTime, advanceTimeTraj, overheadActorTime, swapTime
      , updateCalm, leadLevelSwitch
      , endOrLoop
    #ifdef EXPOSE_INTERNAL
        -- * Internal operations
      , addAnyActor, rollSpawnPos, gameExit
    #endif
      ) where

    import Prelude ()

    import Game.LambdaHack.Core.Prelude

    import qualified Data.EnumMap.Strict as EM
    import qualified Data.EnumSet as ES
    import           Data.Int (Int64)
    import qualified Data.IntMap.Strict as IM
    import qualified Data.Text as T

    import           Game.LambdaHack.Atomic
    import           Game.LambdaHack.Common.Actor
    import           Game.LambdaHack.Common.ActorState
    import           Game.LambdaHack.Common.Area
    import           Game.LambdaHack.Common.Faction
    import           Game.LambdaHack.Common.Item
    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.State
    import qualified Game.LambdaHack.Common.Tile as Tile
    import           Game.LambdaHack.Common.Time
    import           Game.LambdaHack.Common.Types
    import qualified Game.LambdaHack.Content.CaveKind as CK
    import           Game.LambdaHack.Content.FactionKind
    import           Game.LambdaHack.Content.ItemKind (ItemKind)
    import qualified Game.LambdaHack.Content.ItemKind as IK
    import           Game.LambdaHack.Content.ModeKind
    import           Game.LambdaHack.Core.Frequency
    import           Game.LambdaHack.Core.Random
    import qualified Game.LambdaHack.Definition.Ability as Ability
    import           Game.LambdaHack.Definition.Defs
    import           Game.LambdaHack.Server.CommonM
    import           Game.LambdaHack.Server.ItemM
    import           Game.LambdaHack.Server.ItemRev
    import           Game.LambdaHack.Server.MonadServer
    import           Game.LambdaHack.Server.ProtocolM
    import           Game.LambdaHack.Server.ServerOptions
    import           Game.LambdaHack.Server.State

    -- | Spawn, possibly, a monster according to the level's actor groups.
    -- We assume heroes are never spawned.
    spawnMonster :: MonadServerAtomic m => m ()
    spawnMonster :: forall (m :: * -> *). MonadServerAtomic m => m ()
    spawnMonster = do
     COps{cocave} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
     arenas <- getsServer sarenas
     unless (ES.null arenas) $ do
      -- Do this on only one of the arenas to prevent micromanagement,
      -- e.g., spreading leaders across levels to bump monster generation.
      arena <- rndToAction $ oneOf $ ES.elems arenas
      Level{lkind, ldepth, lbig, ltime=localTime} <- getLevel arena
      let ck = ContentData CaveKind -> ContentId CaveKind -> CaveKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData CaveKind
    cocave ContentId CaveKind
    lkind
      if | CK.cactorCoeff ck == 0 || null (CK.cactorFreq ck) -> return ()
         | EM.size lbig >= 300 ->  -- probably not so rare, but debug anyway
           -- Gameplay consideration: not fun to slog through so many actors.
           -- Caves rarely start with more than 100.
           debugPossiblyPrint "Server: spawnMonster: too many big actors on level"
         | otherwise -> do
           totalDepth <- getsState stotalDepth
           lvlSpawned <- getsServer $ fromMaybe 0 . EM.lookup arena . snumSpawned
           let perMillion =
                 AbsDepth -> AbsDepth -> Int -> Int -> Int
    monsterGenChance AbsDepth
    ldepth AbsDepth
    totalDepth Int
    lvlSpawned (CaveKind -> Int
    CK.cactorCoeff CaveKind
    ck)
               million = Int
    1000000
           k <- rndToAction $ randomR (1, million)
           when (k <= perMillion && localTime > timeTurn) $ do
             let numToSpawn | Int
    25 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    k Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    perMillion = Int
    3
                            | Int
    10 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    k Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    perMillion = Int
    2
                            | Bool
    otherwise = Int
    1
                 alt Maybe a
    Nothing = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    1
                 alt (Just a
    n) = a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> a -> Maybe a
    forall a b. (a -> b) -> a -> b
    $ a
    n a -> a -> a
    forall a. Num a => a -> a -> a
    + a
    1
             modifyServer $ \StateServer
    ser ->
               StateServer
    ser { snumSpawned = EM.insert arena (lvlSpawned + numToSpawn)
                                   $ snumSpawned ser
                   , sbandSpawned = IM.alter alt numToSpawn
                                    $ sbandSpawned ser }
             void $ addManyActors False lvlSpawned (CK.cactorFreq ck) arena
                                  localTime Nothing numToSpawn

    addAnyActor :: MonadServerAtomic m
                => Bool -> Int -> Freqs ItemKind -> LevelId -> Time -> Maybe Point
                -> m (Maybe (ActorId, Point))
    addAnyActor :: forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool
    -> Int
    -> [(GroupName ItemKind, Int)]
    -> LevelId
    -> Time
    -> Maybe Point
    -> m (Maybe (ActorId, Point))
    addAnyActor Bool
    summoned Int
    lvlSpawned [(GroupName ItemKind, Int)]
    actorFreq LevelId
    lid Time
    time Maybe Point
    mpos = do
      -- We bootstrap the actor by first creating the trunk of the actor's body
      -- that contains the fixed properties of all actors of that kind.
      cops <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      lvl@Level{ldepth} <- getLevel lid
      factionD <- getsState sfactionD
      freq <- prepareItemKind lvlSpawned ldepth actorFreq
      m2 <- rollItemAspect freq ldepth
      case m2 of
        NewItem
    NoNewItem -> do
          Text -> m ()
    forall (m :: * -> *). MonadServer m => Text -> m ()
    debugPossiblyPrint (Text -> m ()) -> Text -> m ()
    forall a b. (a -> b) -> a -> b
    $ String -> Text
    T.pack (String -> Text) -> String -> Text
    forall a b. (a -> b) -> a -> b
    $
            String
    "Server: addAnyActor: trunk failed to roll"
            String
    -> (Bool, Int, [(GroupName ItemKind, Int)],
        Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind),
        LevelId, Time, Maybe Point)
    -> String
    forall v. Show v => String -> v -> String
    `showFailure` (Bool
    summoned, Int
    lvlSpawned, [(GroupName ItemKind, Int)]
    actorFreq, Frequency (GroupName ItemKind, ContentId ItemKind, ItemKind)
    freq, LevelId
    lid, Time
    time, Maybe Point
    mpos)
          Maybe (ActorId, Point) -> m (Maybe (ActorId, Point))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (ActorId, Point)
    forall a. Maybe a
    Nothing
        NewItem GroupName ItemKind
    itemGroup ItemKnown
    itemKnownRaw ItemFull
    itemFullRaw ItemQuant
    itemQuant -> do
          (fid, _) <- Rnd (FactionId, Faction) -> m (FactionId, Faction)
    forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
    rndToAction (Rnd (FactionId, Faction) -> m (FactionId, Faction))
    -> Rnd (FactionId, Faction) -> m (FactionId, Faction)
    forall a b. (a -> b) -> a -> b
    $ Frequency (FactionId, Faction) -> Rnd (FactionId, Faction)
    forall a. Show a => Frequency a -> Rnd a
    frequency (Frequency (FactionId, Faction) -> Rnd (FactionId, Faction))
    -> Frequency (FactionId, Faction) -> Rnd (FactionId, Faction)
    forall a b. (a -> b) -> a -> b
    $
                        [GroupName ItemKind]
    -> ItemKind -> FactionDict -> Frequency (FactionId, Faction)
    possibleActorFactions [GroupName ItemKind
    itemGroup] (ItemFull -> ItemKind
    itemKind ItemFull
    itemFullRaw)
                                              FactionDict
    factionD
          let fact = FactionDict
    factionD FactionDict -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    fid
          if isJust $ gquit fact
          then return Nothing  -- the faction that spawns the monster is dead
          else do
            pers <- getsServer sperFid
            let allPers = [EnumSet Point] -> EnumSet Point
    forall k. [EnumSet k] -> EnumSet k
    ES.unions ([EnumSet Point] -> EnumSet Point)
    -> [EnumSet Point] -> EnumSet Point
    forall a b. (a -> b) -> a -> b
    $ (EnumMap LevelId Perception -> EnumSet Point)
    -> [EnumMap LevelId Perception] -> [EnumSet Point]
    forall a b. (a -> b) -> [a] -> [b]
    map (Perception -> EnumSet Point
    totalVisible (Perception -> EnumSet Point)
    -> (EnumMap LevelId Perception -> Perception)
    -> EnumMap LevelId Perception
    -> EnumSet Point
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (EnumMap LevelId Perception -> LevelId -> Perception
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! LevelId
    lid))
                          ([EnumMap LevelId Perception] -> [EnumSet Point])
    -> [EnumMap LevelId Perception] -> [EnumSet Point]
    forall a b. (a -> b) -> a -> b
    $ PerFid -> [EnumMap LevelId Perception]
    forall k a. EnumMap k a -> [a]
    EM.elems (PerFid -> [EnumMap LevelId Perception])
    -> PerFid -> [EnumMap LevelId Perception]
    forall a b. (a -> b) -> a -> b
    $ FactionId -> PerFid -> PerFid
    forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
    EM.delete FactionId
    fid PerFid
    pers  -- expensive :(
                -- Checking skill would be more accurate, but skills can be
                -- inside organs, equipment, condition organs, created organs, etc.
                freqNames = ((GroupName ItemKind, Int) -> GroupName ItemKind)
    -> [(GroupName ItemKind, Int)] -> [GroupName ItemKind]
    forall a b. (a -> b) -> [a] -> [b]
    map (GroupName ItemKind, Int) -> GroupName ItemKind
    forall a b. (a, b) -> a
    fst ([(GroupName ItemKind, Int)] -> [GroupName ItemKind])
    -> [(GroupName ItemKind, Int)] -> [GroupName ItemKind]
    forall a b. (a -> b) -> a -> b
    $ ItemKind -> [(GroupName ItemKind, Int)]
    IK.ifreq (ItemKind -> [(GroupName ItemKind, Int)])
    -> ItemKind -> [(GroupName ItemKind, Int)]
    forall a b. (a -> b) -> a -> b
    $ ItemFull -> ItemKind
    itemKind ItemFull
    itemFullRaw
                mobile = GroupName ItemKind
    IK.MOBILE GroupName ItemKind -> [GroupName ItemKind] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [GroupName ItemKind]
    freqNames
                aquatic = GroupName ItemKind
    IK.AQUATIC GroupName ItemKind -> [GroupName ItemKind] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [GroupName ItemKind]
    freqNames
            mrolledPos <- case mpos of
              Just{} -> Maybe Point -> m (Maybe Point)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Point
    mpos
              Maybe Point
    Nothing -> do
                rollPos <-
                  (State -> Rnd (Maybe Point)) -> m (Rnd (Maybe Point))
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState ((State -> Rnd (Maybe Point)) -> m (Rnd (Maybe Point)))
    -> (State -> Rnd (Maybe Point)) -> m (Rnd (Maybe Point))
    forall a b. (a -> b) -> a -> b
    $ COps
    -> EnumSet Point
    -> Bool
    -> Bool
    -> LevelId
    -> Level
    -> FactionId
    -> State
    -> Rnd (Maybe Point)
    rollSpawnPos COps
    cops EnumSet Point
    allPers Bool
    mobile Bool
    aquatic LevelId
    lid Level
    lvl FactionId
    fid
                rndToAction rollPos
            case mrolledPos of
              Just Point
    pos ->
                (ActorId, Point) -> Maybe (ActorId, Point)
    forall a. a -> Maybe a
    Just ((ActorId, Point) -> Maybe (ActorId, Point))
    -> (ActorId -> (ActorId, Point))
    -> ActorId
    -> Maybe (ActorId, Point)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (\ActorId
    aid -> (ActorId
    aid, Point
    pos))
                (ActorId -> Maybe (ActorId, Point))
    -> m ActorId -> m (Maybe (ActorId, Point))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Bool
    -> ItemKnown
    -> ItemFullKit
    -> FactionId
    -> Point
    -> LevelId
    -> Time
    -> m ActorId
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool
    -> ItemKnown
    -> ItemFullKit
    -> FactionId
    -> Point
    -> LevelId
    -> Time
    -> m ActorId
    registerActor Bool
    summoned ItemKnown
    itemKnownRaw (ItemFull
    itemFullRaw, ItemQuant
    itemQuant)
                                  FactionId
    fid Point
    pos LevelId
    lid Time
    time
              Maybe Point
    Nothing -> do
                Text -> m ()
    forall (m :: * -> *). MonadServer m => Text -> m ()
    debugPossiblyPrint
                  Text
    "Server: addAnyActor: failed to find any free position"
                Maybe (ActorId, Point) -> m (Maybe (ActorId, Point))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (ActorId, Point)
    forall a. Maybe a
    Nothing

    addManyActors :: MonadServerAtomic m
                  => Bool -> Int -> Freqs ItemKind -> LevelId -> Time -> Maybe Point
                  -> Int
                  -> m Bool
    addManyActors :: forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool
    -> Int
    -> [(GroupName ItemKind, Int)]
    -> LevelId
    -> Time
    -> Maybe Point
    -> Int
    -> m Bool
    addManyActors Bool
    summoned Int
    lvlSpawned [(GroupName ItemKind, Int)]
    actorFreq LevelId
    lid Time
    time Maybe Point
    mpos
                  Int
    howMany = Bool -> m Bool -> m Bool
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Int
    howMany Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    1) (m Bool -> m Bool) -> m Bool -> m Bool
    forall a b. (a -> b) -> a -> b
    $ do
      mInitialLAidPos <- case Maybe Point
    mpos of
        Just Point
    pos -> Maybe ([ActorId], Point) -> m (Maybe ([ActorId], Point))
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ([ActorId], Point) -> m (Maybe ([ActorId], Point)))
    -> Maybe ([ActorId], Point) -> m (Maybe ([ActorId], Point))
    forall a b. (a -> b) -> a -> b
    $ ([ActorId], Point) -> Maybe ([ActorId], Point)
    forall a. a -> Maybe a
    Just ([], Point
    pos)
        Maybe Point
    Nothing ->
          (\(ActorId
    aid, Point
    pos) -> ([ActorId
    aid], Point
    pos))
          ((ActorId, Point) -> ([ActorId], Point))
    -> m (Maybe (ActorId, Point)) -> m (Maybe ([ActorId], Point))
    forall (f :: * -> *) (g :: * -> *) a b.
    (Functor f, Functor g) =>
    (a -> b) -> f (g a) -> f (g b)
    <$$> Bool
    -> Int
    -> [(GroupName ItemKind, Int)]
    -> LevelId
    -> Time
    -> Maybe Point
    -> m (Maybe (ActorId, Point))
    forall (m :: * -> *).
    MonadServerAtomic m =>
    Bool
    -> Int
    -> [(GroupName ItemKind, Int)]
    -> LevelId
    -> Time
    -> Maybe Point
    -> m (Maybe (ActorId, Point))
    addAnyActor Bool
    summoned Int
    lvlSpawned [(GroupName ItemKind, Int)]
    actorFreq LevelId
    lid Time
    time Maybe Point
    forall a. Maybe a
    Nothing
      case mInitialLAidPos of
        Maybe ([ActorId], Point)
    Nothing -> Bool -> m Bool
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False  -- suspect content; server debug elsewhere
        Just ([ActorId]
    laid, Point
    pos) -> do
          cops@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 lid
          let validTile ContentId TileKind
    t = Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ TileSpeedup -> ContentId TileKind -> Bool
    Tile.isNoActor TileSpeedup
    coTileSpeedup ContentId TileKind
    t
              ps = COps -> Level -> (ContentId TileKind -> Bool) -> Point -> [Point]
    nearbyFreePoints COps
    cops Level
    lvl ContentId TileKind -> Bool
    validTile Point
    pos
              psNeeded = Int -> [Point] -> [Point]
    forall a. Int -> [a] -> [a]
    take (Int
    howMany Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - [ActorId] -> Int
    forall a. [a] -> Int
    length [ActorId]
    laid) [Point]
    ps
          when (length psNeeded < howMany - length laid) $
            debugPossiblyPrint $
              "Server: addManyActors: failed to find enough free positions at"
              <+> tshow (lid, pos)
          maidposs <- forM psNeeded $
            addAnyActor summoned lvlSpawned actorFreq lid time . Just
          case laid ++ map fst (catMaybes maidposs) of
            [] -> Bool -> m Bool
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
            ActorId
    aid : [ActorId]
    _ -> 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
    aid
              mleader <- getsState $ gleader . (EM.! bfid b) . sfactionD
              when (isNothing mleader) $ setFreshLeader (bfid b) aid
              return True

    rollSpawnPos :: COps -> ES.EnumSet Point
                 -> Bool -> Bool -> LevelId -> Level -> FactionId -> State
                 -> Rnd (Maybe Point)
    rollSpawnPos :: COps
    -> EnumSet Point
    -> Bool
    -> Bool
    -> LevelId
    -> Level
    -> FactionId
    -> State
    -> Rnd (Maybe Point)
    rollSpawnPos COps{TileSpeedup
    coTileSpeedup :: COps -> TileSpeedup
    coTileSpeedup :: TileSpeedup
    coTileSpeedup} EnumSet Point
    visible
                 Bool
    mobile Bool
    aquatic LevelId
    lid lvl :: Level
    lvl@Level{Area
    larea :: Area
    larea :: Level -> Area
    larea} FactionId
    fid State
    s = do
      let inhabitants :: [Actor]
    inhabitants = FactionId -> LevelId -> State -> [Actor]
    foeRegularList FactionId
    fid LevelId
    lid State
    s
          nearInh :: Int -> Point -> Bool
    nearInh !Int
    d !Point
    p = (Actor -> Bool) -> [Actor] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (\ !Actor
    b -> Point -> Point -> Int
    chessDist (Actor -> Point
    bpos Actor
    b) Point
    p Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    d) [Actor]
    inhabitants
          farInh :: Int -> Point -> Bool
    farInh !Int
    d !Point
    p = (Actor -> Bool) -> [Actor] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (\ !Actor
    b -> Point -> Point -> Int
    chessDist (Actor -> Point
    bpos Actor
    b) Point
    p Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    d) [Actor]
    inhabitants
          (Point
    _, Int
    xspan, Int
    yspan) = Area -> (Point, Int, Int)
    spanArea Area
    larea
          averageSpan :: Int
    averageSpan = (Int
    xspan Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    yspan) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2
          distantMiddle :: Int -> Point -> Bool
    distantMiddle !Int
    d !Point
    p = Point -> Point -> Int
    chessDist Point
    p (Area -> Point
    middlePoint Area
    larea) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    d
          -- Don't spawn very far from foes, to keep the player entertained,
          -- but not too close, so that standing on positions with better
          -- visibility does not influence the spawn places too often,
          -- to avoid unnatural position micromanagement using AI predictability.
          condList :: [Point -> Bool]
    condList | Bool
    mobile =
            [ \Point
    p -> Int -> Point -> Bool
    nearInh (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    15 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int
    averageSpan Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2) Point
    p
                    Bool -> Bool -> Bool
    && Int -> Point -> Bool
    farInh Int
    10 Point
    p
            , \Point
    p -> Int -> Point -> Bool
    nearInh (Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    15 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    averageSpan Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    3) Point
    p
                    Bool -> Bool -> Bool
    && Int -> Point -> Bool
    farInh Int
    5 Point
    p
            ]
                   | Bool
    otherwise =
            [ Int -> Point -> Bool
    distantMiddle Int
    8
            , Int -> Point -> Bool
    distantMiddle Int
    16
            , Int -> Point -> Bool
    distantMiddle Int
    24
            , Int -> Point -> Bool
    distantMiddle Int
    26
            , Int -> Point -> Bool
    distantMiddle Int
    28
            , Int -> Point -> Bool
    distantMiddle Int
    30
            ]
      -- Not considering TK.OftenActor, because monsters emerge from hidden ducts,
      -- which are easier to hide in crampy corridors that lit halls.
      Int
    -> Level
    -> (Point -> ContentId TileKind -> Bool)
    -> [Point -> ContentId TileKind -> Bool]
    -> (Point -> ContentId TileKind -> Bool)
    -> [Point -> ContentId TileKind -> Bool]
    -> Rnd (Maybe Point)
    findPosTry2 (if Bool
    mobile then Int
    500 else Int
    50) Level
    lvl
        ( \Point
    p !ContentId TileKind
    t -> TileSpeedup -> ContentId TileKind -> Bool
    Tile.isWalkable TileSpeedup
    coTileSpeedup ContentId TileKind
    t
                   Bool -> Bool -> Bool
    && Bool -> Bool
    not (TileSpeedup -> ContentId TileKind -> Bool
    Tile.isNoActor TileSpeedup
    coTileSpeedup ContentId TileKind
    t)
                   Bool -> Bool -> Bool
    && Bool -> Bool
    not (Point -> Level -> Bool
    occupiedBigLvl Point
    p Level
    lvl)
                   Bool -> Bool -> Bool
    && Bool -> Bool
    not (Point -> Level -> Bool
    occupiedProjLvl Point
    p Level
    lvl) )
        (((Point -> Bool) -> Point -> ContentId TileKind -> Bool)
    -> [Point -> Bool] -> [Point -> ContentId TileKind -> Bool]
    forall a b. (a -> b) -> [a] -> [b]
    map (\Point -> Bool
    f Point
    p ContentId TileKind
    _ -> Point -> Bool
    f Point
    p) [Point -> Bool]
    condList)
        (\ !Point
    p ContentId TileKind
    t -> Int -> Point -> Bool
    farInh Int
    3 Point
    p  -- otherwise actors in dark rooms swarmed
                   Bool -> Bool -> Bool
    && Bool -> Bool
    not (Point
    p Point -> EnumSet Point -> Bool
    forall k. Enum k => k -> EnumSet k -> Bool
    `ES.member` EnumSet Point
    visible)  -- visibility and plausibility
                   Bool -> Bool -> Bool
    && (Bool -> Bool
    not Bool
    aquatic Bool -> Bool -> Bool
    || TileSpeedup -> ContentId TileKind -> Bool
    Tile.isAquatic TileSpeedup
    coTileSpeedup ContentId TileKind
    t))
        [ \ !Point
    p ContentId TileKind
    _ -> Int -> Point -> Bool
    farInh Int
    3 Point
    p
                    Bool -> Bool -> Bool
    && Bool -> Bool
    not (Point
    p Point -> EnumSet Point -> Bool
    forall k. Enum k => k -> EnumSet k -> Bool
    `ES.member` EnumSet Point
    visible)
        , \ !Point
    p ContentId TileKind
    _ -> Int -> Point -> Bool
    farInh Int
    2 Point
    p  -- otherwise actors hit on entering level
                    Bool -> Bool -> Bool
    && Bool -> Bool
    not (Point
    p Point -> EnumSet Point -> Bool
    forall k. Enum k => k -> EnumSet k -> Bool
    `ES.member` EnumSet Point
    visible)
        , \ !Point
    p ContentId TileKind
    _ -> Bool -> Bool
    not (Point
    p Point -> EnumSet Point -> Bool
    forall k. Enum k => k -> EnumSet k -> Bool
    `ES.member` EnumSet Point
    visible)
        ]

    -- | Advance the move time for the given actor.
    advanceTime :: MonadServerAtomic m => ActorId -> Int -> Bool -> m ()
    advanceTime :: forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> Int -> Bool -> m ()
    advanceTime ActorId
    aid Int
    percent Bool
    breakStasis = 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
    aid
      actorMaxSk <- getsState $ getActorMaxSkills aid
      let t = Delta Time -> Int -> Delta Time
    timeDeltaPercent (Speed -> Delta Time
    ticksPerMeter (Speed -> Delta Time) -> Speed -> Delta Time
    forall a b. (a -> b) -> a -> b
    $ Skills -> Speed
    gearSpeed Skills
    actorMaxSk) Int
    percent
      -- @t@ may be negative; that's OK.
      modifyServer $ \StateServer
    ser ->
        StateServer
    ser {sactorTime = ageActor (bfid b) (blid b) aid t $ sactorTime ser}
      when breakStasis $
        modifyServer $ \StateServer
    ser ->
          StateServer
    ser {sactorStasis = ES.delete aid (sactorStasis ser)}
                 -- actor moved, so he broke the time stasis, he can be
                 -- paralyzed as well as propelled again

    -- | Advance the trajectory following time for the given actor.
    advanceTimeTraj :: MonadServerAtomic m => ActorId -> m ()
    advanceTimeTraj :: forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
    advanceTimeTraj ActorId
    aid = 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
    aid
      let speedTraj = case Actor -> Maybe ([Vector], Speed)
    btrajectory Actor
    b of
            Maybe ([Vector], Speed)
    Nothing -> String -> Speed
    forall a. (?callStack::CallStack) => String -> a
    error (String -> Speed) -> String -> Speed
    forall a b. (a -> b) -> a -> b
    $ String
    "" String -> Actor -> String
    forall v. Show v => String -> v -> String
    `showFailure` Actor
    b
            Just ([Vector]
    _, Speed
    speed) -> Speed
    speed
          t = Speed -> Delta Time
    ticksPerMeter Speed
    speedTraj
      -- @t@ may be negative; that's OK.
      modifyServer $ \StateServer
    ser ->
        StateServer
    ser {strajTime = ageActor (bfid b) (blid b) aid t $ strajTime ser}

    -- | Add communication overhead time delta to all non-projectile, non-dying
    -- faction's actors, except the leader. Effectively, this limits moves
    -- of a faction on a level to 10, regardless of the number of actors
    -- and their speeds. To avoid animals suddenly acting extremely sluggish
    -- whenever monster's leader visits a distant arena that has a crowd
    -- of animals, overhead applies only to actors on the same level.
    -- Since the number of active levels is limited, this bounds the total moves
    -- per turn of each faction as well.
    --
    -- Leader is immune from overhead and so he is faster than other faction
    -- members and of equal speed to leaders of other factions (of equal
    -- base speed) regardless how numerous the faction is.
    -- Thanks to this, there is no problem with leader of a numerous faction
    -- having very long UI turns, introducing UI lag.
    overheadActorTime :: MonadServerAtomic m => FactionId -> LevelId -> m ()
    overheadActorTime :: forall (m :: * -> *).
    MonadServerAtomic m =>
    FactionId -> LevelId -> m ()
    overheadActorTime FactionId
    fid LevelId
    lid = do
      -- Only non-projectiles processed, because @strajTime@ ignored.
      actorTimeFid <- (StateServer -> EnumMap LevelId (EnumMap ActorId Time))
    -> m (EnumMap LevelId (EnumMap ActorId Time))
    forall a. (StateServer -> a) -> m a
    forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
    getsServer ((StateServer -> EnumMap LevelId (EnumMap ActorId Time))
     -> m (EnumMap LevelId (EnumMap ActorId Time)))
    -> (StateServer -> EnumMap LevelId (EnumMap ActorId Time))
    -> m (EnumMap LevelId (EnumMap ActorId Time))
    forall a b. (a -> b) -> a -> b
    $ (ActorTime -> FactionId -> EnumMap LevelId (EnumMap ActorId Time)
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    fid) (ActorTime -> EnumMap LevelId (EnumMap ActorId Time))
    -> (StateServer -> ActorTime)
    -> StateServer
    -> EnumMap LevelId (EnumMap ActorId Time)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . StateServer -> ActorTime
    sactorTime
      let actorTimeLid = EnumMap LevelId (EnumMap ActorId Time)
    actorTimeFid EnumMap LevelId (EnumMap ActorId Time)
    -> LevelId -> EnumMap ActorId Time
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! LevelId
    lid
      getActorB <- getsState $ flip getActorBody
      mleader <- getsState $ gleader . (EM.! fid) . sfactionD
      let f !ActorId
    aid !Time
    time =
            let body :: Actor
    body = ActorId -> Actor
    getActorB ActorId
    aid
            in if Actor -> Int64
    bhp Actor
    body Int64 -> Int64 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int64
    0  -- speed up all-move-at-once carcass removal
                  Bool -> Bool -> Bool
    && ActorId -> Maybe ActorId
    forall a. a -> Maybe a
    Just ActorId
    aid Maybe ActorId -> Maybe ActorId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Maybe ActorId
    mleader  -- leader fast, for UI to be fast
               then Time -> Delta Time -> Time
    timeShift Time
    time (Time -> Delta Time
    forall a. a -> Delta a
    Delta Time
    timeClip)
               else Time
    time
          actorTimeLid2 = (ActorId -> Time -> Time)
    -> EnumMap ActorId Time -> EnumMap ActorId Time
    forall k a b. Enum k => (k -> a -> b) -> EnumMap k a -> EnumMap k b
    EM.mapWithKey ActorId -> Time -> Time
    f EnumMap ActorId Time
    actorTimeLid
          actorTimeFid2 = LevelId
    -> EnumMap ActorId Time
    -> EnumMap LevelId (EnumMap ActorId Time)
    -> EnumMap LevelId (EnumMap ActorId Time)
    forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
    EM.insert LevelId
    lid EnumMap ActorId Time
    actorTimeLid2 EnumMap LevelId (EnumMap ActorId Time)
    actorTimeFid
      modifyServer $ \StateServer
    ser ->
        StateServer
    ser {sactorTime = EM.insert fid actorTimeFid2 $ sactorTime ser}

    -- | Swap the relative move times of two actors (e.g., when switching
    -- a UI leader). Notice that their trajectory move times are not swapped.
    swapTime :: MonadServerAtomic m => ActorId -> ActorId -> m ()
    swapTime :: forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> ActorId -> m ()
    swapTime ActorId
    source ActorId
    target = do
      sb <- (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
    source
      tb <- getsState $ getActorBody target
      slvl <- getsState $ getLocalTime (blid sb)
      tlvl <- getsState $ getLocalTime (blid tb)
      btime_sb <-
        getsServer
        $ fromJust . lookupActorTime (bfid sb) (blid sb) source . sactorTime
      btime_tb <-
        getsServer
        $ fromJust . lookupActorTime (bfid tb) (blid tb) target . sactorTime
      let lvlDelta = Time
    slvl Time -> Time -> Delta Time
    `timeDeltaToFrom` Time
    tlvl
          bDelta = Time
    btime_sb Time -> Time -> Delta Time
    `timeDeltaToFrom` Time
    btime_tb
          sdelta = Delta Time -> Delta Time -> Delta Time
    timeDeltaSubtract Delta Time
    lvlDelta Delta Time
    bDelta
          tdelta = Delta Time -> Delta Time
    timeDeltaReverse Delta Time
    sdelta
      -- Equivalent, for the assert:
      let !_A = let sbodyDelta :: Delta Time
    sbodyDelta = Time
    btime_sb Time -> Time -> Delta Time
    `timeDeltaToFrom` Time
    slvl
                    tbodyDelta :: Delta Time
    tbodyDelta = Time
    btime_tb Time -> Time -> Delta Time
    `timeDeltaToFrom` Time
    tlvl
                    sgoal :: Time
    sgoal = Time
    slvl Time -> Delta Time -> Time
    `timeShift` Delta Time
    tbodyDelta
                    tgoal :: Time
    tgoal = Time
    tlvl Time -> Delta Time -> Time
    `timeShift` Delta Time
    sbodyDelta
                    sdelta' :: Delta Time
    sdelta' = Time
    sgoal Time -> Time -> Delta Time
    `timeDeltaToFrom` Time
    btime_sb
                    tdelta' :: Delta Time
    tdelta' = Time
    tgoal Time -> Time -> Delta Time
    `timeDeltaToFrom` Time
    btime_tb
                in Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (Delta Time
    sdelta Delta Time -> Delta Time -> Bool
    forall a. Eq a => a -> a -> Bool
    == Delta Time
    sdelta' Bool -> Bool -> Bool
    && Delta Time
    tdelta Delta Time -> Delta Time -> Bool
    forall a. Eq a => a -> a -> Bool
    == Delta Time
    tdelta'
                           Bool
    -> (Time, Time, Time, Time, Delta Time, Delta Time, Delta Time,
        Delta Time)
    -> Bool
    forall v. Show v => Bool -> v -> Bool
    `blame` ( Time
    slvl, Time
    tlvl, Time
    btime_sb, Time
    btime_tb
                                   , Delta Time
    sdelta, Delta Time
    sdelta', Delta Time
    tdelta, Delta Time
    tdelta' )) ()
      when (sdelta /= Delta timeZero) $ modifyServer $ \StateServer
    ser ->
        StateServer
    ser {sactorTime = ageActor (bfid sb) (blid sb) source sdelta
                          $ sactorTime ser}
      when (tdelta /= Delta timeZero) $ modifyServer $ \StateServer
    ser ->
        StateServer
    ser {sactorTime = ageActor (bfid tb) (blid tb) target tdelta
                          $ sactorTime ser}

    updateCalm :: MonadServerAtomic m => ActorId -> Int64 -> m ()
    updateCalm :: forall (m :: * -> *).
    MonadServerAtomic m =>
    ActorId -> Int64 -> m ()
    updateCalm ActorId
    target Int64
    deltaCalm = do
      tb <- (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
    target
      actorMaxSk <- getsState $ getActorMaxSkills target
      let calmMax64 = Int -> Int64
    xM (Int -> Int64) -> Int -> Int64
    forall a b. (a -> b) -> a -> b
    $ Skill -> Skills -> Int
    Ability.getSk Skill
    Ability.SkMaxCalm Skills
    actorMaxSk
      execUpdAtomic $ UpdRefillCalm target deltaCalm
      when (bcalm tb < calmMax64
            && bcalm tb + deltaCalm >= calmMax64) $
        return ()
        -- We don't dominate the actor here, because if so, players would
        -- disengage after one of their actors is dominated and wait for him
        -- to regenerate Calm. This is unnatural and boring. Better fight
        -- and hope he gets his Calm again to 0 and then defects back.
        -- We could instead tell here that Calm is fully regenerated,
        -- but that would be too verbose.

    leadLevelSwitch :: MonadServerAtomic m => m ()
    leadLevelSwitch :: forall (m :: * -> *). MonadServerAtomic m => m ()
    leadLevelSwitch = do
      COps{cocave} <- (State -> COps) -> m COps
    forall a. (State -> a) -> m a
    forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
    getsState State -> COps
    scops
      factionD <- getsState sfactionD
      -- Leader switching between levels can be done by the client
      -- (e.g,. UI client of the human) or by the server
      -- (the frequency of leader level switching done by the server
      -- is controlled by @RuleKind.rleadLevelClips@). Regardless, the server
      -- alwayw does a subset of the switching, e.g., when the old leader dies
      -- and no other actor of the faction resides on his level.
      -- Here we check if the server is permitted to handle the mundane cases.
      let serverMaySwitch Faction
    fact =
            Faction -> Bool
    bannedPointmanSwitchBetweenLevels Faction
    fact
              -- client banned from switching, so the sever has to step in
            Bool -> Bool -> Bool
    || Faction -> Bool
    gunderAI Faction
    fact
                 -- a hack to help AI, until AI client can switch levels
          flipFaction (FactionId
    _, Faction
    fact) | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Faction -> Bool
    serverMaySwitch Faction
    fact = () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          flipFaction (FactionId
    fid, Faction
    fact) =
            case Faction -> Maybe ActorId
    gleader Faction
    fact of
              Maybe ActorId
    Nothing -> () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
              Just ActorId
    leader -> do
                body <- (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
                let !_A = Bool -> () -> ()
    forall a. (?callStack::CallStack) => Bool -> a -> a
    assert (FactionId
    fid FactionId -> FactionId -> Bool
    forall a. Eq a => a -> a -> Bool
    == Actor -> FactionId
    bfid Actor
    body) ()
                s <- getsServer $ (EM.! fid) . sclientStates
                let leaderStuck = Actor -> Bool
    actorWaits Actor
    body
                    lvlsRaw =
                      [ ((LevelId
    lid, Level
    lvl), (Bool
    allSeen, [(ActorId, Actor)]
    as))
                      | (LevelId
    lid, Level
    lvl) <- EnumMap LevelId Level -> [(LevelId, Level)]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs (EnumMap LevelId Level -> [(LevelId, Level)])
    -> EnumMap LevelId Level -> [(LevelId, Level)]
    forall a b. (a -> b) -> a -> b
    $ State -> EnumMap LevelId Level
    sdungeon State
    s
                      , LevelId
    lid LevelId -> LevelId -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Actor -> LevelId
    blid Actor
    body Bool -> Bool -> Bool
    || Bool -> Bool
    not Bool
    leaderStuck
                      , let asRaw :: [(ActorId, Actor)]
    asRaw = -- Drama levels ignored, hence @Regular@.
                                    FactionId -> LevelId -> State -> [(ActorId, Actor)]
    fidActorRegularAssocs FactionId
    fid LevelId
    lid State
    s
                            isAlert :: (a, Actor) -> Bool
    isAlert (a
    _, Actor
    b) = case Actor -> Watchfulness
    bwatch Actor
    b of
                              Watchfulness
    WWatch -> Bool
    True
                              WWait Int
    n -> Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0
                              Watchfulness
    WSleep -> Bool
    False
                              Watchfulness
    WWake -> Bool
    True  -- probably in danger
                            ([(ActorId, Actor)]
    alert, [(ActorId, Actor)]
    relaxed) = ((ActorId, Actor) -> Bool)
    -> [(ActorId, Actor)] -> ([(ActorId, Actor)], [(ActorId, Actor)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (ActorId, Actor) -> Bool
    forall {a}. (a, Actor) -> Bool
    isAlert [(ActorId, Actor)]
    asRaw
                            as :: [(ActorId, Actor)]
    as = [(ActorId, Actor)]
    alert [(ActorId, Actor)] -> [(ActorId, Actor)] -> [(ActorId, Actor)]
    forall a. [a] -> [a] -> [a]
    ++ [(ActorId, Actor)]
    relaxed  -- best switch leader to alert
                      , Bool -> Bool
    not ([(ActorId, Actor)] -> Bool
    forall a. [a] -> Bool
    null [(ActorId, Actor)]
    as)
                      , let allSeen :: Bool
    allSeen =
                              Level -> Int
    lexpl Level
    lvl Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Level -> Int
    lseen Level
    lvl
                              Bool -> Bool -> Bool
    || CaveKind -> Int
    CK.cactorCoeff (ContentData CaveKind -> ContentId CaveKind -> CaveKind
    forall a. ContentData a -> ContentId a -> a
    okind ContentData CaveKind
    cocave (ContentId CaveKind -> CaveKind) -> ContentId CaveKind -> CaveKind
    forall a b. (a -> b) -> a -> b
    $ Level -> ContentId CaveKind
    lkind Level
    lvl) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    150
                                 Bool -> Bool -> Bool
    && Bool -> Bool
    not (FactionKind -> Bool
    fhasGender (FactionKind -> Bool) -> FactionKind -> Bool
    forall a b. (a -> b) -> a -> b
    $ Faction -> FactionKind
    gkind Faction
    fact)
                      ]
                    (lvlsSeen, lvlsNotSeen) = partition (fst . snd) lvlsRaw
                    -- Monster AI changes leadership mostly to move from level
                    -- to level and, in particular, to quickly bring troops
                    -- to the frontline level and so prevent human from killing
                    -- monsters at numerical advantage.
                    -- However, an AI boss that can't move between levels
                    -- disrupts this by hogging leadership. To prevent that,
                    -- assuming the boss resides below the frontline level,
                    -- only the two shallowest levels that are not yet fully
                    -- explored are considered to choose the new leader from.
                    -- This frontier moves as the levels are explored or emptied
                    -- and sometimes the level with the boss is counted among
                    -- them, but it never happens in the crucial periods when
                    -- AI armies are transferred from level to level.
                    f ((a
    _, Level
    lvl), b
    _) = Level -> AbsDepth
    ldepth Level
    lvl
                    lvls = [((LevelId, Level), (Bool, [(ActorId, Actor)]))]
    lvlsSeen [((LevelId, Level), (Bool, [(ActorId, Actor)]))]
    -> [((LevelId, Level), (Bool, [(ActorId, Actor)]))]
    -> [((LevelId, Level), (Bool, [(ActorId, Actor)]))]
    forall a. [a] -> [a] -> [a]
    ++ Int
    -> [((LevelId, Level), (Bool, [(ActorId, Actor)]))]
    -> [((LevelId, Level), (Bool, [(ActorId, Actor)]))]
    forall a. Int -> [a] -> [a]
    take Int
    2 ((((LevelId, Level), (Bool, [(ActorId, Actor)]))
     -> ((LevelId, Level), (Bool, [(ActorId, Actor)])) -> Ordering)
    -> [((LevelId, Level), (Bool, [(ActorId, Actor)]))]
    -> [((LevelId, Level), (Bool, [(ActorId, Actor)]))]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy ((((LevelId, Level), (Bool, [(ActorId, Actor)])) -> AbsDepth)
    -> ((LevelId, Level), (Bool, [(ActorId, Actor)]))
    -> ((LevelId, Level), (Bool, [(ActorId, Actor)]))
    -> Ordering
    forall a b. Ord a => (b -> a) -> b -> b -> Ordering
    comparing ((LevelId, Level), (Bool, [(ActorId, Actor)])) -> AbsDepth
    forall {a} {b}. ((a, Level), b) -> AbsDepth
    f) [((LevelId, Level), (Bool, [(ActorId, Actor)]))]
    lvlsNotSeen)
                -- Actors on desolate levels (not many own or enemy non-projectiles)
                -- tend to become (or stay) leaders so that they can join the main
                -- force where it matters ASAP. Unfortunately, this keeps hero
                -- scouts as leader, but foes spawn very fast early on ,
                -- so they give back leadership rather quickly to let others follow.
                -- We count non-mobile and sleeping actors, because they may
                -- be dangerous, especially if adjacent to stairs.
                let overOwnStash Actor
    b = (LevelId, Point) -> Maybe (LevelId, Point)
    forall a. a -> Maybe a
    Just (Actor -> LevelId
    blid Actor
    b, Actor -> Point
    bpos Actor
    b) Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
    forall a. Eq a => a -> a -> Bool
    == Faction -> Maybe (LevelId, Point)
    gstash Faction
    fact
                    freqList = [ (Int
    k, (LevelId
    lid, ActorId
    aid))
                               | ((LevelId
    lid, Level
    lvl), (Bool
    _, (ActorId
    aid, Actor
    b) : [(ActorId, Actor)]
    rest)) <- [((LevelId, Level), (Bool, [(ActorId, Actor)]))]
    lvls
                               , let len :: Int
    len = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    min Int
    20 (BigActorMap -> Int
    forall k a. EnumMap k a -> Int
    EM.size (BigActorMap -> Int) -> BigActorMap -> Int
    forall a b. (a -> b) -> a -> b
    $ Level -> BigActorMap
    lbig Level
    lvl)
                                     n :: Int
    n = Int
    1000000 Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` (Int
    1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    len)
                                     -- Visit the stash guard rarely, but not too
                                     -- rarely, to regen Calm and fling at foes.
                                     k :: Int
    k = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    1 (Int -> Int) -> Int -> Int
    forall a b. (a -> b) -> a -> b
    $ if [(ActorId, Actor)] -> Bool
    forall a. [a] -> Bool
    null [(ActorId, Actor)]
    rest Bool -> Bool -> Bool
    && Actor -> Bool
    overOwnStash Actor
    b
                                                 then Int
    n Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    30
                                                 else Int
    n
                               ]
                    closeToFactStash (FactionId
    fid2, Faction
    fact2) = case Faction -> Maybe (LevelId, Point)
    gstash Faction
    fact2 of
                      Just (LevelId
    lid, Point
    pos) ->
                        (FactionId
    fid FactionId -> FactionId -> Bool
    forall a. Eq a => a -> a -> Bool
    == FactionId
    fid2 Bool -> Bool -> Bool
    || FactionId -> Faction -> FactionId -> Bool
    isFoe FactionId
    fid (FactionDict
    factionD FactionDict -> FactionId -> Faction
    forall k a. Enum k => EnumMap k a -> k -> a
    EM.! FactionId
    fid) FactionId
    fid2)
                        Bool -> Bool -> Bool
    && LevelId
    lid LevelId -> LevelId -> Bool
    forall a. Eq a => a -> a -> Bool
    == Actor -> LevelId
    blid Actor
    body
                        Bool -> Bool -> Bool
    && Point -> Point -> Int
    chessDist Point
    pos (Actor -> Point
    bpos Actor
    body) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1  -- visible
                      Maybe (LevelId, Point)
    Nothing -> Bool
    False
                    closeToEnemyStash = ((FactionId, Faction) -> Bool) -> [(FactionId, Faction)] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (FactionId, Faction) -> Bool
    closeToFactStash ([(FactionId, Faction)] -> Bool) -> [(FactionId, Faction)] -> Bool
    forall a b. (a -> b) -> a -> b
    $ FactionDict -> [(FactionId, Faction)]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs FactionDict
    factionD
                foes <- getsState $ foeRegularList fid (blid body)
                ours <- getsState $ map snd
                                    <$> fidActorRegularAssocs fid (blid body)
                let foesClose = (Actor -> Bool) -> [Actor] -> [Actor]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\Actor
    b -> Point -> Point -> Int
    chessDist (Actor -> Point
    bpos Actor
    body) (Actor -> Point
    bpos Actor
    b) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    2)
                                       [Actor]
    foes
                    oursCloseMelee =
                      (Actor -> Bool) -> [Actor] -> [Actor]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\Actor
    b -> Point -> Point -> Int
    chessDist (Actor -> Point
    bpos Actor
    body) (Actor -> Point
    bpos Actor
    b) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    2
                                    Bool -> Bool -> Bool
    && Actor -> Int
    bweapon Actor
    b Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Actor -> Int
    bweapBenign Actor
    b Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0)
                             [Actor]
    ours
                    canHelpMelee =
                      Bool -> Bool
    not Bool
    leaderStuck
                      Bool -> Bool -> Bool
    && [Actor] -> Int
    forall a. [a] -> Int
    length [Actor]
    oursCloseMelee Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    2
                      Bool -> Bool -> Bool
    && Bool -> Bool
    not ([Actor] -> Bool
    forall a. [a] -> Bool
    null [Actor]
    foesClose)
                      Bool -> Bool -> Bool
    && Bool -> Bool
    not ((Actor -> Bool) -> [Actor] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (\Actor
    b -> (Actor -> Bool) -> [Actor] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Point -> Point -> Bool
    adjacent (Actor -> Point
    bpos Actor
    b) (Point -> Bool) -> (Actor -> Point) -> Actor -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Actor -> Point
    bpos) [Actor]
    foes)
                                  [Actor]
    oursCloseMelee)
                unless (closeToEnemyStash || canHelpMelee || null freqList) $ do
                  (lid, a) <- rndToAction $ frequency
                                          $ toFreq "leadLevel" freqList
                  unless (lid == blid body) $  -- flip levels rather than actors
                    setFreshLeader fid a
      mapM_ flipFaction $ EM.assocs factionD

    -- | Continue or exit or restart the game.
    endOrLoop :: (MonadServerAtomic m, MonadServerComm m)
              => m () -> (Maybe (GroupName ModeKind) -> m ())
              -> m ()
    {-# INLINE endOrLoop #-}
    endOrLoop :: forall (m :: * -> *).
    (MonadServerAtomic m, MonadServerComm m) =>
    m () -> (Maybe (GroupName ModeKind) -> m ()) -> m ()
    endOrLoop m ()
    loop Maybe (GroupName ModeKind) -> m ()
    restart = 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
      let inGame Faction
    fact = case Faction -> Maybe Status
    gquit Faction
    fact of
            Maybe Status
    Nothing -> Bool
    True
            Just Status{stOutcome :: Status -> Outcome
    stOutcome=Outcome
    Camping} -> Bool
    True
            Maybe Status
    _ -> Bool
    False
          gameOver = Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ (Faction -> Bool) -> [Faction] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Faction -> Bool
    inGame ([Faction] -> Bool) -> [Faction] -> Bool
    forall a b. (a -> b) -> a -> b
    $ FactionDict -> [Faction]
    forall k a. EnumMap k a -> [a]
    EM.elems FactionDict
    factionD
      let getQuitter Faction
    fact = case Faction -> Maybe Status
    gquit Faction
    fact of
            Just Status{stOutcome :: Status -> Outcome
    stOutcome=Outcome
    Restart, Maybe (GroupName ModeKind)
    stNewGame :: Maybe (GroupName ModeKind)
    stNewGame :: Status -> Maybe (GroupName ModeKind)
    stNewGame} -> Maybe (GroupName ModeKind)
    stNewGame
            Maybe Status
    _ -> Maybe (GroupName ModeKind)
    forall a. Maybe a
    Nothing
          quitters = (Faction -> Maybe (GroupName ModeKind))
    -> [Faction] -> [GroupName ModeKind]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Faction -> Maybe (GroupName ModeKind)
    getQuitter ([Faction] -> [GroupName ModeKind])
    -> [Faction] -> [GroupName ModeKind]
    forall a b. (a -> b) -> a -> b
    $ FactionDict -> [Faction]
    forall k a. EnumMap k a -> [a]
    EM.elems FactionDict
    factionD
          restartNeeded = Bool
    gameOver Bool -> Bool -> Bool
    || Bool -> Bool
    not ([GroupName ModeKind] -> Bool
    forall a. [a] -> Bool
    null [GroupName ModeKind]
    quitters)
      let isCamper Faction
    fact = case Faction -> Maybe Status
    gquit Faction
    fact of
            Just Status{stOutcome :: Status -> Outcome
    stOutcome=Outcome
    Camping} -> Bool
    True
            Maybe Status
    _ -> Bool
    False
          campers = ((FactionId, Faction) -> Bool)
    -> [(FactionId, Faction)] -> [(FactionId, Faction)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Faction -> Bool
    isCamper (Faction -> Bool)
    -> ((FactionId, Faction) -> Faction)
    -> (FactionId, Faction)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (FactionId, Faction) -> Faction
    forall a b. (a, b) -> b
    snd) ([(FactionId, Faction)] -> [(FactionId, Faction)])
    -> [(FactionId, Faction)] -> [(FactionId, Faction)]
    forall a b. (a -> b) -> a -> b
    $ FactionDict -> [(FactionId, Faction)]
    forall k a. Enum k => EnumMap k a -> [(k, a)]
    EM.assocs FactionDict
    factionD
      -- Wipe out the quit flag for the savegame files.
      mapM_ (\(FactionId
    fid, Faction
    fact) ->
        UpdAtomic -> m ()
    forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
    execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
    forall a b. (a -> b) -> a -> b
    $ FactionId
    -> Maybe Status
    -> Maybe Status
    -> Maybe (FactionAnalytics, GenerationAnalytics)
    -> UpdAtomic
    UpdQuitFaction FactionId
    fid (Faction -> Maybe Status
    gquit Faction
    fact) Maybe Status
    forall a. Maybe a
    Nothing Maybe (FactionAnalytics, GenerationAnalytics)
    forall a. Maybe a
    Nothing) campers
      swriteSave <- getsServer swriteSave
      sstopAfterGameOver <-
        getsServer $ sstopAfterGameOver . soptions
      when swriteSave $ do
        modifyServer $ \StateServer
    ser -> StateServer
    ser {swriteSave = False}
        writeSaveAll True False
      if | gameOver && sstopAfterGameOver -> gameExit
         | restartNeeded -> restart (listToMaybe quitters)
         | not $ null campers -> gameExit  -- and @loop@ is not called
         | otherwise -> loop  -- continue current game

    gameExit :: (MonadServerAtomic m, MonadServerComm m) => m ()
    gameExit :: forall (m :: * -> *).
    (MonadServerAtomic m, MonadServerComm m) =>
    m ()
    gameExit = do
    --  debugPossiblyPrint "Server: Verifying all perceptions."
      -- Verify that the possibly not saved caches are equal to future
      -- reconstructed. Otherwise, save/restore would change game state.
      -- This is done even in released binaries, because it only prolongs
      -- game shutdown a bit. The same checks at each periodic game save
      -- would icrease the game saving lag, so they are normally avoided.
      m ()
    forall (m :: * -> *). MonadServer m => m ()
    verifyCaches
      -- Kill all clients, including those that did not take part
      -- in the current game.
      -- Clients exit not now, but after they print all ending screens.
    --  debugPossiblyPrint "Server: Killing all clients."
      m ()
    forall (m :: * -> *).
    (MonadServerAtomic m, MonadServerComm m) =>
    m ()
    killAllClients
    --  debugPossiblyPrint "Server: All clients killed."
      () -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()