module Game.LambdaHack.Server.EndM
( endOrLoop, dieSer
) where
import Prelude ()
import Game.LambdaHack.Common.Prelude
import qualified Data.EnumMap.Strict as EM
import Game.LambdaHack.Atomic
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
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.HandleEffectM
import Game.LambdaHack.Server.ItemM
import Game.LambdaHack.Server.MonadServer
import Game.LambdaHack.Server.State
endOrLoop :: (MonadAtomic m, MonadServer m)
=> m () -> (Maybe (GroupName ModeKind) -> m ()) -> m () -> m ()
-> m ()
endOrLoop loop restart gameExit gameSave = 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 && not restartNeeded) $ do
modifyServer $ \ser -> ser {swriteSave = False}
gameSave
if | restartNeeded -> restart (listToMaybe quitters)
| not $ null campers -> gameExit
| otherwise -> loop
dieSer :: (MonadAtomic m, MonadServer m) => ActorId -> Actor -> m ()
dieSer aid b = do
unless (bproj b) $ do
discoKind <- getsServer sdiscoKind
trunk <- getsState $ getItemBody $ btrunk b
let KindMean{kmKind} = discoKind EM.! jkindIx trunk
execUpdAtomic $ UpdRecordKill aid kmKind 1
deduceKilled aid
electLeader (bfid b) (blid b) aid
fact <- getsState $ (EM.! bfid b) . sfactionD
when (isNothing $ _gleader fact) $ moveStores False aid CSha CInv
dropAllItems aid b
b2 <- getsState $ getActorBody aid
execUpdAtomic $ UpdDestroyActor aid b2 []
dropAllItems :: (MonadAtomic m, MonadServer 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