equal
deleted
inserted
replaced
15 import Actions |
15 import Actions |
16 import OfficialServer.DBInteraction |
16 import OfficialServer.DBInteraction |
17 |
17 |
18 |
18 |
19 timerLoop :: Int -> Chan CoreMessage -> IO() |
19 timerLoop :: Int -> Chan CoreMessage -> IO() |
20 timerLoop tick messagesChan = threadDelay (30 * 10^6) >> (writeChan messagesChan $ TimerAction tick) >> timerLoop (tick + 1) messagesChan |
20 timerLoop tick messagesChan = threadDelay (30 * 10^6) >> writeChan messagesChan (TimerAction tick) >> timerLoop (tick + 1) messagesChan |
21 |
21 |
22 firstAway (_, a, b, c) = (a, b, c) |
22 firstAway (_, a, b, c) = (a, b, c) |
23 |
23 |
24 reactCmd :: ServerInfo -> Int -> [String] -> Clients -> Rooms -> IO (ServerInfo, Clients, Rooms) |
24 reactCmd :: ServerInfo -> Int -> [String] -> Clients -> Rooms -> IO (ServerInfo, Clients, Rooms) |
25 reactCmd serverInfo clID cmd clients rooms = |
25 reactCmd serverInfo clID cmd clients rooms = |
29 mainLoop serverInfo clients rooms = do |
29 mainLoop serverInfo clients rooms = do |
30 r <- readChan $ coreChan serverInfo |
30 r <- readChan $ coreChan serverInfo |
31 |
31 |
32 (newServerInfo, mClients, mRooms) <- |
32 (newServerInfo, mClients, mRooms) <- |
33 case r of |
33 case r of |
34 Accept ci -> do |
34 Accept ci -> |
35 liftM firstAway $ processAction |
35 liftM firstAway $ processAction |
36 (clientUID ci, serverInfo, clients, rooms) (AddClient ci) |
36 (clientUID ci, serverInfo, clients, rooms) (AddClient ci) |
37 |
37 |
38 ClientMessage (clID, cmd) -> do |
38 ClientMessage (clID, cmd) -> do |
39 debugM "Clients" $ (show clID) ++ ": " ++ (show cmd) |
39 debugM "Clients" $ (show clID) ++ ": " ++ (show cmd) |
55 return (serverInfo, clients, rooms) |
55 return (serverInfo, clients, rooms) |
56 |
56 |
57 TimerAction tick -> |
57 TimerAction tick -> |
58 liftM firstAway $ |
58 liftM firstAway $ |
59 foldM processAction (0, serverInfo, clients, rooms) $ |
59 foldM processAction (0, serverInfo, clients, rooms) $ |
60 PingAll : if even tick then [StatsAction] else [] |
60 PingAll : [StatsAction | even tick] |
61 |
61 |
62 |
62 |
63 {- let hadRooms = (not $ null rooms) && (null mrooms) |
63 {- let hadRooms = (not $ null rooms) && (null mrooms) |
64 in unless ((not $ isDedicated serverInfo) && ((null clientsIn) || hadRooms)) $ |
64 in unless ((not $ isDedicated serverInfo) && ((null clientsIn) || hadRooms)) $ |
65 mainLoop serverInfo acceptChan messagesChan clientsIn mrooms -} |
65 mainLoop serverInfo acceptChan messagesChan clientsIn mrooms -} |
78 |
78 |
79 return () |
79 return () |
80 |
80 |
81 forkIO $ timerLoop 0 $ coreChan serverInfo |
81 forkIO $ timerLoop 0 $ coreChan serverInfo |
82 |
82 |
83 startDBConnection $ serverInfo |
83 startDBConnection serverInfo |
84 |
84 |
85 forkIO $ mainLoop serverInfo IntMap.empty (IntMap.singleton 0 newRoom) |
85 forkIO $ mainLoop serverInfo IntMap.empty (IntMap.singleton 0 newRoom) |
86 |
86 |
87 forever $ threadDelay (60 * 60 * 10^6) >> putStrLn "***" |
87 forever $ threadDelay (60 * 60 * 10^6) >> putStrLn "***" |