51 | StatsAction |
51 | StatsAction |
52 |
52 |
53 type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action] |
53 type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action] |
54 |
54 |
55 |
55 |
|
56 othersChans = do |
|
57 cl <- client's id |
|
58 ri <- clientRoomA |
|
59 liftM (map sendChan . filter (/= cl)) $ roomClientsS ri |
|
60 |
56 processAction :: Action -> StateT ServerState IO () |
61 processAction :: Action -> StateT ServerState IO () |
57 |
62 |
58 |
63 |
59 processAction (AnswerClients chans msg) = do |
64 processAction (AnswerClients chans msg) = do |
60 liftIO $ map (flip seq ()) chans `seq` map (flip seq ()) msg `seq` mapM_ (flip writeChan msg) chans |
65 liftIO $ map (flip seq ()) chans `seq` map (flip seq ()) msg `seq` mapM_ (flip writeChan msg) chans |
98 (Just ci) <- gets clientIndex |
103 (Just ci) <- gets clientIndex |
99 rnc <- gets roomsClients |
104 rnc <- gets roomsClients |
100 ri <- clientRoomA |
105 ri <- clientRoomA |
101 |
106 |
102 chan <- client's sendChan |
107 chan <- client's sendChan |
103 ready <- client's isReady |
|
104 |
108 |
105 when (ri /= lobbyId) $ do |
109 when (ri /= lobbyId) $ do |
106 processAction $ MoveToLobby ("quit: " `B.append` msg) |
110 processAction $ MoveToLobby ("quit: " `B.append` msg) |
107 liftIO $ modifyRoom rnc (\r -> r{ |
|
108 --playersIDs = IntSet.delete ci (playersIDs r) |
|
109 playersIn = (playersIn r) - 1, |
|
110 readyPlayers = if ready then readyPlayers r - 1 else readyPlayers r |
|
111 }) ri |
|
112 return () |
111 return () |
113 |
112 |
114 liftIO $ do |
113 liftIO $ do |
115 infoM "Clients" (show ci ++ " quits: " ++ (B.unpack msg)) |
114 infoM "Clients" (show ci ++ " quits: " ++ (B.unpack msg)) |
116 |
115 |
177 |
176 |
178 processAction (MoveToRoom ri) = do |
177 processAction (MoveToRoom ri) = do |
179 (Just ci) <- gets clientIndex |
178 (Just ci) <- gets clientIndex |
180 rnc <- gets roomsClients |
179 rnc <- gets roomsClients |
181 liftIO $ do |
180 liftIO $ do |
182 modifyClient rnc (\cl -> cl{teamsInGame = 0}) ci |
181 modifyClient rnc (\cl -> cl{teamsInGame = 0, isReady = false, isMaster = false}) ci |
183 modifyRoom rnc (\r -> r{playersIn = (playersIn r) + 1}) ri |
182 modifyRoom rnc (\r -> r{playersIn = (playersIn r) + 1}) ri |
184 |
183 |
185 liftIO $ moveClientToRoom rnc ri ci |
184 liftIO $ moveClientToRoom rnc ri ci |
186 |
185 |
187 chans <- liftM (map sendChan) $ roomClientsS ri |
186 chans <- liftM (map sendChan) $ roomClientsS ri |
189 |
188 |
190 processAction $ AnswerClients chans ["JOINED", clNick] |
189 processAction $ AnswerClients chans ["JOINED", clNick] |
191 |
190 |
192 processAction (MoveToLobby msg) = do |
191 processAction (MoveToLobby msg) = do |
193 (Just ci) <- gets clientIndex |
192 (Just ci) <- gets clientIndex |
194 --ri <- clientRoomA |
193 ri <- clientRoomA |
195 rnc <- gets roomsClients |
194 rnc <- gets roomsClients |
196 |
195 room <- clientRoomA |
197 liftIO $ moveClientToLobby rnc ci |
196 ready <- client's isReady |
|
197 master <- client's isMaster |
|
198 client <- client's id |
|
199 |
|
200 if master then |
|
201 processAction RemoveRoom |
|
202 else |
|
203 do |
|
204 clNick <- client's nick |
|
205 clChan <- client's sendChan |
|
206 chans <- othersChans |
|
207 mapM_ processAction [AnswerClients chans ["LEFT", clNick, msg], RemoveClientTeams ci] |
|
208 |
|
209 liftIO $ do |
|
210 modifyRoom rnc (\r -> r{ |
|
211 playersIn = (playersIn r) - 1, |
|
212 readyPlayers = if ready then readyPlayers r - 1 else readyPlayers r |
|
213 }) ri |
|
214 moveClientToLobby rnc ci |
198 |
215 |
199 {- |
216 {- |
200 (_, _, newClients, newRooms) <- |
217 (_, _, newClients, newRooms) <- |
201 if isMaster client then |
218 if isMaster client then |
202 if (gameinprogress room) && (playersIn room > 1) then |
219 if (gameinprogress room) && (playersIn room > 1) then |
266 mapM_ processAction [ |
283 mapM_ processAction [ |
267 AnswerClients chans ["ROOM", "ADD", roomName] |
284 AnswerClients chans ["ROOM", "ADD", roomName] |
268 , ModifyClient (\cl -> cl{isMaster = True}) |
285 , ModifyClient (\cl -> cl{isMaster = True}) |
269 ] |
286 ] |
270 |
287 |
271 {- |
288 |
272 processAction (clID, serverInfo, rnc) (RemoveRoom) = do |
289 processAction RemoveRoom = do |
273 processAction (clID, serverInfo, rnc) $ AnswerLobby ["ROOM", "DEL", name room] |
290 Just clId <- gets clientIndex |
274 processAction (clID, serverInfo, rnc) $ AnswerOthersInRoom ["ROOMABANDONED", name room] |
291 rnc <- gets roomsClients |
275 return (clID, |
292 ri <- liftIO $ clientRoomM rnc clId |
276 serverInfo, |
293 roomName <- liftIO $ room'sM rnc name ri |
277 Data.IntMap.map (\cl -> if roomID cl == rID then cl{roomID = 0, isMaster = False, isReady = False, teamsInGame = undefined} else cl) clients, |
294 others <- othersChans |
278 delete rID $ adjust (\r -> r{playersIDs = IntSet.union (playersIDs room) (playersIDs r)}) 0 rooms |
295 lobbyChans <- liftM (map sendChan) $! roomClientsS lobbyId |
279 ) |
296 |
280 where |
297 mapM_ processAction [ |
281 room = rooms ! rID |
298 AnswerClients lobbyChans ["ROOM", "DEL", roomName], |
282 rID = roomID client |
299 AnswerClients others ["ROOMABANDONED", roomName] |
283 client = clients ! clID |
300 ] |
284 |
301 |
285 -} |
302 liftIO $ removeRoom rnc ri |
|
303 |
|
304 |
286 processAction (UnreadyRoomClients) = do |
305 processAction (UnreadyRoomClients) = do |
287 rnc <- gets roomsClients |
306 rnc <- gets roomsClients |
288 ri <- clientRoomA |
307 ri <- clientRoomA |
289 roomPlayers <- roomClientsS ri |
308 roomPlayers <- roomClientsS ri |
290 roomClIDs <- liftIO $ roomClientsIndicesM rnc ri |
309 roomClIDs <- liftIO $ roomClientsIndicesM rnc ri |
296 processAction (RemoveTeam teamName) = do |
315 processAction (RemoveTeam teamName) = do |
297 rnc <- gets roomsClients |
316 rnc <- gets roomsClients |
298 cl <- client's id |
317 cl <- client's id |
299 ri <- clientRoomA |
318 ri <- clientRoomA |
300 inGame <- liftIO $ room'sM rnc gameinprogress ri |
319 inGame <- liftIO $ room'sM rnc gameinprogress ri |
301 chans <- liftM (map sendChan . filter (/= cl)) $ roomClientsS ri |
320 chans <- othersChans |
302 if inGame then |
321 if inGame then |
303 mapM_ processAction [ |
322 mapM_ processAction [ |
304 AnswerClients chans ["REMOVE_TEAM", teamName], |
323 AnswerClients chans ["REMOVE_TEAM", teamName], |
305 ModifyRoom (\r -> r{teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r}) |
324 ModifyRoom (\r -> r{teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r}) |
306 ] |
325 ] |
314 }) |
333 }) |
315 ] |
334 ] |
316 where |
335 where |
317 rmTeamMsg = toEngineMsg $ (B.singleton 'F') `B.append` teamName |
336 rmTeamMsg = toEngineMsg $ (B.singleton 'F') `B.append` teamName |
318 |
337 |
|
338 |
|
339 processAction (RemoveClientTeams clId) = do |
|
340 rnc <- gets roomsClients |
|
341 |
|
342 removeTeamActions <- liftIO $ do |
|
343 clNick <- client'sM rnc nick clId |
|
344 rId <- clientRoomM rnc clId |
|
345 roomTeams <- room'sM rnc teams rId |
|
346 return . Prelude.map (RemoveTeam . teamname) . Prelude.filter (\t -> teamowner t == clNick) $ roomTeams |
|
347 |
|
348 mapM_ processAction removeTeamActions |
|
349 |
|
350 |
|
351 |
319 processAction CheckRegistered = do |
352 processAction CheckRegistered = do |
320 (Just ci) <- gets clientIndex |
353 (Just ci) <- gets clientIndex |
321 n <- client's nick |
354 n <- client's nick |
322 h <- client's host |
355 h <- client's host |
323 db <- gets (dbQueries . serverInfo) |
356 db <- gets (dbQueries . serverInfo) |
385 |
418 |
386 processAction (clID, serverInfo, rnc) (KickRoomClient kickID) = do |
419 processAction (clID, serverInfo, rnc) (KickRoomClient kickID) = do |
387 writeChan (sendChan $ clients ! kickID) ["KICKED"] |
420 writeChan (sendChan $ clients ! kickID) ["KICKED"] |
388 liftM2 replaceID (return clID) (processAction (kickID, serverInfo, rnc) $ RoomRemoveThisClient "kicked") |
421 liftM2 replaceID (return clID) (processAction (kickID, serverInfo, rnc) $ RoomRemoveThisClient "kicked") |
389 |
422 |
390 |
|
391 processAction (clID, serverInfo, rnc) (RemoveClientTeams teamsClID) = |
|
392 liftM2 replaceID (return clID) $ |
|
393 foldM processAction (teamsClID, serverInfo, rnc) removeTeamsActions |
|
394 where |
|
395 client = clients ! teamsClID |
|
396 room = rooms ! (roomID client) |
|
397 teamsToRemove = Prelude.filter (\t -> teamowner t == nick client) $ teams room |
|
398 removeTeamsActions = Prelude.map (RemoveTeam . teamname) teamsToRemove |
|
399 -} |
423 -} |
400 |
424 |
401 processAction (AddClient client) = do |
425 processAction (AddClient client) = do |
402 rnc <- gets roomsClients |
426 rnc <- gets roomsClients |
403 si <- gets serverInfo |
427 si <- gets serverInfo |