q_shared.pas

delphi编的不错的贪吃蛇

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;

var vidref_val: Integer; // CAK - external for cl_ents.c
// PGM
// ==================



// CAK - TAKEN FROM g_local.h











//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
implementation
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Uses SysUtils, Dialogs;

procedure Com_printf(s: String);
begin
  ShowMessage(s);
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(out a: vec3_t);
begin
  a[0]:=0; a[1]:=0; a[2]:=0;
end;

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

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


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

procedure RotatePointAroundVector(var dst: vec3_t; const dir, point: vec3_t; degrees: single);
var m,im,zrot,tmpmat,rot: matrix33;
var i: Integer;
var 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(angles: vec3_t; forwards, right, up: vec3_p);
Var sr,sp,sy,cr,cp,cy: single; // static to help MS compiler fp bugs
var 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;
var minelem: single;
var 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; out _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; out _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
(*
  if f >= 0 then
    result:=f
  else
    result:=-f;
*)
  tmp:=PLongInt(@f)^;
  tmp:=tmp and $7FFFFFFF;
  result:=PSingle(@tmp)^;
end;

function fabs(f: single): single;
Var tmp: LongInt;
begin
(*
  if f >= 0 then
    result:=f
  else
    result:=-f;
*)
  tmp:=PLongInt(@f)^;
  tmp:=tmp and $7FFFFFFF;
  result:=PSingle(@tmp)^;
end;

function Q_ftol(f: single): LongInt;
begin
  //Result:=Round(f); // CAK - I DONT THINK THIS FUNCTION IS SUPPOSED TO ROUND
  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;
end;

// CAK - DANGER WILL ROBINSON!!!!!!!!!
// CAK - These could cause many errors, so I removed them.
// CAK - This was a bug in q_shared.c
//var i: Integer;
//var corners: array[0..1] of vec3_t;


// this is the slow, general version
function BoxOnPlaneSide2(var emins, emaxs: vec3_t; p: cplane_p): Integer;
Var i: Integer;
var dist1, dist2: single;
var sides: integer;
var corners: array[0..1] of vec3_t;
begin
  for i:=0 to 2 do begin
    if p^.normal[i]<0 then begin
      corners[0][i]:=emins[i];
      corners[1][i]:=emaxs[i];
    end else begin
      corners[1][i]:=emins[i];
      corners[0][i]:=emaxs[i];
    end;
  end;
  dist1 := DotProduct (p^.normal, corners[0]) - p^.dist;
  dist2 := DotProduct (p^.normal, corners[1]) - p^.dist;
  sides := 0;
  if dist1 >= 0 then
    sides := 1;
  if dist2 < 0 then
    sides := (sides or 2);

  result := sides;
end;

(*
==================
BoxOnPlaneSide

Returns 1, 2, or 1 + 2
==================
*)
function BoxOnPlaneSide(var emins, emaxs: vec3_t; p: cplane_p): Integer;
Var dist1, dist2: single; sides: Integer;
begin
// fast axial cases
  if p^._type < 3 then begin
    if p^.dist <= emins[p^._type] then begin
      result:= 1;
      exit;
    end;
    if p^.dist >= emaxs[p^._type] then begin
      result:= 2;
      exit;
    end;
    result:= 3;
    exit;
  end;

// general case