LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
  Custom ODE collider implementations.
6

7
   Credits :  
8
      Heightfield collider code originally adapted from Mattias Fagerlund's
9
         DelphiODE terrain collision demo.
10
         Website: http://www.cambrianlabs.com/Mattias/DelphiODE
11
   
12

13
   History :  
14
     19/06/14 - PW - Changed some types from Single to TdReal to permit ODE be double based in ODEImport.pas
15
     10/11/12 - PW - Added CPP compatibility: restored records with arrays instead of vector arrays
16
     23/08/10 - Yar - Added OpenGLTokens to uses, replaced OpenGL1x functions to OpenGLAdapter
17
     22/04/10 - Yar - Fixes after GLState revision
18
     05/03/10 - DanB - More state added to TGLStateCache
19
     17/11/09 - DaStr - Improved Unix compatibility
20
                           (thanks Predator) (BugtrackerID = 2893580)
21
     08/11/09 - DaStr - Improved FPC compatibility
22
                            (thanks Predator) (BugtrackerID = 2893580)
23
     12/04/08 - DaStr - Cleaned up uses section
24
                            (thanks Sandor Domokos) (BugtrackerID = 1808373)
25
     06/02/08 - Mrqzzz - Upgrade to ODE 0.9 (by Paul Robello)
26
                            Fixed reference to odeimport
27
     25/12/07 - DaStr  - Fixed memory leak in TGLODECustomCollider.Destroy()
28
                             (thanks Sandor Domokos) (BugtrackerID = 1808373)
29
     10/10/07 - Mrqzzz - Fixed reference ODEGL.ODERToGLSceneMatrix
30
     07/10/07 - Mrqzzz - Added reference to ODEGL
31
     11/09/07 - Mrqzzz - Added reference to ODEImport
32
     07/06/07 - DaStr - Added GLColor to uses (BugtrackerID = 1732211)
33
                           Added $I GLScene.inc
34
     08/12/04 - SG - Added contact point rendering to TGLODECustomCollider.
35
     07/12/04 - SG - Added new TGLODECustomCollider class,
36
                        Geom collide code now uses Resolution to determine the
37
                        number of contact points to generate.
38
     19/11/04 - SG - Changed TGLODETerrainCollider to TGLODEHeightField
39
                        which now inherits from TGLODEBehaviour and works for
40
                        both TGLTerrainRenderer and TGLHeightField objects.
41
                        Added Capsule, Cylinder and Cone collider code for
42
                        the heightfield collider.
43
     23/04/04 - SG - Removed freeform static collider
44
     29/10/03 - SG - Fix for GLODETerrainCollider (Matheus Degiovani)
45
     30/07/03 - SG - Creation.
46
   
47
}
48
unit GLODECustomColliders;
49

50
interface
51

52
{$I GLScene.inc}
53

54
uses
55
  Classes,
56
  SysUtils,
57
   cene
58
  GLODEManager,
59
  ODEGL,
60
  ODEImport,
61
  GLVectorGeometry,
62
  GLVectorLists,
63
  GLScene,
64
  GLTerrainRenderer,
65
  GLGraph,
66
  GLXCollection,
67
  OpenGLTokens,
68
  GLContext,
69
  GLTexture,
70
  GLColor,
71
  GLRenderContextInfo,
72
  GLState;
73

74
type
75
  TContactPoint = class
76
  public
77
    Position,
78
      Normal: TAffineVector;
79
    Depth: Single;
80
  end;
81

82
  // TGLODECustomCollider
83
  //
84
  { The custom collider is designed for generic contact handling. There is a
85
     contact point generator for sphere, box, capped cylinder, cylinder and
86
     cone geoms.
87

88
     Once the contact points for a collision are generated the abstract Collide
89
     function is called to generate the depth and the contact position and
90
     normal. These points are then sorted and the deepest are applied to ODE. }
91
  TGLODECustomCollider = class(TGLODEBehaviour)
92
  private
93
     
94
    FGeom: PdxGeom;
95
    FContactList,
96
      FContactCache: TList;
97
    FTransform: TMatrix;
98
    FContactResolution: Single;
99

100
    FRenderContacts: Boolean;
101
    FContactRenderPoints: TAffineVectorList;
102
    FPointSize: Single;
103
    FContactColor: TGLColor;
104

105
  protected
106
     
107
    procedure Initialize; override;
108
    procedure Finalize; override;
109

110
    procedure WriteToFiler(writer: TWriter); override;
111
    procedure ReadFromFiler(reader: TReader); override;
112

113
    // Test a position for a collision and fill out the contact information.
114
    function Collide(aPos: TAffineVector; var Depth: Single;
115
      var cPos, cNorm: TAffineVector): Boolean; virtual; abstract;
116

117
    // Clears the contact list so it's ready for another collision.
118
    procedure ClearContacts;
119

120
    // Add a contact point to the list for ApplyContacts to processes.
121
    procedure AddContact(x, y, z: TdReal); overload;
122
    procedure AddContact(pos: TAffineVector); overload;
123

124
    // Sort the current contact list and apply the deepest to ODE.
125
    function ApplyContacts(o1, o2: PdxGeom; flags: Integer;
126
      contact: PdContactGeom; skip: Integer): Integer;
127

128
    { Set the transform used that transforms contact points generated with
129
       AddContact. }
130
    procedure SetTransform(ATransform: TMatrix);
131

132
    procedure SetContactResolution(const Value: Single);
133
    procedure SetRenderContacts(const Value: Boolean);
134
    procedure SetPointSize(const Value: Single);
135
    procedure SetContactColor(const Value: TGLColor);
136

137
  public
138
     
139
    constructor Create(AOwner: TGLXCollection); override;
140
    destructor Destroy; override;
141

142
    procedure Render(var rci: TGLRenderContextInfo); override;
143

144
    property Geom: PdxGeom read FGeom;
145

146
  published
147
    { Defines the resolution of the contact points created for the colliding
148
       Geom. The number of contact points generated change base don the size
149
       of the object and the ContactResolution. Lower values generate higher
150
       resolution contact boundaries, and thus smoother but slower collisions. }
151
    property ContactResolution: Single read FContactResolution write SetContactResolution;
152
    { Toggle contact point rendering on and off. (Rendered through the assigned
153
       Manager.RenderPoint. }
154
    property RenderContacts: Boolean read FRenderContacts write SetRenderContacts;
155
    // Contact point rendering size (in pixels).
156
    property PointSize: Single read FPointSize write SetPointSize;
157
    // Contact point rendering color.
158
    property ContactColor: TGLColor read FContactColor write SetContactColor;
159

160
  end;
161

162
  // TGLODEHeightField
163
  //
164
  { Add this behaviour to a TGLHeightField or TGLTerrainRenderer to enable
165
     height based collisions for spheres, boxes, capped cylinders, cylinders
166
     and cones. }
167
  TGLODEHeightField = class(TGLODECustomCollider)
168
  protected
169
     
170
    procedure WriteToFiler(writer: TWriter); override;
171
    procedure ReadFromFiler(reader: TReader); override;
172

173
    function Collide(aPos: TAffineVector; var Depth: Single;
174
      var cPos, cNorm: TAffineVector): Boolean; override;
175

176
  public
177
     
178
    constructor Create(AOwner: TGLXCollection); override;
179

180
    class function FriendlyName: string; override;
181
    class function FriendlyDescription: string; override;
182
    class function UniqueItem: Boolean; override;
183
    class function CanAddTo(collection: TGLXCollection): Boolean; override;
184

185
  end;
186

187
function GetODEHeightField(obj: TGLBaseSceneObject): TGLODEHeightField;
188
function GetOrCreateODEHeightField(obj: TGLBaseSceneObject): TGLODEHeightField;
189

190
implementation
191

192
var
193
  vCustomColliderClass: TdGeomClass;
194
  vCustomColliderClassNum: Integer;
195

196
  // GetODEHeightField
197
  //
198

199
function GetODEHeightField(obj: TGLBaseSceneObject): TGLODEHeightField;
200
begin
201
  result := TGLODEHeightField(obj.Behaviours.GetByClass(TGLODEHeightField));
202
end;
203

204
// GetOrCreateODEHeightField
205
//
206

207
function GetOrCreateODEHeightField(obj: TGLBaseSceneObject): TGLODEHeightField;
208
begin
209
  result := TGLODEHeightField(obj.GetOrCreateBehaviour(TGLODEHeightField));
210
end;
211

212
// GetColliderFromGeom
213
//
214

215
function GetColliderFromGeom(aGeom: PdxGeom): TGLODECustomCollider;
216
var
217
  temp: TObject;
218
begin
219
  Result := nil;
220
  temp := dGeomGetData(aGeom);
221
  if Assigned(temp) then
222
    if temp is TGLODECustomCollider then
223
      Result := TGLODECustomCollider(temp);
224
end;
225

226
// ContactSort
227
//
228

229
function ContactSort(Item1, Item2: Pointer): Integer;
230
var
231
  c1, c2: TContactPoint;
232
begin
233
  c1 := TContactPoint(Item1);
234
  c2 := TContactPoint(Item2);
235
  if c1.Depth > c2.Depth then
236
    result := -1
237
  else if c1.Depth = c2.Depth then
238
    result := 0
239
  else
240
    result := 1;
241
end;
242

243
// CollideSphere
244
//
245

246
function CollideSphere(o1, o2: PdxGeom; flags: Integer;
247
  contact: PdContactGeom; skip: Integer): Integer; cdecl;
248
var
249
  Collider: TGLODECustomCollider;
250
  i, j, res: Integer;
251
  pos: PdVector3;
252
  R: PdMatrix3;
253
  rmat, mat: TMatrix;
254
  rad, dx, dy, dz: TdReal;
255
begin
256
  Result := 0;
257
  Collider := GetColliderFromGeom(o1);
258
  if not Assigned(Collider) then
259
    exit;
260

261
  pos := dGeomGetPosition(o2);
262
  R := dGeomGetRotation(o2);
263
  ODEGL.ODERToGLSceneMatrix(mat, R^, pos^);
264
  Collider.SetTransform(mat);
265

266
  rad := dGeomSphereGetRadius(o2);
267

268
  res := Round(10 * rad / Collider.ContactResolution);
269
  if res < 8 then
270
    res := 8;
271

272
  Collider.AddContact(0, 0, -rad);
273
  Collider.AddContact(0, 0, rad);
274
  rmat := CreateRotationMatrixZ(2 * Pi / res);
275
  for i := 0 to res - 1 do
276
  begin
277
    mat := MatrixMultiply(rmat, mat);
278
    Collider.SetTransform(mat);
279
    for j := -(res div 2) + 1 to (res div 2) - 1 do
280
    begin
281
      dx := rad * cos(j * Pi / res);
282
      dy := 0;
283
      dz := rad * sin(j * Pi / res);
284
      Collider.AddContact(dx, dy, dz);
285
    end;
286
  end;
287

288
  Result := Collider.ApplyContacts(o1, o2, flags, contact, skip);
289
  Collider.SetTransform(IdentityHMGMatrix);
290
end;
291

292
// CollideBox
293
//
294

295
function CollideBox(o1, o2: PdxGeom; flags: Integer;
296
  contact: PdContactGeom; skip: Integer): Integer; cdecl;
297
var
298
  Collider: TGLODECustomCollider;
299
  i, j, res: Integer;
300
  rcpres, len1, len2: Single;
301
  s: TdVector3;
302
  pos: PdVector3;
303
  R: PdMatrix3;
304
  mat: TMatrix;
305
begin
306
  Result := 0;
307
  Collider := GetColliderFromGeom(o1);
308
  if not Assigned(Collider) then
309
    exit;
310

311
  pos := dGeomGetPosition(o2);
312
  R := dGeomGetRotation(o2);
313
  ODEGL.ODERToGLSceneMatrix(mat, R^, pos^);
314
  Collider.SetTransform(mat);
315

316
  dGeomBoxGetLengths(o2, s);
317

318
  res := Round(Sqrt(MaxFloat([s[0], s[1], s[2]])) / Collider.ContactResolution);
319
  if res < 1 then
320
    res := 1;
321
  rcpres := 1 / res;
322

323
  s[0] := 0.5 * s[0];
324
  s[1] := 0.5 * s[1];
325
  s[2] := 0.5 * s[2];
326

327
  with Collider do
328
  begin
329
    // Corners
330
    AddContact(s[0], s[1], s[2]);
331
    AddContact(s[0], s[1], -s[2]);
332
    AddContact(s[0], -s[1], s[2]);
333
    AddContact(s[0], -s[1], -s[2]);
334
    AddContact(-s[0], s[1], s[2]);
335
    AddContact(-s[0], s[1], -s[2]);
336
    AddContact(-s[0], -s[1], s[2]);
337
    AddContact(-s[0], -s[1], -s[2]);
338

339
    // Edges
340
    for i := -(res - 1) to (res - 1) do
341
    begin
342
      len1 := i * rcpres * s[0];
343
      AddContact(len1, s[1], s[2]);
344
      AddContact(len1, s[1], -s[2]);
345
      AddContact(len1, -s[1], s[2]);
346
      AddContact(len1, -s[1], -s[2]);
347
      len1 := i * rcpres * s[1];
348
      AddContact(s[0], len1, s[2]);
349
      AddContact(s[0], len1, -s[2]);
350
      AddContact(-s[0], len1, s[2]);
351
      AddContact(-s[0], len1, -s[2]);
352
      len1 := i * rcpres * s[2];
353
      AddContact(s[0], s[1], len1);
354
      AddContact(s[0], -s[1], len1);
355
      AddContact(-s[0], s[1], len1);
356
      AddContact(-s[0], -s[1], len1);
357
    end;
358

359
    // Faces
360
    for i := -(res - 1) to (res - 1) do
361
      for j := -(res - 1) to (res - 1) do
362
      begin
363
        len1 := i * rcpres * s[0];
364
        len2 := j * rcpres * s[1];
365
        AddContact(len1, len2, s[2]);
366
        AddContact(len1, len2, -s[2]);
367
        len2 := j * rcpres * s[2];
368
        AddContact(len1, s[1], len2);
369
        AddContact(len1, -s[1], len2);
370
        len1 := i * rcpres * s[1];
371
        AddContact(s[0], len1, len2);
372
        AddContact(-s[0], len1, len2);
373
      end;
374
  end;
375

376
  Result := Collider.ApplyContacts(o1, o2, flags, contact, skip);
377
  Collider.SetTransform(IdentityHMGMatrix);
378
end;
379

380
// CollideCapsule
381
//
382

383
function CollideCapsule(o1, o2: PdxGeom; flags: Integer;
384
  contact: PdContactGeom; skip: Integer): Integer; cdecl;
385
var
386
  Collider: TGLODECustomCollider;
387
  i, j, res: Integer;
388
  pos: PdVector3;
389
  R: PdMatrix3;
390
  mat, rmat: TMatrix;
391
  rad, len, dx, dy, dz: TdReal;
392
begin
393
  Result := 0;
394

395
  Collider := GetColliderFromGeom(o1);
396
  if not Assigned(Collider) then
397
    exit;
398

399
  pos := dGeomGetPosition(o2);
400
  R := dGeomGetRotation(o2);
401
  ODEGL.ODERToGLSceneMatrix(mat, R^, pos^);
402
  Collider.SetTransform(mat);
403

404
  dGeomCapsuleGetParams(o2, rad, len);
405

406
  res := Round(5 * MaxFloat(4 * rad, len) / Collider.ContactResolution);
407
  if res < 8 then
408
    res := 8;
409

410
  rmat := CreateRotationMatrixZ(2 * Pi / res);
411
  with Collider do
412
  begin
413
    AddContact(0, 0, -rad - 0.5 * len);
414
    AddContact(0, 0, rad + 0.5 * len);
415
    for i := 0 to res - 1 do
416
    begin
417
      mat := MatrixMultiply(rmat, mat);
418
      SetTransform(mat);
419

420
      for j := 0 to res do
421
        AddContact(rad, 0, len * (j / res - 0.5));
422

423
      for j := 1 to (res div 2) - 1 do
424
      begin
425
        dx := rad * cos(j * Pi / res);
426
        dy := 0;
427
        dz := rad * sin(j * Pi / res);
428
        Collider.AddContact(dx, dy, -dz - 0.5 * len);
429
        Collider.AddContact(dx, dy, dz + 0.5 * len);
430
      end;
431
    end;
432
  end;
433

434
  Result := Collider.ApplyContacts(o1, o2, flags, contact, skip);
435
  Collider.SetTransform(IdentityHMGMatrix);
436
end;
437

438
// CollideCylinder
439
//
440

441
function CollideCylinder(o1, o2: PdxGeom; flags: Integer;
442
  contact: PdContactGeom; skip: Integer): Integer; cdecl;
443
var
444
  Collider: TGLODECustomCollider;
445
  i, j, res: Integer;
446
  pos: PdVector3;
447
  R: PdMatrix3;
448
  mat: TMatrix;
449
  rad, len, dx, dy: TdReal;
450
begin
451
  Result := 0;
452

453
  Collider := GetColliderFromGeom(o1);
454
  if not Assigned(Collider) then
455
    exit;
456

457
  pos := dGeomGetPosition(o2);
458
  R := dGeomGetRotation(o2);
459
  ODEGL.ODERToGLSceneMatrix(mat, R^, pos^);
460
  Collider.SetTransform(mat);
461

462
  dGeomCylinderGetParams(o2, rad, len);
463

464
  res := Round(5 * MaxFloat(4 * rad, len) / Collider.ContactResolution);
465
  if res < 8 then
466
    res := 8;
467

468
  with Collider do
469
  begin
470
    AddContact(0, -0.5 * len, 0);
471
    AddContact(0, 0.5 * len, 0);
472
    for i := 0 to res - 1 do
473
    begin
474
      SinCos(2 * Pi * i / res, rad, dy, dx);
475
      AddContact(dx, -0.5 * len, dy);
476
      AddContact(dx, 0, dy);
477
      AddContact(dx, 0.5 * len, dy);
478

479
      for j := 0 to res do
480
        AddContact(dx, len * (j / res - 0.5), dy);
481

482
      for j := 1 to (res div 2) - 1 do
483
      begin
484
        SinCos(2 * Pi * i / res, rad * j / (res div 2), dy, dx);
485
        AddContact(dx, -0.5 * len, dy);
486
        AddContact(dx, 0.5 * len, dy);
487
      end;
488
    end;
489
  end;
490

491
  Result := Collider.ApplyContacts(o1, o2, flags, contact, skip);
492
  Collider.SetTransform(IdentityHMGMatrix);
493
end;
494

495
// GetCustomColliderFn
496
//
497

498
function GetCustomColliderFn(num: Integer): TdColliderFn; cdecl;
499
begin
500
  if num = dSphereClass then
501
    Result := CollideSphere
502
  else if num = dBoxClass then
503
    Result := CollideBox
504
  else if num = dCapsuleClass then
505
    Result := CollideCapsule
506
  else if num = dCylinderClass then
507
    Result := CollideCylinder
508
  else
509
    Result := nil;
510
end;
511

512
// ---------------
513
// --------------- TGLODECustomCollider --------------
514
// ---------------
515

516
// Create
517
//
518

519
constructor TGLODECustomCollider.Create(AOwner: TGLXCollection);
520
begin
521
  inherited;
522

523
  FContactList := TList.Create;
524
  FContactCache := TList.Create;
525

526
  FContactResolution := 1;
527

528
  FRenderContacts := False;
529
  FContactRenderPoints := TAffineVectorList.Create;
530
  FContactColor := TGLColor.CreateInitialized(Self, clrRed, NotifyChange);
531
  FPointSize := 3;
532
end;
533

534
// Destroy
535
//
536

537
destructor TGLODECustomCollider.Destroy;
538
var
539
  i: integer;
540
begin
541
  FContactList.Free;
542
  for i := 0 to FContactCache.Count - 1 do
543
    TContactPoint(FContactCache[i]).Free;
544
  FContactCache.Free;
545
  FContactRenderPoints.Free;
546
  FContactColor.Free;
547
  inherited;
548
end;
549

550
// Initialize
551
//
552

553
procedure TGLODECustomCollider.Initialize;
554
begin
555
  if not Assigned(Manager) then
556
    exit;
557
  if not Assigned(Manager.Space) then
558
    exit;
559
  if vCustomColliderClassNum = 0 then
560
  begin
561
    with vCustomColliderClass do
562
    begin
563
      bytes := 0;
564
      collider := GetCustomColliderFn;
565
      aabb := dInfiniteAABB;
566
      aabb_test := nil;
567
      dtor := nil;
568
    end;
569
    vCustomColliderClassNum := dCreateGeomClass(vCustomColliderClass);
570
  end;
571
  FGeom := dCreateGeom(vCustomColliderClassNum);
572
  dGeomSetData(FGeom, Self);
573
  dSpaceAdd(Manager.Space, FGeom);
574
  inherited;
575
end;
576

577
// Finalize
578
//
579

580
procedure TGLODECustomCollider.Finalize;
581
begin
582
  if not Initialized then
583
    exit;
584
  if Assigned(FGeom) then
585
  begin
586
    dGeomDestroy(FGeom);
587
    FGeom := nil;
588
  end;
589
  inherited;
590
end;
591

592
// WriteToFiler
593
//
594

595
procedure TGLODECustomCollider.WriteToFiler(writer: TWriter);
596
begin
597
  inherited;
598
  with writer do
599
  begin
600
    WriteInteger(0); // Archive version
601
    WriteFloat(FContactResolution);
602
    WriteBoolean(FRenderContacts);
603
    WriteFloat(FPointSize);
604
    Write(PByte(FContactColor.AsAddress)^, 4);
605
  end;
606
end;
607

608
// ReadFromFiler
609
//
610

611
procedure TGLODECustomCollider.ReadFromFiler(reader: TReader);
612
var
613
  archiveVersion: Integer;
614
begin
615
  inherited;
616
  with reader do
617
  begin
618
    archiveVersion := ReadInteger;
619
    Assert(archiveVersion = 0); // Archive version
620
    FContactResolution := ReadFloat;
621
    FRenderContacts := ReadBoolean;
622
    FPointSize := ReadFloat;
623
    Read(PByte(FContactColor.AsAddress)^, 4);
624
  end;
625
end;
626

627
// ClearContacts
628
//
629

630
procedure TGLODECustomCollider.ClearContacts;
631
begin
632
  FContactList.Clear;
633
end;
634

635
// AddContact (x,y,z)
636
//
637

638
procedure TGLODECustomCollider.AddContact(x, y, z: TdReal);
639
begin
640
  AddContact(AffineVectorMake(x, y, z));
641
end;
642

643
// AddContact (pos)
644
//
645

646
procedure TGLODECustomCollider.AddContact(pos: TAffineVector);
647
var
648
  absPos, colPos, colNorm: TAffineVector;
649
  depth: Single;
650
  ContactPoint: TContactPoint;
651
begin
652
  absPos := AffineVectorMake(VectorTransform(PointMake(pos), FTransform));
653
  if Collide(absPos, depth, colPos, colNorm) then
654
  begin
655
    if FContactList.Count < FContactCache.Count then
656
      ContactPoint := FContactCache[FContactList.Count]
657
    else
658
    begin
659
      ContactPoint := TContactPoint.Create;
660
      FContactCache.Add(ContactPoint);
661
    end;
662
    ContactPoint.Position := colPos;
663
    ContactPoint.Normal := colNorm;
664
    ContactPoint.Depth := depth;
665
    FContactList.Add(ContactPoint);
666
  end;
667
  if FRenderContacts and Manager.Visible and Manager.VisibleAtRunTime then
668
    FContactRenderPoints.Add(absPos);
669
end;
670

671
// ApplyContacts
672
//
673

674
function TGLODECustomCollider.ApplyContacts(o1, o2: PdxGeom;
675
  flags: Integer; contact: PdContactGeom; skip: Integer): Integer;
676
var
677
  i, maxContacts: integer;
678
begin
679
  FContactList.Sort(ContactSort);
680
  Result := 0;
681
  maxContacts := flags and $FFFF;
682
  try
683
    for i := 0 to FContactList.Count - 1 do
684
    begin
685
      if Result >= maxContacts then
686
        Exit;
687
      with TContactPoint(FContactList[i]) do
688
      begin
689
        contact.depth := Depth;
690
        contact.pos[0] := Position.V[0];
691
        contact.pos[1] := Position.V[1];
692
        contact.pos[2] := Position.V[2];
693
        contact.pos[3] := 1;
694
        contact.normal[0] := -Normal.V[0];
695
        contact.normal[1] := -Normal.V[1];
696
        contact.normal[2] := -Normal.V[2];
697
        contact.normal[3] := 0;
698
      end;
699
      contact.g1 := o1;
700
      contact.g2 := o2;
701
      contact := PdContactGeom(Integer(contact) + skip);
702
      Inc(Result);
703
    end;
704
  finally
705
    ClearContacts;
706
  end;
707
end;
708

709
// SetTransform
710
//
711

712
procedure TGLODECustomCollider.SetTransform(ATransform: TMatrix);
713
begin
714
  FTransform := ATransform;
715
end;
716

717
// SetContactResolution
718
//
719

720
procedure TGLODECustomCollider.SetContactResolution(const Value: Single);
721
begin
722
  FContactResolution := Value;
723
  if FContactResolution <= 0 then
724
    FContactResolution := 0.01;
725
end;
726

727
// Render
728
//
729

730
procedure TGLODECustomCollider.Render(var rci: TGLRenderContextInfo);
731
var
732
  i: Integer;
733
begin
734
  if FRenderContacts and (FContactRenderPoints.Count > 0) then
735
  begin
736
    GL.Color3fv(FContactColor.AsAddress);
737
    rci.GLStates.PointSize := FPointSize;
738
    GL.Begin_(GL_POINTS);
739
    for i := 0 to FContactRenderPoints.Count - 1 do
740
      GL.Vertex3fv(@FContactRenderPoints.List[i]);
741
    GL.End_;
742
  end;
743
  FContactRenderPoints.Clear;
744
end;
745

746
// SetRenderContacts
747
//
748

749
procedure TGLODECustomCollider.SetRenderContacts(const Value: Boolean);
750
begin
751
  if Value <> FRenderContacts then
752
  begin
753
    FRenderContacts := Value;
754
    NotifyChange(Self);
755
  end;
756
end;
757

758
// SetContactColor
759
//
760

761
procedure TGLODECustomCollider.SetContactColor(const Value: TGLColor);
762
begin
763
  FContactColor.Assign(Value);
764
end;
765

766
// SetPointSize
767
//
768

769
procedure TGLODECustomCollider.SetPointSize(const Value: Single);
770
begin
771
  if Value <> FPointSize then
772
  begin
773
    FPointSize := Value;
774
    NotifyChange(Self);
775
  end;
776
end;
777

778
// ---------------
779
// --------------- TGLODEHeightField --------------
780
// ---------------
781

782
// Create
783
//
784

785
constructor TGLODEHeightField.Create(AOwner: TGLXCollection);
786
var
787
  Allow: Boolean;
788
begin
789
  Allow := False;
790
  if Assigned(AOwner) then
791
  begin
792
    if Assigned(AOwner.Owner) then
793
    begin
794
      if ((AOwner.Owner) is TGLTerrainRenderer)
795
        or ((AOwner.Owner) is TGLHeightField) then
796
        Allow := True;
797
    end;
798
  end;
799

800
  if not Allow then
801
    raise Exception.Create('This element must be a behaviour of a TGLTerrainRenderer or TGLHeightField');
802

803
  inherited Create(AOwner);
804
end;
805

806
// WriteToFiler
807
//
808

809
procedure TGLODEHeightField.WriteToFiler(writer: TWriter);
810
begin
811
  inherited;
812
  with writer do
813
  begin
814
    WriteInteger(0); // Archive version
815
  end;
816
end;
817

818
// ReadFromFiler
819
//
820

821
procedure TGLODEHeightField.ReadFromFiler(reader: TReader);
822
var
823
  archiveVersion: Integer;
824
begin
825
  inherited;
826
  with reader do
827
  begin
828
    archiveVersion := ReadInteger;
829
    Assert(archiveVersion = 0); // Archive version
830
  end;
831
end;
832

833
 
834
//
835

836
class function TGLODEHeightField.FriendlyName: string;
837
begin
838
  Result := 'ODE HeightField Collider';
839
end;
840

841
// FriendlyDescription
842
//
843

844
class function TGLODEHeightField.FriendlyDescription: string;
845
begin
846
  Result := 'A custom ODE collider powered by it''s parent TGLTerrainRenderer or TGLHeightField';
847
end;
848

849
// UniqueItem
850
//
851

852
class function TGLODEHeightField.UniqueItem: Boolean;
853
begin
854
  Result := True;
855
end;
856

857
// CanAddTo
858
//
859

860
class function TGLODEHeightField.CanAddTo(collection: TGLXCollection): Boolean;
861
begin
862
  Result := False;
863
  if collection is TGLBehaviours then
864
    if Assigned(TGLBehaviours(collection).Owner) then
865
      if (TGLBehaviours(collection).Owner is TGLHeightField)
866
        or (TGLBehaviours(collection).Owner is TGLTerrainRenderer) then
867
        Result := True;
868
end;
869

870
// Collide
871
//
872

873
function TGLODEHeightField.Collide(aPos: TAffineVector;
874
  var Depth: Single; var cPos, cNorm: TAffineVector): Boolean;
875

876
  function AbsoluteToLocal(vec: TVector): TVector;
877
  var
878
    mat: TMatrix;
879
  begin
880
    if Owner.Owner is TGLHeightField then
881
      Result := TGLHeightField(Owner.Owner).AbsoluteToLocal(vec)
882
    else if Owner.Owner is TGLTerrainRenderer then
883
    begin
884
      mat := TGLTerrainRenderer(Owner.Owner).AbsoluteMatrix;
885
      NormalizeMatrix(mat);
886
      InvertMatrix(mat);
887
      Result := VectorTransform(vec, mat);
888
    end
889
    else
890
      Assert(False);
891
  end;
892

893
  function LocalToAbsolute(vec: TVector): TVector;
894
  var
895
    mat: TMatrix;
896
  begin
897
    if Owner.Owner is TGLHeightField then
898
      Result := TGLHeightField(Owner.Owner).LocalToAbsolute(vec)
899
    else if Owner.Owner is TGLTerrainRenderer then
900
    begin
901
      mat := TGLTerrainRenderer(Owner.Owner).AbsoluteMatrix;
902
      NormalizeMatrix(mat);
903
      Result := VectorTransform(vec, mat);
904
    end
905
    else
906
      Assert(False);
907
  end;
908

909
  function GetHeight(pos: TVector; var height: Single): Boolean;
910
  var
911
    dummy1: TVector;
912
    dummy2: TTexPoint;
913
  begin
914
    Result := False;
915
    if Owner.Owner is TGLTerrainRenderer then
916
    begin
917
      height := TGLTerrainRenderer(Owner.Owner).InterpolatedHeight(LocalToAbsolute(pos));
918
      Result := True;
919
    end
920
    else if Owner.Owner is TGLHeightField then
921
    begin
922
      if Assigned(TGLHeightField(Owner.Owner).OnGetHeight) then
923
      begin
924
        TGLHeightField(Owner.Owner).OnGetHeight(pos.V[0], pos.V[1], height, dummy1, dummy2);
925
        Result := True;
926
      end;
927
    end;
928
  end;
929

930
const
931
  cDelta = 0.1;
932
var
933
  localPos: TVector;
934
  height: Single;
935
  temp1, temp2: TAffineVector;
936
begin
937
  localPos := AbsoluteToLocal(PointMake(aPos));
938
  if GetHeight(localPos, height) then
939
  begin
940
    Depth := height - localPos.V[2];
941
    Result := (Depth > 0);
942
    if Result then
943
    begin
944
      localPos.V[2] := height;
945
      cPos := AffineVectorMake(LocalToAbsolute(localPos));
946
      temp1.V[0] := localPos.V[0] + cDelta;
947
      temp1.V[1] := localPos.V[1];
948
      temp1.V[2] := localPos.V[2];
949
      GetHeight(PointMake(temp1), temp1.V[2]);
950
      temp2.V[0] := localPos.V[0];
951
      temp2.V[1] := localPos.V[1] + cDelta;
952
      temp2.V[2] := localPos.V[2];
953
      GetHeight(PointMake(temp2), temp2.V[2]);
954
      cNorm := CalcPlaneNormal(AffineVectorMake(localPos), temp1, temp2);
955
      cNorm := AffineVectorMake(LocalToAbsolute(VectorMake(cNorm)));
956
    end;
957
  end
958
  else
959
    Result := False;
960
end;
961

962
// ------------------------------------------------------------------
963
// ------------------------------------------------------------------
964
// ------------------------------------------------------------------
965
initialization
966
  // ------------------------------------------------------------------
967
  // ------------------------------------------------------------------
968
  // ------------------------------------------------------------------
969

970
  RegisterXCollectionItemClass(TGLODEHeightField);
971

972
  // ------------------------------------------------------------------
973
  // ------------------------------------------------------------------
974
  // ------------------------------------------------------------------
975
finalization
976
  // ------------------------------------------------------------------
977
  // ------------------------------------------------------------------
978
  // ------------------------------------------------------------------
979

980
  UnregisterXCollectionItemClass(TGLODEHeightField);
981

982
end.
983

984