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 |
105 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) |
106 | length hhsInfo /= 16 = return [ProtocolError $ loc "Corrupted hedgehogs info"] |
106 | length hhsInfo /= 16 = return [ProtocolError $ loc "Corrupted hedgehogs info"] |
107 | otherwise = do |
107 | otherwise = do |
108 (ci, _) <- ask |
108 (ci, _) <- ask |
109 rm <- thisRoom |
109 rm <- thisRoom |
|
110 cl <- thisClient |
110 clNick <- clientNick |
111 clNick <- clientNick |
111 clChan <- thisClientChans |
112 clChan <- thisClientChans |
112 othChans <- roomOthersChans |
113 othChans <- roomOthersChans |
113 roomChans <- roomClientsChans |
114 roomChans <- roomClientsChans |
114 cl <- thisClient |
115 cl <- thisClient |
|
116 let isRegistered = (<) 0 . B.length . webPassword $ cl |
115 teamColor <- |
117 teamColor <- |
116 if clientProto cl < 42 then |
118 if clientProto cl < 42 then |
117 return color |
119 return color |
118 else |
120 else |
119 liftM (head . (L.\\) (map B.singleton ['0'..]) . map teamcolor . teams) thisRoom |
121 liftM (head . (L.\\) (map B.singleton ['0'..]) . map teamcolor . teams) thisRoom |
120 let roomTeams = teams rm |
122 let roomTeams = teams rm |
121 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 |
122 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) |
123 return $ |
125 return $ |
124 if not . null . drop (maxTeams rm - 1) $ roomTeams then |
126 if not . null . drop (maxTeams rm - 1) $ roomTeams then |
125 [Warning $ loc "too many teams"] |
127 [Warning $ loc "too many teams"] |
126 else if canAddNumber roomTeams <= 0 then |
128 else if canAddNumber roomTeams <= 0 then |
127 [Warning $ loc "too many hedgehogs"] |
129 [Warning $ loc "too many hedgehogs"] |
154 |
156 |
155 |
157 |
156 handleCmd_inRoom ["REMOVE_TEAM", tName] = do |
158 handleCmd_inRoom ["REMOVE_TEAM", tName] = do |
157 (ci, _) <- ask |
159 (ci, _) <- ask |
158 r <- thisRoom |
160 r <- thisRoom |
|
161 clNick <- clientNick |
159 |
162 |
160 let maybeTeam = findTeam r |
163 let maybeTeam = findTeam r |
161 let team = fromJust maybeTeam |
164 let team = fromJust maybeTeam |
162 |
165 |
163 return $ |
166 return $ |
164 if isNothing $ maybeTeam then |
167 if isNothing $ maybeTeam then |
165 [Warning $ loc "REMOVE_TEAM: no such team"] |
168 [Warning $ loc "REMOVE_TEAM: no such team"] |
166 else if ci /= teamownerId team then |
169 else if clNick /= teamowner team then |
167 [ProtocolError $ loc "Not team owner!"] |
170 [ProtocolError $ loc "Not team owner!"] |
168 else |
171 else |
169 [RemoveTeam tName, |
172 [RemoveTeam tName, |
170 ModifyClient |
173 ModifyClient |
171 (\c -> c{ |
174 (\c -> c{ |
172 teamsInGame = teamsInGame c - 1, |
175 teamsInGame = teamsInGame c - 1, |
173 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 |
174 }) |
177 }) |
175 ] |
178 ] |
176 where |
179 where |
177 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 |
178 findTeam = find (\t -> tName == teamname t) . teams |
181 findTeam = find (\t -> tName == teamname t) . teams |
179 |
182 |
180 |
183 |
181 handleCmd_inRoom ["HH_NUM", teamName, numberStr] = do |
184 handleCmd_inRoom ["HH_NUM", teamName, numberStr] = do |
182 cl <- thisClient |
185 cl <- thisClient |
209 others <- roomOthersChans |
212 others <- roomOthersChans |
210 r <- thisRoom |
213 r <- thisRoom |
211 |
214 |
212 let maybeTeam = findTeam r |
215 let maybeTeam = findTeam r |
213 let team = fromJust maybeTeam |
216 let team = fromJust maybeTeam |
|
217 maybeClientId <- clientByNick $ teamowner team |
|
218 let teamOwnerId = fromJust maybeClientId |
214 |
219 |
215 return $ |
220 return $ |
216 if not $ isMaster cl then |
221 if not $ isMaster cl then |
217 [ProtocolError $ loc "Not room master"] |
222 [ProtocolError $ loc "Not room master"] |
218 else if isNothing maybeTeam then |
223 else if isNothing maybeTeam || isNothing maybeClientId then |
219 [] |
224 [] |
220 else |
225 else |
221 [ModifyRoom $ modifyTeam team{teamcolor = newColor}, |
226 [ModifyRoom $ modifyTeam team{teamcolor = newColor}, |
222 AnswerClients others ["TEAM_COLOR", teamName, newColor], |
227 AnswerClients others ["TEAM_COLOR", teamName, newColor], |
223 ModifyClient2 (teamownerId team) (\c -> c{clientClan = Just newColor})] |
228 ModifyClient2 teamOwnerId (\c -> c{clientClan = Just newColor})] |
224 where |
229 where |
225 findTeam = find (\t -> teamName == teamname t) . teams |
230 findTeam = find (\t -> teamName == teamname t) . teams |
226 |
231 |
227 |
232 |
228 handleCmd_inRoom ["TOGGLE_READY"] = do |
233 handleCmd_inRoom ["TOGGLE_READY"] = do |