gameServer/ServerCore.hs
changeset 3451 62089ccec75c
parent 3435 4e4f88a7bdf2
child 3458 11cd56019f00
--- a/gameServer/ServerCore.hs	Sat May 08 21:50:26 2010 +0000
+++ b/gameServer/ServerCore.hs	Sun May 09 17:53:08 2010 +0000
@@ -7,6 +7,7 @@
 import qualified Data.IntMap as IntMap
 import System.Log.Logger
 import Control.Monad.Reader
+import Control.Monad.State
 --------------------------------------
 import CoreTypes
 import NetRoutines
@@ -20,25 +21,28 @@
 timerLoop tick messagesChan = threadDelay (30 * 10^6) >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan
 
 
-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))
+reactCmd :: [String] -> StateT ActionsState IO ()
+reactCmd cmd = do
+    (Just ci) <- gets clientIndex
+    rnc <- gets roomsClients
+    actions <- liftIO $ withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc))
+    forM_ actions processAction
 
-mainLoop :: ServerInfo -> MRnC -> IO ()
-mainLoop serverInfo rnc = forever $ do
-    r <- readChan $ coreChan serverInfo
+mainLoop :: StateT ActionsState IO ()
+mainLoop = forever $ do
+    si <- gets serverInfo
+    r <- liftIO $ readChan $ coreChan si
 
     case r of
         Accept ci -> do
-            processAction
-                (undefined, serverInfo, rnc) (AddClient ci)
+            processAction (AddClient ci)
             return ()
 
-        ClientMessage (clID, cmd) -> do
-            debugM "Clients" $ (show clID) ++ ": " ++ (show cmd)
+        ClientMessage (ci, cmd) -> do
+            liftIO $ debugM "Clients" $ (show ci) ++ ": " ++ (show cmd)
+            modify (\as -> as{clientIndex = Just ci})
             --if clID `IntMap.member` clients then
-            reactCmd serverInfo clID cmd rnc
+            reactCmd cmd
             return ()
                 --else
                 --do
@@ -47,9 +51,7 @@
 
         ClientAccountInfo (clID, info) -> do
             --if clID `IntMap.member` clients then
-            processAction
-                (clID, serverInfo, rnc)
-                (ProcessAccountInfo info)
+            processAction (ProcessAccountInfo info)
             return ()
                 --else
                 --do
@@ -79,6 +81,6 @@
 
     rnc <- newRoomsAndClients newRoom
 
-    forkIO $ mainLoop serverInfo rnc
+    forkIO $ evalStateT mainLoop (ActionsState Nothing serverInfo rnc)
 
     forever $ threadDelay (60 * 60 * 10^6) >> putStrLn "***"