author | unc0rr |
Fri, 09 Jan 2009 11:27:52 +0000 | |
changeset 1622 | 8e0d62727f01 |
parent 1621 | d1ded2532d3f |
child 1632 | b3fcd8a36124 |
permissions | -rw-r--r-- |
1473 | 1 |
module HWProto |
2 |
( |
|
3 |
handleCmd |
|
4 |
) where |
|
890 | 5 |
|
6 |
import IO |
|
896 | 7 |
import Data.List |
894 | 8 |
import Data.Word |
890 | 9 |
import Miscutils |
1320 | 10 |
import Maybe |
1317 | 11 |
import qualified Data.Map as Map |
1384 | 12 |
import Opts |
890 | 13 |
|
1331
ae291cfd617a
Send teams info to newly connected client (has a bug with team sequence, need to discover)
unc0rr
parents:
1330
diff
changeset
|
14 |
teamToNet team = ["ADD_TEAM", teamname team, teamgrave team, teamfort team, show $ difficulty team] ++ hhsInfo |
ae291cfd617a
Send teams info to newly connected client (has a bug with team sequence, need to discover)
unc0rr
parents:
1330
diff
changeset
|
15 |
where |
ae291cfd617a
Send teams info to newly connected client (has a bug with team sequence, need to discover)
unc0rr
parents:
1330
diff
changeset
|
16 |
hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team |
ae291cfd617a
Send teams info to newly connected client (has a bug with team sequence, need to discover)
unc0rr
parents:
1330
diff
changeset
|
17 |
|
1491
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
18 |
makeAnswer :: HandlesSelector -> [String] -> [Answer] |
1492 | 19 |
makeAnswer func msg = [\_ -> (func, msg)] |
1491
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
20 |
answerClientOnly, answerOthersRoom, answerSameRoom :: [String] -> [Answer] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
21 |
answerClientOnly = makeAnswer clientOnly |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
22 |
answerOthersRoom = makeAnswer othersInRoom |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
23 |
answerSameRoom = makeAnswer sameRoom |
1591 | 24 |
answerSameProtoLobby = makeAnswer sameProtoLobbyClients |
1618 | 25 |
answerOtherLobby = makeAnswer otherLobbyClients |
1567 | 26 |
answerAll = makeAnswer allClients |
1491
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
27 |
|
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
28 |
answerBadCmd = answerClientOnly ["ERROR", "Bad command, state or incorrect parameter"] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
29 |
answerNotMaster = answerClientOnly ["ERROR", "You cannot configure room parameters"] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
30 |
answerBadParam = answerClientOnly ["ERROR", "Bad parameter"] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
31 |
answerErrorMsg msg = answerClientOnly ["ERROR", msg] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
32 |
answerQuit msg = answerClientOnly ["BYE", msg] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
33 |
answerNickChosen = answerClientOnly ["ERROR", "The nick already chosen"] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
34 |
answerNickChooseAnother = answerClientOnly ["WARNING", "Choose another nick"] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
35 |
answerNick nick = answerClientOnly ["NICK", nick] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
36 |
answerProtocolKnown = answerClientOnly ["ERROR", "Protocol number already known"] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
37 |
answerBadInput = answerClientOnly ["ERROR", "Bad input"] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
38 |
answerProto protoNum = answerClientOnly ["PROTO", show protoNum] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
39 |
answerRoomsList list = answerClientOnly $ "ROOMS" : list |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
40 |
answerRoomExists = answerClientOnly ["WARNING", "There's already a room with that name"] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
41 |
answerNoRoom = answerClientOnly ["WARNING", "There's no room with that name"] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
42 |
answerWrongPassword = answerClientOnly ["WARNING", "Wrong password"] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
43 |
answerCantAdd reason = answerClientOnly ["WARNING", "Cannot add team: " ++ reason] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
44 |
answerTeamAccepted team = answerClientOnly ["TEAM_ACCEPTED", teamname team] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
45 |
answerTooFewClans = answerClientOnly ["ERROR", "Too few clans in game"] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
46 |
answerRestricted = answerClientOnly ["WARNING", "Room joining restricted"] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
47 |
answerConnected = answerClientOnly ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
48 |
answerNotOwner = answerClientOnly ["ERROR", "You do not own this team"] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
49 |
answerCannotCreateRoom = answerClientOnly ["WARNING", "Cannot create more rooms"] |
1582 | 50 |
answerInfo client = answerClientOnly ["INFO", nick client, host client, proto2ver $ protocol client, roomInfo] |
51 |
where |
|
52 |
roomInfo = if not $ null $ room client then "room " ++ (room client) else "lobby" |
|
1491
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
53 |
|
1592
5ee77ee470a6
Start converting network protocol to no-disconnecting religion
unc0rr
parents:
1591
diff
changeset
|
54 |
answerAbandoned protocol = |
5ee77ee470a6
Start converting network protocol to no-disconnecting religion
unc0rr
parents:
1591
diff
changeset
|
55 |
if protocol < 20 then |
5ee77ee470a6
Start converting network protocol to no-disconnecting religion
unc0rr
parents:
1591
diff
changeset
|
56 |
answerOthersRoom ["BYE", "Room abandoned"] |
5ee77ee470a6
Start converting network protocol to no-disconnecting religion
unc0rr
parents:
1591
diff
changeset
|
57 |
else |
5ee77ee470a6
Start converting network protocol to no-disconnecting religion
unc0rr
parents:
1591
diff
changeset
|
58 |
answerOthersRoom ["ROOMABANDONED"] |
5ee77ee470a6
Start converting network protocol to no-disconnecting religion
unc0rr
parents:
1591
diff
changeset
|
59 |
|
1491
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
60 |
answerChatString nick msg = answerOthersRoom ["CHAT_STRING", nick, msg] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
61 |
answerAddTeam team = answerOthersRoom $ teamToNet team |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
62 |
answerRemoveTeam teamName = answerOthersRoom ["REMOVE_TEAM", teamName] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
63 |
answerMap mapName = answerOthersRoom ["MAP", mapName] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
64 |
answerHHNum teamName hhNumber = answerOthersRoom ["HH_NUM", teamName, show hhNumber] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
65 |
answerTeamColor teamName newColor = answerOthersRoom ["TEAM_COLOR", teamName, newColor] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
66 |
answerConfigParam paramName paramStrs = answerOthersRoom $ "CONFIG_PARAM" : paramName : paramStrs |
1512
43742041c211
- Don't send 'Bad param' msg, as the only reason of it is just some lag
unc0rr
parents:
1493
diff
changeset
|
67 |
answerQuitInform nick msg = |
43742041c211
- Don't send 'Bad param' msg, as the only reason of it is just some lag
unc0rr
parents:
1493
diff
changeset
|
68 |
if not $ null msg then |
43742041c211
- Don't send 'Bad param' msg, as the only reason of it is just some lag
unc0rr
parents:
1493
diff
changeset
|
69 |
answerOthersRoom ["LEFT", nick, msg] |
43742041c211
- Don't send 'Bad param' msg, as the only reason of it is just some lag
unc0rr
parents:
1493
diff
changeset
|
70 |
else |
43742041c211
- Don't send 'Bad param' msg, as the only reason of it is just some lag
unc0rr
parents:
1493
diff
changeset
|
71 |
answerOthersRoom ["LEFT", nick] |
1592
5ee77ee470a6
Start converting network protocol to no-disconnecting religion
unc0rr
parents:
1591
diff
changeset
|
72 |
|
1598 | 73 |
answerPartInform nick = answerOthersRoom ["LEFT", nick, "bye room"] |
1566
6b63c75fdc68
Start work on lobby: add/remove nick from the list on join/quit
unc0rr
parents:
1561
diff
changeset
|
74 |
answerQuitLobby nick msg = |
1581 | 75 |
if not $ null nick then |
76 |
if not $ null msg then |
|
77 |
answerAll ["LOBBY:LEFT", nick, msg] |
|
1566
6b63c75fdc68
Start work on lobby: add/remove nick from the list on join/quit
unc0rr
parents:
1561
diff
changeset
|
78 |
else |
1581 | 79 |
answerAll ["LOBBY:LEFT", nick] |
80 |
else |
|
81 |
[] |
|
1491
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
82 |
|
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
83 |
answerJoined nick = answerSameRoom ["JOINED", nick] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
84 |
answerRunGame = answerSameRoom ["RUN_GAME"] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
85 |
answerIsReady nick = answerSameRoom ["READY", nick] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
86 |
answerNotReady nick = answerSameRoom ["NOT_READY", nick] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
87 |
|
1591 | 88 |
answerRoomAdded name = answerSameProtoLobby ["ROOM", "ADD", name] |
89 |
answerRoomDeleted name = answerSameProtoLobby ["ROOM", "DEL", name] |
|
90 |
||
1491
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
91 |
answerFullConfig room = concatMap toAnswer (Map.toList $ params room) ++ (answerClientOnly ["MAP", gamemap room]) |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
92 |
where |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
93 |
toAnswer (paramName, paramStrs) = |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
94 |
answerClientOnly $ "CONFIG_PARAM" : paramName : paramStrs |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
95 |
|
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
96 |
answerAllTeams room = concatMap toAnswer (teams room) |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
97 |
where |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
98 |
toAnswer team = |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
99 |
(answerClientOnly $ teamToNet team) ++ |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
100 |
(answerClientOnly ["TEAM_COLOR", teamname team, teamcolor team]) ++ |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
101 |
(answerClientOnly ["HH_NUM", teamname team, show $ hhnum team]) |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
102 |
|
1569 | 103 |
answerServerMessage client clients = [\serverInfo -> (clientOnly, "SERVER_MESSAGE" : |
1614 | 104 |
[(mainbody serverInfo) ++ updateInfo ++ clientsIn ++ (lastHour serverInfo)])] |
1384 | 105 |
where |
1492 | 106 |
mainbody serverInfo = serverMessage serverInfo ++ |
107 |
if isDedicated serverInfo then |
|
108 |
"<p align=center>Dedicated server</p>" |
|
109 |
else |
|
110 |
"<p align=center>Private server</p>" |
|
1614 | 111 |
|
1616 | 112 |
updateInfo = if protocol client < 21 then "<font color=yellow><p align=center>Hedgewars 0.9.8 is out!!! Please, update. Support for 0.9.7 will be dropped in a month.</p><p align=center><a href=http://hedgewars.org/download.html>Download page here</a></p><hr></font>" else "" |
1569 | 113 |
clientsIn = if protocol client < 20 then "<p align=left>" ++ (show $ length nicks) ++ " clients in: " ++ clientslist ++ "</p>" else [] |
1452 | 114 |
clientslist = if not $ null nicks then foldr1 (\a b -> a ++ ", " ++ b) nicks else "" |
1493 | 115 |
lastHour serverInfo = |
116 |
if isDedicated serverInfo then |
|
117 |
"<p align=left>" ++ (show $ length $ lastHourUsers serverInfo) ++ " user logins in last hour</p>" |
|
118 |
else |
|
119 |
"" |
|
1452 | 120 |
nicks = filter (not . null) $ map nick clients |
1492 | 121 |
|
1491
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
122 |
answerPing = makeAnswer allClients ["PING"] |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
123 |
|
1082 | 124 |
-- Main state-independent cmd handler |
125 |
handleCmd :: CmdHandler |
|
1478 | 126 |
handleCmd client _ rooms ("QUIT" : xs) = |
1082 | 127 |
if null (room client) then |
1566
6b63c75fdc68
Start work on lobby: add/remove nick from the list on join/quit
unc0rr
parents:
1561
diff
changeset
|
128 |
(noChangeClients, noChangeRooms, answerQuit msg ++ (answerQuitLobby (nick client) msg) ) |
1082 | 129 |
else if isMaster client then |
1620 | 130 |
(modifyRoomClients clRoom (\cl -> cl{isReady = False, partRoom = True}), removeRoom (room client), (answerQuit msg) ++ (answerQuitLobby (nick client) msg) ++ (answerAbandoned $ protocol client) ++ (answerRoomDeleted $ room client)) -- core disconnects clients on ROOMABANDONED answer |
1082 | 131 |
else |
1566
6b63c75fdc68
Start work on lobby: add/remove nick from the list on join/quit
unc0rr
parents:
1561
diff
changeset
|
132 |
(noChangeClients, modifyRoom clRoom{teams = othersTeams, playersIn = (playersIn clRoom) - 1, readyPlayers = newReadyPlayers}, (answerQuit msg) ++ (answerQuitInform (nick client) msg) ++ (answerQuitLobby (nick client) msg) ++ answerRemoveClientTeams) |
1334
b58afaadf7ae
Send team removal message to others in room when client disconnects
unc0rr
parents:
1333
diff
changeset
|
133 |
where |
b58afaadf7ae
Send team removal message to others in room when client disconnects
unc0rr
parents:
1333
diff
changeset
|
134 |
clRoom = roomByName (room client) rooms |
1491
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
135 |
answerRemoveClientTeams = concatMap (\tn -> answerOthersRoom ["REMOVE_TEAM", teamname tn]) clientTeams |
1335
c795cbc752c1
Small optimization (use partition instead of two filters with opposite predicates)
unc0rr
parents:
1334
diff
changeset
|
136 |
(clientTeams, othersTeams) = partition (\t -> teamowner t == nick client) $ teams clRoom |
1403 | 137 |
newReadyPlayers = if isReady client then (readyPlayers clRoom) - 1 else readyPlayers clRoom |
1478 | 138 |
msg = if not $ null xs then head xs else "" |
895 | 139 |
|
1461
87e5a6c3882c
Ping clients every 30 seconds, should help with ghosts on server
unc0rr
parents:
1452
diff
changeset
|
140 |
handleCmd _ _ _ ["PING"] = -- core requsted |
87e5a6c3882c
Ping clients every 30 seconds, should help with ghosts on server
unc0rr
parents:
1452
diff
changeset
|
141 |
(noChangeClients, noChangeRooms, answerPing) |
1307 | 142 |
|
1469 | 143 |
handleCmd _ _ _ ["ASKME"] = -- core requsted |
144 |
(noChangeClients, noChangeRooms, answerConnected) |
|
145 |
||
1462 | 146 |
handleCmd _ _ _ ["PONG"] = |
147 |
(noChangeClients, noChangeRooms, []) |
|
148 |
||
1483 | 149 |
handleCmd _ _ _ ["ERROR", msg] = |
150 |
(noChangeClients, noChangeRooms, answerErrorMsg msg) |
|
151 |
||
1577 | 152 |
handleCmd _ clients _ ["INFO", asknick] = |
153 |
if noSuchClient then |
|
154 |
(noChangeClients, noChangeRooms, []) |
|
155 |
else |
|
156 |
(noChangeClients, noChangeRooms, answerInfo client) |
|
157 |
where |
|
158 |
maybeClient = find (\cl -> asknick == nick cl) clients |
|
159 |
noSuchClient = isNothing maybeClient |
|
160 |
client = fromJust maybeClient |
|
161 |
||
162 |
||
1082 | 163 |
-- check state and call state-dependent commmand handlers |
164 |
handleCmd client clients rooms cmd = |
|
165 |
if null (nick client) || protocol client == 0 then |
|
166 |
handleCmd_noInfo client clients rooms cmd |
|
167 |
else if null (room client) then |
|
168 |
handleCmd_noRoom client clients rooms cmd |
|
169 |
else |
|
170 |
handleCmd_inRoom client clients rooms cmd |
|
171 |
||
1307 | 172 |
|
1082 | 173 |
-- 'no info' state - need to get protocol number and nickname |
1566
6b63c75fdc68
Start work on lobby: add/remove nick from the list on join/quit
unc0rr
parents:
1561
diff
changeset
|
174 |
onLoginFinished client clients = |
1571 | 175 |
if (null $ nick client) || (protocol client == 0) then |
1566
6b63c75fdc68
Start work on lobby: add/remove nick from the list on join/quit
unc0rr
parents:
1561
diff
changeset
|
176 |
[] |
6b63c75fdc68
Start work on lobby: add/remove nick from the list on join/quit
unc0rr
parents:
1561
diff
changeset
|
177 |
else |
1618 | 178 |
(answerClientOnly $ ["LOBBY:JOINED"] ++ (filter (\n -> (not (null n)) && n /= nick client) $ map nick $ clients)) ++ |
179 |
(answerAll ["LOBBY:JOINED", nick client]) ++ |
|
1584
90f6a5abad17
Save much space for chat widget on lobby page by removing server message widget (now this messages goes to chat)
unc0rr
parents:
1582
diff
changeset
|
180 |
(answerServerMessage client clients) |
1566
6b63c75fdc68
Start work on lobby: add/remove nick from the list on join/quit
unc0rr
parents:
1561
diff
changeset
|
181 |
|
1082 | 182 |
handleCmd_noInfo :: CmdHandler |
183 |
handleCmd_noInfo client clients _ ["NICK", newNick] = |
|
894 | 184 |
if not . null $ nick client then |
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
185 |
(noChangeClients, noChangeRooms, answerNickChosen) |
894 | 186 |
else if haveSameNick then |
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
187 |
(noChangeClients, noChangeRooms, answerNickChooseAnother) |
894 | 188 |
else |
1566
6b63c75fdc68
Start work on lobby: add/remove nick from the list on join/quit
unc0rr
parents:
1561
diff
changeset
|
189 |
(modifyClient client{nick = newNick}, noChangeRooms, answerNick newNick ++ (onLoginFinished client{nick = newNick} clients)) |
894 | 190 |
where |
1320 | 191 |
haveSameNick = isJust $ find (\cl -> newNick == nick cl) clients |
894 | 192 |
|
1566
6b63c75fdc68
Start work on lobby: add/remove nick from the list on join/quit
unc0rr
parents:
1561
diff
changeset
|
193 |
handleCmd_noInfo client clients _ ["PROTO", protoNum] = |
894 | 194 |
if protocol client > 0 then |
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
195 |
(noChangeClients, noChangeRooms, answerProtocolKnown) |
894 | 196 |
else if parsedProto == 0 then |
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
197 |
(noChangeClients, noChangeRooms, answerBadInput) |
894 | 198 |
else |
1566
6b63c75fdc68
Start work on lobby: add/remove nick from the list on join/quit
unc0rr
parents:
1561
diff
changeset
|
199 |
(modifyClient client{protocol = parsedProto}, noChangeRooms, answerProto parsedProto ++ (onLoginFinished client{protocol = parsedProto} clients)) |
894 | 200 |
where |
201 |
parsedProto = fromMaybe 0 (maybeRead protoNum :: Maybe Word16) |
|
202 |
||
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
203 |
handleCmd_noInfo _ _ _ _ = (noChangeClients, noChangeRooms, answerBadCmd) |
894 | 204 |
|
1307 | 205 |
|
894 | 206 |
-- 'noRoom' clients state command handlers |
1082 | 207 |
handleCmd_noRoom :: CmdHandler |
1452 | 208 |
handleCmd_noRoom client clients rooms ["LIST"] = |
1584
90f6a5abad17
Save much space for chat widget on lobby page by removing server message widget (now this messages goes to chat)
unc0rr
parents:
1582
diff
changeset
|
209 |
(noChangeClients, noChangeRooms, (answerRoomsList $ concatMap roomInfo $ sameProtoRooms)) |
1396 | 210 |
where |
1402 | 211 |
roomInfo room = [ |
212 |
name room, |
|
213 |
(show $ playersIn room) ++ "(" ++ (show $ length $ teams room) ++ ")", |
|
214 |
show $ gameinprogress room |
|
215 |
] |
|
1412 | 216 |
sameProtoRooms = filter (\r -> (roomProto r == protocol client) && (not $ isRestrictedJoins r)) rooms |
903 | 217 |
|
1082 | 218 |
handleCmd_noRoom client _ rooms ["CREATE", newRoom, roomPassword] = |
1492 | 219 |
if haveSameRoom then |
220 |
(noChangeClients, noChangeRooms, answerRoomExists) |
|
895 | 221 |
else |
1591 | 222 |
(modifyClient client{room = newRoom, isMaster = True}, addRoom createRoom{name = newRoom, password = roomPassword, roomProto = (protocol client)}, (answerJoined $ nick client) ++ (answerNotReady $ nick client) ++ (answerRoomAdded newRoom)) |
895 | 223 |
where |
1320 | 224 |
haveSameRoom = isJust $ find (\room -> newRoom == name room) rooms |
895 | 225 |
|
1082 | 226 |
handleCmd_noRoom client clients rooms ["CREATE", newRoom] = |
227 |
handleCmd_noRoom client clients rooms ["CREATE", newRoom, ""] |
|
228 |
||
1308
d5dcd6cfa5e2
Fix another server failure (when second client in room disconnects)
unc0rr
parents:
1307
diff
changeset
|
229 |
handleCmd_noRoom client clients rooms ["JOIN", roomName, roomPassword] = |
902 | 230 |
if noSuchRoom then |
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
231 |
(noChangeClients, noChangeRooms, answerNoRoom) |
1321 | 232 |
else if roomPassword /= password clRoom then |
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
233 |
(noChangeClients, noChangeRooms, answerWrongPassword) |
1411 | 234 |
else if isRestrictedJoins clRoom then |
235 |
(noChangeClients, noChangeRooms, answerRestricted) |
|
895 | 236 |
else |
1596 | 237 |
(modifyClient client{room = roomName}, modifyRoom clRoom{playersIn = 1 + playersIn clRoom}, (answerJoined $ nick client) ++ answerNicks ++ answerReady ++ (answerNotReady $ nick client) ++ answerFullConfig clRoom ++ answerAllTeams clRoom ++ watchRound) |
895 | 238 |
where |
1401 | 239 |
noSuchRoom = isNothing $ find (\room -> roomName == name room && roomProto room == protocol client) rooms |
1491
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
240 |
answerNicks = answerClientOnly $ ["JOINED"] ++ (map nick $ sameRoomClients) |
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
241 |
answerReady = concatMap (\c -> answerClientOnly [if isReady c then "READY" else "NOT_READY", nick c]) sameRoomClients |
1406 | 242 |
sameRoomClients = filter (\ci -> room ci == roomName) clients |
1321 | 243 |
clRoom = roomByName roomName rooms |
1558
3370b7ffeb5c
- Send previous moves info to newly connected client when it joins a room with already started game
unc0rr
parents:
1512
diff
changeset
|
244 |
watchRound = if (roomProto clRoom < 20) || (not $ gameinprogress clRoom) then |
3370b7ffeb5c
- Send previous moves info to newly connected client when it joins a room with already started game
unc0rr
parents:
1512
diff
changeset
|
245 |
[] |
3370b7ffeb5c
- Send previous moves info to newly connected client when it joins a room with already started game
unc0rr
parents:
1512
diff
changeset
|
246 |
else |
1560
e140bc57ff68
Quick replay round to spectators until current move
unc0rr
parents:
1559
diff
changeset
|
247 |
(answerClientOnly ["RUN_GAME"]) ++ |
e140bc57ff68
Quick replay round to spectators until current move
unc0rr
parents:
1559
diff
changeset
|
248 |
answerClientOnly ("GAMEMSG" : "DGUkc3BlY3RhdGUgMQ==" : roundMsgs clRoom) |
895 | 249 |
|
1082 | 250 |
handleCmd_noRoom client clients rooms ["JOIN", roomName] = |
251 |
handleCmd_noRoom client clients rooms ["JOIN", roomName, ""] |
|
894 | 252 |
|
1568 | 253 |
handleCmd_noRoom client _ _ ["CHAT_STRING", msg] = |
254 |
(noChangeClients, noChangeRooms, answerChatString (nick client) msg) |
|
255 |
||
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
256 |
handleCmd_noRoom _ _ _ _ = (noChangeClients, noChangeRooms, answerBadCmd) |
895 | 257 |
|
1307 | 258 |
|
897 | 259 |
-- 'inRoom' clients state command handlers |
1082 | 260 |
handleCmd_inRoom :: CmdHandler |
1322
c624b04699fb
Fix protocol implementation to conform documentation
unc0rr
parents:
1321
diff
changeset
|
261 |
handleCmd_inRoom client _ _ ["CHAT_STRING", msg] = |
1317 | 262 |
(noChangeClients, noChangeRooms, answerChatString (nick client) msg) |
897 | 263 |
|
1327 | 264 |
handleCmd_inRoom client _ rooms ("CONFIG_PARAM" : paramName : paramStrs) = |
1317 | 265 |
if isMaster client then |
1322
c624b04699fb
Fix protocol implementation to conform documentation
unc0rr
parents:
1321
diff
changeset
|
266 |
(noChangeClients, modifyRoom clRoom{params = Map.insert paramName paramStrs (params clRoom)}, answerConfigParam paramName paramStrs) |
1317 | 267 |
else |
268 |
(noChangeClients, noChangeRooms, answerNotMaster) |
|
1321 | 269 |
where |
270 |
clRoom = roomByName (room client) rooms |
|
271 |
||
1592
5ee77ee470a6
Start converting network protocol to no-disconnecting religion
unc0rr
parents:
1591
diff
changeset
|
272 |
handleCmd_inRoom client _ rooms ["PART"] = |
5ee77ee470a6
Start converting network protocol to no-disconnecting religion
unc0rr
parents:
1591
diff
changeset
|
273 |
if isMaster client then |
1618 | 274 |
(modifyRoomClients clRoom (\cl -> cl{isReady = False, isMaster = False, partRoom = True}), removeRoom (room client), (answerAbandoned $ protocol client) ++ (answerRoomDeleted $ room client)) |
1592
5ee77ee470a6
Start converting network protocol to no-disconnecting religion
unc0rr
parents:
1591
diff
changeset
|
275 |
else |
1598 | 276 |
(modifyClient client{isReady = False, partRoom = True}, modifyRoom clRoom{teams = othersTeams, playersIn = (playersIn clRoom) - 1, readyPlayers = newReadyPlayers}, (answerPartInform (nick client)) ++ answerRemoveClientTeams) |
1592
5ee77ee470a6
Start converting network protocol to no-disconnecting religion
unc0rr
parents:
1591
diff
changeset
|
277 |
where |
5ee77ee470a6
Start converting network protocol to no-disconnecting religion
unc0rr
parents:
1591
diff
changeset
|
278 |
clRoom = roomByName (room client) rooms |
5ee77ee470a6
Start converting network protocol to no-disconnecting religion
unc0rr
parents:
1591
diff
changeset
|
279 |
answerRemoveClientTeams = concatMap (\tn -> answerOthersRoom ["REMOVE_TEAM", teamname tn]) clientTeams |
5ee77ee470a6
Start converting network protocol to no-disconnecting religion
unc0rr
parents:
1591
diff
changeset
|
280 |
(clientTeams, othersTeams) = partition (\t -> teamowner t == nick client) $ teams clRoom |
5ee77ee470a6
Start converting network protocol to no-disconnecting religion
unc0rr
parents:
1591
diff
changeset
|
281 |
newReadyPlayers = if isReady client then (readyPlayers clRoom) - 1 else readyPlayers clRoom |
5ee77ee470a6
Start converting network protocol to no-disconnecting religion
unc0rr
parents:
1591
diff
changeset
|
282 |
|
1333
b0b0510eb82d
- Fix a bug with chosen map (new clinet gets wrong information)
unc0rr
parents:
1332
diff
changeset
|
283 |
handleCmd_inRoom client _ rooms ["MAP", mapName] = |
b0b0510eb82d
- Fix a bug with chosen map (new clinet gets wrong information)
unc0rr
parents:
1332
diff
changeset
|
284 |
if isMaster client then |
b0b0510eb82d
- Fix a bug with chosen map (new clinet gets wrong information)
unc0rr
parents:
1332
diff
changeset
|
285 |
(noChangeClients, modifyRoom clRoom{gamemap = mapName}, answerMap mapName) |
b0b0510eb82d
- Fix a bug with chosen map (new clinet gets wrong information)
unc0rr
parents:
1332
diff
changeset
|
286 |
else |
b0b0510eb82d
- Fix a bug with chosen map (new clinet gets wrong information)
unc0rr
parents:
1332
diff
changeset
|
287 |
(noChangeClients, noChangeRooms, answerNotMaster) |
b0b0510eb82d
- Fix a bug with chosen map (new clinet gets wrong information)
unc0rr
parents:
1332
diff
changeset
|
288 |
where |
b0b0510eb82d
- Fix a bug with chosen map (new clinet gets wrong information)
unc0rr
parents:
1332
diff
changeset
|
289 |
clRoom = roomByName (room client) rooms |
b0b0510eb82d
- Fix a bug with chosen map (new clinet gets wrong information)
unc0rr
parents:
1332
diff
changeset
|
290 |
|
1327 | 291 |
handleCmd_inRoom client _ rooms ("ADD_TEAM" : name : color : grave : fort : difStr : hhsInfo) |
1323
d166f9069c2b
Build neccessary structures in memory on ADDTEAM message, but don't send answer yet (need to review team id concept)
unc0rr
parents:
1322
diff
changeset
|
292 |
| length hhsInfo == 16 = |
1470
ebaca3b66d92
Give more specific explanation when deny to add team
unc0rr
parents:
1469
diff
changeset
|
293 |
if length (teams clRoom) == 6 then |
ebaca3b66d92
Give more specific explanation when deny to add team
unc0rr
parents:
1469
diff
changeset
|
294 |
(noChangeClients, noChangeRooms, answerCantAdd "too many teams") |
ebaca3b66d92
Give more specific explanation when deny to add team
unc0rr
parents:
1469
diff
changeset
|
295 |
else if canAddNumber <= 0 then |
ebaca3b66d92
Give more specific explanation when deny to add team
unc0rr
parents:
1469
diff
changeset
|
296 |
(noChangeClients, noChangeRooms, answerCantAdd "too many hedgehogs") |
ebaca3b66d92
Give more specific explanation when deny to add team
unc0rr
parents:
1469
diff
changeset
|
297 |
else if isJust findTeam then |
ebaca3b66d92
Give more specific explanation when deny to add team
unc0rr
parents:
1469
diff
changeset
|
298 |
(noChangeClients, noChangeRooms, answerCantAdd "already has a team with same name") |
ebaca3b66d92
Give more specific explanation when deny to add team
unc0rr
parents:
1469
diff
changeset
|
299 |
else if gameinprogress clRoom then |
ebaca3b66d92
Give more specific explanation when deny to add team
unc0rr
parents:
1469
diff
changeset
|
300 |
(noChangeClients, noChangeRooms, answerCantAdd "round in progress") |
ebaca3b66d92
Give more specific explanation when deny to add team
unc0rr
parents:
1469
diff
changeset
|
301 |
else if isRestrictedTeams clRoom then |
ebaca3b66d92
Give more specific explanation when deny to add team
unc0rr
parents:
1469
diff
changeset
|
302 |
(noChangeClients, noChangeRooms, answerCantAdd "restricted") |
1323
d166f9069c2b
Build neccessary structures in memory on ADDTEAM message, but don't send answer yet (need to review team id concept)
unc0rr
parents:
1322
diff
changeset
|
303 |
else |
1336
4e88eccbe7f6
Fix team colors mismatch on some conditions (just synchronize them when team is added)
unc0rr
parents:
1335
diff
changeset
|
304 |
(noChangeClients, modifyRoom clRoom{teams = teams clRoom ++ [newTeam]}, answerTeamAccepted newTeam ++ answerAddTeam newTeam ++ answerTeamColor name color) |
1323
d166f9069c2b
Build neccessary structures in memory on ADDTEAM message, but don't send answer yet (need to review team id concept)
unc0rr
parents:
1322
diff
changeset
|
305 |
where |
d166f9069c2b
Build neccessary structures in memory on ADDTEAM message, but don't send answer yet (need to review team id concept)
unc0rr
parents:
1322
diff
changeset
|
306 |
clRoom = roomByName (room client) rooms |
1329 | 307 |
newTeam = (TeamInfo (nick client) name color grave fort difficulty newTeamHHNum (hhsList hhsInfo)) |
1328 | 308 |
findTeam = find (\t -> name == teamname t) $ teams clRoom |
1323
d166f9069c2b
Build neccessary structures in memory on ADDTEAM message, but don't send answer yet (need to review team id concept)
unc0rr
parents:
1322
diff
changeset
|
309 |
difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int) |
1325 | 310 |
hhsList [] = [] |
1323
d166f9069c2b
Build neccessary structures in memory on ADDTEAM message, but don't send answer yet (need to review team id concept)
unc0rr
parents:
1322
diff
changeset
|
311 |
hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs |
1327 | 312 |
canAddNumber = 18 - (sum . map hhnum $ teams clRoom) |
313 |
newTeamHHNum = min 4 canAddNumber |
|
314 |
||
315 |
handleCmd_inRoom client _ rooms ["HH_NUM", teamName, numberStr] = |
|
316 |
if not $ isMaster client then |
|
317 |
(noChangeClients, noChangeRooms, answerNotMaster) |
|
318 |
else |
|
1329 | 319 |
if hhNumber < 1 || hhNumber > 8 || noSuchTeam || hhNumber > (canAddNumber + (hhnum team)) then |
1512
43742041c211
- Don't send 'Bad param' msg, as the only reason of it is just some lag
unc0rr
parents:
1493
diff
changeset
|
320 |
(noChangeClients, noChangeRooms, []) |
1327 | 321 |
else |
322 |
(noChangeClients, modifyRoom $ modifyTeam clRoom team{hhnum = hhNumber}, answerHHNum teamName hhNumber) |
|
323 |
where |
|
324 |
hhNumber = fromMaybe 0 (maybeRead numberStr :: Maybe Int) |
|
325 |
noSuchTeam = isNothing findTeam |
|
326 |
team = fromJust findTeam |
|
327 |
findTeam = find (\t -> teamName == teamname t) $ teams clRoom |
|
328 |
clRoom = roomByName (room client) rooms |
|
329 |
canAddNumber = 18 - (sum . map hhnum $ teams clRoom) |
|
1323
d166f9069c2b
Build neccessary structures in memory on ADDTEAM message, but don't send answer yet (need to review team id concept)
unc0rr
parents:
1322
diff
changeset
|
330 |
|
1330 | 331 |
handleCmd_inRoom client _ rooms ["TEAM_COLOR", teamName, newColor] = |
332 |
if not $ isMaster client then |
|
333 |
(noChangeClients, noChangeRooms, answerNotMaster) |
|
334 |
else |
|
1442 | 335 |
if noSuchTeam then |
1512
43742041c211
- Don't send 'Bad param' msg, as the only reason of it is just some lag
unc0rr
parents:
1493
diff
changeset
|
336 |
(noChangeClients, noChangeRooms, []) |
1442 | 337 |
else |
338 |
(noChangeClients, modifyRoom $ modifyTeam clRoom team{teamcolor = newColor}, answerTeamColor teamName newColor) |
|
1330 | 339 |
where |
340 |
noSuchTeam = isNothing findTeam |
|
341 |
team = fromJust findTeam |
|
342 |
findTeam = find (\t -> teamName == teamname t) $ teams clRoom |
|
343 |
clRoom = roomByName (room client) rooms |
|
344 |
||
1328 | 345 |
handleCmd_inRoom client _ rooms ["REMOVE_TEAM", teamName] = |
1329 | 346 |
if noSuchTeam then |
1512
43742041c211
- Don't send 'Bad param' msg, as the only reason of it is just some lag
unc0rr
parents:
1493
diff
changeset
|
347 |
(noChangeClients, noChangeRooms, []) |
1328 | 348 |
else |
1329 | 349 |
if not $ nick client == teamowner team then |
350 |
(noChangeClients, noChangeRooms, answerNotOwner) |
|
1328 | 351 |
else |
352 |
(noChangeClients, modifyRoom clRoom{teams = filter (\t -> teamName /= teamname t) $ teams clRoom}, answerRemoveTeam teamName) |
|
353 |
where |
|
354 |
noSuchTeam = isNothing findTeam |
|
355 |
team = fromJust findTeam |
|
356 |
findTeam = find (\t -> teamName == teamname t) $ teams clRoom |
|
357 |
clRoom = roomByName (room client) rooms |
|
1083 | 358 |
|
1403 | 359 |
handleCmd_inRoom client _ rooms ["TOGGLE_READY"] = |
360 |
if isReady client then |
|
1411 | 361 |
(modifyClient client{isReady = False}, modifyRoom clRoom{readyPlayers = newReadyPlayers}, answerNotReady $ nick client) |
1338 | 362 |
else |
1411 | 363 |
(modifyClient client{isReady = True}, modifyRoom clRoom{readyPlayers = newReadyPlayers}, answerIsReady $ nick client) |
1350 | 364 |
where |
365 |
clRoom = roomByName (room client) rooms |
|
1404 | 366 |
newReadyPlayers = (readyPlayers clRoom) + if isReady client then -1 else 1 |
1338 | 367 |
|
1411 | 368 |
handleCmd_inRoom client _ rooms ["START_GAME"] = |
369 |
if isMaster client && (playersIn clRoom == readyPlayers clRoom) && (not $ gameinprogress clRoom) then |
|
370 |
if enoughClans then |
|
371 |
(noChangeClients, modifyRoom clRoom{gameinprogress = True}, answerRunGame) |
|
372 |
else |
|
373 |
(noChangeClients, noChangeRooms, answerTooFewClans) |
|
374 |
else |
|
375 |
(noChangeClients, noChangeRooms, []) |
|
376 |
where |
|
377 |
clRoom = roomByName (room client) rooms |
|
378 |
enoughClans = not $ null $ drop 1 $ group $ map teamcolor $ teams clRoom |
|
379 |
||
380 |
handleCmd_inRoom client _ rooms ["TOGGLE_RESTRICT_JOINS"] = |
|
381 |
if isMaster client then |
|
382 |
(noChangeClients, modifyRoom clRoom{isRestrictedJoins = newStatus}, []) |
|
383 |
else |
|
384 |
(noChangeClients, noChangeRooms, answerNotMaster) |
|
385 |
where |
|
386 |
clRoom = roomByName (room client) rooms |
|
387 |
newStatus = not $ isRestrictedJoins clRoom |
|
388 |
||
389 |
handleCmd_inRoom client _ rooms ["TOGGLE_RESTRICT_TEAMS"] = |
|
390 |
if isMaster client then |
|
391 |
(noChangeClients, modifyRoom clRoom{isRestrictedTeams = newStatus}, []) |
|
392 |
else |
|
393 |
(noChangeClients, noChangeRooms, answerNotMaster) |
|
394 |
where |
|
395 |
clRoom = roomByName (room client) rooms |
|
396 |
newStatus = not $ isRestrictedTeams clRoom |
|
397 |
||
1408 | 398 |
handleCmd_inRoom client clients rooms ["ROUNDFINISHED"] = |
1345
73119de7d3be
Server erases teams list after round finish, so everything should be okay now
unc0rr
parents:
1344
diff
changeset
|
399 |
if isMaster client then |
1621 | 400 |
(modifyRoomClients clRoom (\cl -> cl{isReady = False}), modifyRoom clRoom{gameinprogress = False, readyPlayers = 0, roundMsgs = []}, answerAllNotReady) |
1345
73119de7d3be
Server erases teams list after round finish, so everything should be okay now
unc0rr
parents:
1344
diff
changeset
|
401 |
else |
1344
4004e597f1bf
Clients send roundfinished message to server when the round is over
unc0rr
parents:
1338
diff
changeset
|
402 |
(noChangeClients, noChangeRooms, []) |
1345
73119de7d3be
Server erases teams list after round finish, so everything should be okay now
unc0rr
parents:
1344
diff
changeset
|
403 |
where |
73119de7d3be
Server erases teams list after round finish, so everything should be okay now
unc0rr
parents:
1344
diff
changeset
|
404 |
clRoom = roomByName (room client) rooms |
1408 | 405 |
sameRoomClients = filter (\ci -> room ci == name clRoom) clients |
1491
0b1f44751509
Make answers creation more abstract, in prepare for a conversion
unc0rr
parents:
1483
diff
changeset
|
406 |
answerAllNotReady = concatMap (\cl -> answerSameRoom ["NOT_READY", nick cl]) sameRoomClients |
1344
4004e597f1bf
Clients send roundfinished message to server when the round is over
unc0rr
parents:
1338
diff
changeset
|
407 |
|
1558
3370b7ffeb5c
- Send previous moves info to newly connected client when it joins a room with already started game
unc0rr
parents:
1512
diff
changeset
|
408 |
handleCmd_inRoom client _ rooms ["GAMEMSG", msg] = |
3370b7ffeb5c
- Send previous moves info to newly connected client when it joins a room with already started game
unc0rr
parents:
1512
diff
changeset
|
409 |
(noChangeClients, addMsg, answerOthersRoom ["GAMEMSG", msg]) |
3370b7ffeb5c
- Send previous moves info to newly connected client when it joins a room with already started game
unc0rr
parents:
1512
diff
changeset
|
410 |
where |
3370b7ffeb5c
- Send previous moves info to newly connected client when it joins a room with already started game
unc0rr
parents:
1512
diff
changeset
|
411 |
addMsg = if roomProto clRoom < 20 then |
3370b7ffeb5c
- Send previous moves info to newly connected client when it joins a room with already started game
unc0rr
parents:
1512
diff
changeset
|
412 |
noChangeRooms |
3370b7ffeb5c
- Send previous moves info to newly connected client when it joins a room with already started game
unc0rr
parents:
1512
diff
changeset
|
413 |
else |
3370b7ffeb5c
- Send previous moves info to newly connected client when it joins a room with already started game
unc0rr
parents:
1512
diff
changeset
|
414 |
modifyRoom clRoom{roundMsgs = roundMsgs clRoom ++ [msg]} |
3370b7ffeb5c
- Send previous moves info to newly connected client when it joins a room with already started game
unc0rr
parents:
1512
diff
changeset
|
415 |
clRoom = roomByName (room client) rooms |
1338 | 416 |
|
1391 | 417 |
handleCmd_inRoom client clients rooms ["KICK", kickNick] = |
418 |
if isMaster client then |
|
419 |
if noSuchClient || (kickClient == client) then |
|
420 |
(noChangeClients, noChangeRooms, []) |
|
421 |
else |
|
422 |
(modifyClient kickClient{forceQuit = True}, noChangeRooms, []) |
|
423 |
else |
|
424 |
(noChangeClients, noChangeRooms, []) |
|
425 |
where |
|
426 |
clRoom = roomByName (room client) rooms |
|
427 |
noSuchClient = isNothing findClient |
|
428 |
kickClient = fromJust findClient |
|
429 |
findClient = find (\t -> ((room t) == (room client)) && ((nick t) == kickNick)) $ clients |
|
430 |
||
1304
05cebf68ebd8
Start refactoring standalone server (prepare to change protocol)
unc0rr
parents:
1302
diff
changeset
|
431 |
handleCmd_inRoom _ _ _ _ = (noChangeClients, noChangeRooms, answerBadCmd) |