|
1804
|
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
|
|
1813
|
6 |
import qualified Data.Foldable as Foldable
|
|
1804
|
7 |
import Maybe
|
|
|
8 |
import Data.List
|
|
|
9 |
--------------------------------------
|
|
|
10 |
import CoreTypes
|
|
|
11 |
import Actions
|
|
|
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 |
|
|
1862
|
37 |
|
|
1815
|
38 |
handleCmd_lobby clID clients _ ["CHAT", msg] =
|
|
|
39 |
[AnswerOthersInRoom ["CHAT", clientNick, msg]]
|
|
1804
|
40 |
where
|
|
|
41 |
clientNick = nick $ clients IntMap.! clID
|
|
|
42 |
|
|
1862
|
43 |
|
|
1804
|
44 |
handleCmd_lobby clID clients rooms ["CREATE", newRoom, roomPassword] =
|
|
|
45 |
if haveSameRoom then
|
|
|
46 |
[Warning "Room exists"]
|
|
|
47 |
else
|
|
|
48 |
[RoomRemoveThisClient, -- leave lobby
|
|
|
49 |
AddRoom newRoom roomPassword,
|
|
|
50 |
AnswerThisClient ["NOT_READY", clientNick]
|
|
|
51 |
]
|
|
|
52 |
where
|
|
|
53 |
clientNick = nick $ clients IntMap.! clID
|
|
|
54 |
haveSameRoom = isJust $ find (\room -> newRoom == name room) $ IntMap.elems rooms
|
|
|
55 |
|
|
1862
|
56 |
|
|
1804
|
57 |
handleCmd_lobby clID clients rooms ["CREATE", newRoom] =
|
|
|
58 |
handleCmd_lobby clID clients rooms ["CREATE", newRoom, ""]
|
|
|
59 |
|
|
1862
|
60 |
|
|
1804
|
61 |
handleCmd_lobby clID clients rooms ["JOIN", roomName, roomPassword] =
|
|
|
62 |
if noSuchRoom then
|
|
|
63 |
[Warning "No such room"]
|
|
|
64 |
else if isRestrictedJoins jRoom then
|
|
|
65 |
[Warning "Joining restricted"]
|
|
|
66 |
else if roomPassword /= password jRoom then
|
|
|
67 |
[Warning "Wrong password"]
|
|
|
68 |
else
|
|
|
69 |
[RoomRemoveThisClient, -- leave lobby
|
|
|
70 |
RoomAddThisClient rID] -- join room
|
|
|
71 |
++ answerNicks
|
|
|
72 |
++ answerReady
|
|
|
73 |
++ [AnswerThisRoom ["NOT_READY", nick client]]
|
|
|
74 |
++ answerFullConfig jRoom
|
|
|
75 |
++ answerTeams
|
|
1813
|
76 |
++ watchRound
|
|
1804
|
77 |
where
|
|
|
78 |
noSuchRoom = isNothing mbRoom
|
|
|
79 |
mbRoom = find (\r -> roomName == name r && roomProto r == clientProto client) $ IntMap.elems rooms
|
|
|
80 |
jRoom = fromJust mbRoom
|
|
|
81 |
rID = roomUID jRoom
|
|
|
82 |
client = clients IntMap.! clID
|
|
|
83 |
roomClientsIDs = IntSet.elems $ playersIDs jRoom
|
|
|
84 |
answerNicks = if playersIn jRoom /= 0 then
|
|
|
85 |
[AnswerThisClient $ ["JOINED"] ++ (map (\clID -> nick $ clients IntMap.! clID) $ roomClientsIDs)]
|
|
|
86 |
else
|
|
|
87 |
[]
|
|
|
88 |
answerReady =
|
|
|
89 |
map (\c -> AnswerThisClient [if isReady c then "READY" else "NOT_READY", nick c]) $
|
|
|
90 |
map (\clID -> clients IntMap.! clID) roomClientsIDs
|
|
|
91 |
|
|
|
92 |
toAnswer (paramName, paramStrs) = AnswerThisClient $ "CFG" : paramName : paramStrs
|
|
|
93 |
answerFullConfig room = map toAnswer (Map.toList $ params room)
|
|
1813
|
94 |
|
|
|
95 |
watchRound = if not $ gameinprogress jRoom then
|
|
1804
|
96 |
[]
|
|
|
97 |
else
|
|
1813
|
98 |
[AnswerThisClient ["RUN_GAME"],
|
|
1866
|
99 |
AnswerThisClient $ "EM" : toEngineMsg "e$spectate 1" : (Foldable.toList $ roundMsgs jRoom)]
|
|
1813
|
100 |
|
|
1804
|
101 |
answerTeams = if gameinprogress jRoom then
|
|
|
102 |
answerAllTeams (teamsAtStart jRoom)
|
|
|
103 |
else
|
|
|
104 |
answerAllTeams (teams jRoom)
|
|
|
105 |
|
|
|
106 |
|
|
1862
|
107 |
handleCmd_lobby clID clients rooms ["JOIN", roomName] =
|
|
|
108 |
handleCmd_lobby clID clients rooms ["JOIN", roomName, ""]
|
|
|
109 |
|
|
|
110 |
|
|
|
111 |
handleCmd_lobby clID clients rooms ["KICK", kickNick] =
|
|
|
112 |
if not $ isAdministrator client then
|
|
|
113 |
[]
|
|
|
114 |
else
|
|
|
115 |
if noSuchClient then
|
|
|
116 |
[]
|
|
|
117 |
else
|
|
|
118 |
if kickID == clID then
|
|
|
119 |
[]
|
|
|
120 |
else
|
|
|
121 |
[KickClient kickID]
|
|
|
122 |
where
|
|
|
123 |
client = clients IntMap.! clID
|
|
|
124 |
maybeClient = Foldable.find (\cl -> kickNick == nick cl) clients
|
|
|
125 |
noSuchClient = isNothing maybeClient
|
|
|
126 |
kickID = clientUID $ fromJust maybeClient
|
|
1866
|
127 |
|
|
|
128 |
|
|
|
129 |
handleCmd_lobby clID clients rooms ["BAN", banNick] =
|
|
|
130 |
if not $ isAdministrator client then
|
|
|
131 |
[]
|
|
|
132 |
else
|
|
|
133 |
BanClient banNick : handleCmd_lobby clID clients rooms ["KICK", banNick]
|
|
|
134 |
where
|
|
|
135 |
client = clients IntMap.! clID
|
|
1862
|
136 |
|
|
1804
|
137 |
|
|
|
138 |
handleCmd_lobby clID _ _ _ = [ProtocolError "Incorrect command (state: in lobby)"]
|