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