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 name room, |
32 name room, |
33 (show $ playersIn room) ++ "(" ++ (show $ length $ teams room) ++ ")", |
33 show (playersIn room) ++ "(" ++ show (length $ teams room) ++ ")", |
34 show $ gameinprogress room |
34 show $ gameinprogress room |
35 ] |
35 ] |
36 |
36 |
37 |
37 |
38 handleCmd_lobby clID clients _ ["CHAT", msg] = |
38 handleCmd_lobby clID clients _ ["CHAT", msg] = |
39 [AnswerOthersInRoom ["CHAT", clientNick, msg]] |
39 [AnswerOthersInRoom ["CHAT", clientNick, msg]] |
40 where |
40 where |
41 clientNick = nick $ clients IntMap.! clID |
41 clientNick = nick $ clients IntMap.! clID |
42 |
42 |
43 |
43 |
44 handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom, roomPassword] = |
44 handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom, roomPassword] |
45 if haveSameRoom then |
45 | haveSameRoom = [Warning "Room exists"] |
46 [Warning "Room exists"] |
46 | illegalName newRoom = [Warning "Illegal room name"] |
47 else if illegalName newRoom then |
47 | otherwise = |
48 [Warning "Illegal room name"] |
|
49 else |
|
50 [RoomRemoveThisClient "", -- leave lobby |
48 [RoomRemoveThisClient "", -- leave lobby |
51 AddRoom newRoom roomPassword, |
49 AddRoom newRoom roomPassword, |
52 AnswerThisClient ["NOT_READY", clientNick] |
50 AnswerThisClient ["NOT_READY", clientNick] |
53 ] |
51 ] |
54 where |
52 where |
58 |
56 |
59 handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom] = |
57 handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom] = |
60 handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom, ""] |
58 handleCmd_lobby clID clients rooms ["CREATE_ROOM", newRoom, ""] |
61 |
59 |
62 |
60 |
63 handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName, roomPassword] = |
61 handleCmd_lobby clID clients rooms ["JOIN_ROOM", roomName, roomPassword] |
64 if noSuchRoom then |
62 | noSuchRoom = [Warning "No such room"] |
65 [Warning "No such room"] |
63 | isRestrictedJoins jRoom = [Warning "Joining restricted"] |
66 else if isRestrictedJoins jRoom then |
64 | roomPassword /= password jRoom = [Warning "Wrong password"] |
67 [Warning "Joining restricted"] |
65 | otherwise = |
68 else if roomPassword /= password jRoom then |
|
69 [Warning "Wrong password"] |
|
70 else |
|
71 [RoomRemoveThisClient "", -- leave lobby |
66 [RoomRemoveThisClient "", -- leave lobby |
72 RoomAddThisClient rID] -- join room |
67 RoomAddThisClient rID] -- join room |
73 ++ answerNicks |
68 ++ answerNicks |
74 ++ answerReady |
69 ++ answerReady |
75 ++ [AnswerThisRoom ["NOT_READY", nick client]] |
70 ++ [AnswerThisRoom ["NOT_READY", nick client]] |
76 ++ answerFullConfig |
71 ++ answerFullConfig |
77 ++ answerTeams |
72 ++ answerTeams |
78 ++ watchRound |
73 ++ watchRound |
79 where |
74 where |
80 noSuchRoom = isNothing mbRoom |
75 noSuchRoom = isNothing mbRoom |
81 mbRoom = find (\r -> roomName == name r && roomProto r == clientProto client) $ IntMap.elems rooms |
76 mbRoom = find (\r -> roomName == name r && roomProto r == clientProto client) $ IntMap.elems rooms |
82 jRoom = fromJust mbRoom |
77 jRoom = fromJust mbRoom |
83 rID = roomUID jRoom |
78 rID = roomUID jRoom |
84 client = clients IntMap.! clID |
79 client = clients IntMap.! clID |
85 roomClientsIDs = IntSet.elems $ playersIDs jRoom |
80 roomClientsIDs = IntSet.elems $ playersIDs jRoom |
86 answerNicks = if playersIn jRoom /= 0 then |
81 answerNicks = |
87 [AnswerThisClient $ ["JOINED"] ++ (map (\clID -> nick $ clients IntMap.! clID) $ roomClientsIDs)] |
82 [AnswerThisClient $ "JOINED" : |
88 else |
83 map (\clID -> nick $ clients IntMap.! clID) roomClientsIDs | playersIn jRoom /= 0] |
89 [] |
84 answerReady = map |
90 answerReady = |
85 ((\ c -> |
91 map (\c -> AnswerThisClient [if isReady c then "READY" else "NOT_READY", nick c]) $ |
86 AnswerThisClient |
92 map (\clID -> clients IntMap.! clID) roomClientsIDs |
87 [if isReady c then "READY" else "NOT_READY", nick c]) |
|
88 . (\ clID -> clients IntMap.! clID)) |
|
89 roomClientsIDs |
93 |
90 |
94 toAnswer (paramName, paramStrs) = AnswerThisClient $ "CFG" : paramName : paramStrs |
91 toAnswer (paramName, paramStrs) = AnswerThisClient $ "CFG" : paramName : paramStrs |
95 |
92 |
96 answerFullConfig = map toAnswer (leftConfigPart ++ rightConfigPart) |
93 answerFullConfig = map toAnswer (leftConfigPart ++ rightConfigPart) |
97 (leftConfigPart, rightConfigPart) = partition (\(p, _) -> p /= "MAP") (Map.toList $ params jRoom) |
94 (leftConfigPart, rightConfigPart) = partition (\(p, _) -> p /= "MAP") (Map.toList $ params jRoom) |
98 |
95 |
99 watchRound = if not $ gameinprogress jRoom then |
96 watchRound = if not $ gameinprogress jRoom then |
100 [] |
97 [] |
101 else |
98 else |
102 [AnswerThisClient ["RUN_GAME"], |
99 [AnswerThisClient ["RUN_GAME"], |
103 AnswerThisClient $ "EM" : toEngineMsg "e$spectate 1" : (Foldable.toList $ roundMsgs jRoom)] |
100 AnswerThisClient $ "EM" : toEngineMsg "e$spectate 1" : Foldable.toList (roundMsgs jRoom)] |
104 |
101 |
105 answerTeams = if gameinprogress jRoom then |
102 answerTeams = if gameinprogress jRoom then |
106 answerAllTeams (teamsAtStart jRoom) |
103 answerAllTeams (teamsAtStart jRoom) |
107 else |
104 else |
108 answerAllTeams (teams jRoom) |
105 answerAllTeams (teams jRoom) |
113 |
110 |
114 --------------------------- |
111 --------------------------- |
115 -- Administrator's stuff -- |
112 -- Administrator's stuff -- |
116 |
113 |
117 handleCmd_lobby clID clients rooms ["KICK", kickNick] = |
114 handleCmd_lobby clID clients rooms ["KICK", kickNick] = |
118 if not $ isAdministrator client then |
115 [KickClient kickID | isAdministrator client && (not noSuchClient) && kickID /= clID] |
119 [] |
|
120 else |
|
121 if noSuchClient then |
|
122 [] |
|
123 else |
|
124 if kickID == clID then |
|
125 [] |
|
126 else |
|
127 [KickClient kickID] |
|
128 where |
116 where |
129 client = clients IntMap.! clID |
117 client = clients IntMap.! clID |
130 maybeClient = Foldable.find (\cl -> kickNick == nick cl) clients |
118 maybeClient = Foldable.find (\cl -> kickNick == nick cl) clients |
131 noSuchClient = isNothing maybeClient |
119 noSuchClient = isNothing maybeClient |
132 kickID = clientUID $ fromJust maybeClient |
120 kickID = clientUID $ fromJust maybeClient |
140 where |
128 where |
141 client = clients IntMap.! clID |
129 client = clients IntMap.! clID |
142 |
130 |
143 |
131 |
144 handleCmd_lobby clID clients rooms ["SET_SERVER_MESSAGE", newMessage] = |
132 handleCmd_lobby clID clients rooms ["SET_SERVER_MESSAGE", newMessage] = |
145 if not $ isAdministrator client then |
133 [ModifyServerInfo (\si -> si{serverMessage = newMessage}) | isAdministrator client] |
146 [] |
|
147 else |
|
148 [ModifyServerInfo (\si -> si{serverMessage = newMessage})] |
|
149 where |
134 where |
150 client = clients IntMap.! clID |
135 client = clients IntMap.! clID |
151 |
136 |
152 |
137 |
153 handleCmd_lobby clID clients rooms ["CLEAR_ACCOUNTS_CACHE"] = |
138 handleCmd_lobby clID clients rooms ["CLEAR_ACCOUNTS_CACHE"] = |
154 if not $ isAdministrator client then |
139 [ClearAccountsCache | isAdministrator client] |
155 [] |
|
156 else |
|
157 [ClearAccountsCache] |
|
158 where |
140 where |
159 client = clients IntMap.! clID |
141 client = clients IntMap.! clID |
160 |
142 |
161 |
143 |
162 handleCmd_lobby clID _ _ _ = [ProtocolError "Incorrect command (state: in lobby)"] |
144 handleCmd_lobby clID _ _ _ = [ProtocolError "Incorrect command (state: in lobby)"] |