common.pas

雷神之锤2(Quake2)Delphi源码

begin
  // z = ((zhead_t *)ptr) - 1;
  z := zhead_p(ptr);
  Dec(z);

  if (z.magic <> Z_MAGIC) then
    Com_Error(ERR_FATAL, 'Z_Free: bad magic', []);

  z.prev.next := z.next;
  z.next.prev := z.prev;

  Dec(z_count);
  z_bytes := z_bytes - z.size;
  FreeMem(z);
end;


(*
========================
Z_Stats_f
========================
*)
procedure Z_Stats_f; cdecl;
begin
  Com_Printf('%d bytes in %d blocks'#10, [z_bytes, z_count]);
end;

(*
========================
Z_FreeTags
========================
*)
procedure Z_FreeTags(tag: Integer);
var
  z, next: zhead_p;
begin
  // for (z=z_chain.next ; z != &z_chain ; z=next)
  z := z_chain.next;
  while (z <> @z_chain) do 
  begin
    next := z.next;
    if (z.tag = tag) then
      Z_Free(Pointer(Integer(z)+1*SizeOf(zhead_t))); // Z_Free ((void *)(z+1));
    z := next // for (;; z=next)
  end;
end;

(*
========================
Z_TagMalloc
========================
*)
function Z_TagMalloc(size: Integer; tag: Integer): Pointer;
var
  z: zhead_p;
begin
  size := size + sizeof(zhead_t);
  try
    GetMem(z, size);
  except
    Com_Error(ERR_FATAL, 'Z_Malloc: failed on allocation of %d bytes', [size]);
    raise; // to fool Compiler warnings
  end;
  FillChar(z^, size, 0);
  Inc(z_count);
  z_bytes := z_bytes + size;
  z.magic := Z_MAGIC;
  z.tag := tag;
  z.size := size;

  z.next := z_chain.next;
  z.prev := @z_chain;
  z_chain.next.prev := z;
  z_chain.next := z;

  // return (void *)(z+1);
  Result:= z;
  Inc(zhead_p(Result));
end;

(*
========================
Z_Malloc
========================
*)
function Z_Malloc(size: Integer): Pointer;
begin
  Result:= Z_TagMalloc(size, 0);
end;


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


(*
====================
COM_BlockSequenceCheckByte

For proxy protecting

// THIS IS MASSIVELY BROKEN!  CHALLENGE MAY BE NEGATIVE
// DON'T USE THIS FUNCTION!!!!!

====================
*)
function COM_BlockSequenceCheckByte(base: PByte; length, sequence, challenge: Integer): Byte;
begin
  Sys_Error('COM_BlockSequenceCheckByte called'#10, []);

{$UNDEF False}
{$IFDEF False}
//#if 0
	int		checksum;
	byte	buf[68];
	byte	*p;
	float temp;
	byte c;

	temp = bytedirs[(sequence/3) % NUMVERTEXNORMALS][sequence % 3];
	temp = LittleFloat(temp);
	p = ((byte *)&temp);

	if (length > 60)
		length = 60;
	memcpy (buf, base, length);

	buf[length] = (sequence & 0xff) ^ p[0];
	buf[length+1] = p[1];
	buf[length+2] = ((sequence>>8) & 0xff) ^ p[2];
	buf[length+3] = p[3];

	temp = bytedirs[((sequence+challenge)/3) % NUMVERTEXNORMALS][(sequence+challenge) % 3];
	temp = LittleFloat(temp);
	p = ((byte *)&temp);

	buf[length+4] = (sequence & 0xff) ^ p[3];
	buf[length+5] = (challenge & 0xff) ^ p[2];
	buf[length+6] = ((sequence>>8) & 0xff) ^ p[1];
	buf[length+7] = ((challenge >> 7) & 0xff) ^ p[0];

	length += 8;

	checksum = LittleLong(Com_BlockChecksum (buf, length));

	checksum &= 0xff;

	return checksum;
//#endif
{$ENDIF}
  Result:= 0;
end;

const
  //Clootie: It was declated as "static byte chktbl[1024]",
  //         but actual size is 930 = 15*64, instead of 16*64 
  chktbl: array[0..15*64-1] of Byte = (
    $84, $47, $51, $c1, $93, $22, $21, $24, $2f, $66, $60, $4d, $b0, $7c, $da,
    $88, $54, $15, $2b, $c6, $6c, $89, $c5, $9d, $48, $ee, $e6, $8a, $b5, $f4,
    $cb, $fb, $f1, $0c, $2e, $a0, $d7, $c9, $1f, $d6, $06, $9a, $09, $41, $54,
    $67, $46, $c7, $74, $e3, $c8, $b6, $5d, $a6, $36, $c4, $ab, $2c, $7e, $85,
    $a8, $a4, $a6, $4d, $96, $19, $19, $9a, $cc, $d8, $ac, $39, $5e, $3c, $f2,
    $f5, $5a, $72, $e5, $a9, $d1, $b3, $23, $82, $6f, $29, $cb, $d1, $cc, $71,
    $fb, $ea, $92, $eb, $1c, $ca, $4c, $70, $fe, $4d, $c9, $67, $43, $47, $94,
    $b9, $47, $bc, $3f, $01, $ab, $7b, $a6, $e2, $76, $ef, $5a, $7a, $29, $0b,
    $51, $54, $67, $d8, $1c, $14, $3e, $29, $ec, $e9, $2d, $48, $67, $ff, $ed,
    $54, $4f, $48, $c0, $aa, $61, $f7, $78, $12, $03, $7a, $9e, $8b, $cf, $83,
    $7b, $ae, $ca, $7b, $d9, $e9, $53, $2a, $eb, $d2, $d8, $cd, $a3, $10, $25,
    $78, $5a, $b5, $23, $06, $93, $b7, $84, $d2, $bd, $96, $75, $a5, $5e, $cf,
    $4e, $e9, $50, $a1, $e6, $9d, $b1, $e3, $85, $66, $28, $4e, $43, $dc, $6e,
    $bb, $33, $9e, $f3, $0d, $00, $c1, $cf, $67, $34, $06, $7c, $71, $e3, $63,
    $b7, $b7, $df, $92, $c4, $c2, $25, $5c, $ff, $c3, $6e, $fc, $aa, $1e, $2a,
    $48, $11, $1c, $36, $68, $78, $86, $79, $30, $c3, $d6, $de, $bc, $3a, $2a,
    $6d, $1e, $46, $dd, $e0, $80, $1e, $44, $3b, $6f, $af, $31, $da, $a2, $bd,
    $77, $06, $56, $c0, $b7, $92, $4b, $37, $c0, $fc, $c2, $d5, $fb, $a8, $da,
    $f5, $57, $a8, $18, $c0, $df, $e7, $aa, $2a, $e0, $7c, $6f, $77, $b1, $26,
    $ba, $f9, $2e, $1d, $16, $cb, $b8, $a2, $44, $d5, $2f, $1a, $79, $74, $87,
    $4b, $00, $c9, $4a, $3a, $65, $8f, $e6, $5d, $e5, $0a, $77, $d8, $1a, $14,
    $41, $75, $b1, $e2, $50, $2c, $93, $38, $2b, $6d, $f3, $f6, $db, $1f, $cd,
    $ff, $14, $70, $e7, $16, $e8, $3d, $f0, $e3, $bc, $5e, $b6, $3f, $cc, $81,
    $24, $67, $f3, $97, $3b, $fe, $3a, $96, $85, $df, $e4, $6e, $3c, $85, $05,
    $0e, $a3, $2b, $07, $c8, $bf, $e5, $13, $82, $62, $08, $61, $69, $4b, $47,
    $62, $73, $44, $64, $8e, $e2, $91, $a6, $9a, $b7, $e9, $04, $b6, $54, $0c,
    $c5, $a9, $47, $a6, $c9, $08, $fe, $4e, $a6, $cc, $8a, $5b, $90, $6f, $2b,
    $3f, $b6, $0a, $96, $c0, $78, $58, $3c, $76, $6d, $94, $1a, $e4, $4e, $b8,
    $38, $bb, $f5, $eb, $29, $d8, $b0, $f3, $15, $1e, $99, $96, $3c, $5d, $63,
    $d5, $b1, $ad, $52, $b8, $55, $70, $75, $3e, $1a, $d5, $da, $f6, $7a, $48,
    $7d, $44, $41, $f9, $11, $ce, $d7, $ca, $a5, $3d, $7a, $79, $7e, $7d, $25,
    $1b, $77, $bc, $f7, $c7, $0f, $84, $95, $10, $92, $67, $15, $11, $5a, $5e,
    $41, $66, $0f, $38, $03, $b2, $f1, $5d, $f8, $ab, $c0, $02, $76, $84, $28,
    $f4, $9d, $56, $46, $60, $20, $db, $68, $a7, $bb, $ee, $ac, $15, $01, $2f,
    $20, $09, $db, $c0, $16, $a1, $89, $f9, $94, $59, $00, $c1, $76, $bf, $c1,
    $4d, $5d, $2d, $a9, $85, $2c, $d6, $d3, $14, $cc, $02, $c3, $c2, $fa, $6b,
    $b7, $a6, $ef, $dd, $12, $26, $a4, $63, $e3, $62, $bd, $56, $8a, $52, $2b,
    $b9, $df, $09, $bc, $0e, $97, $a9, $b0, $82, $46, $08, $d5, $1a, $8e, $1b,
    $a7, $90, $98, $b9, $bb, $3c, $17, $9a, $f2, $82, $ba, $64, $0a, $7f, $ca,
    $5a, $8c, $7c, $d3, $79, $09, $5b, $26, $bb, $bd, $25, $df, $3d, $6f, $9a,
    $8f, $ee, $21, $66, $b0, $8d, $84, $4c, $91, $45, $d4, $77, $4f, $b3, $8c,
    $bc, $a8, $99, $aa, $19, $53, $7c, $02, $87, $bb, $0b, $7c, $1a, $2d, $df,
    $48, $44, $06, $d6, $7d, $0c, $2d, $35, $76, $ae, $c4, $5f, $71, $85, $97,
    $c4, $3d, $ef, $52, $be, $00, $e4, $cd, $49, $d1, $d1, $1c, $3c, $d0, $1c,
    $42, $af, $d4, $bd, $58, $34, $07, $32, $ee, $b9, $b5, $ea, $ff, $d7, $8c,
    $0d, $2e, $2f, $af, $87, $bb, $e6, $52, $71, $22, $f5, $25, $17, $a1, $82,
    $04, $c2, $4a, $bd, $57, $c6, $ab, $c8, $35, $0c, $3c, $d9, $c2, $43, $db,
    $27, $92, $cf, $b8, $25, $60, $fa, $21, $3b, $04, $52, $c8, $96, $ba, $74,
    $e3, $67, $3e, $8e, $8d, $61, $90, $92, $59, $b6, $1a, $1c, $5e, $21, $c1,
    $65, $e5, $a6, $34, $05, $6f, $c5, $60, $b1, $83, $c1, $d5, $d5, $ed, $d9,
    $c7, $11, $7b, $49, $7a, $f9, $f9, $84, $47, $9b, $e2, $a5, $82, $e0, $c2,
    $88, $d0, $b2, $58, $88, $7f, $45, $09, $67, $74, $61, $bf, $e6, $40, $e2,
    $9d, $c2, $47, $05, $89, $ed, $cb, $bb, $b7, $27, $e7, $dc, $7a, $fd, $bf,
    $a8, $d0, $aa, $10, $39, $3c, $20, $f0, $d3, $6e, $b1, $72, $f8, $e6, $0f,
    $ef, $37, $e5, $09, $33, $5a, $83, $43, $80, $4f, $65, $2f, $7c, $8c, $6a,
    $a0, $82, $0c, $d4, $d4, $fa, $81, $60, $3d, $df, $06, $f1, $5f, $08, $0d,
    $6d, $43, $f2, $e3, $11, $7d, $80, $32, $c5, $fb, $c5, $d9, $27, $ec, $c6,
    $4e, $65, $27, $76, $87, $a6, $ee, $ee, $d7, $8b, $d1, $a0, $5c, $b0, $42,
    $13, $0e, $95, $4a, $f2, $06, $c6, $43, $33, $f4, $c7, $f8, $e7, $1f, $dd,
    $e4, $46, $4a, $70, $39, $6c, $d0, $ed, $ca, $be, $60, $3b, $d1, $7b, $57,
    $48, $e5, $3a, $79, $c1, $69, $33, $53, $1b, $80, $b8, $91, $7d, $b4, $f6,
    $17, $1a, $1d, $5a, $32, $d6, $cc, $71, $29, $3f, $28, $bb, $f3, $5e, $71,
    $b8, $43, $af, $f8, $b9, $64, $ef, $c4, $a5, $6c, $08, $53, $c7, $00, $10,
    $39, $4f, $dd, $e4, $b6, $19, $27, $fb, $b8, $f5, $32, $73, $e5, $cb, $32
  );

(*
====================
COM_BlockSequenceCRCByte

For proxy protecting
====================
*)
function COM_BlockSequenceCRCByte(base: PByte; length, sequence: Integer): Byte;
var
  n: Integer;
  p: PByteArray;
  x: Integer;
  chkb: array[0..60 + 4 - 1] of Byte;
  crc: Word;
begin
  if (sequence < 0) then
    Sys_Error('sequence < 0, this shouldn''t happen'#10, []);

  // p = chktbl + (sequence % (sizeof(chktbl) - 4));
  p := Pointer(Integer(@chktbl) + sequence mod (SizeOf(chktbl) - 4));

  if (length > 60) then
    length := 60;

  memcpy(@chkb, base, length);

  chkb[length] := p[0];
  chkb[length+1] := p[1];
  chkb[length+2] := p[2];
  chkb[length+3] := p[3];

  Inc(length, 4);

  crc := CRC_Block(@chkb, length);

  // for (x=0, n=0; n<length; n++)
  x := 0; n := 0;
  while (n < length) do
  begin
    x := x + chkb[n];
    Inc(n);
  end;

  crc := (crc xor x) and $ff;

  Result:= crc;
end;

//========================================================
const
  RAND_MAX  = $7FFF; // unsigned

function rand: Integer;
begin
  Result := Random(RAND_MAX);
end;

function frand: Single;	// 0 ti 1
begin
  // return (rand()&32767)* (1.0/32767);
  Result:= (Random(RAND_MAX) and 32767)* (1.0/32767);
end;

function crand: Single;	// -1 to 1
begin
  // return (rand()&32767)* (2.0/32767) - 1;
  Result:= (Random(RAND_MAX) and 32767)* (2.0/32767) - 1;
end;

function fmod(x, y: Single): Single;
begin
  Result := x - (Trunc(x) div Trunc(y)) * y;
end;

(*
=============
Com_Error_f

Just throw a fatal error to
test error shutdown procedures
=============
*)
procedure Com_Error_f; cdecl;
begin
  Com_Error(ERR_FATAL, '%s', [Cmd_Argv(1)]);
end;


(*
=================
Qcommon_Init
=================
*)
procedure Qcommon_Init(argc: Integer; argv: PComArgvArray);
var
  s: PChar;
begin
  //Clootie: this is replcaed by exceptions...
  //if (setjmp (abortframe) )
  //  Sys_Error('Error during initialization');

  try
    z_chain.prev := @z_chain;
    z_chain.next := z_chain.prev;

    // prepare enough of the subsystems to handle
    // cvar and command buffer management
    COM_InitArgv(argc, argv);

    Swap_Init;
    Cbuf_Init;

    Cmd_Init;
    Cvar_Init;

    Key_Init;

    // we need to add the early commands twice, because
    // a basedir or cddir needs to be set before execing
    // config files, but we want other parms to override
    // the settings of the config files
    Cbuf_AddEarlyCommands(False);
    Cbuf_Execute;

    FS_InitFilesystem;

    Cbuf_AddText('exec default.cfg'#10);
    Cbuf_AddText('exec config.cfg'#10);

    Cbuf_AddEarlyCommands(True);
    Cbuf_Execute;

    //
    // init commands and vars
    //
    Cmd_AddCommand('z_stats', Z_Stats_f);
    Cmd_AddCommand('error', Com_Error_f);

    host_speeds := Cvar_Get('host_speeds', '0', 0);
    log_stats := Cvar_Get('log_stats', '0', 0);
    developer := Cvar_Get('developer', '0', 0);
    timescale := Cvar_Get('timescale', '1', 0);
    fixedtime := Cvar_Get('fixedtime', '0', 0);
    logfile_active := Cvar_Get('logfile', '0', 0);
    showtrace := Cvar_Get('showtrace', '0', 0);
{$IFDEF DEDICATED_ONLY}
    dedicated := Cvar_Get('dedicated', '1', CVAR_NOSET);
{$ELSE}
    dedicated := Cvar_Get('dedicated', '0', CVAR_NOSET);
{$ENDIF}

    s := va('%4.2f %s %s %s', [VERSION, CPUSTRING, __DATE__, BUILDSTRING]);
    Cvar_Get('version', s, CVAR_SERVERINFO or CVAR_NOSET);


    if (dedicated.value <> 0) then
      Cmd_AddCommand('quit', Com_Quit);

    Sys_Init;

    NET_Init;
    Netchan_Init;

    SV_Init;
    CL_Init;

    // add + commands from command line
    if not Cbuf_AddLateCommands then
    begin // if the user didn't give any commands, run default action
      if (dedicated.value = 0) then
        Cbuf_AddText('d1'#10)
      else
        Cbuf_AddText('dedicated_start'#10);
      Cbuf_Execute;
    end
    else
    begin // the user asked for something explicit
      // so drop the loading plaque
      SCR_EndLoadingPlaque;
    end;

    Com_Printf('====== Quake2 Initialized ======'#10#10, []);
  except
    on E:Exception do
      Sys_Error('Error during initialization (exception=%s)', [E.Message]);
  end;
end;

(*
=================
Qcommon_Frame
=================
*)
procedure Qcommon_Frame(msec: Integer);
const
  LOGLINE = 'entities,dlights,parts,frame time'#10;
var
  s: PChar;
  time_before, time_between, time_after: Integer;

  all, sv, gm, cl, rf: Integer;
begin
  //if (setjmp (abortframe) )
  //	return;			// an ERR_DROP was thrown
  try
    if log_stats.modified then
    begin
      log_stats.modified := False;
      if (log_stats.value <> 0) then
      begin
        if (log_stats_file <> 0) then
        begin
          FileClose(log_stats_file);
          log_stats_file := 0;
        end;

        DeleteFile('stats.log');
        log_stats_file := FileCreate('stats.log');
        // log_stats_file = fopen( "stats.log", "w" );

        //Clootie: need to clean up on error
        if log_stats_file = -1 then
        begin
          logfile := 0;
        end;

        if (log_stats_file <> 0) then
        begin
          // fprintf( log_stats_file, 'entities,dlights,parts,frame time'#10 );
          FileWrite(log_stats_file, LOGLINE, length(LOGLINE));
        end;
      end else
      begin
        if (log_stats_file <> 0) then
        begin
          FileClose(log_stats_file);
          log_stats_file := 0;
        end;
      end;
    end;

    if (fixedtime.value <> 0) then
      msec := Trunc(fixedtime.value)
    else if (timescale.value <> 0) then
    begin
      msec := Trunc(msec * timescale.value);
      if (msec < 1) then
        msec := 1;
    end;

    if (showtrace.value <> 0) then
    begin
{
      extern	int c_traces, c_brush_traces;
      extern	int	c_pointcontents;
}

      Com_Printf('%4d traces  %4d points'#10, [c_traces, c_pointcontents]);
      c_traces := 0;
      c_brush_traces := 0;
      c_pointcontents := 0;
    end;

    repeat
      s := Sys_ConsoleInput;
      if (s <> nil) then
        Cbuf_AddText(va('%s'#10, [s]));
    until (s = nil);
    Cbuf_Execute;

    time_before := 0;
    time_between := 0;
    time_after := 0;

    if (host_speeds.value <> 0) then
      time_before := Sys_Milliseconds;

    SV_Frame(msec);

    if (host_speeds.value <> 0) then
      time_between := Sys_Milliseconds;

    CL_Frame(msec);

    if (host_speeds.value <> 0) then
      time_after := Sys_Milliseconds;


    if (host_speeds.value <> 0) then
    begin
      all := time_after - time_before;
      sv := time_between - time_before;
      cl := time_after - time_between;
      gm := time_after_game - time_before_game;
      rf := time_after_ref - time_before_ref;
      sv := sv - gm;
      cl := cl - rf;
      Com_Printf('all:%3d sv:%3d gm:%3d cl:%3d rf:%3d'#10,
        [all, sv, gm, cl, rf]);
    end;
  except
    on E: Exception do Com_Printf(PChar(#10 + 'EXCEPTION: ' + E.Message + #10));
  end;
end;

(*
=================
Qcommon_Shutdown
=================
*)
procedure Qcommon_Shutdown;
begin
end;

end.