author | nemo |
Wed, 29 Jul 2009 23:01:19 +0000 | |
changeset 2286 | 8a24e0858947 |
parent 2245 | c011aecc95e5 |
child 2304 | a6e733ad0366 |
permissions | -rw-r--r-- |
1804 | 1 |
module HWProtoInRoomState where |
2 |
||
1879 | 3 |
import qualified Data.Foldable as Foldable |
1804 | 4 |
import qualified Data.IntMap as IntMap |
5 |
import qualified Data.Map as Map |
|
6 |
import Data.Sequence(Seq, (|>), (><), fromList, empty) |
|
7 |
import Data.List |
|
8 |
import Maybe |
|
9 |
-------------------------------------- |
|
10 |
import CoreTypes |
|
11 |
import Actions |
|
12 |
import Utils |
|
13 |
||
14 |
||
15 |
handleCmd_inRoom :: CmdHandler |
|
16 |
||
1815 | 17 |
handleCmd_inRoom clID clients _ ["CHAT", msg] = |
18 |
[AnswerOthersInRoom ["CHAT", clientNick, msg]] |
|
1804 | 19 |
where |
20 |
clientNick = nick $ clients IntMap.! clID |
|
21 |
||
1811 | 22 |
|
2207
aeea95909aba
Make server accpet TEAM_CHAT protocol command, and act like on CHAT command for now
unc0rr
parents:
2126
diff
changeset
|
23 |
handleCmd_inRoom clID clients _ ["TEAM_CHAT", msg] = |
aeea95909aba
Make server accpet TEAM_CHAT protocol command, and act like on CHAT command for now
unc0rr
parents:
2126
diff
changeset
|
24 |
[AnswerOthersInRoom ["TEAM_CHAT", clientNick, msg]] |
aeea95909aba
Make server accpet TEAM_CHAT protocol command, and act like on CHAT command for now
unc0rr
parents:
2126
diff
changeset
|
25 |
where |
aeea95909aba
Make server accpet TEAM_CHAT protocol command, and act like on CHAT command for now
unc0rr
parents:
2126
diff
changeset
|
26 |
clientNick = nick $ clients IntMap.! clID |
aeea95909aba
Make server accpet TEAM_CHAT protocol command, and act like on CHAT command for now
unc0rr
parents:
2126
diff
changeset
|
27 |
|
aeea95909aba
Make server accpet TEAM_CHAT protocol command, and act like on CHAT command for now
unc0rr
parents:
2126
diff
changeset
|
28 |
|
1814 | 29 |
handleCmd_inRoom clID clients rooms ["PART"] = |
1804 | 30 |
if isMaster client then |
31 |
[RemoveRoom] |
|
32 |
else |
|
2126 | 33 |
[RoomRemoveThisClient "part"] |
1804 | 34 |
where |
35 |
client = clients IntMap.! clID |
|
36 |
||
1811 | 37 |
|
1804 | 38 |
handleCmd_inRoom clID clients rooms ("CFG" : paramName : paramStrs) = |
39 |
if isMaster client then |
|
40 |
[ModifyRoom (\r -> r{params = Map.insert paramName paramStrs (params r)}) |
|
41 |
, AnswerOthersInRoom ("CFG" : paramName : paramStrs)] |
|
42 |
else |
|
43 |
[ProtocolError "Not room master"] |
|
44 |
where |
|
45 |
client = clients IntMap.! clID |
|
46 |
||
47 |
handleCmd_inRoom clID clients rooms ("ADD_TEAM" : name : color : grave : fort : voicepack : difStr : hhsInfo) |
|
48 |
| length hhsInfo == 16 = |
|
49 |
if length (teams room) == 6 then |
|
50 |
[Warning "too many teams"] |
|
51 |
else if canAddNumber <= 0 then |
|
52 |
[Warning "too many hedgehogs"] |
|
53 |
else if isJust findTeam then |
|
54 |
[Warning "already have a team with same name"] |
|
55 |
else if gameinprogress room then |
|
56 |
[Warning "round in progress"] |
|
57 |
else if isRestrictedTeams room then |
|
58 |
[Warning "restricted"] |
|
59 |
else |
|
60 |
[ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}), |
|
2245
c011aecc95e5
unc0rr's patch from issue #144 - prevent spectators from ruining the game
nemo
parents:
2207
diff
changeset
|
61 |
ModifyClient (\c -> c{teamsInGame = teamsInGame c + 1}), |
1804 | 62 |
AnswerThisClient ["TEAM_ACCEPTED", name], |
63 |
AnswerOthersInRoom $ teamToNet newTeam, |
|
64 |
AnswerOthersInRoom ["TEAM_COLOR", name, color] |
|
65 |
] |
|
66 |
where |
|
67 |
client = clients IntMap.! clID |
|
68 |
room = rooms IntMap.! (roomID client) |
|
69 |
canAddNumber = 48 - (sum . map hhnum $ teams room) |
|
70 |
findTeam = find (\t -> name == teamname t) $ teams room |
|
71 |
newTeam = (TeamInfo (nick client) name color grave fort voicepack difficulty newTeamHHNum (hhsList hhsInfo)) |
|
72 |
difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int) |
|
73 |
hhsList [] = [] |
|
74 |
hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs |
|
75 |
newTeamHHNum = min 4 canAddNumber |
|
76 |
||
77 |
||
78 |
handleCmd_inRoom clID clients rooms ["REMOVE_TEAM", teamName] = |
|
79 |
if noSuchTeam then |
|
80 |
[Warning "REMOVE_TEAM: no such team"] |
|
81 |
else |
|
82 |
if not $ nick client == teamowner team then |
|
83 |
[ProtocolError "Not team owner!"] |
|
84 |
else |
|
2245
c011aecc95e5
unc0rr's patch from issue #144 - prevent spectators from ruining the game
nemo
parents:
2207
diff
changeset
|
85 |
[RemoveTeam teamName, |
c011aecc95e5
unc0rr's patch from issue #144 - prevent spectators from ruining the game
nemo
parents:
2207
diff
changeset
|
86 |
ModifyClient (\c -> c{teamsInGame = teamsInGame c - 1}) |
c011aecc95e5
unc0rr's patch from issue #144 - prevent spectators from ruining the game
nemo
parents:
2207
diff
changeset
|
87 |
] |
1804 | 88 |
where |
89 |
client = clients IntMap.! clID |
|
90 |
room = rooms IntMap.! (roomID client) |
|
91 |
noSuchTeam = isNothing findTeam |
|
92 |
team = fromJust findTeam |
|
93 |
findTeam = find (\t -> teamName == teamname t) $ teams room |
|
94 |
||
95 |
||
96 |
handleCmd_inRoom clID clients rooms ["HH_NUM", teamName, numberStr] = |
|
97 |
if not $ isMaster client then |
|
98 |
[ProtocolError "Not room master"] |
|
99 |
else |
|
100 |
if hhNumber < 1 || hhNumber > 8 || noSuchTeam || hhNumber > (canAddNumber + (hhnum team)) then |
|
101 |
[] |
|
102 |
else |
|
103 |
[ModifyRoom $ modifyTeam team{hhnum = hhNumber}, |
|
104 |
AnswerOthersInRoom ["HH_NUM", teamName, show hhNumber]] |
|
105 |
where |
|
106 |
client = clients IntMap.! clID |
|
107 |
room = rooms IntMap.! (roomID client) |
|
108 |
hhNumber = fromMaybe 0 (maybeRead numberStr :: Maybe Int) |
|
109 |
noSuchTeam = isNothing findTeam |
|
110 |
team = fromJust findTeam |
|
111 |
findTeam = find (\t -> teamName == teamname t) $ teams room |
|
112 |
canAddNumber = 48 - (sum . map hhnum $ teams room) |
|
113 |
||
114 |
||
115 |
handleCmd_inRoom clID clients rooms ["TEAM_COLOR", teamName, newColor] = |
|
116 |
if not $ isMaster client then |
|
117 |
[ProtocolError "Not room master"] |
|
118 |
else |
|
119 |
if noSuchTeam then |
|
120 |
[] |
|
121 |
else |
|
122 |
[ModifyRoom $ modifyTeam team{teamcolor = newColor}, |
|
123 |
AnswerOthersInRoom ["TEAM_COLOR", teamName, newColor]] |
|
124 |
where |
|
125 |
noSuchTeam = isNothing findTeam |
|
126 |
team = fromJust findTeam |
|
127 |
findTeam = find (\t -> teamName == teamname t) $ teams room |
|
128 |
client = clients IntMap.! clID |
|
129 |
room = rooms IntMap.! (roomID client) |
|
130 |
||
131 |
||
132 |
handleCmd_inRoom clID clients rooms ["TOGGLE_READY"] = |
|
133 |
[ModifyClient (\c -> c{isReady = not $ isReady client}), |
|
134 |
ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady client then -1 else 1)}), |
|
135 |
AnswerThisRoom $ [if isReady client then "NOT_READY" else "READY", nick client]] |
|
136 |
where |
|
137 |
client = clients IntMap.! clID |
|
138 |
||
139 |
||
140 |
handleCmd_inRoom clID clients rooms ["START_GAME"] = |
|
141 |
if isMaster client && (playersIn room == readyPlayers room) && (not $ gameinprogress room) then |
|
142 |
if enoughClans then |
|
1811 | 143 |
[ModifyRoom |
144 |
(\r -> r{ |
|
145 |
gameinprogress = True, |
|
146 |
roundMsgs = empty, |
|
147 |
leftTeams = [], |
|
148 |
teamsAtStart = teams r} |
|
149 |
), |
|
1804 | 150 |
AnswerThisRoom ["RUN_GAME"]] |
151 |
else |
|
152 |
[Warning "Less than two clans!"] |
|
153 |
else |
|
154 |
[] |
|
155 |
where |
|
156 |
client = clients IntMap.! clID |
|
157 |
room = rooms IntMap.! (roomID client) |
|
158 |
enoughClans = not $ null $ drop 1 $ group $ map teamcolor $ teams room |
|
159 |
||
160 |
||
2245
c011aecc95e5
unc0rr's patch from issue #144 - prevent spectators from ruining the game
nemo
parents:
2207
diff
changeset
|
161 |
handleCmd_inRoom clID clients rooms ["EM", msg] = |
c011aecc95e5
unc0rr's patch from issue #144 - prevent spectators from ruining the game
nemo
parents:
2207
diff
changeset
|
162 |
if teamsInGame client > 0 then |
c011aecc95e5
unc0rr's patch from issue #144 - prevent spectators from ruining the game
nemo
parents:
2207
diff
changeset
|
163 |
[ModifyRoom (\r -> r{roundMsgs = roundMsgs r |> msg}), |
c011aecc95e5
unc0rr's patch from issue #144 - prevent spectators from ruining the game
nemo
parents:
2207
diff
changeset
|
164 |
AnswerOthersInRoom ["EM", msg]] |
c011aecc95e5
unc0rr's patch from issue #144 - prevent spectators from ruining the game
nemo
parents:
2207
diff
changeset
|
165 |
else |
c011aecc95e5
unc0rr's patch from issue #144 - prevent spectators from ruining the game
nemo
parents:
2207
diff
changeset
|
166 |
[] |
c011aecc95e5
unc0rr's patch from issue #144 - prevent spectators from ruining the game
nemo
parents:
2207
diff
changeset
|
167 |
where |
c011aecc95e5
unc0rr's patch from issue #144 - prevent spectators from ruining the game
nemo
parents:
2207
diff
changeset
|
168 |
client = clients IntMap.! clID |
1804 | 169 |
|
1811 | 170 |
handleCmd_inRoom clID clients rooms ["ROUNDFINISHED"] = |
171 |
if isMaster client then |
|
172 |
[ModifyRoom |
|
173 |
(\r -> r{ |
|
174 |
gameinprogress = False, |
|
175 |
readyPlayers = 0, |
|
176 |
roundMsgs = empty, |
|
177 |
leftTeams = [], |
|
178 |
teamsAtStart = []} |
|
179 |
), |
|
180 |
UnreadyRoomClients |
|
181 |
] ++ answerRemovedTeams |
|
182 |
else |
|
183 |
[] |
|
184 |
where |
|
185 |
client = clients IntMap.! clID |
|
186 |
room = rooms IntMap.! (roomID client) |
|
187 |
answerRemovedTeams = map (\t -> AnswerThisRoom ["REMOVE_TEAM", t]) $ leftTeams room |
|
188 |
||
189 |
||
1831 | 190 |
handleCmd_inRoom clID clients _ ["TOGGLE_RESTRICT_JOINS"] = |
191 |
if isMaster client then |
|
192 |
[ModifyRoom (\r -> r{isRestrictedJoins = not $ isRestrictedJoins r})] |
|
193 |
else |
|
194 |
[ProtocolError "Not room master"] |
|
195 |
where |
|
196 |
client = clients IntMap.! clID |
|
197 |
||
198 |
||
199 |
handleCmd_inRoom clID clients _ ["TOGGLE_RESTRICT_TEAMS"] = |
|
200 |
if isMaster client then |
|
201 |
[ModifyRoom (\r -> r{isRestrictedTeams = not $ isRestrictedTeams r})] |
|
202 |
else |
|
203 |
[ProtocolError "Not room master"] |
|
204 |
where |
|
205 |
client = clients IntMap.! clID |
|
206 |
||
1879 | 207 |
handleCmd_inRoom clID clients rooms ["KICK", kickNick] = |
208 |
if not $ isMaster client then |
|
209 |
[] |
|
210 |
else |
|
211 |
if noSuchClient then |
|
212 |
[] |
|
213 |
else |
|
214 |
if (kickID == clID) || (roomID client /= roomID kickClient) then |
|
215 |
[] |
|
216 |
else |
|
1929 | 217 |
[KickRoomClient kickID] |
1879 | 218 |
where |
219 |
client = clients IntMap.! clID |
|
220 |
maybeClient = Foldable.find (\cl -> kickNick == nick cl) clients |
|
221 |
noSuchClient = isNothing maybeClient |
|
222 |
kickClient = fromJust maybeClient |
|
223 |
kickID = clientUID kickClient |
|
224 |
||
1831 | 225 |
|
1804 | 226 |
handleCmd_inRoom clID _ _ _ = [ProtocolError "Incorrect command (state: in room)"] |