MathgeomGLS

1
unit fMeshEllips;
2

3
interface
4

5
uses
6
  Winapi.OpenGL,
7

8
  Winapi.Windows,
9
  Winapi.Messages,
10
  System.SysUtils,
11
  System.Variants,
12
  System.Classes,
13
  System.Math,
14
  Vcl.Graphics,
15
  Vcl.Controls,
16
  Vcl.Forms,
17
  Vcl.Dialogs,
18
  Vcl.ComCtrls,
19
  Vcl.ExtCtrls,
20
  Vcl.Imaging.Jpeg,
21
  Vcl.StdCtrls,
22

23
  GLS.OpenGLTokens,
24
  GLS.SceneViewer,
25
  GLS.BaseClasses,
26
  GLS.Scene,
27
  GLS.Objects,
28
  GLS.Coordinates,
29
  GLS.State,
30
  GLS.Graph,
31
  GLS.GeomObjects,
32
  GLS.Mesh,
33
  GLS.HUDObjects,
34
  GLS.BitmapFont,
35
  GLS.WindowsFont,
36
  GLS.VectorGeometry,
37
  GLS.VectorTypes,
38
  GLS.Color,
39
  GLS.Texture;
40

41
type
42
  TFormMesh = class(TForm)
43
    StatusBar: TStatusBar;
44
    GLScene1: TGLScene;
45
    GLSceneViewer1: TGLSceneViewer;
46
    GLDummyCube1: TGLDummyCube;
47
    GLCamera1: TGLCamera;
48
    ObjectsCube: TGLDummyCube;
49
    ArrowZ: TGLArrowLine;
50
    ArrowY: TGLArrowLine;
51
    ArrowX: TGLArrowLine;
52
    GLLightSource1: TGLLightSource;
53
    Panel1: TPanel;
54
    Label1: TLabel;
55
    Label2: TLabel;
56
    Label3: TLabel;
57
    Label4: TLabel;
58
    Label5: TLabel;
59
    Label6: TLabel;
60
    Label7: TLabel;
61
    Label8: TLabel;
62
    Label9: TLabel;
63
    Label10: TLabel;
64
    Label12: TLabel;
65
    xRadiusTrackBar: TTrackBar;
66
    yRadiusTrackBar: TTrackBar;
67
    zRadiusTrackBar: TTrackBar;
68
    xyCurveTrackBar: TTrackBar;
69
    zCurveTrackBar: TTrackBar;
70
    GridCheckBox: TCheckBox;
71
    ArrowsCheckBox: TCheckBox;
72
    SlicesTrackBar: TTrackBar;
73
    StacksTrackBar: TTrackBar;
74
    TopCapRadioGroup: TRadioGroup;
75
    BottomTrackBar: TTrackBar;
76
    TopTrackBar: TTrackBar;
77
    StartTrackBar: TTrackBar;
78
    StopTrackBar: TTrackBar;
79
    BottomCapRadioGroup: TRadioGroup;
80
    Button1: TButton;
81
    GLXYZGridXZ: TGLXYZGrid;
82
    GLMesh1: TGLMesh;
83
    GLWindowsBitmapFont1: TGLWindowsBitmapFont;
84
    GLHUDText1: TGLHUDText;
85
    procedure FormShow(Sender: TObject);
86
    procedure FormCreate(Sender: TObject);
87
    procedure GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
88
      Shift: TShiftState; X, Y: Integer);
89
    procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState;
90
      X, Y: Integer);
91
    procedure GLSceneViewer1MouseUp(Sender: TObject; Button: TMouseButton;
92
      Shift: TShiftState; X, Y: Integer);
93
    procedure AnyChange(Sender: TObject);
94
    procedure GridCheckBoxClick(Sender: TObject);
95
    procedure ArrowsCheckBoxClick(Sender: TObject);
96
    procedure Button1Click(Sender: TObject);
97
    procedure StartTrackBarChange(Sender: TObject);
98
    procedure StopTrackBarChange(Sender: TObject);
99
  private
100
    MousePoint: TPoint;
101
    procedure ShowCameraLocation;
102
    procedure ShowFocalLength;
103
    procedure ShowMesh;
104
  public
105
  end;
106

107
var
108
  FormMesh: TFormMesh;
109

110
implementation
111

112
{$R *.dfm}
113
{$R CURSORS.RES}
114

115
const
116
  crLightxz = 1;
117
  crLightyz = 2;
118
  crLightxy = 3;
119
  crSlidexy = 4;
120
  crSlideyz = 5;
121
  crSlidexz = 6;
122
  crRotate = 7;
123
  crZoom = 8;
124
  crHandMove = 9;
125

126
procedure TFormMesh.AnyChange(Sender: TObject);
127
begin
128
  ShowMesh;
129
end;
130

131
procedure TFormMesh.ArrowsCheckBoxClick(Sender: TObject);
132
begin
133
  ArrowX.Visible := not ArrowsCheckBox.Checked;
134
  ArrowY.Visible := ArrowX.Visible;
135
  ArrowZ.Visible := ArrowX.Visible;
136
end;
137

138
procedure TFormMesh.Button1Click(Sender: TObject);
139
begin
140
  (* vmV, vmVN, vmVNC, vmVNCT, vmVNT, vmVT *)
141
  GLMesh1.VertexMode := vmVN;
142
  with GLMesh1.Material.Texture do
143
  begin
144
    // We need a CubeMapImage, which unlike the "regular Images" stores
145
    // multiple images.
146
    ImageClassName := TGLCubeMapImage.ClassName;
147
    with (Image as TGLCubeMapImage) do
148
    begin
149
      // Load all 6 texture map components of the cube map
150
      // The 'PX', 'NX', etc. refer to 'positive X', 'negative X', etc.
151
      // and follow the RenderMan specs/conventions
152
      Picture[cmtPX].LoadFromFile('cm_left.jpg');
153
      Picture[cmtNX].LoadFromFile('cm_right.jpg');
154
      Picture[cmtPY].LoadFromFile('cm_top.jpg');
155
      Picture[cmtNY].LoadFromFile('cm_bottom.jpg');
156
      Picture[cmtPZ].LoadFromFile('cm_back.jpg');
157
      Picture[cmtNZ].LoadFromFile('cm_front.jpg');
158
    end;
159
    // Select reflection cube map environment mapping
160
    // This is the mode you'll most commonly use with cube maps, normal cube
161
    // map generation is also supported (used for diffuse environment lighting)
162
    MappingMode := tmmCubeMapReflection;
163
    // That's all folks, let us see the thing!
164
    Disabled := False;
165
  end;
166
  Button1.Visible := False;
167
end;
168

169
procedure TFormMesh.FormCreate(Sender: TObject);
170
begin
171
  Screen.Cursors[crRotate] := LoadCursor(HInstance, 'ROTATE');
172
  Screen.Cursors[crZoom] := LoadCursor(HInstance, 'ZOOM');
173
end;
174

175
procedure TFormMesh.FormShow(Sender: TObject);
176
begin
177
  ShowCameraLocation;
178
  // focallength: right mouse drag up/down
179
  ShowFocalLength;
180
  ShowMesh;
181
end;
182

183
procedure TFormMesh.GLSceneViewer1MouseDown(Sender: TObject;
184
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
185
begin
186
  MousePoint.X := X;
187
  MousePoint.Y := Y;
188
  if ssShift in Shift then
189
  begin
190
    if ssLeft in Shift then
191
      Screen.Cursor := crZoom
192
    else if ssRight in Shift then
193
      Screen.Cursor := crLightxz;
194
  end
195
  else if ssCtrl in Shift then
196
  begin
197
    if ssLeft in Shift then
198
      Screen.Cursor := crSlidexy
199
    else if ssRight in Shift then
200
      Screen.Cursor := crLightxy;
201
  end
202
  else // no shift or ctrl key
203
  begin
204
    if Shift = [ssLeft] then
205
      Screen.Cursor := crRotate
206
    else if Shift = [ssRight] then
207
      Screen.Cursor := crZoom;
208
  end;
209
end;
210

211
procedure TFormMesh.GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState;
212
  X, Y: Integer);
213
var
214
  dx, dy: Integer;
215
  nx, nz, d: TGLFloat;
216

217
begin { refer GLScene\Demos\interface\camera\Camera.dpr }
218
  dx := MousePoint.X - X;
219
  dy := MousePoint.Y - Y;
220
  if ssShift in Shift then { shift key down }
221
  begin
222
    if ssLeft in Shift then { left mouse button }
223
    begin
224
      { dy = a step which adjusts target distance by 1.25%; zoom in or out }
225
      with GLCamera1 do
226
        AdjustDistanceToTarget(Power(1.0125, dy));
227
      ShowCameraLocation;
228
    end
229
  end
230
  else // no shift key
231
  begin
232
    if Shift = [ssLeft] then
233
    // Left mouse button changes camera angle by moving around target
234
    begin
235
      GLCamera1.MoveAroundTarget(dy, dx);
236
      ShowCameraLocation;
237
    end;
238
    if Shift = [ssRight] then
239
    begin
240
      { Right mouse button alters the camera's focal length;
241
        zoom out or in by moving cursor up or down }
242
      with GLCamera1 do
243
      begin
244
        FocalLength := FocalLength - dy;
245
        if FocalLength > 2000 then
246
          FocalLength := 2000; // max focal length
247
        if FocalLength < 20 then
248
          FocalLength := 20; // min focal length
249
      end;
250
      ShowFocalLength; // display in statusbar palel
251
    end;
252
  end;
253
  MousePoint.X := X; // update mouse position
254
  MousePoint.Y := Y;
255
end;
256

257
procedure TFormMesh.GLSceneViewer1MouseUp(Sender: TObject; Button: TMouseButton;
258
  Shift: TShiftState; X, Y: Integer);
259
begin
260
  Screen.Cursor := crDefault;
261
end;
262

263
procedure TFormMesh.GridCheckBoxClick(Sender: TObject);
264
begin
265
  GLXYZGridXZ.Visible := not GridCheckBox.Checked;
266
end;
267

268
procedure TFormMesh.ShowCameraLocation;
269
begin
270
  with GLCamera1.Position do
271
    StatusBar.Panels[0].Text := 'Camera: ' + FloatToStrF(X, ffNumber, 5, 2) +
272
      ', ' + FloatToStrF(Y, ffNumber, 5, 2) + ', ' +
273
      FloatToStrF(Z, ffNumber, 5, 2);
274
end;
275

276
procedure TFormMesh.ShowFocalLength;
277
begin
278
  with GLCamera1 do
279
    StatusBar.Panels[1].Text := 'f = ' + FloatToStrF(FocalLength,
280
      ffNumber, 5, 2);
281
end;
282

283
procedure TFormMesh.ShowMesh;
284
type
285
  TCapType = (ctNone, ctCenter, ctFlat);
286

287
  procedure AddTriangle(const p1, p2, p3: TAffineVector;
288
    const Color: TGLColorVector);
289
  begin
290
    with GLMesh1.Vertices do
291
    begin
292
      AddVertex(p1, NullVector, Color);
293
      AddVertex(p2, NullVector, Color);
294
      AddVertex(p3, NullVector, Color);
295
    end;
296
  end;
297

298
var
299
  i, j, tc1, tc2: Integer;
300
  CosPc1, SinPc1, CosTc2, SinTc2, CosNPc1, SinNPc1, CosNTc2, SinNTc2: Double;
301

302
  xyCurve: extended;
303
  zCurve: extended;
304

305
  Stacks: GLInt;
306
  Slices: GLInt;
307

308
  Top: TGLAngleLimit180; // i.e. -90 .. 90
309
  Bottom: TGLAngleLimit180;
310
  Start: TGLAngleLimit360; // i.e.  0 .. 360
311
  Stop: TGLAngleLimit360;
312
  TopCap, BottomCap: TCapType;
313

314
  v1, v2, v3, v4: TAffineVector;
315
  AngTop, AngBottom, AngStart, AngStop, StepV, StepH, Phi, NextPhi, Theta,
316
    NextTheta, SinP, CosP, SinNP, CosNP, SinT, CosT, SinNT, CosNT: Double;
317

318
begin
319
  xyCurve := xyCurveTrackBar.Position / 10;
320
  zCurve := zCurveTrackBar.Position / 10;
321

322
  Slices := SlicesTrackBar.Position;
323
  Stacks := StacksTrackBar.Position;
324

325
  Top := TopTrackBar.Position;
326
  Bottom := -BottomTrackBar.Position;
327

328
  Start := StartTrackBar.Position;
329
  Stop := StopTrackBar.Position;
330

331
  case TopCapRadioGroup.ItemIndex of
332
    0:
333
      TopCap := ctNone;
334
    1:
335
      TopCap := ctCenter;
336
    2:
337
      TopCap := ctFlat;
338
  end;
339

340
  case BottomCapRadioGroup.ItemIndex of
341
    0:
342
      BottomCap := ctNone;
343
    1:
344
      BottomCap := ctCenter;
345
    2:
346
      BottomCap := ctFlat;
347
  end;
348

349
  AngTop := DegToRadian(1.0 * Top);
350
  AngBottom := DegToRadian(1.0 * Bottom);
351
  AngStart := DegToRadian(1.0 * Start);
352
  AngStop := DegToRadian(1.0 * Stop);
353
  StepH := (AngStop - AngStart) / Slices;
354
  StepV := (AngTop - AngBottom) / Stacks;
355

356
  with GLMesh1 do
357
  begin
358
    Mode := mmTriangles;
359
    Vertices.Clear;
360
    Scale.SetVector(xRadiusTrackBar.Position / 10, yRadiusTrackBar.Position /
361
      10, zRadiusTrackBar.Position / 10);
362
  end;
363
  { Even integer used with the Power function, only produce positive points }
364
  tc1 := trunc(xyCurve);
365
  tc2 := trunc(zCurve);
366
  if tc1 mod 2 = 0 then
367
    xyCurve := xyCurve + 1E-6;
368
  if tc2 mod 2 = 0 then
369
    zCurve := zCurve - 1E-6;
370

371
  // bottom cap
372
  if (Bottom > -90) and (BottomCap in [ctCenter, ctFlat]) then
373
  begin
374
    SinCosine(AngBottom, SinP, CosP);
375

376
    if (Sign(SinP) = 1) or (tc1 = xyCurve) then
377
      SinPc1 := Power(SinP, xyCurve)
378
    else
379
      SinPc1 := -Power(-SinP, xyCurve);
380

381
    if (Sign(CosP) = 1) or (tc1 = xyCurve) then
382
      CosPc1 := Power(CosP, xyCurve)
383
    else
384
      CosPc1 := -Power(-CosP, xyCurve);
385

386
    if BottomCap = ctCenter then
387
    begin
388
      v1 := NullVector;
389
      v3.Y := SinPc1;
390
      v4.Y := SinPc1;
391
    end
392
    else { BottomCap = ctFlat }
393
    begin
394
      v1.X := 0;
395
      v1.Y := SinPc1;
396
      v1.Z := 0;
397
      v3.Y := v1.Y;
398
      v4.Y := v1.Y;
399
    end;
400

401
    Theta := AngStart;
402
    NextTheta := Theta + StepH;
403

404
    for i := 0 to Slices - 1 do
405
    begin
406
      SinCosine(Theta, SinT, CosT);
407
      if (Sign(SinT) = 1) or (tc2 = zCurve) then
408
        SinTc2 := Power(SinT, zCurve)
409
      else
410
        SinTc2 := -Power(-SinT, zCurve);
411

412
      SinCosine(NextTheta, SinNT, CosNT);
413
      if (Sign(SinNT) = 1) or (tc2 = zCurve) then
414
        SinNTc2 := Power(SinNT, zCurve)
415
      else
416
        SinNTc2 := -Power(-SinNT, zCurve);
417

418
      if (Sign(CosT) = 1) or (tc2 = zCurve) then
419
        CosTc2 := Power(CosT, zCurve)
420
      else
421
        CosTc2 := -Power(-CosT, zCurve);
422

423
      if (Sign(CosNT) = 1) or (tc2 = zCurve) then
424
        CosNTc2 := Power(CosNT, zCurve)
425
      else
426
        CosNTc2 := -Power(-CosNT, zCurve);
427

428
      v3.X := CosPc1 * SinTc2;
429
      v3.Z := CosPc1 * CosTc2;
430
      v4.X := CosPc1 * SinNTc2;
431
      v4.Z := CosPc1 * CosNTc2;
432

433
      AddTriangle(v1, v4, v3, clrTurquoise);
434
      Theta := NextTheta;
435
      NextTheta := Theta + StepH;
436
    end;
437
  end;
438
  // main body
439
  Phi := AngBottom;
440
  NextPhi := Phi + StepV; { positive StepV; from bottom to top }
441

442
  for j := 0 to Stacks - 1 do
443
  begin
444
    Theta := AngStart;
445
    NextTheta := Theta + StepH; { positive StepH; from start to stop }
446

447
    SinCosine(Phi, SinP, CosP);
448
    if (Sign(SinP) = 1) or (tc1 = xyCurve) then
449
      SinPc1 := Power(SinP, xyCurve)
450
    else
451
      SinPc1 := -Power(-SinP, xyCurve);
452

453
    v1.Y := SinPc1;
454
    v2.Y := SinPc1;
455

456
    SinCosine(NextPhi, SinNP, CosNP);
457
    if (Sign(SinNP) = 1) or (tc1 = xyCurve) then
458
      SinNPc1 := Power(SinNP, xyCurve)
459
    else
460
      SinNPc1 := -Power(-SinNP, xyCurve);
461

462
    v3.Y := SinNPc1;
463
    v4.Y := SinNPc1;
464

465
    { define CopsPvc & CosNPc1 for Slices }
466
    if (Sign(CosP) = 1) or (tc1 = xyCurve) then
467
      CosPc1 := Power(CosP, xyCurve)
468
    else
469
      CosPc1 := -Power(-CosP, xyCurve);
470

471
    if (Sign(CosNP) = 1) or (tc1 = xyCurve) then
472
      CosNPc1 := Power(CosNP, xyCurve)
473
    else
474
      CosNPc1 := -Power(-CosNP, xyCurve);
475

476
    for i := 0 to Slices - 1 do
477
    begin
478
      SinCosine(Theta, SinT, CosT);
479
      if (Sign(SinT) = 1) or (tc2 = zCurve) then
480
        SinTc2 := Power(SinT, zCurve)
481
      else
482
        SinTc2 := -Power(-SinT, zCurve);
483

484
      if (Sign(CosT) = 1) or (tc2 = zCurve) then
485
        CosTc2 := Power(CosT, zCurve)
486
      else
487
        CosTc2 := -Power(-CosT, zCurve);
488

489
      SinCosine(NextTheta, SinNT, CosNT);
490
      if (Sign(SinNT) = 1) or (tc2 = zCurve) then
491
        SinNTc2 := Power(SinNT, zCurve)
492
      else
493
        SinNTc2 := -Power(-SinNT, zCurve);
494

495
      if (Sign(CosNT) = 1) or (tc2 = zCurve) then
496
        CosNTc2 := Power(CosNT, zCurve)
497
      else
498
        CosNTc2 := -Power(-CosNT, zCurve);
499

500
      v1.X := CosPc1 * SinTc2;
501
      v2.X := CosPc1 * SinNTc2;
502
      v3.X := CosNPc1 * SinTc2;
503
      v4.X := CosNPc1 * SinNTc2;
504

505
      v1.Z := CosPc1 * CosTc2;
506
      v2.Z := CosPc1 * CosNTc2;
507
      v3.Z := CosNPc1 * CosTc2;
508
      v4.Z := CosNPc1 * CosNTc2;
509

510
      AddTriangle(v1, v2, v3, clrTurquoise);
511
      AddTriangle(v2, v4, v3, clrTurquoise);
512

513
      Theta := NextTheta;
514
      NextTheta := Theta + StepH;
515
    end;
516
    Phi := NextPhi;
517
    NextPhi := Phi + StepV;
518
  end;
519

520
  // top cap
521
  if (Top < 90) and (TopCap in [ctCenter, ctFlat]) then
522
  begin
523
    SinCosine(AngTop, SinP, CosP);
524

525
    if (Sign(SinP) = 1) or (tc1 = xyCurve) then
526
      SinPc1 := Power(SinP, xyCurve)
527
    else
528
      SinPc1 := -Power(-SinP, xyCurve);
529

530
    if (Sign(CosP) = 1) or (tc1 = xyCurve) then
531
      CosPc1 := Power(CosP, xyCurve)
532
    else
533
      CosPc1 := -Power(-CosP, xyCurve);
534

535
    if TopCap = ctCenter then
536
    begin
537
      v1 := NullVector;
538
      v3.Y := SinPc1;
539
      v4.Y := SinPc1;
540
    end
541
    else { FTopCap = ctFlat }
542
    begin
543
      v1.X := 0;
544
      v1.Y := SinPc1;
545
      v1.Z := 0;
546
      v3.Y := v1.Y;
547
      v4.Y := v1.Y;
548
    end;
549

550
    Theta := AngStart;
551
    NextTheta := Theta + StepH;
552

553
    for i := 0 to Slices - 1 do
554
    begin
555
      SinCosine(Theta, SinT, CosT);
556
      if (Sign(SinT) = 1) or (tc2 = zCurve) then
557
        SinTc2 := Power(SinT, zCurve)
558
      else
559
        SinTc2 := -Power(-SinT, zCurve);
560

561
      SinCosine(NextTheta, SinNT, CosNT);
562
      if (Sign(SinNT) = 1) or (tc2 = zCurve) then
563
        SinNTc2 := Power(SinNT, zCurve)
564
      else
565
        SinNTc2 := -Power(-SinNT, zCurve);
566

567
      if (Sign(CosT) = 1) or (tc2 = zCurve) then
568
        CosTc2 := Power(CosT, zCurve)
569
      else
570
        CosTc2 := -Power(-CosT, zCurve);
571

572
      if (Sign(CosNT) = 1) or (tc2 = zCurve) then
573
        CosNTc2 := Power(CosNT, zCurve)
574
      else
575
        CosNTc2 := -Power(-CosNT, zCurve);
576

577
      v3.X := CosPc1 * SinTc2;
578
      v3.Z := CosPc1 * CosTc2;
579
      v4.X := CosPc1 * SinNTc2;
580
      v4.Z := CosPc1 * CosNTc2;
581

582
      AddTriangle(v1, v3, v4, clrTurquoise);
583

584
      Theta := NextTheta;
585
      NextTheta := Theta + StepH;
586
    end;
587
  end; { Top Cap }
588

589
  GLMesh1.CalcNormals(fwCounterClockWise);
590
  GLHUDText1.Text := 'Scale:' + FloatToStrF(xRadiusTrackBar.Position / 10,
591
    ffNumber, 6, 2) + ', ' + FloatToStrF(yRadiusTrackBar.Position / 10,
592
    ffNumber, 6, 2) + ', ' + FloatToStrF(zRadiusTrackBar.Position / 10,
593
    ffNumber, 6, 2) + #13#10'xyCurve:' +
594
    FloatToStrF(xyCurveTrackBar.Position / 10, ffNumber, 6, 2) + #13#10'zCurve:'
595
    + FloatToStrF(zCurveTrackBar.Position / 10, ffNumber, 6, 2) +
596
    #13#10'Slices:' + IntToStr(SlicesTrackBar.Position) + #13#10'Stacks:' +
597
    IntToStr(StacksTrackBar.Position) + #13#10'Top:' +
598
    IntToStr(TopTrackBar.Position) + '�' + #13#10'Bottom:' +
599
    IntToStr(BottomTrackBar.Position) + '�' + #13#10'Start:' +
600
    IntToStr(StartTrackBar.Position) + '�' + #13#10'Stop:' +
601
    IntToStr(StopTrackBar.Position) + '�';
602
end;
603

604
procedure TFormMesh.StartTrackBarChange(Sender: TObject);
605
begin
606
  if (StartTrackBar.Position >= StopTrackBar.Position) then
607
    StartTrackBar.Position := StopTrackBar.Position;
608
  ShowMesh;
609
end;
610

611
procedure TFormMesh.StopTrackBarChange(Sender: TObject);
612
begin
613
  if (StopTrackBar.Position <= StartTrackBar.Position) then
614
    StopTrackBar.Position := StartTrackBar.Position;
615
  ShowMesh;
616
end;
617

618
end.
619