# HG changeset patch # User unc0rr # Date 1296499217 -10800 # Node ID 8bdc879ee6b2b63212c105fc6304b023211b2762 # Parent 6122a43d3424aeabf6a178bfb2bffa8d30f6082c Implement room delegation when admin lefts it diff -r 6122a43d3424 -r 8bdc879ee6b2 gameServer/Actions.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 diff -r 6122a43d3424 -r 8bdc879ee6b2 gameServer/CoreTypes.hs --- 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 diff -r 6122a43d3424 -r 8bdc879ee6b2 gameServer/ServerState.hs --- 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