9 -------------------------------------- |
9 -------------------------------------- |
10 import CoreTypes |
10 import CoreTypes |
11 import Actions |
11 import Actions |
12 import Utils |
12 import Utils |
13 |
13 |
14 answerAllTeams teams = concatMap toAnswer teams |
14 answerAllTeams protocol teams = concatMap toAnswer teams |
15 where |
15 where |
16 toAnswer team = |
16 toAnswer team = |
17 [AnswerThisClient $ teamToNet team, |
17 [AnswerThisClient $ teamToNet protocol team, |
18 AnswerThisClient ["TEAM_COLOR", teamname team, teamcolor team], |
18 AnswerThisClient ["TEAM_COLOR", teamname team, teamcolor team], |
19 AnswerThisClient ["HH_NUM", teamname team, show $ hhnum team]] |
19 AnswerThisClient ["HH_NUM", teamname team, show $ hhnum team]] |
20 |
20 |
21 handleCmd_lobby :: CmdHandler |
21 handleCmd_lobby :: CmdHandler |
22 |
22 |
23 handleCmd_lobby clID clients rooms ["LIST"] = |
23 handleCmd_lobby clID clients rooms ["LIST"] = |
24 [AnswerThisClient ("ROOMS" : roomsInfoList)] |
24 [AnswerThisClient ("ROOMS" : roomsInfoList)] |
25 where |
25 where |
26 roomsInfoList = concatMap roomInfo sameProtoRooms |
26 roomsInfoList = concatMap roomInfo sameProtoRooms |
27 sameProtoRooms = filter (\r -> (roomProto r == protocol) && not (isRestrictedJoins r)) roomsList |
27 sameProtoRooms = filter (\r -> (roomProto r == protocol) && not (isRestrictedJoins r)) roomsList |
28 roomsList = IntMap.elems rooms |
28 roomsList = IntMap.elems rooms |
29 protocol = clientProto client |
29 protocol = clientProto client |
30 client = clients IntMap.! clID |
30 client = clients IntMap.! clID |
31 roomInfo room |
31 roomInfo room |
32 | clientProto client < 28 = [ |
32 | clientProto client < 28 = [ |
33 name room, |
33 name room, |
34 show (playersIn room) ++ "(" ++ show (length $ teams room) ++ ")", |
34 show (playersIn room) ++ "(" ++ show (length $ teams room) ++ ")", |
35 show $ gameinprogress room |
35 show $ gameinprogress room |
36 ] |
36 ] |
37 | otherwise = [ |
37 | otherwise = [ |
38 show $ gameinprogress room, |
38 show $ gameinprogress room, |
39 name room, |
39 name room, |
40 show $ playersIn room, |
40 show $ playersIn room, |
41 show $ length $ teams room, |
41 show $ length $ teams room, |
42 nick $ clients IntMap.! (masterID room), |
42 nick $ clients IntMap.! (masterID room), |
43 head (Map.findWithDefault ["+gen+"] "MAP" (params room)), |
43 head (Map.findWithDefault ["+gen+"] "MAP" (params room)), |
44 head (Map.findWithDefault ["Default"] "SCHEME" (params room)), |
44 head (Map.findWithDefault ["Default"] "SCHEME" (params room)), |
45 head (Map.findWithDefault ["Default"] "AMMO" (params room)) |
45 head (Map.findWithDefault ["Default"] "AMMO" (params room)) |
46 ] |
46 ] |
47 |
47 |
48 handleCmd_lobby clID clients _ ["CHAT", msg] = |
48 handleCmd_lobby clID clients _ ["CHAT", msg] = |
49 [AnswerOthersInRoom ["CHAT", clientNick, msg]] |
49 [AnswerOthersInRoom ["CHAT", clientNick, msg]] |
50 where |
50 where |
51 clientNick = nick $ clients IntMap.! clID |
51 clientNick = nick $ clients IntMap.! clID |
52 |
52 |
53 |
53 |
54 handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom, roomPassword] |
54 handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom, roomPassword] |
55 | haveSameRoom = [Warning "Room exists"] |
55 | haveSameRoom = [Warning "Room exists"] |
56 | illegalName newRoom = [Warning "Illegal room name"] |
56 | illegalName newRoom = [Warning "Illegal room name"] |
57 | otherwise = |
57 | otherwise = |
58 [RoomRemoveThisClient "", -- leave lobby |
58 [RoomRemoveThisClient "", -- leave lobby |
59 AddRoom newRoom roomPassword, |
59 AddRoom newRoom roomPassword, |
60 AnswerThisClient ["NOT_READY", clientNick] |
60 AnswerThisClient ["NOT_READY", clientNick] |
61 ] |
61 ] |
62 where |
62 where |
63 clientNick = nick $ clients IntMap.! clID |
63 clientNick = nick $ clients IntMap.! clID |
64 haveSameRoom = isJust $ find (\room -> newRoom == name room) $ IntMap.elems rooms |
64 haveSameRoom = isJust $ find (\room -> newRoom == name room) $ IntMap.elems rooms |
65 |
65 |
66 |
66 |
67 handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom] = |
67 handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom] = |
68 handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom, ""] |
68 handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom, ""] |
69 |
69 |
70 |
70 |
71 handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName, roomPassword] |
71 handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName, roomPassword] |
72 | noSuchRoom = [Warning "No such room"] |
72 | noSuchRoom = [Warning "No such room"] |
73 | isRestrictedJoins jRoom = [Warning "Joining restricted"] |
73 | isRestrictedJoins jRoom = [Warning "Joining restricted"] |
74 | roomPassword /= password jRoom = [Warning "Wrong password"] |
74 | roomPassword /= password jRoom = [Warning "Wrong password"] |
75 | otherwise = |
75 | otherwise = |
76 [RoomRemoveThisClient "", -- leave lobby |
76 [RoomRemoveThisClient "", -- leave lobby |
77 RoomAddThisClient rID] -- join room |
77 RoomAddThisClient rID] -- join room |
78 ++ answerNicks |
78 ++ answerNicks |
79 ++ answerReady |
79 ++ answerReady |
80 ++ [AnswerThisRoom ["NOT_READY", nick client]] |
80 ++ [AnswerThisRoom ["NOT_READY", nick client]] |
81 ++ answerFullConfig |
81 ++ answerFullConfig |
82 ++ answerTeams |
82 ++ answerTeams |
83 ++ watchRound |
83 ++ watchRound |
84 where |
84 where |
85 noSuchRoom = isNothing mbRoom |
85 noSuchRoom = isNothing mbRoom |
86 mbRoom = find (\r -> roomName == name r && roomProto r == clientProto client) $ IntMap.elems rooms |
86 mbRoom = find (\r -> roomName == name r && roomProto r == clientProto client) $ IntMap.elems rooms |
87 jRoom = fromJust mbRoom |
87 jRoom = fromJust mbRoom |
88 rID = roomUID jRoom |
88 rID = roomUID jRoom |
89 client = clients IntMap.! clID |
89 client = clients IntMap.! clID |
90 roomClientsIDs = IntSet.elems $ playersIDs jRoom |
90 roomClientsIDs = IntSet.elems $ playersIDs jRoom |
91 answerNicks = |
91 answerNicks = |
92 [AnswerThisClient $ "JOINED" : |
92 [AnswerThisClient $ "JOINED" : |
93 map (\clID -> nick $ clients IntMap.! clID) roomClientsIDs | playersIn jRoom /= 0] |
93 map (\clID -> nick $ clients IntMap.! clID) roomClientsIDs | playersIn jRoom /= 0] |
94 answerReady = map |
94 answerReady = map |
95 ((\ c -> |
95 ((\ c -> |
96 AnswerThisClient |
96 AnswerThisClient |
97 [if isReady c then "READY" else "NOT_READY", nick c]) |
97 [if isReady c then "READY" else "NOT_READY", nick c]) |
98 . (\ clID -> clients IntMap.! clID)) |
98 . (\ clID -> clients IntMap.! clID)) |
99 roomClientsIDs |
99 roomClientsIDs |
100 |
100 |
101 toAnswer (paramName, paramStrs) = AnswerThisClient $ "CFG" : paramName : paramStrs |
101 toAnswer (paramName, paramStrs) = AnswerThisClient $ "CFG" : paramName : paramStrs |
102 |
102 |
103 answerFullConfig = map toAnswer (leftConfigPart ++ rightConfigPart) |
103 answerFullConfig = map toAnswer (leftConfigPart ++ rightConfigPart) |
104 (leftConfigPart, rightConfigPart) = partition (\(p, _) -> p /= "MAP") (Map.toList $ params jRoom) |
104 (leftConfigPart, rightConfigPart) = partition (\(p, _) -> p /= "MAP") (Map.toList $ params jRoom) |
105 |
105 |
106 watchRound = if not $ gameinprogress jRoom then |
106 watchRound = if not $ gameinprogress jRoom then |
107 [] |
107 [] |
108 else |
108 else |
109 [AnswerThisClient ["RUN_GAME"], |
109 [AnswerThisClient ["RUN_GAME"], |
110 AnswerThisClient $ "EM" : toEngineMsg "e$spectate 1" : Foldable.toList (roundMsgs jRoom)] |
110 AnswerThisClient $ "EM" : toEngineMsg "e$spectate 1" : Foldable.toList (roundMsgs jRoom)] |
111 |
111 |
112 answerTeams = if gameinprogress jRoom then |
112 answerTeams = if gameinprogress jRoom then |
113 answerAllTeams (teamsAtStart jRoom) |
113 answerAllTeams (clientProto client) (teamsAtStart jRoom) |
114 else |
114 else |
115 answerAllTeams (teams jRoom) |
115 answerAllTeams (clientProto client) (teams jRoom) |
116 |
116 |
117 |
117 |
118 handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName] = |
118 handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName] = |
119 handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName, ""] |
119 handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName, ""] |
120 |
120 |
121 --------------------------- |
121 --------------------------- |
122 -- Administrator's stuff -- |
122 -- Administrator's stuff -- |
123 |
123 |
124 handleCmd_lobby clID clients rooms ["KICK", kickNick] = |
124 handleCmd_lobby clID clients rooms ["KICK", kickNick] = |
125 [KickClient kickID | isAdministrator client && (not noSuchClient) && kickID /= clID] |
125 [KickClient kickID | isAdministrator client && (not noSuchClient) && kickID /= clID] |
126 where |
126 where |
127 client = clients IntMap.! clID |
127 client = clients IntMap.! clID |
128 maybeClient = Foldable.find (\cl -> kickNick == nick cl) clients |
128 maybeClient = Foldable.find (\cl -> kickNick == nick cl) clients |
129 noSuchClient = isNothing maybeClient |
129 noSuchClient = isNothing maybeClient |
130 kickID = clientUID $ fromJust maybeClient |
130 kickID = clientUID $ fromJust maybeClient |
131 |
131 |
132 |
132 |
133 handleCmd_lobby clID clients rooms ["BAN", banNick] = |
133 handleCmd_lobby clID clients rooms ["BAN", banNick] = |
134 if not $ isAdministrator client then |
134 if not $ isAdministrator client then |
135 [] |
135 [] |
136 else |
136 else |
137 BanClient banNick : handleCmd_lobby clID clients rooms ["KICK", banNick] |
137 BanClient banNick : handleCmd_lobby clID clients rooms ["KICK", banNick] |
138 where |
138 where |
139 client = clients IntMap.! clID |
139 client = clients IntMap.! clID |
140 |
140 |
141 |
141 |
142 handleCmd_lobby clID clients rooms ["SET_SERVER_MESSAGE", newMessage] = |
142 handleCmd_lobby clID clients rooms ["SET_SERVER_MESSAGE", newMessage] = |
143 [ModifyServerInfo (\si -> si{serverMessage = newMessage}) | isAdministrator client] |
143 [ModifyServerInfo (\si -> si{serverMessage = newMessage}) | isAdministrator client] |
144 where |
144 where |
145 client = clients IntMap.! clID |
145 client = clients IntMap.! clID |
146 |
146 |
147 |
147 |
148 handleCmd_lobby clID clients rooms ["CLEAR_ACCOUNTS_CACHE"] = |
148 handleCmd_lobby clID clients rooms ["CLEAR_ACCOUNTS_CACHE"] = |
149 [ClearAccountsCache | isAdministrator client] |
149 [ClearAccountsCache | isAdministrator client] |
150 where |
150 where |
151 client = clients IntMap.! clID |
151 client = clients IntMap.! clID |
152 |
152 |
153 |
153 |
154 handleCmd_lobby clID _ _ _ = [ProtocolError "Incorrect command (state: in lobby)"] |
154 handleCmd_lobby clID _ _ _ = [ProtocolError "Incorrect command (state: in lobby)"] |