gameServer/Actions.hs
changeset 3673 45778b16b224
parent 3671 a94d1dc4a8d9
child 3741 73246d25dfe1
--- a/gameServer/Actions.hs	Sun Jul 25 18:55:54 2010 +0400
+++ b/gameServer/Actions.hs	Sun Jul 25 22:39:59 2010 +0400
@@ -56,8 +56,10 @@
 processAction :: Action -> StateT ServerState IO ()
 
 
-processAction (AnswerClients chans msg) = 
-    liftIO $ mapM_ (flip writeChan msg) chans
+processAction (AnswerClients chans msg) = do
+    liftIO (putStr $ "AnswerClients... " ++ (show $ length chans) ++ " (" ++ (show msg) ++")")
+    liftIO $ map (flip seq ()) chans `seq` mapM_ (flip writeChan msg) chans
+    liftIO (putStrLn "done")
 
 
 processAction SendServerMessage = do
@@ -68,7 +70,7 @@
             serverMessageForOldVersions si
             else
             serverMessage si
-    liftIO $ writeChan chan ["SERVER_MESSAGE", message]
+    processAction $ AnswerClients [chan] ["SERVER_MESSAGE", message]
 {-
 
 processAction (clID, serverInfo, rnc) SendServerVars = do
@@ -87,12 +89,12 @@
 
 processAction (ProtocolError msg) = do
     chan <- client's sendChan
-    liftIO $ writeChan chan ["ERROR", msg]
+    processAction $ AnswerClients [chan] ["ERROR", msg]
 
 
 processAction (Warning msg) = do
     chan <- client's sendChan
-    liftIO $ writeChan chan ["WARNING", msg]
+    processAction $ AnswerClients [chan] ["WARNING", msg]
 
 processAction (ByeClient msg) = do
     (Just ci) <- gets clientIndex
@@ -109,13 +111,13 @@
         infoM "Clients" (show ci ++ " quits: " ++ (B.unpack msg))
 
         --mapM_ (processAction (ci, serverInfo, rnc)) $ answerOthersQuit ++ answerInformRoom
-        writeChan chan ["BYE", msg]
         modifyRoom rnc (\r -> r{
                         --playersIDs = IntSet.delete ci (playersIDs r)
                         playersIn = (playersIn r) - 1,
                         readyPlayers = if ready then readyPlayers r - 1 else readyPlayers r
                         }) ri
 
+    processAction $ AnswerClients [chan] ["BYE", msg]
     modify (\s -> s{removedClients = ci `Set.insert` removedClients s})
 
 processAction (DeleteClient ci) = do
@@ -336,13 +338,13 @@
     case info of
         HasAccount passwd isAdmin -> do
             chan <- client's sendChan
-            liftIO $ writeChan chan ["ASKPASSWORD"]
+            processAction $ AnswerClients [chan] ["ASKPASSWORD"]
         Guest -> do
             processAction JoinLobby
         Admin -> do
             mapM processAction [ModifyClient (\cl -> cl{isAdministrator = True}), JoinLobby]
             chan <- client's sendChan
-            liftIO $ writeChan chan ["ADMIN_ACCESS"]
+            processAction $ AnswerClients [chan] ["ADMIN_ACCESS"]
 
 
 processAction JoinLobby = do
@@ -402,8 +404,8 @@
         forkIO $ clientSendLoop (clientSocket client) (coreChan si) (sendChan client) ci
 
         infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime client))
-        writeChan (sendChan client) ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"]
 
+    processAction $ AnswerClients [sendChan client] ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"]
 {-        let newLogins = takeWhile (\(_ , time) -> (connectTime client) `diffUTCTime` time <= 11) $ lastLogins serverInfo
 
         if False && (isJust $ host client `Prelude.lookup` newLogins) then