diff -r 3d4692e825e7 -r cfe1481e0247 gameServer/Actions.hs --- a/gameServer/Actions.hs Fri Feb 20 14:12:16 2009 +0000 +++ b/gameServer/Actions.hs Fri Feb 20 19:40:55 2009 +0000 @@ -4,9 +4,11 @@ import Control.Concurrent.Chan import Data.IntMap import qualified Data.IntSet as IntSet +import qualified Data.Sequence as Seq import Monad ----------------------------- import CoreTypes +import Utils data Action = AnswerThisClient [String] @@ -17,6 +19,7 @@ | AnswerLobby [String] | RoomAddThisClient Int -- roomID | RoomRemoveThisClient + | RemoveTeam String | RemoveRoom | UnreadyRoomClients | ProtocolError String @@ -192,6 +195,7 @@ rID = roomID client client = clients ! clID + processAction (clID, serverInfo, clients, rooms) (UnreadyRoomClients) = do processAction (clID, serverInfo, clients, rooms) $ AnswerThisRoom ("NOT_READY" : roomPlayers) return (clID, @@ -206,6 +210,29 @@ roomPlayersIDs = IntSet.elems $ playersIDs room +processAction (clID, serverInfo, clients, rooms) (RemoveTeam teamName) = do + newRooms <- if not $ gameinprogress room then + do + processAction (clID, serverInfo, clients, rooms) $ AnswerOthersInRoom ["REMOVE_TEAM", teamName] + return $ + adjust (\r -> r{teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r}) rID rooms + else + do + processAction (clID, serverInfo, clients, rooms) $ AnswerOthersInRoom ["GAMEMSG", 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) + where + room = rooms ! rID + rID = roomID client + client = clients ! clID + rmTeamMsg = toEngineMsg $ 'F' : teamName + + processAction (clID, serverInfo, clients, rooms) (Dump) = do writeChan (sendChan $ clients ! clID) ["DUMP", show serverInfo, showTree clients, showTree rooms] return (clID, serverInfo, clients, rooms)