1 {-# LANGUAGE CPP, OverloadedStrings #-} |
1 {-# LANGUAGE CPP, OverloadedStrings #-} |
|
2 {-# OPTIONS_GHC -fno-warn-orphans #-} |
2 module Actions where |
3 module Actions where |
3 |
4 |
4 import Control.Concurrent |
5 import Control.Concurrent |
5 import qualified Data.Set as Set |
6 import qualified Data.Set as Set |
6 import qualified Data.Sequence as Seq |
7 import qualified Data.Sequence as Seq |
220 |
223 |
221 processAction (MoveToLobby msg) = do |
224 processAction (MoveToLobby msg) = do |
222 (Just ci) <- gets clientIndex |
225 (Just ci) <- gets clientIndex |
223 ri <- clientRoomA |
226 ri <- clientRoomA |
224 rnc <- gets roomsClients |
227 rnc <- gets roomsClients |
225 (gameProgress, playersNum) <- io $ room'sM rnc ((isJust . gameInfo) &&& playersIn) ri |
228 playersNum <- io $ room'sM rnc playersIn ri |
226 master <- client's isMaster |
229 master <- client's isMaster |
227 -- client <- client's id |
230 -- client <- client's id |
228 clNick <- client's nick |
231 clNick <- client's nick |
229 chans <- othersChans |
232 chans <- othersChans |
230 |
233 |
264 , AnswerClients thisRoomChans ["WARNING", "New room admin is " `B.append` nick newMaster] |
267 , AnswerClients thisRoomChans ["WARNING", "New room admin is " `B.append` nick newMaster] |
265 , AnswerClients thisRoomChans ["CLIENT_FLAGS", "-h", oldMaster] |
268 , AnswerClients thisRoomChans ["CLIENT_FLAGS", "-h", oldMaster] |
266 , AnswerClients thisRoomChans ["CLIENT_FLAGS", "+h", nick newMaster] |
269 , AnswerClients thisRoomChans ["CLIENT_FLAGS", "+h", nick newMaster] |
267 ] |
270 ] |
268 |
271 |
269 proto <- client's clientProto |
272 newRoom' <- io $ room'sM rnc id ri |
270 newRoom <- io $ room'sM rnc id ri |
|
271 chans <- liftM (map sendChan) $! sameProtoClientsS proto |
273 chans <- liftM (map sendChan) $! sameProtoClientsS proto |
272 processAction $ AnswerClients chans ("ROOM" : "UPD" : oldRoomName : roomInfo newRoomName newRoom) |
274 processAction $ AnswerClients chans ("ROOM" : "UPD" : oldRoomName : roomInfo newRoomName newRoom') |
273 |
275 |
274 |
276 |
275 processAction (AddRoom roomName roomPassword) = do |
277 processAction (AddRoom roomName roomPassword) = do |
276 Just clId <- gets clientIndex |
278 Just clId <- gets clientIndex |
277 rnc <- gets roomsClients |
279 rnc <- gets roomsClients |
315 |
317 |
316 io $ removeRoom rnc ri |
318 io $ removeRoom rnc ri |
317 |
319 |
318 |
320 |
319 processAction UnreadyRoomClients = do |
321 processAction UnreadyRoomClients = do |
320 rnc <- gets roomsClients |
|
321 ri <- clientRoomA |
322 ri <- clientRoomA |
322 roomPlayers <- roomClientsS ri |
323 roomPlayers <- roomClientsS ri |
323 roomClIDs <- io $ roomClientsIndicesM rnc ri |
|
324 pr <- client's clientProto |
324 pr <- client's clientProto |
325 mapM_ processAction [ |
325 mapM_ processAction [ |
326 AnswerClients (map sendChan roomPlayers) $ notReadyMessage pr (map nick roomPlayers) |
326 AnswerClients (map sendChan roomPlayers) $ notReadyMessage pr (map nick roomPlayers) |
327 , ModifyRoomClients (\cl -> cl{isReady = False}) |
327 , ModifyRoomClients (\cl -> cl{isReady = False}) |
328 , ModifyRoom (\r -> r{readyPlayers = 0}) |
328 , ModifyRoom (\r -> r{readyPlayers = 0}) |
333 |
333 |
334 processAction FinishGame = do |
334 processAction FinishGame = do |
335 rnc <- gets roomsClients |
335 rnc <- gets roomsClients |
336 ri <- clientRoomA |
336 ri <- clientRoomA |
337 thisRoomChans <- liftM (map sendChan) $ roomClientsS ri |
337 thisRoomChans <- liftM (map sendChan) $ roomClientsS ri |
338 clNick <- client's nick |
|
339 answerRemovedTeams <- io $ |
338 answerRemovedTeams <- io $ |
340 room'sM rnc (map (\t -> AnswerClients thisRoomChans ["REMOVE_TEAM", t]) . leftTeams . fromJust . gameInfo) ri |
339 room'sM rnc (map (\t -> AnswerClients thisRoomChans ["REMOVE_TEAM", t]) . leftTeams . fromJust . gameInfo) ri |
341 |
340 |
342 mapM_ processAction $ |
341 mapM_ processAction $ |
343 SaveReplay |
342 SaveReplay |
486 processAction $ |
485 processAction $ |
487 AddIP2Bans ip msg (addUTCTime seconds currentTime) |
486 AddIP2Bans ip msg (addUTCTime seconds currentTime) |
488 |
487 |
489 processAction BanList = do |
488 processAction BanList = do |
490 ch <- client's sendChan |
489 ch <- client's sendChan |
491 bans <- gets (B.pack . unlines . map show . bans . serverInfo) |
490 b <- gets (B.pack . unlines . map show . bans . serverInfo) |
492 processAction $ |
491 processAction $ |
493 AnswerClients [ch] ["BANLIST", bans] |
492 AnswerClients [ch] ["BANLIST", b] |
494 |
493 |
495 processAction (Unban entry) = do |
494 processAction (Unban entry) = do |
496 processAction $ ModifyServerInfo (\s -> s{bans = filter f $ bans s}) |
495 processAction $ ModifyServerInfo (\s -> s{bans = filter f $ bans s}) |
497 where |
496 where |
498 f (BanByIP bip _ _) = bip == entry |
497 f (BanByIP bip _ _) = bip == entry |