diff -r 2c29b75746f3 -r 11cd56019f00 gameServer/Actions.hs --- a/gameServer/Actions.hs Mon May 10 15:31:09 2010 +0000 +++ b/gameServer/Actions.hs Mon May 10 17:48:06 2010 +0000 @@ -1,3 +1,4 @@ + module Actions where import Control.Concurrent @@ -15,13 +16,13 @@ import CoreTypes import Utils import ClientIO -import RoomsAndClients +import ServerState data Action = AnswerClients [ClientChan] [String] | SendServerMessage | SendServerVars - | RoomAddThisClient Int -- roomID + | RoomAddThisClient RoomIndex -- roomID | RoomRemoveThisClient String | RemoveTeam String | RemoveRoom @@ -30,12 +31,12 @@ | ProtocolError String | Warning String | ByeClient String - | KickClient Int -- clID - | KickRoomClient Int -- clID + | KickClient ClientIndex -- clID + | KickRoomClient ClientIndex -- clID | BanClient String -- nick - | RemoveClientTeams Int -- clID + | RemoveClientTeams ClientIndex -- clID | ModifyClient (ClientInfo -> ClientInfo) - | ModifyClient2 Int (ClientInfo -> ClientInfo) + | ModifyClient2 ClientIndex (ClientInfo -> ClientInfo) | ModifyRoom (RoomInfo -> RoomInfo) | ModifyServerInfo (ServerInfo -> ServerInfo) | AddRoom String String @@ -49,21 +50,8 @@ type CmdHandler = [String] -> Reader (ClientIndex, IRnC) [Action] -data ActionsState = ActionsState { - clientIndex :: Maybe ClientIndex, - serverInfo :: ServerInfo, - roomsClients :: MRnC - } - -clientRoomA :: StateT ActionsState IO RoomIndex -clientRoomA = do - (Just ci) <- gets clientIndex - rnc <- gets roomsClients - liftIO $ clientRoomM rnc ci -replaceID a (b, c, d, e) = (a, c, d, e) - -processAction :: Action -> StateT ActionsState IO () +processAction :: Action -> StateT ServerState IO () processAction (AnswerClients chans msg) = @@ -111,11 +99,12 @@ processAction $ RoomRemoveThisClient ("quit: " ++ msg) return () + chan <- clients sendChan + liftIO $ do infoM "Clients" (show ci ++ " quits: " ++ msg) - chan <- withRoomsAndClients rnc (getChan ci) - + --mapM_ (processAction (ci, serverInfo, rnc)) $ answerOthersQuit ++ answerInformRoom writeChan chan ["BYE", msg] modifyRoom rnc (\r -> r{ @@ -123,10 +112,6 @@ playersIn = (playersIn r) - 1 --readyPlayers = if isReady client then readyPlayers r - 1 else readyPlayers r }) ri - removeClient rnc ci - where - getChan ci irnc = let cl = irnc `client` ci in (sendChan cl) - {- where @@ -149,21 +134,21 @@ else [] -} -{- -processAction (clID, serverInfo, rnc) (ModifyClient func) = - return (clID, serverInfo, adjust func clID rnc) - +processAction (ModifyClient f) = do + (Just ci) <- gets clientIndex + rnc <- gets roomsClients + liftIO $ modifyClient rnc f ci + return () + -processAction (clID, serverInfo, rnc) (ModifyClient2 cl2ID func) = - return (clID, serverInfo, adjust func cl2ID rnc) - +processAction (ModifyRoom f) = do + rnc <- gets roomsClients + ri <- clientRoomA + liftIO $ modifyRoom rnc f ri + return () -processAction (clID, serverInfo, rnc) (ModifyRoom func) = - return (clID, serverInfo, clients, adjust func rID rooms) - where - rID = roomID $ clients ! clID - +{- processAction (clID, serverInfo, rnc) (ModifyServerInfo func) = return (clID, func serverInfo, rnc) @@ -308,15 +293,17 @@ rID = roomID client client = clients ! clID rmTeamMsg = toEngineMsg $ 'F' : teamName - +-} -processAction (clID, serverInfo, rnc) (CheckRegistered) = do - writeChan (dbQueries serverInfo) $ CheckAccount (clientUID client) (nick client) (host client) - return (clID, serverInfo, rnc) - where - client = clients ! clID +processAction CheckRegistered = do + (Just ci) <- gets clientIndex + n <- clients nick + h <- clients host + db <- gets (dbQueries . serverInfo) + liftIO $ writeChan db $ CheckAccount ci n h + return () - +{- processAction (clID, serverInfo, rnc) (ClearAccountsCache) = do writeChan (dbQueries serverInfo) ClearCache return (clID, serverInfo, rnc) @@ -397,7 +384,7 @@ return (ci, serverInfo) -} - + {-