39 cl <- thisClient |
39 cl <- thisClient |
40 rm <- thisRoom |
40 rm <- thisRoom |
41 chans <- roomClientsChans |
41 chans <- roomClientsChans |
42 |
42 |
43 let nicks = map (nick . client rnc) . roomClients rnc $ clientRoom rnc ci |
43 let nicks = map (nick . client rnc) . roomClients rnc $ clientRoom rnc ci |
44 let allPlayersRegistered = all ((<) 0 . B.length . webPassword . client rnc . teamownerId) $ teams rm |
44 let allPlayersRegistered = all isOwnerRegistered $ teams rm |
45 |
45 |
46 if (playersIn rm == readyPlayers rm || clientProto cl > 43) && not (isJust $ gameInfo rm) then |
46 if (playersIn rm == readyPlayers rm || clientProto cl > 43) && not (isJust $ gameInfo rm) then |
47 if enoughClans rm then |
47 if enoughClans rm then |
48 return [ |
48 return [ |
49 ModifyRoom |
49 ModifyRoom |
85 |
85 |
86 if isSpecial rm then |
86 if isSpecial rm then |
87 return [Warning $ loc "Restricted"] |
87 return [Warning $ loc "Restricted"] |
88 else if isMaster cl then |
88 else if isMaster cl then |
89 return [ |
89 return [ |
90 ModifyRoom f, |
90 ModifyRoom $ f (clientProto cl), |
91 AnswerClients chans ("CFG" : paramName : paramStrs)] |
91 AnswerClients chans ("CFG" : paramName : paramStrs)] |
92 else |
92 else |
93 return [ProtocolError $ loc "Not room master"] |
93 return [ProtocolError $ loc "Not room master"] |
94 where |
94 where |
95 f r = if paramName `Map.member` (mapParams r) then |
95 f clproto r = if paramName `Map.member` (mapParams r) then |
96 r{mapParams = Map.insert paramName (head paramStrs) (mapParams r)} |
96 r{mapParams = Map.insert paramName (head paramStrs) (mapParams r)} |
97 else |
97 else |
98 r{params = Map.insert paramName paramStrs (params r)} |
98 r{params = Map.insert paramName (fixedParamStr clproto) (params r)} |
|
99 fixedParamStr clproto |
|
100 | clproto /= 49 = paramStrs |
|
101 | paramName /= "SCHEME" = paramStrs |
|
102 | otherwise = L.init paramStrs ++ [B.replicate 50 'X' `B.append` L.last paramStrs] |
99 |
103 |
100 |
104 |
101 handleCmd_inRoom ("ADD_TEAM" : tName : color : grave : fort : voicepack : flag : difStr : hhsInfo) |
105 handleCmd_inRoom ("ADD_TEAM" : tName : color : grave : fort : voicepack : flag : difStr : hhsInfo) |
102 | length hhsInfo /= 16 = return [ProtocolError $ loc "Corrupted hedgehogs info"] |
106 | length hhsInfo /= 16 = return [ProtocolError $ loc "Corrupted hedgehogs info"] |
103 | otherwise = do |
107 | otherwise = do |
104 (ci, _) <- ask |
108 (ci, _) <- ask |
105 rm <- thisRoom |
109 rm <- thisRoom |
|
110 cl <- thisClient |
106 clNick <- clientNick |
111 clNick <- clientNick |
107 clChan <- thisClientChans |
112 clChan <- thisClientChans |
108 othChans <- roomOthersChans |
113 othChans <- roomOthersChans |
109 roomChans <- roomClientsChans |
114 roomChans <- roomClientsChans |
110 cl <- thisClient |
115 cl <- thisClient |
|
116 let isRegistered = (<) 0 . B.length . webPassword $ cl |
111 teamColor <- |
117 teamColor <- |
112 if clientProto cl < 42 then |
118 if clientProto cl < 42 then |
113 return color |
119 return color |
114 else |
120 else |
115 liftM (head . (L.\\) (map B.singleton ['0'..]) . map teamcolor . teams) thisRoom |
121 liftM (head . (L.\\) (map B.singleton ['0'..]) . map teamcolor . teams) thisRoom |
116 let roomTeams = teams rm |
122 let roomTeams = teams rm |
117 let hhNum = let p = if not $ null roomTeams then minimum [hhnum $ head roomTeams, canAddNumber roomTeams] else 4 in newTeamHHNum roomTeams p |
123 let hhNum = let p = if not $ null roomTeams then minimum [hhnum $ head roomTeams, canAddNumber roomTeams] else 4 in newTeamHHNum roomTeams p |
118 let newTeam = clNick `seq` TeamInfo ci clNick tName teamColor grave fort voicepack flag dif hhNum (hhsList hhsInfo) |
124 let newTeam = clNick `seq` TeamInfo clNick tName teamColor grave fort voicepack flag isRegistered dif hhNum (hhsList hhsInfo) |
119 return $ |
125 return $ |
120 if not . null . drop (maxTeams rm - 1) $ roomTeams then |
126 if not . null . drop (maxTeams rm - 1) $ roomTeams then |
121 [Warning $ loc "too many teams"] |
127 [Warning $ loc "too many teams"] |
122 else if canAddNumber roomTeams <= 0 then |
128 else if canAddNumber roomTeams <= 0 then |
123 [Warning $ loc "too many hedgehogs"] |
129 [Warning $ loc "too many hedgehogs"] |
150 |
156 |
151 |
157 |
152 handleCmd_inRoom ["REMOVE_TEAM", tName] = do |
158 handleCmd_inRoom ["REMOVE_TEAM", tName] = do |
153 (ci, _) <- ask |
159 (ci, _) <- ask |
154 r <- thisRoom |
160 r <- thisRoom |
|
161 clNick <- clientNick |
155 |
162 |
156 let maybeTeam = findTeam r |
163 let maybeTeam = findTeam r |
157 let team = fromJust maybeTeam |
164 let team = fromJust maybeTeam |
158 |
165 |
159 return $ |
166 return $ |
160 if isNothing $ maybeTeam then |
167 if isNothing $ maybeTeam then |
161 [Warning $ loc "REMOVE_TEAM: no such team"] |
168 [Warning $ loc "REMOVE_TEAM: no such team"] |
162 else if ci /= teamownerId team then |
169 else if clNick /= teamowner team then |
163 [ProtocolError $ loc "Not team owner!"] |
170 [ProtocolError $ loc "Not team owner!"] |
164 else |
171 else |
165 [RemoveTeam tName, |
172 [RemoveTeam tName, |
166 ModifyClient |
173 ModifyClient |
167 (\c -> c{ |
174 (\c -> c{ |
168 teamsInGame = teamsInGame c - 1, |
175 teamsInGame = teamsInGame c - 1, |
169 clientClan = if teamsInGame c == 1 then Nothing else Just $ anotherTeamClan ci team r |
176 clientClan = if teamsInGame c == 1 then Nothing else Just $ anotherTeamClan clNick team r |
170 }) |
177 }) |
171 ] |
178 ] |
172 where |
179 where |
173 anotherTeamClan ci team = teamcolor . fromMaybe (error "CHECKPOINT 011") . find (\t -> (teamownerId t == ci) && (t /= team)) . teams |
180 anotherTeamClan clNick team = teamcolor . fromMaybe (error "CHECKPOINT 011") . find (\t -> (teamowner t == clNick) && (t /= team)) . teams |
174 findTeam = find (\t -> tName == teamname t) . teams |
181 findTeam = find (\t -> tName == teamname t) . teams |
175 |
182 |
176 |
183 |
177 handleCmd_inRoom ["HH_NUM", teamName, numberStr] = do |
184 handleCmd_inRoom ["HH_NUM", teamName, numberStr] = do |
178 cl <- thisClient |
185 cl <- thisClient |
205 others <- roomOthersChans |
212 others <- roomOthersChans |
206 r <- thisRoom |
213 r <- thisRoom |
207 |
214 |
208 let maybeTeam = findTeam r |
215 let maybeTeam = findTeam r |
209 let team = fromJust maybeTeam |
216 let team = fromJust maybeTeam |
|
217 maybeClientId <- clientByNick $ teamowner team |
|
218 let teamOwnerId = fromJust maybeClientId |
210 |
219 |
211 return $ |
220 return $ |
212 if not $ isMaster cl then |
221 if not $ isMaster cl then |
213 [ProtocolError $ loc "Not room master"] |
222 [ProtocolError $ loc "Not room master"] |
214 else if isNothing maybeTeam then |
223 else if isNothing maybeTeam || isNothing maybeClientId then |
215 [] |
224 [] |
216 else |
225 else |
217 [ModifyRoom $ modifyTeam team{teamcolor = newColor}, |
226 [ModifyRoom $ modifyTeam team{teamcolor = newColor}, |
218 AnswerClients others ["TEAM_COLOR", teamName, newColor], |
227 AnswerClients others ["TEAM_COLOR", teamName, newColor], |
219 ModifyClient2 (teamownerId team) (\c -> c{clientClan = Just newColor})] |
228 ModifyClient2 teamOwnerId (\c -> c{clientClan = Just newColor})] |
220 where |
229 where |
221 findTeam = find (\t -> teamName == teamname t) . teams |
230 findTeam = find (\t -> teamName == teamname t) . teams |
222 |
231 |
223 |
232 |
224 handleCmd_inRoom ["TOGGLE_READY"] = do |
233 handleCmd_inRoom ["TOGGLE_READY"] = do |