cl_main.pas

雷神之锤2(Quake2)Delphi源码

(*
=======================
CL_SendConnectPacket

We have gotten a challenge from the server, so try and
connect.
======================
*)
procedure CL_SendConnectPacket;
var
	adr: netadr_t;
	port: Integer;
begin
	if (not NET_StringToAdr (cls.servername, adr)) then begin
		Com_Printf ('Bad server address'#10, []);
		cls.connect_time := 0;
		exit;
  end;
	if (adr.port = 0) then
		adr.port := BigShort (PORT_SERVER);

	port := Round(Cvar_VariableValue ('qport'));
	userinfo_modified := false;

	Netchan_OutOfBandPrint (NS_CLIENT, adr, 'connect %d %d %d "%s"'#10,
		[PROTOCOL_VERSION, port, cls.challenge, Cvar_Userinfo_() ]);
end;

(*
=================
CL_CheckForResend

Resend a connect message if the last one has timed out
=================
*)
procedure CL_CheckForResend;
var
	adr: netadr_t;
begin
	// if the local server is running and we aren't
	// then connect
	if (cls.state = ca_disconnected) and (Com_ServerState() <>0) then begin
		cls.state := ca_connecting;
		strncpy (cls.servername, 'localhost', sizeof(cls.servername)-1);
		// we don't need a challenge on the localhost
		CL_SendConnectPacket ();
    exit;
    // cls.connect_time = -99999;	// CL_CheckForResend() will fire immediately
  end;

	// resend if we haven't gotten a reply yet
	if (cls.state <> ca_connecting) then
		exit;

	if (cls.realtime - cls.connect_time < 3000) then
		exit;

	if (not NET_StringToAdr (cls.servername, adr)) then begin
		Com_Printf ('Bad server address'#10, []);
		cls.state := ca_disconnected;
		exit;
  end;
	if (adr.port = 0) then
		adr.port := BigShort (PORT_SERVER);

	cls.connect_time := cls.realtime;	// for retransmit requests

	Com_Printf ('Connecting to %s...'#10, [cls.servername]);

	Netchan_OutOfBandPrint (NS_CLIENT, adr, 'getchallenge'#10, []);
end;


(*
================
CL_Connect_f

================
*)
procedure CL_Connect_f; cdecl;
var
	server: pchar;
begin
	if (Cmd_Argc() <> 2) then begin
		Com_Printf ('usage: connect <server>'#10, []);
		exit;
  end;

	if (Com_ServerState<>0) then begin
		// if running a local server, kill it and reissue
		SV_Shutdown (va('Server quit'#10, [msg]), false);
  end
	else
  begin
		CL_Disconnect ();
  end;

	server := Cmd_Argv (1);

	NET_Config (true);		// allow remote

	CL_Disconnect ();

	cls.state := ca_connecting;
	strncpy (cls.servername, server, sizeof(cls.servername)-1);
	cls.connect_time := -99999;	// CL_CheckForResend() will fire immediately
end;


(*
=====================
CL_Rcon_f

  Send the rest of the command line over as
  an unconnected command.
=====================
*)
procedure CL_Rcon_f; cdecl;
var
	message_: array[0..1024-1] of char;
	i: Integer;
	to_: netadr_t;
begin
	if (rcon_client_password.string_ = nil) then begin
		Com_Printf ('You must set ''rcon_password'' before'#10 +
					      'issuing an rcon command.'#10, []);
		exit;
  end;

	message_[0] := #255;
	message_[1] := #255;
	message_[2] := #255;
	message_[3] := #255;
	message_[4] := #0;

	NET_Config (true);		// allow remote

	strcat (message_, 'rcon ');

	strcat (message_, rcon_client_password.string_);
	strcat (message_, ' ');

	for i := 1 to Cmd_Argc()-1 do begin
		strcat (message_, Cmd_Argv(i));
		strcat (message_, ' ');
  end;

	if (cls.state >= ca_connected) then
		to_ := cls.netchan.remote_address
	else
  begin
		if (Length(rcon_address.string_) = 0) then begin
			Com_Printf ('You must either be connected,'#10 +
						      'or set the ''rcon_address'' cvar'#10 +
						      'to issue rcon commands'#10);

			exit;
    end;
		NET_StringToAdr (rcon_address.string_, to_);
		if (to_.port = 0) then
			to_.port := BigShort (PORT_SERVER);
  end;

	NET_SendPacket (NS_CLIENT, strlen(message_)+1, @message_, to_);
end;


(*
=====================
CL_ClearState

=====================
*)
procedure CL_ClearState;
begin
	S_StopAllSounds ();
	CL_ClearEffects ();
	CL_ClearTEnts ();
// wipe the entire cl structure
	FillChar (cl, sizeof(cl), #0);
	FillChar (cl_entities, sizeof(cl_entities), #0);

	SZ_Clear (cls.netchan.message);
end;

(*
=====================
CL_Disconnect

Goes from a connected state to full screen console state
Sends a disconnect message to the server
This is also called on Com_Error, so it shouldn't cause any errors
=====================
*)
procedure CL_Disconnect;
var
	final: array [0..32-1] of byte;
  time: Integer;
begin
	if (cls.state = ca_disconnected) then
		exit;

	if (cl_timedemo <> nil) and (cl_timedemo.value<>0) then begin
		time := Sys_Milliseconds () - cl.timedemo_start;
		if (time > 0) then
			Com_Printf ('%d frames, %3.1f seconds: %3.1f fps'#10, [cl.timedemo_frames,
			time/1000.0, cl.timedemo_frames*1000.0 / time]);
  end;

	VectorClear (vec3_p(@cl.refdef.blend)^);
	re.CinematicSetPalette(nil);

	M_ForceMenuOff ();

	cls.connect_time := 0;

	SCR_StopCinematic ();

	if (cls.demorecording) then
		CL_Stop_f ();

	// send a disconnect message to the server
	final[0] := Byte(clc_stringcmd);
	strcpy (@final[1], 'disconnect');
	Netchan_Transmit (cls.netchan, strlen(@final), @final);
	Netchan_Transmit (cls.netchan, strlen(@final), @final);
	Netchan_Transmit (cls.netchan, strlen(@final), @final);

	CL_ClearState ();

	// stop download
	if (cls.download>0) then begin
		FileClose(cls.download);
		cls.download := 0;
  end;

	cls.state := ca_disconnected;
end;

procedure CL_Disconnect_f; cdecl;
begin
	Com_Error (ERR_DROP, 'Disconnected from server');
end;


(*
====================
CL_Packet_f

packet <destination> <contents>

Contents allows \n(#10) escape character
====================
*)
procedure CL_Packet_f; cdecl;
var
	send: array[0..2048-1] of char;
	i, l: Integer;
	in_, out_: pchar;
	adr: netadr_t;
begin
	if (Cmd_Argc() <> 3) then begin
		Com_Printf ('packet <destination> <contents>'#10, []);
		exit;
  end;

	NET_Config (true);		// allow remote

	if (not NET_StringToAdr (Cmd_Argv(1), adr)) then begin
		Com_Printf ('Bad address'#10);
		exit;
  end;

	if (adr.port = 0) then
		adr.port := BigShort (PORT_SERVER);

	in_ := Cmd_Argv(2);
	out_ := send+4;
	send[0] := #$ff;
  send[1] := #$ff;
  send[2] := #$ff;
  send[3] := #$ff;

	l := strlen (in_);
	for i := 0 to l-1 do begin
		if (in_[i] = '\') and (in_[i+1] = #10) then begin
			out_ := #10;
      inc (out_);
		end
		else begin
			out_^ := in_[i];
      inc(out_);
    end;
	end;
	out_ := #0;

	NET_SendPacket (NS_CLIENT, out_-send, @send, adr);
end;

(*
=================
CL_Changing_f

Just sent as a hint to the client that they should
drop to full console
=================
*)
procedure CL_Changing_f; cdecl;
begin
	//ZOID
	//if we are downloading, we don't change!  This so we don't suddenly stop downloading a map
	if (cls.download>0) then exit;

	SCR_BeginLoadingPlaque ();
	cls.state := ca_connected;	// not active anymore, but not disconnected
	Com_Printf (#10'Changing map...'#10);
end;


(*
=================
CL_Reconnect_f

The server is changing levels
=================
*)
procedure CL_Reconnect_f; cdecl;
begin
	//ZOID
	//if we are downloading, we don't change!  This so we don't suddenly stop downloading a map
	if (cls.download>0) then exit;

	S_StopAllSounds ();
	if (cls.state = ca_connected) then begin
		Com_Printf ('reconnecting...'#10, []);
		cls.state := ca_connected;
		MSG_WriteChar (cls.netchan.message, Byte(clc_stringcmd));
		MSG_WriteString (cls.netchan.message, 'new');
		exit;
  end;

	if (cls.servername <> nil) then begin
		if (cls.state >= ca_connected) then begin
			CL_Disconnect();
			cls.connect_time := cls.realtime - 1500;
		end else
			cls.connect_time := -99999; // fire immediately

		cls.state := ca_connecting;
		Com_Printf ('reconnecting...'#10, []);
  end;
end;

(*
=================
CL_ParseStatusMessage

Handle a reply from a ping
=================
*)
procedure CL_ParseStatusMessage;
var
	s: pchar;
begin
	s := MSG_ReadString(net_message);

	Com_Printf ('%s'#10, [s]);

	M_AddToServerList (net_from, s);
end;


(*
=================
CL_PingServers_f
=================
*)
procedure CL_PingServers_f; cdecl;
var
	i: Integer;
	adr: netadr_t;
	name: array[0..32-1] of char;
	adrstring: pchar;
	noudp,
	noipx : cvar_p;
begin
	NET_Config (true);		// allow remote

	// send a broadcast packet
	Com_Printf ('pinging broadcast...'#10, []);

	noudp := Cvar_Get ('noudp', '0', CVAR_NOSET);
	if (noudp.value = 0) then begin
		adr.type_ := NA_BROADCAST;
		adr.port := BigShort(PORT_SERVER);
		Netchan_OutOfBandPrint (NS_CLIENT, adr, va('info %d', [PROTOCOL_VERSION]), []);
  end;

	noipx := Cvar_Get ('noipx', '0', CVAR_NOSET);
	if (noipx.value = 0) then begin
		adr.type_ := NA_BROADCAST_IPX;
		adr.port := BigShort(PORT_SERVER);
		Netchan_OutOfBandPrint (NS_CLIENT, adr, va('info %d', [PROTOCOL_VERSION]), []);
  end;

	// send a packet to each address book entry
	for i :=0 to 16-1 do begin
		Com_sprintf (name, sizeof(name), 'adr%d', [i]);
		adrstring := Cvar_VariableString (name);
		if (adrstring = nil) or (adrstring[0]=#0) then
			continue;

		Com_Printf ('pinging %s...'#10, [adrstring]);
		if (not NET_StringToAdr (adrstring, adr)) then begin
			Com_Printf ('Bad address: %s'#10, [adrstring]);
			continue;
		end;
		if (adr.port = 0) then
			adr.port := BigShort(PORT_SERVER);
		Netchan_OutOfBandPrint (NS_CLIENT, adr, va('info %d', [PROTOCOL_VERSION]), []);
	end;
end;


(*
=================
CL_Skins_f

Load or download any custom player skins and models
=================
*)
procedure CL_Skins_f; cdecl;
var
	i: integer;
begin
	for i := 0 to MAX_CLIENTS-1 do begin
		if (cl.configstrings[CS_PLAYERSKINS+i][0] = #0) then
			continue;
		Com_Printf ('client %d: %s'#10, [i, cl.configstrings[CS_PLAYERSKINS+i]]);
		SCR_UpdateScreen ();
		Sys_SendKeyEvents ();	// pump message loop
		CL_ParseClientinfo (i);
  end;
end;


(*
=================
CL_ConnectionlessPacket

Responses to broadcasts, etc
=================
*)
procedure CL_ConnectionlessPacket;
var
	s, c: pchar;
begin
	MSG_BeginReading (net_message);
	MSG_ReadLong (net_message);	// skip the -1

	s := MSG_ReadStringLine (net_message);

	Cmd_TokenizeString (s, false);

	c := Cmd_Argv(0);

	Com_Printf ('%s: %s'#10, [NET_AdrToString (net_from), c]);

	// server connection
	if (strcmp(c, 'client_connect') = 0) then begin
		if (cls.state = ca_connected) then begin
			Com_Printf ('Dup connect received.  Ignored.'#10);
			exit;