4 import Control.Monad |
4 import Control.Monad |
5 import System.Log.Logger |
5 import System.Log.Logger |
6 import Control.Monad.Reader |
6 import Control.Monad.Reader |
7 import Control.Monad.State.Strict |
7 import Control.Monad.State.Strict |
8 import Data.Set as Set |
8 import Data.Set as Set |
9 import qualified Data.ByteString.Char8 as B |
|
10 import Control.DeepSeq |
|
11 import Data.Unique |
9 import Data.Unique |
12 import Data.Maybe |
10 import Data.Maybe |
13 -------------------------------------- |
11 -------------------------------------- |
14 import CoreTypes |
12 import CoreTypes |
15 import NetRoutines |
13 import NetRoutines |
16 import HWProtoCore |
|
17 import Actions |
14 import Actions |
18 import OfficialServer.DBInteraction |
15 import OfficialServer.DBInteraction |
19 import ServerState |
16 import ServerState |
20 |
17 |
21 |
18 |
22 timerLoop :: Int -> Chan CoreMessage -> IO () |
19 timerLoop :: Int -> Chan CoreMessage -> IO () |
23 timerLoop tick messagesChan = threadDelay 30000000 >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan |
20 timerLoop tick messagesChan = threadDelay 30000000 >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan |
24 |
21 |
25 |
|
26 reactCmd :: [B.ByteString] -> StateT ServerState IO () |
|
27 reactCmd cmd = do |
|
28 (Just ci) <- gets clientIndex |
|
29 rnc <- gets roomsClients |
|
30 actions <- liftIO $ withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc)) |
|
31 forM_ (actions `deepseq` actions) processAction |
|
32 |
22 |
33 mainLoop :: StateT ServerState IO () |
23 mainLoop :: StateT ServerState IO () |
34 mainLoop = forever $ do |
24 mainLoop = forever $ do |
35 -- get >>= \s -> put $! s |
25 -- get >>= \s -> put $! s |
36 |
26 |
44 liftIO $ debugM "Clients" $ show ci ++ ": " ++ show cmd |
34 liftIO $ debugM "Clients" $ show ci ++ ": " ++ show cmd |
45 |
35 |
46 removed <- gets removedClients |
36 removed <- gets removedClients |
47 unless (ci `Set.member` removed) $ do |
37 unless (ci `Set.member` removed) $ do |
48 modify (\s -> s{clientIndex = Just ci}) |
38 modify (\s -> s{clientIndex = Just ci}) |
49 reactCmd cmd |
39 processAction $ ReactCmd cmd |
50 |
40 |
51 Remove ci -> |
41 Remove ci -> |
52 processAction (DeleteClient ci) |
42 processAction (DeleteClient ci) |
53 |
43 |
54 ClientAccountInfo ci uid info -> do |
44 ClientAccountInfo ci uid info -> do |