equal
deleted
inserted
replaced
1 module ServerCore where |
1 module ServerCore where |
2 |
2 |
3 import Network |
3 import Network |
4 import Control.Concurrent |
4 import Control.Concurrent |
5 import Control.Concurrent.Chan |
|
6 import Control.Monad |
5 import Control.Monad |
7 import qualified Data.IntMap as IntMap |
|
8 import System.Log.Logger |
6 import System.Log.Logger |
9 import Control.Monad.Reader |
7 import Control.Monad.Reader |
10 import Control.Monad.State.Strict |
8 import Control.Monad.State.Strict |
11 import Data.Set as Set |
9 import Data.Set as Set |
12 import qualified Data.ByteString.Char8 as B |
10 import qualified Data.ByteString.Char8 as B |
19 import OfficialServer.DBInteraction |
17 import OfficialServer.DBInteraction |
20 import ServerState |
18 import ServerState |
21 |
19 |
22 |
20 |
23 timerLoop :: Int -> Chan CoreMessage -> IO () |
21 timerLoop :: Int -> Chan CoreMessage -> IO () |
24 timerLoop tick messagesChan = threadDelay (30 * 10^6) >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan |
22 timerLoop tick messagesChan = threadDelay 30000000 >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan |
25 |
23 |
26 |
24 |
27 reactCmd :: [B.ByteString] -> StateT ServerState IO () |
25 reactCmd :: [B.ByteString] -> StateT ServerState IO () |
28 reactCmd cmd = do |
26 reactCmd cmd = do |
29 (Just ci) <- gets clientIndex |
27 (Just ci) <- gets clientIndex |
72 mapM_ processAction $ |
70 mapM_ processAction $ |
73 PingAll : [StatsAction | even tick] |
71 PingAll : [StatsAction | even tick] |
74 |
72 |
75 |
73 |
76 startServer :: ServerInfo -> Socket -> IO () |
74 startServer :: ServerInfo -> Socket -> IO () |
77 startServer serverInfo serverSocket = do |
75 startServer si serverSocket = do |
78 putStrLn $ "Listening on port " ++ show (listenPort serverInfo) |
76 putStrLn $ "Listening on port " ++ show (listenPort si) |
79 |
77 |
80 forkIO $ |
78 forkIO $ |
81 acceptLoop |
79 acceptLoop |
82 serverSocket |
80 serverSocket |
83 (coreChan serverInfo) |
81 (coreChan si) |
84 |
82 |
85 return () |
83 return () |
86 |
84 |
87 --forkIO $ timerLoop 0 $ coreChan serverInfo |
85 forkIO $ timerLoop 0 $ coreChan si |
88 |
86 |
89 startDBConnection serverInfo |
87 startDBConnection si |
90 |
88 |
91 rnc <- newRoomsAndClients newRoom |
89 rnc <- newRoomsAndClients newRoom |
92 |
90 |
93 forkIO $ evalStateT mainLoop (ServerState Nothing serverInfo Set.empty rnc) |
91 forkIO $ evalStateT mainLoop (ServerState Nothing si Set.empty rnc) |
94 |
92 |
95 forever $ threadDelay (60 * 60 * 10^6) |
93 forever $ threadDelay 3600000000 -- one hour |