28 answerConfigParam paramName paramStrs = [(othersInRoom, "CONFIG_PARAM" : paramName : paramStrs)] |
28 answerConfigParam paramName paramStrs = [(othersInRoom, "CONFIG_PARAM" : paramName : paramStrs)] |
29 answerFullConfig room = map toAnswer (Map.toList $ params room) |
29 answerFullConfig room = map toAnswer (Map.toList $ params room) |
30 where |
30 where |
31 toAnswer (paramName, paramStrs) = |
31 toAnswer (paramName, paramStrs) = |
32 (clientOnly, "CONFIG_PARAM" : paramName : paramStrs) |
32 (clientOnly, "CONFIG_PARAM" : paramName : paramStrs) |
33 answerCantAdd = [(clientOnly, ["WARNING", "Too many teams or hedgehogs"])] |
33 answerCantAdd = [(clientOnly, ["WARNING", "Too many teams or hedgehogs, or same name team"])] |
34 answerTeamAccepted team = [(clientOnly, ["TEAM_ACCEPTED", teamname team])] |
34 answerTeamAccepted team = [(clientOnly, ["TEAM_ACCEPTED", teamname team])] |
35 answerAddTeam team = [(othersInRoom, ["ADD_TEAM", teamname team, teamgrave team, teamfort team, show $ difficulty team] ++ hhsInfo)] |
35 answerAddTeam team = [(othersInRoom, ["ADD_TEAM", teamname team, teamgrave team, teamfort team, show $ difficulty team] ++ hhsInfo)] |
36 where |
36 where |
37 hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team |
37 hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team |
38 answerHHNum teamName hhNumber = [(othersInRoom, ["HH_NUM", teamName, show hhNumber])] |
38 answerHHNum teamName hhNumber = [(othersInRoom, ["HH_NUM", teamName, show hhNumber])] |
|
39 answerRemoveTeam teamName = [(othersInRoom, ["REMOVE_TEAM", teamName])] |
39 |
40 |
40 -- Main state-independent cmd handler |
41 -- Main state-independent cmd handler |
41 handleCmd :: CmdHandler |
42 handleCmd :: CmdHandler |
42 handleCmd client _ rooms ("QUIT":xs) = |
43 handleCmd client _ rooms ("QUIT":xs) = |
43 if null (room client) then |
44 if null (room client) then |
130 where |
131 where |
131 clRoom = roomByName (room client) rooms |
132 clRoom = roomByName (room client) rooms |
132 |
133 |
133 handleCmd_inRoom client _ rooms ("ADD_TEAM" : name : color : grave : fort : difStr : hhsInfo) |
134 handleCmd_inRoom client _ rooms ("ADD_TEAM" : name : color : grave : fort : difStr : hhsInfo) |
134 | length hhsInfo == 16 = |
135 | length hhsInfo == 16 = |
135 if length (teams clRoom) == 6 || canAddNumber <= 0 then |
136 if length (teams clRoom) == 6 || canAddNumber <= 0 || isJust findTeam then |
136 (noChangeClients, noChangeRooms, answerCantAdd) |
137 (noChangeClients, noChangeRooms, answerCantAdd) |
137 else |
138 else |
138 (noChangeClients, modifyRoom clRoom{teams = newTeam : teams clRoom}, answerTeamAccepted newTeam ++ answerAddTeam newTeam) |
139 (noChangeClients, modifyRoom clRoom{teams = newTeam : teams clRoom}, answerTeamAccepted newTeam ++ answerAddTeam newTeam) |
139 where |
140 where |
140 clRoom = roomByName (room client) rooms |
141 clRoom = roomByName (room client) rooms |
141 newTeam = (TeamInfo name color grave fort difficulty newTeamHHNum (hhsList hhsInfo)) |
142 newTeam = (TeamInfo name color grave fort difficulty newTeamHHNum (hhsList hhsInfo)) |
|
143 findTeam = find (\t -> name == teamname t) $ teams clRoom |
142 difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int) |
144 difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int) |
143 hhsList [] = [] |
145 hhsList [] = [] |
144 hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs |
146 hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs |
145 canAddNumber = 18 - (sum . map hhnum $ teams clRoom) |
147 canAddNumber = 18 - (sum . map hhnum $ teams clRoom) |
146 newTeamHHNum = min 4 canAddNumber |
148 newTeamHHNum = min 4 canAddNumber |
159 team = fromJust findTeam |
161 team = fromJust findTeam |
160 findTeam = find (\t -> teamName == teamname t) $ teams clRoom |
162 findTeam = find (\t -> teamName == teamname t) $ teams clRoom |
161 clRoom = roomByName (room client) rooms |
163 clRoom = roomByName (room client) rooms |
162 canAddNumber = 18 - (sum . map hhnum $ teams clRoom) |
164 canAddNumber = 18 - (sum . map hhnum $ teams clRoom) |
163 |
165 |
|
166 handleCmd_inRoom client _ rooms ["REMOVE_TEAM", teamName] = |
|
167 if not $ isMaster client then |
|
168 (noChangeClients, noChangeRooms, answerNotMaster) |
|
169 else |
|
170 if noSuchTeam then |
|
171 (noChangeClients, noChangeRooms, answerBadParam) |
|
172 else |
|
173 (noChangeClients, modifyRoom clRoom{teams = filter (\t -> teamName /= teamname t) $ teams clRoom}, answerRemoveTeam teamName) |
|
174 where |
|
175 noSuchTeam = isNothing findTeam |
|
176 team = fromJust findTeam |
|
177 findTeam = find (\t -> teamName == teamname t) $ teams clRoom |
|
178 clRoom = roomByName (room client) rooms |
164 |
179 |
165 handleCmd_inRoom _ _ _ _ = (noChangeClients, noChangeRooms, answerBadCmd) |
180 handleCmd_inRoom _ _ _ _ = (noChangeClients, noChangeRooms, answerBadCmd) |