diff -r 21dd1def5aaf -r 0eab727d4717 gameServer/ServerCore.hs
--- a/gameServer/ServerCore.hs	Wed Feb 02 09:05:48 2011 +0100
+++ b/gameServer/ServerCore.hs	Wed Feb 02 11:28:38 2011 +0300
@@ -2,86 +2,92 @@
 
 import Network
 import Control.Concurrent
-import Control.Concurrent.STM
-import Control.Concurrent.Chan
 import Control.Monad
-import qualified Data.IntMap as IntMap
 import System.Log.Logger
+import Control.Monad.Reader
+import Control.Monad.State.Strict
+import Data.Set as Set
+import qualified Data.ByteString.Char8 as B
+import Control.DeepSeq
 --------------------------------------
 import CoreTypes
 import NetRoutines
-import Utils
 import HWProtoCore
 import Actions
 import OfficialServer.DBInteraction
+import ServerState
+
+
+timerLoop :: Int -> Chan CoreMessage -> IO ()
+timerLoop tick messagesChan = threadDelay 30000000 >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan
 
 
-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 :: [B.ByteString] -> StateT ServerState IO ()
+reactCmd cmd = do
+    (Just ci) <- gets clientIndex
+    rnc <- gets roomsClients
+    actions <- liftIO $ withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc))
+    forM_ (actions `deepseq` actions) processAction
 
-mainLoop :: ServerInfo -> Clients -> Rooms -> IO ()
-mainLoop serverInfo clients rooms = do
-    r <- readChan $ coreChan serverInfo
-    
-    (newServerInfo, mClients, mRooms) <-
-        case r of
-            Accept ci ->
-                liftM firstAway $ processAction
-                    (clientUID ci, serverInfo, clients, rooms) (AddClient ci)
+mainLoop :: StateT ServerState IO ()
+mainLoop = forever $ do
+    get >>= \s -> put $! s
+
+    si <- gets serverInfo
+    r <- liftIO $ readChan $ coreChan si
+
+    case r of
+        Accept ci -> processAction (AddClient ci)
+
+        ClientMessage (ci, cmd) -> do
+            liftIO $ debugM "Clients" $ (show ci) ++ ": " ++ (show cmd)
 
-            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)
+            removed <- gets removedClients
+            when (not $ ci `Set.member` removed) $ do
+                as <- get
+                put $! as{clientIndex = Just ci}
+                reactCmd cmd
+
+        Remove ci -> do
+            liftIO $ debugM "Clients"  $ "DeleteClient: " ++ show ci
+            processAction (DeleteClient ci)
 
-            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)
+                --else
+                --do
+                --debugM "Clients" "Message from dead client"
+                --return (serverInfo, rnc)
 
-            TimerAction tick ->
-                liftM firstAway $
-                    foldM processAction (0, serverInfo, clients, rooms) $
-                        PingAll : [StatsAction | even tick]
+        ClientAccountInfo (ci, info) -> do
+            rnc <- gets roomsClients
+            exists <- liftIO $ clientExists rnc ci
+            when (exists) $ do
+                as <- get
+                put $! as{clientIndex = Just ci}
+                processAction (ProcessAccountInfo info)
+                return ()
+
+        TimerAction tick ->
+                mapM_ processAction $
+                    PingAll : [StatsAction | even tick]
 
 
-    {-          let hadRooms = (not $ null rooms) && (null mrooms)
-                    in unless ((not $ isDedicated serverInfo) && ((null clientsIn) || hadRooms)) $
-                        mainLoop serverInfo acceptChan messagesChan clientsIn mrooms -}
-
-    mainLoop newServerInfo mClients mRooms
-
 startServer :: ServerInfo -> Socket -> IO ()
-startServer serverInfo serverSocket = do
-    putStrLn $ "Listening on port " ++ show (listenPort serverInfo)
+startServer si serverSocket = do
+    putStrLn $ "Listening on port " ++ show (listenPort si)
 
     forkIO $
         acceptLoop
             serverSocket
-            (coreChan serverInfo)
-            0
+            (coreChan si)
 
     return ()
-    
-    forkIO $ timerLoop 0 $ coreChan serverInfo
+
+    forkIO $ timerLoop 0 $ coreChan si
+
+    startDBConnection si
 
-    startDBConnection serverInfo
+    rnc <- newRoomsAndClients newRoom
 
-    forkIO $ mainLoop serverInfo IntMap.empty (IntMap.singleton 0 newRoom)
+    forkIO $ evalStateT mainLoop (ServerState Nothing si Set.empty rnc)
 
-    forever $ threadDelay (60 * 60 * 10^6) >> putStrLn "***"
\ No newline at end of file
+    forever $ threadDelay 3600000000 -- one hour