gameServer/Actions.hs
changeset 3947 709fdb89f76c
parent 3741 73246d25dfe1
child 4242 5e3c5fe2cb14
--- a/gameServer/Actions.hs	Sun Oct 10 12:53:16 2010 -0400
+++ b/gameServer/Actions.hs	Sun Oct 10 21:32:18 2010 +0400
@@ -98,30 +98,35 @@
     (Just ci) <- gets clientIndex
     rnc <- gets roomsClients
     ri <- clientRoomA
-    when (ri /= lobbyId) $ do
-        processAction $ MoveToLobby ("quit: " `B.append` msg)
-        return ()
 
     chan <- client's sendChan
     ready <- client's isReady
 
+    when (ri /= lobbyId) $ do
+        processAction $ MoveToLobby ("quit: " `B.append` msg)
+        liftIO $ 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
+        return ()
+
     liftIO $ do
         infoM "Clients" (show ci ++ " quits: " ++ (B.unpack msg))
 
         --mapM_ (processAction (ci, serverInfo, rnc)) $ answerOthersQuit ++ answerInformRoom
-        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})
+
+    s <- get
+    put $! s{removedClients = ci `Set.insert` removedClients s}
 
 processAction (DeleteClient ci) = do
     rnc <- gets roomsClients
     liftIO $ removeClient rnc ci
-    modify (\s -> s{removedClients = ci `Set.delete` removedClients s})
+
+    s <- get
+    put $! s{removedClients = ci `Set.delete` removedClients s}
 
 {-
     where
@@ -256,7 +261,7 @@
 
     processAction $ MoveToRoom rId
 
-    chans <- liftM (map sendChan) $ roomClientsS lobbyId
+    chans <- liftM (map sendChan) $! roomClientsS lobbyId
 
     mapM_ processAction [
         AnswerClients chans ["ROOM", "ADD", roomName]
@@ -399,7 +404,7 @@
     liftIO $ do
         ci <- addClient rnc client
         forkIO $ clientRecvLoop (clientSocket client) (coreChan si) ci
-        forkIO $ clientSendLoop (clientSocket client) (coreChan si) (sendChan client) ci
+        forkIO $ clientSendLoop (clientSocket client) (sendChan client) ci
 
         infoM "Clients" (show ci ++ ": New client. Time: " ++ show (connectTime client))