LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   Methods for turning a TGLBaseMesh into a Verlet cloth / jelly
6

7
	 History :  
8
       16/09/10 - YP - Created public NodeList property of TFaceExtractor, it allow us to nail some vertex
9
       23/08/10 - Yar - Added OpenGLTokens to uses, replaced OpenGL1x functions to OpenGLAdapter
10
       06/06/10 - Yar - Fixed warnings
11
       05/03/10 - DanB - More state added to TGLStateCache
12
       22/02/10 - Yar - Optimization of switching states
13
       30/03/07 - DaStr - Added $I GLScene.inc
14
       28/03/07 - DaStr - Added explicit pointer dereferencing (even more)
15
       16/03/07 - DaStr - Added explicit pointer dereferencing
16
                             (thanks Burkhard Carstens) (Bugtracker ID = 1678644)
17
       27/05/04 - MF - Added some length information to edges
18
       24/06/03 - MF - Removed several embarrassing warnings
19
       17/06/03 - MF - Creation
20
    
21
}
22

23
unit GLVerletClothify;
24

25
interface
26

27
{$I GLScene.inc}
28

29
uses
30
  Classes, SysUtils,
31
   
32
  GLVectorFileObjects, GLVerletTypes, GLVectorTypes, GLVectorLists,
33
  GLVectorGeometry, GLTexture, OpenGLTokens, GLRenderContextInfo,
34
  GLState, GLContext;
35

36

37
type
38
  { Class that represents a face. This structure is not used for rendering, but
39
  for extracting info from meshes }
40
  TFace = class
41
  public
42
    Vertices : array[0..2] of integer;
43
    Normal : TAffineVector;
44
    MeshObject : TGLMeshObject;
45
    Active : boolean;
46

47
    procedure UpdateNormal;
48

49
    constructor Create(aMeshObject : TGLMeshObject);
50
  end;
51

52
  { List of faces }
53
  TFaceList = class(TList)
54
  private
55
    function GetItems(i: integer): TFace;
56
    procedure SetItems(i: integer; const Value: TFace);
57
  public
58
    property Items[i : integer] : TFace read GetItems write SetItems; default;
59
  end;
60

61
  { Class that extracts faces from a GLBaseMesh}
62
  TFaceExtractor = class
63
  private
64
    FFaceList : TFaceList;
65
    FGLBaseMesh : TGLBaseMesh;
66
    FNodeList : TVerletNodeList;
67
    FWeldDistance: single;
68
    FEdgeDoublesSkipped : integer;
69

70
    procedure SetWeldDistance(const Value: single);
71
  protected
72
    procedure ProcessMeshObject(const MeshObject : TGLMeshObject); virtual;
73
  public
74
    procedure ExtractFacesFromVertexIndexList(
75
      const FaceGroup : TFGVertexIndexList; const MeshObject : TGLMeshObject);
76

77
    property FaceList : TFaceList read FFaceList;
78

79
    procedure Clear; virtual;
80
    procedure ProcessMesh; virtual;
81

82
    property WeldDistance : single read FWeldDistance write SetWeldDistance;
83
    property EdgeDoublesSkipped : integer read FEdgeDoublesSkipped;
84

85
    property GLBaseMesh : TGLBaseMesh read FGLBaseMesh;
86

87
    property NodeList : TVerletNodeList read FNodeList;
88

89
    function AddFace(const Vi0, Vi1, Vi2 : integer; const MeshObject : TGLMeshObject) : TFace; virtual;
90

91
    constructor Create(const aGLBaseMesh : TGLBaseMesh); virtual;
92
    destructor Destroy; override;
93
  end;
94

95
  // ************ EDGE DETECTOR
96

97
  TEdgeDetector = class;
98
  TEdge = class
99
  private
100
    FSolid: boolean;
101
    FLength: single;
102
    FMeshObject: TGLMeshObject;
103
    FOwner: TEdgeDetector;
104
  public
105
    Vertices : array[0..1] of integer;
106
    Faces : array[0..1] of TFace;
107

108
    procedure Contract;
109

110
    property Owner : TEdgeDetector read FOwner;
111
    property MeshObject : TGLMeshObject read FMeshObject write FMeshObject;
112
    property Length : single read FLength write FLength;
113
    property Solid : boolean read FSolid write FSolid;
114

115
    procedure UpdateEdgeLength;
116

117
    constructor Create(const AOwner: TEdgeDetector; AVi0, AVi1 : integer;
118
      AFace0, AFace1 : TFace; AMeshObject : TGLMeshObject; ASolid : boolean);
119
  end;
120

121
  TEdgeList = class(TList)
122
  private
123
    function GetItems(i: integer): TEdge;
124
    procedure SetItems(i: integer; const Value: TEdge);
125
  public
126
    property Items[i : integer] : TEdge read GetItems write SetItems; default;
127

128
    procedure SortByLength;
129
    function InsertSorted(AEdge : TEdge) : integer;
130
  end;
131

132
  TEdgeDetector = class(TFaceExtractor)
133
  private
134
    FEdgeList : TEdgeList;
135
    FCurrentNodeOffset : integer;
136
    FNodesAdded : boolean;
137

138
    procedure BuildOpposingEdges;
139
  protected
140
    FCalcEdgeLength : boolean;
141
  public
142
    property EdgeList : TEdgeList read FEdgeList;
143

144
    procedure Clear; override;
145
    procedure ProcessMesh; override;
146

147
    function AddEdge(const Vi0, Vi1 : integer; const Face : TFace; const AMeshObject : TGLMeshObject) : TEdge;
148
    function AddFace(const Vi0, Vi1, Vi2 : integer; const MeshObject : TGLMeshObject) : TFace; override;
149
    function AddNode(const VerletWorld : TGLVerletWorld; const MeshObject : TGLMeshObject; const VertexIndex : integer) : TVerletNode; virtual;
150

151
    procedure AddNodes(const VerletWorld : TGLVerletWorld);
152
    procedure AddEdgesAsSticks(const VerletWorld : TGLVerletWorld; const Slack : single);
153
    procedure AddEdgesAsSprings(const VerletWorld : TGLVerletWorld; const Strength, Damping, Slack : single);
154
    procedure AddEdgesAsSolidEdges(const VerletWorld : TGLVerletWorld);
155
    procedure AddOuterEdgesAsSolidEdges(const VerletWorld : TGLVerletWorld);
156

157
    procedure RenderEdges(var rci : TGLRenderContextInfo);
158

159
    property CurrentNodeOffset : integer read FCurrentNodeOffset;
160
    property NodesAdded : boolean read FNodesAdded;
161

162
    procedure ReplaceVertexIndex(const ViRemove, ViReplaceWith : integer);
163

164
    constructor Create(const aGLBaseMesh : TGLBaseMesh); override;
165
    destructor Destroy; override;
166
  end;
167

168
  TGLMeshObjectVerletNode = class(TVerletNode)
169
  private
170
    MeshObject : TGLMeshObject;
171
    VertexIndices : TIntegerList;
172
  public
173
    procedure AfterProgress; override;
174

175
    constructor CreateOwned(const aOwner : TGLVerletWorld); override;
176
    destructor Destroy; override;
177
  end;
178

179
implementation
180

181
{ TFaceExtractor }
182

183
procedure TFaceExtractor.Clear;
184
var
185
  i : integer;
186
begin
187
  for i := 0 to FaceList.Count-1 do
188
    FaceList[i].Free;
189

190
  FaceList.Clear;
191
end;
192

193
constructor TFaceExtractor.Create(const aGLBaseMesh : TGLBaseMesh);
194
begin
195
  FFaceList := TFaceList.Create;
196
  FGLBaseMesh := aGLBaseMesh;
197
  FNodeList := TVerletNodeList.Create;
198
  FWeldDistance := 0.01;
199
end;
200

201
destructor TFaceExtractor.Destroy;
202
begin
203
  Clear;
204

205
  FreeAndNil(FNodeList);
206
  FreeAndNil(FFaceList);
207

208
  inherited;
209
end;
210

211
procedure TFaceExtractor.ExtractFacesFromVertexIndexList(
212
  const FaceGroup : TFGVertexIndexList; const MeshObject : TGLMeshObject);
213
var
214
  List : PIntegerArray;
215
  iFace, iVertex  : integer;
216
begin
217
  case FaceGroup.Mode of
218

219
    fgmmTriangles, fgmmFlatTriangles :
220
    begin
221
      for iFace := 0 to FaceGroup.TriangleCount - 1 do
222
      begin
223
        List := @FaceGroup.VertexIndices.List[iFace * 3 + 0];
224
        AddFace(List^[0], List^[1], List^[2], MeshObject);
225
      end;
226
    end;
227

228
    fgmmTriangleStrip :
229
    begin
230
      for iFace:=0 to FaceGroup.VertexIndices.Count-3 do
231
      begin
232
        List := @FaceGroup.VertexIndices.List[iFace];
233
        if (iFace and 1)=0 then
234
           AddFace(List^[0], List^[1], List^[2], MeshObject)
235
        else
236
           AddFace(List^[2], List^[1], List^[0], MeshObject);
237
      end;
238
    end;
239

240
    fgmmTriangleFan :
241
    begin
242
      List := @FaceGroup.VertexIndices.List;
243

244
      for iVertex:=2 to FaceGroup.VertexIndices.Count-1 do
245
        AddFace(List^[0], List^[iVertex-1], List^[iVertex], MeshObject)
246
    end;
247
    else
248
      Assert(false,'Not supported');
249
  end;
250
end;
251

252
procedure TFaceExtractor.ProcessMesh;
253
var
254
  iMeshObject : integer;
255
  MeshObject : TGLMeshObject;
256
begin
257
  for iMeshObject := 0 to FGLBaseMesh.MeshObjects.Count - 1 do
258
  begin
259
    MeshObject := FGLBaseMesh.MeshObjects[iMeshObject];
260

261
    ProcessMeshObject(MeshObject);
262
  end;
263
end;
264

265
procedure TFaceExtractor.ProcessMeshObject(const MeshObject : TGLMeshObject);
266
var
267
 iFaceGroup : integer;
268
begin
269
  if MeshObject.Mode = momFaceGroups then
270
  begin
271
    for iFaceGroup := 0 to MeshObject.FaceGroups.Count - 1 do
272
    begin
273
      if MeshObject.FaceGroups[iFaceGroup] is TFGVertexIndexList then
274
      begin
275
        ExtractFacesFromVertexIndexList(MeshObject.FaceGroups[iFaceGroup] as TFGVertexIndexList, MeshObject);
276
      end else
277
        Assert(false);
278
    end;
279
  end else
280
    Assert(false);
281
end;
282

283
function TFaceExtractor.AddFace(const Vi0, Vi1, Vi2: integer; const MeshObject : TGLMeshObject) : TFace;
284
var
285
  Face : TFace;
286
begin
287
  Face := TFace.Create(MeshObject);
288

289
  FaceList.Add(Face);
290

291
  Face.Vertices[0] := Vi0;
292
  Face.Vertices[1] := Vi1;
293
  Face.Vertices[2] := Vi2;
294

295
  result := Face;
296
end;
297

298
procedure TFaceExtractor.SetWeldDistance(const Value: single);
299
begin
300
  FWeldDistance := Value;
301
end;
302

303

304
{ TFaceList }
305

306
function TFaceList.GetItems(i: integer): TFace;
307
begin
308
  result := TFace(Get(i));
309
end;
310

311
procedure TFaceList.SetItems(i: integer; const Value: TFace);
312
begin
313
  Put(i, Value);
314
end;
315

316
{ TEdgeList }
317

318
function TEdgeList.GetItems(i: integer): TEdge;
319
begin
320
  result := TEdge(Get(i));
321
end;
322

323
function TEdgeList.InsertSorted(AEdge: TEdge): integer;
324
var
325
  i : integer;
326
begin
327
  for i := 0 to Count-1 do
328
  begin
329
    if AEdge.Length<Items[i].Length then
330
    begin
331
      Insert(i, AEdge);
332
      result := i;
333
      exit;
334
    end;
335
  end;
336

337
  result := Add(AEdge);
338
end;
339

340
procedure TEdgeList.SetItems(i: integer; const Value: TEdge);
341
begin
342
  Put(i, Value);
343
end;
344

345
function EdgeLength(Item1, Item2 : pointer) : integer;
346
begin
347
  if TEdge(Item1).Length < TEdge(Item2).Length then
348
    result := -1
349

350
  else if TEdge(Item1).Length = TEdge(Item2).Length then
351
    result := 0
352

353
  else
354
    result := 1;
355
end;
356

357
procedure TEdgeList.SortByLength;
358
begin
359
  Sort(@EdgeLength);
360
end;
361

362
{ TGLMeshObjectVerletNode }
363

364
constructor TGLMeshObjectVerletNode.CreateOwned(const aOwner: TGLVerletWorld);
365
begin
366
  inherited;
367
  VertexIndices := TIntegerList.Create;
368
end;
369

370
destructor TGLMeshObjectVerletNode.Destroy;
371
begin
372
  VertexIndices.Free;
373
  inherited;
374
end;
375

376
procedure TGLMeshObjectVerletNode.AfterProgress;
377
var
378
  i : integer;
379
begin
380
  // Update the actual vertex
381
  for i := 0 to VertexIndices.Count-1 do
382
    MeshObject.Vertices[VertexIndices[i]] := MeshObject.Owner.Owner.AbsoluteToLocal(Location);
383
end;
384

385
{ TEdgeDetector }
386

387
procedure TEdgeDetector.Clear;
388
var
389
  i : integer;
390
begin
391
  inherited;
392

393
  for i := 0 to EdgeList.Count-1 do
394
    EdgeList[i].Free;
395

396
  EdgeList.Clear;
397

398
  FCurrentNodeOffset := 0;
399
  FNodesAdded := false;
400
end;
401

402
constructor TEdgeDetector.Create(const aGLBaseMesh: TGLBaseMesh);
403
begin
404
  FEdgeList := TEdgeList.Create;
405
  FCurrentNodeOffset := 0;
406
  FNodesAdded := false;
407
  FCalcEdgeLength := false;
408

409
  inherited;
410
end;
411

412
destructor TEdgeDetector.Destroy;
413
begin
414
  inherited;
415

416
  FreeAndNil(FEdgeList);
417
end;
418

419
function TEdgeDetector.AddEdge(const Vi0, Vi1: integer; const Face: TFace; const AMeshObject : TGLMeshObject): TEdge;
420
var
421
  i : integer;
422
  Edge : TEdge;
423
begin
424
  // Find an indentical edge, if there is one
425
  for i := 0 to EdgeList.Count - 1 do
426
  begin
427
    Edge := EdgeList[i];
428

429
    if (Edge.Vertices[0]=Vi0) and (Edge.Vertices[1]=Vi1) or
430
       (Edge.Vertices[1]=Vi0) and (Edge.Vertices[0]=Vi1) then
431
    begin
432
      Edge.Faces[1] := Face;
433

434
      result := Edge;
435
      exit;
436
    end;
437
  end;
438

439
  // No edge was found, create a new one
440
  Edge := TEdge.Create(self, Vi0, Vi1, Face, nil, AMeshObject, true);
441
  EdgeList.Add(Edge);
442

443
  result := Edge;
444
end;
445

446
function TEdgeDetector.AddFace(const Vi0, Vi1, Vi2: integer;
447
  const MeshObject: TGLMeshObject): TFace;
448
var
449
  Face : TFace;
450
begin
451
  Face := TFace.Create(MeshObject);
452

453
  FaceList.Add(Face);
454

455
  Face.Vertices[0] := Vi0;
456
  Face.Vertices[1] := Vi1;
457
  Face.Vertices[2] := Vi2;
458

459
  AddEdge(Vi0, Vi1, Face, MeshObject);
460
  AddEdge(Vi1, Vi2, Face, MeshObject);
461
  AddEdge(Vi2, Vi0, Face, MeshObject);//}
462

463
  result := Face;
464
end;
465

466
procedure TEdgeDetector.AddNodes(const VerletWorld : TGLVerletWorld);
467
var
468
  i : integer;
469
  MO : TGLMeshObject;
470
begin
471
  FNodesAdded := true;
472
  FCurrentNodeOffset := FNodeList.Count;
473

474
  MO := FGLBaseMesh.MeshObjects[0];
475

476
  for i := 0 to MO.Vertices.Count-1 do
477
    AddNode(VerletWorld, MO, i);
478

479
  // Assert(FNodeList.Count = MO.Vertices.Count, Format('%d <> %d',[FNodeList.Count, MO.Vertices.Count]));
480
end;
481

482
procedure TEdgeDetector.AddEdgesAsSprings(const VerletWorld : TGLVerletWorld;
483
  const Strength, Damping, Slack: single);
484
var
485
  i : integer;
486
  Edge : TEdge;
487
begin
488
  if not FNodesAdded then
489
    AddNodes(VerletWorld);
490

491
  for i := 0 to EdgeList.Count-1 do
492
  begin
493
    // if not EdgeList[i].SameSame(FNodeList) then
494
    Edge := EdgeList[i];
495
    if FNodeList[FCurrentNodeOffset+Edge.Vertices[0]] <> FNodeList[FCurrentNodeOffset+Edge.Vertices[1]] then
496
    begin
497
      VerletWorld.CreateSpring(
498
        FNodeList[FCurrentNodeOffset+Edge.Vertices[0]],
499
        FNodeList[FCurrentNodeOffset+Edge.Vertices[1]],
500
        Strength, Damping, Slack);
501
    end;
502
  end;
503
end;
504

505
procedure TEdgeDetector.AddEdgesAsSticks(const VerletWorld : TGLVerletWorld;
506
  const Slack : single);
507
var
508
  i : integer;
509
  Edge : TEdge;
510
begin
511
  if not FNodesAdded then
512
    AddNodes(VerletWorld);
513

514
  for i := 0 to EdgeList.Count-1 do
515
  begin
516
    // if not EdgeList[i].SameSame(FNodeList) then
517
    Edge := EdgeList[i];
518
    if FNodeList[FCurrentNodeOffset+Edge.Vertices[0]] <> FNodeList[FCurrentNodeOffset+Edge.Vertices[1]] then
519
    begin
520
      VerletWorld.CreateStick(
521
        FNodeList[FCurrentNodeOffset + Edge.Vertices[0]],
522
        FNodeList[FCurrentNodeOffset + Edge.Vertices[1]],
523
        Slack);
524
    end;
525
  end;
526
end;
527

528
procedure TEdgeDetector.AddEdgesAsSolidEdges(
529
  const VerletWorld: TGLVerletWorld);
530
var
531
  i : integer;
532
  Edge : TEdge;
533
begin
534
  if not FNodesAdded then
535
    AddNodes(VerletWorld);
536

537
  for i := 0 to EdgeList.Count-1 do
538
  begin
539
    // if not EdgeList[i].SameSame(FNodeList) then
540
    Edge := EdgeList[i];
541
    if FNodeList[FCurrentNodeOffset+Edge.Vertices[0]] <> FNodeList[FCurrentNodeOffset+Edge.Vertices[1]] then
542
    begin
543
      if Edge.Solid then
544
        VerletWorld.AddSolidEdge(
545
          FNodeList[FCurrentNodeOffset + Edge.Vertices[0]],
546
          FNodeList[FCurrentNodeOffset + Edge.Vertices[1]]);
547
    end;
548
  end;
549
end;
550

551
procedure TEdgeDetector.AddOuterEdgesAsSolidEdges(
552
  const VerletWorld: TGLVerletWorld);
553
var
554
  i : integer;
555
  Edge : TEdge;
556
begin
557
  if not FNodesAdded then
558
    AddNodes(VerletWorld);
559

560
  for i := 0 to EdgeList.Count-1 do
561
  begin
562
    // if not EdgeList[i].SameSame(FNodeList) then
563
    Edge := EdgeList[i];
564
    if FNodeList[FCurrentNodeOffset+Edge.Vertices[0]] <> FNodeList[FCurrentNodeOffset+Edge.Vertices[1]] then
565
    begin
566
      if Edge.Solid and (Edge.Faces[1]=nil) then
567
        VerletWorld.AddSolidEdge(
568
          FNodeList[FCurrentNodeOffset + Edge.Vertices[0]],
569
          FNodeList[FCurrentNodeOffset + Edge.Vertices[1]]);
570
    end;
571
  end;
572
end;
573

574
procedure TEdgeDetector.RenderEdges(var rci: TGLRenderContextInfo);
575
var
576
  i : integer;
577
  Edge : TEdge;
578
  Vertex0, Vertex1 : TAffineVector;
579
begin
580
  if EdgeList.Count>0 then
581
  begin
582
    rci.GLStates.Disable(stLighting);
583
    rci.GLStates.LineWidth := 3;
584
    GL.Color3f(1,1,1);
585

586
    GL.Begin_(GL_LINES);
587
      for i := 0 to EdgeList.Count - 1 do
588
      begin
589
        Edge := EdgeList[i];
590

591
        Vertex0 := Edge.MeshObject.Vertices[Edge.Vertices[0]];
592
        Vertex1 := Edge.MeshObject.Vertices[Edge.Vertices[1]];
593

594
        GL.Vertex3fv(PGLfloat(@Vertex0));
595
        GL.Vertex3fv(PGLfloat(@Vertex1));
596
      end;
597
    GL.End_;
598
  end;//}
599
end;
600

601
procedure TEdgeDetector.BuildOpposingEdges;
602
var
603
  iEdge, EdgeCount, vi0, vi1, iEdgeTest : integer;
604
  Face0, Face1 : TFace;
605
  Edge, NewEdge, TestEdge : TEdge;
606
begin
607
  // For each edge that's connected by two triangles, create a new edge that
608
  // connects the two "extra" vertices.... makes sense?
609
  EdgeCount := EdgeList.Count;
610

611
  for iEdge := 0 to EdgeCount-1 do
612
  begin
613
    Edge := EdgeList[iEdge];
614

615
    if Assigned(Edge.Faces[1]) then
616
    begin
617
      Face0 := Edge.Faces[0];
618
      Face1 := Edge.Faces[1];
619

620
      if (Face0.Vertices[0] <> Edge.Vertices[0]) and (Face0.Vertices[0] <> Edge.Vertices[1]) then
621
        vi0 := Face0.Vertices[0]
622
      else if (Face0.Vertices[1] <> Edge.Vertices[0]) and (Face0.Vertices[1] <> Edge.Vertices[1]) then
623
        vi0 := Face0.Vertices[1]
624
      else
625
        vi0 := Face0.Vertices[2];
626

627
      if (Face1.Vertices[0] <> Edge.Vertices[0]) and (Face1.Vertices[0] <> Edge.Vertices[1]) then
628
        vi1 := Face1.Vertices[0]
629
      else if (Face1.Vertices[1] <> Edge.Vertices[0]) and (Face1.Vertices[1] <> Edge.Vertices[1]) then
630
        vi1 := Face1.Vertices[1]
631
      else
632
        vi1 := Face1.Vertices[2];
633

634
      if (vi0=vi1) or
635
         (vi0=Edge.Vertices[0]) or
636
         (vi0=Edge.Vertices[1]) or
637
         (vi1=Edge.Vertices[0]) or
638
         (vi1=Edge.Vertices[1]) then
639
        continue;
640

641
      // Find an indentical edge, if there is one
642
      for iEdgeTest := 0 to EdgeList.Count - 1 do
643
      begin
644
        TestEdge := EdgeList[iEdgeTest];
645

646
        if (TestEdge.Vertices[0]=Vi0) and (TestEdge.Vertices[1]=Vi1) or
647
           (TestEdge.Vertices[1]=Vi0) and (TestEdge.Vertices[0]=Vi1) then
648
        begin
649
          // Edge allready exists!
650
          inc(FEdgeDoublesSkipped);
651
          continue;
652
        end;
653
      end;
654

655
      NewEdge := TEdge.Create(self, Vi0, Vi1, nil, nil, Edge.MeshObject, false);
656

657
      EdgeList.Add(NewEdge);//}
658
    end;
659
  end;
660
end;
661

662
function TEdgeDetector.AddNode(const VerletWorld : TGLVerletWorld; const MeshObject: TGLMeshObject;
663
  const VertexIndex: integer): TVerletNode;
664
var
665
  Location : TAffineVector;
666
  aNode : TGLMeshObjectVerletNode;
667
  i : integer;
668
begin
669
  // Is there an identical node?
670
  Location := MeshObject.Owner.Owner.LocalToAbsolute(MeshObject.Vertices[VertexIndex]);
671

672
  for i := FCurrentNodeOffset to FNodeList.Count-1 do
673
  begin
674
    aNode := TGLMeshObjectVerletNode(FNodeList[i]);
675

676
    if VectorDistance2(Location, aNode.Location)<=FWeldDistance then
677
    begin
678
      FNodeList.Add(aNode);
679
      aNode.VertexIndices.Add(VertexIndex);
680
      Result:=aNode;
681
      Exit;
682
    end;
683
  end;//}
684

685
  aNode := TGLMeshObjectVerletNode.CreateOwned(VerletWorld);
686
  aNode.MeshObject := MeshObject;
687
  aNode.VertexIndices.Add(VertexIndex);
688
  aNode.Location := Location;
689
  aNode.OldLocation := Location;
690

691
  FNodeList.Add(aNode);
692
  Result:=aNode;
693
end;
694

695
procedure TEdgeDetector.ProcessMesh;
696
begin
697
  inherited;
698

699
  BuildOpposingEdges;
700
end;
701

702
procedure TEdgeDetector.ReplaceVertexIndex(const ViRemove,
703
  ViReplaceWith: integer);
704
var
705
  i : integer;
706
  Done : boolean;
707
  Edge : TEdge;
708
begin
709
  for i := 0 to FaceList.Count-1 do
710
    with FaceList[i] do
711
    begin
712
      if Active then
713
      begin
714
        if Vertices[0] = ViRemove then
715
          Vertices[0] := ViReplaceWith;
716

717
        if Vertices[1] = ViRemove then
718
          Vertices[1] := ViReplaceWith;
719

720
        if Vertices[2] = ViRemove then
721
          Vertices[2] := ViReplaceWith;
722

723
        if (Vertices[0]=Vertices[1]) or
724
         (Vertices[1]=Vertices[2]) or
725
         (Vertices[2]=Vertices[0]) then
726
          Active := false;
727
      end;
728
    end;
729

730
  Done := false;
731
  while not Done do
732
  begin
733
    Done := true;
734
    for i := 0 to EdgeList.Count-1 do
735
      with EdgeList[i] do
736
      begin
737
        if (Vertices[0] = ViRemove) or (Vertices[1] = ViRemove) then
738
        begin
739
          if Vertices[0] = ViRemove then
740
            Vertices[0] := ViReplaceWith;
741

742
          if Vertices[1] = ViRemove then
743
            Vertices[1] := ViReplaceWith;
744

745
          UpdateEdgeLength;
746

747
          Edge := EdgeList[i];
748
          EdgeList.Delete(i);
749

750
          if Edge.Length=-1 then
751
            Edge.Free
752
          else
753
            EdgeList.InsertSorted(Edge);
754

755
          Done := false;
756

757
          break;//}
758
        end;
759
      end;
760
  end;
761
end;
762

763
{ TFace }
764

765
constructor TFace.Create(aMeshObject: TGLMeshObject);
766
begin
767
  MeshObject := aMeshObject;
768
  Active := true;
769
end;
770

771
procedure TFace.UpdateNormal;
772
begin
773
  CalcPlaneNormal(
774
    MeshObject.Vertices[Vertices[0]],
775
    MeshObject.Vertices[Vertices[1]],
776
    MeshObject.Vertices[Vertices[2]], Normal);
777
end;
778

779
{ TEdge }
780

781
procedure TEdge.Contract;
782
begin
783
  // We're removing vertex 1 and replacing it with vertex 0
784
  FOwner.ReplaceVertexIndex(Vertices[1], Vertices[0]);
785
  //MeshObject.Vertices[Vertices[0]] := MeshObject.Vertices[Vertices[1]];
786
  Length := -1;
787
end;
788

789
constructor TEdge.Create(const AOwner: TEdgeDetector; AVi0, AVi1 : integer;
790
  AFace0, AFace1 : TFace; AMeshObject : TGLMeshObject; ASolid : boolean);
791
begin
792
  FOwner := AOwner;
793
  Vertices[0] := AVi0;
794
  Vertices[1] := AVi1;
795
  Faces[0] := AFace0;
796
  Faces[1] := AFace1;
797
  FMeshObject := AMeshObject;
798
  FSolid := true;
799

800
  UpdateEdgeLength;
801
end;
802

803
procedure TEdge.UpdateEdgeLength;
804
begin
805
  if FOwner.FCalcEdgeLength then
806
  begin
807
    if Vertices[0] = Vertices[1] then
808
      Length := -1
809
    else
810
      Length := VectorDistance(
811
        FOwner.GLBaseMesh.LocalToAbsolute(FMeshObject.Vertices[Vertices[0]]),
812
        FOwner.GLBaseMesh.LocalToAbsolute(FMeshObject.Vertices[Vertices[1]]));
813
  end;
814
end;
815

816
end.
817