--- a/gameServer/Actions.hs Mon Jul 19 22:37:47 2010 +0400
+++ b/gameServer/Actions.hs Mon Jul 19 23:00:10 2010 +0400
@@ -417,24 +417,22 @@
return (ci, serverInfo)
-}
-
-{-
-processAction (clID, serverInfo, rnc) PingAll = do
- (_, _, newClients, newRooms) <- foldM kickTimeouted (clID, serverInfo, rnc) $ elems clients
- processAction (clID,
- serverInfo,
- Data.IntMap.map (\cl -> cl{pingsQueue = pingsQueue cl + 1}) newClients,
- newRooms) $ AnswerAll ["PING"]
+processAction PingAll = do
+ rnc <- gets roomsClients
+ cis <- liftIO $ allClientsM rnc
+ mapM_ (kickTimeouted rnc) $ cis
+ chans <- liftIO $ mapM (client'sM rnc sendChan) cis
+ liftIO $ mapM_ (modifyClient rnc (\cl -> cl{pingsQueue = pingsQueue cl + 1})) cis
+ processAction $ AnswerClients chans ["PING"]
where
- kickTimeouted (clID, serverInfo, rnc) client =
- if pingsQueue client > 0 then
- processAction (clientUID client, serverInfo, rnc) $ ByeClient "Ping timeout"
- else
- return (clID, serverInfo, rnc)
+ kickTimeouted rnc ci = do
+ pq <- liftIO $ client'sM rnc pingsQueue ci
+ when (pq > 0) $
+ withStateT (\as -> as{clientIndex = Just ci}) $
+ processAction (ByeClient "Ping timeout")
--}
processAction (StatsAction) = do
rnc <- gets roomsClients
--- a/gameServer/RoomsAndClients.hs Mon Jul 19 22:37:47 2010 +0400
+++ b/gameServer/RoomsAndClients.hs Mon Jul 19 23:00:10 2010 +0400
@@ -19,6 +19,7 @@
room,
client'sM,
room'sM,
+ allClientsM,
clientsM,
roomClientsM,
withRoomsAndClients,
@@ -146,6 +147,9 @@
room'sM :: MRoomsAndClients r c -> (r -> a) -> RoomIndex -> IO a
room'sM (MRoomsAndClients (rooms, _)) f (RoomIndex ri) = liftM (f . room') (rooms `readElem` ri)
+allClientsM :: MRoomsAndClients r c -> IO [ClientIndex]
+allClientsM (MRoomsAndClients (_, clients)) = liftM (map ClientIndex) $ indicesM clients
+
clientsM :: MRoomsAndClients r c -> IO [c]
clientsM (MRoomsAndClients (_, clients)) = indicesM clients >>= mapM (\ci -> liftM client' $ readElem clients ci)