13 import Utils |
13 import Utils |
14 import HWProtoCore |
14 import HWProtoCore |
15 import Actions |
15 import Actions |
16 import OfficialServer.DBInteraction |
16 import OfficialServer.DBInteraction |
17 |
17 |
|
18 |
|
19 timerLoop :: Chan CoreMessage -> IO() |
|
20 timerLoop messagesChan = forever $ do |
|
21 threadDelay (30 * 10^6) -- 30 seconds |
|
22 writeChan messagesChan TimerAction |
18 |
23 |
19 firstAway (_, a, b, c) = (a, b, c) |
24 firstAway (_, a, b, c) = (a, b, c) |
20 |
25 |
21 reactCmd :: ServerInfo -> Int -> [String] -> Clients -> Rooms -> IO (ServerInfo, Clients, Rooms) |
26 reactCmd :: ServerInfo -> Int -> [String] -> Clients -> Rooms -> IO (ServerInfo, Clients, Rooms) |
22 reactCmd serverInfo clID cmd clients rooms = |
27 reactCmd serverInfo clID cmd clients rooms = |
48 (ProcessAccountInfo info) |
53 (ProcessAccountInfo info) |
49 else |
54 else |
50 do |
55 do |
51 debugM "Clients" "Got info for dead client" |
56 debugM "Clients" "Got info for dead client" |
52 return (serverInfo, clients, rooms) |
57 return (serverInfo, clients, rooms) |
|
58 |
|
59 TimerAction -> |
|
60 liftM firstAway $ processAction |
|
61 (0, serverInfo, clients, rooms) |
|
62 PingAll |
53 |
63 |
54 |
64 |
55 {- let hadRooms = (not $ null rooms) && (null mrooms) |
65 {- let hadRooms = (not $ null rooms) && (null mrooms) |
56 in unless ((not $ isDedicated serverInfo) && ((null clientsIn) || hadRooms)) $ |
66 in unless ((not $ isDedicated serverInfo) && ((null clientsIn) || hadRooms)) $ |
57 mainLoop serverInfo acceptChan messagesChan clientsIn mrooms -} |
67 mainLoop serverInfo acceptChan messagesChan clientsIn mrooms -} |
58 |
68 |
59 mainLoop newServerInfo mClients mRooms |
69 mainLoop newServerInfo mClients mRooms |
60 |
70 |
61 startServer :: ServerInfo -> Chan CoreMessage -> Socket -> IO () |
71 startServer :: ServerInfo -> Socket -> IO () |
62 startServer serverInfo coreChan serverSocket = do |
72 startServer serverInfo serverSocket = do |
63 putStrLn $ "Listening on port " ++ show (listenPort serverInfo) |
73 putStrLn $ "Listening on port " ++ show (listenPort serverInfo) |
64 |
74 |
65 forkIO $ |
75 forkIO $ |
66 acceptLoop |
76 acceptLoop |
67 serverSocket |
77 serverSocket |
68 coreChan |
78 (coreChan serverInfo) |
69 0 |
79 0 |
70 |
80 |
71 return () |
81 return () |
72 |
82 |
73 {- forkIO $ messagesLoop messagesChan |
83 forkIO $ timerLoop $ coreChan serverInfo |
74 forkIO $ timerLoop messagesChan-} |
|
75 |
84 |
76 startDBConnection $ serverInfo |
85 startDBConnection $ serverInfo |
77 |
86 |
78 mainLoop serverInfo IntMap.empty (IntMap.singleton 0 newRoom) |
87 mainLoop serverInfo IntMap.empty (IntMap.singleton 0 newRoom) |