--- 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)
-}
-
+
{-