7 import Maybe |
7 import Maybe |
8 import qualified Data.Map as Map |
8 import qualified Data.Map as Map |
9 |
9 |
10 answerBadCmd = [(clientOnly, ["ERROR", "Bad command, state or incorrect parameter"])] |
10 answerBadCmd = [(clientOnly, ["ERROR", "Bad command, state or incorrect parameter"])] |
11 answerNotMaster = [(clientOnly, ["ERROR", "You cannot configure room parameters"])] |
11 answerNotMaster = [(clientOnly, ["ERROR", "You cannot configure room parameters"])] |
|
12 answerBadParam = [(clientOnly, ["ERROR", "Bad parameter"])] |
12 answerQuit = [(clientOnly, ["off"])] |
13 answerQuit = [(clientOnly, ["off"])] |
13 answerAbandoned = [(sameRoom, ["BYE"])] |
14 answerAbandoned = [(othersInRoom, ["BYE"])] |
14 answerQuitInform nick = [(othersInRoom, ["LEFT", nick])] |
15 answerQuitInform nick = [(othersInRoom, ["LEFT", nick])] |
15 answerNickChosen = [(clientOnly, ["ERROR", "The nick already chosen"])] |
16 answerNickChosen = [(clientOnly, ["ERROR", "The nick already chosen"])] |
16 answerNickChooseAnother = [(clientOnly, ["WARNING", "Choose another nick"])] |
17 answerNickChooseAnother = [(clientOnly, ["WARNING", "Choose another nick"])] |
17 answerNick nick = [(clientOnly, ["NICK", nick])] |
18 answerNick nick = [(clientOnly, ["NICK", nick])] |
18 answerProtocolKnown = [(clientOnly, ["ERROR", "Protocol number already known"])] |
19 answerProtocolKnown = [(clientOnly, ["ERROR", "Protocol number already known"])] |
27 answerConfigParam paramName paramStrs = [(othersInRoom, "CONFIG_PARAM" : paramName : paramStrs)] |
28 answerConfigParam paramName paramStrs = [(othersInRoom, "CONFIG_PARAM" : paramName : paramStrs)] |
28 answerFullConfig room = map toAnswer (Map.toList $ params room) |
29 answerFullConfig room = map toAnswer (Map.toList $ params room) |
29 where |
30 where |
30 toAnswer (paramName, paramStrs) = |
31 toAnswer (paramName, paramStrs) = |
31 (clientOnly, "CONFIG_PARAM" : paramName : paramStrs) |
32 (clientOnly, "CONFIG_PARAM" : paramName : paramStrs) |
32 answerCantAdd = [(clientOnly, ["WARNING", "Too many teams"])] |
33 answerCantAdd = [(clientOnly, ["WARNING", "Too many teams or hedgehogs"])] |
33 answerTeamAccepted team = [(clientOnly, ["TEAM_ACCEPTED", teamname team])] |
34 answerTeamAccepted team = [(clientOnly, ["TEAM_ACCEPTED", teamname team])] |
34 answerAddTeam team = [(othersInRoom, ["ADD_TEAM", teamname team, teamgrave team, teamfort team, show $ difficulty team] ++ hhsInfo)] |
35 answerAddTeam team = [(othersInRoom, ["ADD_TEAM", teamname team, teamgrave team, teamfort team, show $ difficulty team] ++ hhsInfo)] |
35 where |
36 where |
36 hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team |
37 hhsInfo = concatMap (\(HedgehogInfo name hat) -> [name, hat]) $ hedgehogs team |
|
38 answerHHNum teamName hhNumber = [(othersInRoom, ["HH_NUM", teamName, show hhNumber])] |
37 |
39 |
38 -- Main state-independent cmd handler |
40 -- Main state-independent cmd handler |
39 handleCmd :: CmdHandler |
41 handleCmd :: CmdHandler |
40 handleCmd client _ rooms ("QUIT":xs) = |
42 handleCmd client _ rooms ("QUIT":xs) = |
41 if null (room client) then |
43 if null (room client) then |
42 (noChangeClients, noChangeRooms, answerQuit) |
44 (noChangeClients, noChangeRooms, answerQuit) |
43 else if isMaster client then |
45 else if isMaster client then |
44 (noChangeClients, removeRoom (room client), answerAbandoned) -- core disconnects clients on ROOMABANDONED answer |
46 (noChangeClients, removeRoom (room client), answerQuit ++ answerAbandoned) -- core disconnects clients on ROOMABANDONED answer |
45 else |
47 else |
46 (noChangeClients, noChangeRooms, answerQuit ++ (answerQuitInform $ nick client)) |
48 (noChangeClients, noChangeRooms, answerQuit ++ (answerQuitInform $ nick client)) |
47 |
49 |
48 |
50 |
49 -- check state and call state-dependent commmand handlers |
51 -- check state and call state-dependent commmand handlers |
118 -- 'inRoom' clients state command handlers |
120 -- 'inRoom' clients state command handlers |
119 handleCmd_inRoom :: CmdHandler |
121 handleCmd_inRoom :: CmdHandler |
120 handleCmd_inRoom client _ _ ["CHAT_STRING", msg] = |
122 handleCmd_inRoom client _ _ ["CHAT_STRING", msg] = |
121 (noChangeClients, noChangeRooms, answerChatString (nick client) msg) |
123 (noChangeClients, noChangeRooms, answerChatString (nick client) msg) |
122 |
124 |
123 handleCmd_inRoom client _ rooms ("CONFIG_PARAM":paramName:paramStrs) = |
125 handleCmd_inRoom client _ rooms ("CONFIG_PARAM" : paramName : paramStrs) = |
124 if isMaster client then |
126 if isMaster client then |
125 (noChangeClients, modifyRoom clRoom{params = Map.insert paramName paramStrs (params clRoom)}, answerConfigParam paramName paramStrs) |
127 (noChangeClients, modifyRoom clRoom{params = Map.insert paramName paramStrs (params clRoom)}, answerConfigParam paramName paramStrs) |
126 else |
128 else |
127 (noChangeClients, noChangeRooms, answerNotMaster) |
129 (noChangeClients, noChangeRooms, answerNotMaster) |
128 where |
130 where |
129 clRoom = roomByName (room client) rooms |
131 clRoom = roomByName (room client) rooms |
130 |
132 |
131 handleCmd_inRoom client _ rooms ("ADDTEAM" : name : color : grave : fort : difStr : hhsInfo) |
133 handleCmd_inRoom client _ rooms ("ADD_TEAM" : name : color : grave : fort : difStr : hhsInfo) |
132 | length hhsInfo == 16 = |
134 | length hhsInfo == 16 = |
133 if length (teams clRoom) == 6 then |
135 if length (teams clRoom) == 6 || canAddNumber <= 0 then |
134 (noChangeClients, noChangeRooms, answerCantAdd) |
136 (noChangeClients, noChangeRooms, answerCantAdd) |
135 else |
137 else |
136 (noChangeClients, modifyRoom clRoom{teams = newTeam : teams clRoom}, answerTeamAccepted newTeam ++ answerAddTeam newTeam) |
138 (noChangeClients, modifyRoom clRoom{teams = newTeam : teams clRoom}, answerTeamAccepted newTeam ++ answerAddTeam newTeam) |
137 where |
139 where |
138 clRoom = roomByName (room client) rooms |
140 clRoom = roomByName (room client) rooms |
139 newTeam = (TeamInfo name color grave fort difficulty (hhsList hhsInfo)) |
141 newTeam = (TeamInfo name color grave fort difficulty newTeamHHNum (hhsList hhsInfo)) |
140 difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int) |
142 difficulty = fromMaybe 0 (maybeRead difStr :: Maybe Int) |
141 hhsList [] = [] |
143 hhsList [] = [] |
142 hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs |
144 hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs |
|
145 canAddNumber = 18 - (sum . map hhnum $ teams clRoom) |
|
146 newTeamHHNum = min 4 canAddNumber |
|
147 |
|
148 handleCmd_inRoom client _ rooms ["HH_NUM", teamName, numberStr] = |
|
149 if not $ isMaster client then |
|
150 (noChangeClients, noChangeRooms, answerNotMaster) |
|
151 else |
|
152 if hhNumber < 1 || hhNumber > 8 || hhNumber > canAddNumber|| noSuchTeam then |
|
153 (noChangeClients, noChangeRooms, answerBadParam) |
|
154 else |
|
155 (noChangeClients, modifyRoom $ modifyTeam clRoom team{hhnum = hhNumber}, answerHHNum teamName hhNumber) |
|
156 where |
|
157 hhNumber = fromMaybe 0 (maybeRead numberStr :: Maybe Int) |
|
158 noSuchTeam = isNothing findTeam |
|
159 team = fromJust findTeam |
|
160 findTeam = find (\t -> teamName == teamname t) $ teams clRoom |
|
161 clRoom = roomByName (room client) rooms |
|
162 canAddNumber = 18 - (sum . map hhnum $ teams clRoom) |
143 |
163 |
144 |
164 |
145 handleCmd_inRoom _ _ _ _ = (noChangeClients, noChangeRooms, answerBadCmd) |
165 handleCmd_inRoom _ _ _ _ = (noChangeClients, noChangeRooms, answerBadCmd) |