--- 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)