GLScene/Source/GLDCE.pas

//
// This unit is part of the GLScene Engine, http://glscene.org
//

unit GLDCE;

(*
  Dynamic Collision Engine
  How to use:
  - Add a DCEManager to you form and configure its properties
  - Add a Dynamic Collision Behavior to you object
  - Add a Static Collision behaviour to objects which yours will collide
  - You can choose the shape of your static object
    - csEllipsoid, csBox
    - csFreeform MUST BE A TGLFreeform, otherwise will raise errors
    - csTerrain MUST BE A TGLTerrainRenderer, same condition above
  - Active: Disable or enable the behaviour for this object
  - Friction: is a value aprox. between 0 (no friction) and 100 (no movement)
  - Layer: An object collides only with lower or equal layers
  - Size: is used for Ellipsoids (Radius) / Boxes (Dimensions)
  - Solid: Object still generate collision events but it doesn't "block" the dynamic object
  - UseGravity: You can disable the gravity for that object
  - SlideOrBounce: The object can bounce like a ball or slide like an FPS
  - BounceFactor: Restituition factor, 1 means that it will bounce forever
*)

interface

{$I GLScene.inc}

uses
  System.Classes,
  System.SysUtils,
  System.Types,

  GLScene,
  XCollection,
  GLVectorGeometry,
  GLVectorLists,
  GLVectorFileObjects,
  GLDCEMisc,
  GLEllipseCollision,
  GLTerrainRenderer,
  GLCoordinates,
  GLBaseClasses,
  GLManager,
  GLVectorTypes,
  GLS.Strings;

type
  //Only csEllipsoid can have dynamic behaviour
  TDCEShape = (csEllipsoid, csBox, csFreeform, csTerrain);

  (*Indicates which type of layer comparison is made when trying to detect
     collisions between 2 bodies (A and B). Possible values are:
	 ccsDCEStandard: Collides bodies if A.layer <= B.layer
	 ccsCollisionStandard: Collides bodies if either A or B have
		 layer equal to zero or if their layers are different.
      ccsHybrid: Collides bodies if either one of the previous
	     checks would pass (i.e. if the layer of either body  is
		 equal to 0 or if A.layer <= B.layer) *and* if both
		 layers are positive (that is, turns off collision
		 for bodies whose layer is < 0) *)
  TDCECollisionSelection = (ccsDCEStandard, ccsCollisionStandard, ccsHybrid); 

  TDCECollision = record
    Position: TAffineVector;
    Normal: TAffineVector; //Surface normal
    Bounce: TAffineVector; //Surface reflection
    Nearest: Boolean;
    RootCollision:boolean;
    Distance:single;
  end;

  TGLDCEStatic = class;
  TGLDCEDynamic = class;

  TDCECollisionEvent = procedure (Sender : TObject; object1, object2 : TGLBaseSceneObject;
                                       CollisionInfo: TDCECollision) of object;
  TDCEObjectCollisionEvent = procedure (Sender : TObject; ObjectCollided : TGLBaseSceneObject;
                                       CollisionInfo: TDCECollision) of object;

  TGLDCEManager = class (TComponent)
  private
    FStatics : TList;
    FDynamics : TList;
    FGravity: Single;
    FWorldDirection: TGLCoordinates; //Used to calculate jumps f.i.
    FWorldScale: Single;
    FMovimentScale: Single;
    FStandardiseLayers : TDCECollisionSelection;
    FManualStep: Boolean;
    FOnCollision : TDCECollisionEvent;
    procedure SetWorldDirection(const Value: TGLCoordinates);
    procedure SetWorldScale(const Value: Single);
    function GetDynamicCount: Integer;
    function GetStaticCount: Integer;
  protected
    procedure RegisterStatic(aClient : TGLDCEStatic);
    procedure DeRegisterStatic(aClient : TGLDCEStatic);
    procedure DeRegisterAllStatics;
    procedure RegisterDynamic(aClient : TGLDCEDynamic);
    procedure DeRegisterDynamic(aClient : TGLDCEDynamic);
    procedure DeRegisterAllDynamics;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    //Moves the body by the distance and returns the average friction
    function MoveByDistance(var Body: TGLDCEDynamic; deltaS, deltaAbsS: TAffineVector): Single;
    procedure Step(deltaTime: Double);
    property DynamicCount: Integer read GetDynamicCount;
    property StaticCount: Integer read GetStaticCount;
  published
    property Gravity : Single read FGravity write FGravity;
    property WorldDirection : TGLCoordinates read FWorldDirection write SetWorldDirection;
    property WorldScale : Single read FWorldScale write SetWorldScale;
    property MovimentScale : Single read FMovimentScale write FMovimentScale;
    Property StandardiseLayers: TDCECollisionSelection read FStandardiseLayers write FStandardiseLayers;
    Property ManualStep: Boolean read FManualStep write FManualStep;
    property OnCollision : TDCECollisionEvent read FOnCollision write FOnCollision;
  end;

  TGLDCEStatic = class (TGLBehaviour)
	private
    FManager : TGLDCEManager;
    FManagerName : String; // NOT persistent, temporarily used for persistence
    FActive: Boolean;
    FShape: TDCEShape;
    //Collides only with lower or equal layers
    FLayer: Integer; 
    //Collide and slide if true, otherwise it "walk thru walls"
    FSolid: Boolean; 
    FFriction: Single; //0 (no friction); 100 (no movement)
    FBounceFactor: Single; //0 (don't bounce); 1 (bounce forever)
    FSize: TGLCoordinates;
    //Events
    FOnCollision : TDCEObjectCollisionEvent;
    procedure SetShape(const Value: TDCEShape);
    procedure SetFriction(const Value: Single);
    procedure SetBounceFactor(const Value: Single);
    procedure SetSize(const Value: TGLCoordinates);
  protected
    procedure SetManager(const val : TGLDCEManager);
    procedure WriteToFiler(writer : TWriter); override;
    procedure ReadFromFiler(reader : TReader); override;
    procedure Loaded; override;
  public
    constructor Create(aOwner : TXCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    class function FriendlyName : String; override;
    class function FriendlyDescription : String; override;
    property OnCollision : TDCEObjectCollisionEvent read FOnCollision write FOnCollision;
  published
    property Active : Boolean read FActive write FActive;
    property Manager : TGLDCEManager read FManager write SetManager;
    property Shape : TDCEShape read FShape write SetShape;
    property Layer : Integer read FLayer write FLayer;
    property Solid : Boolean read FSolid write FSolid;
    property Friction : Single read FFriction write SetFriction;
    property BounceFactor : Single read FBounceFactor write SetBounceFactor;
    property Size : TGLCoordinates read FSize write SetSize;
  end;

  TDCESlideOrBounce = (csbSlide,csbBounce);

  TGLDCEDynamic = class (TGLBehaviour)
  private
    FManager : TGLDCEManager;
    FManagerName : String; // NOT persistent, temporarily used for persistence
    FActive: Boolean;
    FUseGravity: Boolean;
    FLayer: Integer; //Collides only with lower or equal layers
    FSolid: Boolean; //Collide and slide if true, otherwise it "walk thru walls"
    FFriction: Single; //0 (no friction); 100 (no movement)
    FBounceFactor: Single; //0 (don't bounce); 1 (bounce forever)
    FSize: TGLCoordinates;
	//Number of iterations of the collision method
    FMaxRecursionDepth:byte; 
    FSlideOrBounce:TDCESlideOrBounce;//gak20041122
    //Movement
    FAccel: TAffineVector; //Current acceleration
    FSpeed: TAffineVector; //Current speed
    FAbsAccel: TAffineVector; //Current absolute accel
    FAbsSpeed: TAffineVector; //Current absolute speed
    FGravSpeed: TAffineVector; //Current gravity speed
    FTotalFriction: Single; //Current sum of all contatcs friction
    FInGround: Boolean;
    FGroundNormal: TAffineVector;
    FJumpHeight, FJumpForce,FJumpSpeed: Single;
    FJumping: Boolean;
    //Events
    FOnCollision : TDCEObjectCollisionEvent;
    procedure SetFriction(const Value: Single);
    procedure SetBounceFactor(const Value: Single);
    procedure SetSize(const Value: TGLCoordinates);
  protected
    procedure SetManager(const val : TGLDCEManager);
    procedure WriteToFiler(writer : TWriter); override;
    procedure ReadFromFiler(reader : TReader); override;
    procedure Loaded; override;
  public
    constructor Create(aOwner : TXCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    class function FriendlyName : String; override;
    class function FriendlyDescription : String; override;
    procedure ApplyAccel(NewAccel: TAffineVector); overload;
    procedure ApplyAccel(x,y,z: Single); overload;
    procedure ApplyAbsAccel(NewAccel: TAffineVector); overload;
    procedure ApplyAbsAccel(x,y,z: Single); overload;
    procedure StopAccel;
    procedure StopAbsAccel;
    procedure Jump(jHeight, jSpeed: Single);
    procedure Move(deltaS: TAffineVector; deltaTime: Double);
    procedure MoveTo(Position: TAffineVector; Amount: Single); 
    procedure DoMove(deltaTime: Double);
    procedure DoProgress(const progressTime : TGLProgressTimes); override;
    //Runtime only
    property Speed : TAffineVector read FSpeed write FSpeed;
    property InGround : Boolean read FInGround;
    property MaxRecursionDepth:byte read FMaxRecursionDepth write FMaxRecursionDepth;
    property OnCollision : TDCEObjectCollisionEvent read FOnCollision write FOnCollision;
  published
    property Active : Boolean read FActive write FActive;
    property Manager : TGLDCEManager read FManager write SetManager;
    property UseGravity : Boolean read FUseGravity write FUseGravity;
    property Layer : Integer read FLayer write FLayer;
    property Solid : Boolean read FSolid write FSolid;
    property Friction : Single read FFriction write SetFriction;
    property BounceFactor : Single read FBounceFactor write SetBounceFactor;
    property Size : TGLCoordinates read FSize write SetSize;
    property SlideOrBounce:TDCESlideOrBounce read FSlideOrBounce write FSlideOrBounce;
  end;

function GetOrCreateDCEStatic(behaviours : TGLBehaviours) : TGLDCEStatic; overload;
function GetOrCreateDCEStatic(obj : TGLBaseSceneObject) : TGLDCEStatic; overload;

function GetOrCreateDCEDynamic(behaviours : TGLBehaviours) : TGLDCEDynamic; overload;
function GetOrCreateDCEDynamic(obj : TGLBaseSceneObject) : TGLDCEDynamic; overload;

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

function RotateVectorByObject(Obj: TGLBaseSceneObject; const v: TAffineVector): TAffineVector;
var v2: TVector;
begin
  SetVector(v2,v);
  SetVector(result,VectorTransform(v2, Obj.Matrix^));
end;

constructor TGLDCEManager.Create(AOwner: TComponent);
begin
	inherited Create(AOwner);
  FStatics:=TList.Create;
  FDynamics:=TList.Create;
  FGravity:=0;
  FWorldDirection:=TGLCoordinates.CreateInitialized(Self, YHmgVector, csVector);
  FWorldScale := 1;
  FMovimentScale := 1;
  FStandardiseLayers := ccsDCEStandard;
  FManualStep := False;
  RegisterManager(Self);
end;

destructor TGLDCEManager.Destroy;
begin
	DeRegisterAllStatics;
	DeRegisterAllDynamics;
  DeRegisterManager(Self);
  FStatics.Free;
  FDynamics.Free;
  FWorldDirection.Free;
	inherited Destroy;
end;

function TGLDCEManager.GetDynamicCount: Integer;
begin
  result := FDynamics.Count;
end;

function TGLDCEManager.GetStaticCount: Integer;
begin
  result := FStatics.Count;
end;

function TGLDCEManager.MoveByDistance(var Body: TGLDCEDynamic; 
  deltaS, deltaAbsS: TAffineVector): Single;
var
    //Friction and bounce
    TotalFriction, bounce,f,m,restitution: Single;
    ContactList: TIntegerList;
    //Temporary properties (Static or Dynamic)
    tFriction, tBounceFactor: Single;
    tObject: TGLBaseSceneObject;
    //Collision results
    ColInfo: TDCECollision;
    lastobj:integer;
    i, oi: Integer;
    MP: TECMovePack;
    CanCollide,GravCollided: boolean;
    //Vars used to calculate high velocities
    ColRange,MaxRange: Single;
    dCR,dT,deltaCR: Double;
begin
  //Set collider parameters
  MP.Radius := Body.Size.AsAffineVector;
  MP.Position := AffineVectorMake(Body.OwnerBaseSceneObject.AbsolutePosition);
  MP.Velocity := deltaS;
  MP.Gravity := deltaAbsS;
  MP.ObjectInfo.Solid := Body.Solid;
  MP.UnitScale := FWorldScale;
  MP.MaxRecursionDepth := Body.MaxRecursionDepth; 
  //Get collision range, if it is too big separate into small pieces
  ECSetCollisionRange(MP);
  ColRange := MP.CollisionRange;
  deltaCR := ColRange;
  MaxRange := MaxXYZComponent(MP.Radius)*2.1;
  SetLength(MP.Contacts,0);
  GravCollided := False; //Is colliding with the ground
  Body.FGroundNormal := NullVector;
  while deltaCR > 0 do
  begin
    if deltaCR > MaxRange then
    begin
      dCR := MaxRange;
      deltaCR := deltaCR - MaxRange;
    end
    else
    begin
      dCR := deltaCR;
      deltaCR := 0;
    end;
    dT := dCR / ColRange;
    MP.Velocity := VectorScale(deltaS,dT);
    MP.Gravity := VectorScale(deltaAbsS, dT);

    ECSetCollisionRange(MP);
    ECResetColliders(MP);

    //For each static collider
    for i:=0 to FStatics.Count-1 do
    with TGLDCEStatic(FStatics[i]) do
    begin

      CanCollide := False;
      if (Active) then
      case FStandardiseLayers of
        ccsDCEStandard: CanCollide := (Layer <= Body.Layer);
        ccsCollisionStandard: CanCollide := (layer = 0) or (body.layer = 0) or (layer <> body.layer);
        ccsHybrid: CanCollide := ( (layer = 0) or (body.layer = 0) or (Layer <= Body.Layer) ) and (layer>=0) and (body.layer>=0);
      end;

      //Add colliders to move pack
      if CanCollide then
      begin
        case Shape of
          csFreeform: ECAddFreeForm(MP,OwnerBaseSceneObject,Solid,i);
          csEllipsoid: ECAddEllipsoid(MP,AffineVectorMake(OwnerBaseSceneObject.AbsolutePosition),
                        Size.AsAffineVector,Solid,i);
          csBox: ECAddBox(MP,OwnerBaseSceneObject,Size.AsAffineVector,Solid,i);
          csTerrain: ECAddTerrain(MP,TGLTerrainRenderer(OwnerBaseSceneObject),FWorldScale*2,Solid,i);
        end;
      end;

    end;

    //For each dynamic collider add a static ellipsoid
    for i:=0 to FDynamics.Count-1 do
    with TGLDCEDynamic(FDynamics[i]) do
    begin
      CanCollide := False;
      if (Active) and (TGLDCEDynamic(FDynamics[i]) <> Body) then
      case FStandardiseLayers of
        ccsDCEStandard: CanCollide := (Layer <= Body.Layer);
        ccsCollisionStandard: CanCollide := (layer = 0) or (body.layer = 0) or (layer <> body.layer);
        ccsHybrid: CanCollide := ( (layer = 0) or (body.layer = 0) or (Layer <= Body.Layer) ) and (layer>=0) and (body.layer>=0);
      end;
      //Add collider to move pack
      //To differ from static it is added with a negative ID (id < 0)
      if CanCollide then
        ECAddEllipsoid(MP,AffineVectorMake(OwnerBaseSceneObject.AbsolutePosition),
                        Size.AsAffineVector,Solid,-1-i);
    end;


    CollideAndSlide(MP);
    if MP.GravityCollided then
    begin
      GravCollided := True;
      Body.FGroundNormal := Mp.GroundNormal;
    end;
    MP.Position := MP.ResultPos;
  end;

  //Set the result
  Body.OwnerBaseSceneObject.AbsolutePosition := VectorMake(MP.ResultPos);
  Body.FInGround := GravCollided;

  //Generate events and calculate average friction
  lastobj := -1;
  TotalFriction := Body.Friction;
  ContactList := TIntegerList.Create;

  try
  for i := 0 to High(MP.Contacts) do
  with MP do
  begin
    oi := Contacts[i].ObjectInfo.ObjectID;

    //Don't repeat objects with same ID
    if ContactList.IndexOf(oi) >= 0 then Continue
    else ContactList.Add(oi);

    //Check if it is static or dynamic
    if oi < 0 then
    begin
      tFriction := TGLDCEDynamic(FDynamics[System.abs(oi) - 1]).Friction;
      tBounceFactor := TGLDCEDynamic(FDynamics[System.abs(oi) - 1]).BounceFactor;
      tObject := TGLDCEDynamic(FDynamics[System.abs(oi) - 1]).OwnerBaseSceneObject;
    end else
    begin
      tFriction := TGLDCEStatic(FStatics[oi]).Friction;
      tBounceFactor := TGLDCEStatic(FStatics[oi]).BounceFactor;
      tObject := TGLDCEStatic(FStatics[oi]).OwnerBaseSceneObject;
    end;

    TotalFriction := TotalFriction + tFriction;
    ColInfo.Position := Contacts[i].Position;
    ColInfo.Normal := Contacts[i].SurfaceNormal;
    ColInfo.Bounce := VectorNormalize(VectorReflect(VectorAdd(deltaS,deltaAbsS), ColInfo.Normal));
    ColInfo.Nearest := oi = MP.NearestObject;

    //Calculate bounce
    if (Body.SlideOrBounce = csbBounce) and ColInfo.Nearest then
    begin
      bounce:=VectorDotProduct(Body.FSpeed, ColInfo.Normal);
      if bounce<0 then begin
        restitution := (Body.BounceFactor + tBounceFactor) / 2;
        m := VectorLength(Body.FSpeed);
        f := -bounce/VectorNorm(ColInfo.Normal)*(1+restitution);
        CombineVector(Body.FSpeed,ColInfo.Normal,f);
        //Limit bounce speed
        if VectorLength(Body.FSpeed) > m * 2 then
           Body.FSpeed := NullVector;
      end;

      bounce:=VectorDotProduct(Body.FAbsSpeed, ColInfo.Normal);
      if bounce<0 then begin
        restitution := (Body.BounceFactor + tBounceFactor) / 2;
        m := VectorLength(Body.FAbsSpeed);
        f := -bounce/VectorNorm(ColInfo.Normal)*(1+restitution);
        CombineVector(Body.FAbsSpeed,ColInfo.Normal,f);
        //Limit
        if VectorLength(Body.FAbsSpeed) > m * 2 then
          Body.FAbsSpeed := NullVector;
      end;

      bounce:=VectorDotProduct(Body.FGravSpeed, ColInfo.Normal);
      if bounce<0 then begin
        restitution := (Body.BounceFactor + tBounceFactor) / 2;
        m := VectorLength(Body.FGravSpeed);
        f := -bounce/VectorNorm(ColInfo.Normal)*(1+restitution);
        CombineVector(Body.FGravSpeed,ColInfo.Normal,f);
        //Limit
        if VectorLength(Body.FGravSpeed) > m * 2 then
          Body.FGravSpeed := NullVector;
      end;

    end;

    colinfo.RootCollision := (lastobj <> oi);
    colInfo.Distance := Contacts[i].Distance;
    lastobj := oi;
    
    if Assigned(FOnCollision) then
        FOnCollision(Self,Body.OwnerBaseSceneObject,tObject,ColInfo);
    if Assigned(Body.FOnCollision) then
        Body.FOnCollision(Self,tObject,ColInfo);
    if Assigned(Body.FOnCollision) then
        Body.FOnCollision(Self,tObject,ColInfo);
    //If the collided object is static trigger its event
    if (oi >= 0) and Assigned(TGLDCEStatic(FStatics[oi]).FOnCollision) then
      TGLDCEStatic(FStatics[oi]).FOnCollision(Self,Body.OwnerBaseSceneObject,ColInfo);
    end;
  finally
    ContactList.Free;
  end;
  result := TotalFriction;
end;

procedure TGLDCEManager.Step(deltaTime: Double);
var i: Integer;
begin
  if deltaTime > 0.1 then deltaTime := 0.1;
  for i := 0 to FDynamics.Count-1 do
    with TGLDCEDynamic(FDynamics[i]) do
      if Active then DoMove(deltaTime);
end;

procedure TGLDCEManager.SetWorldDirection(const Value: TGLCoordinates);
begin
  FWorldDirection := Value;
  FWorldDirection.Normalize;
end;

procedure TGLDCEManager.SetWorldScale(const Value: Single);
begin
  if Value = 0 then FWorldScale := 0.001
  else if Value < 0 then FWorldScale := abs(Value)
  else FWorldScale := Value;
end;

procedure TGLDCEManager.RegisterStatic(aClient : TGLDCEStatic);
begin
   if Assigned(aClient) then
      if FStatics.IndexOf(aClient)<0 then begin
         FStatics.Add(aClient);
         aClient.FManager:=Self;
      end;
end;

procedure TGLDCEManager.DeRegisterStatic(aClient : TGLDCEStatic);
begin
   if Assigned(aClient) then begin
      aClient.FManager:=nil;
      FStatics.Remove(aClient);
   end;
end;

procedure TGLDCEManager.DeRegisterAllStatics;
var
   i : Integer;
begin
   // Fast deregistration
   for i:=0 to FStatics.Count-1 do
      TGLDCEStatic(FStatics[i]).FManager:=nil;
   FStatics.Clear;
end;

procedure TGLDCEManager.RegisterDynamic(aClient : TGLDCEDynamic);
begin
   if Assigned(aClient) then
      if FDynamics.IndexOf(aClient)<0 then begin
         FDynamics.Add(aClient);
         aClient.FManager:=Self;
      end;
end;

procedure TGLDCEManager.DeRegisterDynamic(aClient : TGLDCEDynamic);
begin
   if Assigned(aClient) then begin
      aClient.FManager:=nil;
      FDynamics.Remove(aClient);
   end;
end;

procedure TGLDCEManager.DeRegisterAllDynamics;
var
   i : Integer;
begin
   // Fast deregistration
   for i:=0 to FDynamics.Count-1 do
      TGLDCEDynamic(FDynamics[i]).FManager:=nil;
   FDynamics.Clear;
end;

//---------------------
// TGLDCEStatic 
//---------------------

procedure TGLDCEStatic.Assign(Source: TPersistent);
begin
   if Source is TGLDCEStatic then begin
      Active := TGLDCEStatic(Source).Active;
      Manager:=TGLDCEStatic(Source).Manager;
      Shape := TGLDCEStatic(Source).Shape;
      Layer := TGLDCEStatic(Source).Layer;
      Solid := TGLDCEStatic(Source).Solid;
      Size.Assign(TGLDCEStatic(Source).Size);
      Friction := TGLDCEStatic(Source).Friction;
      BounceFactor := TGLDCEStatic(Source).BounceFactor;
   end;
   inherited Assign(Source);
end;

constructor TGLDCEStatic.Create(aOwner: TXCollection);
begin
   inherited Create(aOwner);
   FActive := True;
   FSize:=TGLCoordinates.CreateInitialized(Self, XYZHmgVector, csVector);
   FShape := csEllipsoid;
   FSolid := True;
   FFriction := 1;
   FBounceFactor := 0;
end;

destructor TGLDCEStatic.Destroy;
begin
   Manager:=nil;
   FSize.Free;
   inherited Destroy;
end;

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

class function TGLDCEStatic.FriendlyName: String;
begin
   Result:='DCE Static Collider';
end;

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

procedure TGLDCEStatic.WriteToFiler(writer: TWriter);
begin
   with writer do begin
      // ArchiveVersion 1, added inherited call
      WriteInteger(1);
      inherited;
      if Assigned(FManager) then
         WriteString(FManager.GetNamePath)
      else WriteString('');
      WriteInteger(Integer(FShape));
      WriteInteger(FLayer);
      WriteBoolean(FSolid);
      WriteBoolean(FActive);
      WriteSingle(FFriction);
      WriteSingle(FBounceFactor);
      FSize.WriteToFiler(writer);
   end;
end;

procedure TGLDCEStatic.ReadFromFiler(reader: TReader);
var
   archiveVersion : Integer;
begin
   with reader do begin
      archiveVersion:=ReadInteger;
      Assert(archiveVersion in [0..1]);
      if archiveVersion >=1 then
        inherited;
      FManagerName:=ReadString;
      Manager:=nil;
      FShape := TDCEShape(ReadInteger);
      FLayer := ReadInteger;
      FSolid := ReadBoolean;
      FActive := ReadBoolean;
      FFriction := ReadSingle;
      FBounceFactor := ReadSingle;
      FSize.ReadFromFiler(reader);
   end;
end;

procedure TGLDCEStatic.SetBounceFactor(const Value: Single);
begin
  FBounceFactor := Value;
  if FBounceFactor < 0 then FBounceFactor := 0;
  if FBounceFactor > 1 then FBounceFactor := 1;
end;

procedure TGLDCEStatic.SetFriction(const Value: Single);
begin
  FFriction := Value;
  if FFriction < 0 then FFriction := 0;
  if FFriction > 100 then FFriction := 100;
end;

procedure TGLDCEStatic.SetManager(const val: TGLDCEManager);
begin
   if val<>FManager then begin
      if Assigned(FManager) then
         FManager.DeRegisterStatic(Self);
      if Assigned(val) then
         val.RegisterStatic(Self);
   end;
end;

procedure TGLDCEStatic.SetShape(const Value: TDCEShape);
begin
  FShape := Value;
end;

procedure TGLDCEStatic.SetSize(const Value: TGLCoordinates);
begin
  FSize.Assign(Value);
  if FSize.X <= 0 then FSize.X := 0.1;
  if FSize.Y <= 0 then FSize.Y := 0.1;
  if FSize.Z <= 0 then FSize.Z := 0.1;
end;

{ TGLDCEDynamic }

procedure TGLDCEDynamic.ApplyAccel(NewAccel: TAffineVector);
begin
  AddVector(FAccel, NewAccel);
end;

procedure TGLDCEDynamic.ApplyAccel(x,y,z: Single);
begin
  AddVector(FAccel, AffineVectorMake(x,y,z));
end;

procedure TGLDCEDynamic.ApplyAbsAccel(NewAccel: TAffineVector);
begin
  AddVector(FAbsAccel, NewAccel);
end;

procedure TGLDCEDynamic.ApplyAbsAccel(x,y,z: Single);
begin
  AddVector(FAbsAccel, AffineVectorMake(x,y,z));
end;

procedure TGLDCEDynamic.StopAccel;
begin
  SetVector(FAccel, NullVector);
end;

procedure TGLDCEDynamic.StopAbsAccel;
begin
  SetVector(FAbsAccel, NullVector);
end;

procedure TGLDCEDynamic.Assign(Source: TPersistent);
begin
  if Source is TGLDCEDynamic then begin
    Manager:=TGLDCEDynamic(Source).Manager;
    Active := TGLDCEDynamic(Source).Active;
    UseGravity := TGLDCEDynamic(Source).UseGravity;
    Layer := TGLDCEDynamic(Source).Layer;
    Solid := TGLDCEDynamic(Source).Solid;
    Size.Assign(TGLDCEDynamic(Source).Size);
    Friction := TGLDCEDynamic(Source).Friction;
    BounceFactor := TGLDCEDynamic(Source).BounceFactor;
    SlideOrBounce := TGLDCEDynamic(Source).SlideOrBounce;
    MaxRecursionDepth := TGLDCEDynamic(Source).MaxRecursionDepth;
  end;
  inherited Assign(Source);
end;

constructor TGLDCEDynamic.Create(aOwner: TXCollection);
begin
  inherited Create(aOwner);
  FActive := True;
  FUseGravity := True;
  FSize:=TGLCoordinates.CreateInitialized(Self, XYZHmgVector, csVector);
  FSolid := True;
  FFriction := 1;
  FBounceFactor := 0;
  FMaxRecursionDepth := 5;  
  FSlideOrBounce := csbSlide;
  FInGround := False;

  FAccel := NullVector;
  FAbsAccel := NullVector;
  FSpeed := NullVector;
  FAbsSpeed := NullVector;
  FGravSpeed := NullVector;
end;

destructor TGLDCEDynamic.Destroy;
begin
  Manager:=nil;
  FSize.Free;
  inherited Destroy;
end;

procedure TGLDCEDynamic.DoMove(deltaTime: Double);
var fGround,fAir, G: Single;
    v, deltaS, deltaAbsS: TAffineVector;

    procedure Accel(var aSpeed: TAffineVector; aFric: Single; aForce: TAffineVector);
    begin
      ScaleVector(aForce, deltaTime);
      ScaleVector(aSpeed, aFric);
      aSpeed := VectorAdd(aForce, aSpeed);
    end;

begin

  if (FSlideOrBounce = csbBounce) then
    FAccel := RotateVectorByObject(OwnerBaseSceneObject, FAccel);

  //Ground friction
  fGround := 1 - deltaTime * FTotalFriction;
  if fGround < 0 then fGround := 0;

  //Air friction
  fAir := 1 - deltaTime * FFriction;
  if fAir < 0 then fAir := 0;

  if FUseGravity and (not FInGround) then ScaleVector(FAccel,0.01);

  //v = TIME * force + max(1-TIME*Friction,0) * v;
  Accel(FSpeed, fGround, FAccel);
  Accel(FAbsSpeed, fGround, FAbsAccel);
  {FSpeed[0] := deltaTime * FAccel[0] + fGround * FSpeed[0];
  FSpeed[1] := deltaTime * FAccel[1] + fGround * FSpeed[1];
  FSpeed[2] := deltaTime * FAccel[2] + fGround * FSpeed[2];

  FAbsSpeed[0] := deltaTime * FAbsAccel[0] + fGround * FAbsSpeed[0];
  FAbsSpeed[1] := deltaTime * FAbsAccel[1] + fGround * FAbsSpeed[1];
  FAbsSpeed[2] := deltaTime * FAbsAccel[2] + fGround * FAbsSpeed[2];}

  if FUseGravity then
  begin
    //Calculate gravity acceleration

    if FInGround then
      G := FManager.Gravity * abs(1-VectorDotProduct(FGroundNormal,FManager.WorldDirection.AsAffineVector))
    else G := FManager.Gravity;

    if FJumping then G := 0;
    v := VectorScale(FManager.WorldDirection.AsAffineVector,g);

    Accel(FGravSpeed, fAir, v);
    {FGravSpeed[0] := deltaTime * v[0] + fAir * FGravSpeed[0];
    FGravSpeed[1] := deltaTime * v[1] + fAir * FGravSpeed[1];
    FGravSpeed[2] := deltaTime * v[2] + fAir * FGravSpeed[2];}
  end else
    FGravSpeed := NullVector;

  if FJumping then
  begin
    FJumpSpeed := FJumpForce;
    FJumpHeight := FJumpHeight - (FJumpSpeed * deltaTime);
    FJumping := FJumpHeight > 0;
    if FJumping then FGravSpeed := NullVector
    else begin
      v := VectorScale(FManager.WorldDirection.AsAffineVector,FJumpSpeed);
      AddVector(FGravSpeed, v);
      FJumpForce := 0;
      FJumpSpeed := 0;
    end;
  end;
  //s = s0 + vt (add relative speed)
  if FSlideOrBounce = csbBounce then
    deltaS := FSpeed
  else
    deltaS := RotateVectorByObject(OwnerBaseSceneObject, FSpeed);
  //Add absolute speed
  AddVector(deltaS, FAbsSpeed);
  //Add jump speed
  v := VectorScale(FManager.WorldDirection.AsAffineVector,FJumpSpeed);
  AddVector(deltaS, v);
  //The absolute space must be only the gravity so it can calculate when it is in the ground
  deltaAbsS := FGravSpeed;

  ScaleVector(deltaS,deltaTime);
  ScaleVector(deltaAbsS,deltaTime);

  //Returns the friction of all collided objects
  FTotalFriction := FManager.MoveByDistance(Self, deltaS, deltaAbsS);

  FAccel := NullVector;
  FAbsAccel := NullVector;
end;

procedure TGLDCEDynamic.DoProgress(const progressTime: TGLProgressTimes);
begin
  inherited doProgress(progressTime);
  assert(assigned(manager), 'DCE Manager not assigned to behaviour.');

  if (not FManager.ManualStep) and FActive then
  begin
    if progressTime.deltaTime > 0.1 then DoMove(0.1)
    else DoMove(progressTime.deltaTime);
  end;
end;

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

class function TGLDCEDynamic.FriendlyName: String;
begin
  Result:='DCE Dynamic Collider';
end;

procedure TGLDCEDynamic.Jump(jHeight, jSpeed: Single);
begin
  if (not FJumping) and (FInGround)
  and (VectorDotProduct(FGroundNormal,FManager.WorldDirection.AsAffineVector) > 0.5) then
  begin
    FJumpHeight := jHeight;
    FJumpForce := jSpeed;
    FJumpSpeed := FJumpForce;
    FJumping := True;
    FInGround := False;
    AddVector(FAbsSpeed, RotateVectorByObject(OwnerBaseSceneObject, FSpeed));
    FSpeed := NullVector;
  end;
end;

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

procedure TGLDCEDynamic.Move(deltaS: TAffineVector; deltaTime: Double);
begin
  ScaleVector(deltaS, deltaTime);
  FManager.MoveByDistance(Self, NullVector, deltaS);
end;

procedure TGLDCEDynamic.MoveTo(Position: TAffineVector; Amount: Single);
begin
  SubtractVector(Position, AffineVectorMake(OwnerBaseSceneObject.AbsolutePosition));

  Move(position,Amount);
end;

procedure TGLDCEDynamic.WriteToFiler(writer: TWriter);
begin
   with writer do begin
      // ArchiveVersion 1, added inherited call
      WriteInteger(1);
      inherited;
      if Assigned(FManager) then
         WriteString(FManager.GetNamePath)
      else WriteString('');
      WriteInteger(FLayer);
      WriteBoolean(FSolid);
      WriteBoolean(FActive);
      WriteBoolean(FUseGravity);
      WriteSingle(FFriction);
      WriteSingle(FBounceFactor);
      writeinteger(FMaxRecursionDepth);
      writeinteger(ord(FSlideOrBounce));
      FSize.WriteToFiler(writer);
   end;
end;

procedure TGLDCEDynamic.ReadFromFiler(reader: TReader);
var
   archiveVersion : Integer;
begin
   with reader do begin
      archiveVersion:=ReadInteger;
      Assert(archiveVersion in [0..1]);
      if archiveVersion >=1 then
        inherited;
      FManagerName:=ReadString;
      Manager:=nil;
      FLayer := ReadInteger;
      FSolid := ReadBoolean;
      FActive := ReadBoolean;
      FUseGravity := ReadBoolean;
      FFriction := ReadSingle;
      FBounceFactor := ReadSingle;
      FMaxRecursionDepth := readinteger;
      FSlideOrBounce := TDCESlideOrBounce(readinteger);
      FSize.ReadFromFiler(reader);
   end;
end;

procedure TGLDCEDynamic.SetBounceFactor(const Value: Single);
begin
  FBounceFactor := Value;
  if FBounceFactor < 0 then FBounceFactor := 0;
  if FBounceFactor > 1 then FBounceFactor := 1;
end;

procedure TGLDCEDynamic.SetFriction(const Value: Single);
begin
  FFriction := Value;
  if FFriction < 0 then FFriction := 0;
  if FFriction > 100 then FFriction := 100;
end;

procedure TGLDCEDynamic.SetManager(const val: TGLDCEManager);
begin
   if val<>FManager then begin
      if Assigned(FManager) then
         FManager.DeRegisterDynamic(Self);
      if Assigned(val) then
         val.RegisterDynamic(Self);
   end;
end;

procedure TGLDCEDynamic.SetSize(const Value: TGLCoordinates);
begin
  FSize.Assign(Value);
  if FSize.X <= 0 then FSize.X := 0.1;
  if FSize.Y <= 0 then FSize.Y := 0.1;
  if FSize.Z <= 0 then FSize.Z := 0.1;
end;

// ----------------------------------------------------------------

function GetOrCreateDCEStatic(behaviours : TGLBehaviours) : TGLDCEStatic;
var
	i : Integer;
begin
	i:=behaviours.IndexOfClass(TGLDCEStatic);
	if i>=0 then
		Result:=TGLDCEStatic(behaviours[i])
	else Result:=TGLDCEStatic.Create(behaviours);
end;

function GetOrCreateDCEStatic(obj : TGLBaseSceneObject) : TGLDCEStatic;
begin
	Result:=GetOrCreateDCEStatic(obj.Behaviours);
end;

function GetOrCreateDCEDynamic(behaviours : TGLBehaviours) : TGLDCEDynamic;
var
	i : Integer;
begin
	i:=behaviours.IndexOfClass(TGLDCEDynamic);
	if i>=0 then
		Result:=TGLDCEDynamic(behaviours[i])
	else Result:=TGLDCEDynamic.Create(behaviours);
end;

function GetOrCreateDCEDynamic(obj : TGLBaseSceneObject) : TGLDCEDynamic;
begin
	Result:=GetOrCreateDCEDynamic(obj.Behaviours);
end;


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

	// class registrations
	RegisterXCollectionItemClass(TGLDCEStatic);
	RegisterXCollectionItemClass(TGLDCEDynamic);

finalization

	UnregisterXCollectionItemClass(TGLDCEStatic);
	UnregisterXCollectionItemClass(TGLDCEDynamic);

end.