module Game.LambdaHack.Server.EndServer
( endOrLoop, dieSer, dropEqpItems
) where
import Control.Monad
import qualified Data.EnumMap.Strict as EM
import Data.Maybe
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.Server.CommonServer
import Game.LambdaHack.Server.HandleEffectServer
import Game.LambdaHack.Server.ItemServer
import Game.LambdaHack.Server.MonadServer
import Game.LambdaHack.Server.State
endOrLoop :: (MonadAtomic m, MonadServer m)
=> m () -> 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
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 Nothing (gquit fact) Nothing) campers
bkpSave <- getsServer swriteSave
when bkpSave $ do
modifyServer $ \ser -> ser {swriteSave = False}
gameSave
case (quitters, campers) of
(sgameMode : _, _) -> do
modifyServer $ \ser -> ser {sdebugNxt = (sdebugNxt ser) {sgameMode}}
restart
_ | gameOver -> restart
([], []) -> loop
([], _ : _) -> gameExit
dieSer :: (MonadAtomic m, MonadServer m) => ActorId -> Actor -> Bool -> m ()
dieSer aid b hit = do
if bproj b then do
dropEqpItems aid b hit
b2 <- getsState $ getActorBody aid
execUpdAtomic $ UpdDestroyActor aid b2 []
else do
discoKind <- getsServer sdiscoKind
trunk <- getsState $ getItemBody $ btrunk b
let ikind = discoKind EM.! jkindIx trunk
execUpdAtomic $ UpdRecordKill aid ikind 1
electLeader (bfid b) (blid b) aid
equipAllItems aid b
dropEqpItems aid b False
b2 <- getsState $ getActorBody aid
execUpdAtomic $ UpdDestroyActor aid b2 []
deduceKilled b
equipAllItems :: (MonadAtomic m, MonadServer m)
=> ActorId -> Actor -> m ()
equipAllItems aid b = do
fact <- getsState $ (EM.! bfid b) . sfactionD
when (isNothing $ gleader fact) $ moveStores aid CSha CEqp
moveStores aid CInv CEqp
dropEqpItems :: (MonadAtomic m, MonadServer m)
=> ActorId -> Actor -> Bool -> m ()
dropEqpItems aid b hit = mapActorCStore_ CEqp (dropEqpItem aid b hit) b