q_shared.pas

delphi编的不错的贪吃蛇

  // frame rates
  // this structure needs to be communicated bit-accurate
  // from the server to the client to guarantee that
  // prediction stays in sync, so no floats are used.
  // if any part of the game code modifies this struct, it
  // will result in a prediction error of some degree.

const
  MAXTOUCH = q_shared_add.MAXTOUCH;

type

  // a trace is returned when a box is swept through the world
  trace_p = q_shared_add.trace_p;
  trace_t = q_shared_add.trace_t;

  pmove_p = q_shared_add.pmove_p;
  pmove_t = q_shared_add.pmove_t;

  (*
  ROGUE - VERSIONS
  1234	08/13/1998		Activision
  1235	08/14/1998		Id Software
  1236	08/15/1998		Steve Tietze
  1237	08/15/1998		Phil Dobranski
  1238	08/15/1998		John Sheley
  1239	08/17/1998		Barrett Alexander
  1230	08/17/1998		Brandon Fish
  1245	08/17/1998		Don MacAskill
  1246	08/17/1998		David "Zoid" Kirsch
  1247	08/17/1998		Manu Smith
  1248	08/17/1998		Geoff Scully
  1249	08/17/1998		Andy Van Fossen
  1240	08/20/1998		Activision Build 2
  1256	08/20/1998		Ranger Clan
  1257	08/20/1998		Ensemble Studios
  1258	08/21/1998		Robert Duffy
  1259	08/21/1998		Stephen Seachord
  1250	08/21/1998		Stephen Heaslip
  1267	08/21/1998		Samir Sandesara
  1268	08/21/1998		Oliver Wyman
  1269	08/21/1998		Steven Marchegiano
  1260	08/21/1998		Build #2 for Nihilistic
  1278	08/21/1998		Build #2 for Ensemble

  9999	08/20/1998		Internal Use
  *)
const
  ROGUE_VERSION_ID = 1278;
  ROGUE_VERSION_STRING = '08/21/1998 Beta 2 for Ensemble';

  // ROGUE
  (*
  ==========================================================

    ELEMENTS COMMUNICATED ACROSS THE NET

  ==========================================================
  *)

function ANGLE2SHORT(x: Single): Word;
function SHORT2ANGLE(x: Word): Single;

//
// config strings are a general means of communication from
// the server to all connected clients.
// Each config string can be at most MAX_QPATH characters.
//
const
  CS_NAME = 0;
  CS_CDTRACK = 1;
  CS_SKY = 2;
  CS_SKYAXIS = 3;                       // %f %f %f format
  CS_SKYROTATE = 4;
  CS_STATUSBAR = 5;                     // display program string

  CS_AIRACCEL = 29;                     // air acceleration control
  CS_MAXCLIENTS = 30;
  CS_MAPCHECKSUM = 31;                  // for catching cheater maps

  CS_MODELS = 32;
  CS_SOUNDS = (CS_MODELS + MAX_MODELS);
  CS_IMAGES = (CS_SOUNDS + MAX_SOUNDS);
  CS_LIGHTS = (CS_IMAGES + MAX_IMAGES);
  CS_ITEMS = (CS_LIGHTS + MAX_LIGHTSTYLES);
  CS_PLAYERSKINS = (CS_ITEMS + MAX_ITEMS);
  CS_GENERAL = (CS_PLAYERSKINS + MAX_CLIENTS);
  MAX_CONFIGSTRINGS = (CS_GENERAL + MAX_GENERAL);

  // ==================
  // PGM
const
  VIDREF_GL = 1;
  VIDREF_SOFT = 2;
  VIDREF_OTHER = 3;

{$IFNDEF RENDERERDLL}
var
  vidref_val: Integer;                  // CAK - external for cl_ents.c
{$ENDIF}
  // PGM
  // ==================

procedure DelphiStrFmt(buf: PChar; fmt: PChar; args: array of const);

implementation

uses
  CPas,
{$IFDEF GAMEDLL}
  g_main,                               // <- we are compiling gamex86.dll
{$ELSE}
{$IFDEF RENDERERDLL}
  {$IFDEF REF_GL}
  gl_rmain,
  {$ENDIF}
  {$IFDEF REF_SOFT}
  r_main,
  {$ENDIF}
{$ELSE}
  Common,
{$ENDIF}
{$ENDIF}
  SysUtils;

{
  DelphiStrFmt
  - Delphi's StrFmt routine don't understand %i parameter, so we need to
    convert them to %d (which is same).
}

procedure DelphiStrFmt(buf: PChar; fmt: PChar; args: array of const);
var
  p, p2: PChar;
begin
  buf^ := #0;
  try
    { Replace (delphi)unsafe %i with %d }
    p := AllocMem(StrLen(fmt) + 1);
    StrCopy(p, fmt);
    p2 := p;
    while p2^ <> #0 do
    begin
      if (p2^ = '%') then
      begin
        Inc(p2);
        { Skip length part in format (example: %7.2f) }
        while (p2^ in ['0'..'9', '.']) do
          Inc(p2);
        { i->d: i and d are 100% equivalent}
        if p2^ = 'i' then
          p2^ := 'd';
        { c->s: c means one character, we will convert it to s(tring) }
        if p2^ = 'c' then
          p2^ := 's';
      end;
      Inc(p2);
    end;
    StrFmt(buf, p, args);
    FreeMem(p);
  except
    // Juha: This is just to find out all of the bugs in our routine.
    on E: Exception do
      Com_Printf(PChar('Exception in q_shared.DelphiStrFmt!'), []);
  end;
end;

function IS_NAN(x: single): qboolean;
begin
  Result := (PLongInt(@x)^ and nanmask) = nanmask;
end;

function ANGLE2SHORT(x: Single): Word;
begin
  Result := Round(x * 65536 / 360) and 65535;
end;

function SHORT2ANGLE(x: Word): Single;
begin
  Result := x * 360 / 65536;
end;

function DEG2RAD(a: extended): extended;
begin
  Result := a * M_PI / 180;
end;

procedure VectorClear(var a: vec3_t);
begin
  a[0] := 0;
  a[1] := 0;
  a[2] := 0;
end;

procedure VectorNegate(const a: vec3_t; var b: vec3_t);
begin
  b[0] := -a[0];
  b[1] := -a[1];
  b[2] := -a[2];
end;

procedure VectorSet(var v: vec3_t; x, y, z: vec_t);
begin
  v[0] := x;
  v[1] := y;
  v[2] := z;
end;

// CAK - math functions, missing in Delphi 3

function ceil(const x: Single): Integer;
begin
  Result := Integer(Trunc(x));
  if Frac(x) > 0 then
    Inc(Result);
end;

function floor(const x: Single): Integer;
begin
  Result := Integer(Trunc(x));
  if Frac(x) < 0 then
    Dec(Result);
end;

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

procedure RotatePointAroundVector(var dst: vec3_t; const dir, point: vec3_t; degrees: single);
var
  m, im, zrot, tmpmat, rot: matrix33;
  i: Integer;
  vr, vup, vf: vec3_t;
begin
  vf[0] := dir[0];
  vf[1] := dir[1];
  vf[2] := dir[2];

  PerpendicularVector(vr, dir);
  CrossProduct(vr, vf, vup);

  m[0][0] := vr[0];
  m[1][0] := vr[1];
  m[2][0] := vr[2];

  m[0][1] := vup[0];
  m[1][1] := vup[1];
  m[2][1] := vup[2];

  m[0][2] := vf[0];
  m[1][2] := vf[1];
  m[2][2] := vf[2];

  Move(m, im, SizeOf(im));

  im[0][1] := m[1][0];
  im[0][2] := m[2][0];
  im[1][0] := m[0][1];
  im[1][2] := m[2][1];
  im[2][0] := m[0][2];
  im[2][1] := m[1][2];

  FillChar(zrot, sizeof(zrot), 0);
  zrot[0][0] := 1;
  zrot[1][1] := 1;
  zrot[2][2] := 1;

  zrot[0][0] := cos(DEG2RAD(degrees));
  zrot[0][1] := sin(DEG2RAD(degrees));
  zrot[1][0] := -sin(DEG2RAD(degrees));
  zrot[1][1] := cos(DEG2RAD(degrees));

  R_ConcatRotations(m, zrot, tmpmat);
  R_ConcatRotations(tmpmat, im, rot);

  for i := 0 to 2 do
  begin
    dst[i] := rot[i][0] * point[0] + rot[i][1] * point[1] + rot[i][2] * point[2];
  end;
end;

procedure AngleVectors(const angles: vec3_t; forwards, right, up: vec3_p);
var
  sr, sp, sy, cr, cp, cy: single;       // static to help MS compiler fp bugs
  angle: single;
begin
  angle := angles[YAW] * (M_PI * 2 / 360);
  sy := sin(angle);
  cy := cos(angle);
  angle := angles[PITCH] * (M_PI * 2 / 360);
  sp := sin(angle);
  cp := cos(angle);
  angle := angles[ROLL] * (M_PI * 2 / 360);
  sr := sin(angle);
  cr := cos(angle);

  if (forwards <> nil) then
  begin
    forwards[0] := cp * cy;
    forwards[1] := cp * sy;
    forwards[2] := -sp;
  end;
  if (right <> nil) then
  begin
    right[0] := (-1 * sr * sp * cy + -1 * cr * -sy);
    right[1] := (-1 * sr * sp * sy + -1 * cr * cy);
    right[2] := -1 * sr * cp;
  end;
  if (up <> nil) then
  begin
    up[0] := (cr * sp * cy + -sr * -sy);
    up[1] := (cr * sp * sy + -sr * cy);
    up[2] := cr * cp;
  end;
end;

procedure ProjectPointOnPlane(var dst: vec3_t; const p, normal: vec3_t);
var
  d: single;
  n: vec3_t;
  inv_denom: single;
begin
  inv_denom := 1 / DotProduct(normal, normal);
  d := DotProduct(normal, p) * inv_denom;

  n[0] := normal[0] * inv_denom;
  n[1] := normal[1] * inv_denom;
  n[2] := normal[2] * inv_denom;

  dst[0] := p[0] - d * n[0];
  dst[1] := p[1] - d * n[1];
  dst[2] := p[2] - d * n[2];
end;

(*
** assumes "src" is normalized
*)

procedure PerpendicularVector(var dst: vec3_t; const src: vec3_t);
var
  pos, i: Integer;
  minelem: single;
  tempvec: vec3_t;
begin
  minelem := 1;

  (*
  ** find the smallest magnitude axially aligned vector
  *)
  pos := 0;
  for i := 0 to 2 do
  begin
    if abs(src[i]) < minelem then
    begin
      pos := i;
      minelem := abs(src[i]);
    end;
  end;
  tempvec[0] := 0;
  tempvec[1] := 0;
  tempvec[2] := 0;
  tempvec[pos] := 1;

  (*
  ** project the point onto the plane defined by src
  *)
  ProjectPointOnPlane(dst, tempvec, src);

  (*
  ** normalize the result
  *)
  VectorNormalize(dst);
end;

(*
================
R_ConcatRotations
================
*)

procedure R_ConcatRotations(const in1, in2: matrix33; var out_: matrix33);
begin
  out_[0][0] := in1[0][0] * in2[0][0] + in1[0][1] * in2[1][0] +
    in1[0][2] * in2[2][0];
  out_[0][1] := in1[0][0] * in2[0][1] + in1[0][1] * in2[1][1] +
    in1[0][2] * in2[2][1];
  out_[0][2] := in1[0][0] * in2[0][2] + in1[0][1] * in2[1][2] +
    in1[0][2] * in2[2][2];
  out_[1][0] := in1[1][0] * in2[0][0] + in1[1][1] * in2[1][0] +
    in1[1][2] * in2[2][0];
  out_[1][1] := in1[1][0] * in2[0][1] + in1[1][1] * in2[1][1] +
    in1[1][2] * in2[2][1];
  out_[1][2] := in1[1][0] * in2[0][2] + in1[1][1] * in2[1][2] +
    in1[1][2] * in2[2][2];
  out_[2][0] := in1[2][0] * in2[0][0] + in1[2][1] * in2[1][0] +
    in1[2][2] * in2[2][0];
  out_[2][1] := in1[2][0] * in2[0][1] + in1[2][1] * in2[1][1] +
    in1[2][2] * in2[2][1];
  out_[2][2] := in1[2][0] * in2[0][2] + in1[2][1] * in2[1][2] +
    in1[2][2] * in2[2][2];
end;

(*
================
R_ConcatTransforms
================
*)

procedure R_ConcatTransforms(const in1, in2: matrix34; var out_: matrix34);
begin
  out_[0][0] := in1[0][0] * in2[0][0] + in1[0][1] * in2[1][0] +
    in1[0][2] * in2[2][0];
  out_[0][1] := in1[0][0] * in2[0][1] + in1[0][1] * in2[1][1] +
    in1[0][2] * in2[2][1];
  out_[0][2] := in1[0][0] * in2[0][2] + in1[0][1] * in2[1][2] +
    in1[0][2] * in2[2][2];
  out_[0][3] := in1[0][0] * in2[0][3] + in1[0][1] * in2[1][3] +
    in1[0][2] * in2[2][3] + in1[0][3];
  out_[1][0] := in1[1][0] * in2[0][0] + in1[1][1] * in2[1][0] +
    in1[1][2] * in2[2][0];
  out_[1][1] := in1[1][0] * in2[0][1] + in1[1][1] * in2[1][1] +
    in1[1][2] * in2[2][1];
  out_[1][2] := in1[1][0] * in2[0][2] + in1[1][1] * in2[1][2] +
    in1[1][2] * in2[2][2];
  out_[1][3] := in1[1][0] * in2[0][3] + in1[1][1] * in2[1][3] +
    in1[1][2] * in2[2][3] + in1[1][3];
  out_[2][0] := in1[2][0] * in2[0][0] + in1[2][1] * in2[1][0] +
    in1[2][2] * in2[2][0];
  out_[2][1] := in1[2][0] * in2[0][1] + in1[2][1] * in2[1][1] +
    in1[2][2] * in2[2][1];
  out_[2][2] := in1[2][0] * in2[0][2] + in1[2][1] * in2[1][2] +
    in1[2][2] * in2[2][2];
  out_[2][3] := in1[2][0] * in2[0][3] + in1[2][1] * in2[1][3] +
    in1[2][2] * in2[2][3] + in1[2][3];
end;

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

function Q_fabs(f: single): single;
var
  tmp: LongInt;
begin
  tmp := PLongInt(@f)^;
  tmp := tmp and $7FFFFFFF;
  result := PSingle(@tmp)^;
end;

function fabs(f: single): single;
var
  tmp: LongInt;
begin
  tmp := PLongInt(@f)^;
  tmp := tmp and $7FFFFFFF;
  result := PSingle(@tmp)^;
end;

function Q_ftol(f: single): LongInt;
begin
  Result := Trunc(f);
end;

(*
===============
LerpAngle

===============
*)

function LerpAngle(a2, a1, frac: single): single;
begin
  if a1 - a2 > 180 then
    a1 := a1 - 360;
  if a1 - a2 < -180 then
    a1 := a1 + 360;
  result := a2 + frac * (a1 - a2);
end;

function anglemod(a: single): single;
begin
  (*
    if a >= 0 then
      a:=a - 360*trunc(a/360)
    else
      a:=a + 360*( 1 + trunc(-a/360) );
  *)
  a := (360 / 65536) * (trunc(a * (65536 / 360)) and 65535);
  result := a;