Implement room delegation when admin lefts it server_refactor
authorunc0rr
Mon, 31 Jan 2011 21:40:17 +0300
branchserver_refactor
changeset 4622 8bdc879ee6b2
parent 4620 6122a43d3424
child 4624 538e5556262b
child 4904 0eab727d4717
Implement room delegation when admin lefts it
gameServer/Actions.hs
gameServer/CoreTypes.hs
gameServer/ServerState.hs
--- a/gameServer/Actions.hs	Sun Jan 30 20:43:18 2011 +0300
+++ b/gameServer/Actions.hs	Mon Jan 31 21:40:17 2011 +0300
@@ -36,7 +36,8 @@
     | ByeClient B.ByteString
     | KickClient ClientIndex
     | KickRoomClient ClientIndex
-    | BanClient B.ByteString -- nick
+    | BanClient B.ByteString
+    | ChangeMaster
     | RemoveClientTeams ClientIndex
     | ModifyClient (ClientInfo -> ClientInfo)
     | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo)
@@ -179,18 +180,19 @@
     (Just ci) <- gets clientIndex
     ri <- clientRoomA
     rnc <- gets roomsClients
-    room <- clientRoomA
+    (gameProgress, playersNum) <- io $ room'sM rnc (\r -> (gameinprogress r, playersIn r)) ri
     ready <- client's isReady
     master <- client's isMaster
-    client <- client's id
+--    client <- client's id
+    clNick <- client's nick
+    chans <- othersChans
 
     if master then
-        processAction RemoveRoom
+        if gameProgress && playersNum > 1 then
+            mapM_ processAction [ChangeMaster, AnswerClients chans ["LEFT", clNick, msg], NoticeMessage AdminLeft, RemoveClientTeams ci]
+            else
+            processAction RemoveRoom
         else
-        do
-        clNick <- client's nick
-        clChan <- client's sendChan
-        chans <- othersChans
         mapM_ processAction [AnswerClients chans ["LEFT", clNick, msg], RemoveClientTeams ci]
 
     io $ do
@@ -200,54 +202,17 @@
                     }) ri
             moveClientToLobby rnc ci
 
-{-
-    (_, _, newClients, newRooms) <-
-            if isMaster client then
-                if (gameinprogress room) && (playersIn room > 1) then
-                    (changeMaster >>= (\state -> foldM processAction state
-                        [AnswerOthersInRoom ["LEFT", nick client, msg],
-                        AnswerOthersInRoom ["WARNING", "Admin left the room"],
-                        RemoveClientTeams clID]))
-                else -- not in game
-                    processAction (clID, serverInfo, rnc) RemoveRoom
-            else -- not master
-                foldM
-                    processAction
-                        (clID, serverInfo, rnc)
-                        [AnswerOthersInRoom ["LEFT", nick client, msg],
-                        RemoveClientTeams clID]
-
-
-    return (
-        clID,
-        serverInfo,
-        adjust resetClientFlags clID newClients,
-        adjust removeClientFromRoom rID $ adjust insertClientToRoom 0 newRooms
-        )
-    where
-        rID = roomID client
-        client = clients ! clID
-        room = rooms ! rID
-        resetClientFlags cl = cl{roomID = 0, isMaster = False, isReady = False, teamsInGame = undefined}
-        removeClientFromRoom r = r{
-                playersIDs = otherPlayersSet,
-                playersIn = (playersIn r) - 1,
-                readyPlayers = if isReady client then (readyPlayers r) - 1 else readyPlayers r
-                }
-        insertClientToRoom r = r{playersIDs = IntSet.insert clID (playersIDs r)}
-        changeMaster = do
-            processAction (newMasterId, serverInfo, rnc) $ AnswerThisClient ["ROOM_CONTROL_ACCESS", "1"]
-            return (
-                clID,
-                serverInfo,
-                adjust (\cl -> cl{isMaster = True}) newMasterId clients,
-                adjust (\r -> r{masterID = newMasterId, name = newRoomName}) rID rooms
-                )
-        newRoomName = nick newMasterClient
-        otherPlayersSet = IntSet.delete clID (playersIDs room)
-        newMasterId = IntSet.findMin otherPlayersSet
-        newMasterClient = clients ! newMasterId
--}
+processAction ChangeMaster = do
+    ri <- clientRoomA
+    rnc <- gets roomsClients
+    newMasterId <- liftM head . io $ roomClientsIndicesM rnc ri
+    newMaster <- io $ client'sM rnc id newMasterId
+    let newRoomName = nick newMaster
+    mapM_ processAction [
+        ModifyRoom (\r -> r{masterID = newMasterId, name = newRoomName}),
+        ModifyClient2 newMasterId (\c -> c{isMaster = True}),
+        AnswerClients [sendChan newMaster] ["ROOM_CONTROL_ACCESS", "1"]
+        ]
 
 processAction (AddRoom roomName roomPassword) = do
     Just clId <- gets clientIndex
--- a/gameServer/CoreTypes.hs	Sun Jan 30 20:43:18 2011 +0300
+++ b/gameServer/CoreTypes.hs	Mon Jan 31 21:40:17 2011 +0300
@@ -183,5 +183,7 @@
 type MRnC = MRoomsAndClients RoomInfo ClientInfo
 type IRnC = IRoomsAndClients RoomInfo ClientInfo
 
-data Notice = NickAlreadyInUse
+data Notice =
+    NickAlreadyInUse
+    | AdminLeft
     deriving Enum
\ No newline at end of file
--- a/gameServer/ServerState.hs	Sun Jan 30 20:43:18 2011 +0300
+++ b/gameServer/ServerState.hs	Mon Jan 31 21:40:17 2011 +0300
@@ -27,13 +27,13 @@
 clientRoomA = do
     (Just ci) <- gets clientIndex
     rnc <- gets roomsClients
-    liftIO $ clientRoomM rnc ci
+    io $ clientRoomM rnc ci
 
 client's :: (ClientInfo -> a) -> StateT ServerState IO a
 client's f = do
     (Just ci) <- gets clientIndex
     rnc <- gets roomsClients
-    liftIO $ client'sM rnc f ci
+    io $ client'sM rnc f ci
 
 allClientsS :: StateT ServerState IO [ClientInfo]
 allClientsS = gets roomsClients >>= liftIO . clientsM
@@ -41,7 +41,7 @@
 roomClientsS :: RoomIndex -> StateT ServerState IO [ClientInfo]
 roomClientsS ri = do
     rnc <- gets roomsClients
-    liftIO $ roomClientsM rnc ri
+    io $ roomClientsM rnc ri
 
 io :: IO a -> StateT ServerState IO a
 io = liftIO