PHP-Quelltext

unit unitCollision;

interface

uses Math;

type float=extended;
type TPoint3D=record x,y,z:float;end;
type TPointCL=record x,y,z:float;ck:byte;end;
type TPoint3DArray=array of TPoint3D;
type TPointCLArray=array of TPointCL;

procedure CalculateCollision(var start,stop:TPoint3D;var output:TPointCLArray);
function QFrac(q:float):float;
function QInt(q:float):float;
function QSgn(q:float):shortint;
function ESgn(q:float):shortint;
function EqSgn(q,r:float):shortint;
function QFade(a,b:integer;c:byte):integer;
procedure QRotate(var x,y:float;r:float);

implementation

procedure CalculateCollision(var start,stop:TPoint3D;var output:TPointCLArray);
var i:integer;r:byte;
xs,ys,zs,q,qd:float;
xp,yp,zp:float;
qx,qy,qz:float;
p:TPointCL;
begin
  if (Length(output)=0)then exit;
  i:=0;
  xs:=stop.x - start.x;
  ys:=stop.y - start.y;
  zs:=stop.z - start.z;
  q:=0;
  qd:=((Abs(xs)+Abs(ys)+Abs(zs))*1000);
  if qd=0then qd:=1 else qd:=1/qd;
  while i<length(output) do begin
    q:=q+qd;
    //Find grid position
    xp:=start.x+xs*q;
    yp:=start.y+ys*q;
    zp:=start.z+zs*q;
    if xs=0then qx:=high(integer)else qx:=(QInt(xp)+1*ESgn(xs)-start.x)/xs;
    if ys=0then qy:=high(integer)else qy:=(QInt(yp)+1*ESgn(ys)-start.y)/ys;
    if zs=0then qz:=high(integer)else qz:=(QInt(zp)+1*ESgn(zs)-start.z)/zs;
    if(qx<=qy)and(qx<=qz)then begin
      q:=qx;r:=1;
      p.x:=start.x+xs*q;
      p.y:=start.y+ys*q;
      p.z:=start.z+zs*q;
      p.ck:=r;output[i]:=p;Inc(i);
      if i>=length(output) then Continue;
      if (Frac(p.y)=0) and (ys<>0) then begin
        p.ck:=2;output[i]:=p;Inc(i);
        if i>=length(output) then Continue;
      end;
      if (Frac(p.z)=0) and (zs<>0) then begin
        p.ck:=3;output[i]:=p;Inc(i);
        if i>=length(output) then Continue;
      end;
      Continue;
    end;
    if(qy<=qx)and(qy<=qz)then begin
      q:=qy;r:=2;
      p.x:=start.x+xs*q;
      p.y:=start.y+ys*q;
      p.z:=start.z+zs*q;
      p.ck:=r;output[i]:=p;Inc(i);
      if i>=length(output) then Continue;
      if (Frac(p.x)=0) and (xs<>0) then begin
        p.ck:=1;output[i]:=p;Inc(i);
        if i>=length(output) then Continue;
      end;
      if (Frac(p.z)=0) and (zs<>0) then begin
        p.ck:=3;output[i]:=p;Inc(i);
        if i>=length(output) then Continue;
      end;
      Continue;
    end;
    if(qz<=qx)and(qz<=qy)then begin
      q:=qz;r:=3;
      p.x:=start.x+xs*q;
      p.y:=start.y+ys*q;
      p.z:=start.z+zs*q;
      p.ck:=r;output[i]:=p;Inc(i);
      if i>=length(output) then Continue;
      if (Frac(p.x)=0) and (xs<>0) then begin
        p.ck:=1;output[i]:=p;Inc(i);
        if i>=length(output) then Continue;
      end;
      if (Frac(p.y)=0) and (ys<>0) then begin
        p.ck:=2;output[i]:=p;Inc(i);
        if i>=length(output) then Continue;
      end;
      Continue;
    end;
  end;
end;

function QFrac(q:float):float;
begin
  if q>=0then result:=Frac(q)else result:=1-Frac(-q);
end;

function QInt(q:float):float;
begin
  //if q>=0then result:=Floor(q)else result:=Ceil(q);
  result:=abs(floor(q));
  if q<0then result:=floor(-1-result);
end;

function QSgn(q:float):shortint;
begin
  result:=0;
  if q<0then result:=-1;
  if q>0then result:=1;
end;

function ESgn(q:float):shortint;
begin
  result:=0;
  if q>=0then result:=1;
end;

function EqSgn(q,r:float):shortint;
begin
  result:=0;
  if q>=0then result:=1-result;
  if r>=0then result:=1-result;
//  if q>=0then result:=result or 1;
//  if r>=0then result:=result or 1;
end;

function QFade(a,b:integer;c:byte):integer;
var r1,g1,b1,r2,g2,b2:byte;
begin
  b1:=a shr 16; b2:=b shr 16;
  g1:=a shr 8;  g2:=b shr 8;
  r1:=a;        r2:=b;
  b1:=(((b2-b1)*c)shr 8)+b1;
  g1:=(((g2-g1)*c)shr 8)+g1;
  r1:=(((r2-r1)*c)shr 8)+r1;
  result:=r1+g1*256+b1*65536;
end;

procedure QRotate(var x,y:float;r:float);
var a,b:float;
begin
  a:=x;b:=y;
  x:=Cos(r)*a + Sin(r)*b;
  y:=Cos(r)*b - Sin(r)*a;
end;
end.