MathgeomGLS

1
unit fDelaunayFF;
2

3
interface
4

5
uses
6
  Winapi.Windows,
7
  Winapi.Messages,
8
  Winapi.OpenGL,
9
  System.SysUtils,
10
  System.Variants,
11
  System.Classes,
12
  System.Math,
13
  System.IniFiles,
14
  Vcl.Graphics,
15
  Vcl.Controls,
16
  Vcl.Forms,
17
  Vcl.Dialogs,
18
  Vcl.ComCtrls,
19
  Vcl.StdCtrls,
20
  Vcl.ExtCtrls,
21
  Vcl.Imaging.Jpeg,
22
   
23
  GLS.PersistentClasses,
24
  GLS.Scene,
25
  GLS.Objects,
26
  GLS.Mesh,
27
  GLS.Texture,
28
  GLS.VectorTypes,
29
  GLS.VectorGeometry,
30
  GLS.VectorFileObjects,
31
  GLS.VectorLists,
32
  GLS.MeshUtils,
33
  GLS.Cadencer,
34
  
35
  GLS.Context,
36
  GLS.HUDObjects,
37
  GLS.File3DS,
38
  GLS.SceneViewer,
39
  GLS.Material,
40
  GLS.Coordinates,
41
  GLS.BaseClasses,
42
  GLS.RenderContextInfo,
43
  GLS.State,
44
  GLS.Triangulation,
45
  GLS.Utils;
46

47
type
48
  TForm1 = class(TForm)
49
    GLScene: TGLScene;
50
    GLLightSource1: TGLLightSource;
51
    Panel1: TPanel;
52
    GroupBox1: TGroupBox;
53
    Label3: TLabel;
54
    SmoothTB: TTrackBar;
55
    SubdivideBtn: TButton;
56
    GroupBox2: TGroupBox;
57
    WireframeCB: TCheckBox;
58
    Timer1: TTimer;
59
    GLSceneViewer1: TGLSceneViewer;
60
    GLCadencer: TGLCadencer;
61
    TimeLabel: TLabel;
62
    TexturedCB: TCheckBox;
63
    GLDirectOpenGL1: TGLDirectOpenGL;
64
    MatLib: TGLMaterialLibrary;
65
    ffWindrose: TGLFreeForm;
66
    CamH: TGLDummyCube;
67
    CamV: TGLDummyCube;
68
    Camera: TGLCamera;
69
    ffTerrain: TGLFreeForm;
70
    procedure FormCreate(Sender: TObject);
71
    procedure FormDestroy(Sender: TObject);
72
    procedure SubdivideBtnClick(Sender: TObject);
73
    procedure WireframeCBClick(Sender: TObject);
74
    procedure Timer1Timer(Sender: TObject);
75
    procedure GLCadencerProgress(Sender: TObject;
76
      const deltaTime, newTime: Double);
77
    procedure TexturedCBClick(Sender: TObject);
78
    procedure GLDirectOpenGL1Render(Sender: TObject;
79
      var rci: TGLRenderContextInfo);
80
    procedure GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
81
      Shift: TShiftState; X, Y: Integer);
82
    procedure GLSceneViewer1MouseUp(Sender: TObject; Button: TMouseButton;
83
      Shift: TShiftState; X, Y: Integer);
84
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
85
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
86
  private
87
    mx, my: Integer;
88
    MousePos: TPoint;
89
    t: Int64;
90
    IsLeftMouseDown, IsRightMouseDown: Boolean;
91
    procedure BuildMesh(TargetMesh: TGLFreeForm; D: TGLDelaunay2D);
92
    procedure SubdivideMesh(TargetMesh: TGLFreeForm; Smooth: Single);
93
  public
94
  end;
95

96
var
97
  MeshObj: TGLMeshObject;
98
  Delaunay2D: TGLDelaunay2D;
99
  Form1: TForm1;
100

101
implementation
102

103
{$R *.dfm}
104

105
procedure TForm1.FormCreate(Sender: TObject);
106
var
107
  Ini: TIniFile;
108
  i: Integer;
109
  X, Y, z, u, v: Single;
110
  ExePath: TFileName;
111
  AMatIndex: Integer;
112
  S: String;
113

114
begin
115
  ExePath := ExtractFilePath(ParamStr(0));
116
  ffTerrain.Material.Texture.Image.LoadFromFile('terr3.jpg');
117
  Ini := TIniFile.Create(ExePath + 'Vertexes.ini');
118
  Delaunay2D := TGLDelaunay2D.Create;
119

120
  for i := 0 to 559 do
121
  begin
122
    S := IntToStr(i);
123
    X := Ini.ReadFloat(S, 'X', 0.0);
124
    Y := Ini.ReadFloat(S, 'Y', 0.0);
125
    z := Ini.ReadFloat(S, 'Z', 0.0);
126
    u := Ini.ReadFloat(S, 'U', 0.0);
127
    v := Ini.ReadFloat(S, 'V', 0.0);
128
    AMatIndex := 0; // no material
129
    Delaunay2D.AddPoint(X, Y, z, u, v, AMatIndex);
130
  end;
131
  t := StartPrecisionTimer;
132
  Delaunay2D.Mesh(True);
133
  BuildMesh(ffTerrain, Delaunay2D);
134
  Ini.Free;
135
  TimeLabel.Caption := Format('Delaunay triangulation completed in %.1f ms' +
136
    #10#13, [StopPrecisionTimer(t) * 1000]);
137
  ffWindrose.LoadFromFile('windrose.3ds');
138
end;
139

140
procedure TForm1.FormDestroy(Sender: TObject);
141
begin
142
  Delaunay2D.Free;
143
end;
144

145
procedure TForm1.BuildMesh(TargetMesh: TGLFreeForm; D: TGLDelaunay2D);
146
var
147
  i: Integer;
148
  vert1, vert2, vert3: DVertex;
149
  FaceGroup: TFGVertexIndexList;
150
begin
151
  TargetMesh.MeshObjects.Clear;
152

153
  MeshObj := TGLMeshObject.CreateOwned(TargetMesh.MeshObjects);
154
  MeshObj.Mode := momFaceGroups;
155

156
  FaceGroup := TFGVertexIndexList.CreateOwned(MeshObj.FaceGroups);
157

158
  for i := 1 to D.HowMany do
159
  begin
160
    vert1 := D.Vertex[D.Triangle[i].vv0];
161
    vert2 := D.Vertex[D.Triangle[i].vv1];
162
    vert3 := D.Vertex[D.Triangle[i].vv2];
163

164
    MeshObj.Vertices.Add(vert1.X, vert1.Y, vert1.z);
165
    MeshObj.Vertices.Add(vert2.X, vert2.Y, vert2.z);
166
    MeshObj.Vertices.Add(vert3.X, vert3.Y, vert3.z);
167

168
    MeshObj.Colors.Add(1.0, 0.0, 0.0, 1.0);
169
    MeshObj.Colors.Add(0.0, 1.0, 0.0, 1.0);
170
    MeshObj.Colors.Add(0.0, 0.0, 1.0, 1.0);
171

172
    MeshObj.TexCoords.Add(vert1.u, vert1.v);
173
    MeshObj.TexCoords.Add(vert2.u, vert2.v);
174
    MeshObj.TexCoords.Add(vert3.u, vert3.v);
175

176
    FaceGroup.Add(MeshObj.Vertices.Count - 1);
177
    FaceGroup.Add(MeshObj.Vertices.Count - 2);
178
    FaceGroup.Add(MeshObj.Vertices.Count - 3);
179
  end;
180

181
  MeshObj.BuildNormals(FaceGroup.VertexIndices, momTriangles);
182

183
  TargetMesh.StructureChanged;
184
end;
185

186
procedure TForm1.SubdivideMesh(TargetMesh: TGLFreeForm; Smooth: Single);
187
var
188
  i: Integer;
189
  tris, norms, tex, buf: TGLAffineVectorList;
190
  indices, texIndices: TGLIntegerList;
191
  MatName: String;
192
begin
193
  for i := 0 to TargetMesh.MeshObjects.Count - 1 do
194
  begin
195
    tex := TGLAffineVectorList.Create;
196
    with TargetMesh.MeshObjects[i] do
197
    begin
198
      tris := ExtractTriangles(tex);
199
    end;
200
    indices := BuildVectorCountOptimizedIndices(tris);
201
    RemapAndCleanupReferences(tris, indices);
202

203
    norms := BuildNormals(tris, indices);
204

205
    // subdivide geometry
206
    SubdivideTriangles(Smooth, tris, indices, norms);
207

208
    texIndices := BuildVectorCountOptimizedIndices(tex);
209
    RemapAndCleanupReferences(tex, texIndices);
210

211
    // subdivide texture space
212
    SubdivideTriangles(0, tex, texIndices);
213

214
    // Re-expand everything
215
    buf := TGLAffineVectorList.Create;
216
    try
217
      ConvertIndexedListToList(tris, indices, buf);
218
      tris.Assign(buf);
219
      buf.Count := 0;
220
      ConvertIndexedListToList(norms, indices, buf);
221
      norms.Assign(buf);
222
      buf.Count := 0;
223
      ConvertIndexedListToList(tex, texIndices, buf);
224
      tex.Assign(buf);
225
    finally
226
      buf.Free;
227
    end;
228

229
    // Pack & Optimize the expanded stuff
230

231
    indices.Free;
232
    indices := BuildVectorCountOptimizedIndices(tris, norms, tex);
233

234
    RemapReferences(norms, indices);
235
    RemapReferences(tex, indices);
236
    RemapAndCleanupReferences(tris, indices);
237

238
    IncreaseCoherency(indices, 13);
239

240
    with TargetMesh.MeshObjects[i] do
241
    begin
242
      Vertices := tris;
243
      Normals := norms;
244
      TexCoords := tex;
245

246
      MatName := FaceGroups.Items[0].MaterialName;
247
      FaceGroups.Clear;
248
      with TFGVertexIndexList.CreateOwned(FaceGroups) do
249
      begin
250
        MaterialName := MatName;
251
        VertexIndices := indices;
252
        Mode := fgmmTriangles;
253
      end;
254
    end;
255

256
    texIndices.Free;
257
    tex.Free;
258
    indices.Free;
259
    norms.Free;
260
    tris.Free;
261
  end;
262

263
  TargetMesh.StructureChanged;
264
end;
265

266
procedure TForm1.SubdivideBtnClick(Sender: TObject);
267
begin
268
  t := StartPrecisionTimer;
269
  SubdivideMesh(ffTerrain, SmoothTB.Position / 10);
270
  TimeLabel.Caption := TimeLabel.Caption +
271
    Format('Subdivide completed in %.1f ms' + #10#13,
272
    [StopPrecisionTimer(t) * 1000]);
273
end;
274

275
procedure TForm1.WireframeCBClick(Sender: TObject);
276
begin
277
  if (WireframeCB.Checked) then
278
    ffTerrain.Material.PolygonMode := pmLines
279
  else
280
  begin
281
    ffTerrain.Material.PolygonMode := pmFill;
282
  end;
283
end;
284

285
procedure TForm1.Timer1Timer(Sender: TObject);
286
begin
287
  Caption := Format('%.1f FPS -  %d Triangles', [GLSceneViewer1.FramesPerSecond,
288
    ffTerrain.MeshObjects.TriangleCount]);
289
  GLSceneViewer1.ResetPerformanceMonitor;
290
end;
291

292
procedure TForm1.GLCadencerProgress(Sender: TObject;
293
  const deltaTime, newTime: Double);
294
var
295
  deltax, deltay: Single;
296
  pt: TPoint;
297
begin
298
  if (IsLeftMouseDown or IsRightMouseDown) then
299
  begin
300
    GetCursorPos(pt);
301
    deltax := (MousePos.X - pt.X) / 5;
302
    deltay := (MousePos.Y - pt.Y) / 5;
303
    if (pt.X <> MousePos.X) or (pt.Y <> MousePos.Y) then
304
      SetCursorPos(MousePos.X, MousePos.Y);
305
  end;
306

307
  // rotate
308
  if IsLeftMouseDown then
309
  begin
310
    CamH.TurnAngle := CamH.TurnAngle + deltax;
311
    if CamH.TurnAngle >= 360 then
312
      CamH.TurnAngle := CamH.TurnAngle - 360;
313
    if CamH.TurnAngle < 0 then
314
      CamH.TurnAngle := CamH.TurnAngle + 360;
315

316
    // rotation of camera in half sphere
317
    if (CamV.PitchAngle - deltay < 89) and (CamV.PitchAngle - deltay > 0) then
318
      CamV.PitchAngle := CamV.PitchAngle - deltay;
319
  end
320
  else
321
  begin
322
    // moving camera (pan)
323
    if IsRightMouseDown then
324
    begin
325
      CamH.Move(-50 * deltay * deltaTime);
326
      CamH.Slide(50 * deltax * deltaTime);
327
    end;
328
  end;
329

330
  GLSceneViewer1.Invalidate;
331
end;
332

333
procedure TForm1.TexturedCBClick(Sender: TObject);
334
begin
335
  ffTerrain.Material.Texture.Enabled := TexturedCB.Checked;
336
end;
337

338
procedure TForm1.GLDirectOpenGL1Render(Sender: TObject;
339
  var rci: TGLRenderContextInfo);
340
var
341
  size: Single;
342
begin
343
  glPushAttrib(GL_ALL_ATTRIB_BITS);
344
  glMatrixMode(GL_PROJECTION);
345
  glPushMatrix;
346
  glLoadIdentity;
347
  glOrtho(0, GLSceneViewer1.Width, 0, GLSceneViewer1.Height, -1000, 1000);
348
  glMatrixMode(GL_MODELVIEW);
349
  glLoadIdentity;
350

351
  GLScene.SetupLights(GLScene.CurrentBuffer.LimitOf[limLights]);
352

353
  size := GLSceneViewer1.Height / 6;
354

355
  ffWindrose.ResetRotations;
356
  ffWindrose.PitchAngle := -CamV.PitchAngle + 90;
357
  ffWindrose.RollAngle := -CamH.TurnAngle;
358

359
  ffWindrose.Position.AsVector := VectorMake(size, size, 0);
360
  ffWindrose.Scale.AsVector := VectorMake(size, size, size);
361

362
  ffWindrose.Render(rci);
363

364
  glMatrixMode(GL_PROJECTION);
365
  glPopMatrix;
366
  glMatrixMode(GL_MODELVIEW);
367
  glPopAttrib;
368
end;
369

370
procedure TForm1.GLSceneViewer1MouseDown(Sender: TObject; Button: TMouseButton;
371
  Shift: TShiftState; X, Y: Integer);
372
begin
373
  if (ssRight in Shift) then
374
    IsRightMouseDown := True;
375

376
  if (ssLeft in Shift) then
377
  begin
378
    mx := X;
379
    my := Y;
380
    IsLeftMouseDown := True;
381
  end;
382

383
  Screen.Cursor := crNone;
384
  GetCursorPos(MousePos);
385
end;
386

387
procedure TForm1.GLSceneViewer1MouseUp(Sender: TObject; Button: TMouseButton;
388
  Shift: TShiftState; X, Y: Integer);
389
begin
390
  if Button = TMouseButton(mbLeft) then
391
    IsLeftMouseDown := False;
392

393
  if Button = TMouseButton(mbRight) then
394
    IsRightMouseDown := False;
395

396
  if not((ssLeft in Shift) or (ssRight in Shift)) then
397
    Screen.Cursor := crDefault;
398
end;
399

400
procedure TForm1.FormMouseWheel(Sender: TObject; Shift: TShiftState;
401
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
402
var
403
  DistDelta: Single;
404
begin
405
  with Camera do
406
  begin
407
    DistDelta := Power(1.1, WheelDelta / 240);
408

409
    if (DistanceToTarget > 10) or (WheelDelta > 0) then
410
      AdjustDistanceToTarget(DistDelta);
411
  end;
412
end;
413

414
end.
415