diff -r 87ee1be17d27 -r f85243bf890e gameServer/ServerCore.hs
--- a/gameServer/ServerCore.hs	Sun Dec 19 20:45:15 2010 +0300
+++ b/gameServer/ServerCore.hs	Sun Dec 19 13:31:55 2010 -0500
@@ -2,75 +2,69 @@
 
 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 CoreTypes
 import NetRoutines
+import Utils
 import HWProtoCore
 import Actions
 import OfficialServer.DBInteraction
-import ServerState
-
-
-timerLoop :: Int -> Chan CoreMessage -> IO ()
-timerLoop tick messagesChan = threadDelay (30 * 10^6) >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan
 
 
-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 processAction
+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
 
-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)
+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)
 
-            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)
+            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)
 
-                --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 (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 ->
+                liftM firstAway $
+                    foldM processAction (0, serverInfo, clients, rooms) $
+                        PingAll : [StatsAction | even tick]
+
 
-        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
@@ -80,15 +74,14 @@
         acceptLoop
             serverSocket
             (coreChan serverInfo)
+            0
 
     return ()
-
-    --forkIO $ timerLoop 0 $ coreChan serverInfo
+    
+    forkIO $ timerLoop 0 $ coreChan serverInfo
 
     startDBConnection serverInfo
 
-    rnc <- newRoomsAndClients newRoom
+    forkIO $ mainLoop serverInfo IntMap.empty (IntMap.singleton 0 newRoom)
 
-    forkIO $ evalStateT mainLoop (ServerState Nothing serverInfo Set.empty rnc)
-
-    forever $ threadDelay (60 * 60 * 10^6)
+    forever $ threadDelay (60 * 60 * 10^6) >> putStrLn "***"
\ No newline at end of file