12 import Actions |
12 import Actions |
13 import Utils |
13 import Utils |
14 import HandlerUtils |
14 import HandlerUtils |
15 import RoomsAndClients |
15 import RoomsAndClients |
16 import EngineInteraction |
16 import EngineInteraction |
|
17 |
|
18 |
|
19 startGame :: Reader (ClientIndex, IRnC) [Action] |
|
20 startGame = do |
|
21 (ci, rnc) <- ask |
|
22 cl <- thisClient |
|
23 rm <- thisRoom |
|
24 chans <- roomClientsChans |
|
25 |
|
26 let nicks = map (nick . client rnc) . roomClients rnc $ clientRoom rnc ci |
|
27 let allPlayersRegistered = all ((<) 0 . B.length . webPassword . client rnc . teamownerId) $ teams rm |
|
28 |
|
29 if (playersIn rm == readyPlayers rm || clientProto cl > 43) && not (isJust $ gameInfo rm) then |
|
30 if enoughClans rm then |
|
31 return [ |
|
32 ModifyRoom |
|
33 (\r -> r{ |
|
34 gameInfo = Just $ newGameInfo (teams rm) (length $ teams rm) allPlayersRegistered (mapParams rm) (params rm) |
|
35 } |
|
36 ) |
|
37 , AnswerClients chans ["RUN_GAME"] |
|
38 , SendUpdateOnThisRoom |
|
39 , AnswerClients chans $ "CLIENT_FLAGS" : "+g" : nicks |
|
40 , ModifyRoomClients (\c -> c{isInGame = True}) |
|
41 ] |
|
42 else |
|
43 return [Warning $ loc "Less than two clans!"] |
|
44 else |
|
45 return [] |
|
46 where |
|
47 enoughClans = not . null . drop 1 . group . map teamcolor . teams |
|
48 |
|
49 |
17 |
50 |
18 handleCmd_inRoom :: CmdHandler |
51 handleCmd_inRoom :: CmdHandler |
19 |
52 |
20 handleCmd_inRoom ["CHAT", msg] = do |
53 handleCmd_inRoom ["CHAT", msg] = do |
21 n <- clientNick |
54 n <- clientNick |
171 findTeam = find (\t -> teamName == teamname t) . teams |
204 findTeam = find (\t -> teamName == teamname t) . teams |
172 |
205 |
173 |
206 |
174 handleCmd_inRoom ["TOGGLE_READY"] = do |
207 handleCmd_inRoom ["TOGGLE_READY"] = do |
175 cl <- thisClient |
208 cl <- thisClient |
|
209 rm <- thisRoom |
176 chans <- roomClientsChans |
210 chans <- roomClientsChans |
177 |
211 |
178 return [ |
212 (ci, rnc) <- ask |
179 ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady cl then -1 else 1)}), |
213 let ri = clientRoom rnc ci |
180 ModifyClient (\c -> c{isReady = not $ isReady cl}), |
214 let unreadyClients = filter (not . isReady) . map (client rnc) $ roomClients rnc ri |
181 AnswerClients chans $ if clientProto cl < 38 then |
215 |
|
216 gs <- if (not $ isReady cl) && (isSpecial rm) && (unreadyClients == [cl]) then startGame else return [] |
|
217 |
|
218 return $ |
|
219 ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady cl then -1 else 1)}) |
|
220 : ModifyClient (\c -> c{isReady = not $ isReady cl}) |
|
221 : (AnswerClients chans $ if clientProto cl < 38 then |
182 [if isReady cl then "NOT_READY" else "READY", nick cl] |
222 [if isReady cl then "NOT_READY" else "READY", nick cl] |
183 else |
223 else |
184 ["CLIENT_FLAGS", if isReady cl then "-r" else "+r", nick cl] |
224 ["CLIENT_FLAGS", if isReady cl then "-r" else "+r", nick cl]) |
185 ] |
225 : gs |
186 |
226 |
187 |
227 |
188 handleCmd_inRoom ["START_GAME"] = do |
228 handleCmd_inRoom ["START_GAME"] = do |
189 (ci, rnc) <- ask |
229 cl <- thisClient |
190 cl <- thisClient |
230 if isMaster cl then startGame else return [] |
191 rm <- thisRoom |
|
192 chans <- roomClientsChans |
|
193 |
|
194 let nicks = map (nick . client rnc) . roomClients rnc $ clientRoom rnc ci |
|
195 let allPlayersRegistered = all ((<) 0 . B.length . webPassword . client rnc . teamownerId) $ teams rm |
|
196 |
|
197 if isMaster cl && (playersIn rm == readyPlayers rm || clientProto cl > 43) && not (isJust $ gameInfo rm) then |
|
198 if enoughClans rm then |
|
199 return [ |
|
200 ModifyRoom |
|
201 (\r -> r{ |
|
202 gameInfo = Just $ newGameInfo (teams rm) (length $ teams rm) allPlayersRegistered (mapParams rm) (params rm) |
|
203 } |
|
204 ) |
|
205 , AnswerClients chans ["RUN_GAME"] |
|
206 , SendUpdateOnThisRoom |
|
207 , AnswerClients chans $ "CLIENT_FLAGS" : "+g" : nicks |
|
208 , ModifyRoomClients (\c -> c{isInGame = True}) |
|
209 ] |
|
210 else |
|
211 return [Warning $ loc "Less than two clans!"] |
|
212 else |
|
213 return [] |
|
214 where |
|
215 enoughClans = not . null . drop 1 . group . map teamcolor . teams |
|
216 |
|
217 |
231 |
218 handleCmd_inRoom ["EM", msg] = do |
232 handleCmd_inRoom ["EM", msg] = do |
219 cl <- thisClient |
233 cl <- thisClient |
220 rm <- thisRoom |
234 rm <- thisRoom |
221 chans <- roomOthersChans |
235 chans <- roomOthersChans |