gameServer/ServerCore.hs
changeset 3435 4e4f88a7bdf2
parent 3425 ead2ed20dfd4
child 3451 62089ccec75c
--- 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 "***"