2 module Actions where |
2 module Actions where |
3 |
3 |
4 import Control.Concurrent |
4 import Control.Concurrent |
5 import Control.Concurrent.Chan |
5 import Control.Concurrent.Chan |
6 import qualified Data.IntSet as IntSet |
6 import qualified Data.IntSet as IntSet |
|
7 import qualified Data.Set as Set |
7 import qualified Data.Sequence as Seq |
8 import qualified Data.Sequence as Seq |
8 import System.Log.Logger |
9 import System.Log.Logger |
9 import Monad |
10 import Monad |
10 import Data.Time |
11 import Data.Time |
11 import Maybe |
12 import Maybe |
99 when (ri /= lobbyId) $ do |
101 when (ri /= lobbyId) $ do |
100 processAction $ MoveToLobby ("quit: " `B.append` msg) |
102 processAction $ MoveToLobby ("quit: " `B.append` msg) |
101 return () |
103 return () |
102 |
104 |
103 chan <- client's sendChan |
105 chan <- client's sendChan |
|
106 ready <- client's isReady |
104 |
107 |
105 liftIO $ do |
108 liftIO $ do |
106 infoM "Clients" (show ci ++ " quits: " ++ (B.unpack msg)) |
109 infoM "Clients" (show ci ++ " quits: " ++ (B.unpack msg)) |
107 |
110 |
108 |
|
109 --mapM_ (processAction (ci, serverInfo, rnc)) $ answerOthersQuit ++ answerInformRoom |
111 --mapM_ (processAction (ci, serverInfo, rnc)) $ answerOthersQuit ++ answerInformRoom |
110 writeChan chan ["BYE", msg] |
112 writeChan chan ["BYE", msg] |
111 modifyRoom rnc (\r -> r{ |
113 modifyRoom rnc (\r -> r{ |
112 --playersIDs = IntSet.delete ci (playersIDs r) |
114 --playersIDs = IntSet.delete ci (playersIDs r) |
113 playersIn = (playersIn r) - 1 |
115 playersIn = (playersIn r) - 1, |
114 --readyPlayers = if isReady client then readyPlayers r - 1 else readyPlayers r |
116 readyPlayers = if ready then readyPlayers r - 1 else readyPlayers r |
115 }) ri |
117 }) ri |
116 |
118 |
|
119 removeClient rnc ci |
|
120 |
|
121 modify (\s -> s{removedClients = ci `Set.insert` removedClients s}) |
|
122 |
|
123 processAction (DeleteClient ci) = do |
|
124 modify (\s -> s{removedClients = ci `Set.delete` removedClients s}) |
|
125 |
117 {- |
126 {- |
118 where |
127 where |
119 client = clients ! clID |
128 client = clients ! clID |
120 clientNick = nick client |
129 clientNick = nick client |
121 answerInformRoom = |
130 answerInformRoom = |
225 newMasterId = IntSet.findMin otherPlayersSet |
234 newMasterId = IntSet.findMin otherPlayersSet |
226 newMasterClient = clients ! newMasterId |
235 newMasterClient = clients ! newMasterId |
227 -} |
236 -} |
228 |
237 |
229 processAction (AddRoom roomName roomPassword) = do |
238 processAction (AddRoom roomName roomPassword) = do |
230 (ServerState (Just clId) _ rnc) <- get |
239 Just clId <- gets clientIndex |
|
240 rnc <- gets roomsClients |
231 proto <- liftIO $ client'sM rnc clientProto clId |
241 proto <- liftIO $ client'sM rnc clientProto clId |
232 |
242 |
233 let room = newRoom{ |
243 let room = newRoom{ |
234 masterID = clId, |
244 masterID = clId, |
235 name = roomName, |
245 name = roomName, |
333 |
343 |
334 |
344 |
335 processAction JoinLobby = do |
345 processAction JoinLobby = do |
336 chan <- client's sendChan |
346 chan <- client's sendChan |
337 clientNick <- client's nick |
347 clientNick <- client's nick |
338 (lobbyNicks, clientsChans) <- liftM (unzip . Prelude.map (\c -> (nick c, sendChan c)) . Prelude.filter logonPassed) allClientsS |
348 (lobbyNicks, clientsChans) <- liftM (unzip . Prelude.map (\c -> (nick c, sendChan c)) . Prelude.filter logonPassed) $! allClientsS |
339 mapM_ processAction $ |
349 mapM_ processAction $ |
340 (AnswerClients clientsChans ["LOBBY:JOINED", clientNick]) |
350 (AnswerClients clientsChans ["LOBBY:JOINED", clientNick]) |
341 : [AnswerClients [chan] ("LOBBY:JOINED" : lobbyNicks) | not $ Prelude.null lobbyNicks] |
351 : [AnswerClients [chan] ("LOBBY:JOINED" : clientNick : lobbyNicks)] |
342 ++ [ModifyClient (\cl -> cl{logonPassed = True}), SendServerMessage] |
352 ++ [ModifyClient (\cl -> cl{logonPassed = True}), SendServerMessage] |
343 |
353 |
344 {- |
354 {- |
345 processAction (clID, serverInfo, rnc) (RoomAddThisClient rID) = |
355 processAction (clID, serverInfo, rnc) (RoomAddThisClient rID) = |
346 processAction ( |
356 processAction ( |