module Game.LambdaHack.Server.LoopM
( loopSer
#ifdef EXPOSE_INTERNAL
, factionArena, arenasForLoop, handleFidUpd, loopUpd, endClip
, manageCalmAndDomination, applyPeriodicLevel
, handleTrajectories, hTrajectories, advanceTrajectory
, handleActors, hActors, handleUIunderAI, dieSer, restartGame
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import Game.LambdaHack.Atomic
import Game.LambdaHack.Client (ReqUI (..), Response (..))
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Analytics
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import Game.LambdaHack.Common.Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.Perception
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Types
import Game.LambdaHack.Common.Vector
import Game.LambdaHack.Content.FactionKind
import qualified Game.LambdaHack.Content.ItemKind as IK
import Game.LambdaHack.Content.ModeKind
import Game.LambdaHack.Content.RuleKind
import qualified Game.LambdaHack.Definition.Ability as Ability
import Game.LambdaHack.Definition.Defs
import Game.LambdaHack.Server.CommonM
import Game.LambdaHack.Server.HandleEffectM
import Game.LambdaHack.Server.HandleRequestM
import Game.LambdaHack.Server.MonadServer
import Game.LambdaHack.Server.PeriodicM
import Game.LambdaHack.Server.ProtocolM
import Game.LambdaHack.Server.ServerOptions
import Game.LambdaHack.Server.StartM
import Game.LambdaHack.Server.State
loopSer :: (MonadServerAtomic m, MonadServerComm m)
=> ServerOptions
-> (Bool -> FactionId -> ChanServer -> IO ())
-> m ()
loopSer :: ServerOptions -> (Bool -> FactionId -> ChanServer -> IO ()) -> m ()
loopSer ServerOptions
serverOptions 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
$ \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 :: Bool -> m ()
updConn Bool
startsNewGame = (FactionId -> ChanServer -> IO ()) -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
(FactionId -> ChanServer -> IO ()) -> m ()
updateConn ((FactionId -> ChanServer -> IO ()) -> m ())
-> (FactionId -> ChanServer -> IO ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> FactionId -> ChanServer -> IO ()
executorClient Bool
startsNewGame
Maybe (State, StateServer)
restored <- m (Maybe (State, StateServer))
forall (m :: * -> *).
MonadServerComm m =>
m (Maybe (State, StateServer))
tryRestore
case Maybe (State, StateServer)
restored of
Just (State
sRaw, StateServer
ser) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ServerOptions -> Bool
snewGameSer ServerOptions
serverOptions -> do
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 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 ()) -> [FactionId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> (FactionId -> m Bool) -> FactionId -> m ()
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
Bool -> m ()
updConn Bool
False
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 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.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (\FactionId
fid -> FactionId -> UpdAtomic -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
FactionId -> UpdAtomic -> m ()
sendUpdate FactionId
fid (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> EnumMap LevelId Perception -> UpdAtomic
UpdResume FactionId
fid (FactionId -> EnumMap LevelId Perception
persFid FactionId
fid))
(FactionDict -> [FactionId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys FactionDict
factionD)
EnumSet LevelId
arenasNew <- m (EnumSet LevelId)
forall (m :: * -> *). MonadStateRead m => m (EnumSet 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
$ \StateServer
ser2 -> StateServer
ser2 {sarenas :: EnumSet LevelId
sarenas = EnumSet 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
Maybe (State, StateServer)
_ -> do
FactionDict
factionDold <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
State
s <- ServerOptions
-> Maybe (GroupName ModeKind) -> Maybe SMGen -> m State
forall (m :: * -> *).
MonadServer m =>
ServerOptions
-> Maybe (GroupName ModeKind) -> Maybe SMGen -> m State
gameReset ServerOptions
serverOptions Maybe (GroupName ModeKind)
forall a. Maybe a
Nothing Maybe SMGen
forall a. Maybe a
Nothing
let optionsBarRngs :: ServerOptions
optionsBarRngs =
ServerOptions
serverOptions {sdungeonRng :: Maybe SMGen
sdungeonRng = Maybe SMGen
forall a. Maybe a
Nothing, smainRng :: Maybe SMGen
smainRng = Maybe SMGen
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
$ \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
Bool -> m ()
updConn Bool
True
m ()
forall (m :: * -> *). MonadServer m => m ()
initPer
FactionDict -> m ()
forall (m :: * -> *). MonadServerAtomic m => FactionDict -> m ()
reinitGame FactionDict
factionDold
Bool -> Bool -> m ()
forall (m :: * -> *). MonadServerAtomic m => Bool -> Bool -> m ()
writeSaveAll Bool
False Bool
False
m () -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
m () -> m ()
loopUpd (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> m ()
updConn Bool
True
factionArena :: MonadStateRead m => Faction -> m (Maybe LevelId)
factionArena :: Faction -> m (Maybe LevelId)
factionArena Faction
fact = case Faction -> Maybe ActorId
gleader Faction
fact of
Just 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
Maybe ActorId
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 (ES.EnumSet LevelId)
{-# INLINE arenasForLoop #-}
arenasForLoop :: m (EnumSet 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 :: EnumSet LevelId
arenas = [LevelId] -> EnumSet LevelId
forall k. Enum k => [k] -> EnumSet k
ES.fromList ([LevelId] -> EnumSet LevelId) -> [LevelId] -> EnumSet LevelId
forall a b. (a -> b) -> a -> b
$ [Maybe LevelId] -> [LevelId]
forall a. [Maybe a] -> [a]
catMaybes [Maybe LevelId]
marenas
!_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not (EnumSet LevelId -> Bool
forall k. EnumSet k -> Bool
ES.null EnumSet LevelId
arenas)
Bool -> (String, FactionDict) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` String
"game over not caught earlier"
String -> FactionDict -> (String, FactionDict)
forall v. String -> v -> (String, v)
`swith` FactionDict
factionD) ()
EnumSet LevelId -> m (EnumSet LevelId)
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumSet LevelId -> m (EnumSet LevelId))
-> EnumSet LevelId -> m (EnumSet LevelId)
forall a b. (a -> b) -> a -> b
$! EnumSet LevelId
arenas
handleFidUpd :: forall m. (MonadServerAtomic m, MonadServerComm m)
=> (FactionId -> m ()) -> FactionId -> Faction -> m ()
{-# INLINE handleFidUpd #-}
handleFidUpd :: (FactionId -> m ()) -> FactionId -> Faction -> m ()
handleFidUpd FactionId -> m ()
updatePerFid FactionId
fid 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 (LevelId
lid : [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.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ LevelId -> m ()
killDyingLid
killDyingLid :: LevelId -> m ()
killDyingLid :: LevelId -> m ()
killDyingLid 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 (\(ActorId
_, Time
atime) -> Time
atime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= Time
localTime) ([(ActorId, Time)] -> [(ActorId, Time)])
-> [(ActorId, Time)] -> [(ActorId, Time)]
forall a b. (a -> b) -> a -> b
$ EnumMap ActorId Time -> [(ActorId, Time)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap ActorId Time
levelTime
killAid :: (ActorId, b) -> m ()
killAid (ActorId
aid, b
_) = 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
<= Int64
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.
(Foldable t, Monad m) =>
(a -> m ()) -> 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
EnumSet LevelId
arenas <- (StateServer -> EnumSet LevelId) -> m (EnumSet LevelId)
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> EnumSet LevelId
sarenas
let myArenas :: [LevelId]
myArenas = case Maybe LevelId
fa of
Just LevelId
myArena -> LevelId
myArena LevelId -> [LevelId] -> [LevelId]
forall a. a -> [a] -> [a]
: LevelId -> [LevelId] -> [LevelId]
forall a. Eq a => a -> [a] -> [a]
delete LevelId
myArena (EnumSet LevelId -> [LevelId]
forall k. Enum k => EnumSet k -> [k]
ES.elems EnumSet LevelId
arenas)
Maybe LevelId
Nothing -> EnumSet LevelId -> [LevelId]
forall k. Enum k => EnumSet k -> [k]
ES.elems EnumSet LevelId
arenas
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 m ()
updConn = do
let updatePerFid :: FactionId -> m ()
{-# NOINLINE updatePerFid #-}
updatePerFid :: FactionId -> m ()
updatePerFid 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.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (\(LevelId
lid, Bool
valid) -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
valid (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> LevelId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> LevelId -> m ()
updatePer FactionId
fid LevelId
lid)
(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 (FactionId
fid, 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.
(Foldable t, Monad m) =>
(a -> m ()) -> 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
$ \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
let hasUI :: (a, Faction) -> Bool
hasUI (a
_, Faction
fact) = FactionKind -> Bool
fhasUI (Faction -> FactionKind
gkind Faction
fact)
((FactionId, Faction)
factionUI, [(FactionId, Faction)]
factionsRest) = case ((FactionId, Faction) -> Bool)
-> [(FactionId, Faction)]
-> ([(FactionId, Faction)], [(FactionId, Faction)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (FactionId, Faction) -> Bool
forall a. (a, Faction) -> Bool
hasUI ([(FactionId, Faction)]
-> ([(FactionId, Faction)], [(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 of
([(FactionId, Faction)]
noUI1, (FactionId, Faction)
ui : [(FactionId, Faction)]
noUI2) -> ((FactionId, Faction)
ui, [(FactionId, Faction)]
noUI1 [(FactionId, Faction)]
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. [a] -> [a] -> [a]
++ [(FactionId, Faction)]
noUI2)
([(FactionId, Faction)], [(FactionId, Faction)])
_ -> String -> ((FactionId, Faction), [(FactionId, Faction)])
forall a. (?callStack::CallStack) => String -> a
error String
"no UI faction in the game"
((FactionId, Faction) -> m ()) -> [(FactionId, Faction)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (FactionId, Faction) -> m ()
handleFid ([(FactionId, Faction)] -> m ()) -> [(FactionId, Faction)] -> m ()
forall a b. (a -> b) -> a -> b
$ (FactionId, Faction)
factionUI (FactionId, Faction)
-> [(FactionId, Faction)] -> [(FactionId, Faction)]
forall a. a -> [a] -> [a]
: [(FactionId, Faction)]
factionsRest
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
EnumSet LevelId
arenas <- (StateServer -> EnumSet LevelId) -> m (EnumSet LevelId)
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> EnumSet LevelId
sarenas
(FactionId -> m ()) -> [FactionId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (\FactionId
fid -> (LevelId -> m ()) -> [LevelId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (LevelId -> FactionId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
LevelId -> FactionId -> m ()
`handleTrajectories` FactionId
fid) ([LevelId] -> m ()) -> [LevelId] -> m ()
forall a b. (a -> b) -> a -> b
$ EnumSet LevelId -> [LevelId]
forall k. Enum k => EnumSet k -> [k]
ES.elems EnumSet LevelId
arenas)
(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 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
EnumSet LevelId
arenas <- (StateServer -> EnumSet LevelId) -> m (EnumSet LevelId)
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> EnumSet LevelId
sarenas
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ EnumSet LevelId -> UpdAtomic
UpdAgeGame EnumSet 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
== Int
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
Int
0 ->
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
clipN Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
clipsInTurn) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
m ()
forall (m :: * -> *). MonadServerAtomic m => m ()
spawnMonster
Int
4 ->
m ()
forall (m :: * -> *). MonadServerAtomic m => m ()
applyPeriodicLevel
Int
_ -> () -> 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
EnumSet LevelId
arenasNew <- m (EnumSet LevelId)
forall (m :: * -> *). MonadStateRead m => m (EnumSet 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
$ \StateServer
ser -> StateServer
ser {sarenas :: EnumSet LevelId
sarenas = EnumSet 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.
(Foldable t, Monad m) =>
(a -> m ()) -> 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 -> Int
forall a. Enum a => a -> a
succ 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
== Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
Bool -> Bool -> m ()
forall (m :: * -> *). MonadServerAtomic m => Bool -> Bool -> m ()
writeSaveAll Bool
False Bool
False
#endif
manageCalmAndDomination :: MonadServerAtomic m => ActorId -> Actor -> m ()
manageCalmAndDomination :: ActorId -> Actor -> m ()
manageCalmAndDomination ActorId
aid Actor
b = do
Bool
performedDomination <-
if Actor -> Int64
bcalm Actor
b Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
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
Maybe (FactionId, Int)
Nothing -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Just (FactionId
hiImpressionFid, 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 FactionKind -> Bool
fhasPointman (Faction -> FactionKind
gkind Faction
fact)
Bool -> Bool -> Bool
|| Int
hiImpressionK Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10
then ActorId -> ActorId -> ItemId -> FactionId -> m Bool
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> ActorId -> ItemId -> FactionId -> m Bool
dominateFidSfx ActorId
aid ActorId
aid (Actor -> ItemId
btrunk Actor
b) 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
== Int64
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
EnumSet LevelId
arenas <- (StateServer -> EnumSet LevelId) -> m (EnumSet LevelId)
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> EnumSet LevelId
sarenas
let applyPeriodicItem :: ActorId -> CStore -> (ItemId, (a, [a])) -> m ()
applyPeriodicItem ActorId
_ CStore
_ (ItemId
_, (a
_, [])) = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
applyPeriodicItem ActorId
aid CStore
cstore (ItemId
iid, (a, [a])
_) = 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
Maybe ItemQuant
Nothing -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just (Int
k, ItemTimers
_) -> do
let effApplyFlags :: EffApplyFlags
effApplyFlags = EffApplyFlags :: EffToUse
-> Bool -> Bool -> Bool -> ActivationFlag -> Bool -> EffApplyFlags
EffApplyFlags
{ effToUse :: EffToUse
effToUse = EffToUse
EffBare
, effVoluntary :: Bool
effVoluntary = Bool
True
, effUseAllCopies :: Bool
effUseAllCopies = Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
, effKineticPerformed :: Bool
effKineticPerformed = Bool
False
, effActivation :: ActivationFlag
effActivation = ActivationFlag
Ability.ActivationPeriodic
, effMayDestroy :: Bool
effMayDestroy = Bool
True
}
m UseResult -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m UseResult -> m ()) -> m UseResult -> m ()
forall a b. (a -> b) -> a -> b
$ EffApplyFlags
-> ActorId
-> ActorId
-> ActorId
-> ItemId
-> Container
-> ItemFull
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
EffApplyFlags
-> ActorId
-> ActorId
-> ActorId
-> ItemId
-> Container
-> ItemFull
-> m UseResult
effectAndDestroyAndAddKill
EffApplyFlags
effApplyFlags
ActorId
aid ActorId
aid ActorId
aid ItemId
iid (ActorId -> CStore -> Container
CActor ActorId
aid CStore
cstore) ItemFull
itemFull
applyPeriodicActor :: (ActorId, Actor) -> m ()
applyPeriodicActor (ActorId
aid, 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
> Int64
0 Bool -> Bool -> Bool
&& Actor -> LevelId
blid Actor
b LevelId -> EnumSet LevelId -> Bool
forall k. Enum k => k -> EnumSet k -> Bool
`ES.member` EnumSet LevelId
arenas) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
((ItemId, ItemQuant) -> m ()) -> [(ItemId, ItemQuant)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (ActorId -> CStore -> (ItemId, ItemQuant) -> m ()
forall (m :: * -> *) a a.
MonadServerAtomic m =>
ActorId -> CStore -> (ItemId, (a, [a])) -> m ()
applyPeriodicItem ActorId
aid CStore
CEqp) ([(ItemId, ItemQuant)] -> m ()) -> [(ItemId, ItemQuant)] -> m ()
forall a b. (a -> b) -> a -> b
$ ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (ItemBag -> [(ItemId, ItemQuant)])
-> ItemBag -> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> a -> b
$ Actor -> ItemBag
beqp Actor
b
((ItemId, ItemQuant) -> m ()) -> [(ItemId, ItemQuant)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (ActorId -> CStore -> (ItemId, ItemQuant) -> m ()
forall (m :: * -> *) a a.
MonadServerAtomic m =>
ActorId -> CStore -> (ItemId, (a, [a])) -> m ()
applyPeriodicItem ActorId
aid CStore
COrgan) ([(ItemId, ItemQuant)] -> m ()) -> [(ItemId, ItemQuant)] -> m ()
forall a b. (a -> b) -> a -> b
$ ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs (ItemBag -> [(ItemId, ItemQuant)])
-> ItemBag -> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> a -> b
$ Actor -> ItemBag
borgan Actor
b
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.
(Foldable t, Monad m) =>
(a -> m ()) -> 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 LevelId
lid 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 (\(ActorId
_, Time
atime) -> Time
atime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= Time
localTime) ([(ActorId, Time)] -> [(ActorId, Time)])
-> [(ActorId, Time)] -> [(ActorId, Time)]
forall a b. (a -> b) -> a -> b
$ EnumMap ActorId Time -> [(ActorId, Time)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap ActorId Time
levelTime
(ActorId -> m ()) -> [ActorId] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> 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 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 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
$ \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 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
Maybe ([Vector], Speed)
Nothing -> Actor -> m ()
removePushed Actor
b1
Just ([], Speed
_) -> 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
Maybe ([Vector], Speed)
Nothing -> Actor -> m ()
removePushed Actor
b2
Just ([], Speed
_) -> 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 ()
advanceTrajectory :: ActorId -> Actor -> m ()
advanceTrajectory ActorId
aid Actor
b1 = 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
b1
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
b1) (EnumMap ItemId AspectRecord -> AspectRecord)
-> (State -> EnumMap ItemId AspectRecord) -> State -> AspectRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap ItemId AspectRecord
sdiscoAspect
let registerKill :: KillHow -> m ()
registerKill KillHow
killHow =
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> Bool
bproj Actor
b1
Bool -> Bool -> Bool
&& Bool -> Bool
not (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arTrunk)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
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
killHow (Actor -> FactionId
bfid Actor
b1) (Actor -> ItemId
btrunk Actor
b1)
case Actor -> Maybe ([Vector], Speed)
btrajectory Actor
b1 of
Just (Vector
d : [Vector]
lv, Speed
speed) -> do
let tpos :: Point
tpos = Actor -> Point
bpos Actor
b1 Point -> Vector -> Point
`shift` Vector
d
if TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup (ContentId TileKind -> Bool) -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ Level
lvl Level -> Point -> ContentId TileKind
`at` Point
tpos then do
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId
-> Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> UpdAtomic
UpdTrajectory ActorId
aid (Actor -> Maybe ([Vector], Speed)
btrajectory Actor
b1) (([Vector], Speed) -> Maybe ([Vector], Speed)
forall a. a -> Maybe a
Just ([Vector]
lv, Speed
speed))
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Vector] -> Bool
forall a. [a] -> Bool
null [Vector]
lv) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ KillHow -> m ()
registerKill KillHow
KillDropLaunch
let occupied :: Bool
occupied = Point -> Level -> Bool
occupiedBigLvl Point
tpos Level
lvl Bool -> Bool -> Bool
|| Point -> Level -> Bool
occupiedProjLvl Point
tpos Level
lvl
reqMoveHit :: m ()
reqMoveHit = Bool -> Bool -> ActorId -> Vector -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> Bool -> ActorId -> Vector -> m ()
reqMoveGeneric Bool
False Bool
True ActorId
aid Vector
d
reqDisp :: ActorId -> m ()
reqDisp = Bool -> ActorId -> ActorId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
Bool -> ActorId -> ActorId -> m ()
reqDisplaceGeneric Bool
False ActorId
aid
if | Actor -> Bool
bproj Actor
b1 -> m ()
reqMoveHit
| Bool
occupied ->
case (Point -> Level -> Maybe ActorId
posToBigLvl Point
tpos Level
lvl, Point -> Level -> [ActorId]
posToProjsLvl Point
tpos Level
lvl) of
(Maybe ActorId
Nothing, []) -> String -> m ()
forall a. (?callStack::CallStack) => String -> a
error String
"advanceTrajectory: not occupied"
(Maybe ActorId
Nothing, [ActorId
target]) -> ActorId -> m ()
reqDisp ActorId
target
(Maybe ActorId
Nothing, [ActorId]
_) -> m ()
reqMoveHit
(Just ActorId
target, []) ->
if [Vector] -> Bool
forall a. [a] -> Bool
null [Vector]
lv then ActorId -> m ()
reqDisp ActorId
target else m ()
reqMoveHit
(Just ActorId
_, [ActorId]
_) -> m ()
reqMoveHit
| Bool
otherwise -> m ()
reqMoveHit
else do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Actor -> Bool
bproj Actor
b1) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Point -> SfxAtomic
SfxCollideTile ActorId
aid Point
tpos
ItemBag
embedsPre <- (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
$ LevelId -> Point -> State -> ItemBag
getEmbedBag (Actor -> LevelId
blid Actor
b1) Point
tpos
Maybe ReqFailure
mfail <- Bool
-> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
reqAlterFail (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Bool
bproj Actor
b1) EffToUse
EffBare Bool
False ActorId
aid Point
tpos
ItemBag
embedsPost <- (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
$ LevelId -> Point -> State -> ItemBag
getEmbedBag (Actor -> LevelId
blid Actor
b1) Point
tpos
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
let tpos2 :: Point
tpos2 = Actor -> Point
bpos Actor
b2 Point -> Vector -> Point
`shift` Vector
d
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
b2
case Maybe ReqFailure
mfail of
Maybe ReqFailure
Nothing | TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup (ContentId TileKind -> Bool) -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ Level
lvl2 Level -> Point -> ContentId TileKind
`at` Point
tpos2 ->
if ItemBag
embedsPre ItemBag -> ItemBag -> Bool
forall a. Eq a => a -> a -> Bool
/= ItemBag
embedsPost Bool -> Bool -> Bool
&& Bool -> Bool
not (ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null ItemBag
embedsPre) then
if Actor -> Int64
bhp Actor
b2 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
oneM then do
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Int64 -> UpdAtomic
UpdRefillHP ActorId
aid Int64
minusM
Actor
b3 <- (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
ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Actor -> m ()
advanceTrajectory ActorId
aid Actor
b3
else 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
b2)
(Maybe ([Vector], Speed) -> UpdAtomic)
-> Maybe ([Vector], Speed) -> UpdAtomic
forall a b. (a -> b) -> a -> b
$ ([Vector], Speed) -> Maybe ([Vector], Speed)
forall a. a -> Maybe a
Just ([], Speed
speed)
KillHow -> m ()
registerKill KillHow
KillTileLaunch
else
ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Actor -> m ()
advanceTrajectory ActorId
aid Actor
b2
Maybe ReqFailure
_ -> 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
b2) Maybe ([Vector], Speed)
forall a. Maybe a
Nothing
if Actor -> Bool
bproj Actor
b2
then KillHow -> m ()
registerKill KillHow
KillTileLaunch
else Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Actor -> Int64
bhp Actor
b2 Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
oneM) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Int64 -> UpdAtomic
UpdRefillHP ActorId
aid Int64
minusM
let effect :: Effect
effect = Int -> Effect
IK.RefillHP (-Int
2)
SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic (SfxAtomic -> m ()) -> SfxAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> ActorId -> ItemId -> Effect -> Int64 -> SfxAtomic
SfxEffect (Actor -> FactionId
bfid Actor
b2) ActorId
aid (Actor -> ItemId
btrunk Actor
b2) Effect
effect (-Int64
1)
Maybe ([Vector], Speed)
_ -> String -> m ()
forall a. (?callStack::CallStack) => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Nothing or empty trajectory" String -> (ActorId, Actor) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
aid, Actor
b1)
handleActors :: (MonadServerAtomic m, MonadServerComm m)
=> LevelId -> FactionId -> m Bool
handleActors :: LevelId -> FactionId -> m Bool
handleActors LevelId
lid 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 (\(ActorId
_, Time
atime) -> Time
atime Time -> Time -> Bool
forall a. Ord a => a -> a -> Bool
<= Time
localTime) ([(ActorId, Time)] -> [(ActorId, Time)])
-> [(ActorId, Time)] -> [(ActorId, Time)]
forall a b. (a -> b) -> a -> b
$ EnumMap ActorId Time -> [(ActorId, Time)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs EnumMap ActorId Time
levelTime
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 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
Maybe ActorId
_ -> [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@(ActorId
aid : [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
<= Int64
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 = FactionKind -> Bool
fhasUI (Faction -> FactionKind
gkind Faction
fact)
Bool -> Bool -> Bool
&& (Bool
aidIsLeader Bool -> Bool -> Bool
|| Bool -> Bool
not (FactionKind -> Bool
fhasPointman (Faction -> FactionKind
gkind Faction
fact)))
mainUIunderAI :: Bool
mainUIunderAI = Bool
mainUIactor Bool -> Bool -> Bool
&& Faction -> Bool
gunderAI 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
$
FactionId -> ActorId -> m ()
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
FactionId -> ActorId -> m ()
handleUIunderAI FactionId
side ActorId
aid
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
gunderAI 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 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 Maybe ActorId
Nothing = ActorId -> m ActorId
forall (m :: * -> *) a. Monad m => a -> m a
return ActorId
aid
(ActorId
aidNew, Maybe RequestTimed
mtimed) <-
if Bool
doQueryAI then do
(ReqAI
cmd, 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
(ReqUI
cmd, Maybe ActorId
maid) <- Response -> FactionId -> ActorId -> m (ReqUI, Maybe ActorId)
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
Response -> FactionId -> ActorId -> m (ReqUI, Maybe ActorId)
sendQueryUI Response
RespQueryUI 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 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
Maybe RequestTimed
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
handleUIunderAI :: (MonadServerAtomic m, MonadServerComm m)
=> FactionId -> ActorId -> m ()
handleUIunderAI :: FactionId -> ActorId -> m ()
handleUIunderAI FactionId
side ActorId
aid = do
(ReqUI, Maybe ActorId)
cmdS <- Response -> FactionId -> ActorId -> m (ReqUI, Maybe ActorId)
forall (m :: * -> *).
(MonadServerAtomic m, MonadServerComm m) =>
Response -> FactionId -> ActorId -> m (ReqUI, Maybe ActorId)
sendQueryUI Response
RespQueryUIunderAI FactionId
side ActorId
aid
case (ReqUI, Maybe ActorId) -> ReqUI
forall a b. (a, b) -> a
fst (ReqUI, Maybe ActorId)
cmdS of
ReqUI
ReqUINop -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
ReqUI
ReqUIAutomate -> UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ FactionId -> Bool -> UpdAtomic
UpdAutoFaction FactionId
side Bool
False
ReqUI
ReqUIGameDropAndExit -> ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
reqGameDropAndExit ActorId
aid
ReqUI
ReqUIGameSaveAndExit -> ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
reqGameSaveAndExit ActorId
aid
ReqUI
_ -> String -> m ()
forall a. (?callStack::CallStack) => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"" String -> (ReqUI, Maybe ActorId) -> String
forall v. Show v => String -> v -> String
`showFailure` (ReqUI, Maybe ActorId)
cmdS
dieSer :: MonadServerAtomic m => ActorId -> Actor -> m ()
dieSer :: ActorId -> Actor -> m ()
dieSer ActorId
aid Actor
b2 = do
if Actor -> Bool
bproj Actor
b2 then
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe ([Vector], Speed) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe ([Vector], Speed) -> Bool)
-> Maybe ([Vector], Speed) -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Maybe ([Vector], Speed)
btrajectory Actor
b2) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId
-> Maybe ([Vector], Speed) -> Maybe ([Vector], Speed) -> UpdAtomic
UpdTrajectory ActorId
aid (Actor -> Maybe ([Vector], Speed)
btrajectory Actor
b2) Maybe ([Vector], Speed)
forall a. Maybe a
Nothing
else do
ContentId ItemKind
kindId <- (State -> ContentId ItemKind) -> m (ContentId ItemKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ContentId ItemKind) -> m (ContentId ItemKind))
-> (State -> ContentId ItemKind) -> m (ContentId ItemKind)
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ContentId ItemKind
getIidKindIdServer (ItemId -> State -> ContentId ItemKind)
-> ItemId -> State -> ContentId ItemKind
forall a b. (a -> b) -> a -> b
$ Actor -> ItemId
btrunk Actor
b2
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> ContentId ItemKind -> Int -> UpdAtomic
UpdRecordKill ActorId
aid ContentId ItemKind
kindId Int
1
ActorId -> m ()
forall (m :: * -> *). MonadServerAtomic m => ActorId -> m ()
deduceKilled ActorId
aid
FactionId -> LevelId -> ActorId -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
FactionId -> LevelId -> ActorId -> m ()
electLeader (Actor -> FactionId
bfid Actor
b2) (Actor -> LevelId
blid Actor
b2) ActorId
aid
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
b2) (EnumMap ItemId AspectRecord -> AspectRecord)
-> (State -> EnumMap ItemId AspectRecord) -> State -> AspectRecord
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap ItemId AspectRecord
sdiscoAspect
let spentProj :: Bool
spentProj = Actor -> Bool
bproj Actor
b2 Bool -> Bool -> Bool
&& ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null (Actor -> ItemBag
beqp Actor
b2)
isBlast :: Bool
isBlast = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arTrunk
(EffToUse
effScope, Bool
bumping) = if Actor -> Bool
bproj Actor
b2
then (EffToUse
EffBareAndOnCombine, Bool
False)
else (EffToUse
EffBare, Bool
True)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
spentProj Bool -> Bool -> Bool
&& Bool
isBlast) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
m (Maybe ReqFailure) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Maybe ReqFailure) -> m ()) -> m (Maybe ReqFailure) -> m ()
forall a b. (a -> b) -> a -> b
$ Bool
-> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
reqAlterFail Bool
bumping EffToUse
effScope Bool
False ActorId
aid (Actor -> Point
bpos Actor
b2)
Actor
b3 <- (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
ActorId -> Actor -> m ()
forall (m :: * -> *).
MonadServerAtomic m =>
ActorId -> Actor -> m ()
dropAllEquippedItems ActorId
aid Actor
b3
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
b3 CStore
COrgan
EnumMap ItemId AspectRecord
discoAspect <- (State -> EnumMap ItemId AspectRecord)
-> m (EnumMap ItemId AspectRecord)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap ItemId AspectRecord
sdiscoAspect
let f :: ItemId -> ItemQuant -> m ()
f = m UseResult -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m UseResult -> m ())
-> (ItemId -> ItemQuant -> m UseResult)
-> ItemId
-> ItemQuant
-> m ()
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<$$> Bool
-> Bool
-> CStore
-> ActorId
-> Actor
-> Int
-> ItemId
-> ItemQuant
-> m UseResult
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> Bool
-> CStore
-> ActorId
-> Actor
-> Int
-> ItemId
-> ItemQuant
-> m UseResult
dropCStoreItem Bool
False Bool
True CStore
COrgan ActorId
aid Actor
b3 Int
forall a. Bounded a => a
maxBound
isCondition :: ItemId -> Bool
isCondition = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition (AspectRecord -> Bool)
-> (ItemId -> AspectRecord) -> ItemId -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap ItemId AspectRecord
discoAspect EnumMap ItemId AspectRecord -> ItemId -> AspectRecord
forall k a. Enum k => EnumMap k a -> k -> a
EM.!)
((ItemId, ItemQuant) -> m ()) -> [(ItemId, ItemQuant)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ ((ItemId -> ItemQuant -> m ()) -> (ItemId, ItemQuant) -> m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ItemId -> ItemQuant -> m ()
f) ([(ItemId, ItemQuant)] -> m ()) -> [(ItemId, ItemQuant)] -> m ()
forall a b. (a -> b) -> a -> b
$ ((ItemId, ItemQuant) -> Bool)
-> [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((ItemId, ItemQuant) -> Bool) -> (ItemId, ItemQuant) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemId -> Bool
isCondition (ItemId -> Bool)
-> ((ItemId, ItemQuant) -> ItemId) -> (ItemId, ItemQuant) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ItemId, ItemQuant) -> ItemId
forall a b. (a, b) -> a
fst) ([(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)])
-> [(ItemId, ItemQuant)] -> [(ItemId, ItemQuant)]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
bag
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
spentProj Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isBlast) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
m (Maybe ReqFailure) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Maybe ReqFailure) -> m ()) -> m (Maybe ReqFailure) -> m ()
forall a b. (a -> b) -> a -> b
$ Bool
-> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
forall (m :: * -> *).
MonadServerAtomic m =>
Bool
-> EffToUse -> Bool -> ActorId -> Point -> m (Maybe ReqFailure)
reqAlterFail Bool
bumping EffToUse
effScope Bool
False ActorId
aid (Actor -> Point
bpos Actor
b2)
Actor
b4 <- (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
UpdAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => UpdAtomic -> m ()
execUpdAtomic (UpdAtomic -> m ()) -> UpdAtomic -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> Actor -> [(ItemId, Item)] -> UpdAtomic
UpdDestroyActor ActorId
aid Actor
b4 []
restartGame :: MonadServerAtomic m
=> m () -> m () -> Maybe (GroupName ModeKind) -> m ()
restartGame :: m () -> m () -> Maybe (GroupName ModeKind) -> m ()
restartGame m ()
updConn m ()
loop Maybe (GroupName ModeKind)
mgameMode = do
SfxAtomic -> m ()
forall (m :: * -> *). MonadServerAtomic m => SfxAtomic -> m ()
execSfxAtomic SfxAtomic
SfxRestart
ServerOptions
soptionsNxt <- (StateServer -> ServerOptions) -> m ServerOptions
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> ServerOptions
soptionsNxt
SMGen
srandom <- (StateServer -> SMGen) -> m SMGen
forall (m :: * -> *) a. MonadServer m => (StateServer -> a) -> m a
getsServer StateServer -> SMGen
srandom
FactionDict
factionDold <- (State -> FactionDict) -> m FactionDict
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> FactionDict
sfactionD
State
s <- ServerOptions
-> Maybe (GroupName ModeKind) -> Maybe SMGen -> m State
forall (m :: * -> *).
MonadServer m =>
ServerOptions
-> Maybe (GroupName ModeKind) -> Maybe SMGen -> m State
gameReset ServerOptions
soptionsNxt Maybe (GroupName ModeKind)
mgameMode (SMGen -> Maybe SMGen
forall a. a -> Maybe a
Just SMGen
srandom)
let optionsBarRngs :: ServerOptions
optionsBarRngs = ServerOptions
soptionsNxt { sdungeonRng :: Maybe SMGen
sdungeonRng = Maybe SMGen
forall a. Maybe a
Nothing
, smainRng :: Maybe SMGen
smainRng = Maybe SMGen
forall a. Maybe a
Nothing
, sassertExplored :: Maybe Int
sassertExplored = Maybe Int
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
$ \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
FactionDict -> m ()
forall (m :: * -> *). MonadServerAtomic m => FactionDict -> m ()
reinitGame FactionDict
factionDold
Bool -> Bool -> m ()
forall (m :: * -> *). MonadServerAtomic m => Bool -> Bool -> m ()
writeSaveAll Bool
False Bool
True
m ()
loop