19 makeAnswer func msg = [\_ -> (func, msg)] |
19 makeAnswer func msg = [\_ -> (func, msg)] |
20 answerClientOnly, answerOthersRoom, answerSameRoom :: [String] -> [Answer] |
20 answerClientOnly, answerOthersRoom, answerSameRoom :: [String] -> [Answer] |
21 answerClientOnly = makeAnswer clientOnly |
21 answerClientOnly = makeAnswer clientOnly |
22 answerOthersRoom = makeAnswer othersInRoom |
22 answerOthersRoom = makeAnswer othersInRoom |
23 answerSameRoom = makeAnswer sameRoom |
23 answerSameRoom = makeAnswer sameRoom |
|
24 answerSameProtoLobby = makeAnswer sameProtoLobbyClients |
24 answerAll = makeAnswer allClients |
25 answerAll = makeAnswer allClients |
25 |
26 |
26 answerBadCmd = answerClientOnly ["ERROR", "Bad command, state or incorrect parameter"] |
27 answerBadCmd = answerClientOnly ["ERROR", "Bad command, state or incorrect parameter"] |
27 answerNotMaster = answerClientOnly ["ERROR", "You cannot configure room parameters"] |
28 answerNotMaster = answerClientOnly ["ERROR", "You cannot configure room parameters"] |
28 answerBadParam = answerClientOnly ["ERROR", "Bad parameter"] |
29 answerBadParam = answerClientOnly ["ERROR", "Bad parameter"] |
74 answerJoined nick = answerSameRoom ["JOINED", nick] |
75 answerJoined nick = answerSameRoom ["JOINED", nick] |
75 answerRunGame = answerSameRoom ["RUN_GAME"] |
76 answerRunGame = answerSameRoom ["RUN_GAME"] |
76 answerIsReady nick = answerSameRoom ["READY", nick] |
77 answerIsReady nick = answerSameRoom ["READY", nick] |
77 answerNotReady nick = answerSameRoom ["NOT_READY", nick] |
78 answerNotReady nick = answerSameRoom ["NOT_READY", nick] |
78 |
79 |
|
80 answerRoomAdded name = answerSameProtoLobby ["ROOM", "ADD", name] |
|
81 answerRoomDeleted name = answerSameProtoLobby ["ROOM", "DEL", name] |
|
82 |
79 answerFullConfig room = concatMap toAnswer (Map.toList $ params room) ++ (answerClientOnly ["MAP", gamemap room]) |
83 answerFullConfig room = concatMap toAnswer (Map.toList $ params room) ++ (answerClientOnly ["MAP", gamemap room]) |
80 where |
84 where |
81 toAnswer (paramName, paramStrs) = |
85 toAnswer (paramName, paramStrs) = |
82 answerClientOnly $ "CONFIG_PARAM" : paramName : paramStrs |
86 answerClientOnly $ "CONFIG_PARAM" : paramName : paramStrs |
83 |
87 |
112 handleCmd :: CmdHandler |
116 handleCmd :: CmdHandler |
113 handleCmd client _ rooms ("QUIT" : xs) = |
117 handleCmd client _ rooms ("QUIT" : xs) = |
114 if null (room client) then |
118 if null (room client) then |
115 (noChangeClients, noChangeRooms, answerQuit msg ++ (answerQuitLobby (nick client) msg) ) |
119 (noChangeClients, noChangeRooms, answerQuit msg ++ (answerQuitLobby (nick client) msg) ) |
116 else if isMaster client then |
120 else if isMaster client then |
117 (noChangeClients, removeRoom (room client), (answerQuit msg) ++ (answerQuitLobby (nick client) msg) ++ answerAbandoned) -- core disconnects clients on ROOMABANDONED answer |
121 (noChangeClients, removeRoom (room client), (answerQuit msg) ++ (answerQuitLobby (nick client) msg) ++ answerAbandoned ++ (answerRoomDeleted $ room client)) -- core disconnects clients on ROOMABANDONED answer |
118 else |
122 else |
119 (noChangeClients, modifyRoom clRoom{teams = othersTeams, playersIn = (playersIn clRoom) - 1, readyPlayers = newReadyPlayers}, (answerQuit msg) ++ (answerQuitInform (nick client) msg) ++ (answerQuitLobby (nick client) msg) ++ answerRemoveClientTeams) |
123 (noChangeClients, modifyRoom clRoom{teams = othersTeams, playersIn = (playersIn clRoom) - 1, readyPlayers = newReadyPlayers}, (answerQuit msg) ++ (answerQuitInform (nick client) msg) ++ (answerQuitLobby (nick client) msg) ++ answerRemoveClientTeams) |
120 where |
124 where |
121 clRoom = roomByName (room client) rooms |
125 clRoom = roomByName (room client) rooms |
122 answerRemoveClientTeams = concatMap (\tn -> answerOthersRoom ["REMOVE_TEAM", teamname tn]) clientTeams |
126 answerRemoveClientTeams = concatMap (\tn -> answerOthersRoom ["REMOVE_TEAM", teamname tn]) clientTeams |
204 |
208 |
205 handleCmd_noRoom client _ rooms ["CREATE", newRoom, roomPassword] = |
209 handleCmd_noRoom client _ rooms ["CREATE", newRoom, roomPassword] = |
206 if haveSameRoom then |
210 if haveSameRoom then |
207 (noChangeClients, noChangeRooms, answerRoomExists) |
211 (noChangeClients, noChangeRooms, answerRoomExists) |
208 else |
212 else |
209 (modifyClient client{room = newRoom, isMaster = True}, addRoom createRoom{name = newRoom, password = roomPassword, roomProto = (protocol client)}, (answerJoined $ nick client) ++ (answerNotReady $ nick client)) |
213 (modifyClient client{room = newRoom, isMaster = True}, addRoom createRoom{name = newRoom, password = roomPassword, roomProto = (protocol client)}, (answerJoined $ nick client) ++ (answerNotReady $ nick client) ++ (answerRoomAdded newRoom)) |
210 where |
214 where |
211 haveSameRoom = isJust $ find (\room -> newRoom == name room) rooms |
215 haveSameRoom = isJust $ find (\room -> newRoom == name room) rooms |
212 |
216 |
213 handleCmd_noRoom client clients rooms ["CREATE", newRoom] = |
217 handleCmd_noRoom client clients rooms ["CREATE", newRoom] = |
214 handleCmd_noRoom client clients rooms ["CREATE", newRoom, ""] |
218 handleCmd_noRoom client clients rooms ["CREATE", newRoom, ""] |