120 |
120 |
121 processAction (clID, serverInfo, clients, rooms) (ByeClient msg) = do |
121 processAction (clID, serverInfo, clients, rooms) (ByeClient msg) = do |
122 infoM "Clients" ((show $ clientUID client) ++ " quits: " ++ msg) |
122 infoM "Clients" ((show $ clientUID client) ++ " quits: " ++ msg) |
123 (_, _, newClients, newRooms) <- |
123 (_, _, newClients, newRooms) <- |
124 if roomID client /= 0 then |
124 if roomID client /= 0 then |
125 processAction (clID, serverInfo, clients, rooms) |
125 processAction (clID, serverInfo, clients, rooms) $ RoomRemoveThisClient "quit" |
126 (if isMaster client then RemoveRoom else RemoveClientTeams clID) |
|
127 else |
126 else |
128 return (clID, serverInfo, clients, rooms) |
127 return (clID, serverInfo, clients, rooms) |
129 |
128 |
130 mapM_ (processAction (clID, serverInfo, newClients, newRooms)) $ answerOthersQuit ++ answerInformRoom |
129 mapM_ (processAction (clID, serverInfo, newClients, newRooms)) $ answerOthersQuit ++ answerInformRoom |
131 writeChan (sendChan $ clients ! clID) ["BYE", msg] |
130 writeChan (sendChan $ clients ! clID) ["BYE", msg] |
190 AnswerThisRoom ["JOINED", nick client] |
189 AnswerThisRoom ["JOINED", nick client] |
191 |
190 |
192 |
191 |
193 processAction (clID, serverInfo, clients, rooms) (RoomRemoveThisClient msg) = do |
192 processAction (clID, serverInfo, clients, rooms) (RoomRemoveThisClient msg) = do |
194 (_, _, newClients, newRooms) <- |
193 (_, _, newClients, newRooms) <- |
195 if roomID client /= 0 then |
194 if roomID client /= 0 then |
|
195 if isMaster client then |
|
196 if gameinprogress room then |
|
197 processAction (clID, serverInfo, clients, rooms) RemoveRoom |
|
198 else -- not in game |
|
199 processAction (clID, serverInfo, clients, rooms) RemoveRoom |
|
200 else -- not master |
196 foldM |
201 foldM |
197 processAction |
202 processAction |
198 (clID, serverInfo, clients, rooms) |
203 (clID, serverInfo, clients, rooms) |
199 [AnswerOthersInRoom ["LEFT", nick client, msg], |
204 [AnswerOthersInRoom ["LEFT", nick client, msg], |
200 RemoveClientTeams clID] |
205 RemoveClientTeams clID] |
201 else |
206 else -- in lobby |
202 return (clID, serverInfo, clients, rooms) |
207 return (clID, serverInfo, clients, rooms) |
203 |
208 |
204 return ( |
209 return ( |
205 clID, |
210 clID, |
206 serverInfo, |
211 serverInfo, |
207 adjust (\cl -> cl{roomID = 0, isMaster = False, isReady = False, teamsInGame = undefined}) clID newClients, |
212 adjust resetClientFlags clID newClients, |
208 adjust (\r -> r{ |
213 adjust removeClientFromRoom rID $ adjust insertClientToRoom 0 newRooms |
|
214 ) |
|
215 where |
|
216 rID = roomID client |
|
217 client = clients ! clID |
|
218 room = rooms ! rID |
|
219 resetClientFlags cl = cl{roomID = 0, isMaster = False, isReady = False, teamsInGame = undefined} |
|
220 removeClientFromRoom r = r{ |
209 playersIDs = IntSet.delete clID (playersIDs r), |
221 playersIDs = IntSet.delete clID (playersIDs r), |
210 playersIn = (playersIn r) - 1, |
222 playersIn = (playersIn r) - 1, |
211 readyPlayers = if isReady client then (readyPlayers r) - 1 else readyPlayers r |
223 readyPlayers = if isReady client then (readyPlayers r) - 1 else readyPlayers r |
212 }) rID $ |
224 } |
213 adjust (\r -> r{playersIDs = IntSet.insert clID (playersIDs r)}) 0 newRooms |
225 insertClientToRoom r = r{playersIDs = IntSet.insert clID (playersIDs r)} |
214 ) |
|
215 where |
|
216 rID = roomID client |
|
217 client = clients ! clID |
|
218 |
226 |
219 |
227 |
220 processAction (clID, serverInfo, clients, rooms) (AddRoom roomName roomPassword) = do |
228 processAction (clID, serverInfo, clients, rooms) (AddRoom roomName roomPassword) = do |
221 let newServerInfo = serverInfo {nextRoomID = newID} |
229 let newServerInfo = serverInfo {nextRoomID = newID} |
222 let room = newRoom{ |
230 let room = newRoom{ |