common.pas

delphi编的不错的贪吃蛇

*}
procedure Z_Free(ptr: Pointer);
var
  z: zhead_p;
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
  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 := 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;

  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, []);

  {
   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;
  }
  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
    // Juha: In original Quake2 source, there isn't any specific exception
    // handling, but in our version we print the exception to console.
    on E: Exception do
    begin
      if E is ELongJump then
        Exit
      else
        Com_Printf(PChar(#10 + 'EXCEPTION: ' + E.Message + #10));
    end;
  end;
end;

{*
=================
Qcommon_Shutdown
=================
*}
procedure Qcommon_Shutdown;
begin
end;

end.