q_shared.pas

delphi编的不错的贪吃蛇

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
  Result := BoxOnPlaneSide(emins, emaxs, p);
end;

procedure ClearBounds(var mins, maxs: vec3_t);
begin
  mins[0] := 99999;
  mins[1] := 99999;
  mins[2] := 99999;
  maxs[0] := -99999;
  maxs[1] := -99999;
  maxs[2] := -99999;
end;

procedure AddPointToBounds(const v: vec3_t; var mins, maxs: vec3_t);
var
  i: Integer;
  val: vec_t;
begin
  for i := 0 to 2 do
  begin
    val := v[i];
    if val < mins[i] then
      mins[i] := val;
    if val > maxs[i] then
      maxs[i] := val;
  end;
end;

function VectorCompare(const v1, v2: vec3_t): integer;
begin
  if (v1[0] <> v2[0]) or (v1[1] <> v2[1]) or (v1[2] <> v2[2]) then
    result := 0
  else
    result := 1;
end;

function VectorNormalize(var v: vec3_t): vec_t;
var
  length, ilength: single;
begin
  length := v[0] * v[0] + v[1] * v[1] + v[2] * v[2];
  length := sqrt(length);               // FIXME

  if length <> 0 then
  begin
    ilength := 1 / length;
    v[0] := v[0] * ilength;
    v[1] := v[1] * ilength;
    v[2] := v[2] * ilength;
  end;

  result := length;
end;

function VectorNormalize2(const v: vec3_t; var out_: vec3_t): vec_t;
var
  length, ilength: single;
begin
  length := v[0] * v[0] + v[1] * v[1] + v[2] * v[2];
  length := sqrt(length);               // FIXME

  if length <> 0 then
  begin
    ilength := 1 / length;
    out_[0] := v[0] * ilength;
    out_[1] := v[1] * ilength;
    out_[2] := v[2] * ilength;
  end;

  result := length;
end;

procedure VectorMA(const veca: vec3_t; scale: single; const vecb: vec3_t; var vecc: vec3_t);
begin
  vecc[0] := veca[0] + scale * vecb[0];
  vecc[1] := veca[1] + scale * vecb[1];
  vecc[2] := veca[2] + scale * vecb[2];
end;

function _DotProduct(const v1, v2: vec3_t): vec_t;
begin
  result := v1[0] * v2[0] + v1[1] * v2[1] + v1[2] * v2[2];
end;

function DotProduct(const v1, v2: vec3_t): vec_t;
begin
  result := v1[0] * v2[0] + v1[1] * v2[1] + v1[2] * v2[2];
end;

procedure _VectorSubtract(const veca, vecb: vec3_t; var out_: vec3_t);
begin
  out_[0] := veca[0] - vecb[0];
  out_[1] := veca[1] - vecb[1];
  out_[2] := veca[2] - vecb[2];
end;

procedure VectorSubtract(const veca, vecb: vec3_t; var out_: vec3_t);
begin
  out_[0] := veca[0] - vecb[0];
  out_[1] := veca[1] - vecb[1];
  out_[2] := veca[2] - vecb[2];
end;

procedure VectorSubtract(const veca, vecb: array of smallint; var out_: array of integer);
begin
  out_[0] := veca[0] - vecb[0];
  out_[1] := veca[1] - vecb[1];
  out_[2] := veca[2] - vecb[2];
end;

procedure _VectorAdd(const veca, vecb: vec3_t; var out_: vec3_t);
begin
  out_[0] := veca[0] + vecb[0];
  out_[1] := veca[1] + vecb[1];
  out_[2] := veca[2] + vecb[2];
end;

procedure VectorAdd(const veca, vecb: vec3_t; var out_: vec3_t);
begin
  out_[0] := veca[0] + vecb[0];
  out_[1] := veca[1] + vecb[1];
  out_[2] := veca[2] + vecb[2];
end;

procedure _VectorCopy(const _in: vec3_t; var out_: vec3_t);
begin
  out_[0] := _in[0];
  out_[1] := _in[1];
  out_[2] := _in[2];
end;

procedure VectorCopy(const _in: vec3_t; var out_: vec3_t);
begin
  out_[0] := _in[0];
  out_[1] := _in[1];
  out_[2] := _in[2];
end;

procedure VectorCopy(const _in: vec3_t; var out_: array of smallint);
begin
  out_[0] := Trunc(_in[0]);
  out_[1] := Trunc(_in[1]);
  out_[2] := Trunc(_in[2]);
end;

procedure VectorCopy(const _in: array of smallint; var out_: array of smallint);
begin
  out_[0] := _in[0];
  out_[1] := _in[1];
  out_[2] := _in[2];
end;

procedure VectorCopy(const _in: array of smallint; var out_: vec3_t);
begin
  out_[0] := _in[0];
  out_[1] := _in[1];
  out_[2] := _in[2];
end;

procedure CrossProduct(const v1, v2: vec3_t; var cross: vec3_t);
begin
  cross[0] := v1[1] * v2[2] - v1[2] * v2[1];
  cross[1] := v1[2] * v2[0] - v1[0] * v2[2];
  cross[2] := v1[0] * v2[1] - v1[1] * v2[0];
end;

//double sqrt(double x);

function VectorLength(const v: vec3_t): vec_t;
var
  i: Integer;
  length: single;
begin
  length := 0;
  for i := 0 to 2 do
    length := length + v[i] * v[i];
  length := sqrt(length);               // FIXME
  result := length;
end;

procedure VectorInverse(var v: vec3_t);
begin
  v[0] := -v[0];
  v[1] := -v[1];
  v[2] := -v[2];
end;

procedure VectorScale(const _in: vec3_t; const scale: vec_t; var out_: vec3_t);
begin
  out_[0] := _in[0] * scale;
  out_[1] := _in[1] * scale;
  out_[2] := _in[2] * scale;
end;

function Q_log2(val: Integer): Integer;
var
  answer: Integer;
begin
  answer := 0;
  val := val shr 1;
  while val <> 0 do
  begin
    inc(answer);
    val := val shr 1;
  end;
  Result := answer;
end;

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

(*
============
COM_SkipPath
============
*)

function COM_SkipPath(pathname: PChar): PChar;
var
  last: PChar;
begin
  last := pathname;
  while pathname^ <> #0 do
  begin
    if pathname^ = '/' then
    begin
      last := pathname;
      inc(last);
    end;
    inc(pathname);
  end;
  Result := last;
end;

(*
============
COM_StripExtension
============
*)

procedure COM_StripExtension(in_, out_: PChar);
begin
  while (in_^ <> #0) and (in_^ <> '.') do
  begin
    out_^ := in_^;
    inc(in_);
    inc(out_);
  end;
  out_^ := #0;
end;

(*
============
COM_FileExtension
============
*)
var
  exten: array[0..7] of char;

function COM_FileExtension(_in: PChar): PChar;
var
  i: Integer;
begin
  while (_in^ <> #0) and (_in^ <> '.') do
    inc(_in);
  if (_in^ = #0) then
  begin
    Result := '';
    exit;
  end;
  inc(_in);
  i := 0;
  while (i < 7) and (_in^ <> #0) do
  begin
    exten[i] := _in^;
    inc(i);
    inc(_in);
  end;
  exten[i] := #0;
  Result := @exten;
end;

(*
============
COM_FileBase
============
*)

procedure COM_FileBase(in_, out_: PChar);
var
  s, s2: PChar;
begin
  s := in_;
  inc(s, strlen(in_) - 1);

  while (s <> in_) and (s^ <> '.') do
    dec(s);

  s2 := s;
  while (s2 <> in_) and (s2^ <> '/') do
    dec(s2);

  if LongInt(s) - LongInt(s2) < 2 then
    out_^ := #0
  else
  begin
    dec(s);
    strncpy(out_, Pointer(Cardinal(s2) + 1), Cardinal(s) - Cardinal(s2));
    out_[Cardinal(s) - Cardinal(s2)] := #0;
  end;
end;

(*
============
COM_FilePath

Returns the path up to, but not including the last /
============
*)

procedure COM_FilePath(in_, out_: PChar);
var
  s: PChar;
begin
  s := in_;
  inc(s, strlen(in_) - 1);

  while (s <> in_) and (s^ <> '/') do
    dec(s);

  strncpy(out_, in_, LongInt(s) - LongInt(in_));
  out_[LongInt(s) - LongInt(in_)] := #0;
end;

(*
==================
COM_DefaultExtension
==================
*)

procedure COM_DefaultExtension(path, extension: PChar);
var
  src: PChar;
begin
  //
  // if path doesn't have a .EXT, append extension
  // (extension should include the .)