LZScene

1
unit GLForceFields;
2

3
interface
4

5
uses
6
  Classes,
7
  GLVectorGeometry,
8
  GLXCollection,
9
  GLScene,
10
  GLCoordinates,
11
  GLBehaviours,
12
  GLInertias,
13
  GLPhysics
14
  { GLRigidBodyInertia};
15

16
type
17

18
TGLUniformGravityEmitter = class(TGLBaseForceFieldEmitter)
19
private
20
  fGravity:TGLCoordinates;
21
protected
22
  procedure SetGravity(const val : TGLCoordinates);
23
public
24
  constructor Create(aOwner : TGLXCollection); override;
25
  destructor Destroy;override;
26
  procedure Assign(Source: TPersistent); override;
27
  procedure WriteToFiler(writer : TWriter); override;
28
  procedure ReadFromFiler(reader : TReader); override;
29
  class function FriendlyName : String; override;
30
  class function FriendlyDescription : String; override;
31
  class function UniqueItem : Boolean; override;
32
  function CalculateForceField(Body:TGLBaseSceneObject):TAffineVector;override;
33
published
34
  property Gravity:TGLCoordinates read fGravity write SetGravity;
35
end;
36

37
TGLRadialGravityEmitter = class(TGLBaseForceFieldEmitter)
38
private
39
  fMass:Real;
40
  fMassOverG:Real;
41
public
42
  constructor Create(aOwner : TGLXCollection); override;
43
  destructor Destroy;override;
44
  procedure Assign(Source: TPersistent); override;
45
  procedure WriteToFiler(writer : TWriter); override;
46
  procedure ReadFromFiler(reader : TReader); override;
47
  class function FriendlyName : String; override;
48
  class function FriendlyDescription : String; override;
49
  class function UniqueItem : Boolean; override;
50
  function CalculateForceField(Body:TGLBaseSceneObject):TAffineVector;override;
51
published
52
  property Mass:Real read fMass write fMass;
53
end;
54

55
TGLDampingFieldEmitter = class(TGLBaseForceFieldEmitter)
56
private
57
  fDamping:TGLDamping;
58
protected
59
  procedure SetDamping(const val: TGLDamping);
60
public
61
  constructor Create(aOwner : TGLXCollection); override;
62
  destructor Destroy;override;
63
  procedure Assign(Source: TPersistent); override;
64
  procedure WriteToFiler(writer : TWriter); override;
65
  procedure ReadFromFiler(reader : TReader); override;
66
  class function FriendlyName : String; override;
67
  class function FriendlyDescription : String; override;
68
  class function UniqueItem : Boolean; override;
69
  function CalculateForceField(Body:TGLBaseSceneObject):TAffineVector;override;
70
published
71
  property Damping:TGLDamping read fDamping write SetDamping;
72
end;
73

74
const GravitationalConstant=6.6726E-11;
75

76
//==================================================================
77
implementation
78
//==================================================================
79

80
//-------------------------------------
81
//---- TGLUniformGravityEmitter
82
//-------------------------------------
83
constructor TGLUniformGravityEmitter.Create(aOwner : TGLXCollection);
84
begin
85
  inherited Create(aOwner);
86
  fGravity:=TGLCoordinates.CreateInitialized(Self,nullHmgVector,csVector);
87
end;
88

89
destructor TGLUniformGravityEmitter.Destroy;
90
begin
91
  fGravity.Free;
92
  inherited Destroy;
93
end;
94

95
procedure TGLUniformGravityEmitter.Assign(Source: TPersistent);
96
begin
97
  if Source.ClassType=Self.ClassType then begin
98
  fGravity := TGLUniformGravityEmitter(Source).fGravity;
99
  end;
100
end;
101

102
class function TGLUniformGravityEmitter.FriendlyName : String;
103
begin
104
  Result := 'Uniform Gravity';
105
end;
106

107
class function TGLUniformGravityEmitter.FriendlyDescription : String;
108
begin
109
  Result := 'Uniform Gravity, appropriate near surface of planet';
110
end;
111

112
class function TGLUniformGravityEmitter.UniqueItem : Boolean;
113
begin
114
  Result:=false;
115
end;
116

117
procedure TGLUniformGravityEmitter.WriteToFiler(writer : TWriter);
118
begin
119
  inherited;
120
  with Writer do
121
  begin
122
    fGravity.WriteToFiler(writer);
123
  end;
124
end;
125

126
procedure TGLUniformGravityEmitter.ReadFromFiler(reader : TReader);
127
begin
128
  inherited;
129
  with Reader do
130
  begin
131
    fGravity.ReadFromFiler(reader);
132
  end;
133
end;
134

135
procedure TGLUniformGravityEmitter.SetGravity(const val : TGLCoordinates);
136
begin
137
  fGravity.Assign(val);
138
end;
139

140
//  CalculateForceField  (TODO: ParticleInertia -> BaseInertia, add BaseInertia.ApplyAcceleration)
141
function TGLUniformGravityEmitter.CalculateForceField(Body:TGLBaseSceneObject):TAffineVector;
142
var
143
  inertia1:TGLParticleInertia;
144
begin
145
  Inertia1:=TGLParticleInertia(Body.Behaviours.GetByClass(TGLParticleInertia));
146
  if Assigned(inertia1) then
147
  begin
148
    Result:=VectorScale(fGravity.AsAffineVector,Inertia1.Mass);
149
    inertia1.ApplyForce(Result);
150
  end
151
  else
152
    Result:=nullVector;
153
end;
154

155
//------------------------------------------------------------------------------
156
//------------------------------Radial Gravity Emitter -------------------------
157
//------------------------------------------------------------------------------
158

159
constructor TGLRadialGravityEmitter.Create(aOwner : TGLXCollection);
160
begin
161
  inherited Create(aOwner);
162
end;
163

164
destructor TGLRadialGravityEmitter.Destroy;
165
begin
166
  inherited Destroy;
167
end;
168

169
procedure TGLRadialGravityEmitter.Assign(Source: TPersistent);
170
begin
171
  if Source.ClassType=Self.ClassType then
172
  begin
173
    fMass:=TGLRadialGravityEmitter(Source).fMass;
174
  end;
175
end;
176

177
class function TGLRadialGravityEmitter.FriendlyName : String;
178
begin
179
  Result:='Radial Gravity';
180
end;
181

182
class function TGLRadialGravityEmitter.FriendlyDescription : String;
183
begin
184
  Result:='Radial Gravity, can be applied anywhere (use for planets)';
185
end;
186

187
class function TGLRadialGravityEmitter.UniqueItem : Boolean;
188
begin
189
  Result:=false;
190
end;
191

192
procedure TGLRadialGravityEmitter.WriteToFiler(writer : TWriter);
193
begin
194
  inherited;
195
  with Writer do
196
  begin
197
    WriteFloat(fMass);
198
  end;
199
end;
200

201
procedure TGLRadialGravityEmitter.ReadFromFiler(reader : TReader);
202
begin
203
  inherited;
204
  with Reader do
205
  begin
206
    fMass:=ReadFloat();;
207
  end;
208
end;
209

210
//  CalculateForceField (TODO: ParticleInertia -> BaseInertia if possible)
211
function TGLRadialGravityEmitter.CalculateForceField(Body:TGLBaseSceneObject):TAffineVector;
212
var
213
  inertia1:TGLParticleInertia;
214
  R:TAffineVector;
215
  L:Real;
216
begin
217
  Inertia1:=TGLParticleInertia(Body.Behaviours.GetByClass(TGLParticleInertia));
218
  if Assigned(inertia1) then
219
  begin
220
    R:=VectorSubtract(Body.Position.AsAffineVector,Self.OwnerBaseSceneObject.Position.AsAffineVector);
221
    L:=VectorLength(R);
222
    Result:=VectorScale(R,-GravitationalConstant*(fMass/L));
223
    inertia1.ApplyForce(Result);
224
  end
225
  else
226
    Result:=nullvector;
227
end;
228

229
//-----------------------------------------------------------------------------
230
//------------------------------Damping Field Emitter -------------------------
231
//-----------------------------------------------------------------------------
232

233
constructor TGLDampingFieldEmitter.Create(aOwner : TGLXCollection);
234
begin
235
  inherited Create(aOwner);
236
  fDamping:=TGLDamping.Create(Self);
237
end;
238

239
destructor TGLDampingFieldEmitter.Destroy;
240
begin
241
  fDamping.Free;
242
  inherited Destroy;
243
end;
244

245
procedure TGLDampingFieldEmitter.Assign(Source: TPersistent);
246
begin
247
  if Source.ClassType=Self.ClassType then
248
  begin
249
    fDamping:=TGLDampingFieldEmitter(Source).fDamping;
250
  end;
251
end;
252

253
class function TGLDampingFieldEmitter.FriendlyName : String;
254
begin
255
  Result := 'Damping Field';
256
end;
257

258
class function TGLDampingFieldEmitter.FriendlyDescription : String;
259
begin
260
  Result := 'Damping Field, to approximate air/fluid resistance';
261
end;
262

263
class function TGLDampingFieldEmitter.UniqueItem : Boolean;
264
begin
265
  Result := false;
266
end;
267

268
procedure TGLDampingFieldEmitter.WriteToFiler(writer : TWriter);
269
begin
270
  inherited;
271
  with Writer do
272
  begin
273
    fDamping.WriteToFiler(writer);
274
  end;
275
end;
276

277
procedure TGLDampingFieldEmitter.ReadFromFiler(reader : TReader);
278
begin
279
  inherited;
280
  with Reader do
281
  begin
282
    fDamping.ReadFromFiler(reader);
283
  end;
284
end;
285

286
procedure TGLDampingFieldEmitter.SetDamping(const val : TGLDamping);
287
begin
288
  fDamping.Assign(val);
289
end;
290

291
//  CalculateForceField (TODO: ParticleInertia -> BaseInertia, BaseInertia.ApplyDamping?)
292
function TGLDampingFieldEmitter.CalculateForceField(Body:TGLBaseSceneObject):TAffineVector;
293
var
294
  inertia1:TGLParticleInertia;
295
   velocity:TAffineVector;
296
   v:Single; //Real;
297
begin
298
  Inertia1:=TGLParticleInertia(Body.Behaviours.GetByClass(TGLParticleInertia));
299
  if Assigned(inertia1) then
300
    Inertia1.ApplyDamping(Damping);
301

302
//-- Commenting ????
303
  Inertia1:=TGLParticleInertia(Body.Behaviours.GetByClass(TGLParticleInertia));
304
  if Assigned(inertia1) then
305
  begin
306
    velocity:=VectorScale(inertia1.LinearMomentum, 1/Inertia1.Mass); // v = p/m
307
    //apply force in opposite direction to velocity
308
    v:=VectorLength(velocity);
309
    //  F = -Normalised(V)*( Constant + (Linear)*(V) + (Quadtratic)*(V)*(V) )
310
    Result:=VectorScale(VectorNormalize(velocity),-(fDamping.Constant+fDamping.Linear*v+fDamping.Quadratic*v*v));
311
    inertia1.ApplyForce(Result);
312
  end
313
  else
314
    Result:=nullvector;
315
//---
316
end;
317

318
//-------------------------------------------------------------------------
319
initialization
320
//-------------------------------------------------------------------------
321

322
  RegisterXCollectionItemClass(TGLUniformGravityEmitter);
323
  RegisterXCollectionItemClass(TGLRadialGravityEmitter);
324
  RegisterXCollectionItemClass(TGLDampingFieldEmitter);
325
end.
326