module Game.LambdaHack.Server.PeriodicM
( spawnMonster, addManyActors
, advanceTime, advanceTimeTraj, overheadActorTime, swapTime
, updateCalm, leadLevelSwitch
, endOrLoop
#ifdef EXPOSE_INTERNAL
, 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.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
spawnMonster :: MonadServerAtomic m => m ()
spawnMonster :: m ()
spawnMonster = do
COps{ContentData CaveKind
cocave :: COps -> ContentData CaveKind
cocave :: ContentData CaveKind
cocave} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
EnumSet LevelId
arenas <- (StateServer -> EnumSet LevelId) -> m (EnumSet LevelId)
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> EnumSet LevelId
sarenas
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (EnumSet LevelId -> Bool
forall k. EnumSet k -> Bool
ES.null EnumSet LevelId
arenas) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
LevelId
arena <- Rnd LevelId -> m LevelId
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction (Rnd LevelId -> m LevelId) -> Rnd LevelId -> m LevelId
forall a b. (a -> b) -> a -> b
$ [LevelId] -> Rnd LevelId
forall a. [a] -> Rnd a
oneOf ([LevelId] -> Rnd LevelId) -> [LevelId] -> Rnd LevelId
forall a b. (a -> b) -> a -> b
$ EnumSet LevelId -> [LevelId]
forall k. Enum k => EnumSet k -> [k]
ES.elems EnumSet LevelId
arenas
Level{ContentId CaveKind
lkind :: Level -> ContentId CaveKind
lkind :: ContentId CaveKind
lkind, AbsDepth
ldepth :: Level -> AbsDepth
ldepth :: AbsDepth
ldepth, BigActorMap
lbig :: Level -> BigActorMap
lbig :: BigActorMap
lbig} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
arena
let ck :: CaveKind
ck = ContentData CaveKind -> ContentId CaveKind -> CaveKind
forall a. ContentData a -> ContentId a -> a
okind ContentData CaveKind
cocave ContentId CaveKind
lkind
if | CaveKind -> Int
CK.cactorCoeff CaveKind
ck Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
|| [(GroupName ItemKind, Int)] -> Bool
forall a. [a] -> Bool
null (CaveKind -> [(GroupName ItemKind, Int)]
CK.cactorFreq CaveKind
ck) -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| BigActorMap -> Int
forall k a. EnumMap k a -> Int
EM.size BigActorMap
lbig Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
300 ->
Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
debugPossiblyPrint Text
"Server: spawnMonster: too many big actors on level"
| Bool
otherwise -> do
AbsDepth
totalDepth <- (State -> AbsDepth) -> m AbsDepth
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> AbsDepth
stotalDepth
Int
lvlSpawned <- (StateServer -> Int) -> m Int
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> Int) -> m Int) -> (StateServer -> Int) -> m Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int)
-> (StateServer -> Maybe Int) -> StateServer -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LevelId -> EnumMap LevelId Int -> Maybe Int
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup LevelId
arena (EnumMap LevelId Int -> Maybe Int)
-> (StateServer -> EnumMap LevelId Int) -> StateServer -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> EnumMap LevelId Int
snumSpawned
let perMillion :: Int
perMillion =
AbsDepth -> AbsDepth -> Int -> Int -> Int
monsterGenChance AbsDepth
ldepth AbsDepth
totalDepth Int
lvlSpawned (CaveKind -> Int
CK.cactorCoeff CaveKind
ck)
million :: Int
million = Int
1000000
Int
k <- Rnd Int -> m Int
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction (Rnd Int -> m Int) -> Rnd Int -> m Int
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Rnd Int
forall a. Integral a => (a, a) -> Rnd a
randomR (Int
1, Int
million)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
perMillion) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
let numToSpawn :: Int
numToSpawn | 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
3
| Int
4 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 -> Maybe a
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
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
StateServer
ser { snumSpawned :: EnumMap LevelId Int
snumSpawned = LevelId -> Int -> EnumMap LevelId Int -> EnumMap LevelId Int
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert LevelId
arena (Int
lvlSpawned Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
numToSpawn)
(EnumMap LevelId Int -> EnumMap LevelId Int)
-> EnumMap LevelId Int -> EnumMap LevelId Int
forall a b. (a -> b) -> a -> b
$ StateServer -> EnumMap LevelId Int
snumSpawned StateServer
ser
, sbandSpawned :: IntMap Int
sbandSpawned = (Maybe Int -> Maybe Int) -> Int -> IntMap Int -> IntMap Int
forall a. (Maybe a -> Maybe a) -> Int -> IntMap a -> IntMap a
IM.alter Maybe Int -> Maybe Int
forall a. Num a => Maybe a -> Maybe a
alt Int
numToSpawn
(IntMap Int -> IntMap Int) -> IntMap Int -> IntMap Int
forall a b. (a -> b) -> a -> b
$ StateServer -> IntMap Int
sbandSpawned StateServer
ser }
Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime LevelId
arena
m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Bool
-> Int
-> [(GroupName ItemKind, Int)]
-> LevelId
-> Time
-> Maybe Point
-> Int
-> m Bool
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> Int
-> [(GroupName ItemKind, Int)]
-> LevelId
-> Time
-> Maybe Point
-> Int
-> m Bool
addManyActors Bool
False Int
lvlSpawned (CaveKind -> [(GroupName ItemKind, Int)]
CK.cactorFreq CaveKind
ck) LevelId
arena Time
localTime
Maybe Point
forall a. Maybe a
Nothing Int
numToSpawn
addAnyActor :: MonadServerAtomic m
=> Bool -> Int -> Freqs ItemKind -> LevelId -> Time -> Maybe Point
-> m (Maybe (ActorId, Point))
addAnyActor :: 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
COps
cops <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
lvl :: Level
lvl@Level{AbsDepth
ldepth :: AbsDepth
ldepth :: Level -> AbsDepth
ldepth} <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
Frequency (ContentId ItemKind, ItemKind)
freq <- Int
-> AbsDepth
-> [(GroupName ItemKind, Int)]
-> m (Frequency (ContentId ItemKind, ItemKind))
forall (m :: * -> *).
MonadServerAtomic m =>
Int
-> AbsDepth
-> [(GroupName ItemKind, Int)]
-> m (Frequency (ContentId ItemKind, ItemKind))
prepareItemKind Int
lvlSpawned AbsDepth
ldepth [(GroupName ItemKind, Int)]
actorFreq
NewItem
m2 <- Frequency (ContentId ItemKind, ItemKind) -> AbsDepth -> m NewItem
forall (m :: * -> *).
MonadServerAtomic m =>
Frequency (ContentId ItemKind, ItemKind) -> AbsDepth -> m NewItem
rollItemAspect Frequency (ContentId ItemKind, ItemKind)
freq AbsDepth
ldepth
case NewItem
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 (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 (ContentId ItemKind, ItemKind)
freq, LevelId
lid, Time
time, Maybe Point
mpos)
Maybe (ActorId, Point) -> m (Maybe (ActorId, Point))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ActorId, Point)
forall a. Maybe a
Nothing
NewItem ItemKnown
itemKnownRaw ItemFull
itemFullRaw ItemQuant
itemQuant -> do
(FactionId
fid, Faction
_) <- 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
$ [(FactionId, Faction)] -> Rnd (FactionId, Faction)
forall a. [a] -> Rnd a
oneOf ([(FactionId, Faction)] -> Rnd (FactionId, Faction))
-> [(FactionId, Faction)] -> Rnd (FactionId, Faction)
forall a b. (a -> b) -> a -> b
$
ItemKind -> FactionDict -> [(FactionId, Faction)]
possibleActorFactions (ItemFull -> ItemKind
itemKind ItemFull
itemFullRaw) FactionDict
factionD
PerFid
pers <- (StateServer -> PerFid) -> m PerFid
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> PerFid
sperFid
let allPers :: EnumSet Point
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
freqNames :: [GroupName ItemKind]
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 :: Bool
mobile = GroupName ItemKind
IK.MOBILE GroupName ItemKind -> [GroupName ItemKind] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GroupName ItemKind]
freqNames
aquatic :: Bool
aquatic = GroupName ItemKind
IK.AQUATIC GroupName ItemKind -> [GroupName ItemKind] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [GroupName ItemKind]
freqNames
Maybe Point
mrolledPos <- case Maybe Point
mpos of
Just{} -> Maybe Point -> m (Maybe Point)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Point
mpos
Maybe Point
Nothing -> do
Rnd (Maybe Point)
rollPos <-
(State -> Rnd (Maybe Point)) -> m (Rnd (Maybe Point))
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
Rnd (Maybe Point) -> m (Maybe Point)
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction Rnd (Maybe Point)
rollPos
case Maybe Point
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 (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 :: 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
Maybe ([ActorId], Point)
mInitialLAidPos <- case Maybe Point
mpos of
Just Point
pos -> Maybe ([ActorId], Point) -> m (Maybe ([ActorId], Point))
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 Maybe ([ActorId], Point)
mInitialLAidPos of
Maybe ([ActorId], Point)
Nothing -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just ([ActorId]
laid, Point
pos) -> do
cops :: COps
cops@COps{TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
let validTile :: ContentId TileKind -> Bool
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 :: [Point]
ps = COps -> Level -> (ContentId TileKind -> Bool) -> Point -> [Point]
nearbyFreePoints COps
cops Level
lvl ContentId TileKind -> Bool
validTile Point
pos
psNeeded :: [Point]
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
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Point] -> Int
forall a. [a] -> Int
length [Point]
psNeeded Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
howMany Int -> Int -> Int
forall a. Num a => a -> a -> a
- [ActorId] -> Int
forall a. [a] -> Int
length [ActorId]
laid) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Text -> m ()
forall (m :: * -> *). MonadServer m => Text -> m ()
debugPossiblyPrint (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Server: addManyActors: failed to find enough free positions at"
Text -> Text -> Text
<+> (LevelId, Point) -> Text
forall a. Show a => a -> Text
tshow (LevelId
lid, Point
pos)
[Maybe (ActorId, Point)]
maidposs <- [Point]
-> (Point -> m (Maybe (ActorId, Point)))
-> m [Maybe (ActorId, Point)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Point]
psNeeded ((Point -> m (Maybe (ActorId, Point)))
-> m [Maybe (ActorId, Point)])
-> (Point -> m (Maybe (ActorId, Point)))
-> m [Maybe (ActorId, Point)]
forall a b. (a -> b) -> a -> 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 -> m (Maybe (ActorId, Point)))
-> (Point -> Maybe Point) -> Point -> m (Maybe (ActorId, Point))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Maybe Point
forall a. a -> Maybe a
Just
case [ActorId]
laid [ActorId] -> [ActorId] -> [ActorId]
forall a. [a] -> [a] -> [a]
++ ((ActorId, Point) -> ActorId) -> [(ActorId, Point)] -> [ActorId]
forall a b. (a -> b) -> [a] -> [b]
map (ActorId, Point) -> ActorId
forall a b. (a, b) -> a
fst ([Maybe (ActorId, Point)] -> [(ActorId, Point)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (ActorId, Point)]
maidposs) of
[] -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
ActorId
aid : [ActorId]
_ -> do
Actor
b <- (State -> Actor) -> m Actor
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
Maybe ActorId
mleader <- (State -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe ActorId) -> m (Maybe ActorId))
-> (State -> Maybe ActorId) -> m (Maybe ActorId)
forall a b. (a -> b) -> a -> b
$ Faction -> Maybe ActorId
gleader (Faction -> Maybe ActorId)
-> (State -> Faction) -> State -> Maybe ActorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ActorId -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ActorId
mleader) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> ActorId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> ActorId -> m ()
setFreshLeader (Actor -> FactionId
bfid Actor
b) ActorId
aid
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
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 :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} EnumSet Point
visible
Bool
mobile Bool
aquatic LevelId
lid lvl :: Level
lvl@Level{Area
larea :: Level -> Area
larea :: Area
larea} FactionId
fid State
s = do
let inhabitants :: [Actor]
inhabitants = FactionId -> LevelId -> State -> [Actor]
foeRegularList FactionId
fid LevelId
lid State
s
nearInh :: (Int -> Bool) -> Point -> Bool
nearInh !Int -> Bool
df !Point
p = (Actor -> Bool) -> [Actor] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\ !Actor
b -> Int -> Bool
df (Int -> Bool) -> Int -> Bool
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Int
chessDist (Actor -> Point
bpos Actor
b) Point
p) [Actor]
inhabitants
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
condList :: [Point -> Bool]
condList | Bool
mobile =
[ (Int -> Bool) -> Point -> Bool
nearInh (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
50)
, (Int -> Bool) -> Point -> Bool
nearInh (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
100)
]
| 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
]
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 -> Bool) -> Point -> Bool
nearInh (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4) 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)
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 -> Bool) -> Point -> Bool
nearInh (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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 -> Bool) -> Point -> Bool
nearInh (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2) 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
_ -> Bool -> Bool
not (Point
p Point -> EnumSet Point -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` EnumSet Point
visible)
]
advanceTime :: MonadServerAtomic m => ActorId -> Int -> Bool -> m ()
advanceTime :: ActorId -> Int -> Bool -> m ()
advanceTime ActorId
aid Int
percent Bool
breakStasis = do
Actor
b <- (State -> Actor) -> m Actor
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
Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
aid
let t :: Delta Time
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
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
StateServer
ser {sactorTime :: ActorTime
sactorTime = FactionId
-> LevelId -> ActorId -> Delta Time -> ActorTime -> ActorTime
ageActor (Actor -> FactionId
bfid Actor
b) (Actor -> LevelId
blid Actor
b) ActorId
aid Delta Time
t (ActorTime -> ActorTime) -> ActorTime -> ActorTime
forall a b. (a -> b) -> a -> b
$ StateServer -> ActorTime
sactorTime StateServer
ser}
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
breakStasis (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
StateServer
ser {sactorStasis :: EnumSet ActorId
sactorStasis = ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.delete ActorId
aid (StateServer -> EnumSet ActorId
sactorStasis StateServer
ser)}
advanceTimeTraj :: MonadServerAtomic m => ActorId -> m ()
advanceTimeTraj :: ActorId -> m ()
advanceTimeTraj ActorId
aid = do
Actor
b <- (State -> Actor) -> m Actor
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 :: Speed
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 :: Delta Time
t = Speed -> Delta Time
ticksPerMeter Speed
speedTraj
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
StateServer
ser {strajTime :: ActorTime
strajTime = FactionId
-> LevelId -> ActorId -> Delta Time -> ActorTime -> ActorTime
ageActor (Actor -> FactionId
bfid Actor
b) (Actor -> LevelId
blid Actor
b) ActorId
aid Delta Time
t (ActorTime -> ActorTime) -> ActorTime -> ActorTime
forall a b. (a -> b) -> a -> b
$ StateServer -> ActorTime
strajTime StateServer
ser}
overheadActorTime :: MonadServerAtomic m => FactionId -> LevelId -> m ()
overheadActorTime :: FactionId -> LevelId -> m ()
overheadActorTime FactionId
fid LevelId
lid = do
EnumMap LevelId (EnumMap ActorId Time)
actorTimeFid <- (StateServer -> EnumMap LevelId (EnumMap ActorId Time))
-> m (EnumMap LevelId (EnumMap ActorId Time))
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 ActorId Time
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
ActorId -> Actor
getActorB <- (State -> ActorId -> Actor) -> m (ActorId -> Actor)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ActorId -> Actor) -> m (ActorId -> Actor))
-> (State -> ActorId -> Actor) -> m (ActorId -> Actor)
forall a b. (a -> b) -> a -> b
$ (ActorId -> State -> Actor) -> State -> ActorId -> Actor
forall a b c. (a -> b -> c) -> b -> a -> c
flip ActorId -> State -> Actor
getActorBody
Maybe ActorId
mleader <- (State -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe ActorId) -> m (Maybe ActorId))
-> (State -> Maybe ActorId) -> m (Maybe ActorId)
forall a b. (a -> b) -> a -> b
$ Faction -> Maybe ActorId
gleader (Faction -> Maybe ActorId)
-> (State -> Faction) -> State -> Maybe ActorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
let f :: ActorId -> Time -> Time
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
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
then Time -> Delta Time -> Time
timeShift Time
time (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeClip)
else Time
time
actorTimeLid2 :: EnumMap ActorId 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 :: EnumMap LevelId (EnumMap ActorId Time)
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
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
StateServer
ser {sactorTime :: ActorTime
sactorTime = FactionId
-> EnumMap LevelId (EnumMap ActorId Time) -> ActorTime -> ActorTime
forall k a. Enum k => k -> a -> EnumMap k a -> EnumMap k a
EM.insert FactionId
fid EnumMap LevelId (EnumMap ActorId Time)
actorTimeFid2 (ActorTime -> ActorTime) -> ActorTime -> ActorTime
forall a b. (a -> b) -> a -> b
$ StateServer -> ActorTime
sactorTime StateServer
ser}
swapTime :: MonadServerAtomic m => ActorId -> ActorId -> m ()
swapTime :: ActorId -> ActorId -> m ()
swapTime ActorId
source ActorId
target = do
Actor
sb <- (State -> Actor) -> m Actor
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
Actor
tb <- (State -> Actor) -> m Actor
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
Time
slvl <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
sb)
Time
tlvl <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
tb)
Time
btime_sb <-
(StateServer -> Time) -> m Time
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer
((StateServer -> Time) -> m Time)
-> (StateServer -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ Maybe Time -> Time
forall a. (?callStack::CallStack) => Maybe a -> a
fromJust (Maybe Time -> Time)
-> (StateServer -> Maybe Time) -> StateServer -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FactionId -> LevelId -> ActorId -> ActorTime -> Maybe Time
lookupActorTime (Actor -> FactionId
bfid Actor
sb) (Actor -> LevelId
blid Actor
sb) ActorId
source (ActorTime -> Maybe Time)
-> (StateServer -> ActorTime) -> StateServer -> Maybe Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ActorTime
sactorTime
Time
btime_tb <-
(StateServer -> Time) -> m Time
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer
((StateServer -> Time) -> m Time)
-> (StateServer -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ Maybe Time -> Time
forall a. (?callStack::CallStack) => Maybe a -> a
fromJust (Maybe Time -> Time)
-> (StateServer -> Maybe Time) -> StateServer -> Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FactionId -> LevelId -> ActorId -> ActorTime -> Maybe Time
lookupActorTime (Actor -> FactionId
bfid Actor
tb) (Actor -> LevelId
blid Actor
tb) ActorId
target (ActorTime -> Maybe Time)
-> (StateServer -> ActorTime) -> StateServer -> Maybe Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ActorTime
sactorTime
let lvlDelta :: Delta Time
lvlDelta = Time
slvl Time -> Time -> Delta Time
`timeDeltaToFrom` Time
tlvl
bDelta :: Delta Time
bDelta = Time
btime_sb Time -> Time -> Delta Time
`timeDeltaToFrom` Time
btime_tb
sdelta :: Delta Time
sdelta = Delta Time -> Delta Time -> Delta Time
timeDeltaSubtract Delta Time
lvlDelta Delta Time
bDelta
tdelta :: Delta Time
tdelta = Delta Time -> Delta Time
timeDeltaReverse Delta Time
sdelta
let !_A :: ()
_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 a. Show a => Bool -> a -> Bool
`blame` ( Time
slvl, Time
tlvl, Time
btime_sb, Time
btime_tb
, Delta Time
sdelta, Delta Time
sdelta', Delta Time
tdelta, Delta Time
tdelta' )) ()
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Delta Time
sdelta Delta Time -> Delta Time -> Bool
forall a. Eq a => a -> a -> Bool
/= Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeZero) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
StateServer
ser {sactorTime :: ActorTime
sactorTime = FactionId
-> LevelId -> ActorId -> Delta Time -> ActorTime -> ActorTime
ageActor (Actor -> FactionId
bfid Actor
sb) (Actor -> LevelId
blid Actor
sb) ActorId
source Delta Time
sdelta
(ActorTime -> ActorTime) -> ActorTime -> ActorTime
forall a b. (a -> b) -> a -> b
$ StateServer -> ActorTime
sactorTime StateServer
ser}
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Delta Time
tdelta Delta Time -> Delta Time -> Bool
forall a. Eq a => a -> a -> Bool
/= Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeZero) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ (StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser ->
StateServer
ser {sactorTime :: ActorTime
sactorTime = FactionId
-> LevelId -> ActorId -> Delta Time -> ActorTime -> ActorTime
ageActor (Actor -> FactionId
bfid Actor
tb) (Actor -> LevelId
blid Actor
tb) ActorId
target Delta Time
tdelta
(ActorTime -> ActorTime) -> ActorTime -> ActorTime
forall a b. (a -> b) -> a -> b
$ StateServer -> ActorTime
sactorTime StateServer
ser}
updateCalm :: MonadServerAtomic m => ActorId -> Int64 -> m ()
updateCalm :: ActorId -> Int64 -> m ()
updateCalm ActorId
target Int64
deltaCalm = do
Actor
tb <- (State -> Actor) -> m Actor
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
Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
target
let calmMax64 :: Int64
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
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Int64 -> UpdAtomic
UpdRefillCalm ActorId
target Int64
deltaCalm
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> Int64
bcalm Actor
tb Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
calmMax64
Bool -> Bool -> Bool
&& Actor -> Int64
bcalm Actor
tb Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
deltaCalm Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int64
calmMax64) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
leadLevelSwitch :: MonadServerAtomic m => m ()
leadLevelSwitch :: m ()
leadLevelSwitch = do
COps{ContentData CaveKind
cocave :: ContentData CaveKind
cocave :: COps -> ContentData CaveKind
cocave} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
let canSwitch :: Faction -> Bool
canSwitch Faction
fact = (Bool, Bool) -> Bool
forall a b. (a, b) -> a
fst (Faction -> (Bool, Bool)
autoDungeonLevel Faction
fact)
Bool -> Bool -> Bool
|| Player -> Bool
funderAI (Faction -> Player
gplayer Faction
fact)
Bool -> Bool -> Bool
&& Maybe AutoLeader -> Bool
forall a. Maybe a -> Bool
isJust (Player -> Maybe AutoLeader
fleaderMode (Faction -> Player
gplayer Faction
fact))
flipFaction :: (FactionId, Faction) -> m ()
flipFaction (FactionId
_, Faction
fact) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> Bool
canSwitch Faction
fact = () -> m ()
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 (m :: * -> *) a. Monad m => a -> m a
return ()
Just ActorId
leader -> do
Actor
body <- (State -> Actor) -> m Actor
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 :: ()
_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) ()
State
s <- (StateServer -> State) -> m State
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> State) -> m State)
-> (StateServer -> State) -> m State
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId State -> FactionId -> State
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (EnumMap FactionId State -> State)
-> (StateServer -> EnumMap FactionId State) -> StateServer -> State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> EnumMap FactionId State
sclientStates
let leaderStuck :: Bool
leaderStuck = Actor -> Bool
actorWaits Actor
body
lvlsRaw :: [((LevelId, Level), (Bool, [(ActorId, Actor)]))]
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 =
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
([(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
, 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 (Player -> Bool
fhasGender (Player -> Bool) -> Player -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> Player
gplayer Faction
fact)
]
([((LevelId, Level), (Bool, [(ActorId, Actor)]))]
lvlsSeen, [((LevelId, Level), (Bool, [(ActorId, Actor)]))]
lvlsNotSeen) = (((LevelId, Level), (Bool, [(ActorId, Actor)])) -> Bool)
-> [((LevelId, Level), (Bool, [(ActorId, Actor)]))]
-> ([((LevelId, Level), (Bool, [(ActorId, Actor)]))],
[((LevelId, Level), (Bool, [(ActorId, Actor)]))])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((Bool, [(ActorId, Actor)]) -> Bool
forall a b. (a, b) -> a
fst ((Bool, [(ActorId, Actor)]) -> Bool)
-> (((LevelId, Level), (Bool, [(ActorId, Actor)]))
-> (Bool, [(ActorId, Actor)]))
-> ((LevelId, Level), (Bool, [(ActorId, Actor)]))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((LevelId, Level), (Bool, [(ActorId, Actor)]))
-> (Bool, [(ActorId, Actor)])
forall a b. (a, b) -> b
snd) [((LevelId, Level), (Bool, [(ActorId, Actor)]))]
lvlsRaw
f :: ((a, Level), b) -> AbsDepth
f ((a
_, Level
lvl), b
_) = Level -> AbsDepth
ldepth Level
lvl
lvls :: [((LevelId, Level), (Bool, [(ActorId, Actor)]))]
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)
let overOwnStash :: Actor -> Bool
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, (LevelId, ActorId))]
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)
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, Faction) -> Bool
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
Maybe (LevelId, Point)
Nothing -> Bool
False
closeToEnemyStash :: Bool
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
[Actor]
foes <- (State -> [Actor]) -> m [Actor]
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
$ FactionId -> LevelId -> State -> [Actor]
foeRegularList FactionId
fid (Actor -> LevelId
blid Actor
body)
[Actor]
ours <- (State -> [Actor]) -> m [Actor]
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, Actor) -> Actor) -> [(ActorId, Actor)] -> [Actor]
forall a b. (a -> b) -> [a] -> [b]
map (ActorId, Actor) -> Actor
forall a b. (a, b) -> b
snd
([(ActorId, Actor)] -> [Actor])
-> (State -> [(ActorId, Actor)]) -> State -> [Actor]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FactionId -> LevelId -> State -> [(ActorId, Actor)]
fidActorRegularAssocs FactionId
fid (Actor -> LevelId
blid Actor
body)
let foesClose :: [Actor]
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]
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
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
&& [Actor] -> Int
forall a. [a] -> Int
length [Actor]
foesClose Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1
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)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
closeToEnemyStash Bool -> Bool -> Bool
|| Bool
canHelpMelee Bool -> Bool -> Bool
|| [(Int, (LevelId, ActorId))] -> Bool
forall a. [a] -> Bool
null [(Int, (LevelId, ActorId))]
freqList) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
(LevelId
lid, ActorId
a) <- Rnd (LevelId, ActorId) -> m (LevelId, ActorId)
forall (m :: * -> *) a. MonadServer m => Rnd a -> m a
rndToAction (Rnd (LevelId, ActorId) -> m (LevelId, ActorId))
-> Rnd (LevelId, ActorId) -> m (LevelId, ActorId)
forall a b. (a -> b) -> a -> b
$ Frequency (LevelId, ActorId) -> Rnd (LevelId, ActorId)
forall a. Show a => Frequency a -> Rnd a
frequency
(Frequency (LevelId, ActorId) -> Rnd (LevelId, ActorId))
-> Frequency (LevelId, ActorId) -> Rnd (LevelId, ActorId)
forall a b. (a -> b) -> a -> b
$ Text -> [(Int, (LevelId, ActorId))] -> Frequency (LevelId, ActorId)
forall a. Text -> [(Int, a)] -> Frequency a
toFreq Text
"leadLevel" [(Int, (LevelId, ActorId))]
freqList
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (LevelId
lid LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> LevelId
blid Actor
body) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
FactionId -> ActorId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> ActorId -> m ()
setFreshLeader FactionId
fid ActorId
a
((FactionId, Faction) -> m ()) -> [(FactionId, Faction)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (FactionId, Faction) -> m ()
flipFaction ([(FactionId, Faction)] -> m ()) -> [(FactionId, Faction)] -> m ()
forall a b. (a -> b) -> a -> b
$ FactionDict -> [(FactionId, Faction)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs FactionDict
factionD
endOrLoop :: (MonadServerAtomic m, MonadServerComm m)
=> m () -> (Maybe (GroupName ModeKind) -> m ())
-> m ()
{-# INLINE endOrLoop #-}
endOrLoop :: m () -> (Maybe (GroupName ModeKind) -> m ()) -> m ()
endOrLoop m ()
loop Maybe (GroupName ModeKind) -> m ()
restart = do
FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
let inGame :: Faction -> Bool
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
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 -> Maybe (GroupName ModeKind)
getQuitter Faction
fact = case Faction -> Maybe Status
gquit Faction
fact of
Just Status{stOutcome :: Status -> Outcome
stOutcome=Outcome
Restart, Maybe (GroupName ModeKind)
stNewGame :: Status -> Maybe (GroupName ModeKind)
stNewGame :: Maybe (GroupName ModeKind)
stNewGame} -> Maybe (GroupName ModeKind)
stNewGame
Maybe Status
_ -> Maybe (GroupName ModeKind)
forall a. Maybe a
Nothing
quitters :: [GroupName ModeKind]
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
restartNeeded = Bool
gameOver Bool -> Bool -> Bool
|| Bool -> Bool
not ([GroupName ModeKind] -> Bool
forall a. [a] -> Bool
null [GroupName ModeKind]
quitters)
let isCamper :: Faction -> Bool
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)]
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
((FactionId, Faction) -> m ()) -> [(FactionId, Faction)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
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) [(FactionId, Faction)]
campers
Bool
swriteSave <- (StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> Bool
swriteSave
Bool
sstopAfterGameOver <-
(StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> Bool) -> m Bool)
-> (StateServer -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ServerOptions -> Bool
sstopAfterGameOver (ServerOptions -> Bool)
-> (StateServer -> ServerOptions) -> StateServer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ServerOptions
soptions
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
swriteSave (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateServer
ser -> StateServer
ser {swriteSave :: Bool
swriteSave = Bool
False}
Bool -> Bool -> m ()
forall (m :: * -> *). MonadServerAtomic m => Bool -> Bool -> m ()
writeSaveAll Bool
True Bool
False
if | Bool
gameOver Bool -> Bool -> Bool
&& Bool
sstopAfterGameOver -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
m ()
gameExit
| Bool
restartNeeded -> Maybe (GroupName ModeKind) -> m ()
restart ([GroupName ModeKind] -> Maybe (GroupName ModeKind)
forall a. [a] -> Maybe a
listToMaybe [GroupName ModeKind]
quitters)
| Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(FactionId, Faction)] -> Bool
forall a. [a] -> Bool
null [(FactionId, Faction)]
campers -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
m ()
gameExit
| Bool
otherwise -> m ()
loop
gameExit :: (MonadServerAtomic m, MonadServerComm m) => m ()
gameExit :: m ()
gameExit = do
m ()
forall (m :: * -> *). MonadServer m => m ()
verifyCaches
m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
m ()
killAllClients
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()