LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   Skeleton colliders for defining and controlling verlet
6
   constraints.
7

8
    History : 
9
      11/12/03 - SG - Now uses AddToVerletWorld to build the constraints.
10
      08/10/03 - SG - Creation.
11
    
12
}
13
unit GLVerletSkeletonColliders;
14

15
interface
16

17
uses
18
  Classes,
19
   
20
  GLPersistentClasses, GLVectorGeometry, GLVectorFileObjects, GLVerletTypes,
21
  GLVectorTypes;
22

23
type
24
  
25
  // TSCVerletBase
26
  //
27
  { Base verlet skeleton collider class. }
28
  TSCVerletBase = class(TGLSkeletonCollider)
29
    private
30
      FVerletConstraint : TVerletConstraint;
31

32
    public
33
      procedure WriteToFiler(writer : TVirtualWriter); override;
34
      procedure ReadFromFiler(reader : TVirtualReader); override;
35
      procedure AddToVerletWorld(VerletWorld : TGLVerletWorld); virtual;
36

37
      { The verlet constraint is created through the AddToVerletWorld
38
         procedure. }
39
      property VerletConstraint : TVerletConstraint read FVerletConstraint;
40
  end;
41

42
  // TSCVerletSphere
43
  //
44
  { Sphere shaped verlet constraint in a skeleton collider. }
45
  TSCVerletSphere = class(TSCVerletBase)
46
    private
47
      FRadius : Single;
48

49
    protected
50
      procedure SetRadius(const val : Single);
51

52
    public
53
      constructor Create; override;
54
      procedure WriteToFiler(writer : TVirtualWriter); override;
55
      procedure ReadFromFiler(reader : TVirtualReader); override;
56
      procedure AddToVerletWorld(VerletWorld : TGLVerletWorld); override;
57
      procedure AlignCollider; override;
58

59
      property Radius : Single read FRadius write SetRadius;
60
  end;
61

62
  // TSCVerletCapsule
63
  //
64
  { Capsule shaped verlet constraint in a skeleton collider. }
65
  TSCVerletCapsule = class(TSCVerletBase)
66
    private
67
      FRadius,
68
      FLength : Single;
69

70
    protected
71
      procedure SetRadius(const val : Single);
72
      procedure SetLength(const val : Single);
73

74
    public
75
      constructor Create; override;
76
      procedure WriteToFiler(writer : TVirtualWriter); override;
77
      procedure ReadFromFiler(reader : TVirtualReader); override;
78
      procedure AddToVerletWorld(VerletWorld : TGLVerletWorld); override;
79
      procedure AlignCollider; override;
80

81
      property Radius : Single read FRadius write SetRadius;
82
      property Length : Single read FLength write SetLength;
83
  end;
84

85
{ After loading call this function to add all the constraints in a
86
   skeleton collider list to a given verlet world. }
87
procedure AddSCVerletConstriantsToVerletWorld(
88
  colliders : TGLSkeletonColliderList; world : TGLVerletWorld);
89

90
// ------------------------------------------------------------------
91
// ------------------------------------------------------------------
92
// ------------------------------------------------------------------
93
implementation
94
// ------------------------------------------------------------------
95
// ------------------------------------------------------------------
96
// ------------------------------------------------------------------
97
// ------------------
98
// ------------------ Global methods ------------------
99
// ------------------
100

101
// AddSCVerletConstriantsToVerletWorld
102
//
103
procedure AddSCVerletConstriantsToVerletWorld(
104
  colliders : TGLSkeletonColliderList; world : TGLVerletWorld);
105
var
106
  i : Integer;
107
begin
108
  for i:=0 to colliders.Count-1 do
109
    if colliders[i] is TSCVerletBase then
110
      TSCVerletBase(colliders[i]).AddToVerletWorld(world);
111
end;
112

113
// ------------------
114
// ------------------ TSCVerletBase ------------------
115
// ------------------
116

117
// WriteToFiler
118
//
119
procedure TSCVerletBase.WriteToFiler(writer : TVirtualWriter);
120
begin
121
  inherited WriteToFiler(writer);
122
  with writer do begin
123
    WriteInteger(0); // Archive Version 0
124
  end;
125
end;
126

127
// ReadFromFiler
128
//
129
procedure TSCVerletBase.ReadFromFiler(reader : TVirtualReader);
130
var
131
  archiveVersion : integer;
132
begin
133
  inherited ReadFromFiler(reader);
134
  archiveVersion:=reader.ReadInteger;
135
  if archiveVersion=0 then with reader do
136
    // Nothing yet
137
  else RaiseFilerException(archiveVersion);
138
end;
139

140
// AddToVerletWorld
141
//
142
procedure TSCVerletBase.AddToVerletWorld(VerletWorld : TGLVerletWorld);
143
begin
144
  AlignCollider;
145
end;
146

147

148
// ------------------
149
// ------------------ TSCVerletSphere ------------------
150
// ------------------
151

152
// Create
153
//
154
constructor TSCVerletSphere.Create;
155
begin
156
  inherited;
157
  Radius:=0.5;
158
  AlignCollider;
159
end;
160

161
// WriteToFiler
162
//
163
procedure TSCVerletSphere.WriteToFiler(writer : TVirtualWriter);
164
begin
165
  inherited WriteToFiler(writer);
166
  with writer do begin
167
    WriteInteger(0); // Archive Version 0
168
    WriteFloat(FRadius);
169
  end;
170
end;
171

172
// ReadFromFiler
173
//
174
procedure TSCVerletSphere.ReadFromFiler(reader : TVirtualReader);
175
var
176
  archiveVersion : integer;
177
begin
178
  inherited ReadFromFiler(reader);
179
  archiveVersion:=reader.ReadInteger;
180
  if archiveVersion=0 then with reader do
181
    Radius:=ReadFloat
182
  else RaiseFilerException(archiveVersion);
183
end;
184

185
// AddToVerletWorld
186
//
187
procedure TSCVerletSphere.AddToVerletWorld(VerletWorld : TGLVerletWorld);
188
begin
189
  FVerletConstraint:=TVCSphere.Create(VerletWorld);
190
  TVCSphere(FVerletConstraint).Radius:=FRadius;
191
  inherited;
192
end;
193

194
// AlignCollider
195
//
196
procedure TSCVerletSphere.AlignCollider;
197
begin
198
  inherited;
199
  if Assigned(FVerletConstraint) then
200
    TVCSphere(FVerletConstraint).Location:=AffineVectorMake(GlobalMatrix.V[3]);
201
end;
202

203
// SetRadius
204
//
205
procedure TSCVerletSphere.SetRadius(const val : Single);
206
begin
207
  if val<>FRadius then begin
208
    FRadius:=val;
209
    if Assigned(FVerletConstraint) then
210
      TVCSphere(FVerletConstraint).Radius:=FRadius;
211
  end;
212
end;
213

214

215
// ------------------
216
// ------------------ TSCVerletCapsule ------------------
217
// ------------------
218

219
// Create
220
//
221
constructor TSCVerletCapsule.Create;
222
begin
223
  inherited;
224
  Radius:=0.5;
225
  Length:=1;
226
  AlignCollider;
227
end;
228

229
// WriteToFiler
230
//
231
procedure TSCVerletCapsule.WriteToFiler(writer : TVirtualWriter);
232
begin
233
  inherited WriteToFiler(writer);
234
  with writer do begin
235
    WriteInteger(0); // Archive Version 0
236
    WriteFloat(FRadius);
237
    WriteFloat(FLength);
238
  end;
239
end;
240

241
// ReadFromFiler
242
//
243
procedure TSCVerletCapsule.ReadFromFiler(reader : TVirtualReader);
244
var
245
  archiveVersion : integer;
246
begin
247
  inherited ReadFromFiler(reader);
248
  archiveVersion:=reader.ReadInteger;
249
  if archiveVersion=0 then with reader do begin
250
    Radius:=ReadFloat;
251
    Length:=ReadFloat;
252
  end else RaiseFilerException(archiveVersion);
253
end;
254

255
// AddToVerletWorld
256
//
257
procedure TSCVerletCapsule.AddToVerletWorld(VerletWorld : TGLVerletWorld);
258
begin
259
  FVerletConstraint:=TVCCapsule.Create(VerletWorld);
260
  TVCCapsule(FVerletConstraint).Radius:=FRadius;
261
  TVCCapsule(FVerletConstraint).Length:=FLength;
262
  inherited;
263
end;
264

265
// AlignCollider
266
//
267
procedure TSCVerletCapsule.AlignCollider;
268
begin
269
  inherited;
270
  if Assigned(FVerletConstraint) then begin
271
    TVCCapsule(FVerletConstraint).Location:=AffineVectorMake(GlobalMatrix.V[3]);
272
    TVCCapsule(FVerletConstraint).Axis:=AffineVectorMake(GlobalMatrix.V[1]);
273
  end;
274
end;
275

276
// SetRadius
277
//
278
procedure TSCVerletCapsule.SetRadius(const val : Single);
279
begin
280
  if val<>FRadius then begin
281
    FRadius:=val;
282
    if Assigned(FVerletConstraint) then
283
      TVCCapsule(FVerletConstraint).Radius:=FRadius;
284
  end;
285
end;
286

287
// SetLength
288
//
289
procedure TSCVerletCapsule.SetLength(const val : Single);
290
begin
291
  if val<>FLength then begin
292
    FLength:=val;
293
    if Assigned(FVerletConstraint) then
294
      TVCCapsule(FVerletConstraint).Length:=FLength;
295
  end;
296
end;
297

298
// ------------------------------------------------------------------
299
// ------------------------------------------------------------------
300
// ------------------------------------------------------------------
301
initialization
302
// ------------------------------------------------------------------
303
// ------------------------------------------------------------------
304
// ------------------------------------------------------------------
305

306
  RegisterClasses([TSCVerletBase,TSCVerletSphere,TSCVerletCapsule]);
307

308
end.
309