Bring back room and teams removing server_refactor
authorunc0rr
Mon, 10 Jan 2011 18:12:13 +0300
branchserver_refactor
changeset 4571 597440c80b8a
parent 4569 a835465b4fd2
child 4573 7e3be7d7eeda
Bring back room and teams removing
gameServer/Actions.hs
gameServer/HWProtoLobbyState.hs
--- a/gameServer/Actions.hs	Mon Jan 10 15:42:17 2011 +0300
+++ b/gameServer/Actions.hs	Mon Jan 10 18:12:13 2011 +0300
@@ -53,6 +53,11 @@
 type CmdHandler = [B.ByteString] -> Reader (ClientIndex, IRnC) [Action]
 
 
+othersChans = do
+    cl <- client's id
+    ri <- clientRoomA
+    liftM (map sendChan . filter (/= cl)) $ roomClientsS ri
+
 processAction :: Action -> StateT ServerState IO ()
 
 
@@ -100,15 +105,9 @@
     ri <- clientRoomA
 
     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
@@ -179,7 +178,7 @@
     (Just ci) <- gets clientIndex
     rnc <- gets roomsClients
     liftIO $ do
-        modifyClient rnc (\cl -> cl{teamsInGame = 0}) ci
+        modifyClient rnc (\cl -> cl{teamsInGame = 0, isReady = false, isMaster = false}) ci
         modifyRoom rnc (\r -> r{playersIn = (playersIn r) + 1}) ri
 
     liftIO $ moveClientToRoom rnc ri ci
@@ -191,10 +190,28 @@
 
 processAction (MoveToLobby msg) = do
     (Just ci) <- gets clientIndex
-    --ri <- clientRoomA
+    ri <- clientRoomA
     rnc <- gets roomsClients
+    room <- clientRoomA
+    ready <- client's isReady
+    master <- client's isMaster
+    client <- client's id
 
-    liftIO $ moveClientToLobby rnc ci
+    if master then
+        processAction RemoveRoom
+        else
+        do
+        clNick <- client's nick
+        clChan <- client's sendChan
+        chans <- othersChans
+        mapM_ processAction [AnswerClients chans ["LEFT", clNick, msg], RemoveClientTeams ci]
+
+    liftIO $ do
+            modifyRoom rnc (\r -> r{
+                    playersIn = (playersIn r) - 1,
+                    readyPlayers = if ready then readyPlayers r - 1 else readyPlayers r
+                    }) ri
+            moveClientToLobby rnc ci
 
 {-
     (_, _, newClients, newRooms) <-
@@ -268,21 +285,23 @@
         , ModifyClient (\cl -> cl{isMaster = True})
         ]
 
-{-
-processAction (clID, serverInfo, rnc) (RemoveRoom) = do
-    processAction (clID, serverInfo, rnc) $ AnswerLobby ["ROOM", "DEL", name room]
-    processAction (clID, serverInfo, rnc) $ AnswerOthersInRoom ["ROOMABANDONED", name room]
-    return (clID,
-        serverInfo,
-        Data.IntMap.map (\cl -> if roomID cl == rID then cl{roomID = 0, isMaster = False, isReady = False, teamsInGame = undefined} else cl) clients,
-        delete rID $ adjust (\r -> r{playersIDs = IntSet.union (playersIDs room) (playersIDs r)}) 0 rooms
-        )
-    where
-        room = rooms ! rID
-        rID = roomID client
-        client = clients ! clID
+
+processAction RemoveRoom = do
+    Just clId <- gets clientIndex
+    rnc <- gets roomsClients
+    ri <- liftIO $ clientRoomM rnc clId
+    roomName <- liftIO $ room'sM rnc name ri
+    others <- othersChans
+    lobbyChans <- liftM (map sendChan) $! roomClientsS lobbyId
 
--}
+    mapM_ processAction [
+            AnswerClients lobbyChans ["ROOM", "DEL", roomName],
+            AnswerClients others ["ROOMABANDONED", roomName]
+        ]
+
+    liftIO $ removeRoom rnc ri
+
+
 processAction (UnreadyRoomClients) = do
     rnc <- gets roomsClients
     ri <- clientRoomA
@@ -298,7 +317,7 @@
     cl <- client's id
     ri <- clientRoomA
     inGame <- liftIO $ room'sM rnc gameinprogress ri
-    chans <- liftM (map sendChan . filter (/= cl)) $ roomClientsS ri
+    chans <- othersChans
     if inGame then
             mapM_ processAction [
                 AnswerClients chans ["REMOVE_TEAM", teamName],
@@ -316,6 +335,20 @@
     where
         rmTeamMsg = toEngineMsg $ (B.singleton 'F') `B.append` teamName
 
+
+processAction (RemoveClientTeams clId) = do
+    rnc <- gets roomsClients
+
+    removeTeamActions <- liftIO $ do
+        clNick <- client'sM rnc nick clId
+        rId <- clientRoomM rnc clId
+        roomTeams <- room'sM rnc teams rId
+        return . Prelude.map (RemoveTeam . teamname) . Prelude.filter (\t -> teamowner t == clNick) $ roomTeams
+
+    mapM_ processAction removeTeamActions
+
+
+
 processAction CheckRegistered = do
     (Just ci) <- gets clientIndex
     n <- client's nick
@@ -387,15 +420,6 @@
     writeChan (sendChan $ clients ! kickID) ["KICKED"]
     liftM2 replaceID (return clID) (processAction (kickID, serverInfo, rnc) $ RoomRemoveThisClient "kicked")
 
-
-processAction (clID, serverInfo, rnc) (RemoveClientTeams teamsClID) =
-    liftM2 replaceID (return clID) $
-        foldM processAction (teamsClID, serverInfo, rnc) removeTeamsActions
-    where
-        client = clients ! teamsClID
-        room = rooms ! (roomID client)
-        teamsToRemove = Prelude.filter (\t -> teamowner t == nick client) $ teams room
-        removeTeamsActions = Prelude.map (RemoveTeam . teamname) teamsToRemove
 -}
 
 processAction (AddClient client) = do
--- a/gameServer/HWProtoLobbyState.hs	Mon Jan 10 15:42:17 2011 +0300
+++ b/gameServer/HWProtoLobbyState.hs	Mon Jan 10 18:12:13 2011 +0300
@@ -86,9 +86,9 @@
             else
             [
                 MoveToRoom jRI,
-                AnswerClients (map sendChan $ cl : jRoomClients) ["NOT_READY", nick cl]
+                AnswerClients (map sendChan $ cl : jRoomClients) ["NOT_READY", nick cl],
+                AnswerClients [sendChan cl] $ "JOINED" : map nick jRoomClients
             ]
-            ++ [ AnswerClients [sendChan cl] $ "JOINED" : map nick jRoomClients | playersIn jRoom /= 0]
             ++ (map (readynessMessage cl) jRoomClients)
 
     where