--- a/gameServer/ServerCore.hs Thu May 06 15:26:14 2010 +0000
+++ b/gameServer/ServerCore.hs Thu May 06 17:39:08 2010 +0000
@@ -6,58 +6,61 @@
import Control.Monad
import qualified Data.IntMap as IntMap
import System.Log.Logger
+import Control.Monad.Reader
--------------------------------------
import CoreTypes
import NetRoutines
import HWProtoCore
import Actions
import OfficialServer.DBInteraction
+import RoomsAndClients
timerLoop :: Int -> Chan CoreMessage -> IO()
timerLoop tick messagesChan = threadDelay (30 * 10^6) >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan
-firstAway (_, a, b, c) = (a, b, c)
-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
+reactCmd :: ServerInfo -> ClientIndex -> [String] -> MRnC -> IO ()
+reactCmd sInfo ci cmd rnc = do
+ actions <- withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc))
+ forM_ actions (processAction (ci, sInfo, rnc))
-mainLoop :: ServerInfo -> Clients -> Rooms -> IO ()
-mainLoop serverInfo clients rooms = do
+mainLoop :: ServerInfo -> MRnC -> IO ()
+mainLoop serverInfo rnc = forever $ do
r <- readChan $ coreChan serverInfo
- (newServerInfo, mClients, mRooms) <-
- case r of
- Accept ci ->
- liftM firstAway $ processAction
- (clientUID ci, serverInfo, clients, rooms) (AddClient ci)
+ case r of
+ Accept ci -> do
+ processAction
+ (undefined, serverInfo, rnc) (AddClient ci)
+ return ()
- 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 rnc
+ return ()
+ --else
+ --do
+ --debugM "Clients" "Message from dead client"
+ --return (serverInfo, rnc)
- 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) -> do
+ --if clID `IntMap.member` clients then
+ processAction
+ (clID, serverInfo, rnc)
+ (ProcessAccountInfo info)
+ return ()
+ --else
+ --do
+ --debugM "Clients" "Got info for dead client"
+ --return (serverInfo, rnc)
- TimerAction tick ->
- liftM firstAway $
- foldM processAction (0, serverInfo, clients, rooms) $
- PingAll : [StatsAction | even tick]
-
- mainLoop newServerInfo mClients mRooms
+ TimerAction tick ->
+ return ()
+ --liftM snd $
+ -- foldM processAction (0, serverInfo, rnc) $
+ -- PingAll : [StatsAction | even tick]
startServer :: ServerInfo -> Socket -> IO ()
startServer serverInfo serverSocket = do
@@ -67,14 +70,15 @@
acceptLoop
serverSocket
(coreChan serverInfo)
- 0
return ()
-
+
forkIO $ timerLoop 0 $ coreChan serverInfo
startDBConnection serverInfo
- forkIO $ mainLoop serverInfo IntMap.empty (IntMap.singleton 0 newRoom)
+ rnc <- newRoomsAndClients newRoom
+
+ forkIO $ mainLoop serverInfo rnc
forever $ threadDelay (60 * 60 * 10^6) >> putStrLn "***"