2
// This unit is part of the GLScene Engine https://github.com/glscene
5
A Newton Game Dynamics Manager for GLScene.
7
Newton Game Dynamics Engine (http://newtondynamics.com)
8
NewtonImport, a Delphi header translation (http://newtondynamics.com/forum/viewtopic.php?f=9&t=5273#p35865)
11
This code is still being developed so any part of it may change at anytime.
21
Classes, // TComponent Tlist TWriter TReader TPersistent
22
SysUtils, //System utilities
23
Math, // Samevalue isZero to compare single
26
//NewtonImport_JointLibrary, // Newton
28
GLVectorGeometry, // PVector TVector TMatrix PMatrix NullHmgVector...
29
GLVectorLists, // TaffineVectorList for Tree
30
GLXCollection, // TXCollection file function
38
GLVectorFileObjects, // cube cone freeform...
40
GLGeometryBB, // For show debug
44
NGDFloat = NewtonImport.dFloat;
45
PNGDFloat = ^NGDFloat;
47
TGLNGDHeightField = record
48
heightArray: array of Word;
51
gridDiagonals: Boolean;
52
widthDepthScale: Single;
56
TGLNGDBehaviour = class;
57
TGLNGDManager = class;
58
TGLNGDSurfaceItem = class;
61
TGLNGDSolverModels = (smExact = 0, smLinear1, smLinear2, smLinear3, smLinear4,
62
smLinear5, smLinear6, smLinear7, smLinear8, smLinear9);
64
TGLNGDFrictionModels = (fmExact = 0, fmAdaptive);
65
TGLNGDPickedActions = (paAttach = 0, paMove, paDetach);
67
TGLNGDManagerDebug = (mdShowGeometry, mdShowAABB, mdShowCenterOfMass,
68
mdShowContact, mdShowJoint, mdShowForce, mdShowAppliedForce,
69
mdShowAppliedVelocity);
70
TGLNGDManagerDebugs = set of TGLNGDManagerDebug;
72
TGLNGDCollisions = (nc_Primitive = 0, nc_Convex, nc_BBox, nc_BSphere,
73
nc_Tree, nc_Mesh, nc_Null, nc_HeightField, nc_NGDFile);
75
TGLNGDJoints = (nj_BallAndSocket, nj_Hinge, nj_Slider, nj_Corkscrew,
76
nj_Universal, nj_CustomBallAndSocket, nj_CustomHinge, nj_CustomSlider,
77
nj_UpVector, nj_KinematicController);
79
TGLNGDBehaviourList = class(TList)
81
function GetBehav(index: Integer): TGLNGDBehaviour;
82
procedure PutBehav(index: Integer; Item: TGLNGDBehaviour);
84
property ItemsBehav[index: Integer]
85
: TGLNGDBehaviour read GetBehav write PutBehav; default;
88
{ Events for Newton Callback }89
TCollisionIteratorEvent = procedure(const userData: Pointer;
90
vertexCount: Integer; const cfaceArray: PNGDFloat;
91
faceId: Integer) of object;
93
TApplyForceAndTorqueEvent = procedure(const cbody: NewtonBody;
94
timestep: NGDFloat; threadIndex: Integer) of object;
96
TSetTransformEvent = procedure(const cbody: NewtonBody;
97
const cmatrix: PNGDFloat; threadIndex: Integer) of object;
99
TSerializeEvent = procedure(serializeHandle: Pointer; const cbuffer: Pointer;
100
size: Cardinal) of object;
102
TDeSerializeEvent = procedure(serializeHandle: Pointer; buffer: Pointer;
103
size: Cardinal) of object;
105
TAABBOverlapEvent = function(const cmaterial: NewtonMaterial;
106
const cbody0: NewtonBody; const cbody1: NewtonBody;
107
threadIndex: Integer): Boolean of object;
109
TContactProcessEvent = procedure(const ccontact: NewtonJoint;
110
timestep: NGDFloat; threadIndex: Integer) of object;
112
TGLNGDDebugOption = class(TPersistent)
114
FManager: TGLNGDManager;
115
FGeomColorDyn: TGLColor; // Green
116
FGeomColorStat: TGLColor; // Red
117
FAABBColor: TGLColor; // Yellow
118
FAABBColorSleep: TGLColor; // Orange
119
FCenterOfMassColor: TGLColor; // Purple dot
120
FContactColor: TGLColor; // White
121
FJointAxisColor: TGLColor; // Blue
122
FJointPivotColor: TGLColor; // Aquamarine
123
FForceColor: TGLColor; // Black
124
FAppliedForceColor: TGLColor; // Silver
125
FAppliedVelocityColor: TGLColor; // Lime
126
FCustomColor: TGLColor; // Aqua
127
FDotAxisSize: Single; // 1
128
FNGDManagerDebugs: TGLNGDManagerDebugs; // Default All false
129
procedure SetNGDManagerDebugs(const Value: TGLNGDManagerDebugs);
130
procedure SetDotAxisSize(const Value: Single);
131
function StoredDotAxis: Boolean;
133
constructor Create(AOwner: TComponent);
134
destructor Destroy; override;
136
property GeomColorDyn: TGLColor read FGeomColorDyn write FGeomColorDyn;
137
property GeomColorStat: TGLColor read FGeomColorStat write FGeomColorStat;
138
property AABBColor: TGLColor read FAABBColor write FAABBColor;
139
property AABBColorSleep: TGLColor read FAABBColorSleep write FAABBColorSleep;
140
property CenterOfMassColor: TGLColor read FCenterOfMassColor write FCenterOfMassColor;
141
property ContactColor: TGLColor read FContactColor write FContactColor;
142
property JointAxisColor: TGLColor read FJointAxisColor write FJointAxisColor;
143
property JointPivotColor: TGLColor read FJointPivotColor write FJointPivotColor;
144
property ForceColor: TGLColor read FForceColor write FForceColor;
145
property AppliedForceColor: TGLColor read FAppliedForceColor write FAppliedForceColor;
146
property AppliedVelocityColor: TGLColor read FAppliedVelocityColor write FAppliedVelocityColor;
147
property CustomColor: TGLColor read FCustomColor write FCustomColor;
148
property NGDManagerDebugs: TGLNGDManagerDebugs read FNGDManagerDebugs write
149
SetNGDManagerDebugs default[];
150
property DotAxisSize: Single read FDotAxisSize write SetDotAxisSize stored
154
TGLNGDManager = class(TComponent)
156
FVisible: Boolean; // Show Debug at design time
157
FVisibleAtRunTime: Boolean; // Show Debug at run time
158
FDllVersion: Integer;
159
FSolverModel: TGLNGDSolverModels; // Default=Exact
160
FFrictionModel: TGLNGDFrictionModels; // Default=Exact
161
FMinimumFrameRate: Integer; // Default=60
162
FWorldSizeMin: TGLCoordinates; // Default=-100, -100, -100
163
FWorldSizeMax: TGLCoordinates; // Default=100, 100, 100
164
FThreadCount: Integer; // Default=1
165
FGravity: TGLCoordinates; // Default=(0,-9.81,0)
166
FNewtonSurfaceItem: TCollection;
167
FNewtonSurfacePair: TOwnedCollection;
168
FNewtonJointGroup: TOwnedCollection;
169
FNGDDebugOption: TGLNGDDebugOption;
172
FNewtonWorld: NewtonWorld;
173
FNGDBehaviours: TGLNGDBehaviourList;
174
FCurrentColor: TGLColor;
176
procedure Loaded; override;
177
procedure SetVisible(const Value: Boolean);
178
procedure SetVisibleAtRunTime(const Value: Boolean);
179
procedure SetSolverModel(const Value: TGLNGDSolverModels);
180
procedure SetFrictionModel(const Value: TGLNGDFrictionModels);
181
procedure SetMinimumFrameRate(const Value: Integer);
182
procedure SetThreadCount(const Value: Integer);
183
procedure SetGLLines(const Value: TGLLines);
184
function GetBodyCount: Integer;
185
function GetConstraintCount: Integer;
186
procedure AddNode(const coords: TGLCustomCoordinates); overload;
187
procedure AddNode(const X, Y, Z: Single); overload;
188
procedure AddNode(const Value: TVector); overload;
189
procedure AddNode(const Value: TAffineVector); overload;
190
procedure RebuildAllMaterial;
191
procedure RebuildAllJoint(Sender: TObject);
193
procedure NotifyWorldSizeChange(Sender: TObject);
194
procedure NotifyChange(Sender: TObject); // Debug view
196
constructor Create(AOwner: TComponent); override;
197
destructor Destroy; override;
198
procedure Step(deltatime: Single);
200
property Visible: Boolean read FVisible write SetVisible default True;
201
property VisibleAtRunTime: Boolean read FVisibleAtRunTime write
202
SetVisibleAtRunTime default False;
203
property SolverModel: TGLNGDSolverModels read FSolverModel write
204
SetSolverModel default smExact;
205
property FrictionModel: TGLNGDFrictionModels read FFrictionModel write
206
SetFrictionModel default fmExact;
207
property MinimumFrameRate: Integer read FMinimumFrameRate write
208
SetMinimumFrameRate default 60;
209
property ThreadCount: Integer read FThreadCount write SetThreadCount default 1;
210
property DllVersion: Integer read FDllVersion;
211
property NewtonBodyCount: Integer read GetBodyCount;
212
property NewtonConstraintCount: Integer read GetConstraintCount;
213
property Gravity: TGLCoordinates read FGravity write FGravity;
214
property WorldSizeMin: TGLCoordinates read FWorldSizeMin write FWorldSizeMin;
215
property WorldSizeMax: TGLCoordinates read FWorldSizeMax write FWorldSizeMax;
216
property NewtonSurfaceItem: TCollection read FNewtonSurfaceItem write FNewtonSurfaceItem;
217
property NewtonSurfacePair: TOwnedCollection read FNewtonSurfacePair write
219
property DebugOption: TGLNGDDebugOption read FNGDDebugOption write
221
property Line: TGLLines read FGLLines write SetGLLines;
222
property NewtonJoint: TOwnedCollection read FNewtonJointGroup write
226
{ Basis structures for GLScene behaviour style implementations. }227
TGLNGDBehaviour = class(TGLBehaviour)
229
FManager: TGLNGDManager;
230
FManagerName: string;
231
FInitialized: Boolean;
232
FNewtonBody: NewtonBody;
233
FCollision: NewtonCollision;
234
FNewtonBodyMatrix: TMatrix; // Position and Orientation
235
FContinuousCollisionMode: Boolean; // Default=False
236
FNGDCollisions: TGLNGDCollisions;
237
FCollisionIteratorEvent: TCollisionIteratorEvent;
238
FOwnerBaseSceneObject: TGLBaseSceneObject;
239
// FNullCollisionMass: Single; // Default=0
240
FTreeCollisionOptimize: Boolean; // Default=True
241
FConvexCollisionTolerance: Single; // Default=0.01 1%
242
FFileCollision: string;
243
FNGDSurfaceItem: TGLNGDSurfaceItem;
244
FHeightFieldOptions: TGLNGDHeightField;
246
procedure Initialize; virtual;
247
procedure Finalize; virtual;
248
procedure WriteToFiler(writer: TWriter); override;
249
procedure ReadFromFiler(reader: TReader); override;
250
procedure Loaded; override;
251
procedure SetManager(Value: TGLNGDManager);
252
procedure SetNewtonBodyMatrix(const Value: TMatrix);
253
procedure SetContinuousCollisionMode(const Value: Boolean);
254
function GetNewtonBodyMatrix: TMatrix;
255
function GetNewtonBodyAABB: TAABB;
256
procedure UpdCollision; virtual;
257
procedure Render; virtual;
258
procedure SetNGDNewtonCollisions(const Value: TGLNGDCollisions);
259
procedure SetNGDSurfaceItem(const Value: TGLNGDSurfaceItem);
260
procedure SetHeightFieldOptions(const Value: TGLNGDHeightField);
261
function GetPrimitiveCollision(): NewtonCollision;
262
function GetConvexCollision(): NewtonCollision;
263
function GetBBoxCollision(): NewtonCollision;
264
function GetBSphereCollision(): NewtonCollision;
265
function GetTreeCollision(): NewtonCollision;
266
function GetMeshCollision(): NewtonCollision;
267
function GetNullCollision(): NewtonCollision;
268
function GetHeightFieldCollision(): NewtonCollision;
269
function GetNGDFileCollision(): NewtonCollision;
270
function StoredTolerance: Boolean;
272
procedure OnCollisionIteratorEvent(const userData: Pointer;
273
vertexCount: Integer; const cfaceArray: PNGDFloat; faceId: Integer);
275
class procedure NewtonCollisionIterator(const userData: Pointer;
276
vertexCount: Integer; const faceArray: PNGDFloat;
277
faceId: Integer); static; cdecl;
278
class procedure NewtonSerialize(serializeHandle: Pointer;
279
const buffer: Pointer; size: Cardinal); static; cdecl;
280
class procedure NewtonDeserialize(serializeHandle: Pointer;
281
buffer: Pointer; size: Cardinal); static; cdecl;
283
constructor Create(AOwner: TGLXCollection); override;
284
destructor Destroy; override;
285
procedure Reinitialize;
286
property Initialized: Boolean read FInitialized;
287
class function UniqueItem: Boolean; override;
288
property NewtonBodyMatrix: TMatrix read GetNewtonBodyMatrix write
290
property NewtonBodyAABB: TAABB read GetNewtonBodyAABB;
291
procedure Serialize(filename: string);
292
procedure DeSerialize(filename: string);
293
property HeightFieldOptions: TGLNGDHeightField read FHeightFieldOptions write
294
SetHeightFieldOptions;
296
property Manager: TGLNGDManager read FManager write SetManager;
297
property ContinuousCollisionMode: Boolean read FContinuousCollisionMode write
298
SetContinuousCollisionMode default False;
299
property NGDNewtonCollisions: TGLNGDCollisions read FNGDCollisions
300
write SetNGDNewtonCollisions default nc_Primitive;
301
property TreeCollisionOptimize: Boolean read FTreeCollisionOptimize write
302
FTreeCollisionOptimize default True;
303
property ConvexCollisionTolerance: Single read FConvexCollisionTolerance write
304
FConvexCollisionTolerance stored StoredTolerance;
305
property FileCollision: string read FFileCollision write FFileCollision;
306
property NGDSurfaceItem: TGLNGDSurfaceItem read FNGDSurfaceItem write
310
TGLNGDDynamic = class(TGLNGDBehaviour)
312
FAABBmin: TGLCoordinates;
313
FAABBmax: TGLCoordinates;
314
FForce: TGLCoordinates;
315
FTorque: TGLCoordinates;
316
FCenterOfMass: TGLCoordinates;
317
FAutoSleep: Boolean; // Default=True
318
FLinearDamping: Single; // default=0.1
319
FAngularDamping: TGLCoordinates; // Default=0.1
320
FDensity: Single; // Default=1
321
FUseGravity: Boolean; // Default=True
322
FNullCollisionVolume: Single; // Default=0
323
FApplyForceAndTorqueEvent: TApplyForceAndTorqueEvent;
324
FSetTransformEvent: TSetTransformEvent;
325
FCustomForceAndTorqueEvent: TApplyForceAndTorqueEvent;
329
FAppliedForce: TGLCoordinates;
330
FAppliedTorque: TGLCoordinates;
331
FAppliedOmega: TGLCoordinates;
332
FAppliedVelocity: TGLCoordinates;
333
function StoredDensity: Boolean;
334
function StoredLinearDamping: Boolean;
335
function StoredNullCollisionVolume: Boolean;
337
procedure SetAutoSleep(const Value: Boolean);
338
procedure SetLinearDamping(const Value: Single);
339
procedure SetDensity(const Value: Single); virtual;
340
procedure Initialize; override;
341
procedure Finalize; override;
342
procedure WriteToFiler(writer: TWriter); override;
343
procedure ReadFromFiler(reader: TReader); override;
344
procedure Loaded; override;
345
procedure Render; override;
347
procedure NotifyCenterOfMassChange(Sender: TObject);
348
procedure NotifyAngularDampingChange(Sender: TObject);
349
procedure OnApplyForceAndTorqueEvent(const cbody: NewtonBody;
350
timestep: NGDFloat; threadIndex: Integer);
351
procedure OnSetTransformEvent(const cbody: NewtonBody;
352
const cmatrix: PNGDFloat; threadIndex: Integer);
354
class procedure NewtonApplyForceAndTorque(const body: NewtonBody;
355
timestep: NGDFloat; threadIndex: Integer); static; cdecl;
356
class procedure NewtonSetTransform(const body: NewtonBody;
357
const matrix: PNGDFloat; threadIndex: Integer); static; cdecl;
359
constructor Create(AOwner: TGLXCollection); override;
360
destructor Destroy; override;
361
procedure AddImpulse(const veloc, pointposit: TVector);
362
function GetOmega: TVector;
363
procedure SetOmega(const Omega: TVector);
364
function GetVelocity: TVector;
365
procedure SetVelocity(const Velocity: TVector);
366
class function FriendlyName: string; override;
367
property CustomForceAndTorqueEvent
368
: TApplyForceAndTorqueEvent read FCustomForceAndTorqueEvent write
369
FCustomForceAndTorqueEvent;
370
property Velocity: TVector read GetVelocity write SetVelocity;
371
property Omega: TVector read GetOmega write SetOmega;
373
property Force: TGLCoordinates read FForce write FForce;
374
property Torque: TGLCoordinates read FTorque write FTorque;
375
property CenterOfMass
376
: TGLCoordinates read FCenterOfMass write FCenterOfMass;
377
property AutoSleep: Boolean read FAutoSleep write SetAutoSleep default True;
378
property LinearDamping
379
: Single read FLinearDamping write SetLinearDamping
380
stored StoredLinearDamping;
381
property AngularDamping
382
: TGLCoordinates read FAngularDamping write FAngularDamping;
384
: Single read FDensity write SetDensity stored StoredDensity;
386
: Boolean read FUseGravity write FUseGravity default True;
387
property NullCollisionVolume
388
: Single read FNullCollisionVolume write FNullCollisionVolume stored
389
StoredNullCollisionVolume;
391
property AppliedOmega: TGLCoordinates read FAppliedOmega;
392
property AppliedVelocity: TGLCoordinates read FAppliedVelocity;
393
property AppliedForce: TGLCoordinates read FAppliedForce;
394
property AppliedTorque: TGLCoordinates read FAppliedTorque;
395
property Volume: Single read FVolume;
396
property Mass: Single read FMass;
399
TGLNGDStatic = class(TGLNGDBehaviour)
401
procedure Render; override;
403
class function FriendlyName: string; override;
407
TGLNGDSurfaceItem = class(TCollectionItem)
409
FDisplayName: string;
411
function GetDisplayName: string; override;
412
procedure SetDisplayName(const Value: string); override;
414
property DisplayName;
418
TGLNGDSurfacePair = class(TCollectionItem)
420
FManager: TGLNGDManager;
421
FNGDSurfaceItem1: TGLNGDSurfaceItem;
422
FNGDSurfaceItem2: TGLNGDSurfaceItem;
423
FAABBOverlapEvent: TAABBOverlapEvent;
424
FContactProcessEvent: TContactProcessEvent;
425
FSoftness: Single; // 0.1
426
FElasticity: Single; // 0.4
427
FCollidable: Boolean; // true
428
FStaticFriction: Single; // 0.9
429
FKineticFriction: Single; // 0.5
430
FContinuousCollisionMode: Boolean; // False
431
FThickness: Boolean; // False
432
procedure SetCollidable(const Value: Boolean);
433
procedure SetElasticity(const Value: Single);
434
procedure SetKineticFriction(const Value: Single);
435
procedure SetSoftness(const Value: Single);
436
procedure SetStaticFriction(const Value: Single);
437
procedure SetContinuousCollisionMode(const Value: Boolean);
438
procedure SetThickness(const Value: Boolean);
439
function StoredElasticity: Boolean;
440
function StoredKineticFriction: Boolean;
441
function StoredSoftness: Boolean;
442
function StoredStaticFriction: Boolean;
445
class function NewtonAABBOverlap(const material: NewtonMaterial;
446
const body0: NewtonBody; const body1: NewtonBody;
447
threadIndex: Integer): Integer; static; cdecl;
448
class procedure NewtonContactsProcess(const contact: NewtonJoint;
449
timestep: NGDFloat; threadIndex: Integer); static; cdecl;
451
function OnNewtonAABBOverlapEvent(const cmaterial: NewtonMaterial;
452
const cbody0: NewtonBody; const cbody1: NewtonBody;
453
threadIndex: Integer): Boolean;
454
procedure OnNewtonContactsProcessEvent(const ccontact: NewtonJoint;
455
timestep: NGDFloat; threadIndex: Integer);
457
constructor Create(Collection: TCollection); override;
458
procedure SetMaterialItems(const item1, item2: TGLNGDSurfaceItem);
459
property NGDSurfaceItem1: TGLNGDSurfaceItem read FNGDSurfaceItem1;
460
property NGDSurfaceItem2: TGLNGDSurfaceItem read FNGDSurfaceItem2;
462
property Softness: Single read FSoftness write SetSoftness stored
464
property Elasticity: Single read FElasticity write SetElasticity stored
467
: Boolean read FCollidable write SetCollidable default True;
468
property StaticFriction
469
: Single read FStaticFriction write SetStaticFriction
470
stored StoredStaticFriction;
471
property KineticFriction
472
: Single read FKineticFriction write SetKineticFriction stored
473
StoredKineticFriction;
474
property ContinuousCollisionMode
475
: Boolean read FContinuousCollisionMode write
476
SetContinuousCollisionMode default False;
478
: Boolean read FThickness write SetThickness default False;
479
property ContactProcessEvent
480
: TContactProcessEvent read FContactProcessEvent
481
write FContactProcessEvent;
482
property AABBOverlapEvent: TAABBOverlapEvent read FAABBOverlapEvent write
486
TGLNGDJointPivot = class(TPersistent)
488
FManager: TGLNGDManager;
489
FPivotPoint: TGLCoordinates;
492
constructor Create(AOwner: TComponent; aOuter: TGLNGDJoint); virtual;
493
destructor Destroy; override;
495
property PivotPoint: TGLCoordinates read FPivotPoint write FPivotPoint;
498
TGLNGDJointPin = class(TGLNGDJointPivot)
500
FPinDirection: TGLCoordinates;
502
constructor Create(AOwner: TComponent; aOuter: TGLNGDJoint); override;
503
destructor Destroy; override;
505
property PinDirection: TGLCoordinates read FPinDirection write FPinDirection;
508
TGLNGDJointPin2 = class(TGLNGDJointPin)
510
FPinDirection2: TGLCoordinates;
512
constructor Create(AOwner: TComponent; aOuter: TGLNGDJoint); override;
513
destructor Destroy; override;
515
property PinDirection2: TGLCoordinates read FPinDirection2 write FPinDirection2;
518
TGLNGDJointBallAndSocket = class(TGLNGDJointPivot)
520
FConeAngle: Single; // 90
521
FMinTwistAngle: Single; // -90
522
FMaxTwistAngle: Single; // 90
523
procedure SetConeAngle(const Value: Single);
524
procedure SetMaxTwistAngle(const Value: Single);
525
procedure SetMinTwistAngle(const Value: Single);
526
function StoredMaxTwistAngle: Boolean;
527
function StoredMinTwistAngle: Boolean;
528
function StoredConeAngle: Boolean;
530
constructor Create(AOwner: TComponent; aOuter: TGLNGDJoint); override;
532
property ConeAngle: Single read FConeAngle write SetConeAngle stored
534
property MinTwistAngle: Single read FMinTwistAngle write SetMinTwistAngle
535
stored StoredMinTwistAngle;
536
property MaxTwistAngle: Single read FMaxTwistAngle write SetMaxTwistAngle
537
stored StoredMaxTwistAngle;
540
TGLNGDJointHinge = class(TGLNGDJointPin)
542
FMinAngle: Single; // -90
543
FMaxAngle: Single; // 90
544
procedure SetMaxAngle(const Value: Single);
545
procedure SetMinAngle(const Value: Single);
546
function StoredMaxAngle: Boolean;
547
function StoredMinAngle: Boolean;
549
constructor Create(AOwner: TComponent; aOuter: TGLNGDJoint); override;
551
property MinAngle: Single read FMinAngle write SetMinAngle stored
553
property MaxAngle: Single read FMaxAngle write SetMaxAngle stored
557
TGLNGDJointSlider = class(TGLNGDJointPin)
559
FMinDistance: Single; // -10
560
FMaxDistance: Single; // 10
561
procedure SetMaxDistance(const Value: Single);
562
procedure SetMinDistance(const Value: Single);
563
function StoredMaxDistance: Boolean;
564
function StoredMinDistance: Boolean;
566
constructor Create(AOwner: TComponent; aOuter: TGLNGDJoint); override;
568
property MinDistance: Single read FMinDistance write SetMinDistance stored
570
property MaxDistance: Single read FMaxDistance write SetMaxDistance stored
574
TGLNGDJointKinematicController = class(TPersistent)
576
FPickModeLinear: Boolean; // False
577
FLinearFriction: Single; // 750
578
FAngularFriction: Single; // 250
579
function StoredAngularFriction: Boolean;
580
function StoredLinearFriction: Boolean;
582
constructor Create();
584
property PickModeLinear: Boolean read FPickModeLinear write FPickModeLinear
586
property LinearFriction: Single read FLinearFriction write FLinearFriction stored
587
StoredLinearFriction;
588
property AngularFriction: Single read FAngularFriction write FAngularFriction stored
589
StoredAngularFriction;
592
TGLNGDJoint = class(TCollectionItem)
595
FManager: TGLNGDManager;
596
FParentObject: TGLBaseSceneObject;
597
FJointType: TGLNGDJoints;
598
FStiffness: Single; // 0.9
600
// Every joint except nj_UpVector and nj_KinematicController
601
FChildObject: TGLBaseSceneObject;
602
FCollisionState: Boolean; // False
603
// With classic joint
604
// nj_BallAndSocket, nj_Hinge, nj_Slider, nj_Corkscrew
605
// nj_Universal, nj_UpVector
606
FNewtonJoint: NewtonJoint;
608
// nj_CustomBallAndSocket, nj_CustomHinge, nj_CustomSlider
609
// nj_KinematicController
610
FNewtonUserJoint: NewtonJoint;
612
FUPVectorDirection: TGLCoordinates;
613
FBallAndSocketOptions: TGLNGDJointPivot;
614
FHingeOptions: TGLNGDJointPin;
615
FSliderOptions: TGLNGDJointPin;
616
FCorkscrewOptions: TGLNGDJointPin;
617
FUniversalOptions: TGLNGDJointPin2;
618
FCustomBallAndSocketOptions: TGLNGDJointBallAndSocket;
619
FCustomHingeOptions: TGLNGDJointHinge;
620
FCustomSliderOptions: TGLNGDJointSlider;
621
FKinematicOptions: TGLNGDJointKinematicController;
622
procedure SetJointType(const Value: TGLNGDJoints);
623
procedure SetChildObject(const Value: TGLBaseSceneObject);
624
procedure SetCollisionState(const Value: Boolean);
625
procedure SetParentObject(const Value: TGLBaseSceneObject);
626
procedure SetStiffness(const Value: Single);
628
function StoredStiffness: Boolean;
629
procedure DestroyNewtonData;
631
constructor Create(Collection: TCollection); override;
632
destructor Destroy; override;
633
procedure KinematicControllerPick(pickpoint: TVector;
634
PickedActions: TGLNGDPickedActions);
636
property BallAndSocketOptions: TGLNGDJointPivot read FBallAndSocketOptions write
637
FBallAndSocketOptions;
638
property HingeOptions: TGLNGDJointPin read FHingeOptions write FHingeOptions;
639
property SliderOptions: TGLNGDJointPin read FSliderOptions write FSliderOptions;
640
property CorkscrewOptions: TGLNGDJointPin read FCorkscrewOptions write FCorkscrewOptions;
641
property UniversalOptions: TGLNGDJointPin2 read FUniversalOptions write FUniversalOptions;
642
property CustomBallAndSocketOptions: TGLNGDJointBallAndSocket read FCustomBallAndSocketOptions write
643
FCustomBallAndSocketOptions;
644
property CustomHingeOptions: TGLNGDJointHinge read FCustomHingeOptions write
646
property CustomSliderOptions: TGLNGDJointSlider read FCustomSliderOptions write
647
FCustomSliderOptions;
648
property KinematicControllerOptions: TGLNGDJointKinematicController read FKinematicOptions write
650
property JointType: TGLNGDJoints read FJointType write SetJointType;
651
property ParentObject: TGLBaseSceneObject read FParentObject write
653
property ChildObject: TGLBaseSceneObject read FChildObject write
655
property CollisionState: Boolean read FCollisionState write SetCollisionState default False;
656
property Stiffness: Single read FStiffness write SetStiffness stored
658
property UPVectorDirection: TGLCoordinates read FUPVectorDirection write FUPVectorDirection;
662
function GetNGDStatic(Obj: TGLBaseSceneObject): TGLNGDStatic;
663
function GetOrCreateNGDStatic(Obj: TGLBaseSceneObject): TGLNGDStatic;
664
function GetNGDDynamic(Obj: TGLBaseSceneObject): TGLNGDDynamic;
665
function GetOrCreateNGDDynamic(Obj: TGLBaseSceneObject): TGLNGDDynamic;
666
function GetBodyFromGLSceneObject(Obj: TGLBaseSceneObject): NewtonBody;
668
//----------------------------------------------------------------------
670
//----------------------------------------------------------------------
673
epsilon = 0.0000001; // 1E-07
675
function GetNGDStatic(Obj: TGLBaseSceneObject): TGLNGDStatic;
677
Result := TGLNGDStatic(Obj.Behaviours.GetByClass(TGLNGDStatic));
680
function GetOrCreateNGDStatic(Obj: TGLBaseSceneObject): TGLNGDStatic;
682
Result := TGLNGDStatic(Obj.GetOrCreateBehaviour(TGLNGDStatic));
685
function GetNGDDynamic(Obj: TGLBaseSceneObject): TGLNGDDynamic;
687
Result := TGLNGDDynamic(Obj.Behaviours.GetByClass(TGLNGDDynamic));
690
function GetOrCreateNGDDynamic(Obj: TGLBaseSceneObject): TGLNGDDynamic;
692
Result := TGLNGDDynamic(Obj.GetOrCreateBehaviour(TGLNGDDynamic));
695
function GetBodyFromGLSceneObject(Obj: TGLBaseSceneObject): NewtonBody;
697
Behaviour: TGLNGDBehaviour;
699
Behaviour := TGLNGDBehaviour(Obj.Behaviours.GetByClass(TGLNGDBehaviour));
700
Assert(Behaviour <> nil, 'NGD Behaviour (static or dynamic) is missing for this object');
701
Result := Behaviour.FNewtonBody;
704
// ------------------------------------------------------------------
705
// ------------------------------------------------------------------
706
// ------------------------------------------------------------------
708
//-----------------------
710
//-----------------------
711
constructor TGLNGDDebugOption.Create(AOwner: TComponent);
713
FManager := AOwner as TGLNGDManager;
716
FGeomColorDyn := TGLColor.CreateInitialized(self, clrGreen, NotifyChange);
717
FGeomColorStat := TGLColor.CreateInitialized(self, clrRed, NotifyChange);
718
FAABBColor := TGLColor.CreateInitialized(self, clrYellow, NotifyChange);
719
FAABBColorSleep := TGLColor.CreateInitialized(self, clrOrange,
721
FCenterOfMassColor := TGLColor.CreateInitialized(self, clrPurple,
723
FContactColor := TGLColor.CreateInitialized(self, clrWhite, NotifyChange);
724
FJointAxisColor := TGLColor.CreateInitialized(self, clrBlue, NotifyChange);
725
FJointPivotColor := TGLColor.CreateInitialized(self, clrAquamarine,
728
FForceColor := TGLColor.CreateInitialized(self, clrBlack, NotifyChange);
729
FAppliedForceColor := TGLColor.CreateInitialized(self, clrSilver,
731
FAppliedVelocityColor := TGLColor.CreateInitialized(self, clrLime,
734
FCustomColor := TGLColor.CreateInitialized(self, clrAqua, NotifyChange);
737
FNGDManagerDebugs := [];
739
FManager := AOwner as TGLNGDManager;
742
destructor TGLNGDDebugOption.Destroy;
747
FAABBColorSleep.Free;
748
FCenterOfMassColor.Free;
750
FJointAxisColor.Free;
751
FJointPivotColor.Free;
753
FAppliedForceColor.Free;
754
FAppliedVelocityColor.Free;
759
procedure TGLNGDDebugOption.SetDotAxisSize(const Value: Single);
761
FDotAxisSize := Value;
762
FManager.NotifyChange(self);
765
procedure TGLNGDDebugOption.SetNGDManagerDebugs(const Value: TGLNGDManagerDebugs);
767
FNGDManagerDebugs := Value;
768
FManager.NotifyChange(self);
771
function TGLNGDDebugOption.StoredDotAxis: Boolean;
773
Result := not SameValue(FDotAxisSize, 1, epsilon);
776
//------------------------
778
//------------------------
779
procedure TGLNGDManager.AddNode(const Value: TVector);
781
if Assigned(FGLLines) then
783
FGLLines.Nodes.AddNode(Value);
785
with (FGLLines.Nodes.Last as TGLLinesNode) do
786
Color := FCurrentColor;
790
procedure TGLNGDManager.AddNode(const coords: TGLCustomCoordinates);
792
if Assigned(FGLLines) then
794
FGLLines.Nodes.AddNode(coords); (FGLLines.Nodes.Last as TGLLinesNode)
795
.Color := FCurrentColor;
799
procedure TGLNGDManager.AddNode(const X, Y, Z: Single);
801
if Assigned(FGLLines) then
803
FGLLines.Nodes.AddNode(X, Y, Z); (FGLLines.Nodes.Last as TGLLinesNode)
804
.Color := FCurrentColor;
808
procedure TGLNGDManager.AddNode(const Value: TAffineVector);
810
if Assigned(FGLLines) then
812
FGLLines.Nodes.AddNode(Value); (FGLLines.Nodes.Last as TGLLinesNode)
813
.Color := FCurrentColor;
817
constructor TGLNGDManager.Create(AOwner: TComponent);
819
minworld, maxworld: TVector;
822
FNGDBehaviours := TGLNGDBehaviourList.Create;
824
FVisibleAtRunTime := False;
825
FSolverModel := smExact;
826
FFrictionModel := fmExact;
827
FMinimumFrameRate := 60;
828
FWorldSizeMin := TGLCoordinates.CreateInitialized(self,
829
VectorMake(-100, -100, -100, 0), csPoint);
830
FWorldSizeMax := TGLCoordinates.CreateInitialized(self,
831
VectorMake(100, 100, 100, 0), csPoint);
833
// Using Events because we need to call API Function when
834
// theses TGLCoordinates change.
835
FWorldSizeMin.OnNotifyChange := NotifyWorldSizeChange;
836
FWorldSizeMax.OnNotifyChange := NotifyWorldSizeChange;
839
FGravity := TGLCoordinates3.CreateInitialized(self,
840
VectorMake(0, -9.81, 0, 0), csVector);
842
FNewtonWorld := NewtonCreate;//(nil, nil);
843
FDllVersion := NewtonWorldGetVersion;//(FNewtonWorld);
845
// This is to prevent body out the world at startTime
846
minworld := VectorMake(-1E50, -1E50, -1E50);
847
maxworld := VectorMake(1E50, 1E50, 1E50);
848
//NewtonSetWorldSize(FNewtonWorld, @minworld, @maxworld);
851
NewtonWorldSetUserData(FNewtonWorld, self);
853
FNewtonSurfaceItem := TCollection.Create(TGLNGDSurfaceItem);
854
FNewtonSurfacePair := TOwnedCollection.Create(self, TGLNGDSurfacePair);
855
FNewtonJointGroup := TOwnedCollection.Create(self, TGLNGDJoint);
856
FNGDDebugOption := TGLNGDDebugOption.Create(self);
857
RegisterManager(self);
860
destructor TGLNGDManager.Destroy;
862
// for joint before body.
863
FreeAndNil(FNewtonJointGroup);
865
// Unregister everything
866
while FNGDBehaviours.Count > 0 do
867
FNGDBehaviours[0].Manager := nil;
869
// Clean up everything
870
FreeAndNil(FNGDBehaviours);
871
FreeAndNil(FWorldSizeMin);
872
FreeAndNil(FWorldSizeMax);
873
FreeAndNil(FGravity);
874
FreeAndNil(FNewtonSurfaceItem);
875
FreeAndNil(FNewtonSurfacePair);
876
FreeAndNil(FNGDDebugOption);
878
NewtonDestroyAllBodies(FNewtonWorld);
879
NewtonMaterialDestroyAllGroupID(FNewtonWorld);
880
NewtonDestroy(FNewtonWorld);
882
DeregisterManager(self);
886
procedure TGLNGDManager.Loaded;
889
NotifyWorldSizeChange(self);
890
RebuildAllJoint(self);
893
function TGLNGDManager.GetBodyCount: Integer;
895
if (csDesigning in ComponentState) then
896
Result := FNGDBehaviours.Count
898
Result := NewtonWorldGetBodyCount(FNewtonWorld);
901
function TGLNGDManager.GetConstraintCount: Integer;
903
if (csDesigning in ComponentState) then
904
Result := FNewtonJointGroup.Count
906
// Constraint is the number of joint
907
Result := NewtonWorldGetConstraintCount(FNewtonWorld);
910
procedure TGLNGDManager.NotifyChange(Sender: TObject);
914
// This event is raise
915
// when debugOptions properties are edited,
916
// when a behavior is initialized/finalize,
917
// when joints are rebuilded, (runtime only)
918
// when visible and visibleAtRuntime are edited (designTime only),
919
// in manager.step, and in SetGLLines.
921
// Here the manager call render method for bodies and joints in its lists
923
if not Assigned(FGLLines) then
925
FGLLines.Nodes.Clear;
929
if not(csDesigning in ComponentState) then
930
if not VisibleAtRunTime then
933
for I := 0 to FNGDBehaviours.Count - 1 do
934
FNGDBehaviours[I].Render;
936
if mdShowJoint in FNGDDebugOption.NGDManagerDebugs then
937
for I := 0 to NewtonJoint.Count - 1 do //
938
(NewtonJoint.Items[I] as TGLNGDJoint)
943
procedure TGLNGDManager.SetFrictionModel(const Value: TGLNGDFrictionModels);
945
FFrictionModel := Value;
946
//if not(csDesigning in ComponentState) then
947
// NewtonSetFrictionModel(FNewtonWorld, Ord(FFrictionModel));
950
procedure TGLNGDManager.SetGLLines(const Value: TGLLines);
952
if Assigned(FGLLines) then
953
FGLLines.Nodes.Clear;
957
if Assigned(FGLLines) then
959
FGLLines.SplineMode := lsmSegments;
960
FGLLines.NodesAspect := lnaInvisible;
961
FGLLines.Options := [loUseNodeColorForLines];
962
FGLLines.Pickable := False;
967
procedure TGLNGDManager.SetMinimumFrameRate(const Value: Integer);
969
if (Value >= 60) and (Value <= 1000) then
970
FMinimumFrameRate := Value;
971
// if not(csDesigning in ComponentState) then
972
// NewtonSetMinimumFrameRate(FNewtonWorld, FMinimumFrameRate);
975
procedure TGLNGDManager.SetSolverModel(const Value: TGLNGDSolverModels);
977
FSolverModel := Value;
978
if not(csDesigning in ComponentState) then
979
NewtonSetSolverModel(FNewtonWorld, Ord(FSolverModel));
982
procedure TGLNGDManager.SetThreadCount(const Value: Integer);
985
FThreadCount := Value;
986
NewtonSetThreadsCount(FNewtonWorld, FThreadCount);
987
FThreadCount := NewtonGetThreadsCount(FNewtonWorld);
990
procedure TGLNGDManager.SetVisible(const Value: Boolean);
993
if (csDesigning in ComponentState) then
997
procedure TGLNGDManager.SetVisibleAtRunTime(const Value: Boolean);
999
FVisibleAtRunTime := Value;
1000
if (csDesigning in ComponentState) then
1004
procedure TGLNGDManager.NotifyWorldSizeChange(Sender: TObject);
1006
//if not(csDesigning in ComponentState) then
1007
// NewtonSetWorldSize(FNewtonWorld, @FWorldSizeMin.AsVector,
1008
// @FWorldSizeMax.AsVector);
1011
procedure TGLNGDManager.RebuildAllJoint(Sender: TObject);
1013
procedure BuildBallAndSocket(Joint: TGLNGDJoint);
1016
if Assigned(FParentObject) and Assigned(FChildObject) then
1018
FNewtonJoint := NewtonConstraintCreateBall(FNewtonWorld,
1019
@(FBallAndSocketOptions.FPivotPoint.AsVector),
1020
GetBodyFromGLSceneObject(FChildObject),
1021
GetBodyFromGLSceneObject(FParentObject));
1022
NewtonJointSetCollisionState(FNewtonJoint, Ord(FCollisionState));
1023
NewtonJointSetStiffness(FNewtonJoint, FStiffness);
1027
procedure BuildHinge(Joint: TGLNGDJoint);
1030
if Assigned(FParentObject) and Assigned(FChildObject) then
1032
FNewtonJoint := NewtonConstraintCreateHinge(FNewtonWorld,
1033
@(FHingeOptions.FPivotPoint.AsVector),
1034
@(FHingeOptions.FPinDirection.AsVector),
1035
GetBodyFromGLSceneObject(FChildObject),
1036
GetBodyFromGLSceneObject(FParentObject));
1037
NewtonJointSetCollisionState(FNewtonJoint, Ord(FCollisionState));
1038
NewtonJointSetStiffness(FNewtonJoint, FStiffness);
1042
procedure BuildSlider(Joint: TGLNGDJoint);
1045
if Assigned(FParentObject) and Assigned(FChildObject) then
1047
FNewtonJoint := NewtonConstraintCreateSlider(FNewtonWorld,
1048
@(FSliderOptions.FPivotPoint.AsVector),
1049
@(FSliderOptions.FPinDirection.AsVector),
1050
GetBodyFromGLSceneObject(FChildObject),
1051
GetBodyFromGLSceneObject(FParentObject));
1052
NewtonJointSetCollisionState(FNewtonJoint, Ord(FCollisionState));
1053
NewtonJointSetStiffness(FNewtonJoint, FStiffness);
1057
procedure BuildCorkscrew(Joint: TGLNGDJoint);
1060
if Assigned(FParentObject) and Assigned(FChildObject) then
1062
FNewtonJoint := NewtonConstraintCreateCorkscrew(FNewtonWorld,
1063
@(FCorkscrewOptions.FPivotPoint.AsVector),
1064
@(FCorkscrewOptions.FPinDirection.AsVector),
1065
GetBodyFromGLSceneObject(FChildObject),
1066
GetBodyFromGLSceneObject(FParentObject));
1067
NewtonJointSetCollisionState(FNewtonJoint, Ord(FCollisionState));
1068
NewtonJointSetStiffness(FNewtonJoint, FStiffness);
1072
procedure BuildUniversal(Joint: TGLNGDJoint);
1075
if Assigned(FParentObject) and Assigned(FChildObject) then
1077
FNewtonJoint := NewtonConstraintCreateUniversal(FNewtonWorld,
1078
@(FUniversalOptions.FPivotPoint.AsVector),
1079
@(FUniversalOptions.FPinDirection.AsVector),
1080
@(FUniversalOptions.FPinDirection2.AsVector),
1081
GetBodyFromGLSceneObject(FChildObject),
1082
GetBodyFromGLSceneObject(FParentObject));
1083
NewtonJointSetCollisionState(FNewtonJoint, Ord(FCollisionState));
1084
NewtonJointSetStiffness(FNewtonJoint, FStiffness);
1088
procedure BuildCustomBallAndSocket(Joint: TGLNGDJoint);
1090
pinAndPivot: TMatrix;
1093
//if Assigned(FParentObject) and Assigned(FChildObject) then
1095
// pinAndPivot := IdentityHmgMatrix;
1096
// pinAndPivot.W := FCustomBallAndSocketOptions.FPivotPoint.AsVector;
1097
// FNewtonUserJoint := CreateCustomBallAndSocket(@pinAndPivot,
1098
// GetBodyFromGLSceneObject(FChildObject),
1099
// GetBodyFromGLSceneObject(FParentObject));
1100
// BallAndSocketSetConeAngle(FNewtonUserJoint,
1101
// DegToRad(FCustomBallAndSocketOptions.FConeAngle));
1102
// BallAndSocketSetTwistAngle(FNewtonUserJoint,
1103
// DegToRad(FCustomBallAndSocketOptions.FMinTwistAngle),
1104
// DegToRad(FCustomBallAndSocketOptions.FMaxTwistAngle));
1105
// CustomSetBodiesCollisionState(FNewtonUserJoint, Ord(FCollisionState));
1106
// NewtonJointSetStiffness(CustomGetNewtonJoint(FNewtonUserJoint),
1111
procedure BuildCustomHinge(Joint: TGLNGDJoint);
1113
pinAndPivot: TMatrix;
1114
bso: TGLBaseSceneObject;
1116
{ Newton wait from FPinAndPivotMatrix a structure like that:1117
First row: the pin direction
1118
Second and third rows are set to create an orthogonal matrix
1119
Fourth: The pivot position
1121
In glscene, the GLBaseSceneObjects direction is the third row,
1122
because the first row is the right vector (second row is up vector). }
1124
if Assigned(FParentObject) and Assigned(FChildObject) then
1126
bso := TGLBaseSceneObject.Create(FManager);
1127
bso.AbsolutePosition := FCustomHingeOptions.FPivotPoint.AsVector;
1128
bso.AbsoluteDirection := FCustomHingeOptions.FPinDirection.AsVector;
1129
pinAndPivot := bso.AbsoluteMatrix;
1130
pinAndPivot.X := bso.AbsoluteMatrix.Z;
1131
pinAndPivot.Z := bso.AbsoluteMatrix.X;
1134
//FNewtonUserJoint := CreateCustomHinge(@pinAndPivot,
1135
// GetBodyFromGLSceneObject(FChildObject),
1136
// GetBodyFromGLSceneObject(FParentObject));
1137
//HingeEnableLimits(FNewtonUserJoint, 1);
1138
//HingeSetLimits(FNewtonUserJoint,
1139
// DegToRad(FCustomHingeOptions.FMinAngle),
1140
// DegToRad(FCustomHingeOptions.FMaxAngle));
1141
//CustomSetBodiesCollisionState(FNewtonUserJoint, Ord(FCollisionState));
1142
//NewtonJointSetStiffness(CustomGetNewtonJoint(FNewtonUserJoint),
1144
//CustomSetUserData(FNewtonUserJoint, CustomHingeOptions);
1148
procedure BuildCustomSlider(Joint: TGLNGDJoint);
1150
pinAndPivot: TMatrix;
1151
bso: TGLBaseSceneObject;
1154
{ Newton wait from FPinAndPivotMatrix a structure like that:1155
First row: the pin direction
1156
Second and third rows are set to create an orthogonal matrix
1157
Fourth: The pivot position
1159
In glscene, the GLBaseSceneObjects direction is the third row,
1160
because the first row is the right vector (second row is up vector). }
1162
if Assigned(FParentObject) and Assigned(FChildObject) then
1165
bso := TGLBaseSceneObject.Create(FManager);
1166
bso.AbsolutePosition := FCustomSliderOptions.FPivotPoint.AsVector;
1167
bso.AbsoluteDirection := FCustomSliderOptions.FPinDirection.AsVector;
1168
pinAndPivot := bso.AbsoluteMatrix;
1169
pinAndPivot.X := bso.AbsoluteMatrix.Z;
1170
pinAndPivot.Z := bso.AbsoluteMatrix.X;
1173
//FNewtonUserJoint := CreateCustomSlider(@pinAndPivot, GetBodyFromGLSceneObject(FChildObject), GetBodyFromGLSceneObject(FParentObject));
1174
//SliderEnableLimits(FNewtonUserJoint, 1);
1175
//SliderSetLimits(FNewtonUserJoint, FCustomSliderOptions.FMinDistance, FCustomSliderOptions.FMaxDistance);
1176
//NewtonJointSetStiffness(CustomGetNewtonJoint(FNewtonUserJoint),0);
1178
//CustomSetBodiesCollisionState(FNewtonUserJoint, Ord(FCollisionState));
1179
//CustomSetUserData(FNewtonUserJoint, CustomSliderOptions);
1183
procedure BuildUpVector(Joint: TGLNGDJoint);
1186
if Assigned(FParentObject) then
1188
FNewtonJoint := NewtonConstraintCreateUpVector(FNewtonWorld,
1189
@FUPVectorDirection.AsVector,
1190
GetBodyFromGLSceneObject(FParentObject));
1194
procedure BuildKinematicController(Joint: TGLNGDJoint);
1199
procedure BuildOneJoint(Joint: TGLNGDJoint);
1201
case Joint.FJointType of
1204
Joint.DestroyNewtonData;
1205
BuildBallAndSocket(Joint);
1210
Joint.DestroyNewtonData;
1216
Joint.DestroyNewtonData;
1222
Joint.DestroyNewtonData;
1223
BuildCorkscrew(Joint);
1228
Joint.DestroyNewtonData;
1229
BuildUniversal(Joint);
1232
nj_CustomBallAndSocket:
1234
Joint.DestroyNewtonData;
1235
BuildCustomBallAndSocket(Joint);
1240
Joint.DestroyNewtonData;
1241
BuildCustomHinge(Joint);
1246
Joint.DestroyNewtonData;
1247
BuildCustomSlider(Joint);
1252
Joint.DestroyNewtonData;
1253
BuildUpVector(Joint);
1256
nj_KinematicController:
1258
// DestroyJoint(Joint);
1259
// BuildKinematicController(Joint);
1268
if not(csDesigning in ComponentState) and not(csLoading in ComponentState)
1271
if Sender is TGLNGDManager then
1272
for i := 0 to NewtonJoint.Count - 1 do
1273
BuildOneJoint(NewtonJoint.Items[i] as TGLNGDJoint);
1275
if (Sender is TGLNGDJoint) then
1276
BuildOneJoint((Sender as TGLNGDJoint));
1278
if Sender is TGLCoordinates then
1279
BuildOneJoint(((Sender as TGLCoordinates).Owner as TGLNGDJoint));
1286
procedure TGLNGDManager.RebuildAllMaterial;
1288
procedure BuildMaterialPair;
1290
I, ID0, ID1: Integer;
1292
for I := 0 to FNewtonSurfacePair.Count - 1 do
1293
with (FNewtonSurfacePair.Items[I] as TGLNGDSurfacePair) do
1295
if Assigned(NGDSurfaceItem1) and Assigned(NGDSurfaceItem2) then
1297
ID0 := NGDSurfaceItem1.ID;
1298
ID1 := NGDSurfaceItem2.ID;
1300
//NewtonMaterialSetContinuousCollisionMode(FNewtonWorld, ID0, ID1,
1301
// Ord(ContinuousCollisionMode));
1303
NewtonMaterialSetSurfaceThickness(FNewtonWorld, ID0, ID1, 1);
1304
NewtonMaterialSetDefaultSoftness(FNewtonWorld, ID0, ID1, Softness);
1305
NewtonMaterialSetDefaultElasticity(FNewtonWorld, ID0, ID1,
1307
NewtonMaterialSetDefaultCollidable(FNewtonWorld, ID0, ID1,
1309
NewtonMaterialSetDefaultFriction(FNewtonWorld, ID0, ID1,
1310
StaticFriction, KineticFriction);
1312
//NewtonMaterialSetCollisionCallback(FNewtonWorld, ID0, ID1,
1313
// FNewtonSurfacePair.Items[I], @TGLNGDSurfacePair.NewtonAABBOverlap,
1314
// @TGLNGDSurfacePair.NewtonContactsProcess);
1324
if not(csDesigning in ComponentState) then
1326
// for newton materials
1327
NewtonMaterialDestroyAllGroupID(FNewtonWorld);
1329
// Creates materialID
1330
for I := 0 to FNewtonSurfaceItem.Count - 1 do
1331
maxID := MaxInteger((FNewtonSurfaceItem.Items[I] as TGLNGDSurfaceItem).ID,
1333
for I := 0 to maxID - 1 do
1334
NewtonMaterialCreateGroupID(FNewtonWorld);
1336
// assign matID to bodies
1337
for I := 0 to FNGDBehaviours.Count - 1 do
1338
with FNGDBehaviours[I] do
1339
if Assigned(FNGDSurfaceItem) then
1340
NewtonBodySetMaterialGroupID(FNewtonBody, FNGDSurfaceItem.ID)
1342
NewtonBodySetMaterialGroupID(FNewtonBody, 0);
1344
// Set values to newton material pair :callback userdata friction...
1349
procedure TGLNGDManager.Step(deltatime: Single);
1351
if not(csDesigning in ComponentState) then
1352
NewtonUpdate(FNewtonWorld, deltatime);
1357
//---------------------------
1359
//---------------------------
1361
constructor TGLNGDBehaviour.Create(AOwner: TGLXCollection);
1364
FInitialized := False;
1365
FOwnerBaseSceneObject := OwnerBaseSceneObject;
1367
FContinuousCollisionMode := False;
1371
FNGDCollisions := nc_Primitive;
1373
FCollisionIteratorEvent := OnCollisionIteratorEvent;
1375
FTreeCollisionOptimize := True;
1376
FConvexCollisionTolerance := 0.01;
1377
FFileCollision := '';
1378
name := 'NGD Static';
1381
destructor TGLNGDBehaviour.Destroy;
1383
if Assigned(FManager) then
1384
Manager := nil; // This will call finalize
1388
procedure TGLNGDBehaviour.Finalize;
1392
FInitialized := False;
1394
if Assigned(FManager) then
1397
if Assigned(FManager.NewtonJoint) then
1398
for i := FManager.NewtonJoint.Count-1 downto 0 do
1400
if ((FManager.NewtonJoint.Items[i] as TGLNGDJoint).ParentObject = FOwnerBaseSceneObject)
1401
or ((FManager.NewtonJoint.Items[i] as TGLNGDJoint).ChildObject = FOwnerBaseSceneObject) then
1403
FManager.NewtonJoint.Items[i].Free;
1407
NewtonDestroyBody(FNewtonBody);
1413
function TGLNGDBehaviour.GetBBoxCollision: NewtonCollision;
1415
vc: array [0 .. 7] of TVector;
1418
for I := 0 to 8 - 1 do
1419
vc[I] := AABBToBB(FOwnerBaseSceneObject.AxisAlignedBoundingBoxEx).BBox[I];
1420
Result := NewtonCreateConvexHull(FManager.FNewtonWorld, 8, @vc[0],
1421
SizeOf(TVector), 0.01, 0, nil);
1424
function TGLNGDBehaviour.GetBSphereCollision: NewtonCollision;
1426
boundingSphere: TBSphere;
1427
collisionOffsetMatrix: TMatrix;
1429
AABBToBSphere(FOwnerBaseSceneObject.AxisAlignedBoundingBoxEx, boundingSphere);
1431
collisionOffsetMatrix := IdentityHmgMatrix;
1432
collisionOffsetMatrix.W := VectorMake(boundingSphere.Center, 1);
1433
Result := NewtonCreateSphere(FManager.FNewtonWorld, boundingSphere.Radius,0, @collisionOffsetMatrix);
1436
function TGLNGDBehaviour.GetConvexCollision: NewtonCollision;
1439
vertexArray: array of TVertex;
1441
if FOwnerBaseSceneObject is TGLBaseMesh then
1443
with (FOwnerBaseSceneObject as TGLBaseMesh) do
1446
for I := 0 to MeshObjects.Count - 1 do
1447
for J := 0 to MeshObjects[I].Vertices.Count - 1 do
1449
SetLength(vertexArray, Length(vertexArray) + 1);
1450
vertexArray[Length(vertexArray) - 1] := MeshObjects[I].Vertices[J];
1453
if Length(vertexArray) > 0 then
1454
Result := NewtonCreateConvexHull(FManager.FNewtonWorld,
1455
Length(vertexArray), @vertexArray[0], SizeOf(TVertex),
1456
FConvexCollisionTolerance, 0, nil)
1458
Result := GetNullCollision;
1462
Result := GetNullCollision;
1465
function TGLNGDBehaviour.GetHeightFieldCollision: NewtonCollision;
1468
attributeMap: array of ShortInt;
1470
SetLength(attributeMap, Length(FHeightFieldOptions.heightArray));
1471
for I := 0 to Length(FHeightFieldOptions.heightArray) - 1 do
1472
attributeMap[I] := 0;
1474
//Result := NewtonCreateHeightFieldCollision(FManager.FNewtonWorld,
1475
// FHeightFieldOptions.width, FHeightFieldOptions.depth,
1476
// Ord(FHeightFieldOptions.gridDiagonals),
1477
// PUnsigned_short(FHeightFieldOptions.heightArray), P2Char(attributeMap),
1478
// FHeightFieldOptions.widthDepthScale, FHeightFieldOptions.heightScale, 0);
1481
function TGLNGDBehaviour.GetMeshCollision: NewtonCollision;
1483
collisionArray: array of NewtonCollision;
1485
vertexArray: array of TVertex;
1487
if FOwnerBaseSceneObject is TGLBaseMesh then
1489
with (FOwnerBaseSceneObject as TGLBaseMesh) do
1492
// Iterate trough mesh of GLobject
1493
for I := 0 to MeshObjects.Count - 1 do
1495
// Iterate trough vertices of mesh
1496
for J := 0 to MeshObjects[I].Vertices.Count - 1 do
1498
SetLength(vertexArray, Length(vertexArray) + 1);
1499
vertexArray[Length(vertexArray) - 1] := MeshObjects[I].Vertices[J];
1502
if Length(vertexArray) > 3 then
1504
SetLength(collisionArray, Length(collisionArray) + 1);
1506
collisionArray[Length(collisionArray) - 1] := NewtonCreateConvexHull
1507
(FManager.FNewtonWorld, Length(vertexArray), @vertexArray[0],
1508
SizeOf(TVertex), FConvexCollisionTolerance, 0, nil);
1510
// Remove last collision if the newton function was not successful
1511
if collisionArray[Length(collisionArray) - 1] = nil then
1512
SetLength(collisionArray, Length(collisionArray) - 1);
1515
SetLength(vertexArray, 0);
1518
//if Length(collisionArray) > 0 then
1519
// Result := NewtonCreateCompoundCollision(FManager.FNewtonWorld,
1520
// Length(collisionArray), TCollisionPrimitiveArray(@collisionArray[0]), 0)
1522
// Result := GetNullCollision;
1527
Result := GetNullCollision;
1531
function TGLNGDBehaviour.GetNewtonBodyMatrix: TMatrix;
1533
if Assigned(FManager) then
1534
NewtonBodyGetmatrix(FNewtonBody, @FNewtonBodyMatrix);
1535
Result := FNewtonBodyMatrix;
1538
function TGLNGDBehaviour.GetNewtonBodyAABB: TAABB;
1540
if Assigned(FManager) then
1541
NewtonBodyGetAABB(FNewtonBody, @(Result.min), @(Result.max));
1544
function TGLNGDBehaviour.GetNGDFileCollision: NewtonCollision;
1546
MyFile: TFileStream;
1549
if FileExists(FFileCollision) then
1551
MyFile := TFileStream.Create(FFileCollision, fmOpenRead);
1552
Result := NewtonCreateCollisionFromSerialization(FManager.FNewtonWorld,
1553
@TGLNGDBehaviour.NewtonDeserialize, Pointer(MyFile));
1557
Result := NewtonCreateNull(FManager.FNewtonWorld);
1560
function TGLNGDBehaviour.GetNullCollision: NewtonCollision;
1562
Result := NewtonCreateNull(FManager.FNewtonWorld);
1565
function TGLNGDBehaviour.GetPrimitiveCollision: NewtonCollision;
1567
collisionOffsetMatrix: TMatrix; // For cone capsule and cylinder
1569
collisionOffsetMatrix := IdentityHmgMatrix;
1571
if (FOwnerBaseSceneObject is TGLCube) then
1573
with (FOwnerBaseSceneObject as TGLCube) do
1574
Result := NewtonCreateBox(FManager.FNewtonWorld, CubeWidth, CubeHeight,
1575
CubeDepth, 0, @collisionOffsetMatrix);
1578
else if (FOwnerBaseSceneObject is TGLSphere) then
1580
with (FOwnerBaseSceneObject as TGLSphere) do
1581
Result := NewtonCreateSphere(FManager.FNewtonWorld, Radius, 0, @collisionOffsetMatrix);
1584
else if (FOwnerBaseSceneObject is TGLCone) then
1586
collisionOffsetMatrix := MatrixMultiply(collisionOffsetMatrix,
1587
CreateRotationMatrixZ(Pi / 2.0));
1588
with (FOwnerBaseSceneObject as TGLCone) do
1589
Result := NewtonCreateCone(FManager.FNewtonWorld, BottomRadius, Height,
1590
0, @collisionOffsetMatrix);
1593
else if (FOwnerBaseSceneObject is TGLCapsule) then
1595
collisionOffsetMatrix := MatrixMultiply(collisionOffsetMatrix,
1596
CreateRotationMatrixY(Pi / 2.0));
1597
with (FOwnerBaseSceneObject as TGLCapsule) do
1598
// Use Cylinder shape for buoyancy
1599
Result := NewtonCreateCapsule(FManager.FNewtonWorld, Radius,
1600
Height + 2 * Radius,height, 0, @collisionOffsetMatrix);
1603
else if (FOwnerBaseSceneObject is TGLCylinder) then
1605
collisionOffsetMatrix := MatrixMultiply(collisionOffsetMatrix,
1606
CreateRotationMatrixZ(Pi / 2.0));
1607
with (FOwnerBaseSceneObject as TGLCylinder) do
1608
Result := NewtonCreateCylinder(FManager.FNewtonWorld, TopRadius, BottomRadius,
1609
Height, 0, @collisionOffsetMatrix);
1612
Result := GetNullCollision;
1615
function TGLNGDBehaviour.GetTreeCollision: NewtonCollision;
1617
meshIndex, triangleIndex: Integer;
1618
triangleList: TAffineVectorList;
1619
v: array [0 .. 2] of TAffineVector;
1622
if FOwnerBaseSceneObject is TGLBaseMesh then
1624
with (FOwnerBaseSceneObject as TGLBaseMesh) do
1626
Result := NewtonCreateTreeCollision(FManager.FNewtonWorld, 0);
1627
NewtonTreeCollisionBeginBuild(Result);
1629
for meshIndex := 0 to MeshObjects.Count - 1 do
1631
triangleList := MeshObjects[meshIndex].ExtractTriangles;
1632
for triangleIndex := 0 to triangleList.Count - 1 do
1634
if triangleIndex mod 3 = 0 then
1636
v[0] := triangleList.Items[triangleIndex];
1637
// ScaleVector(v[0], FOwnerBaseSceneObject.Scale.X);
1638
v[1] := triangleList.Items[triangleIndex + 1];
1639
// ScaleVector(v[1], FOwnerBaseSceneObject.Scale.Y);
1640
v[2] := triangleList.Items[triangleIndex + 2];
1641
// ScaleVector(v[2], FOwnerBaseSceneObject.Scale.Z);
1642
NewtonTreeCollisionAddFace(Result, 3, @(v), SizeOf(TAffineVector),
1648
NewtonTreeCollisionEndBuild(Result, Ord(FTreeCollisionOptimize));
1652
Result := GetNullCollision;
1655
procedure TGLNGDBehaviour.Initialize;
1657
FInitialized := True;
1659
if Assigned(FManager) then
1661
// Creates NewtonBody with null collision
1662
FCollision := NewtonCreateNull(FManager.FNewtonWorld);
1663
FNewtonBodyMatrix := FOwnerBaseSceneObject.AbsoluteMatrix;
1664
//FNewtonBody := NewtonCreateBody(FManager.FNewtonWorld, FCollision,
1665
// @FNewtonBodyMatrix);
1667
//// Release NewtonCollision
1668
//NewtonReleaseCollision(FManager.FNewtonWorld, FCollision);
1670
// Set Link between glscene and newton
1671
NewtonBodySetUserdata(FNewtonBody, self);
1673
// Set position and orientation
1674
SetNewtonBodyMatrix(FOwnerBaseSceneObject.AbsoluteMatrix);
1681
procedure TGLNGDBehaviour.Loaded;
1686
if FManagerName <> '' then
1688
mng := FindManager(TGLNGDManager, FManagerName);
1689
if Assigned(mng) then
1690
Manager := TGLNGDManager(mng);
1694
if Assigned(FManager) then
1696
SetContinuousCollisionMode(FContinuousCollisionMode);
1700
class procedure TGLNGDBehaviour.NewtonCollisionIterator
1701
(const userData: Pointer; vertexCount: Integer; const faceArray: PNGDFloat;
1702
faceId: Integer)cdecl;
1704
TGLNGDBehaviour(userData).FCollisionIteratorEvent(userData, vertexCount,
1708
// Serializes are called by NGDBehaviour to save and load collision in file
1709
// It's better to save/load big collisions [over 50000 polygones] to reduce
1711
class procedure TGLNGDBehaviour.NewtonDeserialize(serializeHandle,
1712
buffer: Pointer; size: Cardinal)cdecl;
1714
TFileStream(serializeHandle).read(buffer^, size);
1717
class procedure TGLNGDBehaviour.NewtonSerialize(serializeHandle: Pointer;
1718
const buffer: Pointer; size: Cardinal)cdecl;
1720
TFileStream(serializeHandle).write(buffer^, size);
1723
procedure TGLNGDBehaviour.OnCollisionIteratorEvent(const userData: Pointer;
1724
vertexCount: Integer; const cfaceArray: PNGDFloat; faceId: Integer);
1727
v0, v1: array [0 .. 2] of Single;
1728
vA: array of Single;
1730
// This algorithme draw Collision Shape for Debuggin.
1731
// Taken to Sascha Willems in SDLNewton-Demo at
1732
// http://www.saschawillems.de/?page_id=82
1734
// Leave if there is no or to much vertex
1735
if (vertexCount = 0) then
1738
SetLength(vA, vertexCount * 3);
1739
Move(cfaceArray^, vA[0], vertexCount * 3 * SizeOf(Single));
1740
v0[0] := vA[(vertexCount - 1) * 3];
1741
v0[1] := vA[(vertexCount - 1) * 3 + 1];
1742
v0[2] := vA[(vertexCount - 1) * 3 + 2];
1743
for I := 0 to vertexCount - 1 do
1746
v1[1] := vA[I * 3 + 1];
1747
v1[2] := vA[I * 3 + 2];
1748
FManager.AddNode(v0[0], v0[1], v0[2]);
1749
FManager.AddNode(v1[0], v1[1], v1[2]);
1754
procedure TGLNGDBehaviour.Reinitialize;
1758
// Set Appropriate NewtonCollision
1760
// Set position and orientation
1761
SetNewtonBodyMatrix(FOwnerBaseSceneObject.AbsoluteMatrix);
1766
procedure TGLNGDBehaviour.Render;
1770
// Rebuild collision in design time
1771
if (csDesigning in FOwnerBaseSceneObject.ComponentState) then
1774
if self is TGLNGDDynamic then
1775
FManager.FCurrentColor := FManager.DebugOption.GeomColorDyn
1777
FManager.FCurrentColor := FManager.DebugOption.GeomColorStat;
1778
M := FOwnerBaseSceneObject.AbsoluteMatrix;
1779
if mdShowGeometry in FManager.DebugOption.NGDManagerDebugs then
1780
NewtonCollisionForEachPolygonDo(FCollision, @M,
1781
@TGLNGDBehaviour.NewtonCollisionIterator, self);
1784
// In this procedure, we assign collision to body
1785
// [Because when initialised, the collision for body is type NULL]
1786
procedure TGLNGDBehaviour.UpdCollision;
1788
collisionInfoRecord: TNewtonCollisionInfoRecord;
1791
case FNGDCollisions of
1793
FCollision := GetPrimitiveCollision;
1795
FCollision := GetConvexCollision;
1797
FCollision := GetBBoxCollision;
1799
FCollision := GetBSphereCollision;
1801
FCollision := GetTreeCollision;
1803
FCollision := GetMeshCollision;
1805
FCollision := GetNullCollision;
1807
FCollision := GetHeightFieldCollision;
1809
FCollision := GetNGDFileCollision;
1812
if Assigned(FCollision) then
1814
NewtonBodySetCollision(FNewtonBody, FCollision);
1816
// The API Ask for releasing Collision to avoid memory leak
1817
NewtonCollisionGetInfo(FCollision, @collisionInfoRecord);
1818
//if collisionInfoRecord.m_referenceCount > 2 then
1819
// NewtonReleaseCollision(FManager.FNewtonWorld, FCollision);
1824
procedure TGLNGDBehaviour.SetContinuousCollisionMode(const Value: Boolean);
1826
// for continue collision to be active the continue collision mode must on
1827
// the material pair of the colliding bodies as well as on at
1828
// least one of the two colliding bodies.
1829
// see NewtonBodySetContinuousCollisionMode
1830
// see NewtonMaterialSetContinuousCollisionMode
1831
FContinuousCollisionMode := Value;
1832
if not(csDesigning in FOwnerBaseSceneObject.ComponentState) then
1833
if Assigned(FManager) then
1834
NewtonBodySetContinuousCollisionMode(FNewtonBody, Ord(Value));
1837
procedure TGLNGDBehaviour.SetHeightFieldOptions(const Value: TGLNGDHeightField);
1839
FHeightFieldOptions := Value;
1843
procedure TGLNGDBehaviour.SetManager(Value: TGLNGDManager);
1845
if FManager <> Value then
1847
if Assigned(FManager) then
1851
FManager.FNGDBehaviours.Remove(self);
1852
// FManager.NotifyChange(self);
1855
if Assigned(FManager) then
1858
FManager.FNGDBehaviours.Add(self);
1859
FManager.NotifyChange(self);
1864
procedure TGLNGDBehaviour.SetNewtonBodyMatrix(const Value: TMatrix);
1866
FNewtonBodyMatrix := Value;
1867
if Assigned(FManager) then
1868
NewtonBodySetmatrix(FNewtonBody, @FNewtonBodyMatrix);
1871
procedure TGLNGDBehaviour.SetNGDNewtonCollisions
1872
(const Value: TGLNGDCollisions);
1874
FNGDCollisions := Value;
1875
if Assigned(FManager) then
1879
procedure TGLNGDBehaviour.SetNGDSurfaceItem(const Value: TGLNGDSurfaceItem);
1881
FNGDSurfaceItem := Value;
1882
FManager.RebuildAllMaterial;
1885
function TGLNGDBehaviour.StoredTolerance: Boolean;
1887
Result := not SameValue(FConvexCollisionTolerance, 0.01, epsilon);
1890
class function TGLNGDBehaviour.UniqueItem: Boolean;
1895
procedure TGLNGDBehaviour.ReadFromFiler(reader: TReader);
1902
version := ReadInteger; // read data version
1903
Assert(version <= 1); // Archive version
1905
FManagerName := ReadString;
1906
FContinuousCollisionMode := ReadBoolean;
1907
read(FNGDCollisions, SizeOf(TGLNGDCollisions));
1908
FTreeCollisionOptimize := ReadBoolean;
1909
if version <= 0 then
1910
FConvexCollisionTolerance := ReadSingle
1912
FConvexCollisionTolerance := ReadFloat;
1913
FFileCollision := ReadString;
1917
procedure TGLNGDBehaviour.WriteToFiler(writer: TWriter);
1922
WriteInteger(1); // Archive version
1923
if Assigned(FManager) then
1924
WriteString(FManager.GetNamePath)
1927
WriteBoolean(FContinuousCollisionMode);
1928
write(FNGDCollisions, SizeOf(TGLNGDCollisions));
1929
WriteBoolean(FTreeCollisionOptimize);
1930
WriteFloat(FConvexCollisionTolerance);
1931
WriteString(FFileCollision);
1935
procedure TGLNGDBehaviour.Serialize(filename: string);
1937
MyFile: TFileStream;
1939
MyFile := TFileStream.Create(filename, fmCreate or fmOpenReadWrite);
1941
NewtonCollisionSerialize(FManager.FNewtonWorld, FCollision,
1942
@TGLNGDBehaviour.NewtonSerialize, Pointer(MyFile));
1947
procedure TGLNGDBehaviour.DeSerialize(filename: string);
1949
MyFile: TFileStream;
1950
collisionInfoRecord: TNewtonCollisionInfoRecord;
1952
MyFile := TFileStream.Create(filename, fmOpenRead);
1954
FCollision := NewtonCreateCollisionFromSerialization(FManager.FNewtonWorld,
1955
@TGLNGDBehaviour.NewtonDeserialize, Pointer(MyFile));
1958
NewtonBodySetCollision(FNewtonBody, FCollision);
1960
// Release collision
1961
NewtonCollisionGetInfo(FCollision, @collisionInfoRecord);
1962
//if collisionInfoRecord.m_referenceCount > 2 then
1963
// NewtonReleaseCollision(FManager.FNewtonWorld, FCollision);
1970
procedure TGLNGDDynamic.AddImpulse(const veloc, pointposit: TVector);
1972
//if Assigned(FNewtonBody) then
1973
// NewtonBodyAddImpulse(FNewtonBody, @veloc, @pointposit);
1976
constructor TGLNGDDynamic.Create(AOwner: TGLXCollection);
1980
FLinearDamping := 0.1;
1981
FAngularDamping := TGLCoordinates.CreateInitialized(self,
1982
VectorMake(0.1, 0.1, 0.1, 0), csPoint);
1983
FAngularDamping.OnNotifyChange := NotifyAngularDampingChange;
1986
FForce := TGLCoordinates.CreateInitialized(self, NullHmgVector, csVector);
1987
FTorque := TGLCoordinates.CreateInitialized(self, NullHmgVector, csVector);
1988
FCenterOfMass := TGLCoordinates.CreateInitialized(self, NullHmgVector,
1990
FCenterOfMass.OnNotifyChange := NotifyCenterOfMassChange;
1991
FAABBmin := TGLCoordinates.CreateInitialized(self, NullHmgVector, csPoint);
1992
FAABBmax := TGLCoordinates.CreateInitialized(self, NullHmgVector, csPoint);
1993
FAppliedOmega := TGLCoordinates.CreateInitialized(self, NullHmgVector,
1995
FAppliedVelocity := TGLCoordinates.CreateInitialized(self, NullHmgVector,
1997
FAppliedForce := TGLCoordinates.CreateInitialized(self, NullHmgVector,
1999
FAppliedTorque := TGLCoordinates.CreateInitialized(self, NullHmgVector,
2001
FUseGravity := True;
2002
FNullCollisionVolume := 0;
2004
FApplyForceAndTorqueEvent := OnApplyForceAndTorqueEvent;
2005
FSetTransformEvent := OnSetTransformEvent;
2006
name := 'NGD Dynamic'
2009
destructor TGLNGDDynamic.Destroy;
2011
// Clean up everything
2012
FAngularDamping.Free;
2019
FAppliedTorque.Free;
2020
FAppliedVelocity.Free;
2025
procedure TGLNGDDynamic.Finalize;
2027
if not(csDesigning in FOwnerBaseSceneObject.ComponentState) then
2028
if Assigned(FManager) then
2030
// Removing Callback
2031
NewtonBodySetForceAndTorqueCallback(FNewtonBody, nil);
2032
NewtonBodySetTransformCallback(FNewtonBody, nil);
2037
class function TGLNGDDynamic.FriendlyName: string;
2039
Result := 'NGD Dynamic';
2043
procedure TGLNGDDynamic.Initialize;
2046
if not(csDesigning in FOwnerBaseSceneObject.ComponentState) then
2047
if Assigned(FManager) then
2049
// Set Density, Mass and inertie matrix
2050
SetDensity(FDensity);
2053
NewtonBodySetForceAndTorqueCallback(FNewtonBody,
2054
@TGLNGDDynamic.NewtonApplyForceAndTorque);
2055
NewtonBodySetTransformCallback(FNewtonBody,
2056
@TGLNGDDynamic.NewtonSetTransform);
2060
procedure TGLNGDDynamic.Render;
2062
procedure DrawAABB(min, max: TGLCoordinates3);
2077
FManager.AddNode(min.X, min.Y, min.Z); // E
2078
FManager.AddNode(max.X, min.Y, min.Z); // F
2080
FManager.AddNode(max.X, min.Y, min.Z); // F
2081
FManager.AddNode(max.X, max.Y, min.Z); // G
2083
FManager.AddNode(max.X, max.Y, min.Z); // G
2084
FManager.AddNode(min.X, max.Y, min.Z); // H
2086
FManager.AddNode(min.X, max.Y, min.Z); // H
2087
FManager.AddNode(min.X, min.Y, min.Z); // E
2090
FManager.AddNode(min.X, min.Y, max.Z); // A
2091
FManager.AddNode(max.X, min.Y, max.Z); // B
2093
FManager.AddNode(max.X, min.Y, max.Z); // B
2094
FManager.AddNode(max.X, max.Y, max.Z); // C
2096
FManager.AddNode(max.X, max.Y, max.Z); // C
2097
FManager.AddNode(min.X, max.Y, max.Z); // D
2099
FManager.AddNode(min.X, max.Y, max.Z); // D
2100
FManager.AddNode(min.X, min.Y, max.Z); // A
2103
FManager.AddNode(min.X, min.Y, max.Z); // A
2104
FManager.AddNode(min.X, min.Y, min.Z); // E
2106
FManager.AddNode(max.X, min.Y, max.Z); // B
2107
FManager.AddNode(max.X, min.Y, min.Z); // F
2109
FManager.AddNode(max.X, max.Y, max.Z); // C
2110
FManager.AddNode(max.X, max.Y, min.Z); // G
2112
FManager.AddNode(min.X, max.Y, max.Z); // D
2113
FManager.AddNode(min.X, max.Y, min.Z); // H
2116
procedure DrawContact;
2119
thisContact: NewtonJoint;
2120
material: NewtonMaterial;
2123
FManager.FCurrentColor := FManager.DebugOption.ContactColor;
2124
cnt := NewtonBodyGetFirstContactJoint(FNewtonBody);
2127
thisContact := NewtonContactJointGetFirstContact(cnt);
2128
while thisContact <> nil do
2130
material := NewtonContactGetMaterial(thisContact);
2131
NewtonMaterialGetContactPositionAndNormal(material, FNewtonBody, @pos, @nor);
2133
FManager.AddNode(pos);
2134
nor := VectorAdd(pos, nor);
2135
FManager.AddNode(nor);
2137
thisContact := NewtonContactJointGetNextContact(cnt, thisContact);
2139
cnt := NewtonBodyGetNextContactJoint(FNewtonBody, cnt);
2143
function GetAbsCom(): TVector;
2147
NewtonBodyGetCentreOfMass(FNewtonBody, @Result);
2148
M := IdentityHmgMatrix;
2151
M := MatrixMultiply(M, FOwnerBaseSceneObject.AbsoluteMatrix);
2155
procedure DrawForce;
2162
if mdShowForce in FManager.DebugOption.NGDManagerDebugs then
2164
FManager.FCurrentColor := FManager.DebugOption.ForceColor;
2165
nor := VectorAdd(pos, FForce.AsVector);
2166
FManager.AddNode(pos);
2167
FManager.AddNode(nor);
2170
if mdShowAppliedForce in FManager.DebugOption.NGDManagerDebugs then
2172
FManager.FCurrentColor := FManager.DebugOption.AppliedForceColor;
2173
nor := VectorAdd(pos, FAppliedForce.AsVector);
2174
FManager.AddNode(pos);
2175
FManager.AddNode(nor);
2179
if mdShowAppliedVelocity in FManager.DebugOption.NGDManagerDebugs then
2181
FManager.FCurrentColor := FManager.DebugOption.AppliedVelocityColor;
2182
nor := VectorAdd(pos, FAppliedVelocity.AsVector);
2183
FManager.AddNode(pos);
2184
FManager.AddNode(nor);
2194
FManager.FCurrentColor := FManager.DebugOption.CenterOfMassColor;
2195
size := FManager.DebugOption.DotAxisSize;
2197
FManager.AddNode(VectorAdd(com, VectorMake(0, 0, size)));
2198
FManager.AddNode(VectorAdd(com, VectorMake(0, 0, -size)));
2199
FManager.AddNode(VectorAdd(com, VectorMake(0, size, 0)));
2200
FManager.AddNode(VectorAdd(com, VectorMake(0, -size, 0)));
2201
FManager.AddNode(VectorAdd(com, VectorMake(size, 0, 0)));
2202
FManager.AddNode(VectorAdd(com, VectorMake(-size, 0, 0)));
2208
// Move/Rotate NewtonObject if matrix are not equal in design time.
2209
if (csDesigning in FOwnerBaseSceneObject.ComponentState) then
2210
if not MatrixEquals(NewtonBodyMatrix, FOwnerBaseSceneObject.AbsoluteMatrix)
2212
SetNewtonBodyMatrix(FOwnerBaseSceneObject.AbsoluteMatrix);
2214
NewtonBodyGetAABB(FNewtonBody, @(FAABBmin.AsVector), @(FAABBmax.AsVector));
2216
if NewtonBodyGetSleepState(FNewtonBody) = 1 then
2217
FManager.FCurrentColor := FManager.DebugOption.AABBColorSleep
2219
FManager.FCurrentColor := FManager.DebugOption.AABBColor;
2221
if mdShowAABB in FManager.DebugOption.NGDManagerDebugs then
2222
DrawAABB(FAABBmin, FAABBmax);
2224
if mdShowContact in FManager.DebugOption.NGDManagerDebugs then
2227
DrawForce; // Draw Force, AppliedForce and AppliedVelocity
2229
if mdShowCenterOfMass in FManager.DebugOption.NGDManagerDebugs then
2233
procedure TGLNGDDynamic.SetAutoSleep(const Value: Boolean);
2235
FAutoSleep := Value;
2236
if not(csDesigning in FOwnerBaseSceneObject.ComponentState) then
2237
if Assigned(FManager) then
2238
NewtonBodySetAutoSleep(FNewtonBody, Ord(FAutoSleep));
2241
procedure TGLNGDDynamic.SetDensity(const Value: Single);
2246
if Assigned(FManager) then
2251
FVolume := NewtonConvexCollisionCalculateVolume(FCollision);
2252
NewtonConvexCollisionCalculateInertialMatrix(FCollision, @inertia,
2255
if IsZero(FVolume, epsilon) then
2257
FVolume := FNullCollisionVolume;
2258
inertia := VectorMake(FNullCollisionVolume, FNullCollisionVolume,
2259
FNullCollisionVolume, 0);
2262
FMass := FVolume * FDensity;
2264
if not(csDesigning in FOwnerBaseSceneObject.ComponentState) then
2265
NewtonBodySetMassMatrix(FNewtonBody, FMass, FMass * inertia.X,
2266
FMass * inertia.Y, FMass * inertia.Z);
2268
FCenterOfMass.AsVector := origin;
2272
procedure TGLNGDDynamic.SetLinearDamping(const Value: Single);
2274
if (Value >= 0) and (Value <= 1) then
2275
FLinearDamping := Value;
2276
if not(csDesigning in FOwnerBaseSceneObject.ComponentState) then
2277
if Assigned(FManager) then
2278
NewtonBodySetLinearDamping(FNewtonBody, FLinearDamping);
2281
function TGLNGDDynamic.GetOmega: TVector;
2283
NewtonBodyGetOmega(FNewtonBody, @Result);
2286
procedure TGLNGDDynamic.SetOmega(const Omega: TVector);
2288
NewtonBodySetOmega(FNewtonBody, @Omega);
2291
function TGLNGDDynamic.GetVelocity: TVector;
2293
NewtonBodyGetVelocity(FNewtonBody, @Result);
2296
procedure TGLNGDDynamic.SetVelocity(const Velocity: TVector);
2298
NewtonBodySetVelocity(FNewtonBody, @Velocity);
2301
function TGLNGDDynamic.StoredDensity: Boolean;
2303
Result := not SameValue(FDensity, 1, epsilon);
2306
function TGLNGDDynamic.StoredLinearDamping: Boolean;
2308
Result := not SameValue(FLinearDamping, 0.1, epsilon);
2311
function TGLNGDDynamic.StoredNullCollisionVolume: Boolean;
2313
Result := not SameValue(FNullCollisionVolume, 0, epsilon);
2316
procedure TGLNGDDynamic.WriteToFiler(writer: TWriter);
2321
WriteInteger(1); // Archive version
2322
WriteBoolean(FAutoSleep);
2323
WriteFloat(FLinearDamping);
2324
WriteFloat(FDensity);
2325
WriteBoolean(FUseGravity);
2326
WriteFloat(FNullCollisionVolume);
2328
FForce.WriteToFiler(writer);
2329
FTorque.WriteToFiler(writer);
2330
FCenterOfMass.WriteToFiler(writer);
2331
FAngularDamping.WriteToFiler(writer);
2334
procedure TGLNGDDynamic.ReadFromFiler(reader: TReader);
2341
version := ReadInteger; // read data version
2342
Assert(version <= 1); // Archive version
2344
FAutoSleep := ReadBoolean;
2345
if version <= 0 then
2346
FLinearDamping := ReadSingle
2348
FLinearDamping := ReadFloat;
2349
if version <= 0 then
2350
FDensity := ReadSingle
2352
FDensity := ReadFloat;
2354
// if Version >= 1 then
2355
FUseGravity := ReadBoolean;
2357
if version <= 0 then
2358
FNullCollisionVolume := ReadSingle
2360
FNullCollisionVolume := ReadFloat;
2363
FForce.ReadFromFiler(reader);
2364
FTorque.ReadFromFiler(reader);
2365
FCenterOfMass.ReadFromFiler(reader);
2366
FAngularDamping.ReadFromFiler(reader);
2369
procedure TGLNGDDynamic.Loaded;
2372
if Assigned(FManager) then
2374
SetAutoSleep(FAutoSleep);
2375
SetLinearDamping(FLinearDamping);
2376
SetDensity(FDensity);
2377
NotifyCenterOfMassChange(self);
2378
NotifyAngularDampingChange(self);
2382
class procedure TGLNGDDynamic.NewtonApplyForceAndTorque
2383
(const body: NewtonBody; timestep: NGDFloat; threadIndex: Integer); cdecl;
2385
TGLNGDDynamic(NewtonBodyGetUserData(body)).FApplyForceAndTorqueEvent(body,
2386
timestep, threadIndex);
2389
class procedure TGLNGDDynamic.NewtonSetTransform(const body: NewtonBody;
2390
const matrix: PNGDFloat; threadIndex: Integer); cdecl;
2392
TGLNGDDynamic(NewtonBodyGetUserData(body)).FSetTransformEvent(body, matrix,
2396
procedure TGLNGDDynamic.NotifyAngularDampingChange(Sender: TObject);
2398
FAngularDamping.OnNotifyChange := nil;
2399
if (FAngularDamping.X >= 0) and (FAngularDamping.X <= 1) and
2400
(FAngularDamping.Y >= 0) and (FAngularDamping.Y <= 1) and
2401
(FAngularDamping.Z >= 0) and (FAngularDamping.Z <= 1) then
2402
if Assigned(FManager) then
2403
NewtonBodySetAngularDamping(FNewtonBody, @(FAngularDamping.AsVector));
2404
FAngularDamping.OnNotifyChange := NotifyAngularDampingChange;
2407
procedure TGLNGDDynamic.NotifyCenterOfMassChange(Sender: TObject);
2409
FCenterOfMass.OnNotifyChange := nil;
2410
if Assigned(FManager) then
2411
NewtonBodySetCentreOfMass(FNewtonBody, @(FCenterOfMass.AsVector));
2412
FCenterOfMass.OnNotifyChange := NotifyCenterOfMassChange;
2415
procedure TGLNGDDynamic.OnApplyForceAndTorqueEvent(const cbody: NewtonBody;
2416
timestep: NGDFloat; threadIndex: Integer);
2418
worldGravity: TVector;
2421
// Read Only: We get the force and torque resulting from every interaction on this body
2422
NewtonBodyGetForce(cbody, @(FAppliedForce.AsVector));
2423
NewtonBodyGetTorque(cbody, @(FAppliedTorque.AsVector));
2425
NewtonBodyGetVelocity(cbody, @(FAppliedVelocity.AsVector));
2426
NewtonBodyGetOmega(cbody, @(FAppliedOmega.AsVector));
2428
// Raise Custom event
2429
if Assigned(FCustomForceAndTorqueEvent) then
2430
FCustomForceAndTorqueEvent(cbody, timestep, threadIndex)
2433
NewtonBodySetForce(cbody, @(Force.AsVector));
2434
NewtonBodySetTorque(cbody, @(Torque.AsVector));
2436
// Add Gravity from World
2439
worldGravity := VectorScale(FManager.Gravity.AsVector, FMass);
2440
NewtonBodyAddForce(cbody, @(worldGravity));
2446
procedure TGLNGDDynamic.OnSetTransformEvent(const cbody: NewtonBody;
2447
const cmatrix: PNGDFloat; threadIndex: Integer);
2451
// The Newton API does not support scale [scale modifie value in matrix],
2452
// so this line reset scale of the glsceneObject to (1,1,1)
2453
// to avoid crashing the application
2455
with FOwnerBaseSceneObject do
2456
if not SameValue(Scale.X, 1.0, epsi) or not SameValue(Scale.Y, 1.0, epsi)
2457
or not SameValue(Scale.Z, 1.0, epsi) then
2459
Scale.SetVector(1, 1, 1);
2460
SetNewtonBodyMatrix(AbsoluteMatrix);
2463
// Make the Position and orientation of the glscene-Object relative to the
2464
// NewtonBody position and orientation.
2465
FOwnerBaseSceneObject.AbsoluteMatrix := pMatrix(cmatrix)^;
2468
//------------------------
2470
//------------------------
2472
procedure TGLNGDStatic.Render;
2475
// Move/Rotate NewtonObject if matrix are not equal in run time.
2476
if not MatrixEquals(NewtonBodyMatrix, FOwnerBaseSceneObject.AbsoluteMatrix)
2478
SetNewtonBodyMatrix(FOwnerBaseSceneObject.AbsoluteMatrix);
2482
class function TGLNGDStatic.FriendlyName: string;
2484
Result := 'NGD Static';
2487
//------------------------
2489
//------------------------
2491
function TGLNGDSurfaceItem.GetDisplayName: string;
2493
if FDisplayName = '' then
2494
FDisplayName := 'Iron';
2495
Result := FDisplayName;
2498
procedure TGLNGDSurfaceItem.SetDisplayName(const Value: string);
2501
FDisplayName := Value;
2504
//------------------------
2505
{ TGLNGDSurfacePair }2506
//------------------------
2508
constructor TGLNGDSurfacePair.Create(Collection: TCollection);
2513
FCollidable := True;
2514
FStaticFriction := 0.9;
2515
FKineticFriction := 0.5;
2516
FContinuousCollisionMode := False;
2517
FThickness := False;
2519
FAABBOverlapEvent := OnNewtonAABBOverlapEvent;
2520
FContactProcessEvent := OnNewtonContactsProcessEvent;
2521
FManager := TGLNGDManager(Collection.Owner);
2522
FManager.RebuildAllMaterial;
2525
class function TGLNGDSurfacePair.NewtonAABBOverlap
2526
(const material: NewtonMaterial;
2527
const body0, body1: NewtonBody; threadIndex: Integer): Integer; cdecl;
2529
Result := Ord(TGLNGDSurfacePair(NewtonMaterialGetMaterialPairUserData(material))
2530
.FAABBOverlapEvent(material, body0, body1, threadIndex));
2533
class procedure TGLNGDSurfacePair.NewtonContactsProcess
2534
(const contact: NewtonJoint; timestep: NGDFloat; threadIndex: Integer);
2537
TGLNGDSurfacePair(NewtonMaterialGetMaterialPairUserData
2538
(NewtonContactGetMaterial
2539
(NewtonContactJointGetFirstContact(contact)))).FContactProcessEvent
2540
(contact, timestep, threadIndex);
2543
function TGLNGDSurfacePair.OnNewtonAABBOverlapEvent
2544
(const cmaterial: NewtonMaterial; const cbody0, cbody1: NewtonBody;
2545
threadIndex: Integer): Boolean;
2550
procedure TGLNGDSurfacePair.OnNewtonContactsProcessEvent
2551
(const ccontact: NewtonJoint; timestep: NGDFloat; threadIndex: Integer);
2556
procedure TGLNGDSurfacePair.SetCollidable(const Value: Boolean);
2558
FCollidable := Value;
2559
FManager.RebuildAllMaterial;
2562
procedure TGLNGDSurfacePair.SetContinuousCollisionMode(const Value: Boolean);
2564
FContinuousCollisionMode := Value;
2565
FManager.RebuildAllMaterial;
2568
procedure TGLNGDSurfacePair.SetElasticity(const Value: Single);
2570
if (Value >= 0) then
2571
FElasticity := Value;
2572
FManager.RebuildAllMaterial;
2575
procedure TGLNGDSurfacePair.SetKineticFriction(const Value: Single);
2577
if (Value >= 0) and (Value <= 1) then
2578
FKineticFriction := Value;
2579
FManager.RebuildAllMaterial;
2582
procedure TGLNGDSurfacePair.SetMaterialItems(const item1, item2: TGLNGDSurfaceItem);
2584
FNGDSurfaceItem1 := item1;
2585
FNGDSurfaceItem2 := item2;
2586
FManager.RebuildAllMaterial;
2589
procedure TGLNGDSurfacePair.SetSoftness(const Value: Single);
2591
if (Value >= 0) and (Value <= 1) then
2593
FManager.RebuildAllMaterial;
2596
procedure TGLNGDSurfacePair.SetStaticFriction(const Value: Single);
2598
if (Value >= 0) and (Value <= 1) then
2599
FStaticFriction := Value;
2600
FManager.RebuildAllMaterial;
2603
procedure TGLNGDSurfacePair.SetThickness(const Value: Boolean);
2605
FThickness := Value;
2606
FManager.RebuildAllMaterial;
2609
function TGLNGDSurfacePair.StoredElasticity: Boolean;
2611
Result := not SameValue(FElasticity, 0.4, epsilon);
2614
function TGLNGDSurfacePair.StoredKineticFriction: Boolean;
2616
Result := not SameValue(FKineticFriction, 0.5, epsilon);
2619
function TGLNGDSurfacePair.StoredSoftness: Boolean;
2621
Result := not SameValue(FSoftness, 0.1, epsilon);
2624
function TGLNGDSurfacePair.StoredStaticFriction: Boolean;
2626
Result := not SameValue(FStaticFriction, 0.9, epsilon);
2629
//------------------------
2631
//------------------------
2633
constructor TGLNGDJoint.Create(Collection: TCollection);
2636
FCollisionState := False;
2638
FNewtonJoint := nil;
2639
FNewtonUserJoint := nil;
2640
FParentObject := nil;
2641
FChildObject := nil;
2643
FManager := TGLNGDManager(Collection.Owner);
2645
FBallAndSocketOptions := TGLNGDJointPivot.Create(FManager, self);
2646
FHingeOptions := TGLNGDJointPin.Create(FManager, self);
2647
FSliderOptions := TGLNGDJointPin.Create(FManager, self);
2648
FCorkscrewOptions := TGLNGDJointPin.Create(FManager, self);
2649
FUniversalOptions := TGLNGDJointPin2.Create(FManager, self);
2651
FCustomBallAndSocketOptions := TGLNGDJointBallAndSocket.Create(FManager, self);
2652
FCustomHingeOptions := TGLNGDJointHinge.Create(FManager, self);
2653
FCustomSliderOptions := TGLNGDJointSlider.Create(FManager, self);
2654
FKinematicOptions := TGLNGDJointKinematicController.Create;
2656
FUPVectorDirection := TGLCoordinates.CreateInitialized(self, YHmgVector,
2658
FUPVectorDirection.OnNotifyChange := FManager.RebuildAllJoint;
2661
destructor TGLNGDJoint.Destroy;
2665
FParentObject := nil;
2666
FChildObject := nil;
2669
FBallAndSocketOptions.Free;
2671
FSliderOptions.Free;
2672
FCorkscrewOptions.Free;
2673
FUniversalOptions.Free;
2675
FCustomBallAndSocketOptions.Free;
2676
FCustomHingeOptions.Free;
2677
FCustomSliderOptions.Free;
2678
FKinematicOptions.Free;
2679
FUPVectorDirection.Free;
2683
procedure TGLNGDJoint.DestroyNewtonData;
2685
if FNewtonJoint <> nil then
2687
Assert((FManager <> nil) and (FManager.FNewtonWorld <> nil));
2688
NewtonDestroyJoint(FManager.FNewtonWorld, FNewtonJoint);
2689
FNewtonJoint := nil;
2691
if FNewtonUserJoint <> nil then
2693
// CustomDestroyJoint(FNewtonUserJoint);
2694
FNewtonUserJoint := nil;
2698
procedure TGLNGDJoint.KinematicControllerPick(pickpoint: TVector;
2699
PickedActions: TGLNGDPickedActions);
2701
if FJointType = nj_KinematicController then
2702
if Assigned(FParentObject) then
2704
// Creates the joint
2705
if PickedActions = paAttach then
2707
//if not Assigned(FNewtonUserJoint) then
2708
// if Assigned(GetNGDDynamic(FParentObject).FNewtonBody) then
2709
// FNewtonUserJoint := CreateCustomKinematicController
2710
// (GetNGDDynamic(FParentObject).FNewtonBody, @pickpoint);
2713
// Change the TargetPoint
2714
if (PickedActions = paMove) or (PickedActions = paAttach) then
2716
if Assigned(FNewtonUserJoint) then
2718
//CustomKinematicControllerSetPickMode(FNewtonUserJoint,
2719
// Ord(FKinematicOptions.FPickModeLinear));
2720
//CustomKinematicControllerSetMaxLinearFriction(FNewtonUserJoint,
2721
// FKinematicOptions.FLinearFriction);
2722
//CustomKinematicControllerSetMaxAngularFriction(FNewtonUserJoint,
2723
// FKinematicOptions.FAngularFriction);
2724
//CustomKinematicControllerSetTargetPosit(FNewtonUserJoint, @pickpoint);
2729
if PickedActions = paDetach then
2731
if Assigned(FNewtonUserJoint) then
2733
//CustomDestroyJoint(FNewtonUserJoint);
2734
FNewtonUserJoint := nil;
2735
// Reset autosleep because this joint turns it off
2736
NewtonBodySetAutoSleep(GetNGDDynamic(FParentObject).FNewtonBody,
2737
Ord(GetNGDDynamic(FParentObject).AutoSleep));
2739
ParentObject := nil;
2744
procedure TGLNGDJoint.Render;
2746
procedure DrawPivot(pivot: TVector);
2750
size := FManager.DebugOption.DotAxisSize;
2751
FManager.FCurrentColor := FManager.DebugOption.JointPivotColor;
2752
FManager.AddNode(VectorAdd(pivot, VectorMake(0, 0, size)));
2753
FManager.AddNode(VectorAdd(pivot, VectorMake(0, 0, -size)));
2754
FManager.AddNode(VectorAdd(pivot, VectorMake(0, size, 0)));
2755
FManager.AddNode(VectorAdd(pivot, VectorMake(0, -size, 0)));
2756
FManager.AddNode(VectorAdd(pivot, VectorMake(size, 0, 0)));
2757
FManager.AddNode(VectorAdd(pivot, VectorMake(-size, 0, 0)));
2760
procedure DrawPin(pin, pivot: TVector);
2762
FManager.FCurrentColor := FManager.DebugOption.JointAxisColor;
2763
FManager.AddNode(VectorAdd(pivot, pin));
2764
FManager.AddNode(VectorAdd(pivot, VectorNegate(pin)));
2767
procedure DrawJoint(pivot: TVector);
2769
FManager.FCurrentColor := FManager.DebugOption.CustomColor;
2770
FManager.AddNode(FParentObject.AbsolutePosition);
2771
FManager.AddNode(pivot);
2772
FManager.AddNode(pivot);
2773
FManager.AddNode(FChildObject.AbsolutePosition);
2776
procedure DrawKinematic;
2778
pickedMatrix: TMatrix;
2781
size := FManager.DebugOption.DotAxisSize;
2782
//CustomKinematicControllerGetTargetMatrix(FNewtonUserJoint, @pickedMatrix);
2783
FManager.FCurrentColor := FManager.DebugOption.JointAxisColor;
2785
FManager.AddNode(FParentObject.AbsolutePosition);
2786
FManager.AddNode(pickedMatrix.W);
2788
FManager.FCurrentColor := FManager.DebugOption.JointPivotColor;
2789
FManager.AddNode(VectorAdd(pickedMatrix.W, VectorMake(0, 0, size)));
2790
FManager.AddNode(VectorAdd(pickedMatrix.W, VectorMake(0, 0, -size)));
2791
FManager.AddNode(VectorAdd(pickedMatrix.W, VectorMake(0, size, 0)));
2792
FManager.AddNode(VectorAdd(pickedMatrix.W, VectorMake(0, -size, 0)));
2793
FManager.AddNode(VectorAdd(pickedMatrix.W, VectorMake(size, 0, 0)));
2794
FManager.AddNode(VectorAdd(pickedMatrix.W, VectorMake(-size, 0, 0)));
2802
if Assigned(FParentObject) and Assigned(FChildObject) then
2804
DrawJoint(FBallAndSocketOptions.FPivotPoint.AsVector);
2805
DrawPivot(FBallAndSocketOptions.FPivotPoint.AsVector);
2809
if Assigned(FParentObject) and Assigned(FChildObject) then
2811
DrawJoint(FHingeOptions.FPivotPoint.AsVector);
2812
DrawPin(FHingeOptions.FPinDirection.AsVector,
2813
FHingeOptions.FPivotPoint.AsVector);
2814
DrawPivot(FHingeOptions.FPivotPoint.AsVector);
2818
if Assigned(FParentObject) and Assigned(FChildObject) then
2820
DrawJoint(FSliderOptions.FPivotPoint.AsVector);
2821
DrawPin(FSliderOptions.FPinDirection.AsVector,
2822
FSliderOptions.FPivotPoint.AsVector);
2823
DrawPivot(FSliderOptions.FPivotPoint.AsVector);
2827
if Assigned(FParentObject) and Assigned(FChildObject) then
2829
DrawJoint(FCorkscrewOptions.FPivotPoint.AsVector);
2830
DrawPin(FCorkscrewOptions.FPinDirection.AsVector,
2831
FCorkscrewOptions.FPivotPoint.AsVector);
2832
DrawPivot(FCorkscrewOptions.FPivotPoint.AsVector);
2836
if Assigned(FParentObject) and Assigned(FChildObject) then
2838
DrawJoint(FUniversalOptions.FPivotPoint.AsVector);
2839
DrawPin(FUniversalOptions.FPinDirection.AsVector,
2840
FUniversalOptions.FPivotPoint.AsVector);
2841
DrawPin(FUniversalOptions.FPinDirection2.AsVector,
2842
FUniversalOptions.FPivotPoint.AsVector);
2843
DrawPivot(FUniversalOptions.FPivotPoint.AsVector);
2846
nj_CustomBallAndSocket:
2847
if Assigned(FParentObject) and Assigned(FChildObject) then
2849
DrawJoint(FCustomBallAndSocketOptions.FPivotPoint.AsVector);
2850
DrawPivot(FCustomBallAndSocketOptions.FPivotPoint.AsVector);
2854
if Assigned(FParentObject) and Assigned(FChildObject) then
2856
DrawJoint(FCustomHingeOptions.FPivotPoint.AsVector);
2857
DrawPin(FCustomHingeOptions.FPinDirection.AsVector,
2858
FCustomHingeOptions.FPivotPoint.AsVector);
2859
DrawPivot(FCustomHingeOptions.FPivotPoint.AsVector);
2863
if Assigned(FParentObject) and Assigned(FChildObject) then
2865
DrawJoint(FCustomSliderOptions.FPivotPoint.AsVector);
2866
DrawPin(FCustomSliderOptions.FPinDirection.AsVector,
2867
FCustomSliderOptions.FPivotPoint.AsVector);
2868
DrawPivot(FCustomSliderOptions.FPivotPoint.AsVector);
2872
if Assigned(FParentObject) then
2874
FManager.FCurrentColor := FManager.DebugOption.JointAxisColor;
2875
FManager.AddNode(FParentObject.AbsolutePosition);
2876
FManager.AddNode(VectorAdd(FParentObject.AbsolutePosition,
2877
FUPVectorDirection.AsVector));
2880
nj_KinematicController:
2881
if Assigned(FParentObject) and Assigned(FNewtonUserJoint) then
2889
procedure TGLNGDJoint.SetChildObject(const Value: TGLBaseSceneObject);
2891
FChildObject := Value;
2892
FManager.RebuildAllJoint(self);
2895
procedure TGLNGDJoint.SetCollisionState(const Value: Boolean);
2897
FCollisionState := Value;
2898
FManager.RebuildAllJoint(self);
2901
procedure TGLNGDJoint.SetJointType(const Value: TGLNGDJoints);
2903
FJointType := Value;
2904
FManager.RebuildAllJoint(self);
2907
procedure TGLNGDJoint.SetParentObject(const Value: TGLBaseSceneObject);
2909
FParentObject := Value;
2910
FManager.RebuildAllJoint(self);
2913
procedure TGLNGDJoint.SetStiffness(const Value: Single);
2915
if (Value >= 0) and (Value <= 1) then
2917
FStiffness := Value;
2918
FManager.RebuildAllJoint(self);
2922
function TGLNGDJoint.StoredStiffness: Boolean;
2924
Result := not SameValue(FStiffness, 0.9, epsilon);
2927
//------------------------
2929
//------------------------
2931
constructor TGLNGDJointPivot.Create(AOwner: TComponent; aOuter: TGLNGDJoint);
2933
FManager := AOwner as TGLNGDManager;
2935
FPivotPoint := TGLCoordinates.CreateInitialized(aOuter, NullHMGPoint,
2937
FPivotPoint.OnNotifyChange := FManager.RebuildAllJoint;
2940
destructor TGLNGDJointPivot.Destroy;
2946
{ TGLNGDJoint.TGLNGDJointPin }2948
constructor TGLNGDJointPin.Create(AOwner: TComponent; aOuter: TGLNGDJoint);
2951
FPinDirection := TGLCoordinates.CreateInitialized(aOuter, NullHmgVector,
2953
FPinDirection.OnNotifyChange := FManager.RebuildAllJoint;
2956
destructor TGLNGDJointPin.Destroy;
2962
//------------------------
2964
//------------------------
2966
constructor TGLNGDJointPin2.Create(AOwner: TComponent; aOuter: TGLNGDJoint);
2969
FPinDirection2 := TGLCoordinates.CreateInitialized(aOuter, NullHmgVector,
2971
FPinDirection2.OnNotifyChange := FManager.RebuildAllJoint;
2974
destructor TGLNGDJointPin2.Destroy;
2976
FPinDirection2.Free;
2980
//------------------------
2981
{ TGLNGDJointBallAndSocket }2982
//------------------------
2984
constructor TGLNGDJointBallAndSocket.Create(AOwner: TComponent;
2985
aOuter: TGLNGDJoint);
2989
FMinTwistAngle := -90;
2990
FMaxTwistAngle := 90;
2993
procedure TGLNGDJointBallAndSocket.SetConeAngle(const Value: Single);
2995
FConeAngle := Value;
2996
FManager.RebuildAllJoint(FOuter);
2999
procedure TGLNGDJointBallAndSocket.SetMaxTwistAngle(const Value: Single);
3001
FMaxTwistAngle := Value;
3002
FManager.RebuildAllJoint(FOuter);
3005
procedure TGLNGDJointBallAndSocket.SetMinTwistAngle(const Value: Single);
3007
FMinTwistAngle := Value;
3008
FManager.RebuildAllJoint(FOuter);
3011
function TGLNGDJointBallAndSocket.StoredConeAngle: Boolean;
3013
Result := not SameValue(FConeAngle, 90, epsilon);
3016
function TGLNGDJointBallAndSocket.StoredMaxTwistAngle: Boolean;
3018
Result := not SameValue(FMaxTwistAngle, 90, epsilon);
3021
function TGLNGDJointBallAndSocket.StoredMinTwistAngle: Boolean;
3023
Result := not SameValue(FMinTwistAngle, -90, epsilon);
3026
//------------------------
3028
//------------------------
3030
constructor TGLNGDJointHinge.Create(AOwner: TComponent; aOuter: TGLNGDJoint);
3037
procedure TGLNGDJointHinge.SetMaxAngle(const Value: Single);
3040
FManager.RebuildAllJoint(FOuter);
3043
procedure TGLNGDJointHinge.SetMinAngle(const Value: Single);
3046
FManager.RebuildAllJoint(FOuter);
3049
function TGLNGDJointHinge.StoredMaxAngle: Boolean;
3051
Result := not SameValue(FMaxAngle, 90, epsilon);
3054
function TGLNGDJointHinge.StoredMinAngle: Boolean;
3056
Result := not SameValue(FMinAngle, -90, epsilon);
3059
//------------------------
3060
{ TGLNGDJointSlider }3061
//------------------------
3063
constructor TGLNGDJointSlider.Create(AOwner: TComponent; aOuter: TGLNGDJoint);
3066
FMinDistance := -10;
3071
procedure TGLNGDJointSlider.SetMaxDistance(const Value: Single);
3073
FMaxDistance := Value;
3074
FManager.RebuildAllJoint(FOuter);
3077
procedure TGLNGDJointSlider.SetMinDistance(const Value: Single);
3079
FMinDistance := Value;
3080
FManager.RebuildAllJoint(FOuter);
3084
function TGLNGDJointSlider.StoredMaxDistance: Boolean;
3086
Result := not SameValue(FMaxDistance, 10, epsilon);
3089
function TGLNGDJointSlider.StoredMinDistance: Boolean;
3091
Result := not SameValue(FMinDistance, -10, epsilon);
3094
{ TGLNGDJoint.TGLNGDJointKinematicController }3096
constructor TGLNGDJointKinematicController.Create;
3098
FPickModeLinear := False;
3099
FLinearFriction := 750;
3100
FAngularFriction := 250;
3103
function TGLNGDJointKinematicController.StoredAngularFriction: Boolean;
3105
Result := not SameValue(FAngularFriction, 250, epsilon);
3108
function TGLNGDJointKinematicController.StoredLinearFriction: Boolean;
3110
Result := not SameValue(FLinearFriction, 750, epsilon);
3113
//------------------------
3114
{ TGLNGDBehaviourList }3115
//------------------------
3117
function TGLNGDBehaviourList.GetBehav(index: Integer): TGLNGDBehaviour;
3119
Result := Items[index];
3122
procedure TGLNGDBehaviourList.PutBehav(index: Integer; Item: TGLNGDBehaviour);
3124
inherited put(index, Item);
3127
// ------------------------------------------------------------------
3129
// ------------------------------------------------------------------
3131
RegisterXCollectionItemClass(TGLNGDDynamic);
3132
RegisterXCollectionItemClass(TGLNGDStatic);
3134
// ------------------------------------------------------------------
3136
// ------------------------------------------------------------------
3138
UnregisterXCollectionItemClass(TGLNGDDynamic);
3139
UnregisterXCollectionItemClass(TGLNGDStatic);