55 , SendUpdateOnThisRoom |
55 , SendUpdateOnThisRoom |
56 , AnswerClients chans $ "CLIENT_FLAGS" : "+g" : nicks |
56 , AnswerClients chans $ "CLIENT_FLAGS" : "+g" : nicks |
57 , ModifyRoomClients (\c -> c{isInGame = True, teamIndexes = map snd . filter (\(t, _) -> teamowner t == nick c) $ zip (teams rm) [0..]}) |
57 , ModifyRoomClients (\c -> c{isInGame = True, teamIndexes = map snd . filter (\(t, _) -> teamowner t == nick c) $ zip (teams rm) [0..]}) |
58 ] |
58 ] |
59 else |
59 else |
60 return [Warning $ loc "Less than two clans!"] |
60 return [Warning $ loc "The game can't be started with less than two clans!"] |
61 else |
61 else |
62 return [] |
62 return [] |
63 where |
63 where |
64 enoughClans = not . null . drop 1 . group . map teamcolor . teams |
64 enoughClans = not . null . drop 1 . group . map teamcolor . teams |
65 |
65 |
75 handleCmd_inRoom ["PART"] = return [MoveToLobby "part"] |
75 handleCmd_inRoom ["PART"] = return [MoveToLobby "part"] |
76 handleCmd_inRoom ["PART", msg] = return [MoveToLobby $ "part: " `B.append` msg] |
76 handleCmd_inRoom ["PART", msg] = return [MoveToLobby $ "part: " `B.append` msg] |
77 |
77 |
78 |
78 |
79 handleCmd_inRoom ("CFG" : paramName : paramStrs) |
79 handleCmd_inRoom ("CFG" : paramName : paramStrs) |
80 | null paramStrs = return [ProtocolError $ loc "Empty config entry"] |
80 | null paramStrs = return [ProtocolError $ loc "Empty config entry."] |
81 | otherwise = do |
81 | otherwise = do |
82 chans <- roomOthersChans |
82 chans <- roomOthersChans |
83 cl <- thisClient |
83 cl <- thisClient |
84 rm <- thisRoom |
84 rm <- thisRoom |
85 |
85 |
86 if isSpecial rm then |
86 if isSpecial rm then |
87 return [Warning $ loc "Restricted"] |
87 return [Warning $ loc "Access denied."] |
88 else if isMaster cl then |
88 else if isMaster cl then |
89 return [ |
89 return [ |
90 ModifyRoom $ f (clientProto cl), |
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 "You're not the room master!"] |
94 where |
94 where |
95 f clproto 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 (fixedParamStr clproto) (params r)} |
98 r{params = Map.insert paramName (fixedParamStr clproto) (params r)} |
123 else |
123 else |
124 defaultHedgehogsNumber rm |
124 defaultHedgehogsNumber rm |
125 let newTeam = clNick `seq` TeamInfo clNick tName teamColor grave fort voicepack flag (isRegistered cl) dif hhNum (hhsList hhsInfo) |
125 let newTeam = clNick `seq` TeamInfo clNick tName teamColor grave fort voicepack flag (isRegistered cl) dif hhNum (hhsList hhsInfo) |
126 return $ |
126 return $ |
127 if not . null . drop (teamsNumberLimit rm - 1) $ roomTeams then |
127 if not . null . drop (teamsNumberLimit rm - 1) $ roomTeams then |
128 [Warning $ loc "too many teams"] |
128 [Warning $ loc "Too many teams!"] |
129 else if canAddNumber roomTeams <= 0 then |
129 else if canAddNumber roomTeams <= 0 then |
130 [Warning $ loc "too many hedgehogs"] |
130 [Warning $ loc "Too many hedgehogs!"] |
131 else if isJust $ findTeam rm then |
131 else if isJust $ findTeam rm then |
132 [Warning $ loc "There's already a team with same name in the list"] |
132 [Warning $ loc "There's already a team with same name in the list."] |
133 else if isJust $ gameInfo rm then |
133 else if isJust $ gameInfo rm then |
134 [Warning $ loc "round in progress"] |
134 [Warning $ loc "Joining not possible: Round is in progress."] |
135 else if isRestrictedTeams rm then |
135 else if isRestrictedTeams rm then |
136 [Warning $ loc "restricted"] |
136 [Warning $ loc "This room currently does not allow adding new teams."] |
137 else |
137 else |
138 [ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}), |
138 [ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}), |
139 SendUpdateOnThisRoom, |
139 SendUpdateOnThisRoom, |
140 ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = Just teamColor}), |
140 ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = Just teamColor}), |
141 AnswerClients clChan ["TEAM_ACCEPTED", tName], |
141 AnswerClients clChan ["TEAM_ACCEPTED", tName], |
164 let maybeTeam = findTeam r |
164 let maybeTeam = findTeam r |
165 let team = fromJust maybeTeam |
165 let team = fromJust maybeTeam |
166 |
166 |
167 return $ |
167 return $ |
168 if isNothing $ maybeTeam then |
168 if isNothing $ maybeTeam then |
169 [Warning $ loc "REMOVE_TEAM: no such team"] |
169 [Warning $ loc "Error: The team you tried to remove does not exist."] |
170 else if clNick /= teamowner team then |
170 else if clNick /= teamowner team then |
171 [ProtocolError $ loc "Not team owner!"] |
171 [ProtocolError $ loc "You can't remove a team you don't own."] |
172 else |
172 else |
173 [RemoveTeam tName, |
173 [RemoveTeam tName, |
174 ModifyClient |
174 ModifyClient |
175 (\c -> c{ |
175 (\c -> c{ |
176 teamsInGame = teamsInGame c - 1, |
176 teamsInGame = teamsInGame c - 1, |
191 let maybeTeam = findTeam r |
191 let maybeTeam = findTeam r |
192 let team = fromJust maybeTeam |
192 let team = fromJust maybeTeam |
193 |
193 |
194 return $ |
194 return $ |
195 if not $ isMaster cl then |
195 if not $ isMaster cl then |
196 [ProtocolError $ loc "Not room master"] |
196 [ProtocolError $ loc "You're not the room master!"] |
197 else if isNothing maybeTeam then |
197 else if isNothing maybeTeam then |
198 [] |
198 [] |
199 else if hhNumber < 1 || hhNumber > 8 || hhNumber > canAddNumber r + hhnum team then |
199 else if hhNumber < 1 || hhNumber > 8 || hhNumber > canAddNumber r + hhnum team then |
200 [AnswerClients clChan ["HH_NUM", teamName, showB $ hhnum team]] |
200 [AnswerClients clChan ["HH_NUM", teamName, showB $ hhnum team]] |
201 else |
201 else |
218 maybeClientId <- clientByNick $ teamowner team |
218 maybeClientId <- clientByNick $ teamowner team |
219 let teamOwnerId = fromJust maybeClientId |
219 let teamOwnerId = fromJust maybeClientId |
220 |
220 |
221 return $ |
221 return $ |
222 if not $ isMaster cl then |
222 if not $ isMaster cl then |
223 [ProtocolError $ loc "Not room master"] |
223 [ProtocolError $ loc "You're not the room master!"] |
224 else if isNothing maybeTeam || isNothing maybeClientId then |
224 else if isNothing maybeTeam || isNothing maybeClientId then |
225 [] |
225 [] |
226 else |
226 else |
227 [ModifyRoom $ modifyTeam team{teamcolor = newColor}, |
227 [ModifyRoom $ modifyTeam team{teamcolor = newColor}, |
228 AnswerClients others ["TEAM_COLOR", teamName, newColor], |
228 AnswerClients others ["TEAM_COLOR", teamName, newColor], |
312 rm <- thisRoom |
312 rm <- thisRoom |
313 chans <- sameProtoChans |
313 chans <- sameProtoChans |
314 |
314 |
315 return $ |
315 return $ |
316 if illegalName newName then |
316 if illegalName newName then |
317 [Warning $ loc "Illegal room name"] |
317 [Warning $ loc "Illegal room name! The room name must be between 1-40 characters long, must not have a trailing or leading space and must not have any of these characters: $()*+?[]^{|}"] |
318 else |
318 else |
319 if isSpecial rm then |
319 if isSpecial rm then |
320 [Warning $ loc "Restricted"] |
320 [Warning $ loc "Access denied."] |
321 else |
321 else |
322 if isJust $ find (\r -> newName == name r) rs then |
322 if isJust $ find (\r -> newName == name r) rs then |
323 [Warning $ loc "Room with such name already exists"] |
323 [Warning $ loc "A room with the same name already exists."] |
324 else |
324 else |
325 [ModifyRoom roomUpdate, |
325 [ModifyRoom roomUpdate, |
326 AnswerClients chans ("ROOM" : "UPD" : name rm : roomInfo (clientProto cl) (nick cl) (roomUpdate rm))] |
326 AnswerClients chans ("ROOM" : "UPD" : name rm : roomInfo (clientProto cl) (nick cl) (roomUpdate rm))] |
327 where |
327 where |
328 roomUpdate r = r{name = newName} |
328 roomUpdate r = r{name = newName} |
416 ["CHAT", "[server]", loc "Available callvote commands: kick <nickname>, map <name>, pause, newseed, hedgehogs"] |
416 ["CHAT", "[server]", loc "Available callvote commands: kick <nickname>, map <name>, pause, newseed, hedgehogs"] |
417 ] |
417 ] |
418 |
418 |
419 handleCmd_inRoom ["CALLVOTE", "KICK"] = do |
419 handleCmd_inRoom ["CALLVOTE", "KICK"] = do |
420 cl <- thisClient |
420 cl <- thisClient |
421 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "callvote kick: specify nickname"]] |
421 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "/callvote kick: You need to specify a nickname."]] |
422 |
422 |
423 handleCmd_inRoom ["CALLVOTE", "KICK", nickname] = do |
423 handleCmd_inRoom ["CALLVOTE", "KICK", nickname] = do |
424 (thisClientId, rnc) <- ask |
424 (thisClientId, rnc) <- ask |
425 cl <- thisClient |
425 cl <- thisClient |
426 rm <- thisRoom |
426 rm <- thisRoom |
432 return [] |
432 return [] |
433 else |
433 else |
434 if isJust maybeClientId && sameRoom then |
434 if isJust maybeClientId && sameRoom then |
435 startVote $ VoteKick nickname |
435 startVote $ VoteKick nickname |
436 else |
436 else |
437 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "callvote kick: no such user"]] |
437 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "/callvote kick: No such user!"]] |
438 |
438 |
439 |
439 |
440 handleCmd_inRoom ["CALLVOTE", "MAP"] = do |
440 handleCmd_inRoom ["CALLVOTE", "MAP"] = do |
441 cl <- thisClient |
441 cl <- thisClient |
442 s <- liftM (Map.keys . roomSaves) thisRoom |
442 s <- liftM (Map.keys . roomSaves) thisRoom |
448 rm <- thisRoom |
448 rm <- thisRoom |
449 |
449 |
450 if Map.member roomSave $ roomSaves rm then |
450 if Map.member roomSave $ roomSaves rm then |
451 startVote $ VoteMap roomSave |
451 startVote $ VoteMap roomSave |
452 else |
452 else |
453 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "callvote map: no such map"]] |
453 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "/callvote map: No such map!"]] |
454 |
454 |
455 |
455 |
456 handleCmd_inRoom ["CALLVOTE", "PAUSE"] = do |
456 handleCmd_inRoom ["CALLVOTE", "PAUSE"] = do |
457 cl <- thisClient |
457 cl <- thisClient |
458 rm <- thisRoom |
458 rm <- thisRoom |
459 |
459 |
460 if isJust $ gameInfo rm then |
460 if isJust $ gameInfo rm then |
461 startVote VotePause |
461 startVote VotePause |
462 else |
462 else |
463 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "callvote pause: no game in progress"]] |
463 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "/callvote pause: No game in progress!"]] |
464 |
464 |
465 |
465 |
466 handleCmd_inRoom ["CALLVOTE", "NEWSEED"] = do |
466 handleCmd_inRoom ["CALLVOTE", "NEWSEED"] = do |
467 startVote VoteNewSeed |
467 startVote VoteNewSeed |
468 |
468 |
469 |
469 |
470 handleCmd_inRoom ["CALLVOTE", "HEDGEHOGS"] = do |
470 handleCmd_inRoom ["CALLVOTE", "HEDGEHOGS"] = do |
471 cl <- thisClient |
471 cl <- thisClient |
472 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "callvote hedgehogs: specify number from 1 to 8"]] |
472 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "/callvote hedgehogs: Specify number from 1 to 8."]] |
473 |
473 |
474 |
474 |
475 handleCmd_inRoom ["CALLVOTE", "HEDGEHOGS", hhs] = do |
475 handleCmd_inRoom ["CALLVOTE", "HEDGEHOGS", hhs] = do |
476 cl <- thisClient |
476 cl <- thisClient |
477 let h = readInt_ hhs |
477 let h = readInt_ hhs |
478 |
478 |
479 if h > 0 && h <= 8 then |
479 if h > 0 && h <= 8 then |
480 startVote $ VoteHedgehogsPerTeam h |
480 startVote $ VoteHedgehogsPerTeam h |
481 else |
481 else |
482 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "callvote hedgehogs: specify number from 1 to 8"]] |
482 return [AnswerClients [sendChan cl] ["CHAT", "[server]", loc "/callvote hedgehogs: Specify number from 1 to 8."]] |
483 |
483 |
484 |
484 |
485 handleCmd_inRoom ("VOTE" : m : p) = do |
485 handleCmd_inRoom ("VOTE" : m : p) = do |
486 cl <- thisClient |
486 cl <- thisClient |
487 let b = if m == "YES" then Just True else if m == "NO" then Just False else Nothing |
487 let b = if m == "YES" then Just True else if m == "NO" then Just False else Nothing |
488 if isJust b then |
488 if isJust b then |
489 voted (p == ["FORCE"]) (fromJust b) |
489 voted (p == ["FORCE"]) (fromJust b) |
490 else |
490 else |
491 return [AnswerClients [sendChan cl] ["CHAT", "[server]", "vote: 'yes' or 'no'"]] |
491 return [AnswerClients [sendChan cl] ["CHAT", "[server]", "/vote: Please use 'yes' or 'no'."]] |
492 |
492 |
493 |
493 |
494 handleCmd_inRoom ["SAVE", stateName, location] = serverAdminOnly $ do |
494 handleCmd_inRoom ["SAVE", stateName, location] = serverAdminOnly $ do |
495 return [ModifyRoom $ \r -> r{roomSaves = Map.insert stateName (location, mapParams r, params r) (roomSaves r)}] |
495 return [ModifyRoom $ \r -> r{roomSaves = Map.insert stateName (location, mapParams r, params r) (roomSaves r)}] |
496 |
496 |