56 teamColor <- |
56 teamColor <- |
57 if clientProto cl < 42 then |
57 if clientProto cl < 42 then |
58 return color |
58 return color |
59 else |
59 else |
60 liftM (head . (L.\\) (map B.singleton ['0'..]) . map teamcolor . teams) thisRoom |
60 liftM (head . (L.\\) (map B.singleton ['0'..]) . map teamcolor . teams) thisRoom |
61 let newTeam = clNick `seq` TeamInfo ci clNick tName teamColor grave fort voicepack flag dif (newTeamHHNum rm) (hhsList hhsInfo) |
61 let roomTeams = teams rm |
|
62 let hhNum = let p = if not $ null roomTeams then hhnum $ head roomTeams else 4 in newTeamHHNum roomTeams p |
|
63 let newTeam = clNick `seq` TeamInfo ci clNick tName teamColor grave fort voicepack flag dif hhNum (hhsList hhsInfo) |
62 return $ |
64 return $ |
63 if not . null . drop (maxTeams rm - 1) $ teams rm then |
65 if not . null . drop (maxTeams rm - 1) $ roomTeams then |
64 [Warning $ loc "too many teams"] |
66 [Warning $ loc "too many teams"] |
65 else if canAddNumber rm <= 0 then |
67 else if canAddNumber roomTeams <= 0 then |
66 [Warning $ loc "too many hedgehogs"] |
68 [Warning $ loc "too many hedgehogs"] |
67 else if isJust $ findTeam rm then |
69 else if isJust $ findTeam rm then |
68 [Warning $ loc "There's already a team with same name in the list"] |
70 [Warning $ loc "There's already a team with same name in the list"] |
69 else if isJust $ gameInfo rm then |
71 else if isJust $ gameInfo rm then |
70 [Warning $ loc "round in progress"] |
72 [Warning $ loc "round in progress"] |
73 else |
75 else |
74 [ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}), |
76 [ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}), |
75 SendUpdateOnThisRoom, |
77 SendUpdateOnThisRoom, |
76 ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = Just teamColor}), |
78 ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = Just teamColor}), |
77 AnswerClients clChan ["TEAM_ACCEPTED", tName], |
79 AnswerClients clChan ["TEAM_ACCEPTED", tName], |
|
80 AnswerClients clChan ["HH_NUM", tName, showB $ hhnum newTeam], |
78 AnswerClients othChans $ teamToNet $ newTeam, |
81 AnswerClients othChans $ teamToNet $ newTeam, |
79 AnswerClients roomChans ["TEAM_COLOR", tName, teamColor] |
82 AnswerClients roomChans ["TEAM_COLOR", tName, teamColor] |
80 ] |
83 ] |
81 where |
84 where |
82 canAddNumber r = 48 - (sum . map hhnum $ teams r) |
85 canAddNumber rt = (48::Int) - (sum $ map hhnum rt) |
83 findTeam = find (\t -> tName == teamname t) . teams |
86 findTeam = find (\t -> tName == teamname t) . teams |
84 dif = readInt_ difStr |
87 dif = readInt_ difStr |
85 hhsList [] = [] |
88 hhsList [] = [] |
86 hhsList [_] = error "Hedgehogs list with odd elements number" |
89 hhsList [_] = error "Hedgehogs list with odd elements number" |
87 hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs |
90 hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs |
88 newTeamHHNum r = min 4 (canAddNumber r) |
91 newTeamHHNum rt p = min p (canAddNumber rt) |
89 maxTeams r |
92 maxTeams r |
90 | roomProto r < 38 = 6 |
93 | roomProto r < 38 = 6 |
91 | otherwise = 8 |
94 | otherwise = 8 |
92 |
95 |
93 |
96 |
117 findTeam = find (\t -> tName == teamname t) . teams |
120 findTeam = find (\t -> tName == teamname t) . teams |
118 |
121 |
119 |
122 |
120 handleCmd_inRoom ["HH_NUM", teamName, numberStr] = do |
123 handleCmd_inRoom ["HH_NUM", teamName, numberStr] = do |
121 cl <- thisClient |
124 cl <- thisClient |
122 others <- roomOthersChans |
|
123 r <- thisRoom |
125 r <- thisRoom |
|
126 clChan <- thisClientChans |
|
127 roomChans <- roomClientsChans |
124 |
128 |
125 let maybeTeam = findTeam r |
129 let maybeTeam = findTeam r |
126 let team = fromJust maybeTeam |
130 let team = fromJust maybeTeam |
127 |
131 |
128 return $ |
132 return $ |
129 if not $ isMaster cl then |
133 if not $ isMaster cl then |
130 [ProtocolError $ loc "Not room master"] |
134 [ProtocolError $ loc "Not room master"] |
131 else if hhNumber < 1 || hhNumber > 8 || isNothing maybeTeam || hhNumber > canAddNumber r + hhnum team then |
135 else if hhNumber < 1 || hhNumber > 8 || isNothing maybeTeam || hhNumber > canAddNumber r + hhnum team then |
132 [] |
136 [AnswerClients clChan ["HH_NUM", teamName, showB $ hhnum team]] |
133 else |
137 else |
134 [ModifyRoom $ modifyTeam team{hhnum = hhNumber}, |
138 [ModifyRoom $ modifyTeam team{hhnum = hhNumber}, |
135 AnswerClients others ["HH_NUM", teamName, showB hhNumber]] |
139 AnswerClients roomChans ["HH_NUM", teamName, showB hhNumber]] |
136 where |
140 where |
137 hhNumber = readInt_ numberStr |
141 hhNumber = readInt_ numberStr |
138 findTeam = find (\t -> teamName == teamname t) . teams |
142 findTeam = find (\t -> teamName == teamname t) . teams |
139 canAddNumber = (-) 48 . sum . map hhnum . teams |
143 canAddNumber = (-) 48 . sum . map hhnum . teams |
140 |
144 |