|
1 module HWProtoLobbyState where |
|
2 |
|
3 import qualified Data.Map as Map |
|
4 import qualified Data.IntMap as IntMap |
|
5 import qualified Data.IntSet as IntSet |
|
6 import Maybe |
|
7 import Data.List |
|
8 -------------------------------------- |
|
9 import CoreTypes |
|
10 import Actions |
|
11 import Answers |
|
12 import Utils |
|
13 |
|
14 answerAllTeams teams = concatMap toAnswer teams |
|
15 where |
|
16 toAnswer team = |
|
17 [AnswerThisClient $ teamToNet team, |
|
18 AnswerThisClient ["TEAM_COLOR", teamname team, teamcolor team], |
|
19 AnswerThisClient ["HH_NUM", teamname team, show $ hhnum team]] |
|
20 |
|
21 handleCmd_lobby :: CmdHandler |
|
22 |
|
23 handleCmd_lobby clID clients rooms ["LIST"] = |
|
24 [AnswerThisClient ("ROOMS" : roomsInfoList)] |
|
25 where |
|
26 roomsInfoList = concatMap roomInfo $ sameProtoRooms |
|
27 sameProtoRooms = filter (\r -> (roomProto r == protocol) && (not $ isRestrictedJoins r)) roomsList |
|
28 roomsList = IntMap.elems rooms |
|
29 protocol = clientProto client |
|
30 client = clients IntMap.! clID |
|
31 roomInfo room = [ |
|
32 name room, |
|
33 (show $ playersIn room) ++ "(" ++ (show $ length $ teams room) ++ ")", |
|
34 show $ gameinprogress room |
|
35 ] |
|
36 |
|
37 handleCmd_lobby clID clients _ ["CHAT_STRING", msg] = |
|
38 [AnswerOthersInRoom ["CHAT_STRING", clientNick, msg]] |
|
39 where |
|
40 clientNick = nick $ clients IntMap.! clID |
|
41 |
|
42 handleCmd_lobby clID clients rooms ["CREATE", newRoom, roomPassword] = |
|
43 if haveSameRoom then |
|
44 [Warning "Room exists"] |
|
45 else |
|
46 [RoomRemoveThisClient, -- leave lobby |
|
47 AddRoom newRoom roomPassword, |
|
48 AnswerThisClient ["NOT_READY", clientNick] |
|
49 ] |
|
50 where |
|
51 clientNick = nick $ clients IntMap.! clID |
|
52 haveSameRoom = isJust $ find (\room -> newRoom == name room) $ IntMap.elems rooms |
|
53 |
|
54 handleCmd_lobby clID clients rooms ["CREATE", newRoom] = |
|
55 handleCmd_lobby clID clients rooms ["CREATE", newRoom, ""] |
|
56 |
|
57 handleCmd_lobby clID clients rooms ["JOIN", roomName, roomPassword] = |
|
58 if noSuchRoom then |
|
59 [Warning "No such room"] |
|
60 else if isRestrictedJoins jRoom then |
|
61 [Warning "Joining restricted"] |
|
62 else if roomPassword /= password jRoom then |
|
63 [Warning "Wrong password"] |
|
64 else |
|
65 [RoomRemoveThisClient, -- leave lobby |
|
66 RoomAddThisClient rID] -- join room |
|
67 ++ answerNicks |
|
68 ++ answerReady |
|
69 ++ [AnswerThisRoom ["NOT_READY", nick client]] |
|
70 ++ answerFullConfig jRoom |
|
71 ++ answerTeams |
|
72 -- ++ watchRound) |
|
73 where |
|
74 noSuchRoom = isNothing mbRoom |
|
75 mbRoom = find (\r -> roomName == name r && roomProto r == clientProto client) $ IntMap.elems rooms |
|
76 jRoom = fromJust mbRoom |
|
77 rID = roomUID jRoom |
|
78 client = clients IntMap.! clID |
|
79 roomClientsIDs = IntSet.elems $ playersIDs jRoom |
|
80 answerNicks = if playersIn jRoom /= 0 then |
|
81 [AnswerThisClient $ ["JOINED"] ++ (map (\clID -> nick $ clients IntMap.! clID) $ roomClientsIDs)] |
|
82 else |
|
83 [] |
|
84 answerReady = |
|
85 map (\c -> AnswerThisClient [if isReady c then "READY" else "NOT_READY", nick c]) $ |
|
86 map (\clID -> clients IntMap.! clID) roomClientsIDs |
|
87 |
|
88 toAnswer (paramName, paramStrs) = AnswerThisClient $ "CFG" : paramName : paramStrs |
|
89 answerFullConfig room = map toAnswer (Map.toList $ params room) |
|
90 {- |
|
91 watchRound = if (roomProto clRoom < 20) || (not $ gameinprogress clRoom) then |
|
92 [] |
|
93 else |
|
94 (answerClientOnly ["RUN_GAME"]) ++ |
|
95 answerClientOnly ("GAMEMSG" : toEngineMsg "e$spectate 1" : (toList $ roundMsgs clRoom)) -} |
|
96 answerTeams = if gameinprogress jRoom then |
|
97 answerAllTeams (teamsAtStart jRoom) |
|
98 else |
|
99 answerAllTeams (teams jRoom) |
|
100 |
|
101 |
|
102 handleCmd_lobby client clients rooms ["JOIN", roomName] = |
|
103 handleCmd_lobby client clients rooms ["JOIN", roomName, ""] |
|
104 |
|
105 handleCmd_lobby clID _ _ _ = [ProtocolError "Incorrect command (state: in lobby)"] |