cl_main.pas

delphi编的不错的贪吃蛇

{$ALIGN ON}{$MINENUMSIZE 4}
{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): client\cl_main.c                                                    }
{                                                                            }
{ Initial conversion by : Juha Hartikainen ([e-mail])             }
{ Initial conversion on : 02-Jun-2002                                        }
{                                                                            }
{ This File contains part of convertion of Quake2 source to ObjectPascal.    }
{ More information about this project can be found at:                       }
{ http://www.sulaco.co.za/quake2/                                            }
{                                                                            }
{ Copyright (C) 1997-2001 Id Software, Inc.                                  }
{                                                                            }
{ This program is free software; you can redistribute it and/or              }
{ modify it under the terms of the GNU General Public License                }
{ as published by the Free Software Foundation; either version 2             }
{ of the License, or (at your option) any later version.                     }
{                                                                            }
{ This program is distributed in the hope that it will be useful,            }
{ but WITHOUT ANY WARRANTY; without even the implied warranty of             }
{ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                       }
{                                                                            }
{ See the GNU General Public License for more details.                       }
{                                                                            }
{----------------------------------------------------------------------------}
{ Updated on : 25-jul-2002                                                   }
{ Updated by : burnin ([e-mail])                                }
{   Removed IFDEF TODO directives around menu calls.                         }
{   Added some routines needed by menu.pas to interface section              }
{                                                                            }
{----------------------------------------------------------------------------}
// cl_main.c  -- client main loop

unit cl_main;

interface

uses
  Client,
  q_shared;

procedure Cmd_ForwardToServer;
procedure CL_Disconnect;
procedure CL_FixUpGender;
procedure CL_Snd_Restart_f; cdecl;
procedure CL_Drop;
procedure CL_Init;
procedure CL_Shutdown;
procedure CL_Frame(msec: Integer);
procedure CL_RequestNextDownload;
procedure CL_ClearState;
procedure CL_WriteDemoMessage;
procedure CL_PingServers_f; cdecl;
procedure CL_Quit_f; cdecl;

var
  cls: client_static_t;
  cl: client_state_t;
  cl_entities: array[0..MAX_EDICTS - 1] of centity_t;
  cl_parse_entities: array[0..MAX_PARSE_ENTITIES - 1] of entity_state_t;

var
  freelook,
    adr0,
    adr1,
    adr2,
    adr3,
    adr4,
    adr5,
    adr6,
    adr7,
    adr8,

  cl_stereo_separation,
    cl_stereo,

  rcon_client_password,
    rcon_address,

  cl_noskins,
    cl_autoskins,
    cl_footsteps,
    cl_timeout,
    cl_predict,
    //cvar_t	*cl_minfps,
  cl_maxfps,
    cl_gun,

  cl_add_particles,
    cl_add_lights,
    cl_add_entities,
    cl_add_blend,

  cl_shownet,
    cl_showmiss,
    cl_showclamp,

  cl_paused,
    cl_timedemo,

  lookspring,
    lookstrafe,
    sensitivity,

  m_pitch,
    m_yaw,
    m_forward,
    m_side,

  cl_lightlevel,

  //
  // userinfo
  //
  info_password,
    info_spectator,
    name,
    skin,
    rate,
    fov,
    msg,
    hand,
    gender,
    gender_auto,

  cl_vwep: cvar_p;

implementation

uses
  {$IFDEF WIN32}
  Windows,
  net_wins,
  sys_win,
  cd_win,
  q_shwin,
  in_win,
  vid_dll,
  {$ELSE}
  vid_so ,
  in_linux,
  q_shlinux,
  sys_linux,
  cd_sdl,
  net_udp,
  libc,
  {$ENDIF}
  qfiles,
  SysUtils,
  Files,
  Cmd,
  Common,
  Console,
  CModel,
  CVar,
  CPas,
  Keys,
  net_chan,
  server,
  sv_main,
  snd_dma,
  cl_tent,
  menu,
  cl_parse,
  cl_pred,
  cl_cin,
  cl_view,
  cl_input,
  cl_fx,
  cl_scrn;

//======================================================================

{*
====================
CL_WriteDemoMessage

Dumps the current net message, prefixed by the length
====================
*}
procedure CL_WriteDemoMessage;
var
  len, swlen: Integer;
  buf: pchar;
begin
  // the first eight bytes are just packet sequencing stuff
  len := net_message.cursize - 8;
  swlen := LittleLong(len);

  FileWrite(cls.demofile, swlen, 4);
  buf := PChar(Integer(net_message.data) + 8);
  FileWrite(cls.demofile, buf^, len);
end;

{*
====================
CL_Stop_f

stop recording a demo
====================
*}
procedure CL_Stop_f; cdecl;
var
  len: Integer;
begin
  if (not cls.demorecording) then
  begin
    Com_Printf('Not recording a demo.'#10, []);
    exit;
  end;

  // finish up
  len := -1;
  FileWrite(cls.demofile, len, 4);
  FileClose(cls.demofile);
  cls.demofile := 0;
  cls.demorecording := false;
  Com_Printf('Stopped demo.'#10, []);
end;

{*
====================
CL_Record_f

record <demoname>

Begins recording a demo from the current position
====================
*}
procedure CL_Record_f; cdecl;
var
  name: array[0..MAX_OSPATH - 1] of char;
  buf_data: array[0..MAX_MSGLEN - 1] of char;
  buf: sizebuf_t;
  i: Integer;
  len: Integer;
  ent: entity_state_p;
  nilstate: entity_state_t;
begin
  if (Cmd_Argc <> 2) then
  begin
    Com_Printf('record <demoname>'#10, []);
    exit;
  end;

  if (cls.demorecording) then
  begin
    Com_Printf('Already recording.'#10, []);
    exit;
  end;

  if (cls.state <> ca_active) then
  begin
    Com_Printf('You must be in a level to record.'#10, []);
    exit;
  end;

  //
  // open the demo file
  //
  Com_sprintf(name, sizeof(name), '%s/demos/%s.dm2', [FS_Gamedir, Cmd_Argv(1)]);

  Com_Printf('recording to %s.'#10, [name]);
  FS_CreatePath(name);

  cls.demofile := FileOpen(name, fmOpenReadWrite);
  if (cls.demofile = 0) then
  begin
    Com_Printf('ERROR: couldn''t open.'#10, []);
    exit;
  end;
  cls.demorecording := true;

  // don't start saving messages until a non-delta compressed message is received
  cls.demowaiting := true;

  //
  // write out messages to hold the startup information
  //
  SZ_Init(buf, PByte(@buf_data), sizeof(buf_data));

  // send the serverdata
  MSG_WriteByte(buf, Byte(svc_serverdata));
  MSG_WriteLong(buf, PROTOCOL_VERSION);
  MSG_WriteLong(buf, $010000 + cl.servercount);
  MSG_WriteByte(buf, 1);                // demos are always attract loops
  MSG_WriteString(buf, cl.gamedir);
  MSG_WriteShort(buf, cl.playernum);

  MSG_WriteString(buf, cl.configstrings[CS_NAME]);

  // configstrings
  for i := 0 to MAX_CONFIGSTRINGS - 1 do
  begin
    if (Byte(cl.configstrings[i][0]) <> 0) then
    begin
      if (buf.cursize + Length(cl.configstrings[i]) + 32 > buf.maxsize) then
      begin
        // write it out
        len := LittleLong(buf.cursize);
        FileWrite(cls.demofile, len, 4);
        FileWrite(cls.demofile, buf.data, buf.cursize);
        buf.cursize := 0;
      end;
      MSG_WriteByte(buf, Byte(svc_configstring));
      MSG_WriteShort(buf, i);
      MSG_WriteString(buf, cl.configstrings[i]);
    end;
  end;

  // baselines
  FillChar(nilstate, sizeof(nilstate), #0);
  for i := 0 to MAX_EDICTS - 1 do
  begin
    ent := @cl_entities[i].baseline;
    if (ent.modelindex = 0) then
      continue;

    if (buf.cursize + 64 > buf.maxsize) then
    begin
      // write it out
      len := LittleLong(buf.cursize);
      FileWrite(cls.demofile, len, 4);
      FileWrite(cls.demofile, buf.data, buf.cursize);
      buf.cursize := 0;
    end;

    MSG_WriteByte(buf, Byte(svc_spawnbaseline));
    MSG_WriteDeltaEntity(nilstate, cl_entities[i].baseline, buf, true, true);
  end;

  MSG_WriteByte(buf, Byte(svc_stufftext));
  MSG_WriteString(buf, 'precache'#10);

  // write it to the demo file

  len := LittleLong(buf.cursize);

  FileWrite(cls.demofile, len, 4);
  FileWrite(cls.demofile, buf.data, buf.cursize);

  // the rest of the demo file will be individual frames
end;

//======================================================================

{*
===================
Cmd_ForwardToServer

adds the current command line as a clc_stringcmd to the client message.
things like godmode, noclip, etc, are commands directed to the server,
so when they are typed in at the console, they will need to be forwarded.
===================
*}
procedure Cmd_ForwardToServer;
var
  cmd: PChar;
begin
  cmd := Cmd_Argv(0);
  if (cls.state <= ca_connected) or
    (cmd^ = '-') or
    (cmd^ = '+') then
  begin
    Com_Printf('Unknown command "%s"'#10, [cmd]);
    exit;
  end;

  MSG_WriteByte(cls.netchan.message, Byte(clc_stringcmd));
  SZ_Print(cls.netchan.message, cmd);
  if (Cmd_Argc > 1) then
  begin
    SZ_Print(cls.netchan.message, ' ');
    SZ_Print(cls.netchan.message, Cmd_Args);
  end;
end;

procedure CL_Setenv_f; cdecl;
var
  argc: Integer;
  name, value: string;
  i: Integer;
begin
  argc := Cmd_Argc();

  if (argc > 2) then
  begin

    name := Cmd_Argv(1);
    for i := 2 to argc - 1 do
    begin
      value := value + Cmd_Argv(i) + ' ';
    end;
    {$IFDEF LINUX}
    putenv( PChar(name) ); // on linux
    {$ELSE}
    Windows.SetEnvironmentVariable(PChar(name), PChar(value));
    {$ENDIF}
  end
  else if (argc = 2) then
  begin
    Value := SysUtils.GetEnvironmentVariable(Cmd_Argv(1));
    if (Value <> '') then
      Com_Printf('%s=%s'#10, [Cmd_Argv(1), Value])
    else
      Com_Printf('%s undefined'#10, [Cmd_Argv(1), Value]);
  end;
end;

{*
==================
CL_ForwardToServer_f
==================
*}
procedure CL_ForwardToServer_f; cdecl;
begin
  if (cls.state <> ca_connected) and (cls.state <> ca_active) then
  begin
    Com_Printf('Can''t "%s", not connected'#10, [Cmd_Argv(0)]);
    exit;
  end;

  // don't forward the first argument
  if (Cmd_Argc() > 1) then
  begin
    MSG_WriteByte(cls.netchan.message, Byte(clc_stringcmd));
    SZ_Print(cls.netchan.message, Cmd_Args());
  end;
end;

{*
==================
CL_Pause_f
==================
*}
procedure CL_Pause_f; cdecl;
begin
  // never pause in multiplayer
  if (Cvar_VariableValue('maxclients') > 1) or
    (not Boolean(Com_ServerState)) then
  begin
    Cvar_SetValue('paused', 0);
    exit;
  end;
  Cvar_SetValue('paused', Integer(not Boolean(Round(cl_paused.value))));
end;

{*
==================
CL_Quit_f
==================
*}
procedure CL_Quit_f; cdecl;
begin
  CL_Disconnect;
  Com_Quit;
end;

{*
================
CL_Drop

Called after an ERR_DROP was thrown
================
*}
procedure CL_Drop;
begin
  if (cls.state = ca_uninitialized) then
    exit;
  if (cls.state = ca_disconnected) then
    exit;

  CL_Disconnect;

  // drop loading plaque unless this is the initial game start
  if (cls.disable_servercount <> -1) then
    SCR_EndLoadingPlaque;               // get rid of loading plaque
end;

{*
=======================
CL_SendConnectPacket

We have gotten a challenge from the server, so try and
connect.
======================
*}
procedure CL_SendConnectPacket;
var
  adr: netadr_t;
  port: Integer;
begin
  {$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.connect_time := 0;
    exit;
  end;
  if (adr.port = 0) then