diff -r a94d1dc4a8d9 -r 45778b16b224 gameServer/Actions.hs --- 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