# HG changeset patch # User unc0rr # Date 1279395882 -14400 # Node ID c0b3f1bb9316ea5e9994fac9eeb1a83f423e6953 # Parent 42c5684289ae58e0094bbf99ceb59f3a356ea55e Reimplement REMOVE_TEAM diff -r 42c5684289ae -r c0b3f1bb9316 gameServer/Actions.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 diff -r 42c5684289ae -r c0b3f1bb9316 gameServer/HWProtoLobbyState.hs --- 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 diff -r 42c5684289ae -r c0b3f1bb9316 gameServer/RoomsAndClients.hs --- 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) diff -r 42c5684289ae -r c0b3f1bb9316 gameServer/ServerState.hs --- 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