cl_main.pas

delphi编的不错的贪吃蛇

    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;

  {$IFDEF WIN32}
  if (not NET_StringToAdr(cls.servername, adr)) then
  {$ELSE}
  if (not NET_StringToAdr(cls.servername, @adr)) then
  {$ENDIF}
  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;
    {$IFDEF WIN32}
    NET_StringToAdr(rcon_address.string_, to_);
    {$ELSE}
    NET_StringToAdr(rcon_address.string_, @to_);
    {$ENDIF}
    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

  {$IFDEF WIN32}
  if (not NET_StringToAdr(Cmd_Argv(1), adr)) then
  {$ELSE}
  if (not NET_StringToAdr(Cmd_Argv(1), @adr)) then
  {$ENDIF}
  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]);
    {$IFDEF WIN32}
    if (not NET_StringToAdr(adrstring, adr)) then
    {$ELSE}
    if (not NET_StringToAdr(adrstring, @adr)) then
    {$ENDIF}
    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;
    end;
    Netchan_Setup(NS_CLIENT, @cls.netchan, net_from, cls.quakePort);
    MSG_WriteChar(cls.netchan.message, Byte(clc_stringcmd));
    MSG_WriteString(cls.netchan.message, 'new');
    cls.state := ca_connected;
    exit;
  end;

  // server responding to a status broadcast
  if (strcmp(c, 'info') = 0) then
  begin
    CL_ParseStatusMessage();
    exit;
  end;