-- | 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 ()