2
// This unit is part of the GLScene Engine https://github.com/glscene
5
A Newton Game Dynamics Manager for GLScene.
8
GLScene (http://glscene.org)
9
Newton Game Dynamics Engine (http://newtondynamics.com)
10
NewtonImport, a Delphi header translation (http://newtondynamics.com/forum/viewtopic.php?f=9&t=5273#p35865)
14
This code is still being developed so any part of it may change at anytime.
15
To install use the GLS_NGD?.dpk in the GLScene/Delphi? folder.
18
10/11/12 - PW - Added CPP compatibility: used records with arrays instead of vector arrays
19
11/17/12 - YP - Check not nil result with GetBodyFromGLSceneObject
20
FreeAndNil when destroying objects
21
Destroy all relative joints when finalizing a behaviour to avoid random crash
22
Smart GetBBoxCollision
23
DestroyNewtonData is now common for all procedures
24
28/06/12 - YP - Updated to newton 2.36 (no api change with 2.35)
25
02/02/11 - FP - Read/Write to Filer update to version 1
26
Use RWFloat instead of RWSingle for Single for lazarus compatibility
27
02/02/11 - FP - Add initial name for behavior
28
Moved two TNGDSurfacePair properties from published to public for Lazarus
29
01/02/11 - FP - Fixed custom hinge DegToRad limit
30
Update newtoncreatebody API with matrix parameter (since newton 2.28)
31
Joint draw [parent-to-pivot-to-child] instead of [parent-to-child]
32
21/01/11 - FP - Huge update: Joint in manager collection. Material (now surface) in manager collection
33
Callback as static class function now raise events
34
Debugs view use TGLLines instead of TGLRenderPoint
35
Reset filer version to zero
36
16/12/10 - FP - Update to NewtonSDK 2.25-2.26
37
19/11/10 - FP - Fixed FAngularDamping memory leak for TGLNGDDynamic
38
19/11/10 - FP - Added UseGravity property for TGLNGDDynamic
39
05/11/10 - FP - Removed check freeform in TGLNGDStatic.GeTree
40
Removed FCollisionArray from TGLNGDBehaviour
41
Modified misspelling usevelovity to usevelocity [thx bobrob69]
42
Moved Creation of compound collision for freeform from GetCollisionFromBaseSceneObject to SetCollision for TGLNGDDynamic [thx bobrob69]
43
25/10/10 - FP - Fixed Material badly loaded when created in design time
44
25/10/10 - FP - Commented 'Release each collision form the array' in TGLNGDBehaviour.SetCollision.
45
Changed angular friction in TGLNGDDynamic.Pick method to be able to pick body with small mass.
46
Added Beta Serialize and Deserialise for TGLNGDBehaviour.
47
Commented 'rebuild in runtime' in TGLNGDStatic.Render, because this is conflicting with news serialize methods
48
23/10/10 - Yar - Replace OpenGL1x to OpenGLAdapter
49
08/10/10 - FP - Added show contact for dynamic in render.
50
Uncommented ShowContact property in manager.
51
07/10/10 - FP - Joints connected to TGLNGDBehaviour are now freed in TGLNGDBehaviour.Destroy
52
30/09/10 - FP - Removed beta functions of player and car in TGLNGDDynamic.
53
Added AddImpulse function in TGLNGDDynamic.
54
29/09/10 - FP - Moved FManager assignation for MaterialPair from loaded to create
55
21/09/10 - FP - Added timestep in TContactProcessEvent.
56
Removed Manager property of MaterialPair.
57
MaterialPair.loaded use the owner.owner component as manager now.
58
MaterialPair FilerVersion up to 1
59
20/09/10 - FP - Call Finalize/Initialize in Setid
60
20/09/10 - YP - Moved MaterialAutoCreateGroupID call into Material.Initialize
61
19/09/10 - YP - Added MaterialAutoCreateGroupID to fix loaded order
62
18/09/10 - YP - Added Get and GetOrCreate NGD behaviors routine
63
15/07/10 - FP - Creation by Franck Papouin
74
Classes, // TComponent Tlist TWriter TReader TPersistent
75
SysUtils, //System utilities
76
Math, // Samevalue isZero to compare single
77
NewtonImport, NewtonImport_JointLibrary, // Newton
78
GLVectorGeometry, // PVector TVector TMatrix PMatrix NullHmgVector...
79
GLVectorLists, // TaffineVectorList for Tree
80
GLXCollection, TGLXCollection file function
81
GLBaseClasses, GLScene, GLManager, GLCrossPlatform, GLCoordinates, //
82
GLObjects, GLGeomObjects, GLVectorFileObjects, // cube cone freeform...
83
GLColor, GLGeometryBB; // For show debug
87
NGDFloat = NewtonImport.Float;
88
PNGDFloat = ^NGDFloat;
92
heightArray: array of Word;
95
gridDiagonals: Boolean;
96
widthDepthScale: Single;
101
TGLNGDBehaviour = class;
102
TGLNGDManager = class;
103
TNGDSurfaceItem = class;
107
TNGDSolverModels = (smExact = 0, smLinear1, smLinear2, smLinear3, smLinear4,
108
smLinear5, smLinear6, smLinear7, smLinear8, smLinear9);
110
TNGDFrictionModels = (fmExact = 0, fmAdaptive);
111
TNGDPickedActions = (paAttach = 0, paMove, paDetach);
113
TNGDManagerDebug = (mdShowGeometry, mdShowAABB, mdShowCenterOfMass,
114
mdShowContact, mdShowJoint, mdShowForce, mdShowAppliedForce,
115
mdShowAppliedVelocity);
116
TNGDManagerDebugs = set of TNGDManagerDebug;
118
TNGDNewtonCollisions = (nc_Primitive = 0, nc_Convex, nc_BBox, nc_BSphere,
119
nc_Tree, nc_Mesh, nc_Null, nc_HeightField, nc_NGDFile);
121
TNGDNewtonJoints = (nj_BallAndSocket, nj_Hinge, nj_Slider, nj_Corkscrew,
122
nj_Universal, nj_CustomBallAndSocket, nj_CustomHinge, nj_CustomSlider,
123
nj_UpVector, nj_KinematicController);
125
TGLNGDBehaviourList = class(TList)
127
function GetBehav(index: Integer): TGLNGDBehaviour;
128
procedure PutBehav(index: Integer; Item: TGLNGDBehaviour);
130
property ItemsBehav[index: Integer]
131
: TGLNGDBehaviour read GetBehav write PutBehav; default;
134
{ Events for Newton Callback }136
TCollisionIteratorEvent = procedure(const userData: Pointer;
137
vertexCount: Integer; const cfaceArray: PNGDFloat;
138
faceId: Integer) of object;
140
TApplyForceAndTorqueEvent = procedure(const cbody: PNewtonBody;
141
timestep: NGDFloat; threadIndex: Integer) of object;
143
TSetTransformEvent = procedure(const cbody: PNewtonBody;
144
const cmatrix: PNGDFloat; threadIndex: Integer) of object;
146
TSerializeEvent = procedure(serializeHandle: Pointer; const cbuffer: Pointer;
147
size: Cardinal) of object;
149
TDeSerializeEvent = procedure(serializeHandle: Pointer; buffer: Pointer;
150
size: Cardinal) of object;
152
TAABBOverlapEvent = function(const cmaterial: PNewtonMaterial;
153
const cbody0: PNewtonBody; const cbody1: PNewtonBody;
154
threadIndex: Integer): Boolean of object;
156
TContactProcessEvent = procedure(const ccontact: PNewtonJoint;
157
timestep: NGDFloat; threadIndex: Integer) of object;
161
TNGDDebugOption = class(TPersistent)
163
FManager: TGLNGDManager;
164
FGeomColorDyn: TGLColor; // Green
165
FGeomColorStat: TGLColor; // Red
166
FAABBColor: TGLColor; // Yellow
167
FAABBColorSleep: TGLColor; // Orange
168
FCenterOfMassColor: TGLColor; // Purple dot
169
FContactColor: TGLColor; // White
170
FJointAxisColor: TGLColor; // Blue
171
FJointPivotColor: TGLColor; // Aquamarine
172
FForceColor: TGLColor; // Black
173
FAppliedForceColor: TGLColor; // Silver
174
FAppliedVelocityColor: TGLColor; // Lime
175
FCustomColor: TGLColor; // Aqua
176
FDotAxisSize: Single; // 1
177
FNGDManagerDebugs: TNGDManagerDebugs; // Default All false
178
procedure SetNGDManagerDebugs(const Value: TNGDManagerDebugs);
179
procedure SetDotAxisSize(const Value: Single);
180
function StoredDotAxis: Boolean;
183
constructor Create(AOwner: TComponent);
184
destructor Destroy; override;
187
property GeomColorDyn: TGLColor read FGeomColorDyn write FGeomColorDyn;
188
property GeomColorStat: TGLColor read FGeomColorStat write FGeomColorStat;
189
property AABBColor: TGLColor read FAABBColor write FAABBColor;
190
property AABBColorSleep
191
: TGLColor read FAABBColorSleep write FAABBColorSleep;
192
property CenterOfMassColor
193
: TGLColor read FCenterOfMassColor write FCenterOfMassColor;
194
property ContactColor: TGLColor read FContactColor write FContactColor;
195
property JointAxisColor
196
: TGLColor read FJointAxisColor write FJointAxisColor;
197
property JointPivotColor
198
: TGLColor read FJointPivotColor write FJointPivotColor;
199
property ForceColor: TGLColor read FForceColor write FForceColor;
200
property AppliedForceColor
201
: TGLColor read FAppliedForceColor write FAppliedForceColor;
202
property AppliedVelocityColor
203
: TGLColor read FAppliedVelocityColor write FAppliedVelocityColor;
204
property CustomColor: TGLColor read FCustomColor write FCustomColor;
205
property NGDManagerDebugs: TNGDManagerDebugs read FNGDManagerDebugs write
206
SetNGDManagerDebugs default[];
207
property DotAxisSize: Single read FDotAxisSize write SetDotAxisSize stored
211
TGLNGDManager = class(TComponent)
215
FVisible: Boolean; // Show Debug at design time
216
FVisibleAtRunTime: Boolean; // Show Debug at run time
217
FDllVersion: Integer;
218
FSolverModel: TNGDSolverModels; // Default=Exact
219
FFrictionModel: TNGDFrictionModels; // Default=Exact
220
FMinimumFrameRate: Integer; // Default=60
221
FWorldSizeMin: TGLCoordinates; // Default=-100, -100, -100
222
FWorldSizeMax: TGLCoordinates; // Default=100, 100, 100
223
FThreadCount: Integer; // Default=1
224
FGravity: TGLCoordinates; // Default=(0,-9.81,0)
225
FNewtonSurfaceItem: TCollection;
226
FNewtonSurfacePair: TOwnedCollection;
227
FNewtonJointGroup: TOwnedCollection;
228
FNGDDebugOption: TNGDDebugOption;
232
FNewtonWorld: PNewtonWorld;
233
FNGDBehaviours: TGLNGDBehaviourList;
234
FCurrentColor: TGLColor;
236
procedure Loaded; override;
237
procedure SetVisible(const Value: Boolean);
238
procedure SetVisibleAtRunTime(const Value: Boolean);
239
procedure SetSolverModel(const Value: TNGDSolverModels);
240
procedure SetFrictionModel(const Value: TNGDFrictionModels);
241
procedure SetMinimumFrameRate(const Value: Integer);
242
procedure SetThreadCount(const Value: Integer);
243
procedure SetGLLines(const Value: TGLLines);
244
function GetBodyCount: Integer;
245
function GetConstraintCount: Integer;
246
procedure AddNode(const coords: TGLCustomCoordinates); overload;
247
procedure AddNode(const X, Y, Z: Single); overload;
248
procedure AddNode(const Value: TVector); overload;
249
procedure AddNode(const Value: TAffineVector); overload;
250
procedure RebuildAllMaterial;
251
procedure RebuildAllJoint(Sender: TObject);
254
procedure NotifyWorldSizeChange(Sender: TObject);
255
procedure NotifyChange(Sender: TObject); // Debug view
259
constructor Create(AOwner: TComponent); override;
260
destructor Destroy; override;
261
procedure Step(deltatime: Single);
266
property Visible: Boolean read FVisible write SetVisible default True;
267
property VisibleAtRunTime: Boolean read FVisibleAtRunTime write
268
SetVisibleAtRunTime default False;
269
property SolverModel: TNGDSolverModels read FSolverModel write
270
SetSolverModel default smExact;
271
property FrictionModel: TNGDFrictionModels read FFrictionModel write
272
SetFrictionModel default fmExact;
273
property MinimumFrameRate: Integer read FMinimumFrameRate write
274
SetMinimumFrameRate default 60;
276
: Integer read FThreadCount write SetThreadCount default 1;
277
property DllVersion: Integer read FDllVersion;
278
property NewtonBodyCount: Integer read GetBodyCount;
279
property NewtonConstraintCount: Integer read GetConstraintCount;
280
property Gravity: TGLCoordinates read FGravity write FGravity;
281
property WorldSizeMin
282
: TGLCoordinates read FWorldSizeMin write FWorldSizeMin;
283
property WorldSizeMax
284
: TGLCoordinates read FWorldSizeMax write FWorldSizeMax;
285
property NewtonSurfaceItem
286
: TCollection read FNewtonSurfaceItem write FNewtonSurfaceItem;
287
property NewtonSurfacePair: TOwnedCollection read FNewtonSurfacePair write
289
property DebugOption: TNGDDebugOption read FNGDDebugOption write
291
property Line: TGLLines read FGLLines write SetGLLines;
292
property NewtonJoint: TOwnedCollection read FNewtonJointGroup write
296
{ Basis structures for GLScene behaviour style implementations. }297
TGLNGDBehaviour = class(TGLBehaviour)
299
{ Private Declartions }300
FManager: TGLNGDManager;
301
FManagerName: string;
302
FInitialized: Boolean;
303
FNewtonBody: PNewtonBody;
304
FCollision: PNewtonCollision;
305
FNewtonBodyMatrix: TMatrix; // Position and Orientation
306
FContinuousCollisionMode: Boolean; // Default=False
307
FNGDNewtonCollisions: TNGDNewtonCollisions;
308
FCollisionIteratorEvent: TCollisionIteratorEvent;
309
FOwnerBaseSceneObject: TGLBaseSceneObject;
310
// FNullCollisionMass: Single; // Default=0
311
FTreeCollisionOptimize: Boolean; // Default=True
312
FConvexCollisionTolerance: Single; // Default=0.01 1%
313
FFileCollision: string;
314
FNGDSurfaceItem: TNGDSurfaceItem;
315
FHeightFieldOptions: THeightField;
318
procedure Initialize; virtual;
319
procedure Finalize; virtual;
320
procedure WriteToFiler(writer: TWriter); override;
321
procedure ReadFromFiler(reader: TReader); override;
322
procedure Loaded; override;
323
procedure SetManager(Value: TGLNGDManager);
324
procedure SetNewtonBodyMatrix(const Value: TMatrix);
325
procedure SetContinuousCollisionMode(const Value: Boolean);
326
function GetNewtonBodyMatrix: TMatrix;
327
function GetNewtonBodyAABB: TAABB;
328
procedure UpdCollision; virtual;
329
procedure Render; virtual;
330
procedure SetNGDNewtonCollisions(const Value: TNGDNewtonCollisions);
331
procedure SetNGDSurfaceItem(const Value: TNGDSurfaceItem);
332
procedure SetHeightFieldOptions(const Value: THeightField);
334
function GetPrimitiveCollision(): PNewtonCollision;
335
function GetConvexCollision(): PNewtonCollision;
336
function GetBBoxCollision(): PNewtonCollision;
337
function GetBSphereCollision(): PNewtonCollision;
338
function GetTreeCollision(): PNewtonCollision;
339
function GetMeshCollision(): PNewtonCollision;
340
function GetNullCollision(): PNewtonCollision;
341
function GetHeightFieldCollision(): PNewtonCollision;
342
function GetNGDFileCollision(): PNewtonCollision;
343
function StoredTolerance: Boolean;
346
procedure OnCollisionIteratorEvent(const userData: Pointer;
347
vertexCount: Integer; const cfaceArray: PNGDFloat; faceId: Integer);
350
class procedure NewtonCollisionIterator(const userData: Pointer;
351
vertexCount: Integer; const faceArray: PNGDFloat;
352
faceId: Integer); static; cdecl;
354
class procedure NewtonSerialize(serializeHandle: Pointer;
355
const buffer: Pointer; size: Cardinal); static; cdecl;
357
class procedure NewtonDeserialize(serializeHandle: Pointer;
358
buffer: Pointer; size: Cardinal); static; cdecl;
362
constructor Create(AOwner: TGLXCollection); override;
363
destructor Destroy; override;
364
procedure Reinitialize;
365
property Initialized: Boolean read FInitialized;
366
class function UniqueItem: Boolean; override;
367
property NewtonBodyMatrix: TMatrix read GetNewtonBodyMatrix write
369
property NewtonBodyAABB: TAABB read GetNewtonBodyAABB;
370
procedure Serialize(filename: string);
371
procedure DeSerialize(filename: string);
372
property HeightFieldOptions: THeightField read FHeightFieldOptions write
373
SetHeightFieldOptions;
377
property Manager: TGLNGDManager read FManager write SetManager;
378
property ContinuousCollisionMode
379
: Boolean read FContinuousCollisionMode write
380
SetContinuousCollisionMode default False;
381
property NGDNewtonCollisions
382
: TNGDNewtonCollisions read FNGDNewtonCollisions
383
write SetNGDNewtonCollisions default nc_Primitive;
384
property TreeCollisionOptimize: Boolean read FTreeCollisionOptimize write
385
FTreeCollisionOptimize default True;
386
property ConvexCollisionTolerance
387
: Single read FConvexCollisionTolerance write
388
FConvexCollisionTolerance stored StoredTolerance;
389
property FileCollision: string read FFileCollision write FFileCollision;
390
property NGDSurfaceItem: TNGDSurfaceItem read FNGDSurfaceItem write
394
TGLNGDDynamic = class(TGLNGDBehaviour)
397
FAABBmin: TGLCoordinates;
398
FAABBmax: TGLCoordinates;
399
FForce: TGLCoordinates;
400
FTorque: TGLCoordinates;
401
FCenterOfMass: TGLCoordinates;
402
FAutoSleep: Boolean; // Default=True
403
FLinearDamping: Single; // default=0.1
404
FAngularDamping: TGLCoordinates; // Default=0.1
405
FDensity: Single; // Default=1
406
FUseGravity: Boolean; // Default=True
407
FNullCollisionVolume: Single; // Default=0
408
FApplyForceAndTorqueEvent: TApplyForceAndTorqueEvent;
409
FSetTransformEvent: TSetTransformEvent;
410
FCustomForceAndTorqueEvent: TApplyForceAndTorqueEvent;
415
FAppliedForce: TGLCoordinates;
416
FAppliedTorque: TGLCoordinates;
417
FAppliedOmega: TGLCoordinates;
418
FAppliedVelocity: TGLCoordinates;
420
function StoredDensity: Boolean;
421
function StoredLinearDamping: Boolean;
422
function StoredNullCollisionVolume: Boolean;
425
procedure SetAutoSleep(const Value: Boolean);
426
procedure SetLinearDamping(const Value: Single);
427
procedure SetDensity(const Value: Single); virtual;
428
procedure Initialize; override;
429
procedure Finalize; override;
430
procedure WriteToFiler(writer: TWriter); override;
431
procedure ReadFromFiler(reader: TReader); override;
432
procedure Loaded; override;
433
procedure Render; override;
436
procedure NotifyCenterOfMassChange(Sender: TObject);
437
procedure NotifyAngularDampingChange(Sender: TObject);
438
procedure OnApplyForceAndTorqueEvent(const cbody: PNewtonBody;
439
timestep: NGDFloat; threadIndex: Integer);
440
procedure OnSetTransformEvent(const cbody: PNewtonBody;
441
const cmatrix: PNGDFloat; threadIndex: Integer);
444
class procedure NewtonApplyForceAndTorque(const body: PNewtonBody;
445
timestep: NGDFloat; threadIndex: Integer); static; cdecl;
446
class procedure NewtonSetTransform(const body: PNewtonBody;
447
const matrix: PNGDFloat; threadIndex: Integer); static; cdecl;
452
constructor Create(AOwner: TGLXCollection); override;
453
destructor Destroy; override;
454
procedure AddImpulse(const veloc, pointposit: TVector);
455
function GetOmega: TVector;
456
procedure SetOmega(const Omega: TVector);
457
function GetVelocity: TVector;
458
procedure SetVelocity(const Velocity: TVector);
459
class function FriendlyName: string; override;
460
property CustomForceAndTorqueEvent
461
: TApplyForceAndTorqueEvent read FCustomForceAndTorqueEvent write
462
FCustomForceAndTorqueEvent;
463
property Velocity: TVector read GetVelocity write SetVelocity;
464
property Omega: TVector read GetOmega write SetOmega;
467
property Force: TGLCoordinates read FForce write FForce;
468
property Torque: TGLCoordinates read FTorque write FTorque;
469
property CenterOfMass
470
: TGLCoordinates read FCenterOfMass write FCenterOfMass;
471
property AutoSleep: Boolean read FAutoSleep write SetAutoSleep default True;
472
property LinearDamping
473
: Single read FLinearDamping write SetLinearDamping
474
stored StoredLinearDamping;
475
property AngularDamping
476
: TGLCoordinates read FAngularDamping write FAngularDamping;
478
: Single read FDensity write SetDensity stored StoredDensity;
480
: Boolean read FUseGravity write FUseGravity default True;
481
property NullCollisionVolume
482
: Single read FNullCollisionVolume write FNullCollisionVolume stored
483
StoredNullCollisionVolume;
486
property AppliedOmega: TGLCoordinates read FAppliedOmega;
487
property AppliedVelocity: TGLCoordinates read FAppliedVelocity;
488
property AppliedForce: TGLCoordinates read FAppliedForce;
489
property AppliedTorque: TGLCoordinates read FAppliedTorque;
490
property Volume: Single read FVolume;
491
property Mass: Single read FMass;
494
TGLNGDStatic = class(TGLNGDBehaviour)
500
procedure Render; override;
504
class function FriendlyName: string; override;
510
TNGDSurfaceItem = class(TCollectionItem)
512
FDisplayName: string;
514
function GetDisplayName: string; override;
515
procedure SetDisplayName(const Value: string); override;
518
property DisplayName;
522
TNGDSurfacePair = class(TCollectionItem)
524
FManager: TGLNGDManager;
525
FNGDSurfaceItem1: TNGDSurfaceItem;
526
FNGDSurfaceItem2: TNGDSurfaceItem;
527
FAABBOverlapEvent: TAABBOverlapEvent;
528
FContactProcessEvent: TContactProcessEvent;
530
FSoftness: Single; // 0.1
531
FElasticity: Single; // 0.4
532
FCollidable: Boolean; // true
533
FStaticFriction: Single; // 0.9
534
FKineticFriction: Single; // 0.5
535
FContinuousCollisionMode: Boolean; // False
536
FThickness: Boolean; // False
538
procedure SetCollidable(const Value: Boolean);
539
procedure SetElasticity(const Value: Single);
540
procedure SetKineticFriction(const Value: Single);
541
procedure SetSoftness(const Value: Single);
542
procedure SetStaticFriction(const Value: Single);
543
procedure SetContinuousCollisionMode(const Value: Boolean);
544
procedure SetThickness(const Value: Boolean);
546
function StoredElasticity: Boolean;
547
function StoredKineticFriction: Boolean;
548
function StoredSoftness: Boolean;
549
function StoredStaticFriction: Boolean;
553
class function NewtonAABBOverlap(const material: PNewtonMaterial;
554
const body0: PNewtonBody; const body1: PNewtonBody;
555
threadIndex: Integer): Integer; static; cdecl;
556
class procedure NewtonContactsProcess(const contact: PNewtonJoint;
557
timestep: NGDFloat; threadIndex: Integer); static; cdecl;
560
function OnNewtonAABBOverlapEvent(const cmaterial: PNewtonMaterial;
561
const cbody0: PNewtonBody; const cbody1: PNewtonBody;
562
threadIndex: Integer): Boolean;
563
procedure OnNewtonContactsProcessEvent(const ccontact: PNewtonJoint;
564
timestep: NGDFloat; threadIndex: Integer);
567
constructor Create(Collection: TCollection); override;
568
procedure SetMaterialItems(const item1, item2: TNGDSurfaceItem);
569
property NGDSurfaceItem1: TNGDSurfaceItem read FNGDSurfaceItem1;
570
property NGDSurfaceItem2: TNGDSurfaceItem read FNGDSurfaceItem2;
573
property Softness: Single read FSoftness write SetSoftness stored
575
property Elasticity: Single read FElasticity write SetElasticity stored
578
: Boolean read FCollidable write SetCollidable default True;
579
property StaticFriction
580
: Single read FStaticFriction write SetStaticFriction
581
stored StoredStaticFriction;
582
property KineticFriction
583
: Single read FKineticFriction write SetKineticFriction stored
584
StoredKineticFriction;
585
property ContinuousCollisionMode
586
: Boolean read FContinuousCollisionMode write
587
SetContinuousCollisionMode default False;
589
: Boolean read FThickness write SetThickness default False;
590
property ContactProcessEvent
591
: TContactProcessEvent read FContactProcessEvent
592
write FContactProcessEvent;
593
property AABBOverlapEvent: TAABBOverlapEvent read FAABBOverlapEvent write
597
TNGDJointPivot = class(TPersistent)
599
FManager: TGLNGDManager;
600
FPivotPoint: TGLCoordinates;
603
constructor Create(AOwner: TComponent; aOuter: TNGDJoint); virtual;
604
destructor Destroy; override;
606
property PivotPoint: TGLCoordinates read FPivotPoint write FPivotPoint;
609
TNGDJointPin = class(TNGDJointPivot)
611
FPinDirection: TGLCoordinates;
614
constructor Create(AOwner: TComponent; aOuter: TNGDJoint); override;
615
destructor Destroy; override;
618
property PinDirection
619
: TGLCoordinates read FPinDirection write FPinDirection;
622
TNGDJointPin2 = class(TNGDJointPin)
624
FPinDirection2: TGLCoordinates;
627
constructor Create(AOwner: TComponent; aOuter: TNGDJoint); override;
628
destructor Destroy; override;
631
property PinDirection2
632
: TGLCoordinates read FPinDirection2 write FPinDirection2;
635
TNGDJointBallAndSocket = class(TNGDJointPivot)
637
FConeAngle: Single; // 90
638
FMinTwistAngle: Single; // -90
639
FMaxTwistAngle: Single; // 90
640
procedure SetConeAngle(const Value: Single);
641
procedure SetMaxTwistAngle(const Value: Single);
642
procedure SetMinTwistAngle(const Value: Single);
643
function StoredMaxTwistAngle: Boolean;
644
function StoredMinTwistAngle: Boolean;
645
function StoredConeAngle: Boolean;
648
constructor Create(AOwner: TComponent; aOuter: TNGDJoint); override;
651
property ConeAngle: Single read FConeAngle write SetConeAngle stored
653
property MinTwistAngle
654
: Single read FMinTwistAngle write SetMinTwistAngle
655
stored StoredMinTwistAngle;
656
property MaxTwistAngle
657
: Single read FMaxTwistAngle write SetMaxTwistAngle
658
stored StoredMaxTwistAngle;
661
TNGDJointHinge = class(TNGDJointPin)
663
FMinAngle: Single; // -90
664
FMaxAngle: Single; // 90
665
procedure SetMaxAngle(const Value: Single);
666
procedure SetMinAngle(const Value: Single);
667
function StoredMaxAngle: Boolean;
668
function StoredMinAngle: Boolean;
671
constructor Create(AOwner: TComponent; aOuter: TNGDJoint); override;
674
property MinAngle: Single read FMinAngle write SetMinAngle stored
676
property MaxAngle: Single read FMaxAngle write SetMaxAngle stored
680
TNGDJointSlider = class(TNGDJointPin)
682
FMinDistance: Single; // -10
683
FMaxDistance: Single; // 10
684
procedure SetMaxDistance(const Value: Single);
685
procedure SetMinDistance(const Value: Single);
686
function StoredMaxDistance: Boolean;
687
function StoredMinDistance: Boolean;
690
constructor Create(AOwner: TComponent; aOuter: TNGDJoint); override;
693
property MinDistance: Single read FMinDistance write SetMinDistance stored
695
property MaxDistance: Single read FMaxDistance write SetMaxDistance stored
699
TNGDJointKinematicController = class(TPersistent)
701
FPickModeLinear: Boolean; // False
702
FLinearFriction: Single; // 750
703
FAngularFriction: Single; // 250
704
function StoredAngularFriction: Boolean;
705
function StoredLinearFriction: Boolean;
708
constructor Create();
711
property PickModeLinear
712
: Boolean read FPickModeLinear write FPickModeLinear
714
property LinearFriction
715
: Single read FLinearFriction write FLinearFriction stored
716
StoredLinearFriction;
717
property AngularFriction
718
: Single read FAngularFriction write FAngularFriction stored
719
StoredAngularFriction;
722
TNGDJoint = class(TCollectionItem)
726
FManager: TGLNGDManager;
727
FParentObject: TGLBaseSceneObject;
728
FJointType: TNGDNewtonJoints;
729
FStiffness: Single; // 0.9
732
// Every joint except nj_UpVector and nj_KinematicController
733
FChildObject: TGLBaseSceneObject;
734
FCollisionState: Boolean; // False
736
// With classic joint
737
// nj_BallAndSocket, nj_Hinge, nj_Slider, nj_Corkscrew
738
// nj_Universal, nj_UpVector
739
FNewtonJoint: PNewtonJoint;
742
// nj_CustomBallAndSocket, nj_CustomHinge, nj_CustomSlider
743
// nj_KinematicController
744
FNewtonUserJoint: PNewtonUserJoint;
747
FUPVectorDirection: TGLCoordinates;
749
FBallAndSocketOptions: TNGDJointPivot;
750
FHingeOptions: TNGDJointPin;
751
FSliderOptions: TNGDJointPin;
752
FCorkscrewOptions: TNGDJointPin;
753
FUniversalOptions: TNGDJointPin2;
755
FCustomBallAndSocketOptions: TNGDJointBallAndSocket;
756
FCustomHingeOptions: TNGDJointHinge;
757
FCustomSliderOptions: TNGDJointSlider;
758
FKinematicOptions: TNGDJointKinematicController;
760
procedure SetJointType(const Value: TNGDNewtonJoints);
761
procedure SetChildObject(const Value: TGLBaseSceneObject);
762
procedure SetCollisionState(const Value: Boolean);
763
procedure SetParentObject(const Value: TGLBaseSceneObject);
764
procedure SetStiffness(const Value: Single);
766
function StoredStiffness: Boolean;
767
procedure DestroyNewtonData;
770
constructor Create(Collection: TCollection); override;
771
destructor Destroy; override;
772
procedure KinematicControllerPick(pickpoint: TVector;
773
PickedActions: TNGDPickedActions);
776
property BallAndSocketOptions
777
: TNGDJointPivot read FBallAndSocketOptions write
778
FBallAndSocketOptions;
779
property HingeOptions: TNGDJointPin read FHingeOptions write FHingeOptions;
780
property SliderOptions
781
: TNGDJointPin read FSliderOptions write FSliderOptions;
782
property CorkscrewOptions
783
: TNGDJointPin read FCorkscrewOptions write FCorkscrewOptions;
784
property UniversalOptions
785
: TNGDJointPin2 read FUniversalOptions write FUniversalOptions;
786
property CustomBallAndSocketOptions
787
: TNGDJointBallAndSocket read FCustomBallAndSocketOptions write
788
FCustomBallAndSocketOptions;
789
property CustomHingeOptions: TNGDJointHinge read FCustomHingeOptions write
791
property CustomSliderOptions
792
: TNGDJointSlider read FCustomSliderOptions write
793
FCustomSliderOptions;
794
property KinematicControllerOptions
795
: TNGDJointKinematicController read FKinematicOptions write
797
property JointType: TNGDNewtonJoints read FJointType write SetJointType;
798
property ParentObject: TGLBaseSceneObject read FParentObject write
800
property ChildObject: TGLBaseSceneObject read FChildObject write
802
property CollisionState
803
: Boolean read FCollisionState write SetCollisionState default False;
804
property Stiffness: Single read FStiffness write SetStiffness stored
806
property UPVectorDirection
807
: TGLCoordinates read FUPVectorDirection write FUPVectorDirection;
811
function GetNGDStatic(Obj: TGLBaseSceneObject): TGLNGDStatic;
812
function GetOrCreateNGDStatic(Obj: TGLBaseSceneObject): TGLNGDStatic;
813
function GetNGDDynamic(Obj: TGLBaseSceneObject): TGLNGDDynamic;
814
function GetOrCreateNGDDynamic(Obj: TGLBaseSceneObject): TGLNGDDynamic;
816
function GetBodyFromGLSceneObject(Obj: TGLBaseSceneObject): PNewtonBody;
821
epsilon = 0.0000001; // 1E-07
825
function GetNGDStatic(Obj: TGLBaseSceneObject): TGLNGDStatic;
827
Result := TGLNGDStatic(Obj.Behaviours.GetByClass(TGLNGDStatic));
830
// GetOrCreateNGDStatic
832
function GetOrCreateNGDStatic(Obj: TGLBaseSceneObject): TGLNGDStatic;
834
Result := TGLNGDStatic(Obj.GetOrCreateBehaviour(TGLNGDStatic));
839
function GetNGDDynamic(Obj: TGLBaseSceneObject): TGLNGDDynamic;
841
Result := TGLNGDDynamic(Obj.Behaviours.GetByClass(TGLNGDDynamic));
844
// GetOrCreateNGDDynamic
846
function GetOrCreateNGDDynamic(Obj: TGLBaseSceneObject): TGLNGDDynamic;
848
Result := TGLNGDDynamic(Obj.GetOrCreateBehaviour(TGLNGDDynamic));
851
function GetBodyFromGLSceneObject(Obj: TGLBaseSceneObject): PNewtonBody;
853
Behaviour: TGLNGDBehaviour;
855
Behaviour := TGLNGDBehaviour(Obj.Behaviours.GetByClass(TGLNGDBehaviour));
856
Assert(Behaviour <> nil, 'NGD Behaviour (static or dynamic) is missing for this object');
857
Result := Behaviour.FNewtonBody;
860
// ------------------------------------------------------------------
861
// ------------------------------------------------------------------
862
// ------------------------------------------------------------------
866
constructor TNGDDebugOption.Create(AOwner: TComponent);
868
FManager := AOwner as TGLNGDManager;
871
FGeomColorDyn := TGLColor.CreateInitialized(self, clrGreen, NotifyChange);
872
FGeomColorStat := TGLColor.CreateInitialized(self, clrRed, NotifyChange);
873
FAABBColor := TGLColor.CreateInitialized(self, clrYellow, NotifyChange);
874
FAABBColorSleep := TGLColor.CreateInitialized(self, clrOrange,
876
FCenterOfMassColor := TGLColor.CreateInitialized(self, clrPurple,
878
FContactColor := TGLColor.CreateInitialized(self, clrWhite, NotifyChange);
879
FJointAxisColor := TGLColor.CreateInitialized(self, clrBlue, NotifyChange);
880
FJointPivotColor := TGLColor.CreateInitialized(self, clrAquamarine,
883
FForceColor := TGLColor.CreateInitialized(self, clrBlack, NotifyChange);
884
FAppliedForceColor := TGLColor.CreateInitialized(self, clrSilver,
886
FAppliedVelocityColor := TGLColor.CreateInitialized(self, clrLime,
889
FCustomColor := TGLColor.CreateInitialized(self, clrAqua, NotifyChange);
892
FNGDManagerDebugs := [];
894
FManager := AOwner as TGLNGDManager;
897
destructor TNGDDebugOption.Destroy;
902
FAABBColorSleep.Free;
903
FCenterOfMassColor.Free;
905
FJointAxisColor.Free;
906
FJointPivotColor.Free;
908
FAppliedForceColor.Free;
909
FAppliedVelocityColor.Free;
914
procedure TNGDDebugOption.SetDotAxisSize(const Value: Single);
916
FDotAxisSize := Value;
917
FManager.NotifyChange(self);
920
procedure TNGDDebugOption.SetNGDManagerDebugs(const Value: TNGDManagerDebugs);
922
FNGDManagerDebugs := Value;
923
FManager.NotifyChange(self);
926
function TNGDDebugOption.StoredDotAxis: Boolean;
928
Result := not SameValue(FDotAxisSize, 1, epsilon);
933
procedure TGLNGDManager.AddNode(const Value: TVector);
935
if Assigned(FGLLines) then
937
FGLLines.Nodes.AddNode(Value);
939
with (FGLLines.Nodes.Last as TGLLinesNode) do
940
Color := FCurrentColor;
944
procedure TGLNGDManager.AddNode(const coords: TGLCustomCoordinates);
946
if Assigned(FGLLines) then
948
FGLLines.Nodes.AddNode(coords); (FGLLines.Nodes.Last as TGLLinesNode)
949
.Color := FCurrentColor;
953
procedure TGLNGDManager.AddNode(const X, Y, Z: Single);
955
if Assigned(FGLLines) then
957
FGLLines.Nodes.AddNode(X, Y, Z); (FGLLines.Nodes.Last as TGLLinesNode)
958
.Color := FCurrentColor;
962
procedure TGLNGDManager.AddNode(const Value: TAffineVector);
964
if Assigned(FGLLines) then
966
FGLLines.Nodes.AddNode(Value); (FGLLines.Nodes.Last as TGLLinesNode)
967
.Color := FCurrentColor;
971
constructor TGLNGDManager.Create(AOwner: TComponent);
973
minworld, maxworld: TVector;
976
FNGDBehaviours := TGLNGDBehaviourList.Create;
978
FVisibleAtRunTime := False;
979
FSolverModel := smExact;
980
FFrictionModel := fmExact;
981
FMinimumFrameRate := 60;
982
FWorldSizeMin := TGLCoordinates.CreateInitialized(self,
983
VectorMake(-100, -100, -100, 0), csPoint);
984
FWorldSizeMax := TGLCoordinates.CreateInitialized(self,
985
VectorMake(100, 100, 100, 0), csPoint);
987
// Using Events because we need to call API Function when
988
// theses TGLCoordinates change.
989
FWorldSizeMin.OnNotifyChange := NotifyWorldSizeChange;
990
FWorldSizeMax.OnNotifyChange := NotifyWorldSizeChange;
993
FGravity := TGLCoordinates3.CreateInitialized(self,
994
VectorMake(0, -9.81, 0, 0), csVector);
996
FNewtonWorld := NewtonCreate(nil, nil);
997
FDllVersion := NewtonWorldGetVersion(FNewtonWorld);
999
// This is to prevent body out the world at startTime
1000
minworld := VectorMake(-1E50, -1E50, -1E50);
1001
maxworld := VectorMake(1E50, 1E50, 1E50);
1002
NewtonSetWorldSize(FNewtonWorld, @minworld, @maxworld);
1004
NewtonWorldSetUserData(FNewtonWorld, self);
1006
FNewtonSurfaceItem := TCollection.Create(TNGDSurfaceItem);
1007
FNewtonSurfacePair := TOwnedCollection.Create(self, TNGDSurfacePair);
1008
FNewtonJointGroup := TOwnedCollection.Create(self, TNGDJoint);
1010
FNGDDebugOption := TNGDDebugOption.Create(self);
1012
RegisterManager(self);
1016
destructor TGLNGDManager.Destroy;
1018
// Destroy joint before body.
1019
FreeAndNil(FNewtonJointGroup);
1021
// Unregister everything
1022
while FNGDBehaviours.Count > 0 do
1023
FNGDBehaviours[0].Manager := nil;
1025
// Clean up everything
1026
FreeAndNil(FNGDBehaviours);
1027
FreeAndNil(FWorldSizeMin);
1028
FreeAndNil(FWorldSizeMax);
1029
FreeAndNil(FGravity);
1030
FreeAndNil(FNewtonSurfaceItem);
1031
FreeAndNil(FNewtonSurfacePair);
1032
FreeAndNil(FNGDDebugOption);
1034
NewtonDestroyAllBodies(FNewtonWorld);
1035
NewtonMaterialDestroyAllGroupID(FNewtonWorld);
1036
NewtonDestroy(FNewtonWorld);
1037
FNewtonWorld := nil;
1039
DeregisterManager(self);
1043
procedure TGLNGDManager.Loaded;
1046
NotifyWorldSizeChange(self);
1047
RebuildAllJoint(self);
1050
function TGLNGDManager.GetBodyCount: Integer;
1052
if (csDesigning in ComponentState) then
1053
Result := FNGDBehaviours.Count
1055
Result := NewtonWorldGetBodyCount(FNewtonWorld);
1058
function TGLNGDManager.GetConstraintCount: Integer;
1060
if (csDesigning in ComponentState) then
1061
Result := FNewtonJointGroup.Count
1063
// Constraint is the number of joint
1064
Result := NewtonWorldGetConstraintCount(FNewtonWorld);
1067
procedure TGLNGDManager.NotifyChange(Sender: TObject);
1071
// This event is raise
1072
// when debugOptions properties are edited,
1073
// when a behavior is initialized/finalize,
1074
// when joints are rebuilded, (runtime only)
1075
// when visible and visibleAtRuntime are edited (designTime only),
1076
// in manager.step, and in SetGLLines.
1078
// Here the manager call render method for bodies and joints in its lists
1080
if not Assigned(FGLLines) then
1082
FGLLines.Nodes.Clear;
1086
if not(csDesigning in ComponentState) then
1087
if not VisibleAtRunTime then
1090
for I := 0 to FNGDBehaviours.Count - 1 do
1091
FNGDBehaviours[I].Render;
1093
if mdShowJoint in FNGDDebugOption.NGDManagerDebugs then
1094
for I := 0 to NewtonJoint.Count - 1 do //
1095
(NewtonJoint.Items[I] as TNGDJoint)
1100
procedure TGLNGDManager.SetFrictionModel(const Value: TNGDFrictionModels);
1102
FFrictionModel := Value;
1103
if not(csDesigning in ComponentState) then
1104
NewtonSetFrictionModel(FNewtonWorld, Ord(FFrictionModel));
1107
procedure TGLNGDManager.SetGLLines(const Value: TGLLines);
1109
if Assigned(FGLLines) then
1110
FGLLines.Nodes.Clear;
1114
if Assigned(FGLLines) then
1116
FGLLines.SplineMode := lsmSegments;
1117
FGLLines.NodesAspect := lnaInvisible;
1118
FGLLines.Options := [loUseNodeColorForLines];
1119
FGLLines.Pickable := False;
1124
procedure TGLNGDManager.SetMinimumFrameRate(const Value: Integer);
1126
if (Value >= 60) and (Value <= 1000) then
1127
FMinimumFrameRate := Value;
1128
if not(csDesigning in ComponentState) then
1129
NewtonSetMinimumFrameRate(FNewtonWorld, FMinimumFrameRate);
1132
procedure TGLNGDManager.SetSolverModel(const Value: TNGDSolverModels);
1134
FSolverModel := Value;
1135
if not(csDesigning in ComponentState) then
1136
NewtonSetSolverModel(FNewtonWorld, Ord(FSolverModel));
1139
procedure TGLNGDManager.SetThreadCount(const Value: Integer);
1142
FThreadCount := Value;
1143
NewtonSetThreadsCount(FNewtonWorld, FThreadCount);
1144
FThreadCount := NewtonGetThreadsCount(FNewtonWorld);
1147
procedure TGLNGDManager.SetVisible(const Value: Boolean);
1150
if (csDesigning in ComponentState) then
1154
procedure TGLNGDManager.SetVisibleAtRunTime(const Value: Boolean);
1156
FVisibleAtRunTime := Value;
1157
if (csDesigning in ComponentState) then
1161
procedure TGLNGDManager.NotifyWorldSizeChange(Sender: TObject);
1163
if not(csDesigning in ComponentState) then
1164
NewtonSetWorldSize(FNewtonWorld, @FWorldSizeMin.AsVector,
1165
@FWorldSizeMax.AsVector);
1168
procedure TGLNGDManager.RebuildAllJoint(Sender: TObject);
1170
procedure BuildBallAndSocket(Joint: TNGDJoint);
1173
if Assigned(FParentObject) and Assigned(FChildObject) then
1175
FNewtonJoint := NewtonConstraintCreateBall(FNewtonWorld,
1176
@(FBallAndSocketOptions.FPivotPoint.AsVector),
1177
GetBodyFromGLSceneObject(FChildObject),
1178
GetBodyFromGLSceneObject(FParentObject));
1179
NewtonJointSetCollisionState(FNewtonJoint, Ord(FCollisionState));
1180
NewtonJointSetStiffness(FNewtonJoint, FStiffness);
1184
procedure BuildHinge(Joint: TNGDJoint);
1187
if Assigned(FParentObject) and Assigned(FChildObject) then
1189
FNewtonJoint := NewtonConstraintCreateHinge(FNewtonWorld,
1190
@(FHingeOptions.FPivotPoint.AsVector),
1191
@(FHingeOptions.FPinDirection.AsVector),
1192
GetBodyFromGLSceneObject(FChildObject),
1193
GetBodyFromGLSceneObject(FParentObject));
1194
NewtonJointSetCollisionState(FNewtonJoint, Ord(FCollisionState));
1195
NewtonJointSetStiffness(FNewtonJoint, FStiffness);
1199
procedure BuildSlider(Joint: TNGDJoint);
1202
if Assigned(FParentObject) and Assigned(FChildObject) then
1204
FNewtonJoint := NewtonConstraintCreateSlider(FNewtonWorld,
1205
@(FSliderOptions.FPivotPoint.AsVector),
1206
@(FSliderOptions.FPinDirection.AsVector),
1207
GetBodyFromGLSceneObject(FChildObject),
1208
GetBodyFromGLSceneObject(FParentObject));
1209
NewtonJointSetCollisionState(FNewtonJoint, Ord(FCollisionState));
1210
NewtonJointSetStiffness(FNewtonJoint, FStiffness);
1214
procedure BuildCorkscrew(Joint: TNGDJoint);
1217
if Assigned(FParentObject) and Assigned(FChildObject) then
1219
FNewtonJoint := NewtonConstraintCreateCorkscrew(FNewtonWorld,
1220
@(FCorkscrewOptions.FPivotPoint.AsVector),
1221
@(FCorkscrewOptions.FPinDirection.AsVector),
1222
GetBodyFromGLSceneObject(FChildObject),
1223
GetBodyFromGLSceneObject(FParentObject));
1224
NewtonJointSetCollisionState(FNewtonJoint, Ord(FCollisionState));
1225
NewtonJointSetStiffness(FNewtonJoint, FStiffness);
1229
procedure BuildUniversal(Joint: TNGDJoint);
1232
if Assigned(FParentObject) and Assigned(FChildObject) then
1234
FNewtonJoint := NewtonConstraintCreateUniversal(FNewtonWorld,
1235
@(FUniversalOptions.FPivotPoint.AsVector),
1236
@(FUniversalOptions.FPinDirection.AsVector),
1237
@(FUniversalOptions.FPinDirection2.AsVector),
1238
GetBodyFromGLSceneObject(FChildObject),
1239
GetBodyFromGLSceneObject(FParentObject));
1240
NewtonJointSetCollisionState(FNewtonJoint, Ord(FCollisionState));
1241
NewtonJointSetStiffness(FNewtonJoint, FStiffness);
1245
procedure BuildCustomBallAndSocket(Joint: TNGDJoint);
1247
pinAndPivot: TMatrix;
1250
if Assigned(FParentObject) and Assigned(FChildObject) then
1252
pinAndPivot := IdentityHmgMatrix;
1253
pinAndPivot.V[3] := FCustomBallAndSocketOptions.FPivotPoint.AsVector;
1254
FNewtonUserJoint := CreateCustomBallAndSocket(@pinAndPivot,
1255
GetBodyFromGLSceneObject(FChildObject),
1256
GetBodyFromGLSceneObject(FParentObject));
1257
BallAndSocketSetConeAngle(FNewtonUserJoint,
1258
GLVectorGeometry.DegToRad(FCustomBallAndSocketOptions.FConeAngle));
1259
BallAndSocketSetTwistAngle(FNewtonUserJoint,
1260
GLVectorGeometry.DegToRad(FCustomBallAndSocketOptions.FMinTwistAngle),
1261
GLVectorGeometry.DegToRad(FCustomBallAndSocketOptions.FMaxTwistAngle));
1262
CustomSetBodiesCollisionState(FNewtonUserJoint, Ord(FCollisionState));
1263
NewtonJointSetStiffness(CustomGetNewtonJoint(FNewtonUserJoint),
1268
procedure BuildCustomHinge(Joint: TNGDJoint);
1270
pinAndPivot: TMatrix;
1271
bso: TGLBaseSceneObject;
1273
{ Newton wait from FPinAndPivotMatrix a structure like that:1274
First row: the pin direction
1275
Second and third rows are set to create an orthogonal matrix
1276
Fourth: The pivot position
1278
In glscene, the GLBaseSceneObjects direction is the third row,
1279
because the first row is the right vector (second row is up vector). }
1281
if Assigned(FParentObject) and Assigned(FChildObject) then
1283
bso := TGLBaseSceneObject.Create(FManager);
1284
bso.AbsolutePosition := FCustomHingeOptions.FPivotPoint.AsVector;
1285
bso.AbsoluteDirection := FCustomHingeOptions.FPinDirection.AsVector;
1286
pinAndPivot := bso.AbsoluteMatrix;
1287
pinAndPivot.V[0] := bso.AbsoluteMatrix.V[2];
1288
pinAndPivot.V[2] := bso.AbsoluteMatrix.V[0];
1291
FNewtonUserJoint := CreateCustomHinge(@pinAndPivot,
1292
GetBodyFromGLSceneObject(FChildObject),
1293
GetBodyFromGLSceneObject(FParentObject));
1294
HingeEnableLimits(FNewtonUserJoint, 1);
1295
HingeSetLimits(FNewtonUserJoint,
1296
GLVectorGeometry.DegToRad(FCustomHingeOptions.FMinAngle),
1297
GLVectorGeometry.DegToRad(FCustomHingeOptions.FMaxAngle));
1298
CustomSetBodiesCollisionState(FNewtonUserJoint, Ord(FCollisionState));
1299
NewtonJointSetStiffness(CustomGetNewtonJoint(FNewtonUserJoint),
1301
CustomSetUserData(FNewtonUserJoint, CustomHingeOptions);
1305
procedure BuildCustomSlider(Joint: TNGDJoint);
1307
pinAndPivot: TMatrix;
1308
bso: TGLBaseSceneObject;
1311
{ Newton wait from FPinAndPivotMatrix a structure like that:1312
First row: the pin direction
1313
Second and third rows are set to create an orthogonal matrix
1314
Fourth: The pivot position
1316
In glscene, the GLBaseSceneObjects direction is the third row,
1317
because the first row is the right vector (second row is up vector). }
1319
if Assigned(FParentObject) and Assigned(FChildObject) then
1322
bso := TGLBaseSceneObject.Create(FManager);
1323
bso.AbsolutePosition := FCustomSliderOptions.FPivotPoint.AsVector;
1324
bso.AbsoluteDirection := FCustomSliderOptions.FPinDirection.AsVector;
1325
pinAndPivot := bso.AbsoluteMatrix;
1326
pinAndPivot.V[0] := bso.AbsoluteMatrix.V[2];
1327
pinAndPivot.V[2] := bso.AbsoluteMatrix.V[0];
1330
FNewtonUserJoint := CreateCustomSlider(@pinAndPivot, GetBodyFromGLSceneObject(FChildObject), GetBodyFromGLSceneObject(FParentObject));
1331
SliderEnableLimits(FNewtonUserJoint, 1);
1332
SliderSetLimits(FNewtonUserJoint, FCustomSliderOptions.FMinDistance, FCustomSliderOptions.FMaxDistance);
1333
NewtonJointSetStiffness(CustomGetNewtonJoint(FNewtonUserJoint),0);
1335
CustomSetBodiesCollisionState(FNewtonUserJoint, Ord(FCollisionState));
1336
CustomSetUserData(FNewtonUserJoint, CustomSliderOptions);
1340
procedure BuildUpVector(Joint: TNGDJoint);
1343
if Assigned(FParentObject) then
1345
FNewtonJoint := NewtonConstraintCreateUpVector(FNewtonWorld,
1346
@FUPVectorDirection.AsVector,
1347
GetBodyFromGLSceneObject(FParentObject));
1351
procedure BuildKinematicController(Joint: TNGDJoint);
1356
procedure BuildOneJoint(Joint: TNGDJoint);
1358
case Joint.FJointType of
1361
Joint.DestroyNewtonData;
1362
BuildBallAndSocket(Joint);
1367
Joint.DestroyNewtonData;
1373
Joint.DestroyNewtonData;
1379
Joint.DestroyNewtonData;
1380
BuildCorkscrew(Joint);
1385
Joint.DestroyNewtonData;
1386
BuildUniversal(Joint);
1389
nj_CustomBallAndSocket:
1391
Joint.DestroyNewtonData;
1392
BuildCustomBallAndSocket(Joint);
1397
Joint.DestroyNewtonData;
1398
BuildCustomHinge(Joint);
1403
Joint.DestroyNewtonData;
1404
BuildCustomSlider(Joint);
1409
Joint.DestroyNewtonData;
1410
BuildUpVector(Joint);
1413
nj_KinematicController:
1415
// DestroyJoint(Joint);
1416
// BuildKinematicController(Joint);
1425
if not(csDesigning in ComponentState) and not(csLoading in ComponentState)
1428
if Sender is TGLNGDManager then
1429
for i := 0 to NewtonJoint.Count - 1 do
1430
BuildOneJoint(NewtonJoint.Items[i] as TNGDJoint);
1432
if (Sender is TNGDJoint) then
1433
BuildOneJoint((Sender as TNGDJoint));
1435
if Sender is TGLCoordinates then
1436
BuildOneJoint(((Sender as TGLCoordinates).Owner as TNGDJoint));
1443
procedure TGLNGDManager.RebuildAllMaterial;
1445
procedure BuildMaterialPair;
1447
I, ID0, ID1: Integer;
1449
for I := 0 to FNewtonSurfacePair.Count - 1 do
1450
with (FNewtonSurfacePair.Items[I] as TNGDSurfacePair) do
1452
if Assigned(NGDSurfaceItem1) and Assigned(NGDSurfaceItem2) then
1454
ID0 := NGDSurfaceItem1.ID;
1455
ID1 := NGDSurfaceItem2.ID;
1457
NewtonMaterialSetContinuousCollisionMode(FNewtonWorld, ID0, ID1,
1458
Ord(ContinuousCollisionMode));
1460
NewtonMaterialSetSurfaceThickness(FNewtonWorld, ID0, ID1, 1);
1461
NewtonMaterialSetDefaultSoftness(FNewtonWorld, ID0, ID1, Softness);
1462
NewtonMaterialSetDefaultElasticity(FNewtonWorld, ID0, ID1,
1464
NewtonMaterialSetDefaultCollidable(FNewtonWorld, ID0, ID1,
1466
NewtonMaterialSetDefaultFriction(FNewtonWorld, ID0, ID1,
1467
StaticFriction, KineticFriction);
1469
NewtonMaterialSetCollisionCallback(FNewtonWorld, ID0, ID1,
1470
FNewtonSurfacePair.Items[I], @TNGDSurfacePair.NewtonAABBOverlap,
1471
@TNGDSurfacePair.NewtonContactsProcess);
1481
if not(csDesigning in ComponentState) then
1483
// Destroy newton materials
1484
NewtonMaterialDestroyAllGroupID(FNewtonWorld);
1486
// Create materialID
1487
for I := 0 to FNewtonSurfaceItem.Count - 1 do
1488
maxID := MaxInteger((FNewtonSurfaceItem.Items[I] as TNGDSurfaceItem).ID,
1490
for I := 0 to maxID - 1 do
1491
NewtonMaterialCreateGroupID(FNewtonWorld);
1493
// Assigned matID to bodies
1494
for I := 0 to FNGDBehaviours.Count - 1 do
1495
with FNGDBehaviours[I] do
1496
if Assigned(FNGDSurfaceItem) then
1497
NewtonBodySetMaterialGroupID(FNewtonBody, FNGDSurfaceItem.ID)
1499
NewtonBodySetMaterialGroupID(FNewtonBody, 0);
1501
// Set values to newton material pair :callback userdata friction...
1506
procedure TGLNGDManager.Step(deltatime: Single);
1508
if not(csDesigning in ComponentState) then
1509
NewtonUpdate(FNewtonWorld, deltatime);
1516
constructor TGLNGDBehaviour.Create(AOwner: TGLXCollection);
1519
FInitialized := False;
1520
FOwnerBaseSceneObject := OwnerBaseSceneObject;
1522
FContinuousCollisionMode := False;
1526
FNGDNewtonCollisions := nc_Primitive;
1528
FCollisionIteratorEvent := OnCollisionIteratorEvent;
1530
FTreeCollisionOptimize := True;
1531
FConvexCollisionTolerance := 0.01;
1532
FFileCollision := '';
1533
name := 'NGD Static';
1536
destructor TGLNGDBehaviour.Destroy;
1538
if Assigned(FManager) then
1539
Manager := nil; // This will call finalize
1543
procedure TGLNGDBehaviour.Finalize;
1547
FInitialized := False;
1549
if Assigned(FManager) then
1552
if Assigned(FManager.NewtonJoint) then
1553
for i := FManager.NewtonJoint.Count-1 downto 0 do
1555
if ((FManager.NewtonJoint.Items[i] as TNGDJoint).ParentObject = FOwnerBaseSceneObject)
1556
or ((FManager.NewtonJoint.Items[i] as TNGDJoint).ChildObject = FOwnerBaseSceneObject) then
1558
FManager.NewtonJoint.Items[i].Free;
1562
NewtonDestroyBody(FManager.FNewtonWorld, FNewtonBody);
1568
function TGLNGDBehaviour.GetBBoxCollision: PNewtonCollision;
1570
vc: array [0 .. 7] of TVector;
1573
for I := 0 to 8 - 1 do
1574
vc[I] := AABBToBB(FOwnerBaseSceneObject.AxisAlignedBoundingBoxEx).BBox[I];
1575
Result := NewtonCreateConvexHull(FManager.FNewtonWorld, 8, @vc[0],
1576
SizeOf(TVector), 0.01, 0, nil);
1579
function TGLNGDBehaviour.GetBSphereCollision: PNewtonCollision;
1581
boundingSphere: TBSphere;
1582
collisionOffsetMatrix: TMatrix;
1584
AABBToBSphere(FOwnerBaseSceneObject.AxisAlignedBoundingBoxEx, boundingSphere);
1586
collisionOffsetMatrix := IdentityHmgMatrix;
1587
collisionOffsetMatrix.V[3] := VectorMake(boundingSphere.Center, 1);
1588
Result := NewtonCreateSphere(FManager.FNewtonWorld, boundingSphere.Radius,
1589
boundingSphere.Radius, boundingSphere.Radius, 0, @collisionOffsetMatrix);
1592
function TGLNGDBehaviour.GetConvexCollision: PNewtonCollision;
1595
vertexArray: array of TVertex;
1597
if FOwnerBaseSceneObject is TGLBaseMesh then
1599
with (FOwnerBaseSceneObject as TGLBaseMesh) do
1602
for I := 0 to MeshObjects.Count - 1 do
1603
for J := 0 to MeshObjects[I].Vertices.Count - 1 do
1605
SetLength(vertexArray, Length(vertexArray) + 1);
1606
vertexArray[Length(vertexArray) - 1] := MeshObjects[I].Vertices[J];
1609
if Length(vertexArray) > 0 then
1610
Result := NewtonCreateConvexHull(FManager.FNewtonWorld,
1611
Length(vertexArray), @vertexArray[0], SizeOf(TVertex),
1612
FConvexCollisionTolerance, 0, nil)
1614
Result := GetNullCollision;
1619
Result := GetNullCollision;
1622
function TGLNGDBehaviour.GetHeightFieldCollision: PNewtonCollision;
1625
attributeMap: array of ShortInt;
1627
SetLength(attributeMap, Length(FHeightFieldOptions.heightArray));
1628
for I := 0 to Length(FHeightFieldOptions.heightArray) - 1 do
1629
attributeMap[I] := 0;
1631
Result := NewtonCreateHeightFieldCollision(FManager.FNewtonWorld,
1632
FHeightFieldOptions.width, FHeightFieldOptions.depth,
1633
Ord(FHeightFieldOptions.gridDiagonals),
1634
PUnsigned_short(FHeightFieldOptions.heightArray), P2Char(attributeMap),
1635
FHeightFieldOptions.widthDepthScale, FHeightFieldOptions.heightScale, 0);
1638
function TGLNGDBehaviour.GetMeshCollision: PNewtonCollision;
1640
collisionArray: array of PNewtonCollision;
1642
vertexArray: array of TVertex;
1644
if FOwnerBaseSceneObject is TGLBaseMesh then
1646
with (FOwnerBaseSceneObject as TGLBaseMesh) do
1649
// Iterate trough mesh of GLobject
1650
for I := 0 to MeshObjects.Count - 1 do
1652
// Iterate trough vertices of mesh
1653
for J := 0 to MeshObjects[I].Vertices.Count - 1 do
1655
SetLength(vertexArray, Length(vertexArray) + 1);
1656
vertexArray[Length(vertexArray) - 1] := MeshObjects[I].Vertices[J];
1659
if Length(vertexArray) > 3 then
1661
SetLength(collisionArray, Length(collisionArray) + 1);
1663
collisionArray[Length(collisionArray) - 1] := NewtonCreateConvexHull
1664
(FManager.FNewtonWorld, Length(vertexArray), @vertexArray[0],
1665
SizeOf(TVertex), FConvexCollisionTolerance, 0, nil);
1667
// Remove last collision if the newton function was not successful
1668
if collisionArray[Length(collisionArray) - 1] = nil then
1669
SetLength(collisionArray, Length(collisionArray) - 1);
1672
SetLength(vertexArray, 0);
1675
if Length(collisionArray) > 0 then
1676
Result := NewtonCreateCompoundCollision(FManager.FNewtonWorld,
1677
Length(collisionArray), @collisionArray[0], 0)
1679
Result := GetNullCollision;
1684
Result := GetNullCollision;
1689
function TGLNGDBehaviour.GetNewtonBodyMatrix: TMatrix;
1691
if Assigned(FManager) then
1692
NewtonBodyGetmatrix(FNewtonBody, @FNewtonBodyMatrix);
1693
Result := FNewtonBodyMatrix;
1696
function TGLNGDBehaviour.GetNewtonBodyAABB: TAABB;
1698
if Assigned(FManager) then
1699
NewtonBodyGetAABB(FNewtonBody, @(Result.min), @(Result.max));
1702
function TGLNGDBehaviour.GetNGDFileCollision: PNewtonCollision;
1704
MyFile: TFileStream;
1707
if FileExists(FFileCollision) then
1709
MyFile := TFileStream.Create(FFileCollision, fmOpenRead);
1711
Result := NewtonCreateCollisionFromSerialization(FManager.FNewtonWorld,
1712
@TGLNGDBehaviour.NewtonDeserialize, Pointer(MyFile));
1717
Result := NewtonCreateNull(FManager.FNewtonWorld);
1721
function TGLNGDBehaviour.GetNullCollision: PNewtonCollision;
1723
Result := NewtonCreateNull(FManager.FNewtonWorld);
1726
function TGLNGDBehaviour.GetPrimitiveCollision: PNewtonCollision;
1728
collisionOffsetMatrix: TMatrix; // For cone capsule and cylinder
1730
collisionOffsetMatrix := IdentityHmgMatrix;
1732
if (FOwnerBaseSceneObject is TGLCube) then
1734
with (FOwnerBaseSceneObject as TGLCube) do
1735
Result := NewtonCreateBox(FManager.FNewtonWorld, CubeWidth, CubeHeight,
1736
CubeDepth, 0, @collisionOffsetMatrix);
1739
else if (FOwnerBaseSceneObject is TGLSphere) then
1741
with (FOwnerBaseSceneObject as TGLSphere) do
1742
Result := NewtonCreateSphere(FManager.FNewtonWorld, Radius, Radius,
1743
Radius, 0, @collisionOffsetMatrix);
1746
else if (FOwnerBaseSceneObject is TGLCone) then
1748
collisionOffsetMatrix := MatrixMultiply(collisionOffsetMatrix,
1749
CreateRotationMatrixZ(Pi / 2.0));
1750
with (FOwnerBaseSceneObject as TGLCone) do
1751
Result := NewtonCreateCone(FManager.FNewtonWorld, BottomRadius, Height,
1752
0, @collisionOffsetMatrix);
1755
else if (FOwnerBaseSceneObject is TGLCapsule) then
1757
collisionOffsetMatrix := MatrixMultiply(collisionOffsetMatrix,
1758
CreateRotationMatrixY(Pi / 2.0));
1759
with (FOwnerBaseSceneObject as TGLCapsule) do
1760
// Use Cylinder shape for buoyancy
1761
Result := NewtonCreateCapsule(FManager.FNewtonWorld, Radius,
1762
Height + 2 * Radius, 0, @collisionOffsetMatrix);
1765
else if (FOwnerBaseSceneObject is TGLCylinder) then
1767
collisionOffsetMatrix := MatrixMultiply(collisionOffsetMatrix,
1768
CreateRotationMatrixZ(Pi / 2.0));
1769
with (FOwnerBaseSceneObject as TGLCylinder) do
1770
Result := NewtonCreateCylinder(FManager.FNewtonWorld, BottomRadius,
1771
Height, 0, @collisionOffsetMatrix);
1774
Result := GetNullCollision;
1777
function TGLNGDBehaviour.GetTreeCollision: PNewtonCollision;
1779
meshIndex, triangleIndex: Integer;
1780
triangleList: TAffineVectorList;
1781
v: array [0 .. 2] of TAffineVector;
1784
if FOwnerBaseSceneObject is TGLBaseMesh then
1786
with (FOwnerBaseSceneObject as TGLBaseMesh) do
1788
Result := NewtonCreateTreeCollision(FManager.FNewtonWorld, 0);
1789
NewtonTreeCollisionBeginBuild(Result);
1791
for meshIndex := 0 to MeshObjects.Count - 1 do
1793
triangleList := MeshObjects[meshIndex].ExtractTriangles;
1794
for triangleIndex := 0 to triangleList.Count - 1 do
1796
if triangleIndex mod 3 = 0 then
1798
v[0] := triangleList.Items[triangleIndex];
1799
// ScaleVector(v[0], FOwnerBaseSceneObject.Scale.X);
1800
v[1] := triangleList.Items[triangleIndex + 1];
1801
// ScaleVector(v[1], FOwnerBaseSceneObject.Scale.Y);
1802
v[2] := triangleList.Items[triangleIndex + 2];
1803
// ScaleVector(v[2], FOwnerBaseSceneObject.Scale.Z);
1804
NewtonTreeCollisionAddFace(Result, 3, @(v), SizeOf(TAffineVector),
1810
NewtonTreeCollisionEndBuild(Result, Ord(FTreeCollisionOptimize));
1814
Result := GetNullCollision;
1818
procedure TGLNGDBehaviour.Initialize;
1820
FInitialized := True;
1822
if Assigned(FManager) then
1824
// Create NewtonBody with null collision
1825
FCollision := NewtonCreateNull(FManager.FNewtonWorld);
1826
FNewtonBodyMatrix := FOwnerBaseSceneObject.AbsoluteMatrix;
1827
FNewtonBody := NewtonCreateBody(FManager.FNewtonWorld, FCollision,
1828
@FNewtonBodyMatrix);
1830
// Release NewtonCollision
1831
NewtonReleaseCollision(FManager.FNewtonWorld, FCollision);
1833
// Set Link between glscene and newton
1834
NewtonBodySetUserdata(FNewtonBody, self);
1836
// Set position and orientation
1837
SetNewtonBodyMatrix(FOwnerBaseSceneObject.AbsoluteMatrix);
1845
procedure TGLNGDBehaviour.Loaded;
1850
if FManagerName <> '' then
1852
mng := FindManager(TGLNGDManager, FManagerName);
1853
if Assigned(mng) then
1854
Manager := TGLNGDManager(mng);
1858
if Assigned(FManager) then
1860
SetContinuousCollisionMode(FContinuousCollisionMode);
1864
class procedure TGLNGDBehaviour.NewtonCollisionIterator
1865
(const userData: Pointer; vertexCount: Integer; const faceArray: PNGDFloat;
1866
faceId: Integer)cdecl; static;
1868
TGLNGDBehaviour(userData).FCollisionIteratorEvent(userData, vertexCount,
1872
// Serializes are called by NGDBehaviour to save and load collision in file
1873
// It's better to save/load big collisions [over 50000 polygones] to reduce
1875
class procedure TGLNGDBehaviour.NewtonDeserialize(serializeHandle,
1876
buffer: Pointer; size: Cardinal)cdecl; static;
1878
TFileStream(serializeHandle).read(buffer^, size);
1881
class procedure TGLNGDBehaviour.NewtonSerialize(serializeHandle: Pointer;
1882
const buffer: Pointer; size: Cardinal)cdecl; static;
1885
TFileStream(serializeHandle).write(buffer^, size);
1888
procedure TGLNGDBehaviour.OnCollisionIteratorEvent(const userData: Pointer;
1889
vertexCount: Integer; const cfaceArray: PNGDFloat; faceId: Integer);
1892
v0, v1: array [0 .. 2] of Single;
1893
vA: array of Single;
1895
// This algorithme draw Collision Shape for Debuggin.
1896
// Taken to Sascha Willems in SDLNewton-Demo at
1897
// http://www.saschawillems.de/?page_id=82
1899
// Leave if there is no or to much vertex
1900
if (vertexCount = 0) then
1903
SetLength(vA, vertexCount * 3);
1904
Move(cfaceArray^, vA[0], vertexCount * 3 * SizeOf(Single));
1905
v0[0] := vA[(vertexCount - 1) * 3];
1906
v0[1] := vA[(vertexCount - 1) * 3 + 1];
1907
v0[2] := vA[(vertexCount - 1) * 3 + 2];
1908
for I := 0 to vertexCount - 1 do
1911
v1[1] := vA[I * 3 + 1];
1912
v1[2] := vA[I * 3 + 2];
1913
FManager.AddNode(v0[0], v0[1], v0[2]);
1914
FManager.AddNode(v1[0], v1[1], v1[2]);
1919
procedure TGLNGDBehaviour.Reinitialize;
1923
// Set Appropriate NewtonCollision
1925
// Set position and orientation
1926
SetNewtonBodyMatrix(FOwnerBaseSceneObject.AbsoluteMatrix);
1931
procedure TGLNGDBehaviour.Render;
1935
// Rebuild collision in design time
1936
if (csDesigning in FOwnerBaseSceneObject.ComponentState) then
1939
if self is TGLNGDDynamic then
1940
FManager.FCurrentColor := FManager.DebugOption.GeomColorDyn
1942
FManager.FCurrentColor := FManager.DebugOption.GeomColorStat;
1944
M := FOwnerBaseSceneObject.AbsoluteMatrix;
1946
if mdShowGeometry in FManager.DebugOption.NGDManagerDebugs then
1947
NewtonCollisionForEachPolygonDo(FCollision, @M,
1948
@TGLNGDBehaviour.NewtonCollisionIterator, self);
1951
// In this procedure, we assign collision to body
1952
// [Because when initialised, the collision for body is type NULL]
1953
procedure TGLNGDBehaviour.UpdCollision;
1955
collisionInfoRecord: TNewtonCollisionInfoRecord;
1958
case FNGDNewtonCollisions of
1960
FCollision := GetPrimitiveCollision;
1962
FCollision := GetConvexCollision;
1964
FCollision := GetBBoxCollision;
1966
FCollision := GetBSphereCollision;
1968
FCollision := GetTreeCollision;
1970
FCollision := GetMeshCollision;
1972
FCollision := GetNullCollision;
1974
FCollision := GetHeightFieldCollision;
1976
FCollision := GetNGDFileCollision;
1979
if Assigned(FCollision) then
1981
NewtonBodySetCollision(FNewtonBody, FCollision);
1983
// The API Ask for releasing Collision to avoid memory leak
1984
NewtonCollisionGetInfo(FCollision, @collisionInfoRecord);
1985
if collisionInfoRecord.m_referenceCount > 2 then
1986
NewtonReleaseCollision(FManager.FNewtonWorld, FCollision);
1991
procedure TGLNGDBehaviour.SetContinuousCollisionMode(const Value: Boolean);
1993
// for continue collision to be active the continue collision mode must on
1994
// the material pair of the colliding bodies as well as on at
1995
// least one of the two colliding bodies.
1996
// see NewtonBodySetContinuousCollisionMode
1997
// see NewtonMaterialSetContinuousCollisionMode
1998
FContinuousCollisionMode := Value;
1999
if not(csDesigning in FOwnerBaseSceneObject.ComponentState) then
2000
if Assigned(FManager) then
2001
NewtonBodySetContinuousCollisionMode(FNewtonBody, Ord(Value));
2004
procedure TGLNGDBehaviour.SetHeightFieldOptions(const Value: THeightField);
2006
FHeightFieldOptions := Value;
2010
procedure TGLNGDBehaviour.SetManager(Value: TGLNGDManager);
2012
if FManager <> Value then
2014
if Assigned(FManager) then
2018
FManager.FNGDBehaviours.Remove(self);
2019
// FManager.NotifyChange(self);
2022
if Assigned(FManager) then
2025
FManager.FNGDBehaviours.Add(self);
2026
FManager.NotifyChange(self);
2031
procedure TGLNGDBehaviour.SetNewtonBodyMatrix(const Value: TMatrix);
2033
FNewtonBodyMatrix := Value;
2034
if Assigned(FManager) then
2035
NewtonBodySetmatrix(FNewtonBody, @FNewtonBodyMatrix);
2038
procedure TGLNGDBehaviour.SetNGDNewtonCollisions
2039
(const Value: TNGDNewtonCollisions);
2041
FNGDNewtonCollisions := Value;
2042
if Assigned(FManager) then
2046
procedure TGLNGDBehaviour.SetNGDSurfaceItem(const Value: TNGDSurfaceItem);
2048
FNGDSurfaceItem := Value;
2049
FManager.RebuildAllMaterial;
2052
function TGLNGDBehaviour.StoredTolerance: Boolean;
2054
Result := not SameValue(FConvexCollisionTolerance, 0.01, epsilon);
2057
class function TGLNGDBehaviour.UniqueItem: Boolean;
2062
procedure TGLNGDBehaviour.ReadFromFiler(reader: TReader);
2069
version := ReadInteger; // read data version
2070
Assert(version <= 1); // Archive version
2072
FManagerName := ReadString;
2073
FContinuousCollisionMode := ReadBoolean;
2074
read(FNGDNewtonCollisions, SizeOf(TNGDNewtonCollisions));
2075
FTreeCollisionOptimize := ReadBoolean;
2076
if version <= 0 then
2077
FConvexCollisionTolerance := ReadSingle
2079
FConvexCollisionTolerance := ReadFloat;
2080
FFileCollision := ReadString;
2084
procedure TGLNGDBehaviour.WriteToFiler(writer: TWriter);
2089
WriteInteger(1); // Archive version
2090
if Assigned(FManager) then
2091
WriteString(FManager.GetNamePath)
2094
WriteBoolean(FContinuousCollisionMode);
2095
write(FNGDNewtonCollisions, SizeOf(TNGDNewtonCollisions));
2096
WriteBoolean(FTreeCollisionOptimize);
2097
WriteFloat(FConvexCollisionTolerance);
2098
WriteString(FFileCollision);
2102
procedure TGLNGDBehaviour.Serialize(filename: string);
2104
MyFile: TFileStream;
2106
MyFile := TFileStream.Create(filename, fmCreate or fmOpenReadWrite);
2108
NewtonCollisionSerialize(FManager.FNewtonWorld, FCollision,
2109
@TGLNGDBehaviour.NewtonSerialize, Pointer(MyFile));
2114
procedure TGLNGDBehaviour.DeSerialize(filename: string);
2116
MyFile: TFileStream;
2117
collisionInfoRecord: TNewtonCollisionInfoRecord;
2119
MyFile := TFileStream.Create(filename, fmOpenRead);
2121
FCollision := NewtonCreateCollisionFromSerialization(FManager.FNewtonWorld,
2122
@TGLNGDBehaviour.NewtonDeserialize, Pointer(MyFile));
2125
NewtonBodySetCollision(FNewtonBody, FCollision);
2127
// Release collision
2128
NewtonCollisionGetInfo(FCollision, @collisionInfoRecord);
2129
if collisionInfoRecord.m_referenceCount > 2 then
2130
NewtonReleaseCollision(FManager.FNewtonWorld, FCollision);
2137
procedure TGLNGDDynamic.AddImpulse(const veloc, pointposit: TVector);
2139
if Assigned(FNewtonBody) then
2140
NewtonBodyAddImpulse(FNewtonBody, @veloc, @pointposit);
2143
constructor TGLNGDDynamic.Create(AOwner: TGLXCollection);
2147
FLinearDamping := 0.1;
2148
FAngularDamping := TGLCoordinates.CreateInitialized(self,
2149
VectorMake(0.1, 0.1, 0.1, 0), csPoint);
2150
FAngularDamping.OnNotifyChange := NotifyAngularDampingChange;
2153
FForce := TGLCoordinates.CreateInitialized(self, NullHmgVector, csVector);
2154
FTorque := TGLCoordinates.CreateInitialized(self, NullHmgVector, csVector);
2155
FCenterOfMass := TGLCoordinates.CreateInitialized(self, NullHmgVector,
2157
FCenterOfMass.OnNotifyChange := NotifyCenterOfMassChange;
2158
FAABBmin := TGLCoordinates.CreateInitialized(self, NullHmgVector, csPoint);
2159
FAABBmax := TGLCoordinates.CreateInitialized(self, NullHmgVector, csPoint);
2160
FAppliedOmega := TGLCoordinates.CreateInitialized(self, NullHmgVector,
2162
FAppliedVelocity := TGLCoordinates.CreateInitialized(self, NullHmgVector,
2164
FAppliedForce := TGLCoordinates.CreateInitialized(self, NullHmgVector,
2166
FAppliedTorque := TGLCoordinates.CreateInitialized(self, NullHmgVector,
2168
FUseGravity := True;
2169
FNullCollisionVolume := 0;
2171
FApplyForceAndTorqueEvent := OnApplyForceAndTorqueEvent;
2172
FSetTransformEvent := OnSetTransformEvent;
2173
name := 'NGD Dynamic'
2176
destructor TGLNGDDynamic.Destroy;
2178
// Clean up everything
2179
FAngularDamping.Free;
2186
FAppliedTorque.Free;
2187
FAppliedVelocity.Free;
2192
procedure TGLNGDDynamic.Finalize;
2194
if not(csDesigning in FOwnerBaseSceneObject.ComponentState) then
2195
if Assigned(FManager) then
2197
// Removing Callback
2198
NewtonBodySetForceAndTorqueCallback(FNewtonBody, nil);
2199
NewtonBodySetTransformCallback(FNewtonBody, nil);
2204
class function TGLNGDDynamic.FriendlyName: string;
2206
Result := 'NGD Dynamic';
2210
procedure TGLNGDDynamic.Initialize;
2213
if not(csDesigning in FOwnerBaseSceneObject.ComponentState) then
2214
if Assigned(FManager) then
2216
// Set Density, Mass and inertie matrix
2217
SetDensity(FDensity);
2220
NewtonBodySetForceAndTorqueCallback(FNewtonBody,
2221
@TGLNGDDynamic.NewtonApplyForceAndTorque);
2222
NewtonBodySetTransformCallback(FNewtonBody,
2223
@TGLNGDDynamic.NewtonSetTransform);
2227
procedure TGLNGDDynamic.Render;
2229
procedure DrawAABB(min, max: TGLCoordinates3);
2244
FManager.AddNode(min.X, min.Y, min.Z); // E
2245
FManager.AddNode(max.X, min.Y, min.Z); // F
2247
FManager.AddNode(max.X, min.Y, min.Z); // F
2248
FManager.AddNode(max.X, max.Y, min.Z); // G
2250
FManager.AddNode(max.X, max.Y, min.Z); // G
2251
FManager.AddNode(min.X, max.Y, min.Z); // H
2253
FManager.AddNode(min.X, max.Y, min.Z); // H
2254
FManager.AddNode(min.X, min.Y, min.Z); // E
2257
FManager.AddNode(min.X, min.Y, max.Z); // A
2258
FManager.AddNode(max.X, min.Y, max.Z); // B
2260
FManager.AddNode(max.X, min.Y, max.Z); // B
2261
FManager.AddNode(max.X, max.Y, max.Z); // C
2263
FManager.AddNode(max.X, max.Y, max.Z); // C
2264
FManager.AddNode(min.X, max.Y, max.Z); // D
2266
FManager.AddNode(min.X, max.Y, max.Z); // D
2267
FManager.AddNode(min.X, min.Y, max.Z); // A
2270
FManager.AddNode(min.X, min.Y, max.Z); // A
2271
FManager.AddNode(min.X, min.Y, min.Z); // E
2273
FManager.AddNode(max.X, min.Y, max.Z); // B
2274
FManager.AddNode(max.X, min.Y, min.Z); // F
2276
FManager.AddNode(max.X, max.Y, max.Z); // C
2277
FManager.AddNode(max.X, max.Y, min.Z); // G
2279
FManager.AddNode(min.X, max.Y, max.Z); // D
2280
FManager.AddNode(min.X, max.Y, min.Z); // H
2283
procedure DrawContact;
2286
thisContact: PNewtonJoint;
2287
material: PNewtonMaterial;
2290
FManager.FCurrentColor := FManager.DebugOption.ContactColor;
2291
cnt := NewtonBodyGetFirstContactJoint(FNewtonBody);
2294
thisContact := NewtonContactJointGetFirstContact(cnt);
2295
while thisContact <> nil do
2297
material := NewtonContactGetMaterial(thisContact);
2298
NewtonMaterialGetContactPositionAndNormal(material, FNewtonBody, @pos, @nor);
2300
FManager.AddNode(pos);
2301
nor := VectorAdd(pos, nor);
2302
FManager.AddNode(nor);
2304
thisContact := NewtonContactJointGetNextContact(cnt, thisContact);
2306
cnt := NewtonBodyGetNextContactJoint(FNewtonBody, cnt);
2310
function GetAbsCom(): TVector;
2314
NewtonBodyGetCentreOfMass(FNewtonBody, @Result);
2315
M := IdentityHmgMatrix;
2318
M := MatrixMultiply(M, FOwnerBaseSceneObject.AbsoluteMatrix);
2322
procedure DrawForce;
2329
if mdShowForce in FManager.DebugOption.NGDManagerDebugs then
2331
FManager.FCurrentColor := FManager.DebugOption.ForceColor;
2332
nor := VectorAdd(pos, FForce.AsVector);
2333
FManager.AddNode(pos);
2334
FManager.AddNode(nor);
2337
if mdShowAppliedForce in FManager.DebugOption.NGDManagerDebugs then
2339
FManager.FCurrentColor := FManager.DebugOption.AppliedForceColor;
2340
nor := VectorAdd(pos, FAppliedForce.AsVector);
2341
FManager.AddNode(pos);
2342
FManager.AddNode(nor);
2346
if mdShowAppliedVelocity in FManager.DebugOption.NGDManagerDebugs then
2348
FManager.FCurrentColor := FManager.DebugOption.AppliedVelocityColor;
2349
nor := VectorAdd(pos, FAppliedVelocity.AsVector);
2350
FManager.AddNode(pos);
2351
FManager.AddNode(nor);
2361
FManager.FCurrentColor := FManager.DebugOption.CenterOfMassColor;
2362
size := FManager.DebugOption.DotAxisSize;
2364
FManager.AddNode(VectorAdd(com, VectorMake(0, 0, size)));
2365
FManager.AddNode(VectorAdd(com, VectorMake(0, 0, -size)));
2366
FManager.AddNode(VectorAdd(com, VectorMake(0, size, 0)));
2367
FManager.AddNode(VectorAdd(com, VectorMake(0, -size, 0)));
2368
FManager.AddNode(VectorAdd(com, VectorMake(size, 0, 0)));
2369
FManager.AddNode(VectorAdd(com, VectorMake(-size, 0, 0)));
2375
// Move/Rotate NewtonObject if matrix are not equal in design time.
2376
if (csDesigning in FOwnerBaseSceneObject.ComponentState) then
2377
if not MatrixEquals(NewtonBodyMatrix, FOwnerBaseSceneObject.AbsoluteMatrix)
2379
SetNewtonBodyMatrix(FOwnerBaseSceneObject.AbsoluteMatrix);
2381
NewtonBodyGetAABB(FNewtonBody, @(FAABBmin.AsVector), @(FAABBmax.AsVector));
2383
if NewtonBodyGetSleepState(FNewtonBody) = 1 then
2384
FManager.FCurrentColor := FManager.DebugOption.AABBColorSleep
2386
FManager.FCurrentColor := FManager.DebugOption.AABBColor;
2388
if mdShowAABB in FManager.DebugOption.NGDManagerDebugs then
2389
DrawAABB(FAABBmin, FAABBmax);
2391
if mdShowContact in FManager.DebugOption.NGDManagerDebugs then
2394
DrawForce; // Draw Force, AppliedForce and AppliedVelocity
2396
if mdShowCenterOfMass in FManager.DebugOption.NGDManagerDebugs then
2400
procedure TGLNGDDynamic.SetAutoSleep(const Value: Boolean);
2402
FAutoSleep := Value;
2403
if not(csDesigning in FOwnerBaseSceneObject.ComponentState) then
2404
if Assigned(FManager) then
2405
NewtonBodySetAutoSleep(FNewtonBody, Ord(FAutoSleep));
2408
procedure TGLNGDDynamic.SetDensity(const Value: Single);
2413
if Assigned(FManager) then
2418
FVolume := NewtonConvexCollisionCalculateVolume(FCollision);
2419
NewtonConvexCollisionCalculateInertialMatrix(FCollision, @inertia,
2422
if IsZero(FVolume, epsilon) then
2424
FVolume := FNullCollisionVolume;
2425
inertia := VectorMake(FNullCollisionVolume, FNullCollisionVolume,
2426
FNullCollisionVolume, 0);
2429
FMass := FVolume * FDensity;
2431
if not(csDesigning in FOwnerBaseSceneObject.ComponentState) then
2432
NewtonBodySetMassMatrix(FNewtonBody, FMass, FMass * inertia.V[0],
2433
FMass * inertia.V[1], FMass * inertia.V[2]);
2435
FCenterOfMass.AsVector := origin;
2439
procedure TGLNGDDynamic.SetLinearDamping(const Value: Single);
2441
if (Value >= 0) and (Value <= 1) then
2442
FLinearDamping := Value;
2443
if not(csDesigning in FOwnerBaseSceneObject.ComponentState) then
2444
if Assigned(FManager) then
2445
NewtonBodySetLinearDamping(FNewtonBody, FLinearDamping);
2448
function TGLNGDDynamic.GetOmega: TVector;
2450
NewtonBodyGetOmega(FNewtonBody, @Result);
2453
procedure TGLNGDDynamic.SetOmega(const Omega: TVector);
2455
NewtonBodySetOmega(FNewtonBody, @Omega);
2458
function TGLNGDDynamic.GetVelocity: TVector;
2460
NewtonBodyGetVelocity(FNewtonBody, @Result);
2463
procedure TGLNGDDynamic.SetVelocity(const Velocity: TVector);
2465
NewtonBodySetVelocity(FNewtonBody, @Velocity);
2468
function TGLNGDDynamic.StoredDensity: Boolean;
2470
Result := not SameValue(FDensity, 1, epsilon);
2473
function TGLNGDDynamic.StoredLinearDamping: Boolean;
2475
Result := not SameValue(FLinearDamping, 0.1, epsilon);
2478
function TGLNGDDynamic.StoredNullCollisionVolume: Boolean;
2480
Result := not SameValue(FNullCollisionVolume, 0, epsilon);
2485
procedure TGLNGDDynamic.WriteToFiler(writer: TWriter);
2490
WriteInteger(1); // Archive version
2491
WriteBoolean(FAutoSleep);
2492
WriteFloat(FLinearDamping);
2493
WriteFloat(FDensity);
2494
WriteBoolean(FUseGravity);
2495
WriteFloat(FNullCollisionVolume);
2497
FForce.WriteToFiler(writer);
2498
FTorque.WriteToFiler(writer);
2499
FCenterOfMass.WriteToFiler(writer);
2500
FAngularDamping.WriteToFiler(writer);
2505
procedure TGLNGDDynamic.ReadFromFiler(reader: TReader);
2512
version := ReadInteger; // read data version
2513
Assert(version <= 1); // Archive version
2515
FAutoSleep := ReadBoolean;
2516
if version <= 0 then
2517
FLinearDamping := ReadSingle
2519
FLinearDamping := ReadFloat;
2520
if version <= 0 then
2521
FDensity := ReadSingle
2523
FDensity := ReadFloat;
2525
// if Version >= 1 then
2526
FUseGravity := ReadBoolean;
2528
if version <= 0 then
2529
FNullCollisionVolume := ReadSingle
2531
FNullCollisionVolume := ReadFloat;
2534
FForce.ReadFromFiler(reader);
2535
FTorque.ReadFromFiler(reader);
2536
FCenterOfMass.ReadFromFiler(reader);
2537
FAngularDamping.ReadFromFiler(reader);
2540
procedure TGLNGDDynamic.Loaded;
2543
if Assigned(FManager) then
2545
SetAutoSleep(FAutoSleep);
2546
SetLinearDamping(FLinearDamping);
2547
SetDensity(FDensity);
2548
NotifyCenterOfMassChange(self);
2549
NotifyAngularDampingChange(self);
2553
class procedure TGLNGDDynamic.NewtonApplyForceAndTorque
2554
(const body: PNewtonBody; timestep: NGDFloat; threadIndex: Integer); cdecl; static;
2556
TGLNGDDynamic(NewtonBodyGetUserData(body)).FApplyForceAndTorqueEvent(body,
2557
timestep, threadIndex);
2560
class procedure TGLNGDDynamic.NewtonSetTransform(const body: PNewtonBody;
2561
const matrix: PNGDFloat; threadIndex: Integer); cdecl; static;
2563
TGLNGDDynamic(NewtonBodyGetUserData(body)).FSetTransformEvent(body, matrix,
2567
procedure TGLNGDDynamic.NotifyAngularDampingChange(Sender: TObject);
2569
FAngularDamping.OnNotifyChange := nil;
2570
if (FAngularDamping.X >= 0) and (FAngularDamping.X <= 1) and
2571
(FAngularDamping.Y >= 0) and (FAngularDamping.Y <= 1) and
2572
(FAngularDamping.Z >= 0) and (FAngularDamping.Z <= 1) then
2573
if Assigned(FManager) then
2574
NewtonBodySetAngularDamping(FNewtonBody, @(FAngularDamping.AsVector));
2575
FAngularDamping.OnNotifyChange := NotifyAngularDampingChange;
2578
procedure TGLNGDDynamic.NotifyCenterOfMassChange(Sender: TObject);
2580
FCenterOfMass.OnNotifyChange := nil;
2581
if Assigned(FManager) then
2582
NewtonBodySetCentreOfMass(FNewtonBody, @(FCenterOfMass.AsVector));
2583
FCenterOfMass.OnNotifyChange := NotifyCenterOfMassChange;
2586
procedure TGLNGDDynamic.OnApplyForceAndTorqueEvent(const cbody: PNewtonBody;
2587
timestep: NGDFloat; threadIndex: Integer);
2589
worldGravity: TVector;
2592
// Read Only: We get the force and torque resulting from every interaction on this body
2593
NewtonBodyGetForce(cbody, @(FAppliedForce.AsVector));
2594
NewtonBodyGetTorque(cbody, @(FAppliedTorque.AsVector));
2596
NewtonBodyGetVelocity(cbody, @(FAppliedVelocity.AsVector));
2597
NewtonBodyGetOmega(cbody, @(FAppliedOmega.AsVector));
2599
// Raise Custom event
2600
if Assigned(FCustomForceAndTorqueEvent) then
2601
FCustomForceAndTorqueEvent(cbody, timestep, threadIndex)
2604
NewtonBodySetForce(cbody, @(Force.AsVector));
2605
NewtonBodySetTorque(cbody, @(Torque.AsVector));
2607
// Add Gravity from World
2610
worldGravity := VectorScale(FManager.Gravity.AsVector, FMass);
2611
NewtonBodyAddForce(cbody, @(worldGravity));
2617
procedure TGLNGDDynamic.OnSetTransformEvent(const cbody: PNewtonBody;
2618
const cmatrix: PNGDFloat; threadIndex: Integer);
2622
// The Newton API does not support scale [scale modifie value in matrix],
2623
// so this line reset scale of the glsceneObject to (1,1,1)
2624
// to avoid crashing the application
2626
with FOwnerBaseSceneObject do
2627
if not SameValue(Scale.X, 1.0, epsi) or not SameValue(Scale.Y, 1.0, epsi)
2628
or not SameValue(Scale.Z, 1.0, epsi) then
2630
Scale.SetVector(1, 1, 1);
2631
SetNewtonBodyMatrix(AbsoluteMatrix);
2634
// Make the Position and orientation of the glscene-Object relative to the
2635
// NewtonBody position and orientation.
2636
FOwnerBaseSceneObject.AbsoluteMatrix := pMatrix(cmatrix)^;
2641
procedure TGLNGDStatic.Render;
2644
// Move/Rotate NewtonObject if matrix are not equal in run time.
2645
if not MatrixEquals(NewtonBodyMatrix, FOwnerBaseSceneObject.AbsoluteMatrix)
2647
SetNewtonBodyMatrix(FOwnerBaseSceneObject.AbsoluteMatrix);
2651
class function TGLNGDStatic.FriendlyName: string;
2653
Result := 'NGD Static';
2658
function TNGDSurfaceItem.GetDisplayName: string;
2660
if FDisplayName = '' then
2661
FDisplayName := 'Iron';
2662
Result := FDisplayName;
2665
procedure TNGDSurfaceItem.SetDisplayName(const Value: string);
2668
FDisplayName := Value;
2673
constructor TNGDSurfacePair.Create(Collection: TCollection);
2678
FCollidable := True;
2679
FStaticFriction := 0.9;
2680
FKineticFriction := 0.5;
2681
FContinuousCollisionMode := False;
2682
FThickness := False;
2684
FAABBOverlapEvent := OnNewtonAABBOverlapEvent;
2685
FContactProcessEvent := OnNewtonContactsProcessEvent;
2686
FManager := TGLNGDManager(Collection.Owner);
2687
FManager.RebuildAllMaterial;
2690
class function TNGDSurfacePair.NewtonAABBOverlap
2691
(const material: PNewtonMaterial;
2692
const body0, body1: PNewtonBody; threadIndex: Integer): Integer; cdecl; static;
2694
Result := Ord(TNGDSurfacePair(NewtonMaterialGetMaterialPairUserData(material))
2695
.FAABBOverlapEvent(material, body0, body1, threadIndex));
2698
class procedure TNGDSurfacePair.NewtonContactsProcess
2699
(const contact: PNewtonJoint; timestep: NGDFloat; threadIndex: Integer); cdecl; static;
2701
TNGDSurfacePair(NewtonMaterialGetMaterialPairUserData
2702
(NewtonContactGetMaterial
2703
(NewtonContactJointGetFirstContact(contact)))).FContactProcessEvent
2704
(contact, timestep, threadIndex);
2707
function TNGDSurfacePair.OnNewtonAABBOverlapEvent
2708
(const cmaterial: PNewtonMaterial; const cbody0, cbody1: PNewtonBody;
2709
threadIndex: Integer): Boolean;
2714
procedure TNGDSurfacePair.OnNewtonContactsProcessEvent
2715
(const ccontact: PNewtonJoint; timestep: NGDFloat; threadIndex: Integer);
2720
procedure TNGDSurfacePair.SetCollidable(const Value: Boolean);
2722
FCollidable := Value;
2723
FManager.RebuildAllMaterial;
2726
procedure TNGDSurfacePair.SetContinuousCollisionMode(const Value: Boolean);
2728
FContinuousCollisionMode := Value;
2729
FManager.RebuildAllMaterial;
2732
procedure TNGDSurfacePair.SetElasticity(const Value: Single);
2734
if (Value >= 0) then
2735
FElasticity := Value;
2736
FManager.RebuildAllMaterial;
2739
procedure TNGDSurfacePair.SetKineticFriction(const Value: Single);
2741
if (Value >= 0) and (Value <= 1) then
2742
FKineticFriction := Value;
2743
FManager.RebuildAllMaterial;
2746
procedure TNGDSurfacePair.SetMaterialItems(const item1, item2: TNGDSurfaceItem);
2748
FNGDSurfaceItem1 := item1;
2749
FNGDSurfaceItem2 := item2;
2750
FManager.RebuildAllMaterial;
2753
procedure TNGDSurfacePair.SetSoftness(const Value: Single);
2755
if (Value >= 0) and (Value <= 1) then
2757
FManager.RebuildAllMaterial;
2760
procedure TNGDSurfacePair.SetStaticFriction(const Value: Single);
2762
if (Value >= 0) and (Value <= 1) then
2763
FStaticFriction := Value;
2764
FManager.RebuildAllMaterial;
2767
procedure TNGDSurfacePair.SetThickness(const Value: Boolean);
2769
FThickness := Value;
2770
FManager.RebuildAllMaterial;
2773
function TNGDSurfacePair.StoredElasticity: Boolean;
2775
Result := not SameValue(FElasticity, 0.4, epsilon);
2778
function TNGDSurfacePair.StoredKineticFriction: Boolean;
2780
Result := not SameValue(FKineticFriction, 0.5, epsilon);
2783
function TNGDSurfacePair.StoredSoftness: Boolean;
2785
Result := not SameValue(FSoftness, 0.1, epsilon);
2788
function TNGDSurfacePair.StoredStaticFriction: Boolean;
2790
Result := not SameValue(FStaticFriction, 0.9, epsilon);
2795
constructor TNGDJoint.Create(Collection: TCollection);
2798
FCollisionState := False;
2800
FNewtonJoint := nil;
2801
FNewtonUserJoint := nil;
2802
FParentObject := nil;
2803
FChildObject := nil;
2805
FManager := TGLNGDManager(Collection.Owner);
2807
FBallAndSocketOptions := TNGDJointPivot.Create(FManager, self);
2808
FHingeOptions := TNGDJointPin.Create(FManager, self);
2809
FSliderOptions := TNGDJointPin.Create(FManager, self);
2810
FCorkscrewOptions := TNGDJointPin.Create(FManager, self);
2811
FUniversalOptions := TNGDJointPin2.Create(FManager, self);
2813
FCustomBallAndSocketOptions := TNGDJointBallAndSocket.Create(FManager, self);
2814
FCustomHingeOptions := TNGDJointHinge.Create(FManager, self);
2815
FCustomSliderOptions := TNGDJointSlider.Create(FManager, self);
2816
FKinematicOptions := TNGDJointKinematicController.Create;
2818
FUPVectorDirection := TGLCoordinates.CreateInitialized(self, YHmgVector,
2820
FUPVectorDirection.OnNotifyChange := FManager.RebuildAllJoint;
2823
destructor TNGDJoint.Destroy;
2827
FParentObject := nil;
2828
FChildObject := nil;
2831
FBallAndSocketOptions.Free;
2833
FSliderOptions.Free;
2834
FCorkscrewOptions.Free;
2835
FUniversalOptions.Free;
2837
FCustomBallAndSocketOptions.Free;
2838
FCustomHingeOptions.Free;
2839
FCustomSliderOptions.Free;
2840
FKinematicOptions.Free;
2841
FUPVectorDirection.Free;
2845
procedure TNGDJoint.DestroyNewtonData;
2847
if FNewtonJoint <> nil then
2849
Assert((FManager <> nil) and (FManager.FNewtonWorld <> nil));
2850
NewtonDestroyJoint(FManager.FNewtonWorld, FNewtonJoint);
2851
FNewtonJoint := nil;
2853
if FNewtonUserJoint <> nil then
2855
CustomDestroyJoint(FNewtonUserJoint);
2856
FNewtonUserJoint := nil;
2860
procedure TNGDJoint.KinematicControllerPick(pickpoint: TVector;
2861
PickedActions: TNGDPickedActions);
2863
if FJointType = nj_KinematicController then
2864
if Assigned(FParentObject) then
2867
if PickedActions = paAttach then
2869
if not Assigned(FNewtonUserJoint) then
2870
if Assigned(GetNGDDynamic(FParentObject).FNewtonBody) then
2871
FNewtonUserJoint := CreateCustomKinematicController
2872
(GetNGDDynamic(FParentObject).FNewtonBody, @pickpoint);
2875
// Change the TargetPoint
2876
if (PickedActions = paMove) or (PickedActions = paAttach) then
2878
if Assigned(FNewtonUserJoint) then
2880
CustomKinematicControllerSetPickMode(FNewtonUserJoint,
2881
Ord(FKinematicOptions.FPickModeLinear));
2882
CustomKinematicControllerSetMaxLinearFriction(FNewtonUserJoint,
2883
FKinematicOptions.FLinearFriction);
2884
CustomKinematicControllerSetMaxAngularFriction(FNewtonUserJoint,
2885
FKinematicOptions.FAngularFriction);
2886
CustomKinematicControllerSetTargetPosit(FNewtonUserJoint, @pickpoint);
2891
if PickedActions = paDetach then
2893
if Assigned(FNewtonUserJoint) then
2895
CustomDestroyJoint(FNewtonUserJoint);
2896
FNewtonUserJoint := nil;
2897
// Reset autosleep because this joint turns it off
2898
NewtonBodySetAutoSleep(GetNGDDynamic(FParentObject).FNewtonBody,
2899
Ord(GetNGDDynamic(FParentObject).AutoSleep));
2901
ParentObject := nil;
2906
procedure TNGDJoint.Render;
2908
procedure DrawPivot(pivot: TVector);
2912
size := FManager.DebugOption.DotAxisSize;
2913
FManager.FCurrentColor := FManager.DebugOption.JointPivotColor;
2914
FManager.AddNode(VectorAdd(pivot, VectorMake(0, 0, size)));
2915
FManager.AddNode(VectorAdd(pivot, VectorMake(0, 0, -size)));
2916
FManager.AddNode(VectorAdd(pivot, VectorMake(0, size, 0)));
2917
FManager.AddNode(VectorAdd(pivot, VectorMake(0, -size, 0)));
2918
FManager.AddNode(VectorAdd(pivot, VectorMake(size, 0, 0)));
2919
FManager.AddNode(VectorAdd(pivot, VectorMake(-size, 0, 0)));
2922
procedure DrawPin(pin, pivot: TVector);
2924
FManager.FCurrentColor := FManager.DebugOption.JointAxisColor;
2925
FManager.AddNode(VectorAdd(pivot, pin));
2926
FManager.AddNode(VectorAdd(pivot, VectorNegate(pin)));
2929
procedure DrawJoint(pivot: TVector);
2931
FManager.FCurrentColor := FManager.DebugOption.CustomColor;
2932
FManager.AddNode(FParentObject.AbsolutePosition);
2933
FManager.AddNode(pivot);
2934
FManager.AddNode(pivot);
2935
FManager.AddNode(FChildObject.AbsolutePosition);
2938
procedure DrawKinematic;
2940
pickedMatrix: TMatrix;
2943
size := FManager.DebugOption.DotAxisSize;
2944
CustomKinematicControllerGetTargetMatrix(FNewtonUserJoint, @pickedMatrix);
2945
FManager.FCurrentColor := FManager.DebugOption.JointAxisColor;
2947
FManager.AddNode(FParentObject.AbsolutePosition);
2948
FManager.AddNode(pickedMatrix.V[3]);
2950
FManager.FCurrentColor := FManager.DebugOption.JointPivotColor;
2951
FManager.AddNode(VectorAdd(pickedMatrix.V[3], VectorMake(0, 0, size)));
2952
FManager.AddNode(VectorAdd(pickedMatrix.V[3], VectorMake(0, 0, -size)));
2953
FManager.AddNode(VectorAdd(pickedMatrix.V[3], VectorMake(0, size, 0)));
2954
FManager.AddNode(VectorAdd(pickedMatrix.V[3], VectorMake(0, -size, 0)));
2955
FManager.AddNode(VectorAdd(pickedMatrix.V[3], VectorMake(size, 0, 0)));
2956
FManager.AddNode(VectorAdd(pickedMatrix.V[3], VectorMake(-size, 0, 0)));
2964
if Assigned(FParentObject) and Assigned(FChildObject) then
2966
DrawJoint(FBallAndSocketOptions.FPivotPoint.AsVector);
2967
DrawPivot(FBallAndSocketOptions.FPivotPoint.AsVector);
2971
if Assigned(FParentObject) and Assigned(FChildObject) then
2973
DrawJoint(FHingeOptions.FPivotPoint.AsVector);
2974
DrawPin(FHingeOptions.FPinDirection.AsVector,
2975
FHingeOptions.FPivotPoint.AsVector);
2976
DrawPivot(FHingeOptions.FPivotPoint.AsVector);
2980
if Assigned(FParentObject) and Assigned(FChildObject) then
2982
DrawJoint(FSliderOptions.FPivotPoint.AsVector);
2983
DrawPin(FSliderOptions.FPinDirection.AsVector,
2984
FSliderOptions.FPivotPoint.AsVector);
2985
DrawPivot(FSliderOptions.FPivotPoint.AsVector);
2989
if Assigned(FParentObject) and Assigned(FChildObject) then
2991
DrawJoint(FCorkscrewOptions.FPivotPoint.AsVector);
2992
DrawPin(FCorkscrewOptions.FPinDirection.AsVector,
2993
FCorkscrewOptions.FPivotPoint.AsVector);
2994
DrawPivot(FCorkscrewOptions.FPivotPoint.AsVector);
2998
if Assigned(FParentObject) and Assigned(FChildObject) then
3000
DrawJoint(FUniversalOptions.FPivotPoint.AsVector);
3001
DrawPin(FUniversalOptions.FPinDirection.AsVector,
3002
FUniversalOptions.FPivotPoint.AsVector);
3003
DrawPin(FUniversalOptions.FPinDirection2.AsVector,
3004
FUniversalOptions.FPivotPoint.AsVector);
3005
DrawPivot(FUniversalOptions.FPivotPoint.AsVector);
3008
nj_CustomBallAndSocket:
3009
if Assigned(FParentObject) and Assigned(FChildObject) then
3011
DrawJoint(FCustomBallAndSocketOptions.FPivotPoint.AsVector);
3012
DrawPivot(FCustomBallAndSocketOptions.FPivotPoint.AsVector);
3016
if Assigned(FParentObject) and Assigned(FChildObject) then
3018
DrawJoint(FCustomHingeOptions.FPivotPoint.AsVector);
3019
DrawPin(FCustomHingeOptions.FPinDirection.AsVector,
3020
FCustomHingeOptions.FPivotPoint.AsVector);
3021
DrawPivot(FCustomHingeOptions.FPivotPoint.AsVector);
3025
if Assigned(FParentObject) and Assigned(FChildObject) then
3027
DrawJoint(FCustomSliderOptions.FPivotPoint.AsVector);
3028
DrawPin(FCustomSliderOptions.FPinDirection.AsVector,
3029
FCustomSliderOptions.FPivotPoint.AsVector);
3030
DrawPivot(FCustomSliderOptions.FPivotPoint.AsVector);
3034
if Assigned(FParentObject) then
3036
FManager.FCurrentColor := FManager.DebugOption.JointAxisColor;
3037
FManager.AddNode(FParentObject.AbsolutePosition);
3038
FManager.AddNode(VectorAdd(FParentObject.AbsolutePosition,
3039
FUPVectorDirection.AsVector));
3042
nj_KinematicController:
3043
if Assigned(FParentObject) and Assigned(FNewtonUserJoint) then
3051
procedure TNGDJoint.SetChildObject(const Value: TGLBaseSceneObject);
3053
FChildObject := Value;
3054
FManager.RebuildAllJoint(self);
3057
procedure TNGDJoint.SetCollisionState(const Value: Boolean);
3059
FCollisionState := Value;
3060
FManager.RebuildAllJoint(self);
3063
procedure TNGDJoint.SetJointType(const Value: TNGDNewtonJoints);
3065
FJointType := Value;
3066
FManager.RebuildAllJoint(self);
3069
procedure TNGDJoint.SetParentObject(const Value: TGLBaseSceneObject);
3071
FParentObject := Value;
3072
FManager.RebuildAllJoint(self);
3075
procedure TNGDJoint.SetStiffness(const Value: Single);
3077
if (Value >= 0) and (Value <= 1) then
3079
FStiffness := Value;
3080
FManager.RebuildAllJoint(self);
3084
function TNGDJoint.StoredStiffness: Boolean;
3086
Result := not SameValue(FStiffness, 0.9, epsilon);
3089
{ TNGDJoint.TNGDJointPivot }3091
constructor TNGDJointPivot.Create(AOwner: TComponent; aOuter: TNGDJoint);
3093
FManager := AOwner as TGLNGDManager;
3095
FPivotPoint := TGLCoordinates.CreateInitialized(aOuter, NullHMGPoint,
3097
FPivotPoint.OnNotifyChange := FManager.RebuildAllJoint;
3100
destructor TNGDJointPivot.Destroy;
3106
{ TNGDJoint.TNGDJointPin }3108
constructor TNGDJointPin.Create(AOwner: TComponent; aOuter: TNGDJoint);
3111
FPinDirection := TGLCoordinates.CreateInitialized(aOuter, NullHmgVector,
3113
FPinDirection.OnNotifyChange := FManager.RebuildAllJoint;
3116
destructor TNGDJointPin.Destroy;
3122
{ TNGDJoint.TNGDJointPin2 }3124
constructor TNGDJointPin2.Create(AOwner: TComponent; aOuter: TNGDJoint);
3127
FPinDirection2 := TGLCoordinates.CreateInitialized(aOuter, NullHmgVector,
3129
FPinDirection2.OnNotifyChange := FManager.RebuildAllJoint;
3132
destructor TNGDJointPin2.Destroy;
3134
FPinDirection2.Free;
3138
{ TNGDJoint.TNGDJointBallAndSocket }3140
constructor TNGDJointBallAndSocket.Create(AOwner: TComponent;
3145
FMinTwistAngle := -90;
3146
FMaxTwistAngle := 90;
3149
procedure TNGDJointBallAndSocket.SetConeAngle(const Value: Single);
3151
FConeAngle := Value;
3152
FManager.RebuildAllJoint(FOuter);
3155
procedure TNGDJointBallAndSocket.SetMaxTwistAngle(const Value: Single);
3157
FMaxTwistAngle := Value;
3158
FManager.RebuildAllJoint(FOuter);
3161
procedure TNGDJointBallAndSocket.SetMinTwistAngle(const Value: Single);
3163
FMinTwistAngle := Value;
3164
FManager.RebuildAllJoint(FOuter);
3167
function TNGDJointBallAndSocket.StoredConeAngle: Boolean;
3169
Result := not SameValue(FConeAngle, 90, epsilon);
3172
function TNGDJointBallAndSocket.StoredMaxTwistAngle: Boolean;
3174
Result := not SameValue(FMaxTwistAngle, 90, epsilon);
3177
function TNGDJointBallAndSocket.StoredMinTwistAngle: Boolean;
3179
Result := not SameValue(FMinTwistAngle, -90, epsilon);
3182
{ TNGDJoint.TNGDJointHinge }3184
constructor TNGDJointHinge.Create(AOwner: TComponent; aOuter: TNGDJoint);
3191
procedure TNGDJointHinge.SetMaxAngle(const Value: Single);
3194
FManager.RebuildAllJoint(FOuter);
3197
procedure TNGDJointHinge.SetMinAngle(const Value: Single);
3200
FManager.RebuildAllJoint(FOuter);
3203
function TNGDJointHinge.StoredMaxAngle: Boolean;
3205
Result := not SameValue(FMaxAngle, 90, epsilon);
3208
function TNGDJointHinge.StoredMinAngle: Boolean;
3210
Result := not SameValue(FMinAngle, -90, epsilon);
3213
{ TNGDJoint.TNGDJointSlider }3216
constructor TNGDJointSlider.Create(AOwner: TComponent; aOuter: TNGDJoint);
3219
FMinDistance := -10;
3224
procedure TNGDJointSlider.SetMaxDistance(const Value: Single);
3226
FMaxDistance := Value;
3227
FManager.RebuildAllJoint(FOuter);
3230
procedure TNGDJointSlider.SetMinDistance(const Value: Single);
3232
FMinDistance := Value;
3233
FManager.RebuildAllJoint(FOuter);
3237
function TNGDJointSlider.StoredMaxDistance: Boolean;
3239
Result := not SameValue(FMaxDistance, 10, epsilon);
3242
function TNGDJointSlider.StoredMinDistance: Boolean;
3244
Result := not SameValue(FMinDistance, -10, epsilon);
3247
{ TNGDJoint.TNGDJointKinematicController }3249
constructor TNGDJointKinematicController.Create;
3251
FPickModeLinear := False;
3252
FLinearFriction := 750;
3253
FAngularFriction := 250;
3256
function TNGDJointKinematicController.StoredAngularFriction: Boolean;
3258
Result := not SameValue(FAngularFriction, 250, epsilon);
3261
function TNGDJointKinematicController.StoredLinearFriction: Boolean;
3263
Result := not SameValue(FLinearFriction, 750, epsilon);
3266
{ TGLNGDBehaviourList }3268
function TGLNGDBehaviourList.GetBehav(index: Integer): TGLNGDBehaviour;
3270
Result := Items[index];
3273
procedure TGLNGDBehaviourList.PutBehav(index: Integer; Item: TGLNGDBehaviour);
3275
inherited put(index, Item);
3280
// ------------------------------------------------------------------
3281
// ------------------------------------------------------------------
3282
// ------------------------------------------------------------------
3284
RegisterXCollectionItemClass(TGLNGDDynamic);
3285
RegisterXCollectionItemClass(TGLNGDStatic);
3287
// ------------------------------------------------------------------
3288
// ------------------------------------------------------------------
3289
// ------------------------------------------------------------------
3293
// ------------------------------------------------------------------
3294
// ------------------------------------------------------------------
3295
// ------------------------------------------------------------------
3297
UnregisterXCollectionItemClass(TGLNGDDynamic);
3298
UnregisterXCollectionItemClass(TGLNGDStatic);