ArenaZ

1
unit Main;
2

3
{$mode objfpc}{$H+}
4

5
interface
6

7
uses
8
  {$IFDEF WINDOWS} Windows, {$ENDIF}
9
  SysUtils, Classes, Math,
10
  Graphics, Controls, Forms, Dialogs, Buttons,
11
  StdCtrls, ComCtrls, ExtCtrls,
12
   
13
  {GLWin32Viewer,} GLCrossPlatform, GLBaseClasses, GLScene, GLGeomObjects,
14
  GLObjects, GLCoordinates, GLGraph, GLVectorLists, OpenGLTokens,
15
  GLMesh, GLHUDObjects, GLBitmapFont, GLWindowsFont,
16
  GLVectorGeometry, GLColor, GLTexture, GLContext, GLCadencer, GLLCLViewer;
17

18

19
type
20
  TMainForm = class(TForm)
21
    StatusBar: TStatusBar;
22
    GLScene1: TGLScene;
23
    GLSceneViewer1: TGLSceneViewer;
24
    CameraCube: TGLDummyCube;
25
    Camera: TGLCamera;
26
    ObjectsCube: TGLDummyCube;
27
    ArrowZ: TGLArrowLine;
28
    ArrowY: TGLArrowLine;
29
    ArrowX: TGLArrowLine;
30

31
    GLLightSource1: TGLLightSource;
32
    Panel1: TPanel;
33
    Label1: TLabel;
34
    Label2: TLabel;
35
    Label3: TLabel;
36
    Label4: TLabel;
37
    Label5: TLabel;
38
    Label6: TLabel;
39
    Label7: TLabel;
40
    Label8: TLabel;
41
    Label9: TLabel;
42
    Label10: TLabel;
43
    Label12: TLabel;
44

45
    xRadiusTrackBar: TTrackBar;
46
    yRadiusTrackBar: TTrackBar;
47
    zRadiusTrackBar: TTrackBar;
48

49
    VCurveTrackBar: TTrackBar;
50
    HCurveTrackBar: TTrackBar;
51
    GridCheckBox: TCheckBox;
52
    ArrowsCheckBox: TCheckBox;
53
    SlicesTrackBar: TTrackBar;
54
    StacksTrackBar: TTrackBar;
55
    TopCapRadioGroup: TRadioGroup;
56
    BottomTrackBar: TTrackBar;
57
    TopTrackBar: TTrackBar;
58
    StartTrackBar: TTrackBar;
59
    StopTrackBar: TTrackBar;
60

61
    BottomCapRadioGroup: TRadioGroup;
62
    Button1: TButton;
63
    GLXYZGridXZ: TGLXYZGrid;
64
    GLWindowsBitmapFont1: TGLWindowsBitmapFont;
65
    GLHUDText: TGLHUDText;
66
    Button2: TButton;
67
    GLCadencer1: TGLCadencer;
68
    GLLightSource: TGLLightSource;
69
    GLSuperellipsoid: TGLSuperellipsoid;
70
    GLMesh: TGLMesh;
71

72
    procedure FormShow(Sender: TObject);
73
    procedure FormCreate(Sender: TObject);
74
    procedure GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
75
      Shift: TShiftState; X, Y: Integer);
76
    procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState;
77
      X, Y: Integer);
78
    procedure GLSceneViewer1MouseUp(Sender: TObject; Button: TMouseButton;
79
      Shift: TShiftState; X, Y: Integer);
80

81
    procedure RadiusTrackBarChange(Sender: TObject);
82
    procedure VCurveTrackBarChange(Sender: TObject);
83
    procedure HCurveTrackBarChange(Sender: TObject);
84
    procedure SlicesTrackBarChange(Sender: TObject);
85
    procedure StacksTrackBarChange(Sender: TObject);
86
    procedure GridCheckBoxClick(Sender: TObject);
87
    procedure ArrowsCheckBoxClick(Sender: TObject);
88
    procedure TopTrackBarChange(Sender: TObject);
89
    procedure BottomTrackBarChange(Sender: TObject);
90
    procedure TopCapRadioGroupClick(Sender: TObject);
91
    procedure BottomCapRadioGroupClick(Sender: TObject);
92
    procedure StartTrackBarChange(Sender: TObject);
93
    procedure StopTrackBarChange(Sender: TObject);
94
    procedure Button1Click(Sender: TObject);
95
    procedure checkclick(Sender: TObject);
96
    procedure CheckBoxClick(Sender: TObject);
97
    procedure Button2Click(Sender: TObject);
98
  private
99
     
100
    MousePoint: TPoint;
101
    Superellipsoids: array[0..5, 0..5] of TGLSuperellipsoid;
102
    procedure ShowCameraLocation;
103
    procedure ShowFocalLength;
104
    procedure ShowDisplacement;
105
    procedure ShowSuperellipsoid;
106
  public
107
     
108
  end;
109

110
var
111
  MainForm: TMainForm;
112

113
implementation
114

115
{$R *.lfm}
116
{$R CURSORS.RES}
117

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

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

136
procedure TMainForm.FormCreate(Sender: TObject);
137
begin
138
  Screen.Cursors[crSlidexy] := LoadCursor(HInstance, 'SLIDEXY');
139
  Screen.Cursors[crRotate] := LoadCursor(HInstance, 'ROTATE');
140
  Screen.Cursors[crZoom] := LoadCursor(HInstance, 'ZOOM');
141

142
  Randomize;
143
  GLSuperellipsoid := TGLSuperellipsoid(GLScene1.Objects.AddNewChild(TGLSuperellipsoid));
144
  GLSuperellipsoid.Direction.SetVector(0, 0, 1);
145
  GLSuperellipsoid.Up.SetVector(0, 1, 0);
146
  GLSuperellipsoid.Position.SetPoint(0, 1, 0);
147
  GLSuperellipsoid.Material.FrontProperties.Ambient.RandomColor;
148
  GLSuperellipsoid.Material.FrontProperties.Diffuse.RandomColor;
149
  GLSuperellipsoid.Material.FrontProperties.Shininess := 100;
150

151
end;
152

153
procedure TMainForm.FormShow(Sender: TObject);
154
begin
155
  ShowCameraLocation;
156
  { focallength: right mouse drag up/down }
157
  ShowFocalLength;
158
  { displace origin: x axis: ctrl/left mouse drag left/right
159
    y axis: ctrl/left mouse drag up/down }
160
  ShowDisplacement;
161
  { move light: x axis: ctrl right mouse drag left/right
162
    y axis: ctrl right mouse drag up/down
163
    z axis: shift right mouse drag up/down }
164
  ShowSuperellipsoid;
165
end;
166

167
procedure TMainForm.GLSceneViewer1MouseDown(Sender: TObject;
168
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
169
begin
170
  MousePoint.X := X;
171
  MousePoint.Y := Y;
172
  if ssShift in Shift then
173
  begin
174
    if ssLeft in Shift then
175
      Screen.Cursor := crZoom
176
    else if ssRight in Shift then
177
      Screen.Cursor := crLightxz;
178
  end
179
  else if ssCtrl in Shift then
180
  begin
181
    if ssLeft in Shift then
182
      Screen.Cursor := crSlidexy
183
    else if ssRight in Shift then
184
      Screen.Cursor := crLightxy;
185
  end
186
  else { no shift or ctrl key }
187
  begin
188
    if Shift = [ssLeft] then
189
      Screen.Cursor := crRotate
190
    else if Shift = [ssRight] then
191
      Screen.Cursor := crZoom;
192
  end;
193
end;
194

195
procedure TMainForm.GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState;
196
  X, Y: Integer);
197
var
198
  dx, dy: Integer;
199
  nx, nz, d: TGLFloat;
200

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

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

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

267
procedure TMainForm.CheckBoxClick(Sender: TObject);
268
begin
269
  ShowSuperellipsoid;
270
end;
271

272
procedure TMainForm.VCurveTrackBarChange(Sender: TObject);
273
var
274
  n: TGLFloat;
275

276
begin
277
  n := VCurveTrackBar.Position / 10;
278
  GLSuperellipsoid.XYCurve := n;
279
  ShowSuperellipsoid;
280
end;
281

282
procedure TMainForm.HCurveTrackBarChange(Sender: TObject);
283
var
284
  n: TGLFloat;
285

286
begin
287
  n := HCurveTrackBar.Position / 10;
288
  GLSuperellipsoid.XYCurve := n;
289
  ShowSuperellipsoid;
290
end;
291

292
procedure TMainForm.ShowCameraLocation;
293
begin
294
  with Camera.Position do
295
    StatusBar.Panels[0].Text := 'Camera: ' + FloatToStrF(X, ffNumber, 5, 2) +
296
      ', ' + FloatToStrF(Y, ffNumber, 5, 2) + ', ' +
297
      FloatToStrF(Z, ffNumber, 5, 2);
298
end;
299

300
procedure TMainForm.ShowFocalLength;
301
begin
302
  with Camera do
303
    StatusBar.Panels[1].Text := 'f = ' + FloatToStrF(FocalLength,
304
      ffNumber, 5, 2);
305
end;
306

307
procedure TMainForm.ShowDisplacement;
308
begin
309
  with CameraCube.Position do
310
    StatusBar.Panels[2].Text := 'Displaced: ' + FloatToStrF(-X, ffNumber, 5, 2)
311
      + ', ' + FloatToStrF(-Y, ffNumber, 5, 2);
312
end;
313

314
procedure TMainForm.ShowSuperellipsoid;
315
begin
316
  // Superellipsoid.NormalDirection := ndInside;
317
  // Superellipsoid.Normals :=
318
  { Determines how and if normals are smoothed.<p>
319
    - nsFlat : facetted look<br>
320
    - nsSmooth : smooth look<br>
321
    - nsNone : unlighted rendering, usefull for decla texturing }
322
  GLSuperellipsoid.Scale.SetVector(xRadiusTrackBar.Position,
323
    yRadiusTrackBar.Position, zRadiusTrackBar.Position);
324
  GLSuperellipsoid.Slices := SlicesTrackBar.Position;
325
  GLSuperellipsoid.Stacks := StacksTrackBar.Position;
326
  GLSuperellipsoid.Top := TopTrackBar.Position;
327

328
  case TopCapRadioGroup.ItemIndex of
329
    0: GLSuperellipsoid.TopCap := ctNone;
330
    1: GLSuperellipsoid.TopCap := ctCenter;
331
    2: GLSuperellipsoid.TopCap := ctFlat;
332
  end;
333

334
  GLSuperellipsoid.Bottom := -BottomTrackBar.Position;
335

336
  case BottomCapRadioGroup.ItemIndex of
337
    0: GLSuperellipsoid.BottomCap := ctNone;
338
    1: GLSuperellipsoid.BottomCap := ctCenter;
339
    2: GLSuperellipsoid.BottomCap := ctFlat;
340
  end;
341

342
  if (StartTrackBar.Position <= StopTrackBar.Position) and
343
    (StartTrackBar.Position < 360) then
344
  begin
345
    GLSuperellipsoid.Start := StartTrackBar.Position;
346
    GLSuperellipsoid.Stop := StopTrackBar.Position;
347
  end;
348
  GLSuperellipsoid.Normals := nsNone;
349
  GLHUDText.Text := 'Scale:' + FloatToStrF(xRadiusTrackBar.Position / 10,
350
    ffNumber, 6, 2) + ', ' + FloatToStrF(yRadiusTrackBar.Position / 10,
351
    ffNumber, 6, 2) + ', ' + FloatToStrF(zRadiusTrackBar.Position / 10,
352
    ffNumber, 6, 2) + #13#10'VCurve:' +
353
    FloatToStrF(VCurveTrackBar.Position / 10, ffNumber, 6, 2) + #13#10'HCurve:'
354
    + FloatToStrF(HCurveTrackBar.Position / 10, ffNumber, 6, 2) +
355
    #13#10'Slices:' + IntToStr(SlicesTrackBar.Position) + #13#10'Stacks:' +
356
    IntToStr(StacksTrackBar.Position) + #13#10'Top:' +
357
    IntToStr(TopTrackBar.Position) + '°' + #13#10'Bottom:' +
358
    IntToStr(BottomTrackBar.Position) + '°' + #13#10'Start:' +
359
    IntToStr(StartTrackBar.Position) + '°' + #13#10'Stop:' +
360
    IntToStr(StopTrackBar.Position) + '°';
361
end;
362

363
procedure TMainForm.SlicesTrackBarChange(Sender: TObject);
364
begin
365
  ShowSuperellipsoid;
366
end;
367

368
procedure TMainForm.StacksTrackBarChange(Sender: TObject);
369
begin
370
  ShowSuperellipsoid;
371
end;
372

373
procedure TMainForm.StartTrackBarChange(Sender: TObject);
374
begin
375
  if (StartTrackBar.Position >= StopTrackBar.Position) then
376
    StartTrackBar.Position := StopTrackBar.Position;
377
  ShowSuperellipsoid;
378
end;
379

380
procedure TMainForm.TopCapRadioGroupClick(Sender: TObject);
381
begin
382
  ShowSuperellipsoid;
383
end;
384

385
procedure TMainForm.TopTrackBarChange(Sender: TObject);
386
begin
387
  ShowSuperellipsoid;
388
end;
389

390
procedure TMainForm.StopTrackBarChange(Sender: TObject);
391
begin
392
  if (StopTrackBar.Position <= StartTrackBar.Position) then
393
    StopTrackBar.Position := StartTrackBar.Position;
394
  ShowSuperellipsoid;
395
end;
396

397
procedure TMainForm.BottomCapRadioGroupClick(Sender: TObject);
398
begin
399
  ShowSuperellipsoid;
400
end;
401

402
procedure TMainForm.BottomTrackBarChange(Sender: TObject);
403
begin
404
  ShowSuperellipsoid;
405
end;
406

407
procedure TMainForm.Button1Click(Sender: TObject);
408
begin
409
  with GLSuperellipsoid.Material.Texture do
410
  begin
411
    // We need a CubeMapImage, which unlike the "regular Images" stores
412
    // multiple images.
413
    ImageClassName := TGLCubeMapImage.ClassName;
414
    with Image as TGLCubeMapImage do
415
    begin
416
      // Load all 6 texture map components of the cube map
417
      // The 'PX', 'NX', etc. refer to 'positive X', 'negative X', etc.
418
      // and follow the RenderMan specs/conventions
419
      Picture[cmtNX].LoadFromFile('cm_left.png');
420
      Picture[cmtPX].LoadFromFile('cm_right.png');
421
      Picture[cmtNY].LoadFromFile('cm_top.png');
422
      Picture[cmtPY].LoadFromFile('cm_bottom.png');
423
      Picture[cmtPZ].LoadFromFile('cm_back.png');
424
      Picture[cmtNZ].LoadFromFile('cm_front.png');
425
    end;
426
    // Select reflection cube map environment mapping
427
    // This is the mode you'll most commonly use with cube maps, normal cube
428
    // map generation is also supported (used for diffuse environment lighting)
429
    MappingMode := tmmCubeMapReflection;
430
    // That's all folks, let us see the thing!
431
    Disabled := False;
432
  end;
433
  Button1.Visible := False;
434
end;
435

436
procedure TMainForm.Button2Click(Sender: TObject);
437
var
438
  i, j: integer;
439
  x, y, d: single;
440

441
begin
442

443
  d := 6;
444
  Randomize;
445
  for j := 0 to 5 do
446
  for i := 0 to 5 do
447
  begin
448
    x := -d*2.5 + d*i;
449
    y :=  d*2.5 - d*j;
450
    Superellipsoids[i, j] :=
451
    TGLSuperellipsoid(GLScene1.Objects.AddNewChild(TGLSuperellipsoid));
452

453
    with Superellipsoids[i, j] do
454
    begin
455
      Slices := 32;
456
      Stacks := 32;
457
      Scale.SetVector(5, 5, 5);
458
      Position.SetPoint(x, y, 0);
459
      Direction.SetVector(0, 1, 0);
460
      Up.SetVector(0, 0, 1);
461
      case i of
462
      0:XYCurve := 0.2;
463
      1:XYCurve := 0.8;
464
      2:XYCurve := 1.0;
465
      3:XYCurve := 1.5;
466
      4:XYCurve := 2.0;
467
      5:XYCurve := 3.0;
468
      end;
469
      case j of
470
      0:XYCurve := 0.2;
471
      1:XYCurve := 0.8;
472
      2:XYCurve := 1.0;
473
      3:XYCurve := 1.5;
474
      4:XYCurve := 2.0;
475
      5:XYCurve := 3.0;
476
      end;
477
      with Material.FrontProperties do
478
      begin
479
        Ambient.RandomColor;
480
        Diffuse.RandomColor;
481
        Specular.RandomColor;
482
        Shininess := 125;
483
      end;
484
    end;
485
  end;
486
  Button2.Visible := False;
487
end;
488

489
procedure TMainForm.checkclick(Sender: TObject);
490
begin
491
  ShowSuperellipsoid;
492
end;
493

494
procedure TMainForm.RadiusTrackBarChange(Sender: TObject);
495
begin
496
  ShowSuperellipsoid;
497
end;
498

499
end.
500