// GLCollision
{: Egg<p>

	Collision-detection management for GLScene<p>

	<b>Historique : </b><font size=-1><ul>
      <li>08/08/00 - Egg - Fixed TGLBCollision.Assign
      <li>16/07/00 - Egg - Added support for all bounding modes (most are un-tested)
	   <li>23/05/00 - Egg - Creation
	</ul></font>
}
unit GLCollision;

interface

uses Classes, GLScene, XCollection, Geometry;

type

   TGLBCollision = class;

   TObjectCollisionEvent = procedure (Sender : TObject; object1, object2 : TGLBaseSceneObject) of object;

   // TCollisionBoundingMode
   //
   {: Defines how fine collision bounding is for a particular object.<p>
      Possible values are :<ul>
      <li>cbmPoint : the object is punctual and may only collide with volumes
      <li>cbmSphere : the object is defined by its bounding sphere (sphere radius
         is the max of axis-aligned dimensions)
      <li>cbmEllipsoid the object is defined by its bounding axis-aligned ellipsoid
      <li>cbmCube : the object is defined by a bounding axis-aligned "cube"
      <li>cbmFaces : the object is defined by its faces (needs object-level support,
         if unavalaible, uses cbmCube code)
      </ul> }
   TCollisionBoundingMode = (cbmPoint, cbmSphere, cbmEllipsoid, cbmCube, cbmFaces);

   TFastCollisionChecker = function (obj1, obj2 : TGLBaseSceneObject) : Boolean;
   PFastCollisionChecker = ^TFastCollisionChecker;

	// TCollisionManager
	//
	TCollisionManager = class (TComponent)
	   private
	      { Private Declarations }
         FClients : TList;
         FOnCollision : TObjectCollisionEvent;

	   protected
	      { Protected Declarations }
	      procedure RegisterClient(aClient : TGLBCollision);
	      procedure DeRegisterClient(aClient : TGLBCollision);
	      procedure DeRegisterAllClients;

	   public
	      { Public Declarations }
	      constructor Create(AOwner: TComponent); override;
         destructor Destroy; override;

	      procedure CheckCollisions;

		published
			{ Published Declarations }
         property OnCollision : TObjectCollisionEvent read FOnCollision write FOnCollision;
	end;

  	// TGLBCollision
	//
	{: Collision detection behaviour.<p>
		Allows an object to register to a TCollisionManager and be accounted for
      in collision-detection and distance calculation mechanisms.<p>
      An object may have multiple TGLBCollision, registered to multiple collision
      managers, however if multiple behaviours share the same manager, only one
      of them will be accounted for, others will be ignored. }
	TGLBCollision = class (TGLBehaviour)
		private
			{ Private Declarations }
         FBoundingMode : TCollisionBoundingMode;
         FManager : TCollisionManager;
         FManagerName : String; // NOT persistent, temporarily used for persistence

		protected
			{ Protected Declarations }
         procedure SetManager(const val : TCollisionManager);

			procedure WriteToFiler(writer : TWriter); override;
         procedure ReadFromFiler(reader : TReader); override;
         procedure Loaded; override;

		public
			{ Public Declarations }
			constructor Create(aOwner : TXCollection); override;
			destructor Destroy; override;

         procedure Assign(Source: TPersistent); override;

			class function FriendlyName : String; override;
			class function FriendlyDescription : String; override;

		published
			{ Published Declarations }
         {: Refers the collision manager. }
         property Manager : TCollisionManager read FManager write SetManager;
         property BoundingMode : TCollisionBoundingMode read FBoundingMode write FBoundingMode;
	end;

function FastCheckPointVsPoint(obj1, obj2 : TGLBaseSceneObject) : Boolean;
function FastCheckPointVsSphere(obj1, obj2 : TGLBaseSceneObject) : Boolean;
function FastCheckPointVsEllipsoid(obj1, obj2 : TGLBaseSceneObject) : Boolean;
function FastCheckPointVsCube(obj1, obj2 : TGLBaseSceneObject) : Boolean;
function FastCheckSphereVsPoint(obj1, obj2 : TGLBaseSceneObject) : Boolean;
function FastCheckSphereVsSphere(obj1, obj2 : TGLBaseSceneObject) : Boolean;
function FastCheckSphereVsEllipsoid(obj1, obj2 : TGLBaseSceneObject) : Boolean;
function FastCheckSphereVsCube(obj1, obj2 : TGLBaseSceneObject) : Boolean;
function FastCheckEllipsoidVsPoint(obj1, obj2 : TGLBaseSceneObject) : Boolean;
function FastCheckEllipsoidVsSphere(obj1, obj2 : TGLBaseSceneObject) : Boolean;
function FastCheckEllipsoidVsEllipsoid(obj1, obj2 : TGLBaseSceneObject) : Boolean;
function FastCheckEllipsoidVsCube(obj1, obj2 : TGLBaseSceneObject) : Boolean;
function FastCheckCubeVsPoint(obj1, obj2 : TGLBaseSceneObject) : Boolean;
function FastCheckCubeVsSphere(obj1, obj2 : TGLBaseSceneObject) : Boolean;
function FastCheckCubeVsEllipsoid(obj1, obj2 : TGLBaseSceneObject) : Boolean;
function FastCheckCubeVsCube(obj1, obj2 : TGLBaseSceneObject) : Boolean;

// ------------------------------------------------------------------
// ------------------------------------------------------------------
// ------------------------------------------------------------------
implementation
// ------------------------------------------------------------------
// ------------------------------------------------------------------
// ------------------------------------------------------------------

uses SysUtils, GLMisc;

const
   cEpsilon : Single = 1e-6;

const
   cFastCollisionChecker : array [cbmPoint..cbmFaces, cbmPoint..cbmFaces] of TFastCollisionChecker = (
       (FastCheckPointVsPoint,      FastCheckPointVsSphere,       FastCheckPointVsEllipsoid,       FastCheckPointVsCube,      FastCheckPointVsCube),
       (FastCheckSphereVsPoint,     FastCheckSphereVsSphere,      FastCheckSphereVsEllipsoid,      FastCheckSphereVsCube,     FastCheckSphereVsCube),
       (FastCheckEllipsoidVsPoint,  FastCheckEllipsoidVsSphere,   FastCheckEllipsoidVsEllipsoid,   FastCheckEllipsoidVsCube,  FastCheckEllipsoidVsCube),
       (FastCheckCubeVsPoint,       FastCheckCubeVsSphere,        FastCheckCubeVsEllipsoid,        FastCheckCubeVsCube,       FastCheckCubeVsCube),
       (FastCheckCubeVsPoint,       FastCheckCubeVsSphere,        FastCheckCubeVsEllipsoid,        FastCheckCubeVsCube,       FastCheckCubeVsCube)
      );

// Fast Collision detection routines
// by "fast" I mean they are heavily specialized and just return a boolean

function FastCheckPointVsPoint(obj1, obj2 : TGLBaseSceneObject) : Boolean;
begin
   Result:=(obj2.SqrDistanceTo(obj1.AbsolutePosition)<=cEpsilon);
end;

function FastCheckPointVsSphere(obj1, obj2 : TGLBaseSceneObject) : Boolean;
begin
   Result:=(obj2.SqrDistanceTo(obj1.AbsolutePosition)<=Sqr(obj2.BoundingSphereRadius));
end;

function FastCheckPointVsEllipsoid(obj1, obj2 : TGLBaseSceneObject) : Boolean;
var
   pt1 : TVector;
   v : TVector;
begin
   // express in local coordinates (for obj2)
   pt1:=VectorTransform(obj1.AbsolutePosition, obj2.InvAbsoluteMatrix);
   // calc local vector, and rescale to unit dimensions
   VectorSubstract(pt1, obj2.AbsolutePosition, v);
   DivideVector(v, obj2.AxisAlignedDimensions);
   v[3]:=0;
   // if norm is below 1, collision
   Result:=(VectorNorm(v)<=1);
end;

function FastCheckPointVsCube(obj1, obj2 : TGLBaseSceneObject) : Boolean;
var
   pt1 : TVector;
   v : TVector;
begin
   // express in local coordinates (for obj2)
   pt1:=VectorTransform(obj1.AbsolutePosition, obj2.InvAbsoluteMatrix);
   // calc local vector, and rescale to unit dimensions
   VectorSubstract(pt1, obj2.AbsolutePosition, v);
   DivideVector(v, obj2.AxisAlignedDimensions);
   v[3]:=0;
   // if any commponent is below 1, collision
   Result:=(MaxXYZComponent(v)<=1);
end;

function FastCheckSphereVsPoint(obj1, obj2 : TGLBaseSceneObject) : Boolean;
begin
   Result:=(obj1.SqrDistanceTo(obj2.AbsolutePosition)<=Sqr(obj1.BoundingSphereRadius));
end;

function FastCheckSphereVsSphere(obj1, obj2 : TGLBaseSceneObject) : Boolean;
begin
   Result:=(obj1.SqrDistanceTo(obj2.AbsolutePosition)
            <= Sqr(obj1.BoundingSphereRadius+obj2.BoundingSphereRadius));
end;

function FastCheckSphereVsEllipsoid(obj1, obj2 : TGLBaseSceneObject) : Boolean;
var
   pt1 : TVector;
   v : TVector;
   aad : TVector;
begin
   // express in local coordinates (for obj2)
   pt1:=VectorTransform(obj1.AbsolutePosition, obj2.InvAbsoluteMatrix);
   // calc local vector, and rescale to unit dimensions
   VectorSubstract(pt1, obj2.AbsolutePosition, v);
   aad:=VectorAdd(obj2.AxisAlignedDimensions, obj1.BoundingSphereRadius);
   DivideVector(v, aad);
   v[3]:=0;
   // if norm is below 1, collision
   Result:=(VectorNorm(v)<=1);
end;

function FastCheckSphereVsCube(obj1, obj2 : TGLBaseSceneObject) : Boolean;
var
   pt1 : TVector;
   v : TVector;
   aad : TVector;
begin
   // express in local coordinates (for obj2)
   pt1:=VectorTransform(obj1.AbsolutePosition, obj2.InvAbsoluteMatrix);
   // calc local vector, and rescale to unit dimensions
   VectorSubstract(pt1, obj2.AbsolutePosition, v);
   aad:=VectorAdd(obj2.AxisAlignedDimensions, obj1.BoundingSphereRadius);
   DivideVector(v, aad);
   v[3]:=0;
   // if any commponent is below 1, collision
   Result:=(MaxXYZComponent(v)<=1);
end;

function FastCheckEllipsoidVsPoint(obj1, obj2 : TGLBaseSceneObject) : Boolean;
begin
   Result:=FastCheckPointVsEllipsoid(obj2, obj1);
end;

function FastCheckEllipsoidVsSphere(obj1, obj2 : TGLBaseSceneObject) : Boolean;
begin
   Result:=FastCheckSphereVsEllipsoid(obj2, obj1);
end;

function FastCheckEllipsoidVsEllipsoid(obj1, obj2 : TGLBaseSceneObject) : Boolean;
var
   pt : TVector;
   v1, v2 : TVector;
begin
   // express in local coordinates (for obj2)
   pt:=VectorTransform(obj1.AbsolutePosition, obj2.InvAbsoluteMatrix);
   // calc local vector, and rescale to unit dimensions
   VectorSubstract(pt, obj2.AbsolutePosition, v1);
   DivideVector(v1, obj2.AxisAlignedDimensions);
   v1[3]:=0;
   // express in local coordinates (for obj1)
   pt:=VectorTransform(obj2.AbsolutePosition, obj1.InvAbsoluteMatrix);
   // calc local vector, and rescale to unit dimensions
   VectorSubstract(pt, obj1.AbsolutePosition, v2);
   DivideVector(v2, obj1.AxisAlignedDimensions);
   v2[3]:=0;
   // if sum of norms is below 2, collision
   Result:=(VectorNorm(v1)+VectorNorm(v2)<=2);
end;

function FastCheckEllipsoidVsCube(obj1, obj2 : TGLBaseSceneObject) : Boolean;
var
   pt1 : TVector;
   v : TVector;
   aad : TVector;
begin
   // express in local coordinates (for obj2)
   pt1:=VectorTransform(obj1.AbsolutePosition, obj2.InvAbsoluteMatrix);
   // calc local vector, and rescale to unit dimensions
   VectorSubstract(pt1, obj2.AbsolutePosition, v);
   aad:=VectorAdd(obj2.AxisAlignedDimensions, obj1.BoundingSphereRadius);
   DivideVector(v, aad);
   v[3]:=0;
   // if norm is below 1, collision
   Result:=(VectorNorm(v)<=1);
end;

function FastCheckCubeVsPoint(obj1, obj2 : TGLBaseSceneObject) : Boolean;
begin
   Result:=FastCheckPointVsCube(obj2, obj1);
end;

function FastCheckCubeVsSphere(obj1, obj2 : TGLBaseSceneObject) : Boolean;
begin
   Result:=FastCheckSphereVsCube(obj2, obj1);
end;

function FastCheckCubeVsEllipsoid(obj1, obj2 : TGLBaseSceneObject) : Boolean;
begin
   Result:=FastCheckEllipsoidVsCube(obj2, obj1);
end;

function FastCheckCubeVsCube(obj1, obj2 : TGLBaseSceneObject) : Boolean;
var
   pt : TVector;
   v1, v2 : TVector;
begin
   // express in local coordinates (for obj2)
   pt:=VectorTransform(obj1.AbsolutePosition, obj2.InvAbsoluteMatrix);
   // calc local vector, and rescale to unit dimensions
   VectorSubstract(pt, obj2.AbsolutePosition, v1);
   DivideVector(v1, obj2.AxisAlignedDimensions);
   v1[3]:=0;
   // express in local coordinates (for obj1)
   pt:=VectorTransform(obj2.AbsolutePosition, obj1.InvAbsoluteMatrix);
   // calc local vector, and rescale to unit dimensions
   VectorSubstract(pt, obj1.AbsolutePosition, v2);
   DivideVector(v2, obj1.AxisAlignedDimensions);
   v2[3]:=0;
   // if sum of max of components is below 2, collision
   Result:=(MaxXYZComponent(v1)+MaxXYZComponent(v2)<=2);
end;

// ------------------
// ------------------ TCollisionManager ------------------
// ------------------

// Create
//
constructor TCollisionManager.Create(AOwner: TComponent);
begin
	inherited Create(AOwner);
   FClients:=TList.Create;
   RegisterManager(Self);
end;

// Destroy
//
destructor TCollisionManager.Destroy;
begin
	DeRegisterAllClients;
   DeRegisterManager(Self);
   FClients.Free;
	inherited Destroy;
end;

// RegisterClient
//
procedure TCollisionManager.RegisterClient(aClient : TGLBCollision);
begin
   if Assigned(aClient) then
      if FClients.IndexOf(aClient)<0 then begin
         FClients.Add(aClient);
         aClient.FManager:=Self;
      end;
end;

// DeRegisterClient
//
procedure TCollisionManager.DeRegisterClient(aClient : TGLBCollision);
begin
   if Assigned(aClient) then begin
      aClient.FManager:=nil;
      FClients.Remove(aClient);
   end;
end;

// DeRegisterAllClients
//
procedure TCollisionManager.DeRegisterAllClients;
var
   i : Integer;
begin
   // Fast deregistration
   for i:=0 to FClients.Count-1 do
      TGLBCollision(FClients[i]).FManager:=nil;
   FClients.Clear;
end;

// CheckCollisions
//
procedure TCollisionManager.CheckCollisions;
var
   obj1, obj2 : TGLBaseSceneObject;
   cli1, cli2 : TGLBCollision;
   i, j : Integer;
begin
   if not Assigned(FOnCollision) then Exit;
   // if you know a code slower than current one, call me ;)
   { TODO : speed improvements & distance cacheing }
   for i:=0 to FClients.Count-2 do begin
      cli1:=TGLBCollision(FClients[i]);
      obj1:=cli1.OwnerBaseSceneObject;
      for j:=i+1 to FClients.Count-1 do begin
         cli2:=TGLBCollision(FClients[j]);
         obj2:=cli2.OwnerBaseSceneObject;
         if cFastCollisionChecker[cli1.BoundingMode, cli2.BoundingMode](obj1, obj2) then
            FOnCollision(Self, obj1, obj2);
      end;
   end;
end;

// ------------------
// ------------------ TGLBCollision ------------------
// ------------------

// Create
//
constructor TGLBCollision.Create(aOwner : TXCollection);
begin
   inherited Create(aOwner);
end;

// Destroy
//
destructor TGLBCollision.Destroy;
begin
   Manager:=nil;
   inherited Destroy;
end;

// FriendlyName
//
class function TGLBCollision.FriendlyName : String;
begin
   Result:='Collision';
end;

// FriendlyDescription
//
class function TGLBCollision.FriendlyDescription : String;
begin
   Result:='Collision-detection registration';
end;

// WriteToFiler
//
procedure TGLBCollision.WriteToFiler(writer : TWriter);
begin
   with writer do begin
      WriteInteger(0); // ArchiveVersion 0
      if Assigned(FManager) then
         WriteString(FManager.GetNamePath)
      else WriteString('');
      WriteInteger(Integer(BoundingMode));
   end;
end;

// ReadFromFiler
//
procedure TGLBCollision.ReadFromFiler(reader : TReader);
begin
   with reader do begin
      Assert(ReadInteger=0);
      FManagerName:=ReadString;
      BoundingMode:=TCollisionBoundingMode(ReadInteger);
      Manager:=nil;
   end;
end;

// Loaded
//
procedure TGLBCollision.Loaded;
var
   mng : TComponent;
begin
   inherited;
   if FManagerName<>'' then begin
      mng:=FindManager(TCollisionManager, FManagerName);
      if Assigned(mng) then
         Manager:=TCollisionManager(mng);
      FManagerName:='';
   end;
end;

// Assign
//
procedure TGLBCollision.Assign(Source: TPersistent);
begin
   if Source is TGLBCollision then begin
      Manager:=TGLBCollision(Source).Manager;
      BoundingMode:=TGLBCollision(Source).BoundingMode;
   end;
   inherited Assign(Source);
end;

// SetManager
//
procedure TGLBCollision.SetManager(const val : TCollisionManager);
begin
   if val<>FManager then begin
      if Assigned(FManager) then
         FManager.DeRegisterClient(Self);
      if Assigned(val) then
         val.RegisterClient(Self);
   end;
end;

// ------------------------------------------------------------------
// ------------------------------------------------------------------
// ------------------------------------------------------------------
initialization
// ------------------------------------------------------------------
// ------------------------------------------------------------------
// ------------------------------------------------------------------

	// class registrations
	RegisterXCollectionItemClass(TGLBCollision);

end.

