14 |
14 |
15 |
15 |
16 handleCmd_inRoom :: CmdHandler |
16 handleCmd_inRoom :: CmdHandler |
17 |
17 |
18 handleCmd_inRoom clID clients _ ["CHAT", msg] = |
18 handleCmd_inRoom clID clients _ ["CHAT", msg] = |
19 [AnswerOthersInRoom ["CHAT", clientNick, msg]] |
19 [AnswerOthersInRoom ["CHAT", clientNick, msg]] |
20 where |
20 where |
21 clientNick = nick $ clients IntMap.! clID |
21 clientNick = nick $ clients IntMap.! clID |
22 |
22 |
23 |
23 |
24 handleCmd_inRoom clID clients _ ["TEAM_CHAT", msg] = |
24 handleCmd_inRoom clID clients _ ["TEAM_CHAT", msg] = |
25 [AnswerOthersInRoom ["TEAM_CHAT", clientNick, msg]] |
25 [AnswerOthersInRoom ["TEAM_CHAT", clientNick, msg]] |
26 where |
26 where |
27 clientNick = nick $ clients IntMap.! clID |
27 clientNick = nick $ clients IntMap.! clID |
28 |
28 |
29 |
29 |
30 handleCmd_inRoom clID clients rooms ["PART"] = |
30 handleCmd_inRoom clID clients rooms ["PART"] = |
31 [RoomRemoveThisClient "part"] |
31 [RoomRemoveThisClient "part"] |
32 where |
32 where |
33 client = clients IntMap.! clID |
33 client = clients IntMap.! clID |
34 |
34 |
35 |
35 |
36 handleCmd_inRoom clID clients rooms ("CFG" : paramName : paramStrs) |
36 handleCmd_inRoom clID clients rooms ("CFG" : paramName : paramStrs) |
37 | null paramStrs = [ProtocolError "Empty config entry"] |
37 | null paramStrs = [ProtocolError "Empty config entry"] |
38 | isMaster client = |
38 | isMaster client = |
39 [ModifyRoom (\r -> r{params = Map.insert paramName paramStrs (params r)}), |
39 [ModifyRoom (\r -> r{params = Map.insert paramName paramStrs (params r)}), |
40 AnswerOthersInRoom ("CFG" : paramName : paramStrs)] |
40 AnswerOthersInRoom ("CFG" : paramName : paramStrs)] |
41 | otherwise = [ProtocolError "Not room master"] |
41 | otherwise = [ProtocolError "Not room master"] |
42 where |
42 where |
43 client = clients IntMap.! clID |
43 client = clients IntMap.! clID |
44 |
44 |
45 handleCmd_inRoom clID clients rooms ("ADD_TEAM" : name : color : grave : fort : voicepack : flag : difStr : hhsInfo) |
45 handleCmd_inRoom clID clients rooms ("ADD_TEAM" : name : color : grave : fort : voicepack : flag : difStr : hhsInfo) |
46 | length hhsInfo /= 16 = [] |
46 | length hhsInfo /= 16 = [] |
47 | length (teams room) == 6 = [Warning "too many teams"] |
47 | length (teams room) == 6 = [Warning "too many teams"] |
48 | canAddNumber <= 0 = [Warning "too many hedgehogs"] |
48 | canAddNumber <= 0 = [Warning "too many hedgehogs"] |
49 | isJust findTeam = [Warning "There's already a team with same name in the list"] |
49 | isJust findTeam = [Warning "There's already a team with same name in the list"] |
50 | gameinprogress room = [Warning "round in progress"] |
50 | gameinprogress room = [Warning "round in progress"] |
51 | isRestrictedTeams room = [Warning "restricted"] |
51 | isRestrictedTeams room = [Warning "restricted"] |
52 | otherwise = |
52 | otherwise = |
53 [ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}), |
53 [ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}), |
54 ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = color}), |
54 ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1, clientClan = color}), |
55 AnswerThisClient ["TEAM_ACCEPTED", name], |
55 AnswerThisClient ["TEAM_ACCEPTED", name], |
56 AnswerOthersInRoom $ teamToNet newTeam, |
56 AnswerOthersInRoom $ teamToNet (clientProto client) newTeam, |
57 AnswerOthersInRoom ["TEAM_COLOR", name, color] |
57 AnswerOthersInRoom ["TEAM_COLOR", name, color] |
58 ] |
58 ] |
59 where |
59 where |
60 client = clients IntMap.! clID |
60 client = clients IntMap.! clID |
61 room = rooms IntMap.! (roomID client) |
61 room = rooms IntMap.! (roomID client) |
62 canAddNumber = 48 - (sum . map hhnum $ teams room) |
62 canAddNumber = 48 - (sum . map hhnum $ teams room) |
63 findTeam = find (\t -> name == teamname t) $ teams room |
63 findTeam = find (\t -> name == teamname t) $ teams room |
64 newTeam = (TeamInfo clID (nick client) name color grave fort voicepack flag difficulty newTeamHHNum (hhsList hhsInfo)) |
64 newTeam = (TeamInfo clID (nick client) name color grave fort voicepack flag difficulty newTeamHHNum (hhsList hhsInfo)) |
65 difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int) |
65 difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int) |
66 hhsList [] = [] |
66 hhsList [] = [] |
67 hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs |
67 hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs |
68 newTeamHHNum = min 4 canAddNumber |
68 newTeamHHNum = min 4 canAddNumber |
|
69 |
|
70 handleCmd_inRoom clID clients rooms ("ADD_TEAM" : name : color : grave : fort : voicepack : difStr : hhsInfo) = |
|
71 handleCmd_inRoom clID clients rooms ("ADD_TEAM" : name : color : grave : fort : voicepack : "" : difStr : hhsInfo) |
69 |
72 |
70 |
73 |
71 handleCmd_inRoom clID clients rooms ["REMOVE_TEAM", teamName] |
74 handleCmd_inRoom clID clients rooms ["REMOVE_TEAM", teamName] |
72 | noSuchTeam = [Warning "REMOVE_TEAM: no such team"] |
75 | noSuchTeam = [Warning "REMOVE_TEAM: no such team"] |
73 | nick client /= teamowner team = [ProtocolError "Not team owner!"] |
76 | nick client /= teamowner team = [ProtocolError "Not team owner!"] |
74 | otherwise = |
77 | otherwise = |
75 [RemoveTeam teamName, |
78 [RemoveTeam teamName, |
76 ModifyClient (\c -> c{teamsInGame = teamsInGame c - 1}) |
79 ModifyClient (\c -> c{teamsInGame = teamsInGame c - 1}) |
77 ] |
80 ] |
78 where |
81 where |
79 client = clients IntMap.! clID |
82 client = clients IntMap.! clID |
80 room = rooms IntMap.! (roomID client) |
83 room = rooms IntMap.! (roomID client) |
81 noSuchTeam = isNothing findTeam |
84 noSuchTeam = isNothing findTeam |
82 team = fromJust findTeam |
85 team = fromJust findTeam |
83 findTeam = find (\t -> teamName == teamname t) $ teams room |
86 findTeam = find (\t -> teamName == teamname t) $ teams room |
84 |
87 |
85 |
88 |
86 handleCmd_inRoom clID clients rooms ["HH_NUM", teamName, numberStr] |
89 handleCmd_inRoom clID clients rooms ["HH_NUM", teamName, numberStr] |
87 | not $ isMaster client = [ProtocolError "Not room master"] |
90 | not $ isMaster client = [ProtocolError "Not room master"] |
88 | hhNumber < 1 || hhNumber > 8 || noSuchTeam || hhNumber > (canAddNumber + (hhnum team)) = [] |
91 | hhNumber < 1 || hhNumber > 8 || noSuchTeam || hhNumber > (canAddNumber + (hhnum team)) = [] |
89 | otherwise = |
92 | otherwise = |
90 [ModifyRoom $ modifyTeam team{hhnum = hhNumber}, |
93 [ModifyRoom $ modifyTeam team{hhnum = hhNumber}, |
91 AnswerOthersInRoom ["HH_NUM", teamName, show hhNumber]] |
94 AnswerOthersInRoom ["HH_NUM", teamName, show hhNumber]] |
92 where |
95 where |
93 client = clients IntMap.! clID |
96 client = clients IntMap.! clID |
94 room = rooms IntMap.! (roomID client) |
97 room = rooms IntMap.! (roomID client) |
95 hhNumber = fromMaybe 0 (maybeRead numberStr :: Maybe Int) |
98 hhNumber = fromMaybe 0 (maybeRead numberStr :: Maybe Int) |
96 noSuchTeam = isNothing findTeam |
99 noSuchTeam = isNothing findTeam |
97 team = fromJust findTeam |
100 team = fromJust findTeam |
98 findTeam = find (\t -> teamName == teamname t) $ teams room |
101 findTeam = find (\t -> teamName == teamname t) $ teams room |
99 canAddNumber = 48 - (sum . map hhnum $ teams room) |
102 canAddNumber = 48 - (sum . map hhnum $ teams room) |
100 |
103 |
101 |
104 |
102 handleCmd_inRoom clID clients rooms ["TEAM_COLOR", teamName, newColor] |
105 handleCmd_inRoom clID clients rooms ["TEAM_COLOR", teamName, newColor] |
103 | not $ isMaster client = [ProtocolError "Not room master"] |
106 | not $ isMaster client = [ProtocolError "Not room master"] |
104 | noSuchTeam = [] |
107 | noSuchTeam = [] |
105 | otherwise = [ModifyRoom $ modifyTeam team{teamcolor = newColor}, |
108 | otherwise = [ModifyRoom $ modifyTeam team{teamcolor = newColor}, |
106 AnswerOthersInRoom ["TEAM_COLOR", teamName, newColor], |
109 AnswerOthersInRoom ["TEAM_COLOR", teamName, newColor], |
107 ModifyClient2 (teamownerId team) (\c -> c{clientClan = newColor})] |
110 ModifyClient2 (teamownerId team) (\c -> c{clientClan = newColor})] |
108 where |
111 where |
109 noSuchTeam = isNothing findTeam |
112 noSuchTeam = isNothing findTeam |
110 team = fromJust findTeam |
113 team = fromJust findTeam |
111 findTeam = find (\t -> teamName == teamname t) $ teams room |
114 findTeam = find (\t -> teamName == teamname t) $ teams room |
112 client = clients IntMap.! clID |
115 client = clients IntMap.! clID |
113 room = rooms IntMap.! (roomID client) |
116 room = rooms IntMap.! (roomID client) |
114 |
117 |
115 |
118 |
116 handleCmd_inRoom clID clients rooms ["TOGGLE_READY"] = |
119 handleCmd_inRoom clID clients rooms ["TOGGLE_READY"] = |
117 [ModifyClient (\c -> c{isReady = not $ isReady client}), |
120 [ModifyClient (\c -> c{isReady = not $ isReady client}), |
118 ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady client then -1 else 1)}), |
121 ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady client then -1 else 1)}), |
119 AnswerThisRoom [if isReady client then "NOT_READY" else "READY", nick client]] |
122 AnswerThisRoom [if isReady client then "NOT_READY" else "READY", nick client]] |
120 where |
123 where |
121 client = clients IntMap.! clID |
124 client = clients IntMap.! clID |
122 |
125 |
123 |
126 |
124 handleCmd_inRoom clID clients rooms ["START_GAME"] = |
127 handleCmd_inRoom clID clients rooms ["START_GAME"] = |
125 if isMaster client && (playersIn room == readyPlayers room) && (not . gameinprogress) room then |
128 if isMaster client && (playersIn room == readyPlayers room) && (not . gameinprogress) room then |
126 if enoughClans then |
129 if enoughClans then |
127 [ModifyRoom |
130 [ModifyRoom |
128 (\r -> r{ |
131 (\r -> r{ |
129 gameinprogress = True, |
132 gameinprogress = True, |
130 roundMsgs = empty, |
133 roundMsgs = empty, |
131 leftTeams = [], |
134 leftTeams = [], |
132 teamsAtStart = teams r} |
135 teamsAtStart = teams r} |
133 ), |
136 ), |
134 AnswerThisRoom ["RUN_GAME"]] |
137 AnswerThisRoom ["RUN_GAME"]] |
135 else |
138 else |
136 [Warning "Less than two clans!"] |
139 [Warning "Less than two clans!"] |
137 else |
140 else |
138 [] |
141 [] |
139 where |
142 where |
140 client = clients IntMap.! clID |
143 client = clients IntMap.! clID |
141 room = rooms IntMap.! (roomID client) |
144 room = rooms IntMap.! (roomID client) |
142 enoughClans = not $ null $ drop 1 $ group $ map teamcolor $ teams room |
145 enoughClans = not $ null $ drop 1 $ group $ map teamcolor $ teams room |
143 |
146 |
144 |
147 |
145 handleCmd_inRoom clID clients rooms ["EM", msg] = |
148 handleCmd_inRoom clID clients rooms ["EM", msg] = |
146 if (teamsInGame client > 0) && isLegal then |
149 if (teamsInGame client > 0) && isLegal then |
147 (AnswerOthersInRoom ["EM", msg]) : [ModifyRoom (\r -> r{roundMsgs = roundMsgs r |> msg}) | not isKeepAlive] |
150 (AnswerOthersInRoom ["EM", msg]) : [ModifyRoom (\r -> r{roundMsgs = roundMsgs r |> msg}) | not isKeepAlive] |
148 else |
151 else |
149 [] |
152 [] |
150 where |
153 where |
151 client = clients IntMap.! clID |
154 client = clients IntMap.! clID |
152 (isLegal, isKeepAlive) = checkNetCmd msg |
155 (isLegal, isKeepAlive) = checkNetCmd msg |
153 |
156 |
154 handleCmd_inRoom clID clients rooms ["ROUNDFINISHED"] = |
157 handleCmd_inRoom clID clients rooms ["ROUNDFINISHED"] = |
155 if isMaster client then |
158 if isMaster client then |
156 [ModifyRoom |
159 [ModifyRoom |
157 (\r -> r{ |
160 (\r -> r{ |
158 gameinprogress = False, |
161 gameinprogress = False, |
159 readyPlayers = 0, |
162 readyPlayers = 0, |
160 roundMsgs = empty, |
163 roundMsgs = empty, |
161 leftTeams = [], |
164 leftTeams = [], |
162 teamsAtStart = []} |
165 teamsAtStart = []} |
163 ), |
166 ), |
164 UnreadyRoomClients |
167 UnreadyRoomClients |
165 ] ++ answerRemovedTeams |
168 ] ++ answerRemovedTeams |
166 else |
169 else |
167 [] |
170 [] |
168 where |
171 where |
169 client = clients IntMap.! clID |
172 client = clients IntMap.! clID |
170 room = rooms IntMap.! (roomID client) |
173 room = rooms IntMap.! (roomID client) |
171 answerRemovedTeams = map (\t -> AnswerThisRoom ["REMOVE_TEAM", t]) $ leftTeams room |
174 answerRemovedTeams = map (\t -> AnswerThisRoom ["REMOVE_TEAM", t]) $ leftTeams room |
172 |
175 |
173 |
176 |
174 handleCmd_inRoom clID clients _ ["TOGGLE_RESTRICT_JOINS"] |
177 handleCmd_inRoom clID clients _ ["TOGGLE_RESTRICT_JOINS"] |
175 | isMaster client = [ModifyRoom (\r -> r{isRestrictedJoins = not $ isRestrictedJoins r})] |
178 | isMaster client = [ModifyRoom (\r -> r{isRestrictedJoins = not $ isRestrictedJoins r})] |
176 | otherwise = [ProtocolError "Not room master"] |
179 | otherwise = [ProtocolError "Not room master"] |
177 where |
180 where |
178 client = clients IntMap.! clID |
181 client = clients IntMap.! clID |
179 |
182 |
180 |
183 |
181 handleCmd_inRoom clID clients _ ["TOGGLE_RESTRICT_TEAMS"] |
184 handleCmd_inRoom clID clients _ ["TOGGLE_RESTRICT_TEAMS"] |
182 | isMaster client = [ModifyRoom (\r -> r{isRestrictedTeams = not $ isRestrictedTeams r})] |
185 | isMaster client = [ModifyRoom (\r -> r{isRestrictedTeams = not $ isRestrictedTeams r})] |
183 | otherwise = [ProtocolError "Not room master"] |
186 | otherwise = [ProtocolError "Not room master"] |
184 where |
187 where |
185 client = clients IntMap.! clID |
188 client = clients IntMap.! clID |
186 |
189 |
187 handleCmd_inRoom clID clients rooms ["KICK", kickNick] = |
190 handleCmd_inRoom clID clients rooms ["KICK", kickNick] = |
188 [KickRoomClient kickID | isMaster client && not noSuchClient && (kickID /= clID) && (roomID client == roomID kickClient)] |
191 [KickRoomClient kickID | isMaster client && not noSuchClient && (kickID /= clID) && (roomID client == roomID kickClient)] |
189 where |
192 where |
190 client = clients IntMap.! clID |
193 client = clients IntMap.! clID |
191 maybeClient = Foldable.find (\cl -> kickNick == nick cl) clients |
194 maybeClient = Foldable.find (\cl -> kickNick == nick cl) clients |
192 noSuchClient = isNothing maybeClient |
195 noSuchClient = isNothing maybeClient |
193 kickClient = fromJust maybeClient |
196 kickClient = fromJust maybeClient |
194 kickID = clientUID kickClient |
197 kickID = clientUID kickClient |
195 |
198 |
196 |
199 |
197 handleCmd_inRoom clID clients _ ["TEAMCHAT", msg] = |
200 handleCmd_inRoom clID clients _ ["TEAMCHAT", msg] = |
198 if (teamsInGame client > 0) then |
201 if (teamsInGame client > 0) then |
199 [AnswerSameClan ["EM", engineMsg]] |
202 [AnswerSameClan ["EM", engineMsg]] |
200 else |
203 else |
201 [] |
204 [] |
202 where |
205 where |
203 client = clients IntMap.! clID |
206 client = clients IntMap.! clID |
204 engineMsg = toEngineMsg $ 'b' : (nick client ++ "(team): " ++ decodedMsg ++ "\x20\x20") |
207 engineMsg = toEngineMsg $ 'b' : (nick client ++ "(team): " ++ decodedMsg ++ "\x20\x20") |
205 decodedMsg = UTF8.decodeString msg |
208 decodedMsg = UTF8.decodeString msg |
206 |
209 |
207 handleCmd_inRoom clID _ _ _ = [ProtocolError "Incorrect command (state: in room)"] |
210 handleCmd_inRoom clID _ _ _ = [ProtocolError "Incorrect command (state: in room)"] |