module Game.LambdaHack.Server.LoopM
( loopSer
#ifdef EXPOSE_INTERNAL
, factionArena, arenasForLoop, handleFidUpd, loopUpd, endClip
, manageCalmAndDomination, applyPeriodicLevel
, handleTrajectories, hTrajectories, advanceTrajectory
, handleActors, hActors, restartGame
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Game.LambdaHack.Atomic
import Game.LambdaHack.Client (ReqUI (..))
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Analytics
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Perception
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Types
import Game.LambdaHack.Common.Vector
import qualified Game.LambdaHack.Content.ItemKind as IK
import Game.LambdaHack.Content.ModeKind
import Game.LambdaHack.Content.RuleKind
import qualified Game.LambdaHack.Definition.Ability as Ability
import Game.LambdaHack.Definition.Defs
import Game.LambdaHack.Server.CommonM
import Game.LambdaHack.Server.EndM
import Game.LambdaHack.Server.HandleEffectM
import Game.LambdaHack.Server.HandleRequestM
import Game.LambdaHack.Server.MonadServer
import Game.LambdaHack.Server.PeriodicM
import Game.LambdaHack.Server.ProtocolM
import Game.LambdaHack.Server.ServerOptions
import Game.LambdaHack.Server.StartM
import Game.LambdaHack.Server.State
loopSer :: (MonadServerAtomic m, MonadServerComm m)
=> ServerOptions
-> (Bool -> FactionId -> ChanServer -> IO ())
-> m ()
loopSer :: ServerOptions -> (Bool -> FactionId -> ChanServer -> IO ()) -> m ()
loopSer serverOptions :: ServerOptions
serverOptions executorClient :: Bool -> FactionId -> ChanServer -> IO ()
executorClient = 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
$ \ser :: StateServer
ser -> StateServer
ser { soptionsNxt :: ServerOptions
soptionsNxt = ServerOptions
serverOptions
, soptions :: ServerOptions
soptions = ServerOptions
serverOptions }
COps
cops <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
let updConn :: m ()
updConn = (Bool -> FactionId -> ChanServer -> IO ()) -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
(Bool -> FactionId -> ChanServer -> IO ()) -> m ()
updateConn Bool -> FactionId -> ChanServer -> IO ()
executorClient
Maybe (State, StateServer)
restored <- m (Maybe (State, StateServer))
forall (m :: * -> *).
MonadServerComm m =>
m (Maybe (State, StateServer))
tryRestore
case Maybe (State, StateServer)
restored of
Just (sRaw :: State
sRaw, ser :: StateServer
ser) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ServerOptions -> Bool
snewGameSer ServerOptions
serverOptions -> do
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ State -> UpdAtomic
UpdResumeServer
(State -> UpdAtomic) -> State -> UpdAtomic
forall a b. (a -> b) -> a -> b
$ (COps -> COps) -> State -> State
updateCOpsAndCachedData (COps -> COps -> COps
forall a b. a -> b -> a
const COps
cops) State
sRaw
StateServer -> m ()
forall (m :: * -> *). MonadServer m => StateServer -> m ()
putServer StateServer
ser {soptionsNxt :: ServerOptions
soptionsNxt = ServerOptions
serverOptions}
m ()
forall (m :: * -> *). MonadServer m => m ()
applyDebug
FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
let f :: FactionId -> m Bool
f fid :: FactionId
fid = let cmd :: UpdAtomic
cmd = State -> UpdAtomic
UpdResumeServer
(State -> UpdAtomic) -> State -> UpdAtomic
forall a b. (a -> b) -> a -> b
$ (COps -> COps) -> State -> State
updateCOpsAndCachedData (COps -> COps -> COps
forall a b. a -> b -> a
const COps
cops)
(State -> State) -> State -> State
forall a b. (a -> b) -> a -> b
$ StateServer -> EnumMap FactionId State
sclientStates StateServer
ser EnumMap FactionId State -> FactionId -> State
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid
in FactionId -> UpdAtomic -> m Bool
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> UpdAtomic -> m Bool
execUpdAtomicFidCatch FactionId
fid UpdAtomic
cmd
(FactionId -> m Bool) -> [FactionId] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FactionId -> m Bool
f ([FactionId] -> m ()) -> [FactionId] -> m ()
forall a b. (a -> b) -> a -> b
$ FactionDict -> [FactionId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys FactionDict
factionD
m ()
updConn
m ()
forall (m :: * -> *). MonadServer m => m ()
initPer
PerFid
pers <- (StateServer -> PerFid) -> m PerFid
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> PerFid
sperFid
let clear :: b -> Perception
clear = Perception -> b -> Perception
forall a b. a -> b -> a
const Perception
emptyPer
persFid :: FactionId -> EnumMap LevelId Perception
persFid fid :: FactionId
fid | ServerOptions -> Bool
sknowEvents ServerOptions
serverOptions = (Perception -> Perception)
-> EnumMap LevelId Perception -> EnumMap LevelId Perception
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map Perception -> Perception
forall b. b -> Perception
clear (PerFid
pers PerFid -> FactionId -> EnumMap LevelId Perception
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid)
| Bool
otherwise = PerFid
pers PerFid -> FactionId -> EnumMap LevelId Perception
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid
(FactionId -> m ()) -> [FactionId] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\fid :: FactionId
fid -> FactionId -> UpdAtomic -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
FactionId -> UpdAtomic -> m ()
sendUpdate FactionId
fid (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> EnumMap LevelId Perception -> UpdAtomic
UpdResume FactionId
fid (FactionId -> EnumMap LevelId Perception
persFid FactionId
fid))
(FactionDict -> [FactionId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys FactionDict
factionD)
[LevelId]
arenasNew <- m [LevelId]
forall (m :: * -> *). MonadStateRead m => m [LevelId]
arenasForLoop
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser2 :: StateServer
ser2 -> StateServer
ser2 {sarenas :: [LevelId]
sarenas = [LevelId]
arenasNew, svalidArenas :: Bool
svalidArenas = Bool
True}
RNGs
rngs <- (StateServer -> RNGs) -> m RNGs
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> RNGs
srngs
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ServerOptions -> Bool
sdumpInitRngs ServerOptions
serverOptions) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ RNGs -> m ()
forall (m :: * -> *). MonadServer m => RNGs -> m ()
dumpRngs RNGs
rngs
_ -> do
State
s <- ServerOptions
-> Maybe (GroupName ModeKind) -> Maybe StdGen -> m State
forall (m :: * -> *).
MonadServer m =>
ServerOptions
-> Maybe (GroupName ModeKind) -> Maybe StdGen -> m State
gameReset ServerOptions
serverOptions Maybe (GroupName ModeKind)
forall a. Maybe a
Nothing Maybe StdGen
forall a. Maybe a
Nothing
let optionsBarRngs :: ServerOptions
optionsBarRngs =
ServerOptions
serverOptions {sdungeonRng :: Maybe StdGen
sdungeonRng = Maybe StdGen
forall a. Maybe a
Nothing, smainRng :: Maybe StdGen
smainRng = Maybe StdGen
forall a. Maybe a
Nothing}
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser -> StateServer
ser { soptionsNxt :: ServerOptions
soptionsNxt = ServerOptions
optionsBarRngs
, soptions :: ServerOptions
soptions = ServerOptions
optionsBarRngs }
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ State -> UpdAtomic
UpdRestartServer State
s
m ()
updConn
m ()
forall (m :: * -> *). MonadServer m => m ()
initPer
m ()
forall (m :: * -> *). MonadServerAtomic m => m ()
reinitGame
Bool -> m ()
forall (m :: * -> *). MonadServerAtomic m => Bool -> m ()
writeSaveAll Bool
False
m () -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
m () -> m ()
loopUpd m ()
updConn
factionArena :: MonadStateRead m => Faction -> m (Maybe LevelId)
factionArena :: Faction -> m (Maybe LevelId)
factionArena fact :: Faction
fact = case Faction -> Maybe ActorId
gleader Faction
fact of
Just leader :: ActorId
leader -> 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
leader
Maybe LevelId -> m (Maybe LevelId)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe LevelId -> m (Maybe LevelId))
-> Maybe LevelId -> m (Maybe LevelId)
forall a b. (a -> b) -> a -> b
$ LevelId -> Maybe LevelId
forall a. a -> Maybe a
Just (LevelId -> Maybe LevelId) -> LevelId -> Maybe LevelId
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b
Nothing -> Maybe LevelId -> m (Maybe LevelId)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe LevelId
forall a. Maybe a
Nothing
arenasForLoop :: MonadStateRead m => m [LevelId]
{-# INLINE arenasForLoop #-}
arenasForLoop :: m [LevelId]
arenasForLoop = do
FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
[Maybe LevelId]
marenas <- (Faction -> m (Maybe LevelId)) -> [Faction] -> m [Maybe LevelId]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Faction -> m (Maybe LevelId)
forall (m :: * -> *).
MonadStateRead m =>
Faction -> m (Maybe LevelId)
factionArena ([Faction] -> m [Maybe LevelId]) -> [Faction] -> m [Maybe LevelId]
forall a b. (a -> b) -> a -> b
$ FactionDict -> [Faction]
forall k a. EnumMap k a -> [a]
EM.elems FactionDict
factionD
let arenas :: [LevelId]
arenas = EnumSet LevelId -> [LevelId]
forall k. Enum k => EnumSet k -> [k]
ES.toList (EnumSet LevelId -> [LevelId]) -> EnumSet LevelId -> [LevelId]
forall a b. (a -> b) -> a -> b
$ [LevelId] -> EnumSet LevelId
forall k. Enum k => [k] -> EnumSet k
ES.fromList ([LevelId] -> EnumSet LevelId) -> [LevelId] -> EnumSet LevelId
forall a b. (a -> b) -> a -> b
$ [Maybe LevelId] -> [LevelId]
forall a. [Maybe a] -> [a]
catMaybes [Maybe LevelId]
marenas
!_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not ([LevelId] -> Bool
forall a. [a] -> Bool
null [LevelId]
arenas)
Bool -> (String, FactionDict) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "game over not caught earlier"
String -> FactionDict -> (String, FactionDict)
forall v. String -> v -> (String, v)
`swith` FactionDict
factionD) ()
[LevelId] -> m [LevelId]
forall (m :: * -> *) a. Monad m => a -> m a
return ([LevelId] -> m [LevelId]) -> [LevelId] -> m [LevelId]
forall a b. (a -> b) -> a -> b
$! [LevelId]
arenas
handleFidUpd :: forall m. (MonadServerAtomic m, MonadServerComm m)
=> (FactionId -> m ()) -> FactionId -> Faction -> m ()
{-# INLINE handleFidUpd #-}
handleFidUpd :: (FactionId -> m ()) -> FactionId -> Faction -> m ()
handleFidUpd updatePerFid :: FactionId -> m ()
updatePerFid fid :: FactionId
fid fact :: Faction
fact = do
FactionId -> m ()
updatePerFid FactionId
fid
let handle :: [LevelId] -> m Bool
handle :: [LevelId] -> m Bool
handle [] = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
handle (lid :: LevelId
lid : rest :: [LevelId]
rest) = do
Bool
breakASAP <- (StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> Bool
sbreakASAP
if Bool
breakASAP
then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
else do
Bool
nonWaitMove <- LevelId -> FactionId -> m Bool
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
LevelId -> FactionId -> m Bool
handleActors LevelId
lid FactionId
fid
if Bool
nonWaitMove
then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else [LevelId] -> m Bool
handle [LevelId]
rest
killDying :: [LevelId] -> m ()
killDying :: [LevelId] -> m ()
killDying = (LevelId -> m ()) -> [LevelId] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ LevelId -> m ()
killDyingLid
killDyingLid :: LevelId -> m ()
killDyingLid :: LevelId -> m ()
killDyingLid lid :: LevelId
lid = do
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
lid
EnumMap ActorId Time
levelTime <- (StateServer -> EnumMap ActorId Time) -> m (EnumMap ActorId Time)
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> EnumMap ActorId Time) -> m (EnumMap ActorId Time))
-> (StateServer -> EnumMap ActorId Time)
-> m (EnumMap ActorId Time)
forall a b. (a -> b) -> a -> b
$ (EnumMap LevelId (EnumMap ActorId Time)
-> LevelId -> EnumMap ActorId Time
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid) (EnumMap LevelId (EnumMap ActorId Time) -> EnumMap ActorId Time)
-> (StateServer -> EnumMap LevelId (EnumMap ActorId Time))
-> StateServer
-> EnumMap ActorId Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
-> FactionId -> EnumMap LevelId (EnumMap ActorId Time)
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
-> EnumMap LevelId (EnumMap ActorId Time))
-> (StateServer
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time)))
-> StateServer
-> EnumMap LevelId (EnumMap ActorId Time)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
sactorTime
let l :: [(ActorId, Time)]
l = ((ActorId, Time) -> Bool) -> [(ActorId, Time)] -> [(ActorId, Time)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(_, atime :: Time
atime) -> Time
atime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= Time
localTime) ([(ActorId, Time)] -> [(ActorId, Time)])
-> [(ActorId, Time)] -> [(ActorId, Time)]
forall a b. (a -> b) -> a -> b
$ EnumMap ActorId Time -> [(ActorId, Time)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap ActorId Time
levelTime
killAid :: (ActorId, b) -> m ()
killAid (aid :: ActorId
aid, _) = do
Actor
b1 <- (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
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> Int64
bhp Actor
b1 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Actor -> m ()
dieSer ActorId
aid Actor
b1
((ActorId, Time) -> m ()) -> [(ActorId, Time)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ActorId, Time) -> m ()
forall (m :: * -> *) b. MonadServerAtomic m => (ActorId, b) -> m ()
killAid [(ActorId, Time)]
l
Maybe LevelId
fa <- Faction -> m (Maybe LevelId)
forall (m :: * -> *).
MonadStateRead m =>
Faction -> m (Maybe LevelId)
factionArena Faction
fact
[LevelId]
arenas <- (StateServer -> [LevelId]) -> m [LevelId]
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> [LevelId]
sarenas
let myArenas :: [LevelId]
myArenas = case Maybe LevelId
fa of
Just myArena :: LevelId
myArena -> LevelId
myArena LevelId -> [LevelId] -> [LevelId]
forall a. a -> [a] -> [a]
: LevelId -> [LevelId] -> [LevelId]
forall a. Eq a => a -> [a] -> [a]
delete LevelId
myArena [LevelId]
arenas
Nothing -> [LevelId]
arenas
Bool
nonWaitMove <- [LevelId] -> m Bool
handle [LevelId]
myArenas
Bool
breakASAP <- (StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> Bool
sbreakASAP
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
breakASAP (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ [LevelId] -> m ()
killDying [LevelId]
myArenas
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
nonWaitMove (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> m ()
updatePerFid FactionId
fid
loopUpd :: forall m. (MonadServerAtomic m, MonadServerComm m)
=> m () -> m ()
loopUpd :: m () -> m ()
loopUpd updConn :: m ()
updConn = do
let updatePerFid :: FactionId -> m ()
{-# NOINLINE updatePerFid #-}
updatePerFid :: FactionId -> m ()
updatePerFid fid :: FactionId
fid = do
EnumMap LevelId Bool
perValid <- (StateServer -> EnumMap LevelId Bool) -> m (EnumMap LevelId Bool)
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> EnumMap LevelId Bool) -> m (EnumMap LevelId Bool))
-> (StateServer -> EnumMap LevelId Bool)
-> m (EnumMap LevelId Bool)
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId (EnumMap LevelId Bool)
-> FactionId -> EnumMap LevelId Bool
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (EnumMap FactionId (EnumMap LevelId Bool) -> EnumMap LevelId Bool)
-> (StateServer -> EnumMap FactionId (EnumMap LevelId Bool))
-> StateServer
-> EnumMap LevelId Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> EnumMap FactionId (EnumMap LevelId Bool)
sperValidFid
((LevelId, Bool) -> m ()) -> [(LevelId, Bool)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(lid :: LevelId
lid, valid :: Bool
valid) -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
valid (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> LevelId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> LevelId -> m ()
updatePer FactionId
fid LevelId
lid)
(EnumMap LevelId Bool -> [(LevelId, Bool)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap LevelId Bool
perValid)
handleFid :: (FactionId, Faction) -> m ()
{-# NOINLINE handleFid #-}
handleFid :: (FactionId, Faction) -> m ()
handleFid (fid :: FactionId
fid, fact :: Faction
fact) = do
Bool
breakASAP <- (StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> Bool
sbreakASAP
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
breakASAP (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ (FactionId -> m ()) -> FactionId -> Faction -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
(FactionId -> m ()) -> FactionId -> Faction -> m ()
handleFidUpd FactionId -> m ()
updatePerFid FactionId
fid Faction
fact
loopConditionally :: m ()
loopConditionally = do
FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
(FactionId -> m ()) -> [FactionId] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FactionId -> m ()
updatePerFid (FactionDict -> [FactionId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys FactionDict
factionD)
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser -> StateServer
ser { sbreakLoop :: Bool
sbreakLoop = Bool
False
, sbreakASAP :: Bool
sbreakASAP = Bool
False }
m () -> (Maybe (GroupName ModeKind) -> m ()) -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
m () -> (Maybe (GroupName ModeKind) -> m ()) -> m ()
endOrLoop m ()
loopUpdConn (m () -> m () -> Maybe (GroupName ModeKind) -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
m () -> m () -> Maybe (GroupName ModeKind) -> m ()
restartGame m ()
updConn m ()
loopUpdConn)
loopUpdConn :: m ()
loopUpdConn = do
FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
((FactionId, Faction) -> m ()) -> [(FactionId, Faction)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FactionId, Faction) -> m ()
handleFid ([(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.toDescList FactionDict
factionD
Bool
breakASAP <- (StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> Bool
sbreakASAP
Bool
breakLoop <- (StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> Bool
sbreakLoop
if Bool
breakASAP Bool -> Bool -> Bool
|| Bool
breakLoop
then m ()
loopConditionally
else do
[LevelId]
arenas <- (StateServer -> [LevelId]) -> m [LevelId]
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> [LevelId]
sarenas
(FactionId -> m ()) -> [FactionId] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\fid :: FactionId
fid -> (LevelId -> m ()) -> [LevelId] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (LevelId -> FactionId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
LevelId -> FactionId -> m ()
`handleTrajectories` FactionId
fid) [LevelId]
arenas)
(FactionDict -> [FactionId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys FactionDict
factionD)
(FactionId -> m ()) -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
(FactionId -> m ()) -> m ()
endClip FactionId -> m ()
updatePerFid
Bool
breakLoop2 <- (StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> Bool
sbreakLoop
if Bool
breakLoop2
then m ()
loopConditionally
else m ()
loopUpdConn
m ()
loopUpdConn
endClip :: forall m. MonadServerAtomic m => (FactionId -> m ()) -> m ()
{-# INLINE endClip #-}
endClip :: (FactionId -> m ()) -> m ()
endClip updatePerFid :: FactionId -> m ()
updatePerFid = do
COps{RuleContent
corule :: COps -> RuleContent
corule :: RuleContent
corule} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
Time
time <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Time
stime
let clipN :: Int
clipN = Time
time Time -> Time -> Int
`timeFit` Time
timeClip
Bool
breakLoop <- (StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> Bool
sbreakLoop
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
breakLoop (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
[LevelId]
arenas <- (StateServer -> [LevelId]) -> m [LevelId]
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> [LevelId]
sarenas
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ [LevelId] -> UpdAtomic
UpdAgeGame [LevelId]
arenas
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
clipN Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` RuleContent -> Int
rleadLevelClips RuleContent
corule Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) m ()
forall (m :: * -> *). MonadServerAtomic m => m ()
leadLevelSwitch
case Int
clipN Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
clipsInTurn of
2 ->
m ()
forall (m :: * -> *). MonadServerAtomic m => m ()
applyPeriodicLevel
4 ->
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([LevelId] -> Bool
forall a. [a] -> Bool
null [LevelId]
arenas) m ()
forall (m :: * -> *). MonadServerAtomic m => m ()
spawnMonster
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Bool
breakLoop2 <- (StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> Bool
sbreakLoop
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
breakLoop2 (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Bool
validArenas <- (StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> Bool
svalidArenas
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
validArenas (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
[LevelId]
arenasNew <- m [LevelId]
forall (m :: * -> *). MonadStateRead m => m [LevelId]
arenasForLoop
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser -> StateServer
ser {sarenas :: [LevelId]
sarenas = [LevelId]
arenasNew, svalidArenas :: Bool
svalidArenas = Bool
True}
FactionDict
factionD <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
(FactionId -> m ()) -> [FactionId] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FactionId -> m ()
updatePerFid (FactionDict -> [FactionId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys FactionDict
factionD)
#ifndef USE_JSFILE
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
breakLoop2 (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
clipN Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` RuleContent -> Int
rwriteSaveClips RuleContent
corule Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> m ()
forall (m :: * -> *). MonadServerAtomic m => Bool -> m ()
writeSaveAll Bool
False
#endif
manageCalmAndDomination :: MonadServerAtomic m => ActorId -> Actor -> m ()
manageCalmAndDomination :: ActorId -> Actor -> m ()
manageCalmAndDomination aid :: ActorId
aid b :: Actor
b = do
Bool
performedDomination <-
if Actor -> Int64
bcalm Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False else do
Maybe (FactionId, Int)
hiImpression <- Actor -> m (Maybe (FactionId, Int))
forall (m :: * -> *).
MonadServerAtomic m =>
Actor -> m (Maybe (FactionId, Int))
highestImpression Actor
b
case Maybe (FactionId, Int)
hiImpression of
Nothing -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just (hiImpressionFid :: FactionId
hiImpressionFid, hiImpressionK :: Int
hiImpressionK) -> do
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
if Player -> LeaderMode
fleaderMode (Faction -> Player
gplayer Faction
fact) LeaderMode -> LeaderMode -> Bool
forall a. Eq a => a -> a -> Bool
/= LeaderMode
LeaderNull
Bool -> Bool -> Bool
|| Int
hiImpressionK Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 10
then ActorId -> ActorId -> FactionId -> m Bool
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> ActorId -> FactionId -> m Bool
dominateFidSfx ActorId
aid ActorId
aid FactionId
hiImpressionFid
else Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
performedDomination (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Int64
newCalmDelta <- (State -> Int64) -> m Int64
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Int64) -> m Int64) -> (State -> Int64) -> m Int64
forall a b. (a -> b) -> a -> b
$ ActorId -> Actor -> State -> Int64
regenCalmDelta ActorId
aid Actor
b
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int64
newCalmDelta Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== 0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
ActorId -> Int64 -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Int64 -> m ()
updateCalm ActorId
aid Int64
newCalmDelta
applyPeriodicLevel :: MonadServerAtomic m => m ()
applyPeriodicLevel :: m ()
applyPeriodicLevel = do
[LevelId]
arenas <- (StateServer -> [LevelId]) -> m [LevelId]
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> [LevelId]
sarenas
let arenasSet :: EnumSet LevelId
arenasSet = [LevelId] -> EnumSet LevelId
forall k. Enum k => [k] -> EnumSet k
ES.fromDistinctAscList [LevelId]
arenas
applyPeriodicItem :: ActorId -> CStore -> (ItemId, (a, [a])) -> m ()
applyPeriodicItem _ _ (_, (_, [])) = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
applyPeriodicItem aid :: ActorId
aid cstore :: CStore
cstore (iid :: ItemId
iid, _) = do
ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Periodic AspectRecord
arItem) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Actor
b2 <- (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
ItemBag
bag <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b2 CStore
cstore
case ItemId
iid ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bag of
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (k :: Int
k, _) ->
Bool
-> ActorId
-> Bool
-> Bool
-> Bool
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Bool
-> ItemFull
-> Bool
-> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> ActorId
-> Bool
-> Bool
-> Bool
-> ActorId
-> ActorId
-> ItemId
-> Container
-> Bool
-> ItemFull
-> Bool
-> m ()
effectAndDestroyAndAddKill
Bool
True ActorId
aid Bool
False (Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 1) Bool
False
ActorId
aid ActorId
aid ItemId
iid (ActorId -> CStore -> Container
CActor ActorId
aid CStore
cstore) Bool
True ItemFull
itemFull Bool
True
applyPeriodicActor :: (ActorId, Actor) -> m ()
applyPeriodicActor (aid :: ActorId
aid, b :: Actor
b) =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Actor -> Bool
bproj Actor
b) Bool -> Bool -> Bool
&& Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0 Bool -> Bool -> Bool
&& Actor -> LevelId
blid Actor
b LevelId -> EnumSet LevelId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` EnumSet LevelId
arenasSet) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
((ItemId, ItemQuant) -> m ()) -> [(ItemId, ItemQuant)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ActorId -> CStore -> (ItemId, ItemQuant) -> m ()
forall (m :: * -> *) a a.
MonadServerAtomic m =>
ActorId -> CStore -> (ItemId, (a, [a])) -> m ()
applyPeriodicItem ActorId
aid CStore
CEqp) ([(ItemId, ItemQuant)] -> m ()) -> [(ItemId, ItemQuant)] -> m ()
forall a b. (a -> b) -> a -> b
$ ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (ItemBag -> [(ItemId, ItemQuant)])
-> ItemBag -> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> a -> b
$ Actor -> ItemBag
beqp Actor
b
((ItemId, ItemQuant) -> m ()) -> [(ItemId, ItemQuant)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ActorId -> CStore -> (ItemId, ItemQuant) -> m ()
forall (m :: * -> *) a a.
MonadServerAtomic m =>
ActorId -> CStore -> (ItemId, (a, [a])) -> m ()
applyPeriodicItem ActorId
aid CStore
COrgan) ([(ItemId, ItemQuant)] -> m ()) -> [(ItemId, ItemQuant)] -> m ()
forall a b. (a -> b) -> a -> b
$ ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (ItemBag -> [(ItemId, ItemQuant)])
-> ItemBag -> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> a -> b
$ Actor -> ItemBag
borgan Actor
b
ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Actor -> m ()
manageCalmAndDomination ActorId
aid Actor
b
ActorDict
allActors <- (State -> ActorDict) -> m ActorDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ActorDict
sactorD
((ActorId, Actor) -> m ()) -> [(ActorId, Actor)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ActorId, Actor) -> m ()
applyPeriodicActor ([(ActorId, Actor)] -> m ()) -> [(ActorId, Actor)] -> m ()
forall a b. (a -> b) -> a -> b
$ ActorDict -> [(ActorId, Actor)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ActorDict
allActors
handleTrajectories :: MonadServerAtomic m => LevelId -> FactionId -> m ()
handleTrajectories :: LevelId -> FactionId -> m ()
handleTrajectories lid :: LevelId
lid fid :: FactionId
fid = do
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
lid
EnumMap ActorId Time
levelTime <- (StateServer -> EnumMap ActorId Time) -> m (EnumMap ActorId Time)
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> EnumMap ActorId Time) -> m (EnumMap ActorId Time))
-> (StateServer -> EnumMap ActorId Time)
-> m (EnumMap ActorId Time)
forall a b. (a -> b) -> a -> b
$ (EnumMap LevelId (EnumMap ActorId Time)
-> LevelId -> EnumMap ActorId Time
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid) (EnumMap LevelId (EnumMap ActorId Time) -> EnumMap ActorId Time)
-> (StateServer -> EnumMap LevelId (EnumMap ActorId Time))
-> StateServer
-> EnumMap ActorId Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
-> FactionId -> EnumMap LevelId (EnumMap ActorId Time)
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
-> EnumMap LevelId (EnumMap ActorId Time))
-> (StateServer
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time)))
-> StateServer
-> EnumMap LevelId (EnumMap ActorId Time)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
strajTime
let l :: [ActorId]
l = [ActorId] -> [ActorId]
forall a. Ord a => [a] -> [a]
sort ([ActorId] -> [ActorId]) -> [ActorId] -> [ActorId]
forall a b. (a -> b) -> a -> b
$ ((ActorId, Time) -> ActorId) -> [(ActorId, Time)] -> [ActorId]
forall a b. (a -> b) -> [a] -> [b]
map (ActorId, Time) -> ActorId
forall a b. (a, b) -> a
fst
([(ActorId, Time)] -> [ActorId]) -> [(ActorId, Time)] -> [ActorId]
forall a b. (a -> b) -> a -> b
$ ((ActorId, Time) -> Bool) -> [(ActorId, Time)] -> [(ActorId, Time)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(_, atime :: Time
atime) -> Time
atime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= Time
localTime) ([(ActorId, Time)] -> [(ActorId, Time)])
-> [(ActorId, Time)] -> [(ActorId, Time)]
forall a b. (a -> b) -> a -> b
$ EnumMap ActorId Time -> [(ActorId, Time)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap ActorId Time
levelTime
(ActorId -> m ()) -> [ActorId] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
hTrajectories [ActorId]
l
Bool
breakLoop <- (StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> Bool
sbreakLoop
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ActorId] -> Bool
forall a. [a] -> Bool
null [ActorId]
l Bool -> Bool -> Bool
|| Bool
breakLoop) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
LevelId -> FactionId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
LevelId -> FactionId -> m ()
handleTrajectories LevelId
lid FactionId
fid
hTrajectories :: MonadServerAtomic m => ActorId -> m ()
{-# INLINE hTrajectories #-}
hTrajectories :: ActorId -> m ()
hTrajectories aid :: ActorId
aid = do
Actor
b1 <- (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 removePushed :: Actor -> m ()
removePushed b :: Actor
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
$ \ser :: StateServer
ser ->
StateServer
ser { strajTime :: EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
strajTime =
(EnumMap LevelId (EnumMap ActorId Time)
-> EnumMap LevelId (EnumMap ActorId Time))
-> FactionId
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust ((EnumMap ActorId Time -> EnumMap ActorId Time)
-> LevelId
-> EnumMap LevelId (EnumMap ActorId Time)
-> EnumMap LevelId (EnumMap ActorId Time)
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust (ActorId -> EnumMap ActorId Time -> EnumMap ActorId Time
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete ActorId
aid) (Actor -> LevelId
blid Actor
b)) (Actor -> FactionId
bfid Actor
b)
(StateServer
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
strajTime StateServer
ser)
, strajPushedBy :: ActorPushedBy
strajPushedBy = ActorId -> ActorPushedBy -> ActorPushedBy
forall k a. Enum k => k -> EnumMap k a -> EnumMap k a
EM.delete ActorId
aid (StateServer -> ActorPushedBy
strajPushedBy StateServer
ser) }
removeTrajectory :: Actor -> m ()
removeTrajectory b :: Actor
b =
Bool -> m () -> m ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Bool
bproj Actor
b)
(m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId
-> Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> UpdAtomic
UpdTrajectory ActorId
aid (Actor -> Maybe ([Vector], Speed)
btrajectory Actor
b) Maybe ([Vector], Speed)
forall a. Maybe a
Nothing
Bool
breakLoop <- (StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> Bool
sbreakLoop
if Bool
breakLoop then () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
else if Actor -> Bool
actorDying Actor
b1 then ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Actor -> m ()
dieSer ActorId
aid Actor
b1
else case Actor -> Maybe ([Vector], Speed)
btrajectory Actor
b1 of
Nothing -> Actor -> m ()
removePushed Actor
b1
Just ([], _) -> Actor -> m ()
removeTrajectory Actor
b1 m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Actor -> m ()
removePushed Actor
b1
Just{} -> do
ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Actor -> m ()
advanceTrajectory ActorId
aid Actor
b1
Actor
b2 <- (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
if Actor -> Bool
actorDying Actor
b2
then ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Actor -> m ()
dieSer ActorId
aid Actor
b2
else case Actor -> Maybe ([Vector], Speed)
btrajectory Actor
b2 of
Nothing -> Actor -> m ()
removePushed Actor
b2
Just ([], _) -> Actor -> m ()
removeTrajectory Actor
b2 m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Actor -> m ()
removePushed Actor
b2
Just{} ->
ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
advanceTimeTraj ActorId
aid
advanceTrajectory :: MonadServerAtomic m => ActorId -> Actor -> m ()
{-# INLINE advanceTrajectory #-}
advanceTrajectory :: ActorId -> Actor -> m ()
advanceTrajectory aid :: ActorId
aid b :: Actor
b = do
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 -> m Level) -> LevelId -> m Level
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b
AspectRecord
arTrunk <- (State -> AspectRecord) -> m AspectRecord
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> AspectRecord) -> m AspectRecord)
-> (State -> AspectRecord) -> m AspectRecord
forall a b. (a -> b) -> a -> b
$ (EnumMap ItemId AspectRecord -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> ItemId
btrunk Actor
b) (EnumMap ItemId AspectRecord -> AspectRecord)
-> (State -> EnumMap ItemId AspectRecord) -> State -> AspectRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap ItemId AspectRecord
sdiscoAspect
case Actor -> Maybe ([Vector], Speed)
btrajectory Actor
b of
Just (d :: Vector
d : lv :: [Vector]
lv, speed :: Speed
speed) -> do
let tpos :: Point
tpos = Actor -> Point
bpos Actor
b Point -> Vector -> Point
`shift` Vector
d
if | TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup (ContentId TileKind -> Bool) -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ Level
lvl Level -> Point -> ContentId TileKind
`at` Point
tpos -> do
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId
-> Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> UpdAtomic
UpdTrajectory ActorId
aid (Actor -> Maybe ([Vector], Speed)
btrajectory Actor
b) (([Vector], Speed) -> Maybe ([Vector], Speed)
forall a. a -> Maybe a
Just ([Vector]
lv, Speed
speed))
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Vector] -> Bool
forall a. [a] -> Bool
null [Vector]
lv Bool -> Bool -> Bool
&& Actor -> Bool
bproj Actor
b
Bool -> Bool -> Bool
&& Bool -> Bool
not (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arTrunk)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
ActorId
killer <- (StateServer -> ActorId) -> m ActorId
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> ActorId) -> m ActorId)
-> (StateServer -> ActorId) -> m ActorId
forall a b. (a -> b) -> a -> b
$ ActorId -> ActorId -> ActorPushedBy -> ActorId
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault ActorId
aid ActorId
aid (ActorPushedBy -> ActorId)
-> (StateServer -> ActorPushedBy) -> StateServer -> ActorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ActorPushedBy
strajPushedBy
ActorId -> KillHow -> FactionId -> ItemId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> KillHow -> FactionId -> ItemId -> m ()
addKillToAnalytics ActorId
killer KillHow
KillDropLaunch (Actor -> FactionId
bfid Actor
b) (Actor -> ItemId
btrunk Actor
b)
let occupied :: Bool
occupied = Point -> Level -> Bool
occupiedBigLvl Point
tpos Level
lvl Bool -> Bool -> Bool
|| Point -> Level -> Bool
occupiedProjLvl Point
tpos Level
lvl
reqMoveHit :: m ()
reqMoveHit = Bool -> Bool -> ActorId -> Vector -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> Bool -> ActorId -> Vector -> m ()
reqMoveGeneric Bool
False Bool
True ActorId
aid Vector
d
reqDisp :: ActorId -> m ()
reqDisp = Bool -> ActorId -> ActorId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> ActorId -> ActorId -> m ()
reqDisplaceGeneric Bool
False ActorId
aid
if | Actor -> Bool
bproj Actor
b ->
m ()
reqMoveHit
| Bool
occupied ->
case (Point -> Level -> Maybe ActorId
posToBigLvl Point
tpos Level
lvl, Point -> Level -> [ActorId]
posToProjsLvl Point
tpos Level
lvl) of
(Nothing, []) -> String -> m ()
forall a. (?callStack::CallStack) => String -> a
error "advanceTrajectory: not occupied"
(Nothing, [target :: ActorId
target]) -> ActorId -> m ()
reqDisp ActorId
target
(Nothing, _) -> m ()
reqMoveHit
(Just target :: ActorId
target, []) -> do
Actor
b2 <- (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
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
if FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
b) Faction
fact (Actor -> FactionId
bfid Actor
b2)
then m ()
reqMoveHit
else ActorId -> m ()
reqDisp ActorId
target
(Just _, _) -> m ()
reqMoveHit
| Bool
otherwise -> m ()
reqMoveHit
| Actor -> Bool
bproj Actor
b -> do
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId
-> Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> UpdAtomic
UpdTrajectory ActorId
aid (Actor -> Maybe ([Vector], Speed)
btrajectory Actor
b) Maybe ([Vector], Speed)
forall a. Maybe a
Nothing
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arTrunk)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
ActorId
killer <- (StateServer -> ActorId) -> m ActorId
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> ActorId) -> m ActorId)
-> (StateServer -> ActorId) -> m ActorId
forall a b. (a -> b) -> a -> b
$ ActorId -> ActorId -> ActorPushedBy -> ActorId
forall k a. Enum k => a -> k -> EnumMap k a -> a
EM.findWithDefault ActorId
aid ActorId
aid (ActorPushedBy -> ActorId)
-> (StateServer -> ActorPushedBy) -> StateServer -> ActorId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer -> ActorPushedBy
strajPushedBy
ActorId -> KillHow -> FactionId -> ItemId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> KillHow -> FactionId -> ItemId -> m ()
addKillToAnalytics ActorId
killer KillHow
KillTileLaunch (Actor -> FactionId
bfid Actor
b) (Actor -> ItemId
btrunk Actor
b)
| Bool
otherwise -> do
SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Point -> SfxAtomic
SfxCollideTile ActorId
aid Point
tpos
Maybe ReqFailure
mfail <- Bool -> ActorId -> Point -> m (Maybe ReqFailure)
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> ActorId -> Point -> m (Maybe ReqFailure)
reqAlterFail Bool
False ActorId
aid Point
tpos
Level
lvl2 <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (LevelId -> m Level) -> LevelId -> m Level
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b
case Maybe ReqFailure
mfail of
Nothing | TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup (ContentId TileKind -> Bool) -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ Level
lvl2 Level -> Point -> ContentId TileKind
`at` Point
tpos ->
() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
_ -> do
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId
-> Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> UpdAtomic
UpdTrajectory ActorId
aid (Actor -> Maybe ([Vector], Speed)
btrajectory Actor
b) Maybe ([Vector], Speed)
forall a. Maybe a
Nothing
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> Int64
bhp Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
oneM) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Int64 -> UpdAtomic
UpdRefillHP ActorId
aid Int64
minusM
let effect :: Effect
effect = Int -> Effect
IK.RefillHP (-2)
SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> ActorId -> Effect -> Int64 -> SfxAtomic
SfxEffect (Actor -> FactionId
bfid Actor
b) ActorId
aid Effect
effect (-1)
_ -> String -> m ()
forall a. (?callStack::CallStack) => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "Nothing or empty trajectory" String -> (ActorId, Actor) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid, Actor
b)
handleActors :: (MonadServerAtomic m, MonadServerComm m)
=> LevelId -> FactionId -> m Bool
handleActors :: LevelId -> FactionId -> m Bool
handleActors lid :: LevelId
lid fid :: FactionId
fid = do
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
lid
EnumMap ActorId Time
levelTime <- (StateServer -> EnumMap ActorId Time) -> m (EnumMap ActorId Time)
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer ((StateServer -> EnumMap ActorId Time) -> m (EnumMap ActorId Time))
-> (StateServer -> EnumMap ActorId Time)
-> m (EnumMap ActorId Time)
forall a b. (a -> b) -> a -> b
$ (EnumMap LevelId (EnumMap ActorId Time)
-> LevelId -> EnumMap ActorId Time
forall k a. Enum k => EnumMap k a -> k -> a
EM.! LevelId
lid) (EnumMap LevelId (EnumMap ActorId Time) -> EnumMap ActorId Time)
-> (StateServer -> EnumMap LevelId (EnumMap ActorId Time))
-> StateServer
-> EnumMap ActorId Time
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
-> FactionId -> EnumMap LevelId (EnumMap ActorId Time)
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
-> EnumMap LevelId (EnumMap ActorId Time))
-> (StateServer
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time)))
-> StateServer
-> EnumMap LevelId (EnumMap ActorId Time)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateServer
-> EnumMap FactionId (EnumMap LevelId (EnumMap ActorId Time))
sactorTime
let l :: [ActorId]
l = [ActorId] -> [ActorId]
forall a. Ord a => [a] -> [a]
sort ([ActorId] -> [ActorId]) -> [ActorId] -> [ActorId]
forall a b. (a -> b) -> a -> b
$ ((ActorId, Time) -> ActorId) -> [(ActorId, Time)] -> [ActorId]
forall a b. (a -> b) -> [a] -> [b]
map (ActorId, Time) -> ActorId
forall a b. (a, b) -> a
fst
([(ActorId, Time)] -> [ActorId]) -> [(ActorId, Time)] -> [ActorId]
forall a b. (a -> b) -> a -> b
$ ((ActorId, Time) -> Bool) -> [(ActorId, Time)] -> [(ActorId, Time)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(_, atime :: Time
atime) -> Time
atime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= Time
localTime) ([(ActorId, Time)] -> [(ActorId, Time)])
-> [(ActorId, Time)] -> [(ActorId, Time)]
forall a b. (a -> b) -> a -> b
$ EnumMap ActorId Time -> [(ActorId, Time)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap ActorId Time
levelTime
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
[ActorId] -> m Bool
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
[ActorId] -> m Bool
hActors ([ActorId] -> m Bool) -> [ActorId] -> m Bool
forall a b. (a -> b) -> a -> b
$ case Maybe ActorId
mleader of
Just aid :: ActorId
aid | ActorId
aid ActorId -> [ActorId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ActorId]
l -> ActorId
aid ActorId -> [ActorId] -> [ActorId]
forall a. a -> [a] -> [a]
: ActorId -> [ActorId] -> [ActorId]
forall a. Eq a => a -> [a] -> [a]
delete ActorId
aid [ActorId]
l
_ -> [ActorId]
l
hActors :: forall m. (MonadServerAtomic m, MonadServerComm m)
=> [ActorId] -> m Bool
hActors :: [ActorId] -> m Bool
hActors [] = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
hActors as :: [ActorId]
as@(aid :: ActorId
aid : rest :: [ActorId]
rest) = do
Actor
b1 <- (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 !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Bool
bproj Actor
b1) ()
if Actor -> Int64
bhp Actor
b1 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 then
[ActorId] -> m Bool
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
[ActorId] -> m Bool
hActors [ActorId]
rest
else do
let side :: FactionId
side = Actor -> FactionId
bfid Actor
b1
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
Bool
breakLoop <- (StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> Bool
sbreakLoop
let mleader :: Maybe ActorId
mleader = Faction -> Maybe ActorId
gleader Faction
fact
aidIsLeader :: Bool
aidIsLeader = Maybe ActorId
mleader Maybe ActorId -> Maybe ActorId -> Bool
forall a. Eq a => a -> a -> Bool
== ActorId -> Maybe ActorId
forall a. a -> Maybe a
Just ActorId
aid
mainUIactor :: Bool
mainUIactor = Player -> Bool
fhasUI (Faction -> Player
gplayer Faction
fact)
Bool -> Bool -> Bool
&& (Bool
aidIsLeader
Bool -> Bool -> Bool
|| Player -> LeaderMode
fleaderMode (Faction -> Player
gplayer Faction
fact) LeaderMode -> LeaderMode -> Bool
forall a. Eq a => a -> a -> Bool
== LeaderMode
LeaderNull)
mainUIunderAI :: Bool
mainUIunderAI = Bool
mainUIactor Bool -> Bool -> Bool
&& Faction -> Bool
isAIFact Faction
fact Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
breakLoop
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
mainUIunderAI (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
RequestUI
cmdS <- FactionId -> ActorId -> m RequestUI
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
FactionId -> ActorId -> m RequestUI
sendQueryUI FactionId
side ActorId
aid
case RequestUI -> ReqUI
forall a b. (a, b) -> a
fst RequestUI
cmdS of
ReqUINop -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ReqUIAutomate -> UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> Bool -> UpdAtomic
UpdAutoFaction FactionId
side Bool
False
ReqUIGameDropAndExit -> ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
reqGameDropAndExit ActorId
aid
ReqUIGameSaveAndExit -> ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
reqGameSaveAndExit ActorId
aid
_ -> String -> m ()
forall a. (?callStack::CallStack) => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ "" String -> RequestUI -> String
forall v. Show v => String -> v -> String
`showFailure` RequestUI
cmdS
Faction
factNew <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (FactionDict -> Faction)
-> (State -> FactionDict) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> FactionDict
sfactionD
let doQueryAI :: Bool
doQueryAI = Bool -> Bool
not Bool
mainUIactor Bool -> Bool -> Bool
|| Faction -> Bool
isAIFact Faction
factNew
Bool
breakASAP <- (StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> Bool
sbreakASAP
if Bool
breakASAP then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True else do
let mswitchLeader :: Maybe ActorId -> m ActorId
{-# NOINLINE mswitchLeader #-}
mswitchLeader :: Maybe ActorId -> m ActorId
mswitchLeader (Just aidNew :: ActorId
aidNew) = FactionId -> ActorId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> ActorId -> m ()
switchLeader FactionId
side ActorId
aidNew m () -> m ActorId -> m ActorId
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ActorId -> m ActorId
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
aidNew
mswitchLeader Nothing = ActorId -> m ActorId
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
aid
(aidNew :: ActorId
aidNew, mtimed :: Maybe RequestTimed
mtimed) <-
if Bool
doQueryAI then do
(cmd :: ReqAI
cmd, maid :: Maybe ActorId
maid) <- FactionId -> ActorId -> m (ReqAI, Maybe ActorId)
forall (m :: * -> *).
MonadServerComm m =>
FactionId -> ActorId -> m (ReqAI, Maybe ActorId)
sendQueryAI FactionId
side ActorId
aid
ActorId
aidNew <- Maybe ActorId -> m ActorId
mswitchLeader Maybe ActorId
maid
Maybe RequestTimed
mtimed <- ReqAI -> m (Maybe RequestTimed)
forall (m :: * -> *).
MonadServerAtomic m =>
ReqAI -> m (Maybe RequestTimed)
handleRequestAI ReqAI
cmd
(ActorId, Maybe RequestTimed) -> m (ActorId, Maybe RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (ActorId
aidNew, Maybe RequestTimed
mtimed)
else do
(cmd :: ReqUI
cmd, maid :: Maybe ActorId
maid) <- FactionId -> ActorId -> m RequestUI
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
FactionId -> ActorId -> m RequestUI
sendQueryUI FactionId
side ActorId
aid
ActorId
aidNew <- Maybe ActorId -> m ActorId
mswitchLeader Maybe ActorId
maid
Maybe RequestTimed
mtimed <- FactionId -> ActorId -> ReqUI -> m (Maybe RequestTimed)
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> ActorId -> ReqUI -> m (Maybe RequestTimed)
handleRequestUI FactionId
side ActorId
aidNew ReqUI
cmd
(ActorId, Maybe RequestTimed) -> m (ActorId, Maybe RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (ActorId
aidNew, Maybe RequestTimed
mtimed)
case Maybe RequestTimed
mtimed of
Just timed :: RequestTimed
timed -> do
Bool
nonWaitMove <- FactionId -> ActorId -> RequestTimed -> m Bool
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> ActorId -> RequestTimed -> m Bool
handleRequestTimed FactionId
side ActorId
aidNew RequestTimed
timed
if Bool
nonWaitMove then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True else [ActorId] -> m Bool
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
[ActorId] -> m Bool
hActors [ActorId]
rest
Nothing -> do
Bool
breakASAP2 <- (StateServer -> Bool) -> m Bool
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> Bool
sbreakASAP
if Bool
breakASAP2 then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True else [ActorId] -> m Bool
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
[ActorId] -> m Bool
hActors [ActorId]
as
restartGame :: MonadServerAtomic m
=> m () -> m () -> Maybe (GroupName ModeKind) -> m ()
restartGame :: m () -> m () -> Maybe (GroupName ModeKind) -> m ()
restartGame updConn :: m ()
updConn loop :: m ()
loop mgameMode :: Maybe (GroupName ModeKind)
mgameMode = do
ServerOptions
soptionsNxt <- (StateServer -> ServerOptions) -> m ServerOptions
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> ServerOptions
soptionsNxt
StdGen
srandom <- (StateServer -> StdGen) -> m StdGen
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> StdGen
srandom
State
s <- ServerOptions
-> Maybe (GroupName ModeKind) -> Maybe StdGen -> m State
forall (m :: * -> *).
MonadServer m =>
ServerOptions
-> Maybe (GroupName ModeKind) -> Maybe StdGen -> m State
gameReset ServerOptions
soptionsNxt Maybe (GroupName ModeKind)
mgameMode (StdGen -> Maybe StdGen
forall a. a -> Maybe a
Just StdGen
srandom)
let optionsBarRngs :: ServerOptions
optionsBarRngs = ServerOptions
soptionsNxt {sdungeonRng :: Maybe StdGen
sdungeonRng = Maybe StdGen
forall a. Maybe a
Nothing, smainRng :: Maybe StdGen
smainRng = Maybe StdGen
forall a. Maybe a
Nothing}
(StateServer -> StateServer) -> m ()
forall (m :: * -> *).
MonadServer m =>
(StateServer -> StateServer) -> m ()
modifyServer ((StateServer -> StateServer) -> m ())
-> (StateServer -> StateServer) -> m ()
forall a b. (a -> b) -> a -> b
$ \ser :: StateServer
ser -> StateServer
ser { soptionsNxt :: ServerOptions
soptionsNxt = ServerOptions
optionsBarRngs
, soptions :: ServerOptions
soptions = ServerOptions
optionsBarRngs }
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ State -> UpdAtomic
UpdRestartServer State
s
m ()
updConn
m ()
forall (m :: * -> *). MonadServer m => m ()
initPer
m ()
forall (m :: * -> *). MonadServerAtomic m => m ()
reinitGame
Bool -> m ()
forall (m :: * -> *). MonadServerAtomic m => Bool -> m ()
writeSaveAll Bool
False
m ()
loop