netserver/HWProto.hs
changeset 1618 2b9cadc232ab
parent 1616 03d099ace39b
child 1619 eb14d2e22e89
equal deleted inserted replaced
1617:30170c63a9dd 1618:2b9cadc232ab
    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 answerSameProtoLobby = makeAnswer sameProtoLobbyClients
       
    25 answerOtherLobby  = makeAnswer otherLobbyClients
    25 answerAll         = makeAnswer allClients
    26 answerAll         = makeAnswer allClients
    26 
    27 
    27 answerBadCmd            = answerClientOnly ["ERROR", "Bad command, state or incorrect parameter"]
    28 answerBadCmd            = answerClientOnly ["ERROR", "Bad command, state or incorrect parameter"]
    28 answerNotMaster         = answerClientOnly ["ERROR", "You cannot configure room parameters"]
    29 answerNotMaster         = answerClientOnly ["ERROR", "You cannot configure room parameters"]
    29 answerBadParam          = answerClientOnly ["ERROR", "Bad parameter"]
    30 answerBadParam          = answerClientOnly ["ERROR", "Bad parameter"]
   124 handleCmd :: CmdHandler
   125 handleCmd :: CmdHandler
   125 handleCmd client _ rooms ("QUIT" : xs) =
   126 handleCmd client _ rooms ("QUIT" : xs) =
   126 	if null (room client) then
   127 	if null (room client) then
   127 		(noChangeClients, noChangeRooms, answerQuit msg ++ (answerQuitLobby (nick client) msg) )
   128 		(noChangeClients, noChangeRooms, answerQuit msg ++ (answerQuitLobby (nick client) msg) )
   128 	else if isMaster client then
   129 	else if isMaster client then
   129 		(modifyRoomClients clRoom (\cl -> cl{isReady = False}), removeRoom (room client), (answerQuit msg) ++ (answerQuitLobby (nick client) msg) ++ (answerAbandoned $ protocol client) ++ (answerRoomDeleted $ room client)) -- core disconnects clients on ROOMABANDONED answer
   130 		(modifyRoomClients clRoom (\cl -> cl{room = [], isReady = False}), removeRoom (room client), (answerQuit msg) ++ (answerQuitLobby (nick client) msg) ++ (answerAbandoned $ protocol client) ++ (answerRoomDeleted $ room client)) -- core disconnects clients on ROOMABANDONED answer
   130 	else
   131 	else
   131 		(noChangeClients, modifyRoom clRoom{teams = othersTeams, playersIn = (playersIn clRoom) - 1, readyPlayers = newReadyPlayers}, (answerQuit msg) ++ (answerQuitInform (nick client) msg) ++ (answerQuitLobby (nick client) msg) ++ answerRemoveClientTeams)
   132 		(noChangeClients, modifyRoom clRoom{teams = othersTeams, playersIn = (playersIn clRoom) - 1, readyPlayers = newReadyPlayers}, (answerQuit msg) ++ (answerQuitInform (nick client) msg) ++ (answerQuitLobby (nick client) msg) ++ answerRemoveClientTeams)
   132 	where
   133 	where
   133 		clRoom = roomByName (room client) rooms
   134 		clRoom = roomByName (room client) rooms
   134 		answerRemoveClientTeams = concatMap (\tn -> answerOthersRoom ["REMOVE_TEAM", teamname tn]) clientTeams
   135 		answerRemoveClientTeams = concatMap (\tn -> answerOthersRoom ["REMOVE_TEAM", teamname tn]) clientTeams
   172 -- 'no info' state - need to get protocol number and nickname
   173 -- 'no info' state - need to get protocol number and nickname
   173 onLoginFinished client clients =
   174 onLoginFinished client clients =
   174 	if (null $ nick client) || (protocol client == 0) then
   175 	if (null $ nick client) || (protocol client == 0) then
   175 		[]
   176 		[]
   176 	else
   177 	else
   177 		(answerClientOnly $ ["LOBBY:JOINED"] ++ (filter (not . null) $ map nick $ clients)) ++
   178 		(answerClientOnly $ ["LOBBY:JOINED"] ++ (filter (\n -> (not (null n)) && n /= nick client) $ map nick $ clients)) ++
   178 		(answerOthersRoom ["LOBBY:JOINED", nick client]) ++
   179 		(answerAll ["LOBBY:JOINED", nick client]) ++
   179 		(answerServerMessage client clients)
   180 		(answerServerMessage client clients)
   180 
   181 
   181 handleCmd_noInfo :: CmdHandler
   182 handleCmd_noInfo :: CmdHandler
   182 handleCmd_noInfo client clients _ ["NICK", newNick] =
   183 handleCmd_noInfo client clients _ ["NICK", newNick] =
   183 	if not . null $ nick client then
   184 	if not . null $ nick client then
   268 	where
   269 	where
   269 		clRoom = roomByName (room client) rooms
   270 		clRoom = roomByName (room client) rooms
   270 
   271 
   271 handleCmd_inRoom client _ rooms ["PART"] =
   272 handleCmd_inRoom client _ rooms ["PART"] =
   272 	if isMaster client then
   273 	if isMaster client then
   273 		(modifyRoomClients clRoom (\cl -> cl{room = [], isReady = False, isMaster = False}), removeRoom (room client), (answerAbandoned $ protocol client) ++ (answerRoomDeleted $ room client))
   274 		(modifyRoomClients clRoom (\cl -> cl{isReady = False, isMaster = False, partRoom = True}), removeRoom (room client), (answerAbandoned $ protocol client) ++ (answerRoomDeleted $ room client))
   274 	else
   275 	else
   275 		(modifyClient client{isReady = False, partRoom = True}, modifyRoom clRoom{teams = othersTeams, playersIn = (playersIn clRoom) - 1, readyPlayers = newReadyPlayers}, (answerPartInform (nick client)) ++ answerRemoveClientTeams)
   276 		(modifyClient client{isReady = False, partRoom = True}, modifyRoom clRoom{teams = othersTeams, playersIn = (playersIn clRoom) - 1, readyPlayers = newReadyPlayers}, (answerPartInform (nick client)) ++ answerRemoveClientTeams)
   276 	where
   277 	where
   277 		clRoom = roomByName (room client) rooms
   278 		clRoom = roomByName (room client) rooms
   278 		answerRemoveClientTeams = concatMap (\tn -> answerOthersRoom ["REMOVE_TEAM", teamname tn]) clientTeams
   279 		answerRemoveClientTeams = concatMap (\tn -> answerOthersRoom ["REMOVE_TEAM", teamname tn]) clientTeams