|
1 module HWProtoInRoomState where |
|
2 |
|
3 import qualified Data.IntMap as IntMap |
|
4 import qualified Data.Map as Map |
|
5 import Data.Sequence(Seq, (|>), (><), fromList, empty) |
|
6 import Data.List |
|
7 import Maybe |
|
8 -------------------------------------- |
|
9 import CoreTypes |
|
10 import Actions |
|
11 import Utils |
|
12 |
|
13 |
|
14 handleCmd_inRoom :: CmdHandler |
|
15 |
|
16 handleCmd_inRoom clID clients _ ["CHAT_STRING", msg] = |
|
17 [AnswerOthersInRoom ["CHAT_STRING", clientNick, msg]] |
|
18 where |
|
19 clientNick = nick $ clients IntMap.! clID |
|
20 |
|
21 handleCmd_inRoom clID clients _ ["PART"] = |
|
22 if isMaster client then |
|
23 [RemoveRoom] |
|
24 else |
|
25 [RoomRemoveThisClient] |
|
26 where |
|
27 client = clients IntMap.! clID |
|
28 |
|
29 handleCmd_inRoom clID clients rooms ("CFG" : paramName : paramStrs) = |
|
30 if isMaster client then |
|
31 [ModifyRoom (\r -> r{params = Map.insert paramName paramStrs (params r)}) |
|
32 , AnswerOthersInRoom ("CFG" : paramName : paramStrs)] |
|
33 else |
|
34 [ProtocolError "Not room master"] |
|
35 where |
|
36 client = clients IntMap.! clID |
|
37 |
|
38 |
|
39 handleCmd_inRoom clID clients rooms ("ADD_TEAM" : name : color : grave : fort : voicepack : difStr : hhsInfo) |
|
40 | length hhsInfo == 16 = |
|
41 if length (teams room) == 6 then |
|
42 [Warning "too many teams"] |
|
43 else if canAddNumber <= 0 then |
|
44 [Warning "too many hedgehogs"] |
|
45 else if isJust findTeam then |
|
46 [Warning "already have a team with same name"] |
|
47 else if gameinprogress room then |
|
48 [Warning "round in progress"] |
|
49 else if isRestrictedTeams room then |
|
50 [Warning "restricted"] |
|
51 else |
|
52 [ModifyRoom (\r -> r{teams = teams r ++ [newTeam]}), |
|
53 AnswerThisClient ["TEAM_ACCEPTED", name], |
|
54 AnswerOthersInRoom $ teamToNet newTeam, |
|
55 AnswerOthersInRoom ["TEAM_COLOR", name, color] |
|
56 ] |
|
57 where |
|
58 client = clients IntMap.! clID |
|
59 room = rooms IntMap.! (roomID client) |
|
60 canAddNumber = 48 - (sum . map hhnum $ teams room) |
|
61 findTeam = find (\t -> name == teamname t) $ teams room |
|
62 newTeam = (TeamInfo (nick client) name color grave fort voicepack difficulty newTeamHHNum (hhsList hhsInfo)) |
|
63 difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int) |
|
64 hhsList [] = [] |
|
65 hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs |
|
66 newTeamHHNum = min 4 canAddNumber |
|
67 |
|
68 |
|
69 handleCmd_inRoom clID clients rooms ["REMOVE_TEAM", teamName] = |
|
70 if noSuchTeam then |
|
71 [Warning "REMOVE_TEAM: no such team"] |
|
72 else |
|
73 if not $ nick client == teamowner team then |
|
74 [ProtocolError "Not team owner!"] |
|
75 else |
|
76 if not $ gameinprogress room then |
|
77 [ModifyRoom (\r -> r{teams = filter (\t -> teamName /= teamname t) $ teams r}), |
|
78 AnswerOthersInRoom ["REMOVE_TEAM", teamName]] |
|
79 else |
|
80 [] |
|
81 {- else |
|
82 (noChangeClients, |
|
83 modifyRoom clRoom{ |
|
84 teams = filter (\t -> teamName /= teamname t) $ teams clRoom, |
|
85 leftTeams = teamName : leftTeams clRoom, |
|
86 roundMsgs = roundMsgs clRoom |> rmTeamMsg |
|
87 }, |
|
88 answerOthersRoom ["GAMEMSG", rmTeamMsg]) -} |
|
89 where |
|
90 client = clients IntMap.! clID |
|
91 room = rooms IntMap.! (roomID client) |
|
92 noSuchTeam = isNothing findTeam |
|
93 team = fromJust findTeam |
|
94 findTeam = find (\t -> teamName == teamname t) $ teams room |
|
95 rmTeamMsg = toEngineMsg $ 'F' : teamName |
|
96 |
|
97 |
|
98 handleCmd_inRoom clID clients rooms ["HH_NUM", teamName, numberStr] = |
|
99 if not $ isMaster client then |
|
100 [ProtocolError "Not room master"] |
|
101 else |
|
102 if hhNumber < 1 || hhNumber > 8 || noSuchTeam || hhNumber > (canAddNumber + (hhnum team)) then |
|
103 [] |
|
104 else |
|
105 [ModifyRoom $ modifyTeam team{hhnum = hhNumber}, |
|
106 AnswerOthersInRoom ["HH_NUM", teamName, show hhNumber]] |
|
107 where |
|
108 client = clients IntMap.! clID |
|
109 room = rooms IntMap.! (roomID client) |
|
110 hhNumber = fromMaybe 0 (maybeRead numberStr :: Maybe Int) |
|
111 noSuchTeam = isNothing findTeam |
|
112 team = fromJust findTeam |
|
113 findTeam = find (\t -> teamName == teamname t) $ teams room |
|
114 canAddNumber = 48 - (sum . map hhnum $ teams room) |
|
115 |
|
116 |
|
117 handleCmd_inRoom clID clients rooms ["TEAM_COLOR", teamName, newColor] = |
|
118 if not $ isMaster client then |
|
119 [ProtocolError "Not room master"] |
|
120 else |
|
121 if noSuchTeam then |
|
122 [] |
|
123 else |
|
124 [ModifyRoom $ modifyTeam team{teamcolor = newColor}, |
|
125 AnswerOthersInRoom ["TEAM_COLOR", teamName, newColor]] |
|
126 where |
|
127 noSuchTeam = isNothing findTeam |
|
128 team = fromJust findTeam |
|
129 findTeam = find (\t -> teamName == teamname t) $ teams room |
|
130 client = clients IntMap.! clID |
|
131 room = rooms IntMap.! (roomID client) |
|
132 |
|
133 |
|
134 handleCmd_inRoom clID clients rooms ["TOGGLE_READY"] = |
|
135 [ModifyClient (\c -> c{isReady = not $ isReady client}), |
|
136 ModifyRoom (\r -> r{readyPlayers = readyPlayers r + (if isReady client then -1 else 1)}), |
|
137 AnswerThisRoom $ [if isReady client then "NOT_READY" else "READY", nick client]] |
|
138 where |
|
139 client = clients IntMap.! clID |
|
140 |
|
141 |
|
142 handleCmd_inRoom clID clients rooms ["START_GAME"] = |
|
143 if isMaster client && (playersIn room == readyPlayers room) && (not $ gameinprogress room) then |
|
144 if enoughClans then |
|
145 [ModifyRoom (\r -> r{gameinprogress = True, roundMsgs = empty, leftTeams = [], teamsAtStart = teams r}), |
|
146 AnswerThisRoom ["RUN_GAME"]] |
|
147 else |
|
148 [Warning "Less than two clans!"] |
|
149 else |
|
150 [] |
|
151 where |
|
152 client = clients IntMap.! clID |
|
153 room = rooms IntMap.! (roomID client) |
|
154 enoughClans = not $ null $ drop 1 $ group $ map teamcolor $ teams room |
|
155 |
|
156 |
|
157 handleCmd_inRoom client _ rooms ["GAMEMSG", msg] = |
|
158 [ModifyRoom (\r -> r{roundMsgs = roundMsgs r |> msg}), |
|
159 AnswerOthersInRoom ["GAMEMSG", msg]] |
|
160 |
|
161 |
|
162 handleCmd_inRoom clID _ _ _ = [ProtocolError "Incorrect command (state: in room)"] |