--- a/gameServer/ServerCore.hs Thu Feb 25 15:58:44 2010 +0000
+++ b/gameServer/ServerCore.hs Thu Feb 25 18:28:33 2010 +0000
@@ -23,65 +23,65 @@
reactCmd :: ServerInfo -> Int -> [String] -> Clients -> Rooms -> IO (ServerInfo, Clients, Rooms)
reactCmd serverInfo clID cmd clients rooms =
- liftM firstAway $ foldM processAction (clID, serverInfo, clients, rooms) $ handleCmd clID clients rooms cmd
+ liftM firstAway $ foldM processAction (clID, serverInfo, clients, rooms) $ handleCmd clID clients rooms cmd
mainLoop :: ServerInfo -> Clients -> Rooms -> IO ()
mainLoop serverInfo clients rooms = do
- r <- readChan $ coreChan serverInfo
-
- (newServerInfo, mClients, mRooms) <-
- case r of
- Accept ci ->
- liftM firstAway $ processAction
- (clientUID ci, serverInfo, clients, rooms) (AddClient ci)
+ r <- readChan $ coreChan serverInfo
+
+ (newServerInfo, mClients, mRooms) <-
+ case r of
+ Accept ci ->
+ liftM firstAway $ processAction
+ (clientUID ci, serverInfo, clients, rooms) (AddClient ci)
- ClientMessage (clID, cmd) -> do
- debugM "Clients" $ (show clID) ++ ": " ++ (show cmd)
- if clID `IntMap.member` clients then
- reactCmd serverInfo clID cmd clients rooms
- else
- do
- debugM "Clients" "Message from dead client"
- return (serverInfo, clients, rooms)
+ ClientMessage (clID, cmd) -> do
+ debugM "Clients" $ (show clID) ++ ": " ++ (show cmd)
+ if clID `IntMap.member` clients then
+ reactCmd serverInfo clID cmd clients rooms
+ else
+ do
+ 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)
+ 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)
- TimerAction tick ->
- liftM firstAway $
- foldM processAction (0, serverInfo, clients, rooms) $
- PingAll : [StatsAction | even tick]
+ TimerAction tick ->
+ liftM firstAway $
+ foldM processAction (0, serverInfo, clients, rooms) $
+ PingAll : [StatsAction | even tick]
- {- let hadRooms = (not $ null rooms) && (null mrooms)
- in unless ((not $ isDedicated serverInfo) && ((null clientsIn) || hadRooms)) $
- mainLoop serverInfo acceptChan messagesChan clientsIn mrooms -}
+ {- let hadRooms = (not $ null rooms) && (null mrooms)
+ in unless ((not $ isDedicated serverInfo) && ((null clientsIn) || hadRooms)) $
+ mainLoop serverInfo acceptChan messagesChan clientsIn mrooms -}
- mainLoop newServerInfo mClients mRooms
+ mainLoop newServerInfo mClients mRooms
startServer :: ServerInfo -> Socket -> IO ()
startServer serverInfo serverSocket = do
- putStrLn $ "Listening on port " ++ show (listenPort serverInfo)
+ putStrLn $ "Listening on port " ++ show (listenPort serverInfo)
- forkIO $
- acceptLoop
- serverSocket
- (coreChan serverInfo)
- 0
+ forkIO $
+ acceptLoop
+ serverSocket
+ (coreChan serverInfo)
+ 0
- return ()
-
- forkIO $ timerLoop 0 $ coreChan serverInfo
+ return ()
+
+ forkIO $ timerLoop 0 $ coreChan serverInfo
- startDBConnection serverInfo
+ startDBConnection serverInfo
- forkIO $ mainLoop serverInfo IntMap.empty (IntMap.singleton 0 newRoom)
+ forkIO $ mainLoop serverInfo IntMap.empty (IntMap.singleton 0 newRoom)
- forever $ threadDelay (60 * 60 * 10^6) >> putStrLn "***"
\ No newline at end of file
+ forever $ threadDelay (60 * 60 * 10^6) >> putStrLn "***"
\ No newline at end of file