module Game.LambdaHack.Server.EndM
( endOrLoop, dieSer, writeSaveAll
#ifdef EXPOSE_INTERNAL
, gameExit, dropAllItems
#endif
) where
import Prelude ()
import Game.LambdaHack.Common.Prelude
import qualified Data.EnumMap.Strict as EM
import Game.LambdaHack.Atomic
import Game.LambdaHack.Client
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.MonadStateRead
import Game.LambdaHack.Common.State
import Game.LambdaHack.Content.ModeKind
import Game.LambdaHack.Server.CommonM
import Game.LambdaHack.Server.Fov
import Game.LambdaHack.Server.HandleEffectM
import Game.LambdaHack.Server.ItemM
import Game.LambdaHack.Server.MonadServer
import Game.LambdaHack.Server.ProtocolM
import Game.LambdaHack.Server.ServerOptions
import Game.LambdaHack.Server.State
endOrLoop :: (MonadServerAtomic m, MonadServerReadRequest m)
=> m () -> (Maybe (GroupName ModeKind) -> m ())
-> m ()
endOrLoop loop restart = do
factionD <- getsState sfactionD
let inGame fact = case gquit fact of
Nothing -> True
Just Status{stOutcome=Camping} -> True
_ -> False
gameOver = not $ any inGame $ EM.elems factionD
let getQuitter fact = case gquit fact of
Just Status{stOutcome=Restart, stNewGame} -> stNewGame
_ -> Nothing
quitters = mapMaybe getQuitter $ EM.elems factionD
restartNeeded = gameOver || not (null quitters)
let isCamper fact = case gquit fact of
Just Status{stOutcome=Camping} -> True
_ -> False
campers = filter (isCamper . snd) $ EM.assocs factionD
mapM_ (\(fid, fact) ->
execUpdAtomic $ UpdQuitFaction fid (gquit fact) Nothing) campers
swriteSave <- getsServer swriteSave
when swriteSave $ do
modifyServer $ \ser -> ser {swriteSave = False}
writeSaveAll True
if | restartNeeded -> restart (listToMaybe quitters)
| not $ null campers -> gameExit
| otherwise -> loop
gameExit :: (MonadServerAtomic m, MonadServerReadRequest m) => m ()
gameExit = do
verifyCaches
killAllClients
return ()
verifyCaches :: MonadServer m => m ()
verifyCaches = do
sperCacheFid <- getsServer sperCacheFid
sperValidFid <- getsServer sperValidFid
sactorAspect2 <- getsState sactorAspect
sfovLucidLid <- getsServer sfovLucidLid
sfovClearLid <- getsServer sfovClearLid
sfovLitLid <- getsServer sfovLitLid
sperFid <- getsServer sperFid
actorAspect <- getsState actorAspectInDungeon
( fovLitLid, fovClearLid, fovLucidLid
,perValidFid, perCacheFid, perFid ) <- getsState perFidInDungeon
let !_A7 = assert (sfovLitLid == fovLitLid
`blame` "wrong accumulated sfovLitLid"
`swith` (sfovLitLid, fovLitLid)) ()
!_A6 = assert (sfovClearLid == fovClearLid
`blame` "wrong accumulated sfovClearLid"
`swith` (sfovClearLid, fovClearLid)) ()
!_A5 = assert (sactorAspect2 == actorAspect
`blame` "wrong accumulated sactorAspect"
`swith` (sactorAspect2, actorAspect)) ()
!_A4 = assert (sfovLucidLid == fovLucidLid
`blame` "wrong accumulated sfovLucidLid"
`swith` (sfovLucidLid, fovLucidLid)) ()
!_A3 = assert (sperValidFid == perValidFid
`blame` "wrong accumulated sperValidFid"
`swith` (sperValidFid, perValidFid)) ()
!_A2 = assert (sperCacheFid == perCacheFid
`blame` "wrong accumulated sperCacheFid"
`swith` (sperCacheFid, perCacheFid)) ()
!_A1 = assert (sperFid == perFid
`blame` "wrong accumulated perception"
`swith` (sperFid, perFid)) ()
return ()
dieSer :: MonadServerAtomic m => ActorId -> Actor -> m ()
dieSer aid b = do
b2 <- if bproj b then return b else do
kindId <- getsState $ getIidKindIdServer $ btrunk b
execUpdAtomic $ UpdRecordKill aid kindId 1
deduceKilled aid
electLeader (bfid b) (blid b) aid
fact <- getsState $ (EM.! bfid b) . sfactionD
when (isNothing $ gleader fact) $ moveStores False aid CSha CInv
getsState $ getActorBody aid
dropAllItems aid b2
b3 <- getsState $ getActorBody aid
execUpdAtomic $ UpdDestroyActor aid b3 []
dropAllItems :: MonadServerAtomic m => ActorId -> Actor -> m ()
dropAllItems aid b = do
mapActorCStore_ CInv (dropCStoreItem False CInv aid b maxBound) b
mapActorCStore_ CEqp (dropCStoreItem False CEqp aid b maxBound) b
writeSaveAll :: MonadServerAtomic m => Bool -> m ()
writeSaveAll uiRequested = do
bench <- getsServer $ sbenchmark . sclientOptions . soptions
noConfirmsGame <- isNoConfirmsGame
when (uiRequested || not bench && not noConfirmsGame) $ do
execUpdAtomic UpdWriteSave
saveServer
#ifdef WITH_EXPENSIVE_ASSERTIONS
verifyCaches
#endif