56 answerQuitInform nick msg = |
56 answerQuitInform nick msg = |
57 if not $ null msg then |
57 if not $ null msg then |
58 answerOthersRoom ["LEFT", nick, msg] |
58 answerOthersRoom ["LEFT", nick, msg] |
59 else |
59 else |
60 answerOthersRoom ["LEFT", nick] |
60 answerOthersRoom ["LEFT", nick] |
|
61 answerQuitLobby nick msg = |
|
62 if not $ null msg then |
|
63 answerOthersRoom ["LOBBY:LEFT", nick, msg] |
|
64 else |
|
65 answerOthersRoom ["LOBBY:LEFT", nick] |
61 |
66 |
62 answerJoined nick = answerSameRoom ["JOINED", nick] |
67 answerJoined nick = answerSameRoom ["JOINED", nick] |
63 answerRunGame = answerSameRoom ["RUN_GAME"] |
68 answerRunGame = answerSameRoom ["RUN_GAME"] |
64 answerIsReady nick = answerSameRoom ["READY", nick] |
69 answerIsReady nick = answerSameRoom ["READY", nick] |
65 answerNotReady nick = answerSameRoom ["NOT_READY", nick] |
70 answerNotReady nick = answerSameRoom ["NOT_READY", nick] |
99 |
104 |
100 -- Main state-independent cmd handler |
105 -- Main state-independent cmd handler |
101 handleCmd :: CmdHandler |
106 handleCmd :: CmdHandler |
102 handleCmd client _ rooms ("QUIT" : xs) = |
107 handleCmd client _ rooms ("QUIT" : xs) = |
103 if null (room client) then |
108 if null (room client) then |
104 (noChangeClients, noChangeRooms, answerQuit msg) |
109 (noChangeClients, noChangeRooms, answerQuit msg ++ (answerQuitLobby (nick client) msg) ) |
105 else if isMaster client then |
110 else if isMaster client then |
106 (noChangeClients, removeRoom (room client), (answerQuit msg) ++ answerAbandoned) -- core disconnects clients on ROOMABANDONED answer |
111 (noChangeClients, removeRoom (room client), (answerQuit msg) ++ (answerQuitLobby (nick client) msg) ++ answerAbandoned) -- core disconnects clients on ROOMABANDONED answer |
107 else |
112 else |
108 (noChangeClients, modifyRoom clRoom{teams = othersTeams, playersIn = (playersIn clRoom) - 1, readyPlayers = newReadyPlayers}, (answerQuit msg) ++ (answerQuitInform (nick client) msg) ++ answerRemoveClientTeams) |
113 (noChangeClients, modifyRoom clRoom{teams = othersTeams, playersIn = (playersIn clRoom) - 1, readyPlayers = newReadyPlayers}, (answerQuit msg) ++ (answerQuitInform (nick client) msg) ++ (answerQuitLobby (nick client) msg) ++ answerRemoveClientTeams) |
109 where |
114 where |
110 clRoom = roomByName (room client) rooms |
115 clRoom = roomByName (room client) rooms |
111 answerRemoveClientTeams = concatMap (\tn -> answerOthersRoom ["REMOVE_TEAM", teamname tn]) clientTeams |
116 answerRemoveClientTeams = concatMap (\tn -> answerOthersRoom ["REMOVE_TEAM", teamname tn]) clientTeams |
112 (clientTeams, othersTeams) = partition (\t -> teamowner t == nick client) $ teams clRoom |
117 (clientTeams, othersTeams) = partition (\t -> teamowner t == nick client) $ teams clRoom |
113 newReadyPlayers = if isReady client then (readyPlayers clRoom) - 1 else readyPlayers clRoom |
118 newReadyPlayers = if isReady client then (readyPlayers clRoom) - 1 else readyPlayers clRoom |
134 else |
139 else |
135 handleCmd_inRoom client clients rooms cmd |
140 handleCmd_inRoom client clients rooms cmd |
136 |
141 |
137 |
142 |
138 -- 'no info' state - need to get protocol number and nickname |
143 -- 'no info' state - need to get protocol number and nickname |
|
144 onLoginFinished client clients = |
|
145 if (protocol client < 20) || (null $ nick client) || (protocol client == 0) then |
|
146 [] |
|
147 else |
|
148 (answerClientOnly $ ["LOBBY:JOINED"] ++ (map nick $ clients)) ++ |
|
149 (answerOthersRoom ["LOBBY:JOINED", nick client]) |
|
150 |
139 handleCmd_noInfo :: CmdHandler |
151 handleCmd_noInfo :: CmdHandler |
140 handleCmd_noInfo client clients _ ["NICK", newNick] = |
152 handleCmd_noInfo client clients _ ["NICK", newNick] = |
141 if not . null $ nick client then |
153 if not . null $ nick client then |
142 (noChangeClients, noChangeRooms, answerNickChosen) |
154 (noChangeClients, noChangeRooms, answerNickChosen) |
143 else if haveSameNick then |
155 else if haveSameNick then |
144 (noChangeClients, noChangeRooms, answerNickChooseAnother) |
156 (noChangeClients, noChangeRooms, answerNickChooseAnother) |
145 else |
157 else |
146 (modifyClient client{nick = newNick}, noChangeRooms, answerNick newNick) |
158 (modifyClient client{nick = newNick}, noChangeRooms, answerNick newNick ++ (onLoginFinished client{nick = newNick} clients)) |
147 where |
159 where |
148 haveSameNick = isJust $ find (\cl -> newNick == nick cl) clients |
160 haveSameNick = isJust $ find (\cl -> newNick == nick cl) clients |
149 |
161 |
150 handleCmd_noInfo client _ _ ["PROTO", protoNum] = |
162 handleCmd_noInfo client clients _ ["PROTO", protoNum] = |
151 if protocol client > 0 then |
163 if protocol client > 0 then |
152 (noChangeClients, noChangeRooms, answerProtocolKnown) |
164 (noChangeClients, noChangeRooms, answerProtocolKnown) |
153 else if parsedProto == 0 then |
165 else if parsedProto == 0 then |
154 (noChangeClients, noChangeRooms, answerBadInput) |
166 (noChangeClients, noChangeRooms, answerBadInput) |
155 else |
167 else |
156 (modifyClient client{protocol = parsedProto}, noChangeRooms, answerProto parsedProto) |
168 (modifyClient client{protocol = parsedProto}, noChangeRooms, answerProto parsedProto ++ (onLoginFinished client{protocol = parsedProto} clients)) |
157 where |
169 where |
158 parsedProto = fromMaybe 0 (maybeRead protoNum :: Maybe Word16) |
170 parsedProto = fromMaybe 0 (maybeRead protoNum :: Maybe Word16) |
159 |
171 |
160 handleCmd_noInfo _ _ _ _ = (noChangeClients, noChangeRooms, answerBadCmd) |
172 handleCmd_noInfo _ _ _ _ = (noChangeClients, noChangeRooms, answerBadCmd) |
161 |
173 |