158 rnc <- gets roomsClients |
158 rnc <- gets roomsClients |
159 io $ removeClient rnc ci |
159 io $ removeClient rnc ci |
160 |
160 |
161 s <- get |
161 s <- get |
162 put $! s{removedClients = ci `Set.delete` removedClients s} |
162 put $! s{removedClients = ci `Set.delete` removedClients s} |
163 |
163 |
164 sp <- gets (shutdownPending . serverInfo) |
164 sp <- gets (shutdownPending . serverInfo) |
165 cls <- allClientsS |
165 cls <- allClientsS |
166 io $ when (sp && null cls) $ throwIO ShutdownException |
166 io $ when (sp && null cls) $ throwIO ShutdownException |
167 |
167 |
168 processAction (ModifyClient f) = do |
168 processAction (ModifyClient f) = do |
249 proto <- client's clientProto |
249 proto <- client's clientProto |
250 newRoom <- io $ room'sM rnc id ri |
250 newRoom <- io $ room'sM rnc id ri |
251 chans <- liftM (map sendChan) $! sameProtoClientsS proto |
251 chans <- liftM (map sendChan) $! sameProtoClientsS proto |
252 processAction $ AnswerClients chans ("ROOM" : "UPD" : oldRoomName : roomInfo (nick newMaster) newRoom) |
252 processAction $ AnswerClients chans ("ROOM" : "UPD" : oldRoomName : roomInfo (nick newMaster) newRoom) |
253 |
253 |
254 |
254 |
255 processAction (AddRoom roomName roomPassword) = do |
255 processAction (AddRoom roomName roomPassword) = do |
256 Just clId <- gets clientIndex |
256 Just clId <- gets clientIndex |
257 rnc <- gets roomsClients |
257 rnc <- gets roomsClients |
258 proto <- client's clientProto |
258 proto <- client's clientProto |
259 n <- client's nick |
259 n <- client's nick |
304 io $ mapM_ (modifyClient rnc (\cl -> cl{isReady = False})) roomClIDs |
304 io $ mapM_ (modifyClient rnc (\cl -> cl{isReady = False})) roomClIDs |
305 processAction $ ModifyRoom (\r -> r{readyPlayers = 0}) |
305 processAction $ ModifyRoom (\r -> r{readyPlayers = 0}) |
306 where |
306 where |
307 notReadyMessage p nicks = if p < 38 then "NOT_READY" : nicks else "CLIENT_FLAGS" : "-r" : nicks |
307 notReadyMessage p nicks = if p < 38 then "NOT_READY" : nicks else "CLIENT_FLAGS" : "-r" : nicks |
308 |
308 |
309 |
309 |
310 processAction FinishGame = do |
310 processAction FinishGame = do |
311 rnc <- gets roomsClients |
311 rnc <- gets roomsClients |
312 ri <- clientRoomA |
312 ri <- clientRoomA |
313 thisRoomChans <- liftM (map sendChan) $ roomClientsS ri |
313 thisRoomChans <- liftM (map sendChan) $ roomClientsS ri |
314 clNick <- client's nick |
314 clNick <- client's nick |
315 answerRemovedTeams <- io $ |
315 answerRemovedTeams <- io $ |
316 room'sM rnc (map (\t -> AnswerClients thisRoomChans ["REMOVE_TEAM", t]) . leftTeams . fromJust . gameInfo) ri |
316 room'sM rnc (map (\t -> AnswerClients thisRoomChans ["REMOVE_TEAM", t]) . leftTeams . fromJust . gameInfo) ri |
317 |
317 |
318 mapM_ processAction $ |
318 mapM_ processAction $ |
319 SaveReplay |
319 SaveReplay |
320 : ModifyRoom |
320 : ModifyRoom |
321 (\r -> r{ |
321 (\r -> r{ |
322 gameInfo = Nothing, |
322 gameInfo = Nothing, |
323 readyPlayers = 0 |
323 readyPlayers = 0 |
324 } |
324 } |
325 ) |
325 ) |
326 : UnreadyRoomClients |
326 : UnreadyRoomClients |
327 : answerRemovedTeams |
327 : answerRemovedTeams |
328 |
328 |
329 |
329 |
330 processAction (SendTeamRemovalMessage teamName) = do |
330 processAction (SendTeamRemovalMessage teamName) = do |
331 chans <- othersChans |
331 chans <- othersChans |
332 mapM_ processAction [ |
332 mapM_ processAction [ |
333 AnswerClients chans ["EM", rmTeamMsg], |
333 AnswerClients chans ["EM", rmTeamMsg], |
334 ModifyRoom (\r -> r{ |
334 ModifyRoom (\r -> r{ |
336 teamsInGameNumber = teamsInGameNumber g - 1 |
336 teamsInGameNumber = teamsInGameNumber g - 1 |
337 , roundMsgs = roundMsgs g Seq.|> rmTeamMsg |
337 , roundMsgs = roundMsgs g Seq.|> rmTeamMsg |
338 }) $ gameInfo r |
338 }) $ gameInfo r |
339 }) |
339 }) |
340 ] |
340 ] |
341 |
341 |
342 rnc <- gets roomsClients |
342 rnc <- gets roomsClients |
343 ri <- clientRoomA |
343 ri <- clientRoomA |
344 gi <- io $ room'sM rnc gameInfo ri |
344 gi <- io $ room'sM rnc gameInfo ri |
345 when (isJust gi && 0 == teamsInGameNumber (fromJust gi)) $ |
345 when (isJust gi && 0 == teamsInGameNumber (fromJust gi)) $ |
346 processAction FinishGame |
346 processAction FinishGame |
347 where |
347 where |
348 rmTeamMsg = toEngineMsg $ 'F' `B.cons` teamName |
348 rmTeamMsg = toEngineMsg $ 'F' `B.cons` teamName |
349 |
349 |
350 |
350 |
351 processAction (RemoveTeam teamName) = do |
351 processAction (RemoveTeam teamName) = do |
352 rnc <- gets roomsClients |
352 rnc <- gets roomsClients |
353 ri <- clientRoomA |
353 ri <- clientRoomA |
354 inGame <- io $ room'sM rnc (isJust . gameInfo) ri |
354 inGame <- io $ room'sM rnc (isJust . gameInfo) ri |
355 chans <- othersChans |
355 chans <- othersChans |
356 mapM_ processAction $ |
356 mapM_ processAction $ |
357 ModifyRoom (\r -> r{ |
357 ModifyRoom (\r -> r{ |
358 teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r |
358 teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r |
359 , gameInfo = liftM (\g -> g{leftTeams = teamName : leftTeams g}) $ gameInfo r |
359 , gameInfo = liftM (\g -> g{leftTeams = teamName : leftTeams g}) $ gameInfo r |
360 }) |
360 }) |
361 : AnswerClients chans ["REMOVE_TEAM", teamName] |
361 : AnswerClients chans ["REMOVE_TEAM", teamName] |
454 processAction BanList = do |
454 processAction BanList = do |
455 ch <- client's sendChan |
455 ch <- client's sendChan |
456 bans <- gets (bans . serverInfo) |
456 bans <- gets (bans . serverInfo) |
457 processAction $ |
457 processAction $ |
458 AnswerClients [ch] ["BANLIST", B.pack $ show bans] |
458 AnswerClients [ch] ["BANLIST", B.pack $ show bans] |
459 |
459 |
460 |
460 |
461 |
461 |
462 processAction (KickRoomClient kickId) = do |
462 processAction (KickRoomClient kickId) = do |
463 modify (\s -> s{clientIndex = Just kickId}) |
463 modify (\s -> s{clientIndex = Just kickId}) |
464 ch <- client's sendChan |
464 ch <- client's sendChan |
534 (roomsNum, clientsNum) <- io $ withRoomsAndClients rnc st |
534 (roomsNum, clientsNum) <- io $ withRoomsAndClients rnc st |
535 io $ writeChan (dbQueries si) $ SendStats clientsNum (roomsNum - 1) |
535 io $ writeChan (dbQueries si) $ SendStats clientsNum (roomsNum - 1) |
536 where |
536 where |
537 st irnc = (length $ allRooms irnc, length $ allClients irnc) |
537 st irnc = (length $ allRooms irnc, length $ allClients irnc) |
538 |
538 |
539 processAction RestartServer = do |
539 processAction RestartServer = do |
540 sp <- gets (shutdownPending . serverInfo) |
540 sp <- gets (shutdownPending . serverInfo) |
541 when (not sp) $ do |
541 when (not sp) $ do |
542 sock <- gets (fromJust . serverSocket . serverInfo) |
542 sock <- gets (fromJust . serverSocket . serverInfo) |
543 args <- gets (runArgs . serverInfo) |
543 args <- gets (runArgs . serverInfo) |
544 io $ do |
544 io $ do |