11 import Miscutils |
11 import Miscutils |
12 import Maybe |
12 import Maybe |
13 import qualified Data.Map as Map |
13 import qualified Data.Map as Map |
14 import Opts |
14 import Opts |
15 |
15 |
16 teamToNet team = ["ADD_TEAM", teamname team, teamgrave team, teamfort team, show $ difficulty team] ++ hhsInfo |
16 teamToNet protocol team = |
|
17 if protocol == 21 then |
|
18 ["ADD_TEAM", teamname team, teamgrave team, teamfort team, show $ difficulty team] ++ hhsInfo |
|
19 else |
|
20 ["ADD_TEAM", teamname team, teamgrave team, teamfort team, teamvoicepack team, show $ difficulty team] ++ hhsInfo |
17 where |
21 where |
18 hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team |
22 hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team |
19 |
23 |
20 makeAnswer :: HandlesSelector -> [String] -> [Answer] |
24 makeAnswer :: HandlesSelector -> [String] -> [Answer] |
21 makeAnswer func msg = [\_ -> (func, msg)] |
25 makeAnswer func msg = [\_ -> (func, msg)] |
58 answerOthersRoom ["BYE", "Room abandoned"] |
62 answerOthersRoom ["BYE", "Room abandoned"] |
59 else |
63 else |
60 answerOthersRoom ["ROOMABANDONED"] |
64 answerOthersRoom ["ROOMABANDONED"] |
61 |
65 |
62 answerChatString nick msg = answerOthersRoom ["CHAT_STRING", nick, msg] |
66 answerChatString nick msg = answerOthersRoom ["CHAT_STRING", nick, msg] |
63 answerAddTeam team = answerOthersRoom $ teamToNet team |
67 answerAddTeam protocol team = answerOthersRoom $ teamToNet protocol team |
64 answerRemoveTeam teamName = answerOthersRoom ["REMOVE_TEAM", teamName] |
68 answerRemoveTeam teamName = answerOthersRoom ["REMOVE_TEAM", teamName] |
65 answerMap mapName = answerOthersRoom ["MAP", mapName] |
69 answerMap mapName = answerOthersRoom ["MAP", mapName] |
66 answerHHNum teamName hhNumber = answerOthersRoom ["HH_NUM", teamName, show hhNumber] |
70 answerHHNum teamName hhNumber = answerOthersRoom ["HH_NUM", teamName, show hhNumber] |
67 answerTeamColor teamName newColor = answerOthersRoom ["TEAM_COLOR", teamName, newColor] |
71 answerTeamColor teamName newColor = answerOthersRoom ["TEAM_COLOR", teamName, newColor] |
68 answerConfigParam paramName paramStrs = answerOthersRoom $ "CONFIG_PARAM" : paramName : paramStrs |
72 answerConfigParam paramName paramStrs = answerOthersRoom $ "CONFIG_PARAM" : paramName : paramStrs |
93 answerFullConfig room = concatMap toAnswer (Map.toList $ params room) ++ (answerClientOnly ["MAP", gamemap room]) |
97 answerFullConfig room = concatMap toAnswer (Map.toList $ params room) ++ (answerClientOnly ["MAP", gamemap room]) |
94 where |
98 where |
95 toAnswer (paramName, paramStrs) = |
99 toAnswer (paramName, paramStrs) = |
96 answerClientOnly $ "CONFIG_PARAM" : paramName : paramStrs |
100 answerClientOnly $ "CONFIG_PARAM" : paramName : paramStrs |
97 |
101 |
98 answerAllTeams room = concatMap toAnswer (teams room) |
102 answerAllTeams protocol room = concatMap toAnswer (teams room) |
99 where |
103 where |
100 toAnswer team = |
104 toAnswer team = |
101 (answerClientOnly $ teamToNet team) ++ |
105 (answerClientOnly $ teamToNet protocol team) ++ |
102 (answerClientOnly ["TEAM_COLOR", teamname team, teamcolor team]) ++ |
106 (answerClientOnly ["TEAM_COLOR", teamname team, teamcolor team]) ++ |
103 (answerClientOnly ["HH_NUM", teamname team, show $ hhnum team]) |
107 (answerClientOnly ["HH_NUM", teamname team, show $ hhnum team]) |
104 |
108 |
105 answerServerMessage client clients = [\serverInfo -> (clientOnly, "SERVER_MESSAGE" : |
109 answerServerMessage client clients = [\serverInfo -> (clientOnly, "SERVER_MESSAGE" : |
106 [(mainbody serverInfo) ++ updateInfo ++ clientsIn ++ (lastHour serverInfo)])] |
110 [(mainbody serverInfo) ++ updateInfo ++ clientsIn ++ (lastHour serverInfo)])] |
234 else if roomPassword /= password clRoom then |
238 else if roomPassword /= password clRoom then |
235 (noChangeClients, noChangeRooms, answerWrongPassword) |
239 (noChangeClients, noChangeRooms, answerWrongPassword) |
236 else if isRestrictedJoins clRoom then |
240 else if isRestrictedJoins clRoom then |
237 (noChangeClients, noChangeRooms, answerRestricted) |
241 (noChangeClients, noChangeRooms, answerRestricted) |
238 else |
242 else |
239 (modifyClient client{room = roomName}, modifyRoom clRoom{playersIn = 1 + playersIn clRoom}, (answerJoined $ nick client) ++ answerNicks ++ answerReady ++ (answerNotReady $ nick client) ++ answerFullConfig clRoom ++ answerAllTeams clRoom ++ watchRound) |
243 (modifyClient client{room = roomName}, modifyRoom clRoom{playersIn = 1 + playersIn clRoom}, (answerJoined $ nick client) ++ answerNicks ++ answerReady ++ (answerNotReady $ nick client) ++ answerFullConfig clRoom ++ answerAllTeams (protocol client) clRoom ++ watchRound) |
240 where |
244 where |
241 noSuchRoom = isNothing $ find (\room -> roomName == name room && roomProto room == protocol client) rooms |
245 noSuchRoom = isNothing $ find (\room -> roomName == name room && roomProto room == protocol client) rooms |
242 answerNicks = answerClientOnly $ ["JOINED"] ++ (map nick $ sameRoomClients) |
246 answerNicks = answerClientOnly $ ["JOINED"] ++ (map nick $ sameRoomClients) |
243 answerReady = concatMap (\c -> answerClientOnly [if isReady c then "READY" else "NOT_READY", nick c]) sameRoomClients |
247 answerReady = concatMap (\c -> answerClientOnly [if isReady c then "READY" else "NOT_READY", nick c]) sameRoomClients |
244 sameRoomClients = filter (\ci -> room ci == roomName) clients |
248 sameRoomClients = filter (\ci -> room ci == roomName) clients |
288 else |
292 else |
289 (noChangeClients, noChangeRooms, answerNotMaster) |
293 (noChangeClients, noChangeRooms, answerNotMaster) |
290 where |
294 where |
291 clRoom = roomByName (room client) rooms |
295 clRoom = roomByName (room client) rooms |
292 |
296 |
293 handleCmd_inRoom client _ rooms ("ADD_TEAM" : name : color : grave : fort : difStr : hhsInfo) |
297 handleCmd_inRoom client _ rooms ("ADD_TEAM" : name : color : grave : fort : voicepack : difStr : hhsInfo) |
294 | length hhsInfo == 16 = |
298 | length hhsInfo == 16 = |
295 if length (teams clRoom) == 6 then |
299 if length (teams clRoom) == 6 then |
296 (noChangeClients, noChangeRooms, answerCantAdd "too many teams") |
300 (noChangeClients, noChangeRooms, answerCantAdd "too many teams") |
297 else if canAddNumber <= 0 then |
301 else if canAddNumber <= 0 then |
298 (noChangeClients, noChangeRooms, answerCantAdd "too many hedgehogs") |
302 (noChangeClients, noChangeRooms, answerCantAdd "too many hedgehogs") |
301 else if gameinprogress clRoom then |
305 else if gameinprogress clRoom then |
302 (noChangeClients, noChangeRooms, answerCantAdd "round in progress") |
306 (noChangeClients, noChangeRooms, answerCantAdd "round in progress") |
303 else if isRestrictedTeams clRoom then |
307 else if isRestrictedTeams clRoom then |
304 (noChangeClients, noChangeRooms, answerCantAdd "restricted") |
308 (noChangeClients, noChangeRooms, answerCantAdd "restricted") |
305 else |
309 else |
306 (noChangeClients, modifyRoom clRoom{teams = teams clRoom ++ [newTeam]}, answerTeamAccepted newTeam ++ answerAddTeam newTeam ++ answerTeamColor name color) |
310 (noChangeClients, modifyRoom clRoom{teams = teams clRoom ++ [newTeam]}, answerTeamAccepted newTeam ++ answerAddTeam (protocol client) newTeam ++ answerTeamColor name color) |
307 where |
311 where |
308 clRoom = roomByName (room client) rooms |
312 clRoom = roomByName (room client) rooms |
309 newTeam = (TeamInfo (nick client) name color grave fort difficulty newTeamHHNum (hhsList hhsInfo)) |
313 newTeam = (TeamInfo (nick client) name color grave fort voicepack difficulty newTeamHHNum (hhsList hhsInfo)) |
310 findTeam = find (\t -> name == teamname t) $ teams clRoom |
314 findTeam = find (\t -> name == teamname t) $ teams clRoom |
311 difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int) |
315 difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int) |
312 hhsList [] = [] |
316 hhsList [] = [] |
313 hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs |
317 hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs |
314 canAddNumber = 18 - (sum . map hhnum $ teams clRoom) |
318 canAddNumber = 18 - (sum . map hhnum $ teams clRoom) |
315 newTeamHHNum = min 4 canAddNumber |
319 newTeamHHNum = min 4 canAddNumber |
316 |
320 |
|
321 handleCmd_inRoom client clients rooms ("ADD_TEAM" : name : color : grave : fort : difStr : hhsInfo) = |
|
322 handleCmd_inRoom client clients rooms ("ADD_TEAM" : name : color : grave : fort : "Default" : difStr : hhsInfo) |
|
323 |
|
324 |
317 handleCmd_inRoom client _ rooms ["HH_NUM", teamName, numberStr] = |
325 handleCmd_inRoom client _ rooms ["HH_NUM", teamName, numberStr] = |
318 if not $ isMaster client then |
326 if not $ isMaster client then |
319 (noChangeClients, noChangeRooms, answerNotMaster) |
327 (noChangeClients, noChangeRooms, answerNotMaster) |
320 else |
328 else |
321 if hhNumber < 1 || hhNumber > 8 || noSuchTeam || hhNumber > (canAddNumber + (hhnum team)) then |
329 if hhNumber < 1 || hhNumber > 8 || noSuchTeam || hhNumber > (canAddNumber + (hhnum team)) then |