LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
  How to use:
6
  - Add a DCEManager to you form and configure its properties
7
  - Add a Dynamic Collision Behavior to you object
8
  - Add a Static Collision behaviour to objects which yours will collide
9
  - You can choose the shape of your static object
10
    - csEllipsoid, csBox
11
    - csFreeform MUST BE A TGLFreeform, otherwise will raise errors
12
    - csTerrain MUST BE A TGLTerrainRenderer, same condition above
13
  - Active: Disable or enable the behaviour for this object
14
  - Friction: is a value aprox. between 0 (no friction) and 100 (no movement)
15
  - Layer: An object collides only with lower or equal layers
16
  - Size: is used for Ellipsoids (Radius) / Boxes (Dimensions)
17
  - Solid: Object still generate collision events but it doesn't "block" the dynamic object
18
  - UseGravity: You can disable the gravity for that object
19
  - SlideOrBounce: The object can bounce like a ball or slide like an FPS
20
  - BounceFactor: Restituition factor, 1 means that it will bounce forever
21
}
22

23
unit GLDCE;
24

25
interface
26

27
{$I GLScene.inc}
28

29
uses
30
  Classes, SysUtils,
31
  GLScene, GLXCollection, GLVectorGeometry, GLVectorLists, GLVectorFileObjects,
32
  GLCrossPlatform, GLDCEMisc, GLEllipseCollision,
33
  GLTerrainRenderer, GLCoordinates, GLBaseClasses, GLManager, GLVectorTypes;
34

35
type
36
  {Only csEllipsoid can have dynamic behaviour}
37
  TDCEShape = (csEllipsoid, csBox, csFreeform, csTerrain);
38

39
  { Indicates which type of layer comparison is made when trying to detect
40
     collisions between 2 bodies (A and B). Possible values are:  
41
	  ccsDCEStandard: Collides bodies if A.layer <= B.layer
42
	  ccsCollisionStandard: Collides bodies if either A or B have
43
		 layer equal to zero or if their layers are different.
44
      ccsHybrid: Collides bodies if either one of the previous
45
	     checks would pass (i.e. if the layer of either body  is
46
		 equal to 0 or if A.layer <= B.layer) *and* if both
47
		 layers are positive (that is, turns off collision
48
		 for bodies whose layer is < 0)
49
	  
50
  }
51
  TDCECollisionSelection = (ccsDCEStandard, ccsCollisionStandard, ccsHybrid); // gak:20041119
52

53
  TDCECollision = record
54
    Position: TAffineVector;
55
    Normal: TAffineVector; //Surface normal
56
    Bounce: TAffineVector; //Surface reflection
57
    Nearest: Boolean;
58
    RootCollision:boolean;//gak:20041119
59
    Distance:single;//gak:20041119
60
  end;
61

62
  TGLDCEStatic = class;
63
  TGLDCEDynamic = class;
64

65
  TDCECollisionEvent = procedure (Sender : TObject; object1, object2 : TGLBaseSceneObject;
66
                                       CollisionInfo: TDCECollision) of object;
67
  TDCEObjectCollisionEvent = procedure (Sender : TObject; ObjectCollided : TGLBaseSceneObject;
68
                                       CollisionInfo: TDCECollision) of object;
69

70
  TGLDCEManager = class (TComponent)
71
  private
72
     
73
    FStatics : TList;
74
    FDynamics : TList;
75
    FGravity: Single;
76
    FWorldDirection: TGLCoordinates; //Used to calculate jumps f.i.
77
    FWorldScale: Single;
78
    FMovimentScale: Single;
79
    FStandardiseLayers : TDCECollisionSelection;
80
    FManualStep: Boolean;
81
    FOnCollision : TDCECollisionEvent;
82
    procedure SetWorldDirection(const Value: TGLCoordinates);
83
    procedure SetWorldScale(const Value: Single);
84
    function GetDynamicCount: Integer;
85
    function GetStaticCount: Integer;
86
  protected
87
     
88
    procedure RegisterStatic(aClient : TGLDCEStatic);
89
    procedure DeRegisterStatic(aClient : TGLDCEStatic);
90
    procedure DeRegisterAllStatics;
91
    procedure RegisterDynamic(aClient : TGLDCEDynamic);
92
    procedure DeRegisterDynamic(aClient : TGLDCEDynamic);
93
    procedure DeRegisterAllDynamics;
94
  public
95
     
96
    constructor Create(AOwner: TComponent); override;
97
    destructor Destroy; override;
98
    //Moves the body by the distance and returns the average friction
99
    function MoveByDistance(var Body: TGLDCEDynamic; deltaS, deltaAbsS: TAffineVector): Single;
100
    procedure Step(deltaTime: Double);
101
    property DynamicCount: Integer read GetDynamicCount;
102
    property StaticCount: Integer read GetStaticCount;
103
  published
104
     
105
    property Gravity : Single read FGravity write FGravity;
106
    property WorldDirection : TGLCoordinates read FWorldDirection write SetWorldDirection;
107
    property WorldScale : Single read FWorldScale write SetWorldScale;
108
    property MovimentScale : Single read FMovimentScale write FMovimentScale;
109
    Property StandardiseLayers: TDCECollisionSelection read FStandardiseLayers write FStandardiseLayers; //gak:20041119
110
    Property ManualStep: Boolean read FManualStep write FManualStep;
111
    property OnCollision : TDCECollisionEvent read FOnCollision write FOnCollision;
112
	end;
113

114
  TGLDCEStatic = class (TGLBehaviour)
115
	private
116
		 
117
    FManager : TGLDCEManager;
118
    FManagerName : String; // NOT persistent, temporarily used for persistence
119
    FActive: Boolean;
120
    FShape: TDCEShape;
121
    FLayer: Integer; //Collides only with lower or equal layers
122
    FSolid: Boolean; //Collide and slide if true, otherwise it "walk thru walls"
123
    FFriction: Single; //0 (no friction); 100 (no movement)
124
    FBounceFactor: Single; //0 (don't bounce); 1 (bounce forever)
125
    FSize: TGLCoordinates;
126
    //Events
127
    FOnCollision : TDCEObjectCollisionEvent;
128
    procedure SetShape(const Value: TDCEShape);
129
    procedure SetFriction(const Value: Single);
130
    procedure SetBounceFactor(const Value: Single);
131
    procedure SetSize(const Value: TGLCoordinates);
132
  protected
133
     
134
    procedure SetManager(const val : TGLDCEManager);
135
    procedure WriteToFiler(writer : TWriter); override;
136
    procedure ReadFromFiler(reader : TReader); override;
137
    procedure Loaded; override;
138
  public
139
     
140
    constructor Create(aOwner : TGLXCollection); override;
141
    destructor Destroy; override;
142
    procedure Assign(Source: TPersistent); override;
143
    class function FriendlyName : String; override;
144
    class function FriendlyDescription : String; override;
145
    property OnCollision : TDCEObjectCollisionEvent read FOnCollision write FOnCollision;
146
  published
147
     
148
    property Active : Boolean read FActive write FActive;
149
    property Manager : TGLDCEManager read FManager write SetManager;
150
    property Shape : TDCEShape read FShape write SetShape;
151
    property Layer : Integer read FLayer write FLayer;
152
    property Solid : Boolean read FSolid write FSolid;
153
    property Friction : Single read FFriction write SetFriction;
154
    property BounceFactor : Single read FBounceFactor write SetBounceFactor;
155
    property Size : TGLCoordinates read FSize write SetSize;
156
  end;
157

158
  TDCESlideOrBounce = (csbSlide,csbBounce);
159

160
  TGLDCEDynamic = class (TGLBehaviour)
161
	private
162
		 
163
    FManager : TGLDCEManager;
164
    FManagerName : String; // NOT persistent, temporarily used for persistence
165
    FActive: Boolean;
166
    FUseGravity: Boolean;
167
    FLayer: Integer; //Collides only with lower or equal layers
168
    FSolid: Boolean; //Collide and slide if true, otherwise it "walk thru walls"
169
    FFriction: Single; //0 (no friction); 100 (no movement)
170
    FBounceFactor: Single; //0 (don't bounce); 1 (bounce forever)
171
    FSize: TGLCoordinates;
172
    FMaxRecursionDepth:byte;//gak20041119 //Number of iterations of the collision method
173
    FSlideOrBounce:TDCESlideOrBounce;//gak20041122
174
    //Movement
175
    FAccel: TAffineVector; //Current acceleration
176
    FSpeed: TAffineVector; //Current speed
177
    FAbsAccel: TAffineVector; //Current absolute accel
178
    FAbsSpeed: TAffineVector; //Current absolute speed
179
    FGravSpeed: TAffineVector; //Current gravity speed
180
    FTotalFriction: Single; //Current sum of all contatcs friction
181
    FInGround: Boolean;
182
    FGroundNormal: TAffineVector;
183
    FJumpHeight, FJumpForce,FJumpSpeed: Single;
184
    FJumping: Boolean;
185
    //Events
186
    FOnCollision : TDCEObjectCollisionEvent;
187
    procedure SetFriction(const Value: Single);
188
    procedure SetBounceFactor(const Value: Single);
189
    procedure SetSize(const Value: TGLCoordinates);
190
  protected
191
     
192
    procedure SetManager(const val : TGLDCEManager);
193
    procedure WriteToFiler(writer : TWriter); override;
194
    procedure ReadFromFiler(reader : TReader); override;
195
    procedure Loaded; override;
196
  public
197
     
198
    constructor Create(aOwner : TGLXCollection); override;
199
    destructor Destroy; override;
200
    procedure Assign(Source: TPersistent); override;
201
    class function FriendlyName : String; override;
202
    class function FriendlyDescription : String; override;
203
    procedure ApplyAccel(NewAccel: TAffineVector); overload;
204
    procedure ApplyAccel(x,y,z: Single); overload;
205
    procedure ApplyAbsAccel(NewAccel: TAffineVector); overload;
206
    procedure ApplyAbsAccel(x,y,z: Single); overload;
207
    procedure StopAccel;
208
    procedure StopAbsAccel;
209
    procedure Jump(jHeight, jSpeed: Single);
210
    procedure Move(deltaS: TAffineVector; deltaTime: Double);
211
    procedure MoveTo(Position: TAffineVector; Amount: Single); // gak:20041119
212
    procedure DoMove(deltaTime: Double);
213
    procedure DoProgress(const progressTime : TProgressTimes); override;
214
    //Runtime only
215
    property Speed : TAffineVector read FSpeed write FSpeed;
216
    property InGround : Boolean read FInGround;
217
    property MaxRecursionDepth:byte read FMaxRecursionDepth write FMaxRecursionDepth;//gak20041119
218
    property OnCollision : TDCEObjectCollisionEvent read FOnCollision write FOnCollision;
219
  published
220
     
221
    property Active : Boolean read FActive write FActive;
222
    property Manager : TGLDCEManager read FManager write SetManager;
223
    property UseGravity : Boolean read FUseGravity write FUseGravity;
224
    property Layer : Integer read FLayer write FLayer;
225
    property Solid : Boolean read FSolid write FSolid;
226
    property Friction : Single read FFriction write SetFriction;
227
    property BounceFactor : Single read FBounceFactor write SetBounceFactor;
228
    property Size : TGLCoordinates read FSize write SetSize;
229
    property SlideOrBounce:TDCESlideOrBounce read FSlideOrBounce write FSlideOrBounce;//gak20041122
230
  end;
231

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

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

238
implementation
239

240
function RotateVectorByObject(Obj: TGLBaseSceneObject; v: TAffineVector): TAffineVector;
241
var v2: TVector;
242
begin
243
  SetVector(v2,v);
244
  SetVector(result,VectorTransform(v2, Obj.Matrix));
245
end;
246

247
constructor TGLDCEManager.Create(AOwner: TComponent);
248
begin
249
	inherited Create(AOwner);
250
  FStatics:=TList.Create;
251
  FDynamics:=TList.Create;
252
  FGravity:=0;
253
  FWorldDirection:=TGLCoordinates.CreateInitialized(Self, YHmgVector, csVector);
254
  FWorldScale := 1;
255
  FMovimentScale := 1;
256
  FStandardiseLayers := ccsDCEStandard;
257
  FManualStep := False;
258
  RegisterManager(Self);
259
end;
260

261
// Destroy
262
//
263
destructor TGLDCEManager.Destroy;
264
begin
265
	DeRegisterAllStatics;
266
	DeRegisterAllDynamics;
267
  DeRegisterManager(Self);
268
  FStatics.Free;
269
  FDynamics.Free;
270
  FWorldDirection.Free;
271
	inherited Destroy;
272
end;
273

274
function TGLDCEManager.GetDynamicCount: Integer;
275
begin
276
  result := FDynamics.Count;
277
end;
278

279
function TGLDCEManager.GetStaticCount: Integer;
280
begin
281
  result := FStatics.Count;
282
end;
283

284
function TGLDCEManager.MoveByDistance(var Body: TGLDCEDynamic; deltaS, deltaAbsS: TAffineVector): Single;
285
var
286
    //Friction and bounce
287
    TotalFriction, bounce,f,m,restitution: Single;
288
    ContactList: TIntegerList;
289
    //Temporary properties (Static or Dynamic)
290
    tFriction, tBounceFactor: Single;
291
    tObject: TGLBaseSceneObject;
292
    //Collision results
293
    ColInfo: TDCECollision;
294
    lastobj:integer;//gak:20041119
295
    i, oi: Integer;
296
    MP: TECMovePack;
297
    CanCollide,GravCollided: boolean;
298
    //Vars used to calculate high velocities
299
    ColRange,MaxRange: Single;
300
    dCR,dT,deltaCR: Double;
301
begin
302
  //Set collider parameters
303
  MP.Radius := Body.Size.AsAffineVector;
304
  MP.Position := AffineVectorMake(Body.OwnerBaseSceneObject.AbsolutePosition);
305
  MP.Velocity := deltaS;
306
  MP.Gravity := deltaAbsS;
307
  MP.ObjectInfo.Solid := Body.Solid;
308
  MP.UnitScale := FWorldScale;
309
  MP.MaxRecursionDepth := Body.MaxRecursionDepth; //gak://20041119
310
  //Get collision range, if it is too big separate into small pieces
311
  ECSetCollisionRange(MP);
312
  ColRange := MP.CollisionRange;
313
  deltaCR := ColRange;
314
  MaxRange := MaxXYZComponent(MP.Radius)*2.1;
315
  SetLength(MP.Contacts,0);
316
  GravCollided := False; //Is colliding with the ground
317
  Body.FGroundNormal := NullVector;
318
  while deltaCR>0 do begin
319
    if deltaCR>MaxRange then begin
320
      dCR:=MaxRange;
321
      deltaCR:=deltaCR-MaxRange;
322
    end else begin
323
      dCR:=deltaCR;
324
      deltaCR:=0;
325
    end;
326
    dT := dCR / ColRange;
327
    MP.Velocity := VectorScale(deltaS,dT);
328
    MP.Gravity := VectorScale(deltaAbsS, dT);
329

330
    ECSetCollisionRange(MP);
331
    ECResetColliders(MP);
332

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

338
      CanCollide := False;
339
      if (Active) then
340
      case FStandardiseLayers of
341
        ccsDCEStandard: CanCollide := (Layer <= Body.Layer);
342
        ccsCollisionStandard: CanCollide := (layer = 0) or (body.layer = 0) or (layer <> body.layer);
343
        ccsHybrid: CanCollide := ( (layer = 0) or (body.layer = 0) or (Layer <= Body.Layer) ) and (layer>=0) and (body.layer>=0);
344
      end;
345

346
      //Add colliders to move pack
347
      if CanCollide then
348
      begin
349
        case Shape of
350
          csFreeform: ECAddFreeForm(MP,OwnerBaseSceneObject,Solid,i);
351
          csEllipsoid: ECAddEllipsoid(MP,AffineVectorMake(OwnerBaseSceneObject.AbsolutePosition),
352
                        Size.AsAffineVector,Solid,i);
353
          csBox: ECAddBox(MP,OwnerBaseSceneObject,Size.AsAffineVector,Solid,i);
354
          csTerrain: ECAddTerrain(MP,TGLTerrainRenderer(OwnerBaseSceneObject),FWorldScale*2,Solid,i);
355
        end;
356
      end;
357

358
    end;
359

360
    //For each dynamic collider add a static ellipsoid
361
    for i:=0 to FDynamics.Count-1 do
362
    with TGLDCEDynamic(FDynamics[i]) do
363
    begin
364
      CanCollide := False;
365
      if (Active) and (TGLDCEDynamic(FDynamics[i]) <> Body) then
366
      case FStandardiseLayers of
367
        ccsDCEStandard: CanCollide := (Layer <= Body.Layer);
368
        ccsCollisionStandard: CanCollide := (layer = 0) or (body.layer = 0) or (layer <> body.layer);
369
        ccsHybrid: CanCollide := ( (layer = 0) or (body.layer = 0) or (Layer <= Body.Layer) ) and (layer>=0) and (body.layer>=0);
370
      end;
371
      //Add collider to move pack
372
      //To differ from static it is added with a negative ID (id < 0)
373
      if CanCollide then
374
        ECAddEllipsoid(MP,AffineVectorMake(OwnerBaseSceneObject.AbsolutePosition),
375
                        Size.AsAffineVector,Solid,-1-i);
376
    end;
377

378

379
    CollideAndSlide(MP);
380
    if MP.GravityCollided then
381
    begin
382
      GravCollided := True;
383
      Body.FGroundNormal := Mp.GroundNormal;
384
    end;
385
    MP.Position := MP.ResultPos;
386
  end;
387

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

392
  //Generate events and calculate average friction
393
  lastobj := -1;//gak:20041119
394
  TotalFriction := Body.Friction;
395
  ContactList := TIntegerList.Create;
396

397
  try
398
  for i := 0 to High(MP.Contacts) do
399
  with MP do
400
  begin
401
    oi := Contacts[i].ObjectInfo.ObjectID;
402

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

407
    //Check if it is static or dynamic
408
    if oi < 0 then
409
    begin
410
      tFriction := TGLDCEDynamic(FDynamics[abs(oi) - 1]).Friction;
411
      tBounceFactor := TGLDCEDynamic(FDynamics[abs(oi) - 1]).BounceFactor;
412
      tObject := TGLDCEDynamic(FDynamics[abs(oi) - 1]).OwnerBaseSceneObject;
413
    end else
414
    begin
415
      tFriction := TGLDCEStatic(FStatics[oi]).Friction;
416
      tBounceFactor := TGLDCEStatic(FStatics[oi]).BounceFactor;
417
      tObject := TGLDCEStatic(FStatics[oi]).OwnerBaseSceneObject;
418
    end;
419

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

426
    //Calculate bounce
427
    if (Body.SlideOrBounce = csbBounce) and ColInfo.Nearest then
428
    begin
429
      bounce:=VectorDotProduct(Body.FSpeed, ColInfo.Normal);
430
      if bounce<0 then begin
431
        restitution := (Body.BounceFactor + tBounceFactor) / 2;
432
        m := VectorLength(Body.FSpeed);
433
        f := -bounce/VectorNorm(ColInfo.Normal)*(1+restitution);
434
        CombineVector(Body.FSpeed,ColInfo.Normal,f);
435
        //Limit bounce speed
436
        if VectorLength(Body.FSpeed) > m * 2 then
437
           Body.FSpeed := NullVector;
438
      end;
439

440
      bounce:=VectorDotProduct(Body.FAbsSpeed, ColInfo.Normal);
441
      if bounce<0 then begin
442
        restitution := (Body.BounceFactor + tBounceFactor) / 2;
443
        m := VectorLength(Body.FAbsSpeed);
444
        f := -bounce/VectorNorm(ColInfo.Normal)*(1+restitution);
445
        CombineVector(Body.FAbsSpeed,ColInfo.Normal,f);
446
        //Limit
447
        if VectorLength(Body.FAbsSpeed) > m * 2 then
448
          Body.FAbsSpeed := NullVector;
449
      end;
450

451
      bounce:=VectorDotProduct(Body.FGravSpeed, ColInfo.Normal);
452
      if bounce<0 then begin
453
        restitution := (Body.BounceFactor + tBounceFactor) / 2;
454
        m := VectorLength(Body.FGravSpeed);
455
        f := -bounce/VectorNorm(ColInfo.Normal)*(1+restitution);
456
        CombineVector(Body.FGravSpeed,ColInfo.Normal,f);
457
        //Limit
458
        if VectorLength(Body.FGravSpeed) > m * 2 then
459
          Body.FGravSpeed := NullVector;
460
      end;
461

462
    end;
463

464
    //gak:20041119 start
465
    colinfo.RootCollision := (lastobj <> oi);
466
    colInfo.Distance := Contacts[i].Distance;
467
    lastobj := oi;
468
    //gak:20041119 end
469

470
    if Assigned(FOnCollision) then
471
        FOnCollision(Self,Body.OwnerBaseSceneObject,tObject,ColInfo);
472
    if Assigned(Body.FOnCollision) then
473
        Body.FOnCollision(Self,tObject,ColInfo);
474
    if Assigned(Body.FOnCollision) then
475
        Body.FOnCollision(Self,tObject,ColInfo);
476
    //If the collided object is static trigger its event
477
    if (oi >= 0) and Assigned(TGLDCEStatic(FStatics[oi]).FOnCollision) then
478
      TGLDCEStatic(FStatics[oi]).FOnCollision(Self,Body.OwnerBaseSceneObject,ColInfo);
479
    end;
480
  finally
481
    ContactList.Free;
482
  end;
483
  result := TotalFriction;
484
end;
485

486
procedure TGLDCEManager.Step(deltaTime: Double);
487
var i: Integer;
488
begin
489
  if deltaTime > 0.1 then deltaTime := 0.1;
490
  for i := 0 to FDynamics.Count-1 do
491
    with TGLDCEDynamic(FDynamics[i]) do
492
      if Active then DoMove(deltaTime);
493
end;
494

495
procedure TGLDCEManager.SetWorldDirection(const Value: TGLCoordinates);
496
begin
497
  FWorldDirection := Value;
498
  FWorldDirection.Normalize;
499
end;
500

501
procedure TGLDCEManager.SetWorldScale(const Value: Single);
502
begin
503
  if Value = 0 then FWorldScale := 0.001
504
  else if Value < 0 then FWorldScale := abs(Value)
505
  else FWorldScale := Value;
506
end;
507

508
procedure TGLDCEManager.RegisterStatic(aClient : TGLDCEStatic);
509
begin
510
   if Assigned(aClient) then
511
      if FStatics.IndexOf(aClient)<0 then begin
512
         FStatics.Add(aClient);
513
         aClient.FManager:=Self;
514
      end;
515
end;
516

517
procedure TGLDCEManager.DeRegisterStatic(aClient : TGLDCEStatic);
518
begin
519
   if Assigned(aClient) then begin
520
      aClient.FManager:=nil;
521
      FStatics.Remove(aClient);
522
   end;
523
end;
524

525
procedure TGLDCEManager.DeRegisterAllStatics;
526
var
527
   i : Integer;
528
begin
529
   // Fast deregistration
530
   for i:=0 to FStatics.Count-1 do
531
      TGLDCEStatic(FStatics[i]).FManager:=nil;
532
   FStatics.Clear;
533
end;
534

535
//Register Dynamics
536

537
procedure TGLDCEManager.RegisterDynamic(aClient : TGLDCEDynamic);
538
begin
539
   if Assigned(aClient) then
540
      if FDynamics.IndexOf(aClient)<0 then begin
541
         FDynamics.Add(aClient);
542
         aClient.FManager:=Self;
543
      end;
544
end;
545

546
procedure TGLDCEManager.DeRegisterDynamic(aClient : TGLDCEDynamic);
547
begin
548
   if Assigned(aClient) then begin
549
      aClient.FManager:=nil;
550
      FDynamics.Remove(aClient);
551
   end;
552
end;
553

554
procedure TGLDCEManager.DeRegisterAllDynamics;
555
var
556
   i : Integer;
557
begin
558
   // Fast deregistration
559
   for i:=0 to FDynamics.Count-1 do
560
      TGLDCEDynamic(FDynamics[i]).FManager:=nil;
561
   FDynamics.Clear;
562
end;
563

564
{ TGLDCEStatic }
565

566
procedure TGLDCEStatic.Assign(Source: TPersistent);
567
begin
568
   if Source is TGLDCEStatic then begin
569
      Active := TGLDCEStatic(Source).Active;
570
      Manager:=TGLDCEStatic(Source).Manager;
571
      Shape := TGLDCEStatic(Source).Shape;
572
      Layer := TGLDCEStatic(Source).Layer;
573
      Solid := TGLDCEStatic(Source).Solid;
574
      Size.Assign(TGLDCEStatic(Source).Size);
575
      Friction := TGLDCEStatic(Source).Friction;
576
      BounceFactor := TGLDCEStatic(Source).BounceFactor;
577
   end;
578
   inherited Assign(Source);
579
end;
580

581
constructor TGLDCEStatic.Create(aOwner: TGLXCollection);
582
begin
583
   inherited Create(aOwner);
584
   FActive := True;
585
   FSize:=TGLCoordinates.CreateInitialized(Self, XYZHmgVector, csVector);
586
   FShape := csEllipsoid;
587
   FSolid := True;
588
   FFriction := 1;
589
   FBounceFactor := 0;
590
end;
591

592
destructor TGLDCEStatic.Destroy;
593
begin
594
   Manager:=nil;
595
   FSize.Free;
596
   inherited Destroy;
597
end;
598

599
class function TGLDCEStatic.FriendlyDescription: String;
600
begin
601
   Result:='Static Collision-detection registration';
602
end;
603

604
class function TGLDCEStatic.FriendlyName: String;
605
begin
606
   Result:='DCE Static Collider';
607
end;
608

609
procedure TGLDCEStatic.Loaded;
610
var
611
   mng : TComponent;
612
begin
613
   inherited;
614
   if FManagerName<>'' then begin
615
      mng:=FindManager(TGLDCEManager, FManagerName);
616
      if Assigned(mng) then
617
         Manager:=TGLDCEManager(mng);
618
      FManagerName:='';
619
   end;
620
end;
621

622
procedure TGLDCEStatic.WriteToFiler(writer: TWriter);
623
begin
624
   with writer do begin
625
      // ArchiveVersion 1, added inherited call
626
      WriteInteger(1);
627
      inherited;
628
      if Assigned(FManager) then
629
         WriteString(FManager.GetNamePath)
630
      else WriteString('');
631
      WriteInteger(Integer(FShape));
632
      WriteInteger(FLayer);
633
      WriteBoolean(FSolid);
634
      WriteBoolean(FActive);
635
      WriteSingle(FFriction);
636
      WriteSingle(FBounceFactor);
637
      FSize.WriteToFiler(writer);
638
   end;
639
end;
640

641
procedure TGLDCEStatic.ReadFromFiler(reader: TReader);
642
var
643
   archiveVersion : Integer;
644
begin
645
   with reader do begin
646
      archiveVersion:=ReadInteger;
647
      Assert(archiveVersion in [0..1]);
648
      if archiveVersion >=1 then
649
        inherited;
650
      FManagerName:=ReadString;
651
      Manager:=nil;
652
      FShape := TDCEShape(ReadInteger);
653
      FLayer := ReadInteger;
654
      FSolid := ReadBoolean;
655
      FActive := ReadBoolean;
656
      FFriction := ReadSingle;
657
      FBounceFactor := ReadSingle;
658
      FSize.ReadFromFiler(reader);
659
   end;
660
end;
661

662
procedure TGLDCEStatic.SetBounceFactor(const Value: Single);
663
begin
664
  FBounceFactor := Value;
665
  if FBounceFactor < 0 then FBounceFactor := 0;
666
  if FBounceFactor > 1 then FBounceFactor := 1;
667
end;
668

669
procedure TGLDCEStatic.SetFriction(const Value: Single);
670
begin
671
  FFriction := Value;
672
  if FFriction < 0 then FFriction := 0;
673
  if FFriction > 100 then FFriction := 100;
674
end;
675

676
procedure TGLDCEStatic.SetManager(const val: TGLDCEManager);
677
begin
678
   if val<>FManager then begin
679
      if Assigned(FManager) then
680
         FManager.DeRegisterStatic(Self);
681
      if Assigned(val) then
682
         val.RegisterStatic(Self);
683
   end;
684
end;
685

686
procedure TGLDCEStatic.SetShape(const Value: TDCEShape);
687
begin
688
  FShape := Value;
689
end;
690

691
procedure TGLDCEStatic.SetSize(const Value: TGLCoordinates);
692
begin
693
  FSize.Assign(Value);
694
  if FSize.X <= 0 then FSize.X := 0.1;
695
  if FSize.Y <= 0 then FSize.Y := 0.1;
696
  if FSize.Z <= 0 then FSize.Z := 0.1;
697
end;
698

699
{ TGLDCEDynamic }
700

701
procedure TGLDCEDynamic.ApplyAccel(NewAccel: TAffineVector);
702
begin
703
  AddVector(FAccel, NewAccel);
704
end;
705

706
procedure TGLDCEDynamic.ApplyAccel(x,y,z: Single);
707
begin
708
  AddVector(FAccel, AffineVectorMake(x,y,z));
709
end;
710

711
procedure TGLDCEDynamic.ApplyAbsAccel(NewAccel: TAffineVector);
712
begin
713
  AddVector(FAbsAccel, NewAccel);
714
end;
715

716
procedure TGLDCEDynamic.ApplyAbsAccel(x,y,z: Single);
717
begin
718
  AddVector(FAbsAccel, AffineVectorMake(x,y,z));
719
end;
720

721
procedure TGLDCEDynamic.StopAccel;
722
begin
723
  SetVector(FAccel, NullVector);
724
end;
725

726
procedure TGLDCEDynamic.StopAbsAccel;
727
begin
728
  SetVector(FAbsAccel, NullVector);
729
end;
730

731
procedure TGLDCEDynamic.Assign(Source: TPersistent);
732
begin
733
  if Source is TGLDCEDynamic then begin
734
    Manager:=TGLDCEDynamic(Source).Manager;
735
    Active := TGLDCEDynamic(Source).Active;
736
    UseGravity := TGLDCEDynamic(Source).UseGravity;
737
    Layer := TGLDCEDynamic(Source).Layer;
738
    Solid := TGLDCEDynamic(Source).Solid;
739
    Size.Assign(TGLDCEDynamic(Source).Size);
740
    Friction := TGLDCEDynamic(Source).Friction;
741
    BounceFactor := TGLDCEDynamic(Source).BounceFactor;
742
    SlideOrBounce := TGLDCEDynamic(Source).SlideOrBounce;
743
    MaxRecursionDepth := TGLDCEDynamic(Source).MaxRecursionDepth;
744
  end;
745
  inherited Assign(Source);
746
end;
747

748
constructor TGLDCEDynamic.Create(aOwner: TGLXCollection);
749
begin
750
  inherited Create(aOwner);
751
  FActive := True;
752
  FUseGravity := True;
753
  FSize:=TGLCoordinates.CreateInitialized(Self, XYZHmgVector, csVector);
754
  FSolid := True;
755
  FFriction := 1;
756
  FBounceFactor := 0;
757
  FMaxRecursionDepth := 5;  //gak:20041119
758
  FSlideOrBounce := csbSlide; // gak:20041122
759
  FInGround := False;
760

761
  FAccel := NullVector;
762
  FAbsAccel := NullVector;
763
  FSpeed := NullVector;
764
  FAbsSpeed := NullVector;
765
  FGravSpeed := NullVector;
766
end;
767

768
destructor TGLDCEDynamic.Destroy;
769
begin
770
  Manager:=nil;
771
  FSize.Free;
772
  inherited Destroy;
773
end;
774

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

779
    procedure Accel(var aSpeed: TAffineVector; aFric: Single; aForce: TAffineVector);
780
    begin
781
      ScaleVector(aForce, deltaTime);
782
      ScaleVector(aSpeed, aFric);
783
      aSpeed := VectorAdd(aForce, aSpeed);
784
    end;
785

786
begin
787

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

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

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

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

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

808
  FAbsSpeed[0] := deltaTime * FAbsAccel[0] + fGround * FAbsSpeed[0];
809
  FAbsSpeed[1] := deltaTime * FAbsAccel[1] + fGround * FAbsSpeed[1];
810
  FAbsSpeed[2] := deltaTime * FAbsAccel[2] + fGround * FAbsSpeed[2];}
811

812
  if FUseGravity then
813
  begin
814
    //Calculate gravity acceleration
815

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

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

823
    Accel(FGravSpeed, fAir, v);
824
    {FGravSpeed[0] := deltaTime * v[0] + fAir * FGravSpeed[0];
825
    FGravSpeed[1] := deltaTime * v[1] + fAir * FGravSpeed[1];
826
    FGravSpeed[2] := deltaTime * v[2] + fAir * FGravSpeed[2];}
827
  end else
828
    FGravSpeed := NullVector;
829

830
  if FJumping then
831
  begin
832
    FJumpSpeed := FJumpForce;
833
    FJumpHeight := FJumpHeight - (FJumpSpeed * deltaTime);
834
    FJumping := FJumpHeight > 0;
835
    if FJumping then FGravSpeed := NullVector
836
    else begin
837
      v := VectorScale(FManager.WorldDirection.AsAffineVector,FJumpSpeed);
838
      AddVector(FGravSpeed, v);
839
      FJumpForce := 0;
840
      FJumpSpeed := 0;
841
    end;
842
  end;
843
  //s = s0 + vt (add relative speed)
844
  if FSlideOrBounce = csbBounce then
845
    deltaS := FSpeed
846
  else
847
    deltaS := RotateVectorByObject(OwnerBaseSceneObject, FSpeed);
848
  //Add absolute speed
849
  AddVector(deltaS, FAbsSpeed);
850
  //Add jump speed
851
  v := VectorScale(FManager.WorldDirection.AsAffineVector,FJumpSpeed);
852
  AddVector(deltaS, v);
853
  //The absolute space must be only the gravity so it can calculate when it is in the ground
854
  deltaAbsS := FGravSpeed;
855

856
  ScaleVector(deltaS,deltaTime);
857
  ScaleVector(deltaAbsS,deltaTime);
858

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

862
  FAccel := NullVector;
863
  FAbsAccel := NullVector;
864
end;
865

866
procedure TGLDCEDynamic.DoProgress(const progressTime: TProgressTimes);
867
begin
868
  inherited doProgress(progressTime);
869
  assert(assigned(manager), 'DCE Manager not assigned to behaviour.');
870

871
  if (not FManager.ManualStep) and FActive then
872
  begin
873
    if progressTime.deltaTime > 0.1 then DoMove(0.1)
874
    else DoMove(progressTime.deltaTime);
875
  end;
876
end;
877

878
class function TGLDCEDynamic.FriendlyDescription: String;
879
begin
880
  Result:='Dynamic Collision-detection registration';
881
end;
882

883
class function TGLDCEDynamic.FriendlyName: String;
884
begin
885
  Result:='DCE Dynamic Collider';
886
end;
887

888
procedure TGLDCEDynamic.Jump(jHeight, jSpeed: Single);
889
begin
890
  if (not FJumping) and (FInGround)
891
  and (VectorDotProduct(FGroundNormal,FManager.WorldDirection.AsAffineVector) > 0.5) then
892
  begin
893
    FJumpHeight := jHeight;
894
    FJumpForce := jSpeed;
895
    FJumpSpeed := FJumpForce;
896
    FJumping := True;
897
    FInGround := False;
898
    AddVector(FAbsSpeed, RotateVectorByObject(OwnerBaseSceneObject, FSpeed));
899
    FSpeed := NullVector;
900
  end;
901
end;
902

903
procedure TGLDCEDynamic.Loaded;
904
var
905
   mng : TComponent;
906
begin
907
   inherited;
908
   if FManagerName<>'' then begin
909
      mng:=FindManager(TGLDCEManager, FManagerName);
910
      if Assigned(mng) then
911
         Manager:=TGLDCEManager(mng);
912
      FManagerName:='';
913
   end;
914
end;
915

916
procedure TGLDCEDynamic.Move(deltaS: TAffineVector; deltaTime: Double);
917
begin
918
  ScaleVector(deltaS, deltaTime);
919
  FManager.MoveByDistance(Self, NullVector, deltaS);
920
end;
921

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

926
  Move(position,Amount);
927
end;
928

929
procedure TGLDCEDynamic.WriteToFiler(writer: TWriter);
930
begin
931
   with writer do begin
932
      // ArchiveVersion 1, added inherited call
933
      WriteInteger(1);
934
      inherited;
935
      if Assigned(FManager) then
936
         WriteString(FManager.GetNamePath)
937
      else WriteString('');
938
      WriteInteger(FLayer);
939
      WriteBoolean(FSolid);
940
      WriteBoolean(FActive);
941
      WriteBoolean(FUseGravity);
942
      WriteSingle(FFriction);
943
      WriteSingle(FBounceFactor);
944
      //gak:20041122 - start
945
      writeinteger(FMaxRecursionDepth);
946
      writeinteger(ord(FSlideOrBounce));
947
      //gak:20041122 - end
948
      FSize.WriteToFiler(writer);
949
   end;
950
end;
951

952
procedure TGLDCEDynamic.ReadFromFiler(reader: TReader);
953
var
954
   archiveVersion : Integer;
955
begin
956
   with reader do begin
957
      archiveVersion:=ReadInteger;
958
      Assert(archiveVersion in [0..1]);
959
      if archiveVersion >=1 then
960
        inherited;
961
      FManagerName:=ReadString;
962
      Manager:=nil;
963
      FLayer := ReadInteger;
964
      FSolid := ReadBoolean;
965
      FActive := ReadBoolean;
966
      FUseGravity := ReadBoolean;
967
      FFriction := ReadSingle;
968
      FBounceFactor := ReadSingle;
969
      //gak:20041122 - start
970
      FMaxRecursionDepth := readinteger;
971
      FSlideOrBounce := TDCESlideOrBounce(readinteger);
972
      //gak:20041122 - end
973
      FSize.ReadFromFiler(reader);
974
   end;
975
end;
976

977
procedure TGLDCEDynamic.SetBounceFactor(const Value: Single);
978
begin
979
  FBounceFactor := Value;
980
  if FBounceFactor < 0 then FBounceFactor := 0;
981
  if FBounceFactor > 1 then FBounceFactor := 1;
982
end;
983

984
procedure TGLDCEDynamic.SetFriction(const Value: Single);
985
begin
986
  FFriction := Value;
987
  if FFriction < 0 then FFriction := 0;
988
  if FFriction > 100 then FFriction := 100;
989
end;
990

991
procedure TGLDCEDynamic.SetManager(const val: TGLDCEManager);
992
begin
993
   if val<>FManager then begin
994
      if Assigned(FManager) then
995
         FManager.DeRegisterDynamic(Self);
996
      if Assigned(val) then
997
         val.RegisterDynamic(Self);
998
   end;
999
end;
1000

1001
procedure TGLDCEDynamic.SetSize(const Value: TGLCoordinates);
1002
begin
1003
  FSize.Assign(Value);
1004
  if FSize.X <= 0 then FSize.X := 0.1;
1005
  if FSize.Y <= 0 then FSize.Y := 0.1;
1006
  if FSize.Z <= 0 then FSize.Z := 0.1;
1007
end;
1008

1009
// ----------------------------------------------------------------
1010

1011
function GetOrCreateDCEStatic(behaviours : TGLBehaviours) : TGLDCEStatic;
1012
var
1013
	i : Integer;
1014
begin
1015
	i:=behaviours.IndexOfClass(TGLDCEStatic);
1016
	if i>=0 then
1017
		Result:=TGLDCEStatic(behaviours[i])
1018
	else Result:=TGLDCEStatic.Create(behaviours);
1019
end;
1020

1021
function GetOrCreateDCEStatic(obj : TGLBaseSceneObject) : TGLDCEStatic;
1022
begin
1023
	Result:=GetOrCreateDCEStatic(obj.Behaviours);
1024
end;
1025

1026
function GetOrCreateDCEDynamic(behaviours : TGLBehaviours) : TGLDCEDynamic;
1027
var
1028
	i : Integer;
1029
begin
1030
	i:=behaviours.IndexOfClass(TGLDCEDynamic);
1031
	if i>=0 then
1032
		Result:=TGLDCEDynamic(behaviours[i])
1033
	else Result:=TGLDCEDynamic.Create(behaviours);
1034
end;
1035

1036
function GetOrCreateDCEDynamic(obj : TGLBaseSceneObject) : TGLDCEDynamic;
1037
begin
1038
	Result:=GetOrCreateDCEDynamic(obj.Behaviours);
1039
end;
1040

1041

1042
initialization
1043

1044
// ------------------------------------------------------------------
1045

1046
	// class registrations
1047
	RegisterXCollectionItemClass(TGLDCEStatic);
1048
	RegisterXCollectionItemClass(TGLDCEDynamic);
1049

1050
finalization
1051

1052
	UnregisterXCollectionItemClass(TGLDCEStatic);
1053
	UnregisterXCollectionItemClass(TGLDCEDynamic);
1054

1055
end.
1056