75 else |
75 else |
76 [ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}), |
76 [ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}), |
77 SendUpdateOnThisRoom, |
77 SendUpdateOnThisRoom, |
78 ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = Just teamColor}), |
78 ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = Just teamColor}), |
79 AnswerClients clChan ["TEAM_ACCEPTED", tName], |
79 AnswerClients clChan ["TEAM_ACCEPTED", tName], |
80 AnswerClients clChan ["HH_NUM", tName, showB $ hhnum newTeam], |
|
81 AnswerClients othChans $ teamToNet $ newTeam, |
80 AnswerClients othChans $ teamToNet $ newTeam, |
82 AnswerClients roomChans ["TEAM_COLOR", tName, teamColor] |
81 AnswerClients roomChans ["TEAM_COLOR", tName, teamColor], |
|
82 ModifyClient $ \c -> c{actionsPending = actionsPending cl |
|
83 ++ [AnswerClients clChan ["HH_NUM", tName, showB $ hhnum newTeam]] |
|
84 }, |
|
85 AnswerClients [sendChan cl] ["PING"] |
83 ] |
86 ] |
84 where |
87 where |
85 canAddNumber rt = (48::Int) - (sum $ map hhnum rt) |
88 canAddNumber rt = (48::Int) - (sum $ map hhnum rt) |
86 findTeam = find (\t -> tName == teamname t) . teams |
89 findTeam = find (\t -> tName == teamname t) . teams |
87 dif = readInt_ difStr |
90 dif = readInt_ difStr |
95 |
98 |
96 |
99 |
97 handleCmd_inRoom ["REMOVE_TEAM", tName] = do |
100 handleCmd_inRoom ["REMOVE_TEAM", tName] = do |
98 (ci, _) <- ask |
101 (ci, _) <- ask |
99 r <- thisRoom |
102 r <- thisRoom |
100 clNick <- clientNick |
|
101 |
103 |
102 let maybeTeam = findTeam r |
104 let maybeTeam = findTeam r |
103 let team = fromJust maybeTeam |
105 let team = fromJust maybeTeam |
104 |
106 |
105 return $ |
107 return $ |
106 if isNothing $ maybeTeam then |
108 if isNothing $ maybeTeam then |
107 [Warning $ loc "REMOVE_TEAM: no such team"] |
109 [Warning $ loc "REMOVE_TEAM: no such team"] |
108 else if clNick /= teamowner team then |
110 else if ci /= teamownerId team then |
109 [ProtocolError $ loc "Not team owner!"] |
111 [ProtocolError $ loc "Not team owner!"] |
110 else |
112 else |
111 [RemoveTeam tName, |
113 [RemoveTeam tName, |
112 ModifyClient |
114 ModifyClient |
113 (\c -> c{ |
115 (\c -> c{ |
114 teamsInGame = teamsInGame c - 1, |
116 teamsInGame = teamsInGame c - 1, |
115 clientClan = if teamsInGame c == 1 then Nothing else Just $ anotherTeamClan ci r |
117 clientClan = if teamsInGame c == 1 then Nothing else Just $ anotherTeamClan ci team r |
116 }) |
118 }) |
117 ] |
119 ] |
118 where |
120 where |
119 anotherTeamClan ci = teamcolor . fromJust . find (\t -> teamownerId t == ci) . teams |
121 anotherTeamClan ci team = teamcolor . fromMaybe (error "CHECKPOINT 011") . find (\t -> (teamownerId t == ci) && (t /= team)) . teams |
120 findTeam = find (\t -> tName == teamname t) . teams |
122 findTeam = find (\t -> tName == teamname t) . teams |
121 |
123 |
122 |
124 |
123 handleCmd_inRoom ["HH_NUM", teamName, numberStr] = do |
125 handleCmd_inRoom ["HH_NUM", teamName, numberStr] = do |
124 cl <- thisClient |
126 cl <- thisClient |
125 r <- thisRoom |
127 r <- thisRoom |
126 clChan <- thisClientChans |
128 clChan <- thisClientChans |
127 roomChans <- roomClientsChans |
129 others <- roomOthersChans |
128 |
130 |
129 let maybeTeam = findTeam r |
131 let maybeTeam = findTeam r |
130 let team = fromJust maybeTeam |
132 let team = fromJust maybeTeam |
131 |
133 |
132 return $ |
134 return $ |
136 [] |
138 [] |
137 else if hhNumber < 1 || hhNumber > 8 || hhNumber > canAddNumber r + hhnum team then |
139 else if hhNumber < 1 || hhNumber > 8 || hhNumber > canAddNumber r + hhnum team then |
138 [AnswerClients clChan ["HH_NUM", teamName, showB $ hhnum team]] |
140 [AnswerClients clChan ["HH_NUM", teamName, showB $ hhnum team]] |
139 else |
141 else |
140 [ModifyRoom $ modifyTeam team{hhnum = hhNumber}, |
142 [ModifyRoom $ modifyTeam team{hhnum = hhNumber}, |
141 AnswerClients roomChans ["HH_NUM", teamName, showB hhNumber]] |
143 AnswerClients others ["HH_NUM", teamName, showB hhNumber]] |
142 where |
144 where |
143 hhNumber = readInt_ numberStr |
145 hhNumber = readInt_ numberStr |
144 findTeam = find (\t -> teamName == teamname t) . teams |
146 findTeam = find (\t -> teamName == teamname t) . teams |
145 canAddNumber = (-) 48 . sum . map hhnum . teams |
147 canAddNumber = (-) 48 . sum . map hhnum . teams |
146 |
148 |
179 AnswerClients chans $ if clientProto cl < 38 then |
181 AnswerClients chans $ if clientProto cl < 38 then |
180 [if isReady cl then "NOT_READY" else "READY", nick cl] |
182 [if isReady cl then "NOT_READY" else "READY", nick cl] |
181 else |
183 else |
182 ["CLIENT_FLAGS", if isReady cl then "-r" else "+r", nick cl] |
184 ["CLIENT_FLAGS", if isReady cl then "-r" else "+r", nick cl] |
183 ] |
185 ] |
|
186 |
184 |
187 |
185 handleCmd_inRoom ["START_GAME"] = do |
188 handleCmd_inRoom ["START_GAME"] = do |
186 (ci, rnc) <- ask |
189 (ci, rnc) <- ask |
187 cl <- thisClient |
190 cl <- thisClient |
188 rm <- thisRoom |
191 rm <- thisRoom |
215 handleCmd_inRoom ["EM", msg] = do |
218 handleCmd_inRoom ["EM", msg] = do |
216 cl <- thisClient |
219 cl <- thisClient |
217 rm <- thisRoom |
220 rm <- thisRoom |
218 chans <- roomOthersChans |
221 chans <- roomOthersChans |
219 |
222 |
220 if teamsInGame cl > 0 && (isJust $ gameInfo rm) && isLegal then |
223 if teamsInGame cl > 0 && (isJust $ gameInfo rm) && (not $ B.null legalMsgs) then |
221 return $ AnswerClients chans ["EM", msg] |
224 return $ AnswerClients chans ["EM", legalMsgs] |
222 : [ModifyRoom (\r -> r{gameInfo = liftM (\g -> g{roundMsgs = msg : roundMsgs g}) $ gameInfo r}) | not isKeepAlive] |
225 : [ModifyRoom (\r -> r{gameInfo = liftM (\g -> g{roundMsgs = nonEmptyMsgs : roundMsgs g}) $ gameInfo r}) | not $ B.null nonEmptyMsgs] |
223 else |
226 else |
224 return [] |
227 return [] |
225 where |
228 where |
226 (isLegal, isKeepAlive) = checkNetCmd msg |
229 (legalMsgs, nonEmptyMsgs) = checkNetCmd msg |
227 |
230 |
228 |
231 |
229 handleCmd_inRoom ["ROUNDFINISHED", correctly] = do |
232 handleCmd_inRoom ["ROUNDFINISHED", _] = do |
230 cl <- thisClient |
233 cl <- thisClient |
231 rm <- thisRoom |
234 rm <- thisRoom |
232 chans <- roomClientsChans |
235 chans <- roomClientsChans |
233 |
236 |
234 let clTeams = map teamname . filter (\t -> teamowner t == nick cl) . teams $ rm |
237 let clTeams = map teamname . filter (\t -> teamowner t == nick cl) . teams $ rm |
240 else |
243 else |
241 return unsetInGameState |
244 return unsetInGameState |
242 else |
245 else |
243 return [] -- don't accept this message twice |
246 return [] -- don't accept this message twice |
244 where |
247 where |
245 isCorrect = correctly == "1" |
248 -- isCorrect = correctly == "1" |
246 |
249 |
247 -- compatibility with clients with protocol < 38 |
250 -- compatibility with clients with protocol < 38 |
248 handleCmd_inRoom ["ROUNDFINISHED"] = |
251 handleCmd_inRoom ["ROUNDFINISHED"] = |
249 handleCmd_inRoom ["ROUNDFINISHED", "1"] |
252 handleCmd_inRoom ["ROUNDFINISHED", "1"] |
250 |
253 |
295 |
299 |
296 handleCmd_inRoom ["KICK", kickNick] = do |
300 handleCmd_inRoom ["KICK", kickNick] = do |
297 (thisClientId, rnc) <- ask |
301 (thisClientId, rnc) <- ask |
298 maybeClientId <- clientByNick kickNick |
302 maybeClientId <- clientByNick kickNick |
299 master <- liftM isMaster thisClient |
303 master <- liftM isMaster thisClient |
|
304 rm <- thisRoom |
300 let kickId = fromJust maybeClientId |
305 let kickId = fromJust maybeClientId |
|
306 let kickCl = rnc `client` kickId |
301 let sameRoom = clientRoom rnc thisClientId == clientRoom rnc kickId |
307 let sameRoom = clientRoom rnc thisClientId == clientRoom rnc kickId |
|
308 let notOnly2Players = (length . group . sort . map teamowner . teams $ rm) > 2 |
302 return |
309 return |
303 [KickRoomClient kickId | master && isJust maybeClientId && (kickId /= thisClientId) && sameRoom] |
310 [KickRoomClient kickId | |
|
311 master |
|
312 && isJust maybeClientId |
|
313 && (kickId /= thisClientId) |
|
314 && sameRoom |
|
315 && ((isNothing $ gameInfo rm) || notOnly2Players || teamsInGame kickCl == 0) |
|
316 ] |
304 |
317 |
305 |
318 |
306 handleCmd_inRoom ["DELEGATE", newAdmin] = do |
319 handleCmd_inRoom ["DELEGATE", newAdmin] = do |
307 (thisClientId, rnc) <- ask |
320 (thisClientId, rnc) <- ask |
308 maybeClientId <- clientByNick newAdmin |
321 maybeClientId <- clientByNick newAdmin |
321 handleCmd_inRoom ["TEAMCHAT", msg] = do |
334 handleCmd_inRoom ["TEAMCHAT", msg] = do |
322 cl <- thisClient |
335 cl <- thisClient |
323 chans <- roomSameClanChans |
336 chans <- roomSameClanChans |
324 return [AnswerClients chans ["EM", engineMsg cl]] |
337 return [AnswerClients chans ["EM", engineMsg cl]] |
325 where |
338 where |
326 engineMsg cl = toEngineMsg $ B.concat ["b", nick cl, "(team): ", msg, "\x20\x20"] |
339 engineMsg cl = toEngineMsg $ B.concat ["b", nick cl, " (team): ", msg, "\x20\x20"] |
|
340 |
327 |
341 |
328 handleCmd_inRoom ["BAN", banNick] = do |
342 handleCmd_inRoom ["BAN", banNick] = do |
329 (thisClientId, rnc) <- ask |
343 (thisClientId, rnc) <- ask |
330 maybeClientId <- clientByNick banNick |
344 maybeClientId <- clientByNick banNick |
331 master <- liftM isMaster thisClient |
345 master <- liftM isMaster thisClient |