Reimplement REMOVE_TEAM
authorunc0rr
Sat, 17 Jul 2010 23:44:42 +0400
changeset 3645 c0b3f1bb9316
parent 3644 42c5684289ae
child 3652 df76ccda0648
Reimplement REMOVE_TEAM
gameServer/Actions.hs
gameServer/HWProtoLobbyState.hs
gameServer/RoomsAndClients.hs
gameServer/ServerState.hs
--- a/gameServer/Actions.hs	Thu Jul 15 04:31:25 2010 +0200
+++ b/gameServer/Actions.hs	Sat Jul 17 23:44:42 2010 +0400
@@ -181,7 +181,7 @@
 
     chans <- liftM (map sendChan) $ roomClientsS ri
     clNick <- client's nick
-    
+
     processAction $ AnswerClients chans ["JOINED", clNick]
 
 processAction (MoveToLobby msg) = do
@@ -244,22 +244,24 @@
     Just clId <- gets clientIndex
     rnc <- gets roomsClients
     proto <- liftIO $ client'sM rnc clientProto clId
-    
+
     let room = newRoom{
             masterID = clId,
             name = roomName,
             password = roomPassword,
             roomProto = proto
             }
-            
-    rId <- liftIO $ addRoom rnc room      
-    
+
+    rId <- liftIO $ addRoom rnc room
+
+    processAction $ MoveToRoom rId
+
     chans <- liftM (map sendChan) $ roomClientsS lobbyId
 
     mapM_ processAction [
         AnswerClients chans ["ROOM", "ADD", roomName]
         , ModifyClient (\cl -> cl{isMaster = True})
-        , MoveToRoom rId]
+        ]
 
 {-
 processAction (clID, serverInfo, rnc) (RemoveRoom) = do
@@ -289,29 +291,30 @@
         roomPlayers = Prelude.map (nick . (clients !)) roomPlayersIDs
         roomPlayersIDs = IntSet.elems $ playersIDs room
 
+-}
 
-processAction (clID, serverInfo, rnc) (RemoveTeam teamName) = do
-    newRooms <- if not $ gameinprogress room then
-            do
-            processAction (clID, serverInfo, rnc) $ AnswerOthersInRoom ["REMOVE_TEAM", teamName]
-            return $
-                adjust (\r -> r{teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r}) rID rooms
+processAction (RemoveTeam teamName) = do
+    rnc <- gets roomsClients
+    cl <- client's id
+    ri <- clientRoomA
+    inGame <- liftIO $ room'sM rnc gameinprogress ri
+    chans <- liftM (map sendChan . filter (/= cl)) $ roomClientsS ri
+    if inGame then
+            mapM_ processAction [
+                AnswerClients chans ["REMOVE_TEAM", teamName],
+                ModifyRoom (\r -> r{teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r})
+                ]
         else
-            do
-            processAction (clID, serverInfo, rnc) $ AnswerOthersInRoom ["EM", rmTeamMsg]
-            return $
-                adjust (\r -> r{
-                teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r,
-                leftTeams = teamName : leftTeams r,
-                roundMsgs = roundMsgs r Seq.|> rmTeamMsg
-                }) rID rooms
-    return (clID, serverInfo, clients, newRooms)
+            mapM_ processAction [
+                AnswerClients chans ["EM", rmTeamMsg],
+                ModifyRoom (\r -> r{
+                    teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r,
+                    leftTeams = teamName : leftTeams r,
+                    roundMsgs = roundMsgs r Seq.|> rmTeamMsg
+                    })
+                ]
     where
-        room = rooms ! rID
-        rID = roomID client
-        client = clients ! clID
-        rmTeamMsg = toEngineMsg $ 'F' : teamName
--}
+        rmTeamMsg = toEngineMsg $ (B.singleton 'F') `B.append` teamName
 
 processAction CheckRegistered = do
     (Just ci) <- gets clientIndex
--- a/gameServer/HWProtoLobbyState.hs	Thu Jul 15 04:31:25 2010 +0200
+++ b/gameServer/HWProtoLobbyState.hs	Sat Jul 17 23:44:42 2010 +0400
@@ -54,8 +54,7 @@
     | illegalName newRoom = return [Warning "Illegal room name"]
     | otherwise = do
         rs <- allRoomInfos
-        (ci, irnc) <- ask
-        let cl =  irnc `client` ci
+        cl <- thisClient
         return $ if isJust $ find (\room -> newRoom == name room) rs then 
             [Warning "Room exists"]
             else
--- a/gameServer/RoomsAndClients.hs	Thu Jul 15 04:31:25 2010 +0200
+++ b/gameServer/RoomsAndClients.hs	Sat Jul 17 23:44:42 2010 +0400
@@ -18,6 +18,7 @@
     client,
     room,
     client'sM,
+    room'sM,
     clientsM,
     roomClientsM,
     withRoomsAndClients,
@@ -142,6 +143,9 @@
 client'sM :: MRoomsAndClients r c -> (c -> a) -> ClientIndex -> IO a
 client'sM (MRoomsAndClients (_, clients)) f (ClientIndex ci) = liftM (f . client') (clients `readElem` ci)
 
+room'sM :: MRoomsAndClients r c -> (r -> a) -> RoomIndex -> IO a
+room'sM (MRoomsAndClients (rooms, _)) f (RoomIndex ri) = liftM (f . room') (rooms `readElem` ri)
+
 clientsM :: MRoomsAndClients r c -> IO [c]
 clientsM (MRoomsAndClients (_, clients)) = indicesM clients >>= mapM (\ci -> liftM client' $ readElem clients ci)
 
--- a/gameServer/ServerState.hs	Thu Jul 15 04:31:25 2010 +0200
+++ b/gameServer/ServerState.hs	Sat Jul 17 23:44:42 2010 +0400
@@ -33,7 +33,7 @@
     (Just ci) <- gets clientIndex
     rnc <- gets roomsClients
     liftIO $ client'sM rnc f ci
-    
+
 allClientsS :: StateT ServerState IO [ClientInfo]
 allClientsS = gets roomsClients >>= liftIO . clientsM
 
@@ -41,4 +41,3 @@
 roomClientsS ri = do
     rnc <- gets roomsClients
     liftIO $ roomClientsM rnc ri
-    
\ No newline at end of file