1 {-# LANGUAGE OverloadedStrings #-} |
1 {-# LANGUAGE OverloadedStrings #-} |
2 module HWProtoInRoomState where |
2 module HWProtoInRoomState where |
3 |
3 |
4 import qualified Data.Map as Map |
4 import qualified Data.Map as Map |
5 import Data.Sequence((|>), empty) |
5 import Data.Sequence((|>)) |
6 import Data.List |
6 import Data.List |
7 import Data.Maybe |
7 import Data.Maybe |
8 import qualified Data.ByteString.Char8 as B |
8 import qualified Data.ByteString.Char8 as B |
9 import Control.Monad |
9 import Control.Monad |
10 import Control.Monad.Reader |
10 import Control.Monad.Reader |
77 dif = readInt_ difStr |
77 dif = readInt_ difStr |
78 hhsList [] = [] |
78 hhsList [] = [] |
79 hhsList [_] = error "Hedgehogs list with odd elements number" |
79 hhsList [_] = error "Hedgehogs list with odd elements number" |
80 hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs |
80 hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs |
81 newTeamHHNum r = min 4 (canAddNumber r) |
81 newTeamHHNum r = min 4 (canAddNumber r) |
82 maxTeams r |
82 maxTeams r |
83 | roomProto r < 38 = 6 |
83 | roomProto r < 38 = 6 |
84 | otherwise = 8 |
84 | otherwise = 8 |
85 |
85 |
86 |
86 |
87 handleCmd_inRoom ["REMOVE_TEAM", tName] = do |
87 handleCmd_inRoom ["REMOVE_TEAM", tName] = do |
88 (ci, _) <- ask |
88 (ci, _) <- ask |
89 r <- thisRoom |
89 r <- thisRoom |
90 clNick <- clientNick |
90 clNick <- clientNick |
155 |
155 |
156 |
156 |
157 handleCmd_inRoom ["TOGGLE_READY"] = do |
157 handleCmd_inRoom ["TOGGLE_READY"] = do |
158 cl <- thisClient |
158 cl <- thisClient |
159 chans <- roomClientsChans |
159 chans <- roomClientsChans |
160 return [ |
160 if isMaster cl then |
161 ModifyClient (\c -> c{isReady = not $ isReady cl}), |
161 return [] |
162 ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady cl then -1 else 1)}), |
162 else |
163 AnswerClients chans $ if clientProto cl < 38 then |
163 return [ |
164 [if isReady cl then "NOT_READY" else "READY", nick cl] |
164 ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady cl then -1 else 1)}), |
165 else |
165 ModifyClient (\c -> c{isReady = not $ isReady cl}), |
166 ["CLIENT_FLAGS", if isReady cl then "-r" else "+r", nick cl] |
166 AnswerClients chans $ if clientProto cl < 38 then |
167 ] |
167 [if isReady cl then "NOT_READY" else "READY", nick cl] |
|
168 else |
|
169 ["CLIENT_FLAGS", if isReady cl then "-r" else "+r", nick cl] |
|
170 ] |
168 |
171 |
169 handleCmd_inRoom ["START_GAME"] = do |
172 handleCmd_inRoom ["START_GAME"] = do |
170 (ci, rnc) <- ask |
173 (ci, rnc) <- ask |
171 cl <- thisClient |
174 cl <- thisClient |
172 rm <- thisRoom |
175 rm <- thisRoom |
173 chans <- roomClientsChans |
176 chans <- roomClientsChans |
174 |
177 |
|
178 let nicks = map (nick . client rnc) . roomClients rnc $ clientRoom rnc ci |
175 let allPlayersRegistered = all ((<) 0 . B.length . webPassword . client rnc . teamownerId) $ teams rm |
179 let allPlayersRegistered = all ((<) 0 . B.length . webPassword . client rnc . teamownerId) $ teams rm |
176 |
180 |
177 if isMaster cl && playersIn rm == readyPlayers rm && not (isJust $ gameInfo rm) then |
181 if isMaster cl && playersIn rm == readyPlayers rm && not (isJust $ gameInfo rm) then |
178 if enoughClans rm then |
182 if enoughClans rm then |
179 return [ |
183 return [ |
180 ModifyRoom |
184 ModifyRoom |
181 (\r -> r{ |
185 (\r -> r{ |
182 gameInfo = Just $ newGameInfo allPlayersRegistered (mapParams rm) (params rm) |
186 gameInfo = Just $ newGameInfo (teams rm) (length $ teams rm) allPlayersRegistered (mapParams rm) (params rm) |
183 } |
187 } |
184 ), |
188 ) |
185 AnswerClients chans ["RUN_GAME"] |
189 , AnswerClients chans ["RUN_GAME"] |
|
190 , AnswerClients chans $ "CLIENT_FLAGS" : "+g" : nicks |
|
191 , ModifyRoomClients (\c -> c{isInGame = True}) |
186 ] |
192 ] |
187 else |
193 else |
188 return [Warning "Less than two clans!"] |
194 return [Warning "Less than two clans!"] |
189 else |
195 else |
190 return [] |
196 return [] |
208 handleCmd_inRoom ["ROUNDFINISHED", correctly] = do |
214 handleCmd_inRoom ["ROUNDFINISHED", correctly] = do |
209 cl <- thisClient |
215 cl <- thisClient |
210 rm <- thisRoom |
216 rm <- thisRoom |
211 chans <- roomClientsChans |
217 chans <- roomClientsChans |
212 |
218 |
213 if isMaster cl && (isJust $ gameInfo rm) then |
219 let clTeams = map teamname . filter (\t -> teamowner t == nick cl) . teams $ rm |
214 return $ |
220 let unsetInGameState = [AnswerClients chans ["CLIENT_FLAGS", "-g", nick cl], ModifyClient (\c -> c{isInGame = False})] |
215 SaveReplay |
221 |
216 : ModifyRoom |
222 if isInGame cl then |
217 (\r -> r{ |
223 if isJust $ gameInfo rm then |
218 gameInfo = Nothing, |
224 if (isMaster cl && isCorrect) then |
219 readyPlayers = 0 |
225 return $ FinishGame : unsetInGameState |
220 } |
226 else |
221 ) |
227 return $ unsetInGameState ++ map SendTeamRemovalMessage clTeams |
222 : UnreadyRoomClients |
228 else |
223 : answerRemovedTeams chans rm |
229 return unsetInGameState |
224 else |
230 else |
225 return [] |
231 return [] -- don't accept this message twice |
226 where |
232 where |
227 answerRemovedTeams chans = map (\t -> AnswerClients chans ["REMOVE_TEAM", t]) . leftTeams . fromJust . gameInfo |
|
228 isCorrect = correctly == "1" |
233 isCorrect = correctly == "1" |
229 |
234 |
230 -- compatibility with clients with protocol < 38 |
235 -- compatibility with clients with protocol < 38 |
231 handleCmd_inRoom ["ROUNDFINISHED"] = |
236 handleCmd_inRoom ["ROUNDFINISHED"] = |
232 handleCmd_inRoom ["ROUNDFINISHED", "1"] |
237 handleCmd_inRoom ["ROUNDFINISHED", "1"] |
250 |
255 |
251 |
256 |
252 handleCmd_inRoom ["ROOM_NAME", newName] = do |
257 handleCmd_inRoom ["ROOM_NAME", newName] = do |
253 cl <- thisClient |
258 cl <- thisClient |
254 rs <- allRoomInfos |
259 rs <- allRoomInfos |
255 |
260 rm <- thisRoom |
|
261 chans <- sameProtoChans |
|
262 |
256 return $ |
263 return $ |
257 if not $ isMaster cl then |
264 if not $ isMaster cl then |
258 [ProtocolError "Not room master"] |
265 [ProtocolError "Not room master"] |
259 else |
266 else |
260 if isJust $ find (\r -> newName == name r) rs then |
267 if isJust $ find (\r -> newName == name r) rs then |
261 [Warning "Room with such name already exists"] |
268 [Warning "Room with such name already exists"] |
262 else |
269 else |
263 [ModifyRoom (\r -> r{name = newName})] |
270 [ModifyRoom roomUpdate, |
|
271 AnswerClients chans ("ROOM" : "UPD" : name rm : roomInfo (nick cl) (roomUpdate rm))] |
|
272 where |
|
273 roomUpdate r = r{name = newName} |
264 |
274 |
265 |
275 |
266 handleCmd_inRoom ["KICK", kickNick] = do |
276 handleCmd_inRoom ["KICK", kickNick] = do |
267 (thisClientId, rnc) <- ask |
277 (thisClientId, rnc) <- ask |
268 maybeClientId <- clientByNick kickNick |
278 maybeClientId <- clientByNick kickNick |
278 chans <- roomSameClanChans |
288 chans <- roomSameClanChans |
279 return [AnswerClients chans ["EM", engineMsg cl]] |
289 return [AnswerClients chans ["EM", engineMsg cl]] |
280 where |
290 where |
281 engineMsg cl = toEngineMsg $ B.concat ["b", nick cl, "(team): ", msg, "\x20\x20"] |
291 engineMsg cl = toEngineMsg $ B.concat ["b", nick cl, "(team): ", msg, "\x20\x20"] |
282 |
292 |
283 handleCmd_inRoom _ = return [ProtocolError "Incorrect command (state: in room)"] |
293 handleCmd_inRoom ["BAN", banNick] = do |
|
294 (_, rnc) <- ask |
|
295 maybeClientId <- clientByNick banNick |
|
296 let banId = fromJust maybeClientId |
|
297 master <- liftM isMaster thisClient |
|
298 return [ModifyRoom (\r -> r{roomBansList = (host $ rnc `client` banId) : roomBansList r}) | master && isJust maybeClientId] |
|
299 |
|
300 |
|
301 handleCmd_inRoom ["LIST"] = return [] -- for old clients (<= 0.9.17) |
|
302 |
|
303 handleCmd_inRoom (s:_) = return [ProtocolError $ "Incorrect command '" `B.append` s `B.append` "' (state: in room)"] |
|
304 |
|
305 handleCmd_inRoom [] = return [ProtocolError "Empty command (state: in room)"] |