LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   Line implementation by means of a Triangle strip. 
6
   The history is logged in a former GLS version of the unit.
7
}
8

9
unit GLMeshLines;
10

11
interface
12

13
uses
14
  Classes,
15
  SysUtils,
16
  OpenGLTokens, 
17
   
18
  GLScene, 
19
  GLObjects, 
20
  GLTexture, 
21
  GLVectorFileObjects, 
22
  GLCoordinates, 
23
  GLContext, 
24
  GLMaterial, 
25
  GLColor, 
26
  GLState, 
27
  GLNodes, 
28
  GLVectorGeometry, 
29
  GLSpline,
30
  GLVectorTypes, 
31
  GLVectorLists, 
32
  GLRenderContextInfo;
33

34
type
35
   // TLineNode
36
   //
37
   {Specialized Node for use in a TGLLines objects. 
38
      Adds a Width property }
39
   TLineNode = class(TGLNode)
40
   private
41
     FData: Pointer;
42
   protected
43
   public
44
     constructor Create(Collection : TCollection); override;
45
     destructor Destroy; override;
46
     procedure Assign(Source: TPersistent); override;
47
     property Data: Pointer read FData write FData;
48
   published
49
   end;
50

51
   // TLineNodes
52
   //
53
   {Specialized collection for Nodes in TGLMeshLines objects. 
54
      Stores TLineNode items. }
55
   TLineNodes = class(TGLNodes)
56
   public
57
     
58
     constructor Create(AOwner : TComponent); overload;
59
     destructor destroy; override;
60
     procedure NotifyChange; override;
61
     function IndexOf(LineNode: TLineNode): Integer;
62
   end;
63

64
  TLineItem = class(TCollectionItem)
65
  private
66
    FName: String;
67
    FBreakAngle: Single;
68
    FDivision: Integer;
69
    FNodes: TLineNodes;
70
    FSplineMode: TGLLineSplineMode;
71
    FTextureLength: Single;
72
    FWidth: Single;
73
    FTextureCorrection: Boolean;
74
    FHide: Boolean;
75
    FData: Pointer;
76
    procedure SetHide(const Value: Boolean);
77
    procedure SetTextureCorrection(const Value: Boolean);
78
    procedure SetBreakAngle(const Value: Single);
79
    procedure SetDivision(const Value: Integer);
80
    procedure SetNodes(const Value: TLineNodes);
81
    procedure SetSplineMode(const Value:TGLLineSplineMode);
82
    procedure SetTextureLength(const Value: Single);
83
    procedure SetWidth(const Value: Single);
84
  protected
85
    procedure DoChanged; virtual;
86
  public
87
    property Data: Pointer read FData write FData;
88
    constructor Create(Collection: TCollection); override;
89
    destructor Destroy; override;
90
  published
91

92
    property Hide: Boolean read FHide write SetHide;
93
    property Name: String read FName write FName;
94
    property TextureCorrection: Boolean read FTextureCorrection write SetTextureCorrection;
95
    property BreakAngle: Single read FBreakAngle write SetBreakAngle;
96
    property Division: Integer read FDivision write SetDivision;
97
    property Nodes : TLineNodes read FNodes write SetNodes;
98
    property SplineMode: TGLLineSplineMode read FSplineMode write SetSplineMode;
99
    property TextureLength: Single read FTextureLength write SetTextureLength;
100
    property Width: Single read FWidth write SetWidth;
101
  end;
102

103
  TLineCollection = class(TOwnedCollection)
104
  private
105
    procedure SetItems(Index: Integer; const Val: TLineItem);
106
    function GetItems(Index: Integer): TLineItem;
107
  protected
108
  public
109
    function Add: TLineItem; overload;
110
    function Add(Name: String): TLineItem; overload;
111
    property Items[Index: Integer]: TLineItem read GetItems write SetItems; default;
112
  published
113
  end;
114

115
  TLightmapBounds = class(TGLCustomCoordinates)
116
  private
117
    function GetLeft: TGLFloat;
118
    function GetTop: TGLFloat;
119
    function GetRight: TGLFloat;
120
    function GetBottom: TGLFloat;
121
    function GetWidth: TGLFloat;
122
    function GetHeight: TGLFloat;
123
    procedure SetLeft(const value: TGLFloat);
124
    procedure SetTop(const value: TGLFloat);
125
    procedure SetRight(const value: TGLFloat);
126
    procedure SetBottom(const value: TGLFloat);
127
  published
128
    property Left: TGLFloat read GetLeft write SetLeft stored False;
129
    property Top: TGLFloat read GetTop write SetTop stored False;
130
    property Right: TGLFloat read GetRight write SetRight stored False;
131
    property Bottom: TGLFloat read GetBottom write SetBottom stored False;
132
    property Width: TGLFloat read GetWidth;
133
    property Height: TGLFloat read GetHeight;
134
  end;
135

136
  TGLMeshLines = class(TGLFreeForm)
137
  private
138
    FLines: TLineCollection;
139
    FMesh: TGLMeshObject;
140
    FLightmapBounds: TLightmapBounds;
141
    FLightmapIndex: Integer;
142
    FLightmapMaterialName: String;
143
    FFaceGroup: TFGVertexIndexList;
144
    FIndex: Integer;
145
    FNoZWrite: boolean;
146
    FShowNodes: Boolean;
147
    FUpdating: Integer;
148
    FSelectedLineItem: TLineItem;
149
    FSelectedNode: TLineNode;
150
    FNode1,FNode2: TLineNode;
151
    function GetUpdating: Boolean;
152
    function PointNearLine(const LineItem: TLineItem; const X,Z: Single; Tolerance: single = 1): boolean;
153
    function PointNearSegment(const StartNode, EndNode: TLineNode; const X,Z: Single; LineWidth: single; Tolerance: single = 1): boolean;
154
    procedure StitchStrips(idx: TIntegerList);
155
    procedure AddStitchMarker(idx: TIntegerList);
156
    procedure SetShowNodes(const Value: Boolean);
157
    procedure SetNoZWrite(const Value: Boolean);
158
    procedure SetLightmapIndex(const value: Integer);
159
    procedure SetLightmapMaterialName(const value: String);
160
    procedure SetLightmapBounds(const value: TLightmapBounds);
161
    procedure DoChanged;
162
    procedure AddIndex;
163
    procedure AddVertices(Up, Inner, Outer: TAffineVector; S: Single; Correction: Single; UseDegenerate: Boolean; LineItem: TLineItem);
164
    procedure BuildLineItem(LineItem: TLineItem);
165
    procedure BuildGeometry;
166
    procedure DrawNode(var rci : TGLRenderContextInfo; Node: TLineNode; LineWidth: Single);
167
    procedure DrawCircle(Radius: Single);
168
    function SelectNode(LineItem: TLineItem; X,Z: Single):TLineNode;
169
  protected
170
    procedure Loaded; override;
171
  public
172
    constructor Create(AOwner: TComponent); override;
173
    destructor Destroy; override;
174
    procedure BeginUpdate; override;
175
    procedure EndUpdate; override;
176
    procedure Clear;
177
    function SelectLineItem(const X,Z: Single; Tolerance: single = 1): TLineItem; overload;
178
    function SelectLineItem(LineItem: TLineItem): TLineItem; overload;
179
    function SelectLineItem(LineNode: TLineNode): TLineItem; overload;
180
    procedure DeselectLineItem;
181
    procedure DeselectLineNode;
182
    procedure BuildList(var rci : TGLRenderContextInfo); override;
183
    procedure DoRender(var rci : TGLRenderContextInfo; renderSelf, renderChildren : Boolean); override;
184
    procedure NotifyChange(Sender : TObject); override;
185
    property SelectedLineItem: TLineItem read FSelectedLineItem;
186
    property SelectedNode: TLineNode read FSelectedNode;
187
    property Node1: TLineNode read FNode1;
188
    property Node2: TLineNode read FNode2;
189
  published
190

191
    property Updating: Boolean Read GetUpdating;
192
    property Lines: TLineCollection read FLines;
193
    property Material;
194
    property LightmapBounds: TLightmapBounds read FLightmapBounds write SetLightmapBounds;
195
    property LightmapIndex: Integer read FLightmapIndex write SetLightmapIndex;
196
    property LightmapMaterialName: String read FLightmapMaterialName write SetLightmapMaterialName;
197
    property NoZWrite: boolean read FNoZWrite write SetNoZWrite;
198
    property ShowNodes: Boolean read FSHowNodes write SetShowNodes;
199
  end;
200

201
//--------------------------------------------------------------------------
202
//--------------------------------------------------------------------------
203
//--------------------------------------------------------------------------
204
implementation
205
//--------------------------------------------------------------------------
206
//--------------------------------------------------------------------------
207
//--------------------------------------------------------------------------
208

209
const
210
  CIRCLESEGMENTS = 32;
211

212
// TLineNode
213
//
214
constructor TLineNode.Create(Collection : TCollection);
215
begin
216
	inherited Create(Collection);
217
end;
218

219
destructor TLineNode.Destroy;
220
begin
221
	inherited Destroy;
222
end;
223

224
procedure TLineNode.Assign(Source: TPersistent);
225
begin
226
	if Source is TLineNode then
227
  begin
228
      FData := TLineNode(Source).FData;
229
  end;
230
	inherited;
231
end;
232

233
// TLineNodes
234
//
235
constructor TLineNodes.Create(AOwner : TComponent);
236
begin
237
   inherited Create(AOwner, TLineNode);
238
end;
239

240
destructor TLineNodes.destroy;
241
begin
242
  inherited;
243
end;
244

245
procedure TLineNodes.NotifyChange;
246
begin
247
   if (GetOwner<>nil) then
248
      TGLMeshLines((GetOwner as TLineItem).Collection.Owner).StructureChanged;
249
end;
250

251
function TLineNodes.IndexOf(LineNode: TLineNode): Integer;
252
var
253
  i: Integer;
254
begin
255
  result := -1;
256
  if assigned(LineNode) then
257
  begin
258
    for i := 0 to Count - 1 do
259
    begin
260
      if LineNode = Items[i] then
261
      begin
262
        Result := i;
263
        break;
264
      end;
265
    end;
266
  end;
267
end;
268

269

270
// TLineCollection
271
//
272
function TLineCollection.GetItems(index: Integer): TLineItem;
273
begin
274
   Result:=TLineItem(inherited Items[index]);
275
end;
276

277
procedure TLineCollection.SetItems(index: Integer; const val: TLineItem);
278
begin
279
   inherited Items[index]:=val;
280
end;
281

282
function TLineCollection.Add: TLineItem;
283
begin
284
  result := TLineItem.Create(self);
285
end;
286

287
function TLineCollection.Add(Name: String): TLineItem;
288
begin
289
  Result := Add;
290
  Result.Name := Name;
291
end;
292

293
// TMeshLine
294
//
295
constructor TLineItem.Create(Collection: TCollection);
296
begin
297
  inherited;
298
  FNodes:=TLineNodes.Create(Self, TLineNode);
299
  FBreakAngle := 30;
300
  FDivision := 10;
301
  FSplineMode := lsmLines;
302
  FTextureLength := 1;
303
  FWidth := 1;
304
  FTextureCorrection := False;
305
end;
306

307
destructor TLineItem.Destroy;
308
begin
309
  if TGLMeshLines(Collection.Owner).SelectedLineItem = self then
310
    TGLMeshLines(Collection.Owner).DeSelectLineItem;
311
  FNodes.Free;
312
  inherited;
313
end;
314

315
procedure TLineItem.SetHide(const Value: Boolean);
316
begin
317
  FHide := Value;
318
  DoChanged;
319
end;
320

321
procedure TLineItem.SetTextureCorrection(const Value: Boolean);
322
begin
323
  FTextureCorrection := Value;
324
  DoChanged;
325
end;
326

327
procedure TLineItem.SetBreakAngle(const Value: Single);
328
begin
329
  FBreakAngle := Value;
330
  DoChanged;
331
end;
332

333
procedure TLineItem.SetDivision(const Value: Integer);
334
begin
335
  FDivision := Value;
336
  DoChanged;
337
end;
338

339
procedure TLineItem.SetNodes(const Value: TLineNodes);
340
begin
341
  FNodes.Assign(Value);
342
  DoChanged;
343
end;
344

345
procedure TLineItem.SetSplineMode(const Value:TGLLineSplineMode);
346
begin
347
  FSplineMode := Value;
348
  DoChanged;
349
end;
350

351
procedure TLineItem.SetTextureLength(const Value: Single);
352
begin
353
  FTextureLength := Value;
354
  DoChanged;
355
end;
356

357
procedure TLineItem.SetWidth(const Value: Single);
358
begin
359
  FWidth := Value;
360
  DoChanged;
361
end;
362

363
procedure TLineItem.DoChanged;
364
begin
365
  //Notify parent of change because the mesh needs to be regenerated
366
  if (GetOwner<>nil) then
367
    TGLMeshLines(Collection.Owner).NotifyChange(Self);
368
end;
369

370
{ TLightmapBounds }
371

372
function TLightmapBounds.GetLeft: TGLFloat;
373
begin
374
  Result := X;
375
end;
376

377
function TLightmapBounds.GetTop: TGLFloat;
378
begin
379
  Result := Y;
380
end;
381

382
function TLightmapBounds.GetRight: TGLFloat;
383
begin
384
  Result := Z;
385
end;
386

387
function TLightmapBounds.GetBottom: TGLFloat;
388
begin
389
  Result := W;
390
end;
391

392
function TLightmapBounds.GetWidth: TGLFloat;
393
begin
394
  Result := Z - X;
395
end;
396

397
function TLightmapBounds.GetHeight: TGLFloat;
398
begin
399
  Result := W - Y;
400
end;
401

402
procedure TLightmapBounds.SetLeft(const value: TGLFloat);
403
begin
404
  X := Value;
405
end;
406

407
procedure TLightmapBounds.SetTop(const value: TGLFloat);
408
begin
409
  Y := Value;
410
end;
411

412
procedure TLightmapBounds.SetRight(const value: TGLFloat);
413
begin
414
  Z := Value;
415
end;
416

417
procedure TLightmapBounds.SetBottom(const value: TGLFloat);
418
begin
419
  W := Value;
420
end;
421

422

423
// TGLMeshLine
424
//
425
constructor TGLMeshLines.Create(AOwner: TComponent);
426
begin
427
  inherited;
428
  FLines := TLineCollection.Create(self,TLineItem);
429
  FLightmapBounds := TLightmapBounds.Create(Self);
430
end;
431

432
destructor TGLMeshLines.Destroy;
433
begin
434
  FLines.Free;
435
  FLightmapBounds.Free;
436
  inherited;
437
end;
438

439
procedure TGLMeshLines.Loaded;
440
begin
441
  DoChanged;
442
end;
443

444
procedure TGLMeshLines.BeginUpdate;
445
begin
446
  inc(FUpdating);
447
end;
448

449
procedure TGLMeshLines.EndUpdate;
450
begin
451
  Dec(FUpdating);
452
  if FUpdating < 1 then
453
  begin
454
    FUpdating := 0;
455
    DoChanged;
456
  end;
457
end;
458

459
procedure TGLMeshLines.Clear;
460
begin
461
  FSelectedLineItem := nil;
462
  FSelectedNode := nil;
463
  FLines.Clear;
464
  MeshObjects.Clear;
465
  StructureChanged;
466
end;
467

468
procedure TGLMeshLines.BuildList(var rci : TGLRenderContextInfo);
469
var
470
  i,j: Integer;
471
begin
472
  inherited;
473
  if FShowNodes then
474
  begin
475
    for i:= 0 to Lines.Count - 1 do
476
    begin
477
      if Lines[i] = FSelectedLineItem then
478
      begin
479
        for j := 0 to Lines[i].Nodes.Count-1 do
480
          DrawNode(rci, TLineNode(Lines[i].Nodes[j]),Lines[i].Width);
481
      end;
482
    end;
483
  end;
484
end;
485

486
procedure TGLMeshLines.DoRender(var rci : TGLRenderContextInfo; renderSelf, renderChildren : Boolean);
487
begin
488
  if FNoZWrite then
489
  begin
490
    GL.Disable(GL_Depth_Test);
491
    inherited;
492
    GL.Enable(GL_Depth_Test);
493
  end
494
  else
495
    inherited;
496
end;
497

498
procedure TGLMeshLines.SetShowNodes(const Value: Boolean);
499
begin
500
  FShowNodes := Value;
501
  DoChanged;
502
end;
503

504
procedure TGLMeshLines.SetNoZWrite(const Value: Boolean);
505
begin
506
  FNoZWrite := Value;
507
  DoChanged;
508
end;
509

510
procedure TGLMeshLines.SetLightmapIndex(const value: Integer);
511
begin
512
  FLightmapIndex := Value;
513
  DoChanged;
514
end;
515

516
procedure TGLMeshLines.SetLightmapMaterialName(const value: String);
517
var
518
  lLibMaterial: TGLLibMaterial;
519
begin
520
  if Value <> '' then
521
  begin
522
    if assigned(LightmapLibrary) then
523
    begin
524
      lLibMaterial := LightmapLibrary.Materials.GetLibMaterialByName(Value);
525
      if assigned(lLibMaterial) then
526
      begin
527
        FLightmapIndex := lLibMaterial.ID;
528
        FLightmapMaterialName := Value;
529
        DoChanged;
530
      end;
531
    end;
532
  end;
533
end;
534

535
procedure TGLMeshLines.SetLightmapBounds( const value: TLightmapBounds );
536
begin
537
  FLightmapBounds.SetVector(value.X, value.Y,value.Z,value.W);
538
  DoChanged;
539
end;
540

541
procedure TGLMeshLines.DoChanged;
542
begin
543
  if Updating then exit;
544
  BuildGeometry;
545
  StructureChanged;
546
end;
547

548
procedure TGLMeshLines.BuildGeometry;
549
var
550
  i: Integer;
551
  lFirstLineDone: Boolean;
552
  lVertex: TAffineVector;
553
  lTextPoint: TTexPoint;
554
begin
555
  if Updating then exit;
556
  //clear the mesh
557

558
  FMeshObjects.Clear;
559
  lFirstLineDone := False;
560
  FMesh := TGLMeshObject.CreateOwned(FMeshObjects);
561
  FMesh.Mode := momFaceGroups;
562
  FFaceGroup := TFGVertexIndexList.CreateOwned(FMesh.FaceGroups);
563
  FFaceGroup.Mode := fgmmTriangleStrip;
564
  FFaceGroup.LightMapIndex := FLightmapIndex;
565
  FIndex := 0;
566
  for i := 0 to Lines.Count - 1 do
567
  begin
568
    if not FLines.Items[i].Hide then
569
    begin
570
      if lFirstLineDone then
571
        AddStitchMarker(FFaceGroup.VertexIndices);
572
      if TLineItem(FLines.Items[i]).Nodes.Count > 0 then
573
      begin
574
        BuildLineItem(TLineItem(FLines.Items[i]));
575
        lFirstLineDone := True;
576
      end;
577
    end;
578
  end;
579
  StitchStrips(FFaceGroup.VertexIndices);
580
  //Calculate lightmapping
581
  if assigned(LightmapLibrary) and (LightmapIndex <> -1 ) then
582
    for i := 0 to FMesh.Vertices.Count - 1 do
583
    begin
584
      lVertex := FMesh.Vertices.Items[i];
585
      lTextPoint.s := (lVertex.X - FLightmapBounds.Left) / FLightmapBounds.Width;
586
      lTextPoint.t := (lVertex.Z - FLightmapBounds.Top) / FLightmapBounds.Height;
587
      FMesh.LightMapTexCoords.Add(lTextPoint);
588
    end;
589
end;
590

591
procedure TGLMeshLines.DrawNode(var rci : TGLRenderContextInfo; Node: TLineNode; LineWidth: Single);
592
var
593
  lNodeSize: Single;
594
begin
595
  lNodeSize := LineWidth* 0.7;
596
  GL.PushMatrix;
597
  GL.Translatef(Node.x,Node.y,Node.z);
598
  if lNodeSize <>1 then
599
  begin
600
    GL.PushMatrix;
601
    GL.Scalef(lNodeSize, lNodeSize, lNodeSize);
602
///    rci.GLStates.UnSetGLState(stTexture2D);
603
   // rci.GLStates.UnSetGLState(stColorMaterial);
604
  //  rci.GLStates.UnSetGLState(stBlend);
605
    if Node = FSelectedNode then
606
      rci.GLStates.SetGLMaterialColors(cmFRONT, clrBlack, clrGray20, clrYellow, clrBlack, 0)
607
    else
608
      rci.GLStates.SetGLMaterialColors(cmFRONT, clrBlack, clrGray20, clrGreen, clrBlack, 0);
609
    DrawCircle(lNodeSize);
610
    GL.PopMatrix;
611
  end
612
  else
613
  begin
614
    if Node = FSelectedNode then
615
      rci.GLStates.SetGLMaterialColors(cmFRONT, clrBlack, clrGray20, clrYellow, clrBlack, 0)
616
    else
617
      rci.GLStates.SetGLMaterialColors(cmFRONT, clrBlack, clrGray20, clrGreen, clrBlack, 0);
618
    DrawCircle(lNodeSize);
619
  end;
620
  GL.PopMatrix;
621
end;
622

623
procedure TGLMeshLines.DrawCircle(Radius: Single);
624
var
625
  inner,outer,p1,p2: TVector;
626
  i: Integer;
627
  a: Single;
628
  lUp: TAffineVector;
629
begin
630
  inner := VectorMake(1, 0, 0);
631
  outer := VectorMake(1.3, 0, 0);
632
  GL.Begin_(GL_TRIANGLE_STRIP);
633
  for i:= 0 to CIRCLESEGMENTS do
634
  begin
635
    a := i * 2 * pi / CIRCLESEGMENTS;
636
    p1 := outer;
637
    p2 := inner;
638
    lUp := Up.AsAffineVector;
639
    RotateVector(p1,lUp, a);
640
    RotateVector(p2,lUp, a);
641
    GL.Vertex3fv(@p1.X);
642
    GL.Vertex3fv(@p2.X);
643
  end;
644
  GL.End_();
645
end;
646

647
function TGLMeshLines.SelectNode(LineItem: TLineItem; X,Z: Single): TLineNode;
648
var
649
  i: Integer;
650
  lRange: Single;
651
  length: single;
652
begin
653
  Result := nil;
654
  lRange := LineItem.Width * 0.88;
655
  for i := 0 to LineItem.Nodes.count - 1 do
656
  begin
657
    length := 1/RLength((X - LineItem.Nodes[i].X),(Z - LineItem.Nodes[i].Z));
658
    if length < lRange then
659
    begin
660
      Result := TLineNode(LineItem.Nodes[i]);
661
      Break;
662
    end;
663
  end;
664
end;
665

666
function TGLMeshLines.SelectLineItem(LineItem: TLineItem): TLineItem;
667
begin
668
  Result := nil;
669
  FSelectedLineItem := LineItem;
670
  FSelectedNode := nil;
671
  DoChanged;
672
end;
673

674
function TGLMeshLines.SelectLineItem(LineNode: TLineNode): TLineItem;
675
begin
676
  FSelectedLineItem := TLineItem(LineNode.Collection.Owner);
677
  FSelectedNode := LineNode;
678
  Result := FSelectedLineItem;
679
  DoChanged;
680
end;
681

682
procedure TGLMeshLines.DeselectLineItem;
683
begin
684
  FSelectedLineItem := nil;
685
  FSelectedNode := nil;
686
  DoChanged;
687
end;
688

689
procedure TGLMeshLines.DeselectLineNode;
690
begin
691
  FSelectedNode := nil;
692
  DoChanged;
693
end;
694

695
function TGLMeshLines.SelectLineItem(const X,Z: Single; Tolerance: single = 1): TLineItem;
696
var
697
  i: Integer;
698
  lStartPoint: Integer;
699
  lNode: TLineNode;
700

701
begin
702
  Result := nil;
703
  if Assigned(FSelectedLineItem) then
704
    lStartPoint := FSelectedLineItem.ID + 1
705
  else
706
    lStartPoint := 0;
707
  for i := lStartPoint to FLines.Count - 1 do
708
  begin
709
    if (FLines[i] <> FSelectedLineItem)  then
710
    begin
711
      if PointNearLine(FLines[i],X,Z,Tolerance) then
712
      begin
713
        Result := FLines[i];
714
        lNode := SelectNode(FLines[i], X,Z);
715
        if lNode <> FSelectedNode then
716
        begin
717
          FSelectedNode := lNode;
718
        end;
719
        break;
720
      end;
721
    end;
722
  end;
723

724
  if not Assigned(Result) then
725
  begin
726
    for i := 0 to lStartPoint - 1 do
727
    begin
728
      if FLines[i] <> FSelectedLineItem then
729
      begin
730
        if PointNearLine(FLines[i],X,Z,Tolerance) then
731
        begin
732
          Result := FLines[i];
733
          break;
734
        end;
735
      end;
736
    end;
737
  end;
738

739
  FSelectedLineItem := Result;
740
  if not assigned(FSelectedLineItem) then
741
  begin
742
    FSelectedNode := nil;
743
    FNode1 := nil;
744
    FNode2 := nil;
745
  end;
746
  DoChanged;
747
end;
748

749
function TGLMeshLines.GetUpdating: Boolean;
750
begin
751
  Result := FUpdating > 0;
752
end;
753

754
function TGLMeshLines.PointNearLine(const LineItem: TLineItem; const X,Z: Single; Tolerance: single = 1): boolean;
755
var
756
  i: Integer;
757
  lStartNode,lEndNode: TLineNode;
758
begin
759
  Result := False;
760
  for i := 0 to LineItem.Nodes.Count - 2 do
761
  begin
762
    lStartNode := TLineNode(LineItem.Nodes[i]);
763
    lEndNode := TLineNode(LineItem.Nodes[i+1]);
764
    if PointNearSegment(lStartNode,lEndNode,X,Z,LineItem.Width,Tolerance) then
765
    begin
766
      Result := True;
767
      FNode1 := lStartNode;
768
      FNode2 := lEndNode;
769
      break;
770
    end;
771
  end;
772
end;
773

774
function TGLMeshLines.PointNearSegment(const StartNode, EndNode: TLineNode; const X,Z: Single; LineWidth: single; Tolerance: single = 1): boolean;
775
var
776
  xt, yt, u, len: single;
777
  xp, yp: single;
778
  lDist: Single;
779
begin
780
  Result:= false;
781
  lDist := (LineWidth/2) * Tolerance;
782
  xt:= EndNode.X - StartNode.X;
783
  yt:= EndNode.Z - StartNode.Z;
784
  len:= sqrt(xt*xt + yt*yt);
785
  xp:= (X - StartNode.X);
786
  yp:= (Z - StartNode.Z);
787
  u:= (xp * xt + yp * yt) / len;
788
  // point beyond line
789
  if (u < -lDist) or (u > len+lDist) then
790
    exit;
791
  u:= u / len;
792
  // get the point on the line that's pependicular to the point in question
793
  xt:= StartNode.X + xt * u;
794
  yt:= StartNode.Z + yt * u;
795
  // find the distance to the line, and see if it's closer than the specified distance
796
  Result:= sqrt(sqr(xt - X) + sqr(yt - Z)) <= lDist;
797
end;
798

799
procedure TGLMeshLines.StitchStrips(idx: TIntegerList);
800
var
801
  i: integer;
802
  i0, i1, i2: integer;
803
begin
804
  for i := idx.Count - 1 downto 0 do
805
  begin
806
    if idx[i] = -1 then
807
    begin
808
      i0:= idx[i-1];
809
      i1:= idx[i+4];
810
      i2:= idx[i+5];
811
      idx[i]:= i0;
812
      idx[i+1]:= i1;
813
      idx[i+2]:= i1;
814
      idx[i+3]:= i2;
815
    end;
816
  end;
817
end;
818

819
procedure TGLMeshLines.AddStitchMarker(idx: TIntegerList);
820
begin
821
  idx.Add(-1);
822
  idx.Add(-2);
823
  idx.Add(-2);
824
  idx.Add(-2);
825
end;
826

827
procedure TGLMeshLines.NotifyChange(Sender : TObject);
828
begin
829
  inherited;
830
  DoChanged;
831
end;
832

833
procedure TGLMeshLines.AddIndex;
834
begin
835
  FFaceGroup.Add(FIndex);
836
  inc(FIndex);
837
end;
838

839
procedure TGLMeshLines.AddVertices(Up,Inner,Outer: TAffineVector; S: Single; Correction: Single; UseDegenerate: Boolean; LineItem: TLineItem);
840
begin
841
  if not LineItem.TextureCorrection then
842
    Correction := 0
843
  else
844
    Correction := Correction / (LineItem.TextureLength / LineItem.width);
845
  FMesh.Normals.Add(Up);
846
  FMesh.Vertices.Add(Outer);
847
  FMesh.TexCoords.Add(S-Correction,1);
848
  AddIndex;
849
  FMesh.Normals.Add(Up);
850
  FMesh.TexCoords.Add(S+Correction,0);
851
  FMesh.Vertices.Add(Inner);
852
  AddIndex;
853
  if LineItem.TextureCorrection then
854
  begin
855
    FMesh.Normals.Add(Up);
856
    FMesh.Vertices.Add(Outer);
857
    FMesh.TexCoords.Add(S+Correction,1);
858
    AddIndex;
859
    FMesh.Normals.Add(Up);
860
    FMesh.TexCoords.Add(S-Correction,0);
861
    FMesh.Vertices.Add(Inner);
862
    AddIndex;
863
  end;
864
end;
865

866
procedure TGLMeshLines.BuildLineItem(LineItem: TLineItem);
867
var
868
  Seg1: TAffineVector;
869
  Seg2: TAffineVector;
870
  NSeg1: TAffineVector;
871
  NSeg2: TAffineVector;
872
  N1,N2,N3: TAffineVector;
873
  Inner: TAffineVector;
874
  Outer: TAffineVector;
875
  lUp: TAffineVector;
876
  lAngle: Single;
877
  lAngleOffset: Single;
878
  lTotalAngleChange: Single;
879
  lBreakAngle: Single;
880
  i: Integer;
881
  Flip: Boolean;
882
  s: single;
883
  lSpline: TCubicSpline;
884
  lCount: Integer;
885
  f : Single;
886
  a, b, c : Single;
887
  lHalfLineWidth: single;
888
begin
889
  inherited;
890
  lTotalAngleChange := 0;
891
  lHalfLineWidth := LineItem.Width/2;
892
  lBreakAngle := DegToRad(LineItem.BreakAngle);
893
  try
894
    N1 := AffineVectorMake(0,0,0);
895
    N2 := AffineVectorMake(0,0,0);
896
    N3 := AffineVectorMake(0,0,0);
897
    s:= 0;
898
    f := 0;
899
    lSpline := nil;
900
    lUp := Up.AsAffineVector;
901
    lCount := 0;
902
    if LineItem.SplineMode = lsmLines then
903
      lCount := LineItem.Nodes.Count - 1
904
    else
905
    if LineItem.Nodes.Count > 1 then
906
    begin
907
      lCount := (LineItem.Nodes.Count-1) * LineItem.Division;
908
      lSpline := LineItem.Nodes.CreateNewCubicSpline;
909
      f:=1/LineItem.Division;
910
    end;
911
    for i := 0 to lCount do
912
    begin
913
      if LineItem.SplineMode = lsmLines then
914
      begin
915
        N3 := LineItem.Nodes.Items[i].AsAffineVector
916
      end
917
      else
918
      begin
919
        if lCount > 1 then
920
        begin
921
          lSpline.SplineXYZ(i*f, a, b, c);
922
          N3 := AffineVectorMake(a,b,c);
923
        end;
924
      end;
925
      if i > 0 then
926
      begin
927
        Seg2 := VectorSubtract(N3,N2);
928
        Seg1 := Seg2;
929
      end;
930
      if (i = 1) and not VectorEQuals(Seg2,NullVector)then
931
      begin
932
        //Create start vertices
933
        //this makes the assumption that these vectors are different which not always true
934
        Inner := VectorCrossProduct(Seg2, lUp);
935
        NormalizeVector(Inner);
936
        ScaleVector(Inner,lHalfLineWidth);
937
        Outer := VectorNegate(Inner);
938
        AddVector(Inner,N2);
939
        AddVector(Outer,N2);
940
        AddVertices(lUp,Inner, Outer,S,0,False,LineItem);
941
        s := s + VectorLength(Seg2)/LineItem.TextureLength;
942
      end;
943
      if i > 1 then
944
      begin
945
        lUp := VectorCrossProduct(Seg2,Seg1);
946
        if VectorEquals(lUp, NullVector) then
947
          lUp := Up.AsAffineVector;
948
        Flip := VectorAngleCosine(lUp,Self.up.AsAffineVector) < 0;
949
        if Flip then
950
          NegateVector(lUp);
951
        NSeg1 := VectorNormalize(Seg1);
952
        NSeg2 := VectorNormalize(Seg2);
953
        if VectorEquals(NSeg1,NSeg2) then
954
        begin
955
          Inner := VectorCrossProduct(Seg2, lUp);
956
          lAngle := 0;
957
        end
958
        else
959
        begin
960
          Inner := VectorSubtract(NSeg2,NSeg1);
961
          lAngle := (1.5707963 - ArcCos(VectorLength(Inner)/2));
962
        end;
963
        lTotalAngleChange := lTotalAngleChange + (lAngle * 2);
964
        //Create intermediate vertices
965
        if (lTotalAngleChange > lBreakAngle) or (LineItem.BreakAngle = -1 )then
966
        begin
967
          lTotalAngleChange := 0;
968
          //Correct width for angles less than 170
969
          if lAngle < 1.52 then
970
            lAngleOffset := lHalfLineWidth * sqrt(sqr(Tan(lAngle))+1)
971
          else
972
            lAngleOffset := lHalfLineWidth;
973
          NormalizeVector(Inner);
974
          ScaleVector(Inner,lAngleOffset);
975
          Outer := VectorNegate(Inner);
976
          AddVector(Inner,N2);
977
          AddVector(Outer,N2);
978
          if not Flip then
979
            AddVertices(lUp,Inner, Outer,S,-Tan(lAngle)/2,True, LineItem)
980
          else
981
            AddVertices(lUp,Outer, Inner,S,Tan(lAngle)/2,True, LineItem);
982
        end;
983
        s:= s + VectorLength(seg2)/LineItem.TextureLength;
984
      end;
985

986
      //Create last vertices
987
      if (lCount > 0) and (i =  lCount) and not VectorEQuals(Seg2,NullVector) then
988
      begin
989
        lUp := Up.AsAffineVector;
990
        Inner := VectorCrossProduct(Seg2, lUp);
991
        NormalizeVector(Inner);
992
        ScaleVector(Inner,lHalfLineWidth);
993
        Outer := VectorNegate(Inner);
994
        AddVector(Inner,N3);
995
        AddVector(Outer,N3);
996
        AddVertices(lUp,Inner, Outer,S,0,False, LineItem);
997
      end;
998
      N1 := N2;
999
      N2 := N3;
1000
    end;
1001
  except
1002
    on e: Exception do
1003
      raise exception.Create(e.Message);
1004
  end;
1005
  if assigned(lSpline) then
1006
    lSpline.Free;
1007
end;
1008

1009

1010
initialization
1011
   RegisterClasses([TGLMeshLines]);
1012

1013
end.
1014