cl_main.pas

雷神之锤2(Quake2)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              }
{                                                                            }
{----------------------------------------------------------------------------}
{ * Still dependent (to compile correctly) on:                               }
{                                                                            }
{----------------------------------------------------------------------------}
{ * TODO:                                                                    }
{ - Rest of the c->pascal conversion.                                        }
{ - Move needed (global) procedure declarations 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
  Windows,
  SysUtils,
  Files,
  Cmd,
  Common,
  Console,
  CModel,
  CVar,
  CPas,
  Keys,
  net_chan,
  net_wins,
  server,
  sv_main,
  sys_win,
  cd_win,
  snd_dma,
  q_shwin,
  in_win,
  vid_dll,
  qfiles,
  cl_tent,
  menu,
  cl_parse,
  cl_pred,
  cl_cin,
  cl_view,
  cl_input,
  cl_fx,
  cl_scrn;



(* TODO
extern	cvar_t *allow_download;
extern	cvar_t *allow_download_players;
extern	cvar_t *allow_download_models;
extern	cvar_t *allow_download_sounds;
extern	cvar_t *allow_download_maps;
*)
//======================================================================



(*
====================
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);
  (*  original code
	fwrite (&swlen, 4, 1, cls.demofile);
	fwrite (net_message.data+8,	len, 1, cls.demofile);

    converted to =>
  *)
  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 := fopen (name, "wb");
   =>
  *)
  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;
    Windows.SetEnvironmentVariable(PChar(name), PChar(value));
  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;