Luxophia

1
unit LUX.GPU.OpenGL.Shaper;
2

3
interface
4

5
uses
6
  System.UITypes,
7
  System.SysUtils,
8
  System.Classes,
9
  System.RegularExpressions,
10
  System.Generics.Collections,
11

12
  Winapi.OpenGL,
13
  Winapi.OpenGLext,
14
  LUX,
15
  LUX.D2,
16
  LUX.D3,
17
  LUX.M4,
18
  //LUX.D4x4,
19
  LUX.GPU.OpenGL,
20
  LUX.GPU.OpenGL.Atom.Buffer,
21
  LUX.GPU.OpenGL.Atom.Buffer.VerBuf,
22
  LUX.GPU.OpenGL.Atom.Buffer.EleBuf,
23
  LUX.GPU.OpenGL.Scener,
24
  LUX.GPU.OpenGL.Matery;
25

26
type
27

28
  TGLShaper = class;
29
  TGLShaperPoin = class;
30
  TGLShaperLine = class;
31
  TGLShaperFace = class;
32

33
  TGLShaper = class(TGLObject, IGLShaper)
34
  private
35
  protected
36
    _Matery: IGLMatery;
37
  public
38
    constructor Create; override;
39
    destructor Destroy; override;
40
    property Matery: IGLMatery read _Matery write _Matery;
41
    procedure BeginDraw; override;
42
    procedure EndDraw; override;
43
  end;
44

45
  TGLShaperZeroPoins = class(TGLShaper)
46
  private
47
  protected
48
    _PoinsN: Integer;
49
    function GetPoinsN: Integer;
50
    procedure SetPoinsN(const PoinsN_: Integer);
51
  public
52
    constructor Create; override;
53
    destructor Destroy; override;
54
    property PoinsN: Integer read GetPoinsN write SetPoinsN;
55
    procedure BeginDraw; override;
56
    procedure DrawMain; override;
57
    procedure EndDraw; override;
58
  end;
59

60
  TGLShaperZeroLines = class(TGLShaper)
61
  private
62
  protected
63
    _LinesN: Integer;
64
    function GetLinesN: Integer;
65
    procedure SetLinesN(const LinesN_: Integer);
66
  public
67
    constructor Create; override;
68
    destructor Destroy; override;
69
    property LinesN: Integer read GetLinesN write SetLinesN;
70
    procedure BeginDraw; override;
71
    procedure DrawMain; override;
72
    procedure EndDraw; override;
73
  end;
74

75
  TGLShaperZeroTrias = class(TGLShaper)
76
  private
77
  protected
78
    _TriasN: Integer;
79
    function GetTriasN: Integer;
80
    procedure SetTriasN(const TriasN_: Integer);
81
  public
82
    constructor Create; override;
83
    destructor Destroy; override;
84
    property TriasN: Integer read GetTriasN write SetTriasN;
85
    procedure BeginDraw; override;
86
    procedure DrawMain; override;
87
    procedure EndDraw; override;
88
  end;
89

90
  TGLShaperPoin = class(TGLShaper)
91
  private
92
  protected
93
    _PosBuf: TGLVerBufS<TSingle3D>;
94
    _NorBuf: TGLVerBufS<TSingle3D>;
95
    _TexBuf: TGLVerBufS<TSingle2D>;
96
  public
97
    constructor Create; override;
98
    destructor Destroy; override;
99
    property PosBuf: TGLVerBufS<TSingle3D> read _PosBuf;
100
    property NorBuf: TGLVerBufS<TSingle3D> read _NorBuf;
101
    property TexBuf: TGLVerBufS<TSingle2D> read _TexBuf;
102
    procedure BeginDraw; override;
103
    procedure DrawMain; override;
104
    procedure EndDraw; override;
105
    procedure CalcBouBox; override;
106
    procedure LoadFromFunc(const Func_: TConstFunc<TdSingle2D, TdSingle3D>;
107
      const DivU_, DivV_: Integer); virtual;
108
    procedure LoadFromFileSTL(const FileName_: String);
109
    procedure LoadFromFileOBJ(const FileName_: String);
110
  end;
111

112
  TGLShaperLine = class(TGLShaperPoin)
113
  private
114
  protected
115
    _EleBuf: TGLEleBufLine32;
116
    _LineW: Single;
117
  public
118
    constructor Create; override;
119
    destructor Destroy; override;
120
    property EleBuf: TGLEleBufLine32 read _EleBuf;
121
    property LineW: Single read _LineW write _LineW;
122
    procedure BeginDraw; override;
123
    procedure DrawMain; override;
124
    procedure EndDraw; override;
125
    procedure LoadFromFunc(const Func_: TConstFunc<TdSingle2D, TdSingle3D>;
126
      const DivU_, DivV_: Integer); override;
127
    procedure LoadFromFileSTL(const FileName_: String);
128
    procedure LoadFromFileOBJ(const FileName_: String);
129
  end;
130

131
  TGLShaperQuadLine = class(TGLShaperPoin)
132
  private
133
  protected
134
    _EleBuf: TGLEleBufQuadLines32;
135
    _LineW: Single;
136
  public
137
    constructor Create; override;
138
    destructor Destroy; override;
139
    property EleBuf: TGLEleBufQuadLines32 read _EleBuf;
140
    property LineW: Single read _LineW write _LineW;
141
    procedure BeginDraw; override;
142
    procedure DrawMain; override;
143
    procedure EndDraw; override;
144
  end;
145

146
  TGLShaperFace = class(TGLShaperPoin)
147
  private
148
  protected
149
    _EleBuf: TGLEleBufFace32;
150
  public
151
    constructor Create; override;
152
    destructor Destroy; override;
153
    property EleBuf: TGLEleBufFace32 read _EleBuf;
154
    procedure DrawMain; override;
155
    procedure LoadFromFunc(const Func_: TConstFunc<TdSingle2D, TdSingle3D>;
156
      const DivU_, DivV_: Integer); override;
157
    procedure LoadFromFileSTL(const FileName_: String);
158
    procedure LoadFromFileOBJ(const FileName_: String);
159
  end;
160

161
implementation
162
// ############################################################### ■
163

164
constructor TGLShaper.Create;
165
begin
166
  inherited;
167

168
  _HitTest := True;
169
end;
170

171
destructor TGLShaper.Destroy;
172
begin
173

174
  inherited;
175
end;
176

177
/// //////////////////////////////////////////////////////////////////// メソッド
178

179
procedure TGLShaper.BeginDraw;
180
begin
181
  inherited;
182

183
  if Assigned(_Matery) then
184
    _Matery.Use;
185
end;
186

187
procedure TGLShaper.EndDraw;
188
begin
189
  if Assigned(_Matery) then
190
    _Matery.Unuse;
191

192
  inherited;
193
end;
194

195
// %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLShaperZeroPoins
196

197
// &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
198

199
// &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
200

201
/// //////////////////////////////////////////////////////////////////// アクセス
202

203
function TGLShaperZeroPoins.GetPoinsN: Integer;
204
begin
205
  Result := _PoinsN;
206
end;
207

208
procedure TGLShaperZeroPoins.SetPoinsN(const PoinsN_: Integer);
209
begin
210
  _PoinsN := PoinsN_;
211
end;
212

213
// &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
214

215
constructor TGLShaperZeroPoins.Create;
216
begin
217
  inherited;
218

219
  _PoinsN := 0;
220
end;
221

222
destructor TGLShaperZeroPoins.Destroy;
223
begin
224

225
  inherited;
226
end;
227

228
/// //////////////////////////////////////////////////////////////////// メソッド
229

230
procedure TGLShaperZeroPoins.BeginDraw;
231
begin
232
  inherited;
233

234
end;
235

236
procedure TGLShaperZeroPoins.DrawMain;
237
begin
238
  glDrawArrays(GL_POINTS, 0, _PoinsN);
239
end;
240

241
procedure TGLShaperZeroPoins.EndDraw;
242
begin
243

244
  inherited;
245
end;
246

247
// %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLShaperZeroLines
248

249
// &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
250

251
// &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
252

253
/// //////////////////////////////////////////////////////////////////// アクセス
254

255
function TGLShaperZeroLines.GetLinesN: Integer;
256
begin
257
  Result := _LinesN;
258
end;
259

260
procedure TGLShaperZeroLines.SetLinesN(const LinesN_: Integer);
261
begin
262
  _LinesN := LinesN_;
263
end;
264

265
// &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
266

267
constructor TGLShaperZeroLines.Create;
268
begin
269
  inherited;
270

271
  _LinesN := 0;
272
end;
273

274
destructor TGLShaperZeroLines.Destroy;
275
begin
276

277
  inherited;
278
end;
279

280
/// //////////////////////////////////////////////////////////////////// メソッド
281

282
procedure TGLShaperZeroLines.BeginDraw;
283
begin
284
  inherited;
285

286
end;
287

288
procedure TGLShaperZeroLines.DrawMain;
289
begin
290
  glDrawArrays(GL_LINES, 0, _LinesN);
291
end;
292

293
procedure TGLShaperZeroLines.EndDraw;
294
begin
295

296
  inherited;
297
end;
298

299
// %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLShaperZeroTrias
300

301
// &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
302

303
// &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
304

305
/// //////////////////////////////////////////////////////////////////// アクセス
306

307
function TGLShaperZeroTrias.GetTriasN: Integer;
308
begin
309
  Result := _TriasN;
310
end;
311

312
procedure TGLShaperZeroTrias.SetTriasN(const TriasN_: Integer);
313
begin
314
  _TriasN := TriasN_;
315
end;
316

317
// &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
318

319
constructor TGLShaperZeroTrias.Create;
320
begin
321
  inherited;
322

323
  _TriasN := 0;
324
end;
325

326
destructor TGLShaperZeroTrias.Destroy;
327
begin
328

329
  inherited;
330
end;
331

332
/// //////////////////////////////////////////////////////////////////// メソッド
333

334
procedure TGLShaperZeroTrias.BeginDraw;
335
begin
336
  inherited;
337

338
end;
339

340
procedure TGLShaperZeroTrias.DrawMain;
341
begin
342
  glDrawArrays(GL_TRIANGLES, 0, _TriasN);
343
end;
344

345
procedure TGLShaperZeroTrias.EndDraw;
346
begin
347

348
  inherited;
349
end;
350

351
// %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLShaperPoin
352

353
// &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
354

355
// &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
356

357
// &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
358

359
constructor TGLShaperPoin.Create;
360
begin
361
  inherited;
362

363
  _PosBuf := TGLVerBufS<TSingle3D>.Create(GL_STATIC_DRAW);
364
  _NorBuf := TGLVerBufS<TSingle3D>.Create(GL_STATIC_DRAW);
365
  _TexBuf := TGLVerBufS<TSingle2D>.Create(GL_STATIC_DRAW);
366
end;
367

368
destructor TGLShaperPoin.Destroy;
369
begin
370
  _PosBuf.Free;
371
  _NorBuf.Free;
372
  _TexBuf.Free;
373

374
  inherited;
375
end;
376

377
/// //////////////////////////////////////////////////////////////////// メソッド
378

379
procedure TGLShaperPoin.BeginDraw;
380
begin
381
  inherited;
382

383
  _PosBuf.Use(0 { BinP } );
384
  _NorBuf.Use(1 { BinP } );
385
  _TexBuf.Use(2 { BinP } );
386
end;
387

388
procedure TGLShaperPoin.DrawMain;
389
begin
390
  glDrawArrays(GL_POINTS, 0, _PosBuf.Count);
391
end;
392

393
procedure TGLShaperPoin.EndDraw;
394
begin
395
  _PosBuf.Unuse(0 { BinP } );
396
  _NorBuf.Unuse(1 { BinP } );
397
  _TexBuf.Unuse(2 { BinP } );
398

399
  inherited;
400
end;
401

402
// ------------------------------------------------------------------------------
403

404
procedure TGLShaperPoin.CalcBouBox;
405
var
406
  B: TSingleArea3D;
407
  I: Integer;
408
begin
409
  inherited;
410

411
  B := TSingleArea3D.NeMax;
412

413
  with _PosBuf.Map(GL_READ_ONLY) do
414
  begin
415
    for I := 0 to Count - 1 do
416
    begin
417
      with Items[I] do
418
      begin
419
        if X < B.Min.X then
420
          B.Min.X := X;
421
        if B.Max.X < X then
422
          B.Max.X := X;
423

424
        if Y < B.Min.Y then
425
          B.Min.Y := Y;
426
        if B.Max.Y < Y then
427
          B.Max.Y := Y;
428

429
        if Z < B.Min.Z then
430
          B.Min.Z := Z;
431
        if B.Max.Z < Z then
432
          B.Max.Z := Z;
433
      end;
434
    end;
435

436
    Free;
437
  end;
438

439
  _Inform.BouBox := B;
440
end;
441

442
// ------------------------------------------------------------------------------
443

444
procedure TGLShaperPoin.LoadFromFunc(const Func_
445
  : TConstFunc<TdSingle2D, TdSingle3D>; const DivU_, DivV_: Integer);
446
// ··································
447
  function XYtoI(const X_, Y_: Integer): Integer;
448
  begin
449
    Result := (DivU_ + 1) * Y_ + X_;
450
  end;
451

452
// ··································
453
var
454
  C, X, Y, I: Integer;
455
  Ps, Ns: TGLBufferData<TSingle3D>;
456
  Ts: TGLBufferData<TSingle2D>;
457
  T: TSingle2D;
458
  M: TSingleM4;
459
begin
460
  C := (DivV_ + 1) * (DivU_ + 1);
461

462
  _PosBuf.Count := C;
463
  _NorBuf.Count := C;
464
  _TexBuf.Count := C;
465

466
  Ps := _PosBuf.Map(GL_WRITE_ONLY);
467
  Ns := _NorBuf.Map(GL_WRITE_ONLY);
468
  Ts := _TexBuf.Map(GL_WRITE_ONLY);
469

470
  for Y := 0 to DivV_ do
471
  begin
472
    T.V := Y / DivV_;
473
    for X := 0 to DivU_ do
474
    begin
475
      T.U := X / DivU_;
476

477
      I := XYtoI(X, Y);
478

479
      Ts[I] := T;
480

481
      M := Tensor(T, Func_);
482

483
      Ps[I] := M.AxisP;
484
      Ns[I] := M.AxisZ;
485
    end;
486
  end;
487

488
  Ps.Free;
489
  Ns.Free;
490
  Ts.Free;
491

492
  CalcBouBox;
493
end;
494

495
// ------------------------------------------------------------------------------
496

497
procedure TGLShaperPoin.LoadFromFileSTL(const FileName_: String);
498
var
499
  F: TFileStream;
500
  Hs: array [0 .. 80 - 1] of AnsiChar;
501
  FsN, I: Cardinal;
502
  Fs: array of packed record Nor: TSingle3D;
503
  Pos1: TSingle3D;
504
  Pos2: TSingle3D;
505
  Pos3: TSingle3D;
506
  _: Word;
507
end;
508
Ps, Ns: TGLBufferData<TSingle3D>;
509
E:
510
TCardinal3D;
511
begin
512
  F := TFileStream.Create(FileName_, fmOpenRead);
513
  try
514
    F.Read(Hs, SizeOf(Hs));
515

516
    F.Read(FsN, SizeOf(FsN));
517

518
    SetLength(Fs, FsN);
519

520
    F.Read(Fs[0], 50 * FsN);
521
  finally
522
    F.Free;
523
  end;
524

525
  _PosBuf.Count := 3 * FsN;
526
  _NorBuf.Count := 3 * FsN;
527

528
  Ps := _PosBuf.Map(GL_WRITE_ONLY);
529
  Ns := _NorBuf.Map(GL_WRITE_ONLY);
530

531
  E.X := 0;
532
  E.Y := 1;
533
  E.Z := 2;
534
  for I := 0 to FsN - 1 do
535
  begin
536
    with Fs[I] do
537
    begin
538
      Ps[E.X] := Pos1;
539
      Ps[E.Y] := Pos2;
540
      Ps[E.Z] := Pos3;
541

542
      Ns[E.X] := Nor;
543
      Ns[E.Y] := Nor;
544
      Ns[E.Z] := Nor;
545
    end;
546

547
    Inc(E.X, 3);
548
    Inc(E.Y, 3);
549
    Inc(E.Z, 3);
550
  end;
551

552
  Ps.Free;
553
  Ns.Free;
554

555
  CalcBouBox;
556
end;
557

558
// ------------------------------------------------------------------------------
559

560
procedure TGLShaperPoin.LoadFromFileOBJ(const FileName_: String);
561
type
562
  TVert = record
563
    P: Integer;
564
    N: Integer;
565
    T: Integer;
566
  end;
567
var
568
  Vs: TDictionary<TVert, Integer>;
569
  // ·····································
570
  function ReadVert(const M_: TMatch): Cardinal;
571
  var
572
    V: TVert;
573
  begin
574
    with V do
575
    begin
576
      P := StrToIntDef(M_.Groups[1].Value, 0) - 1;
577
      T := StrToIntDef(M_.Groups[2].Value, 0) - 1;
578
      N := StrToIntDef(M_.Groups[3].Value, 0) - 1;
579
    end;
580

581
    if Vs.ContainsKey(V) then
582
      Result := Vs[V]
583
    else
584
    begin
585
      Result := Vs.Count;
586
      Vs.Add(V, Result);
587
    end;
588
  end;
589

590
// ·····································
591
var
592
  F: TStreamReader;
593
  RV, RN, RT, RF, RI: TRegEx;
594
  Ps, Ns: TArray<TSingle3D>;
595
  Ts: TArray<TSingle2D>;
596
  L: String;
597
   P, N: TSingle3D;
598
  T: TSingle2D;
599
  Ms: TMatchCollection;
600
  K: Integer;
601
  V: TPair<TVert, Integer>;
602
begin
603
  Vs := TDictionary<TVert, Integer>.Create;
604

605
  F := TStreamReader.Create(FileName_, TEncoding.Default);
606
  try
607
    RV := TRegEx.Create('v[ \t]+([^ \t]+)[ \t]+([^ \t]+)[ \t]+([^ \t\n]+)');
608
    RN := TRegEx.Create('vn[ \t]+([^ \t]+)[ \t]+([^ \t]+)[ \t]+([^ \t\n]+)');
609
    RT := TRegEx.Create('vt[ \t]+([^ \t]+)[ \t]+([^ \t]+)');
610
    RF := TRegEx.Create('f( [^\n]+)');
611
    RI := TRegEx.Create('[ \t]+(\d+)/?(\d*)/?(\d*)');
612

613
    Ps := [];
614
    Ns := [];
615
    Ts := [];
616
    while not F.EndOfStream do
617
    begin
618
      L := F.ReadLine;
619

620
      with RV.Match(L) do
621
      begin
622
        if Success then
623
        begin
624
          P.X := Groups[1].Value.ToSingle;
625
          P.Y := Groups[2].Value.ToSingle;
626
          P.Z := Groups[3].Value.ToSingle;
627

628
          Ps := Ps + [P];
629
        end;
630
      end;
631

632
      with RN.Match(L) do
633
      begin
634
        if Success then
635
        begin
636
          N.X := Groups[1].Value.ToSingle;
637
          N.Y := Groups[2].Value.ToSingle;
638
          N.Z := Groups[3].Value.ToSingle;
639

640
          Ns := Ns + [N];
641
        end;
642
      end;
643

644
      with RT.Match(L) do
645
      begin
646
        if Success then
647
        begin
648
          T.X := Groups[1].Value.ToSingle;
649
          T.Y := Groups[2].Value.ToSingle;
650

651
          Ts := Ts + [T];
652
        end;
653
      end;
654

655
      with RF.Match(L) do
656
      begin
657
        if Success then
658
        begin
659
          Ms := RI.Matches(Groups[1].Value);
660

661
          for K := 0 to Ms.Count - 1 do
662
            ReadVert(Ms[K]);
663
        end;
664
      end;
665
    end;
666
  finally
667
    F.Free;
668
  end;
669

670
  if Length(Ps) > 0 then
671
  begin
672
    with _PosBuf do
673
    begin
674
      Count := Vs.Count;
675

676
      with Map(GL_WRITE_ONLY) do
677
      begin
678
        for V in Vs do
679
          Items[V.Value] := Ps[V.Key.P];
680

681
        Free;
682
      end;
683
    end;
684
  end;
685

686
  if Length(Ns) > 0 then
687
  begin
688
    with _NorBuf do
689
    begin
690
      Count := Vs.Count;
691

692
      with Map(GL_WRITE_ONLY) do
693
      begin
694
        for V in Vs do
695
          Items[V.Value] := Ns[V.Key.N];
696

697
        Free;
698
      end;
699
    end;
700
  end;
701

702
  if Length(Ts) > 0 then
703
  begin
704
    with _TexBuf do
705
    begin
706
      Count := Vs.Count;
707

708
      with Map(GL_WRITE_ONLY) do
709
      begin
710
        for V in Vs do
711
          Items[V.Value] := Ts[V.Key.T];
712

713
        Free;
714
      end;
715
    end;
716
  end;
717

718
  Vs.Free;
719

720
  CalcBouBox;
721
end;
722

723
// %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLShaperLine
724

725
// &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
726

727
// &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
728

729
// &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
730

731
constructor TGLShaperLine.Create;
732
begin
733
  inherited;
734

735
  _EleBuf := TGLEleBufLine32.Create(GL_STATIC_DRAW);
736

737
  _LineW := 1;
738
end;
739

740
destructor TGLShaperLine.Destroy;
741
begin
742
  _EleBuf.Free;
743

744
  inherited;
745
end;
746

747
/// //////////////////////////////////////////////////////////////////// メソッド
748

749
procedure TGLShaperLine.BeginDraw;
750
begin
751
  inherited;
752

753
  glLineWidth(_LineW);
754
end;
755

756
procedure TGLShaperLine.DrawMain;
757
begin
758
  _EleBuf.Draw;
759
end;
760

761
procedure TGLShaperLine.EndDraw;
762
begin
763

764
  inherited;
765
end;
766

767
// ------------------------------------------------------------------------------
768

769
procedure TGLShaperLine.LoadFromFunc(const Func_
770
  : TConstFunc<TdSingle2D, TdSingle3D>; const DivU_, DivV_: Integer);
771
// ··································
772
  function XYtoI(const X_, Y_: Integer): Integer;
773
  begin
774
    Result := (DivU_ + 1) * Y_ + X_;
775
  end;
776

777
// ··································
778
var
779
  Es: TGLBufferData<TCardinal2D>;
780
  X, Y, I, I0, I1: Integer;
781
begin
782
  inherited;
783

784
  _EleBuf.Count := DivV_ * (DivU_ + 1) + (DivV_ + 1) * DivU_;
785

786
  Es := _EleBuf.Map(GL_WRITE_ONLY);
787

788
  I := 0;
789

790
  for Y := 0 to DivV_ do
791
  begin
792
    for X := 0 to DivU_ - 1 do
793
    begin
794
      I0 := XYtoI(X + 0, Y);
795
      I1 := XYtoI(X + 1, Y);
796

797
      Es[I] := TCardinal2D.Create(I0, I1);
798
      Inc(I);
799
    end;
800
  end;
801

802
  for X := 0 to DivU_ do
803
  begin
804
    for Y := 0 to DivV_ - 1 do
805
    begin
806
      I0 := XYtoI(X, Y + 0);
807
      I1 := XYtoI(X, Y + 1);
808

809
      Es[I] := TCardinal2D.Create(I0, I1);
810
      Inc(I);
811
    end;
812
  end;
813

814
  Es.Free;
815
end;
816

817
// ------------------------------------------------------------------------------
818

819
procedure TGLShaperLine.LoadFromFileSTL(const FileName_: String);
820
var
821
  F: TFileStream;
822
  Hs: array [0 .. 80 - 1] of AnsiChar;
823
  FsN, I: Cardinal;
824
  Fs: array of packed record Nor: TSingle3D;
825
  Pos1: TSingle3D;
826
  Pos2: TSingle3D;
827
  Pos3: TSingle3D;
828
  _: Word;
829
end;
830
Ps, Ns: TGLBufferData<TSingle3D>;
831
Es:
832
TGLBufferData<TCardinal2D>;
833
E:
834
TCardinal3D;
835
begin
836
  F := TFileStream.Create(FileName_, fmOpenRead);
837
  try
838
    F.Read(Hs, SizeOf(Hs));
839

840
    F.Read(FsN, SizeOf(FsN));
841

842
    SetLength(Fs, FsN);
843

844
    F.Read(Fs[0], 50 * FsN);
845
  finally
846
    F.Free;
847
  end;
848

849
  _PosBuf.Count := 3 * FsN;
850
  _NorBuf.Count := 3 * FsN;
851
  _EleBuf.Count := 3 * FsN;
852

853
  Ps := _PosBuf.Map(GL_WRITE_ONLY);
854
  Ns := _NorBuf.Map(GL_WRITE_ONLY);
855
  Es := _EleBuf.Map(GL_WRITE_ONLY);
856

857
  E.X := 0;
858
  E.Y := 1;
859
  E.Z := 2;
860
  for I := 0 to FsN - 1 do
861
  begin
862
    with Fs[I] do
863
    begin
864
      Ps[E.X] := Pos1;
865
      Ps[E.Y] := Pos2;
866
      Ps[E.Z] := Pos3;
867

868
      Ns[E.X] := Nor;
869
      Ns[E.Y] := Nor;
870
      Ns[E.Z] := Nor;
871
    end;
872

873
    Es[I * 3 + 0] := TCardinal2D.Create(E.X, E.Y);
874
    Es[I * 3 + 1] := TCardinal2D.Create(E.Y, E.Z);
875
    Es[I * 3 + 2] := TCardinal2D.Create(E.Z, E.X);
876

877
    Inc(E.X, 3);
878
    Inc(E.Y, 3);
879
    Inc(E.Z, 3);
880
  end;
881

882
  Ps.Free;
883
  Ns.Free;
884
  Es.Free;
885

886
  CalcBouBox;
887
end;
888

889
// ------------------------------------------------------------------------------
890

891
procedure TGLShaperLine.LoadFromFileOBJ(const FileName_: String);
892
type
893
  TVert = record
894
    P: Integer;
895
    N: Integer;
896
    T: Integer;
897
  end;
898
var
899
  Vs: TDictionary<TVert, Integer>;
900
  // ·····································
901
  function ReadVert(const M_: TMatch): Cardinal;
902
  var
903
    V: TVert;
904
  begin
905
    with V do
906
    begin
907
      P := StrToIntDef(M_.Groups[1].Value, 0) - 1;
908
      T := StrToIntDef(M_.Groups[2].Value, 0) - 1;
909
      N := StrToIntDef(M_.Groups[3].Value, 0) - 1;
910
    end;
911

912
    if Vs.ContainsKey(V) then
913
      Result := Vs[V]
914
    else
915
    begin
916
      Result := Vs.Count;
917
      Vs.Add(V, Result);
918
    end;
919
  end;
920

921
// ·····································
922
var
923
  F: TStreamReader;
924
  RV, RN, RT, RF, RI: TRegEx;
925
  Ps, Ns: TArray<TSingle3D>;
926
  Ts: TArray<TSingle2D>;
927
  L: String;
928
   P, N: TSingle3D;
929
  T: TSingle2D;
930
  Es: TArray<TCardinal2D>;
931
  Ms: TMatchCollection;
932
  E: TCardinal2D;
933
  K: Integer;
934
  V: TPair<TVert, Integer>;
935
begin
936
  Vs := TDictionary<TVert, Integer>.Create;
937

938
  F := TStreamReader.Create(FileName_, TEncoding.Default);
939
  try
940
    RV := TRegEx.Create('v[ \t]+([^ \t]+)[ \t]+([^ \t]+)[ \t]+([^ \t\n]+)');
941
    RN := TRegEx.Create('vn[ \t]+([^ \t]+)[ \t]+([^ \t]+)[ \t]+([^ \t\n]+)');
942
    RT := TRegEx.Create('vt[ \t]+([^ \t]+)[ \t]+([^ \t]+)');
943
    RF := TRegEx.Create('f( [^\n]+)');
944
    RI := TRegEx.Create('[ \t]+(\d+)/?(\d*)/?(\d*)');
945

946
    Ps := [];
947
    Ns := [];
948
    Ts := [];
949
    Es := [];
950
    while not F.EndOfStream do
951
    begin
952
      L := F.ReadLine;
953

954
      with RV.Match(L) do
955
      begin
956
        if Success then
957
        begin
958
          P.X := Groups[1].Value.ToSingle;
959
          P.Y := Groups[2].Value.ToSingle;
960
          P.Z := Groups[3].Value.ToSingle;
961

962
          Ps := Ps + [P];
963
        end;
964
      end;
965

966
      with RN.Match(L) do
967
      begin
968
        if Success then
969
        begin
970
          N.X := Groups[1].Value.ToSingle;
971
          N.Y := Groups[2].Value.ToSingle;
972
          N.Z := Groups[3].Value.ToSingle;
973

974
          Ns := Ns + [N];
975
        end;
976
      end;
977

978
      with RT.Match(L) do
979
      begin
980
        if Success then
981
        begin
982
          T.X := Groups[1].Value.ToSingle;
983
          T.Y := Groups[2].Value.ToSingle;
984

985
          Ts := Ts + [T];
986
        end;
987
      end;
988

989
      with RF.Match(L) do
990
      begin
991
        if Success then
992
        begin
993
          Ms := RI.Matches(Groups[1].Value);
994

995
          E.X := ReadVert(Ms[0]);
996
          E.Y := ReadVert(Ms[1]);
997

998
          Es := Es + [E];
999

1000
          for K := 2 to Ms.Count - 1 do
1001
          begin
1002
            E.X := E.Y;
1003
            E.Y := ReadVert(Ms[K]);
1004

1005
            Es := Es + [E];
1006
          end;
1007
        end;
1008
      end;
1009
    end;
1010
  finally
1011
    F.Free;
1012
  end;
1013

1014
  if Length(Ps) > 0 then
1015
  begin
1016
    with _PosBuf do
1017
    begin
1018
      Count := Vs.Count;
1019

1020
      with Map(GL_WRITE_ONLY) do
1021
      begin
1022
        for V in Vs do
1023
          Items[V.Value] := Ps[V.Key.P];
1024

1025
        Free;
1026
      end;
1027
    end;
1028
  end;
1029

1030
  if Length(Ns) > 0 then
1031
  begin
1032
    with _NorBuf do
1033
    begin
1034
      Count := Vs.Count;
1035

1036
      with Map(GL_WRITE_ONLY) do
1037
      begin
1038
        for V in Vs do
1039
          Items[V.Value] := Ns[V.Key.N];
1040

1041
        Free;
1042
      end;
1043
    end;
1044
  end;
1045

1046
  if Length(Ts) > 0 then
1047
  begin
1048
    with _TexBuf do
1049
    begin
1050
      Count := Vs.Count;
1051

1052
      with Map(GL_WRITE_ONLY) do
1053
      begin
1054
        for V in Vs do
1055
          Items[V.Value] := Ts[V.Key.T];
1056

1057
        Free;
1058
      end;
1059
    end;
1060
  end;
1061

1062
  Vs.Free;
1063

1064
  _EleBuf.CopyFrom(Es);
1065

1066
  CalcBouBox;
1067
end;
1068

1069
// %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLShaperLine
1070

1071
// &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
1072

1073
// &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
1074

1075
// &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
1076

1077
constructor TGLShaperQuadLine.Create;
1078
begin
1079
  inherited;
1080

1081
  _EleBuf := TGLEleBufQuadLines32.Create(GL_STATIC_DRAW);
1082

1083
  _LineW := 1;
1084
end;
1085

1086
destructor TGLShaperQuadLine.Destroy;
1087
begin
1088
  _EleBuf.Free;
1089

1090
  inherited;
1091
end;
1092

1093
/// //////////////////////////////////////////////////////////////////// メソッド
1094

1095
procedure TGLShaperQuadLine.BeginDraw;
1096
begin
1097
  inherited;
1098

1099
  glLineWidth(_LineW);
1100
end;
1101

1102
procedure TGLShaperQuadLine.DrawMain;
1103
begin
1104
  _EleBuf.Draw;
1105
end;
1106

1107
procedure TGLShaperQuadLine.EndDraw;
1108
begin
1109

1110
  inherited;
1111
end;
1112

1113
// %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% TGLShaperFace
1114

1115
// &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& private
1116

1117
// &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& protected
1118

1119
// &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& public
1120

1121
constructor TGLShaperFace.Create;
1122
begin
1123
  inherited;
1124

1125
  _EleBuf := TGLEleBufFace32.Create(GL_STATIC_DRAW);
1126
end;
1127

1128
destructor TGLShaperFace.Destroy;
1129
begin
1130
  _EleBuf.Free;
1131

1132
  inherited;
1133
end;
1134

1135
/// //////////////////////////////////////////////////////////////////// メソッド
1136

1137
procedure TGLShaperFace.DrawMain;
1138
begin
1139
  _EleBuf.Draw;
1140
end;
1141

1142
// ------------------------------------------------------------------------------
1143

1144
procedure TGLShaperFace.LoadFromFunc(const Func_
1145
  : TConstFunc<TdSingle2D, TdSingle3D>; const DivU_, DivV_: Integer);
1146
// ··································
1147
  function XYtoI(const X_, Y_: Integer): Integer;
1148
  begin
1149
    Result := (DivU_ + 1) * Y_ + X_;
1150
  end;
1151

1152
// ··································
1153
var
1154
  Es: TGLBufferData<TCardinal3D>;
1155
  X0, Y0, X1, Y1, I, I00, I01, I10, I11: Integer;
1156
begin
1157
  inherited;
1158

1159
  _EleBuf.Count := 2 * DivV_ * DivU_;
1160

1161
  Es := _EleBuf.Map(GL_WRITE_ONLY);
1162

1163
  I := 0;
1164
  for Y0 := 0 to DivV_ - 1 do
1165
  begin
1166
    Y1 := Y0 + 1;
1167
    for X0 := 0 to DivU_ - 1 do
1168
    begin
1169
      X1 := X0 + 1;
1170

1171
      I00 := XYtoI(X0, Y0);
1172
      I01 := XYtoI(X1, Y0);
1173
      I10 := XYtoI(X0, Y1);
1174
      I11 := XYtoI(X1, Y1);
1175

1176
      // 00───01
1177
      // │      │
1178
      // │      │
1179
      // │      │
1180
      // 10───11
1181

1182
      Es[I] := TCardinal3D.Create(I00, I10, I11);
1183
      Inc(I);
1184
      Es[I] := TCardinal3D.Create(I11, I01, I00);
1185
      Inc(I);
1186
    end;
1187
  end;
1188

1189
  Es.Free;
1190
end;
1191

1192
// ------------------------------------------------------------------------------
1193

1194
procedure TGLShaperFace.LoadFromFileSTL(const FileName_: String);
1195
var
1196
  F: TFileStream;
1197
  Hs: array [0 .. 80 - 1] of AnsiChar;
1198
  FsN, I: Cardinal;
1199
  Fs: array of packed record Nor: TSingle3D;
1200
  Pos1: TSingle3D;
1201
  Pos2: TSingle3D;
1202
  Pos3: TSingle3D;
1203
  _: Word;
1204
end;
1205
Ps, Ns: TGLBufferData<TSingle3D>;
1206
Es:
1207
TGLBufferData<TCardinal3D>;
1208
E:
1209
TCardinal3D;
1210
begin
1211
  F := TFileStream.Create(FileName_, fmOpenRead);
1212
  try
1213
    F.Read(Hs, SizeOf(Hs));
1214

1215
    F.Read(FsN, SizeOf(FsN));
1216

1217
    SetLength(Fs, FsN);
1218

1219
    F.Read(Fs[0], 50 * FsN);
1220
  finally
1221
    F.Free;
1222
  end;
1223

1224
  _PosBuf.Count := 3 * FsN;
1225
  _NorBuf.Count := 3 * FsN;
1226
  _EleBuf.Count := FsN;
1227

1228
  Ps := _PosBuf.Map(GL_WRITE_ONLY);
1229
  Ns := _NorBuf.Map(GL_WRITE_ONLY);
1230
  Es := _EleBuf.Map(GL_WRITE_ONLY);
1231

1232
  E.X := 0;
1233
  E.Y := 1;
1234
  E.Z := 2;
1235
  for I := 0 to FsN - 1 do
1236
  begin
1237
    with Fs[I] do
1238
    begin
1239
      Ps[E.X] := Pos1;
1240
      Ps[E.Y] := Pos2;
1241
      Ps[E.Z] := Pos3;
1242

1243
      Ns[E.X] := Nor;
1244
      Ns[E.Y] := Nor;
1245
      Ns[E.Z] := Nor;
1246
    end;
1247

1248
    Es[I] := E;
1249

1250
    Inc(E.X, 3);
1251
    Inc(E.Y, 3);
1252
    Inc(E.Z, 3);
1253
  end;
1254

1255
  Ps.Free;
1256
  Ns.Free;
1257
  Es.Free;
1258

1259
  CalcBouBox;
1260
end;
1261

1262
// ------------------------------------------------------------------------------
1263

1264
procedure TGLShaperFace.LoadFromFileOBJ(const FileName_: String);
1265
type
1266
  TVert = record
1267
    P: Integer;
1268
    N: Integer;
1269
    T: Integer;
1270
  end;
1271
var
1272
  Vs: TDictionary<TVert, Integer>;
1273
  // ·····································
1274
  function ReadVert(const M_: TMatch): Cardinal;
1275
  var
1276
    V: TVert;
1277
  begin
1278
    with V do
1279
    begin
1280
      P := StrToIntDef(M_.Groups[1].Value, 0) - 1;
1281
      T := StrToIntDef(M_.Groups[2].Value, 0) - 1;
1282
      N := StrToIntDef(M_.Groups[3].Value, 0) - 1;
1283
    end;
1284

1285
    if Vs.ContainsKey(V) then
1286
      Result := Vs[V]
1287
    else
1288
    begin
1289
      Result := Vs.Count;
1290
      Vs.Add(V, Result);
1291
    end;
1292
  end;
1293

1294
// ·····································
1295
var
1296
  F: TStreamReader;
1297
  RV, RN, RT, RF, RI: TRegEx;
1298
  Ps, Ns: TArray<TSingle3D>;
1299
  Ts: TArray<TSingle2D>;
1300
  L: String;
1301
   P, N: TSingle3D;
1302
  T: TSingle2D;
1303
  Es: TArray<TCardinal3D>;
1304
  Ms: TMatchCollection;
1305
  E: TCardinal3D;
1306
  K: Integer;
1307
  V: TPair<TVert, Integer>;
1308
begin
1309
  Vs := TDictionary<TVert, Integer>.Create;
1310

1311
  F := TStreamReader.Create(FileName_, TEncoding.Default);
1312
  try
1313
    RV := TRegEx.Create('v[ \t]+([^ \t]+)[ \t]+([^ \t]+)[ \t]+([^ \t\n]+)');
1314
    RN := TRegEx.Create('vn[ \t]+([^ \t]+)[ \t]+([^ \t]+)[ \t]+([^ \t\n]+)');
1315
    RT := TRegEx.Create('vt[ \t]+([^ \t]+)[ \t]+([^ \t]+)');
1316
    RF := TRegEx.Create('f( [^\n]+)');
1317
    RI := TRegEx.Create('[ \t]+(\d+)/?(\d*)/?(\d*)');
1318

1319
    Ps := [];
1320
    Ns := [];
1321
    Ts := [];
1322
    Es := [];
1323
    while not F.EndOfStream do
1324
    begin
1325
      L := F.ReadLine;
1326

1327
      with RV.Match(L) do
1328
      begin
1329
        if Success then
1330
        begin
1331
          P.X := Groups[1].Value.ToSingle;
1332
          P.Y := Groups[2].Value.ToSingle;
1333
          P.Z := Groups[3].Value.ToSingle;
1334

1335
          Ps := Ps + [P];
1336
        end;
1337
      end;
1338

1339
      with RN.Match(L) do
1340
      begin
1341
        if Success then
1342
        begin
1343
          N.X := Groups[1].Value.ToSingle;
1344
          N.Y := Groups[2].Value.ToSingle;
1345
          N.Z := Groups[3].Value.ToSingle;
1346

1347
          Ns := Ns + [N];
1348
        end;
1349
      end;
1350

1351
      with RT.Match(L) do
1352
      begin
1353
        if Success then
1354
        begin
1355
          T.X := Groups[1].Value.ToSingle;
1356
          T.Y := Groups[2].Value.ToSingle;
1357

1358
          Ts := Ts + [T];
1359
        end;
1360
      end;
1361

1362
      with RF.Match(L) do
1363
      begin
1364
        if Success then
1365
        begin
1366
          Ms := RI.Matches(Groups[1].Value);
1367

1368
          E.X := ReadVert(Ms[0]);
1369
          E.Y := ReadVert(Ms[1]);
1370
          E.Z := ReadVert(Ms[2]);
1371

1372
          Es := Es + [E];
1373

1374
          for K := 3 to Ms.Count - 1 do
1375
          begin
1376
            E.Y := E.Z;
1377
            E.Z := ReadVert(Ms[K]);
1378

1379
            Es := Es + [E];
1380
          end;
1381
        end;
1382
      end;
1383
    end;
1384
  finally
1385
    F.Free;
1386
  end;
1387

1388
  if Length(Ps) > 0 then
1389
  begin
1390
    with _PosBuf do
1391
    begin
1392
      Count := Vs.Count;
1393

1394
      with Map(GL_WRITE_ONLY) do
1395
      begin
1396
        for V in Vs do
1397
          Items[V.Value] := Ps[V.Key.P];
1398

1399
        Free;
1400
      end;
1401
    end;
1402
  end;
1403

1404
  if Length(Ns) > 0 then
1405
  begin
1406
    with _NorBuf do
1407
    begin
1408
      Count := Vs.Count;
1409

1410
      with Map(GL_WRITE_ONLY) do
1411
      begin
1412
        for V in Vs do
1413
          Items[V.Value] := Ns[V.Key.N];
1414

1415
        Free;
1416
      end;
1417
    end;
1418
  end;
1419

1420
  if Length(Ts) > 0 then
1421
  begin
1422
    with _TexBuf do
1423
    begin
1424
      Count := Vs.Count;
1425

1426
      with Map(GL_WRITE_ONLY) do
1427
      begin
1428
        for V in Vs do
1429
          Items[V.Value] := Ts[V.Key.T];
1430

1431
        Free;
1432
      end;
1433
    end;
1434
  end;
1435

1436
  Vs.Free;
1437

1438
  _EleBuf.CopyFrom(Es);
1439

1440
  CalcBouBox;
1441
end;
1442

1443
// $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$【ルーチン】
1444

1445
// ############################################################################## □
1446

1447
initialization // $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 初期化
1448

1449
finalization // $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ 最終化
1450

1451
end. // ######################################################################### ■
1452