diff -r 00a5fc50aa43 -r 5dd4cb7fd7e5 gameServer/ServerCore.hs --- a/gameServer/ServerCore.hs Tue Feb 24 19:39:10 2009 +0000 +++ b/gameServer/ServerCore.hs Tue Feb 24 19:39:49 2009 +0000 @@ -15,21 +15,24 @@ import Actions import OfficialServer.DBInteraction + +firstAway (_, a, b, c) = (a, b, c) + reactCmd :: ServerInfo -> Int -> [String] -> Clients -> Rooms -> IO (ServerInfo, Clients, Rooms) reactCmd serverInfo clID cmd clients rooms = do (_ , serverInfo, clients, rooms) <- foldM processAction (clID, serverInfo, clients, rooms) $ handleCmd clID clients rooms cmd return (serverInfo, clients, rooms) -mainLoop :: Chan CoreMessage -> ServerInfo -> Clients -> Rooms -> IO () -mainLoop coreChan serverInfo clients rooms = do - r <- readChan coreChan +mainLoop :: ServerInfo -> Clients -> Rooms -> IO () +mainLoop serverInfo clients rooms = do + r <- readChan $ coreChan serverInfo (newServerInfo, mClients, mRooms) <- case r of Accept ci -> do let updatedClients = IntMap.insert (clientUID ci) ci clients - --infoM "Clients" ("New client: id " ++ (show $ clientUID ci)) + infoM "Clients" ("New client: id " ++ (show $ clientUID ci)) processAction (clientUID ci, serverInfo, updatedClients, rooms) (AnswerThisClient ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"]) @@ -44,11 +47,22 @@ debugM "Clients" "Message from dead client" return (serverInfo, clients, rooms) + ClientAccountInfo clID info -> + if clID `IntMap.member` clients then + liftM firstAway $ processAction + (clID, serverInfo, clients, rooms) + (ProcessAccountInfo info) + else + do + debugM "Clients" "Got info for dead client" + return (serverInfo, clients, rooms) + + {- let hadRooms = (not $ null rooms) && (null mrooms) in unless ((not $ isDedicated serverInfo) && ((null clientsIn) || hadRooms)) $ mainLoop serverInfo acceptChan messagesChan clientsIn mrooms -} - mainLoop coreChan newServerInfo mClients mRooms + mainLoop newServerInfo mClients mRooms startServer :: ServerInfo -> Chan CoreMessage -> Socket -> IO () startServer serverInfo coreChan serverSocket = do @@ -67,7 +81,7 @@ startDBConnection $ serverInfo - mainLoop coreChan serverInfo IntMap.empty (IntMap.singleton 0 newRoom) + mainLoop serverInfo IntMap.empty (IntMap.singleton 0 newRoom)