q_shared.pas

雷神之锤2(Quake2)Delphi源码

procedure DelphiStrFmt(buf: PChar; fmt: PChar; args: array of const);
begin
 buf^ := #0;
 try
   StrFmt(buf, PChar(StringReplace(fmt, '%i', '%d', [rfReplaceAll])), args);
 except
   On E:Exception do
     Com_Printf(PChar('Exception: "' + E.Message + '" in 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(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
(*
  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;
  dist1, dist2: single;
  sides: integer;
  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
  case p^.signbits of
    0: begin
         dist1 := p^.normal[0]*emaxs[0] + p^.normal[1]*emaxs[1] + p^.normal[2]*emaxs[2];
         dist2 := p^.normal[0]*emins[0] + p^.normal[1]*emins[1] + p^.normal[2]*emins[2];
       end;
    1: begin
         dist1 := p^.normal[0]*emins[0] + p^.normal[1]*emaxs[1] + p^.normal[2]*emaxs[2];
         dist2 := p^.normal[0]*emaxs[0] + p^.normal[1]*emins[1] + p^.normal[2]*emins[2];
       end;
    2: begin
         dist1 := p^.normal[0]*emaxs[0] + p^.normal[1]*emins[1] + p^.normal[2]*emaxs[2];
         dist2 := p^.normal[0]*emins[0] + p^.normal[1]*emaxs[1] + p^.normal[2]*emins[2];
       end;
    3: begin
         dist1 := p^.normal[0]*emins[0] + p^.normal[1]*emins[1] + p^.normal[2]*emaxs[2];
         dist2 := p^.normal[0]*emaxs[0] + p^.normal[1]*emaxs[1] + p^.normal[2]*emins[2];
       end;
    4: begin
         dist1 := p^.normal[0]*emaxs[0] + p^.normal[1]*emaxs[1] + p^.normal[2]*emins[2];
         dist2 := p^.normal[0]*emins[0] + p^.normal[1]*emins[1] + p^.normal[2]*emaxs[2];
       end;
    5: begin
         dist1 := p^.normal[0]*emins[0] + p^.normal[1]*emaxs[1] + p^.normal[2]*emins[2];
         dist2 := p^.normal[0]*emaxs[0] + p^.normal[1]*emins[1] + p^.normal[2]*emaxs[2];
       end;
    6: begin
         dist1 := p^.normal[0]*emaxs[0] + p^.normal[1]*emins[1] + p^.normal[2]*emins[2];
         dist2 := p^.normal[0]*emins[0] + p^.normal[1]*emaxs[1] + p^.normal[2]*emaxs[2];
       end;
    7: begin
         dist1 := p^.normal[0]*emins[0] + p^.normal[1]*emins[1] + p^.normal[2]*emins[2];
         dist2 := p^.normal[0]*emaxs[0] + p^.normal[1]*emaxs[1] + p^.normal[2]*emaxs[2];
       end;
    else begin
      dist1:=0;
      dist2:=0; // shut up compiler
      assert(false,'BoxOnPlaneSide error: invalid sign bits, (Carl Kenner)');
    end;
  end;

  sides := 0;
  if dist1 >= p^.dist then
    sides := 1;
  if dist2 < p^.dist then
    sides := sides or 2;

  assert(sides<>0,'BoxOnPlaneSide error: sides must be zero, (Carl Kenner)');

  result:= sides;
end;

// CAK - There was an assembly language version here too, but I didn't
// CAK - bother converting it. Sorry.

// MACRO - Calls the original function
function BOX_ON_PLANE_SIDE(var emins, emaxs: vec3_t; p: cplane_p): Integer;
begin