57 teamColor <- |
57 teamColor <- |
58 if clientProto cl < 42 then |
58 if clientProto cl < 42 then |
59 return color |
59 return color |
60 else |
60 else |
61 liftM (head . (L.\\) (map B.singleton ['0'..]) . map teamcolor . teams) thisRoom |
61 liftM (head . (L.\\) (map B.singleton ['0'..]) . map teamcolor . teams) thisRoom |
|
62 let newTeam = clNick `seq` TeamInfo ci clNick tName teamColor grave fort voicepack flag dif (newTeamHHNum rm) (hhsList hhsInfo) |
62 return $ |
63 return $ |
63 if not . null . drop (maxTeams rm - 1) $ teams rm then |
64 if not . null . drop (maxTeams rm - 1) $ teams rm then |
64 [Warning "too many teams"] |
65 [Warning "too many teams"] |
65 else if canAddNumber rm <= 0 then |
66 else if canAddNumber rm <= 0 then |
66 [Warning "too many hedgehogs"] |
67 [Warning "too many hedgehogs"] |
69 else if isJust $ gameInfo rm then |
70 else if isJust $ gameInfo rm then |
70 [Warning "round in progress"] |
71 [Warning "round in progress"] |
71 else if isRestrictedTeams rm then |
72 else if isRestrictedTeams rm then |
72 [Warning "restricted"] |
73 [Warning "restricted"] |
73 else |
74 else |
74 [ModifyRoom (\r -> r{teams = teams r ++ [newTeam ci clNick r teamColor]}), |
75 [ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}), |
75 SendUpdateOnThisRoom, |
76 SendUpdateOnThisRoom, |
76 ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = Just teamColor}), |
77 ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = Just teamColor}), |
77 AnswerClients clChan ["TEAM_ACCEPTED", tName], |
78 AnswerClients clChan ["TEAM_ACCEPTED", tName], |
78 AnswerClients othChans $ teamToNet $ newTeam ci clNick rm teamColor, |
79 AnswerClients othChans $ teamToNet $ newTeam, |
79 AnswerClients roomChans ["TEAM_COLOR", tName, teamColor] |
80 AnswerClients roomChans ["TEAM_COLOR", tName, teamColor] |
80 ] |
81 ] |
81 where |
82 where |
82 canAddNumber r = 48 - (sum . map hhnum $ teams r) |
83 canAddNumber r = 48 - (sum . map hhnum $ teams r) |
83 findTeam = find (\t -> tName == teamname t) . teams |
84 findTeam = find (\t -> tName == teamname t) . teams |
84 newTeam ci clNick r tColor = TeamInfo ci clNick tName tColor grave fort voicepack flag dif (newTeamHHNum r) (hhsList hhsInfo) |
|
85 dif = readInt_ difStr |
85 dif = readInt_ difStr |
86 hhsList [] = [] |
86 hhsList [] = [] |
87 hhsList [_] = error "Hedgehogs list with odd elements number" |
87 hhsList [_] = error "Hedgehogs list with odd elements number" |
88 hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs |
88 hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs |
89 newTeamHHNum r = min 4 (canAddNumber r) |
89 newTeamHHNum r = min 4 (canAddNumber r) |