17 |
17 |
18 |
18 |
19 firstAway (_, a, b, c) = (a, b, c) |
19 firstAway (_, a, b, c) = (a, b, c) |
20 |
20 |
21 reactCmd :: ServerInfo -> Int -> [String] -> Clients -> Rooms -> IO (ServerInfo, Clients, Rooms) |
21 reactCmd :: ServerInfo -> Int -> [String] -> Clients -> Rooms -> IO (ServerInfo, Clients, Rooms) |
22 reactCmd serverInfo clID cmd clients rooms = do |
22 reactCmd serverInfo clID cmd clients rooms = |
23 (_ , serverInfo, clients, rooms) <- |
23 liftM firstAway $ foldM processAction (clID, serverInfo, clients, rooms) $ handleCmd clID clients rooms cmd |
24 foldM processAction (clID, serverInfo, clients, rooms) $ handleCmd clID clients rooms cmd |
|
25 return (serverInfo, clients, rooms) |
|
26 |
24 |
27 mainLoop :: ServerInfo -> Clients -> Rooms -> IO () |
25 mainLoop :: ServerInfo -> Clients -> Rooms -> IO () |
28 mainLoop serverInfo clients rooms = do |
26 mainLoop serverInfo clients rooms = do |
29 r <- readChan $ coreChan serverInfo |
27 r <- readChan $ coreChan serverInfo |
30 |
28 |
31 (newServerInfo, mClients, mRooms) <- |
29 (newServerInfo, mClients, mRooms) <- |
32 case r of |
30 case r of |
33 Accept ci -> do |
31 Accept ci -> do |
34 let updatedClients = IntMap.insert (clientUID ci) ci clients |
32 let updatedClients = IntMap.insert (clientUID ci) ci clients |
35 infoM "Clients" ("New client: id " ++ (show $ clientUID ci)) |
33 infoM "Clients" ("New client: id " ++ (show $ clientUID ci)) |
36 processAction |
34 liftM firstAway $ processAction |
37 (clientUID ci, serverInfo, updatedClients, rooms) |
35 (clientUID ci, serverInfo, updatedClients, rooms) |
38 (AnswerThisClient ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"]) |
36 (AnswerThisClient ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"]) |
39 return (serverInfo, updatedClients, rooms) |
|
40 |
37 |
41 ClientMessage (clID, cmd) -> do |
38 ClientMessage (clID, cmd) -> do |
42 debugM "Clients" $ (show clID) ++ ": " ++ (show cmd) |
39 debugM "Clients" $ (show clID) ++ ": " ++ (show cmd) |
43 if clID `IntMap.member` clients then |
40 if clID `IntMap.member` clients then |
44 reactCmd serverInfo clID cmd clients rooms |
41 reactCmd serverInfo clID cmd clients rooms |