--- 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 "***"