netserver/HWProto.hs
changeset 1478 8bfb417d165e
parent 1473 60e1fad78d58
child 1483 89e24edb6020
equal deleted inserted replaced
1477:001a52a108ed 1478:8bfb417d165e
    23 		nicks = filter (not . null) $ map nick clients
    23 		nicks = filter (not . null) $ map nick clients
    24 		
    24 		
    25 answerBadCmd = [(clientOnly, ["ERROR", "Bad command, state or incorrect parameter"])]
    25 answerBadCmd = [(clientOnly, ["ERROR", "Bad command, state or incorrect parameter"])]
    26 answerNotMaster = [(clientOnly, ["ERROR", "You cannot configure room parameters"])]
    26 answerNotMaster = [(clientOnly, ["ERROR", "You cannot configure room parameters"])]
    27 answerBadParam = [(clientOnly, ["ERROR", "Bad parameter"])]
    27 answerBadParam = [(clientOnly, ["ERROR", "Bad parameter"])]
    28 answerQuit = [(clientOnly, ["BYE"])]
    28 answerQuit msg = [(clientOnly, ["BYE", msg])]
    29 answerAbandoned = [(othersInRoom, ["BYE"])]
    29 answerAbandoned = [(othersInRoom, ["BYE", "Room abandoned"])]
    30 answerQuitInform nick = [(othersInRoom, ["LEFT", nick])]
    30 answerQuitInform nick = [(othersInRoom, ["LEFT", nick])]
    31 answerNickChosen = [(clientOnly, ["ERROR", "The nick already chosen"])]
    31 answerNickChosen = [(clientOnly, ["ERROR", "The nick already chosen"])]
    32 answerNickChooseAnother = [(clientOnly, ["WARNING", "Choose another nick"])]
    32 answerNickChooseAnother = [(clientOnly, ["WARNING", "Choose another nick"])]
    33 answerNick nick = [(clientOnly, ["NICK", nick])]
    33 answerNick nick = [(clientOnly, ["NICK", nick])]
    34 answerProtocolKnown = [(clientOnly, ["ERROR", "Protocol number already known"])]
    34 answerProtocolKnown = [(clientOnly, ["ERROR", "Protocol number already known"])]
    68 answerPing = [(allClients, ["PING"])]
    68 answerPing = [(allClients, ["PING"])]
    69 answerConnected = [(clientOnly, ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"])]
    69 answerConnected = [(clientOnly, ["CONNECTED", "Hedgewars server http://www.hedgewars.org/"])]
    70 
    70 
    71 -- Main state-independent cmd handler
    71 -- Main state-independent cmd handler
    72 handleCmd :: CmdHandler
    72 handleCmd :: CmdHandler
    73 handleCmd client _ rooms ("QUIT":xs) =
    73 handleCmd client _ rooms ("QUIT" : xs) =
    74 	if null (room client) then
    74 	if null (room client) then
    75 		(noChangeClients, noChangeRooms, answerQuit)
    75 		(noChangeClients, noChangeRooms, answerQuit msg)
    76 	else if isMaster client then
    76 	else if isMaster client then
    77 		(noChangeClients, removeRoom (room client), answerQuit ++ answerAbandoned) -- core disconnects clients on ROOMABANDONED answer
    77 		(noChangeClients, removeRoom (room client), (answerQuit msg) ++ answerAbandoned) -- core disconnects clients on ROOMABANDONED answer
    78 	else
    78 	else
    79 		(noChangeClients, modifyRoom clRoom{teams = othersTeams, playersIn = (playersIn clRoom) - 1, readyPlayers = newReadyPlayers}, answerQuit ++ (answerQuitInform $ nick client) ++ answerRemoveClientTeams)
    79 		(noChangeClients, modifyRoom clRoom{teams = othersTeams, playersIn = (playersIn clRoom) - 1, readyPlayers = newReadyPlayers}, (answerQuit msg) ++ (answerQuitInform $ nick client) ++ answerRemoveClientTeams)
    80 	where
    80 	where
    81 		clRoom = roomByName (room client) rooms
    81 		clRoom = roomByName (room client) rooms
    82 		answerRemoveClientTeams = map (\tn -> (othersInRoom, ["REMOVE_TEAM", teamname tn])) clientTeams
    82 		answerRemoveClientTeams = map (\tn -> (othersInRoom, ["REMOVE_TEAM", teamname tn])) clientTeams
    83 		(clientTeams, othersTeams) = partition (\t -> teamowner t == nick client) $ teams clRoom
    83 		(clientTeams, othersTeams) = partition (\t -> teamowner t == nick client) $ teams clRoom
    84 		newReadyPlayers = if isReady client then (readyPlayers clRoom) - 1 else readyPlayers clRoom
    84 		newReadyPlayers = if isReady client then (readyPlayers clRoom) - 1 else readyPlayers clRoom
       
    85 		msg = if not $ null xs then head xs else ""
    85 
    86 
    86 handleCmd _ _ _ ["PING"] = -- core requsted
    87 handleCmd _ _ _ ["PING"] = -- core requsted
    87 	(noChangeClients, noChangeRooms, answerPing)
    88 	(noChangeClients, noChangeRooms, answerPing)
    88 
    89 
    89 handleCmd _ _ _ ["ASKME"] = -- core requsted
    90 handleCmd _ _ _ ["ASKME"] = -- core requsted