--- a/gameServer/CoreTypes.hs Fri Jun 19 17:55:42 2009 +0000
+++ b/gameServer/CoreTypes.hs Fri Jun 19 17:56:52 2009 +0000
@@ -160,7 +160,7 @@
Accept ClientInfo
| ClientMessage (Int, [String])
| ClientAccountInfo (Int, AccountInfo)
- | TimerAction
+ | TimerAction Int
type Clients = IntMap.IntMap ClientInfo
type Rooms = IntMap.IntMap RoomInfo
--- a/gameServer/ServerCore.hs Fri Jun 19 17:55:42 2009 +0000
+++ b/gameServer/ServerCore.hs Fri Jun 19 17:56:52 2009 +0000
@@ -16,10 +16,11 @@
import OfficialServer.DBInteraction
-timerLoop :: Chan CoreMessage -> IO()
-timerLoop messagesChan = forever $ do
+timerLoop :: Int -> Chan CoreMessage -> IO()
+timerLoop tick messagesChan = do
threadDelay (30 * 10^6) -- 30 seconds
- writeChan messagesChan TimerAction
+ writeChan messagesChan $ TimerAction tick
+ timerLoop (tick + 1) messagesChan
firstAway (_, a, b, c) = (a, b, c)
@@ -56,10 +57,10 @@
debugM "Clients" "Got info for dead client"
return (serverInfo, clients, rooms)
- TimerAction ->
+ TimerAction tick ->
liftM firstAway $
- foldM processAction (0, serverInfo, clients, rooms)
- [PingAll, StatsAction]
+ foldM processAction (0, serverInfo, clients, rooms) $
+ PingAll : if even tick then [StatsAction] else []
{- let hadRooms = (not $ null rooms) && (null mrooms)
@@ -80,7 +81,7 @@
return ()
- forkIO $ timerLoop $ coreChan serverInfo
+ forkIO $ timerLoop 0 $ coreChan serverInfo
startDBConnection $ serverInfo