ArenaZ

1
unit umainform;
2

3
{$IFDEF FPC}
4
  {$MODE Delphi}
5
{$ENDIF}
6

7
interface
8

9
uses
10
{$IFnDEF FPC}
11
  Windows,
12
{$ELSE}
13
  LCLIntf, LCLType, LMessages,
14
{$ENDIF}
15
  Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
16
  Dialogs, ExtCtrls, Contnrs, ComCtrls, Buttons, StdCtrls,
17
  //GLS
18
  GLLCLViewer, GLScene, GLVectorFileObjects, GLState,
19
  GLTexture, GLObjects, GLVectorGeometry, GLVectorTypes, OpenGLTokens,
20
  GLMaterial, GLCoordinates, GLCrossPlatform, GLBaseClasses, FileUtil;
21

22
type
23
  TModifierCube = class(TGLCube)
24
  public
25
    FVectorIndex : Integer;
26
    FMeshObjIndex : Integer;
27
    constructor Create(AOwner: TComponent); override;
28
  end;
29

30
  { TfrmMain }
31

32
  TfrmMain = class(TForm)
33
    Label2: TLabel;
34
    Panel2: TPanel;
35
    Panel3: TPanel;
36
    GLSceneViewer: TGLSceneViewer;
37
    GLScene: TGLScene;
38
    GLCamera: TGLCamera;
39
    GLFreeForm: TGLFreeForm;
40
    Label1: TLabel;
41
    cbPolygonMode: TComboBox;
42
    dcModifiers: TGLDummyCube;
43
    chbViewPoints: TCheckBox;
44
    StatusBar: TStatusBar;
45
    GroupBox1: TGroupBox;
46
    chbShowAxis: TCheckBox;
47
    Label3: TLabel;
48
    Label4: TLabel;
49
    Label5: TLabel;
50
    Label6: TLabel;
51
    tbPos: TTrackBar;
52
    GroupBox2: TGroupBox;
53
    rbXY: TRadioButton;
54
    rbZY: TRadioButton;
55
    GLLightSource1: TGLLightSource;
56
    GroupBox3: TGroupBox;
57
    btnVertex: TBitBtn;
58
    btnNormals: TBitBtn;
59
    btnTextcoords: TBitBtn;
60
    btnGroups: TBitBtn;
61
    GLMaterialLibrary1: TGLMaterialLibrary;
62
    procedure FormCreate(Sender: TObject);
63
    procedure GLSceneViewerMouseDown(Sender: TObject;
64
      Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
65
    procedure GLSceneViewerMouseMove(Sender: TObject; Shift: TShiftState;
66
      X, Y: Integer);
67
    procedure cbPolygonModeChange(Sender: TObject);
68
    procedure FormDestroy(Sender: TObject);
69
    procedure chbViewPointsClick(Sender: TObject);
70
    procedure GLSceneViewerMouseUp(Sender: TObject; Button: TMouseButton;
71
      Shift: TShiftState; X, Y: Integer);
72
    procedure chbShowAxisClick(Sender: TObject);
73
    procedure tbPosChange(Sender: TObject);
74
    procedure GLSceneViewerBeforeRender(Sender: TObject);
75
    procedure btnVertexClick(Sender: TObject);
76
    procedure btnNormalsClick(Sender: TObject);
77
    procedure btnTextcoordsClick(Sender: TObject);
78
    procedure btnGroupsClick(Sender: TObject);
79
  private
80
    //Private declarations
81
  private
82
    { Private declarations }
83
    FOldX, FOldY      : Integer;
84
    FModifierList     : TObjectList;
85
    FSelectedModifier : TModifierCube;
86
    FMoveZ            : Boolean;
87
    FOldMouseWorldPos : TVector;
88

89
    {Create cubes used to modify vertex points}
90
    procedure SetVertexModifiers;
91
    {Populate statusbar with object information}
92
    procedure ShowModifierStatus(const aObj : TModifierCube);
93
    {Change the mesh vector property for the selected modifier.}
94
    procedure ChangeMeshVector(const aObj : TModifierCube; const aPos : TVector4f);
95
    {Identify mouse position in X, Y and Z axis}
96
    function MouseWorldPos(x, y : Integer) : TVector;
97
    {Strip redundent data, recalculate normals and faces}
98
    procedure StripAndRecalc;
99
    {Set Freeform's polygon mode: line, fill or points}
100
  public
101
    { Public declarations }
102
  end;
103

104
var
105
  frmMain: TfrmMain;
106

107
implementation
108

109
uses
110
  GLPersistentClasses, GLVectorLists,MeshData, GLMeshUtils,
111
  GLFile3DS,  GLColor, GLContext;
112

113
{$IFnDEF FPC}
114
  {$IFnDEF FPC}
115
  {$R *.lfm}
116
{$ELSE}
117
  {$R *.lfm}
118
{$ENDIF}
119
{$ELSE}
120
  {$R *.lfm}
121
{$ENDIF}
122

123
const
124
  {Default combobox index for startup}
125
  CLinePolyMode  = 1;
126
  {Scale dimention}
127
  CModifierDim   = 0.04;
128

129
var
130
  {Modifier colors}
131
  CModColorNormal : TColorVector;
132
  CModColorSelect : TColorVector;
133

134
constructor TModifierCube.Create(AOwner: TComponent);
135
begin
136
  inherited;
137
  {Set the modifiers initial size and color}
138
  CubeWidth  := CModifierDim;
139
  CubeHeight := CModifierDim;
140
  CubeDepth  := CModifierDim;
141
  Material.FrontProperties.Diffuse.Color := CModColorNormal;
142
end;
143

144

145
procedure TfrmMain.FormCreate(Sender: TObject);
146
var
147
  lsDir : String;
148
  lsFileName : String;
149
begin
150
  {Do initial setup}
151
  FModifierList := TObjectList.Create;
152
  CModColorNormal := clrCoral;
153
  CModColorSelect := clrSkyBlue;
154

155
  lsDir := ExtractFileDir(Application.ExeName);
156
  lsFileName := Format('%s\media\cube.3ds', [lsDir]);
157
  if FileExistsUTF8(lsFileName) { *Converti depuis FileExists* } then
158
  begin
159
    GLFreeForm.LoadFromFile(lsFileName);
160
    StripAndRecalc;
161
    SetVertexModifiers;
162
  end;
163

164
  cbPolygonMode.ItemIndex := CLinePolyMode;
165
end;
166

167
procedure TfrmMain.GLSceneViewerMouseDown(Sender: TObject;
168
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
169
var
170
  lObj : TGLBaseSceneObject;
171
begin
172
  FOldX := X; FOldY := Y;
173
  {If selecting a different modifier, change the last one's color back to default}
174
  if Assigned(FSelectedModifier) then
175
     FSelectedModifier.Material.FrontProperties.Diffuse.Color := CModColorNormal;
176

177

178
  {Get selected objects}
179
  if not (ssCtrl in Shift) then
180
    Exit;
181

182
  {Check if selected object is a modifier.
183
   If so, change modifiers color as to indicated selected modifier.}  
184
  lObj := GLSceneViewer.Buffer.GetPickedObject(X, Y);
185
  if (lObj is TModifierCube) then
186
  begin
187
    FSelectedModifier := TModifierCube(lObj);
188
    FSelectedModifier.Material.FrontProperties.Diffuse.Color := CModColorSelect;
189
    FSelectedModifier.NotifyChange(FSelectedModifier);
190
    ShowModifierStatus(TModifierCube(lObj));
191

192
    FMoveZ := rbZY.Checked;
193
    FOldMouseWorldPos := MouseWorldPos(X, Y);
194
  end;
195
end;
196

197
procedure TfrmMain.GLSceneViewerMouseMove(Sender: TObject;
198
  Shift: TShiftState; X, Y: Integer);
199
var
200
  lCurrentPos : TVector;
201
  lOldV       : TVector3f;
202
  lDiff       : TVector4f;
203
begin
204
  {If ctrl is not in use, move around freeform}
205
  if (ssLeft in Shift) and (not (ssCtrl in Shift)) then
206
  begin
207
    GLCamera.MoveAroundTarget(FOldY - Y, FOldX - X);
208
    FOldX := X; FOldY := Y;
209
    Exit;
210
  end;
211

212
  {Move modifier and change relevant vertex data}
213
  if (ssLeft in Shift) then
214
  begin
215
    FMoveZ := rbZY.Checked;
216

217
    lCurrentPos := MouseWorldPos(X, Y);
218
    if Assigned(FSelectedModifier) and (VectorNorm(FOldMouseWorldPos) <> 0) then
219
    begin
220
      MakeVector(lOldV, FSelectedModifier.Position.X, FSelectedModifier.Position.Y, FSelectedModifier.Position.Z);
221
      lDiff := VectorSubtract(lCurrentPos, FOldMouseWorldPos);
222
      FSelectedModifier.Position.Translate(lDiff);
223
      ChangeMeshVector(FSelectedModifier, lDiff);
224
    end;
225
    FOldMouseWorldPos := lCurrentPos;
226
  end;
227
end;
228

229
procedure TfrmMain.cbPolygonModeChange(Sender: TObject);
230
begin
231
  case cbPolygonMode.ItemIndex of
232
   0: GLFreeForm.Material.PolygonMode := pmFill;
233
   1: GLFreeForm.Material.PolygonMode := pmLines;
234
   2: GLFreeForm.Material.PolygonMode := pmPoints;
235
  end;
236

237

238
end;
239

240
procedure TfrmMain.SetVertexModifiers;
241
  procedure ScaleVector(var V1, V2 : TVector3F);
242
  begin
243
    V1.X := V1.X * V2.X;
244
    V1.Y := V1.Y * V2.Y;
245
    V1.Z := V1.Z * V2.Z;
246
  end;
247
var
248
  i, j : Integer;
249
  lVector, lScale : TVector3F;
250
  lModifier : TModifierCube;
251
begin
252
  FModifierList.Clear;
253
  GLScene.BeginUpdate;
254
  try
255
    with GLFreeForm.MeshObjects do
256
    begin
257
      for i := 0 to Count - 1 do
258
        for j := 0 to Items[i].Vertices.Count - 1 do
259
        begin
260
          lVector := Items[i].Vertices.Items[j];
261
          lModifier := TModifierCube.Create(nil);
262
          lModifier.FVectorIndex := j;
263
          lModifier.FMeshObjIndex := i;
264

265
          FModifierList.Add(lModifier);
266
          GLScene.Objects.AddChild(lModifier);
267

268
          lScale := GLFreeForm.Scale.AsAffineVector;
269
          ScaleVector(lVector, lScale);
270
          lModifier.Position.Translate(lVector);
271
        end;
272
    end;
273
  finally
274
    GLScene.EndUpdate;
275
  end;
276
end;
277

278
procedure TfrmMain.FormDestroy(Sender: TObject);
279
begin
280
  FModifierList.Clear;
281
  FreeAndNil(FModifierList);
282
end;
283

284
procedure TfrmMain.chbViewPointsClick(Sender: TObject);
285
var
286
  i : Integer;
287
begin
288
  GLScene.BeginUpdate;
289
  try
290
    for i := 0 to FModifierList.Count - 1 do
291
      TModifierCube(FModifierList.Items[i]).Visible := chbViewPoints.Checked;
292
  finally
293
    GLScene.EndUpdate;
294
  end;
295
end;
296

297
procedure TfrmMain.ShowModifierStatus(const aObj: TModifierCube);
298
begin
299
  if aObj = nil then
300
    StatusBar.Panels[0].Text := ''
301
  else
302
    StatusBar.Panels[0].Text := Format('Modifier vector index [%d]', [aObj.FVectorIndex]);
303
end;
304

305
function TfrmMain.MouseWorldPos(x, y: Integer): TVector;
306
var
307
  v : TVector;
308
begin
309
  y := GLSceneViewer.Height - y;
310

311
  if Assigned(FSelectedModifier) then
312
  begin
313
    SetVector(v, x, y, 0);
314
    if FMoveZ then
315
      GLSceneViewer.Buffer.ScreenVectorIntersectWithPlaneXZ(v, FSelectedModifier.Position.Y, Result)
316
    else
317
      GLSceneViewer.Buffer.ScreenVectorIntersectWithPlaneXY(v, FSelectedModifier.Position.Z, Result);
318
  end
319
  else
320
    SetVector(Result, NullVector);
321
end;
322

323
procedure TfrmMain.ChangeMeshVector(const aObj : TModifierCube; const aPos : TVector4f);
324
var
325
  lVIndex,
326
  lMIndex  : Integer;
327
  v        : TVector3f;
328
begin
329
  if aObj = nil then
330
    Exit;
331

332
  lVIndex := aObj.FVectorIndex;
333
  lMIndex := aObj.FMeshObjIndex;
334

335
  {Get new vertex position, keep freeform scale in mind and redraw freeform.}
336
  MakeVector(v, aPos.X/CModifierDim, aPos.Y/CModifierDim, aPos.Z/CModifierDim);
337
  GLFreeForm.MeshObjects.Items[lMIndex].Vertices.TranslateItem(lVIndex, v);
338
  GLFreeForm.StructureChanged;
339
end;
340

341
procedure TfrmMain.GLSceneViewerMouseUp(Sender: TObject;
342
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
343
begin
344
  if Assigned(FSelectedModifier) then
345
  begin
346
    FSelectedModifier.Material.FrontProperties.Diffuse.Color := CModColorNormal;
347
    FSelectedModifier := nil;
348
    {Recalculate structure and redraw freeform}
349
    StripAndRecalc;
350
    {Reset vertex modifiers and their data.}
351
    SetVertexModifiers;
352
  end;
353
end;
354

355
procedure TfrmMain.chbShowAxisClick(Sender: TObject);
356
begin
357
  dcModifiers.ShowAxes := TCheckBox(Sender).Checked;
358
end;
359

360
procedure TfrmMain.tbPosChange(Sender: TObject);
361
begin
362
  GLCamera.Position.Z := tbPos.Position;
363

364
end;
365

366
procedure TfrmMain.GLSceneViewerBeforeRender(Sender: TObject);
367
begin
368
  gl.Enable(GL_NORMALIZE);
369
end;
370

371
procedure TfrmMain.btnVertexClick(Sender: TObject);
372
var
373
  i, j    : Integer;
374
  lList   : TStringList;
375
  lVector : TVector3f;
376
begin
377
  lList := TStringList.Create;
378
  try
379
    with GLFreeForm.MeshObjects do
380
      for i := 0 to Count - 1 do
381
      begin
382
        lList.Add('For mesh object ' + IntToStr(i));
383
        for j := 0 to Items[i].Vertices.Count - 1 do
384
        begin
385
          lVector := Items[i].Vertices.Items[j];
386
          lList.Add(Format('%f %f %f', [lVector.X, lVector.Y, lVector.Z]));
387
        end;
388
      end;
389
    ShowMeshData(lList);
390
  finally
391
    FreeAndNil(lList);
392
  end;
393
end;
394

395
procedure TfrmMain.btnNormalsClick(Sender: TObject);
396
var
397
  i, j    : Integer;
398
  lList   : TStringList;
399
  lVector : TVector3f;
400
begin
401
  lList := TStringList.Create;
402
  try
403
    with GLFreeForm.MeshObjects do
404
      for i := 0 to Count - 1 do
405
      begin
406
        lList.Add('For mesh object ' + IntToStr(i));
407
        for j := 0 to Items[i].Normals.Count - 1 do
408
        begin
409
          lVector := Items[i].Normals.Items[j];
410
          lList.Add(Format('%f %f %f', [lVector.X, lVector.Y, lVector.Z]));
411
        end;
412
      end;
413
    ShowMeshData(lList);
414
  finally
415
    FreeAndNil(lList);
416
  end;
417
end;
418

419
procedure TfrmMain.btnTextcoordsClick(Sender: TObject);
420
var
421
  i, j    : Integer;
422
  lList   : TStringList;
423
  lVector : TVector3f;
424
begin
425
  lList := TStringList.Create;
426
  try
427
    with GLFreeForm.MeshObjects do
428
      for i := 0 to Count - 1 do
429
      begin
430
        lList.Add('For mesh object ' + IntToStr(i));
431
        for j := 0 to Items[i].TexCoords.Count - 1 do
432
        begin
433
          lVector := Items[i].TexCoords.Items[j];
434
          lList.Add(Format('%f %f %f', [lVector.X, lVector.Y, lVector.Z]));
435
        end;
436
      end;
437
    ShowMeshData(lList);
438
  finally
439
    FreeAndNil(lList);
440
  end;
441
end;
442

443
procedure TfrmMain.btnGroupsClick(Sender: TObject);
444
var
445
  i    : Integer;
446
  lList   : TStringList;
447
begin
448
  lList := TStringList.Create;
449
  try
450
    with GLFreeForm.MeshObjects do
451
      for i := 0 to Count - 1 do
452
      begin
453
        lList.Add('For mesh object ' + IntToStr(i));
454
        lList.Add(IntToStr(Items[i].TriangleCount));
455
      end;
456
    ShowMeshData(lList);
457
  finally
458
    FreeAndNil(lList);
459
  end;
460
end;
461

462
procedure TfrmMain.StripAndRecalc;
463
var
464
  lTrigList,
465
  lNormals    : TAffineVectorList;
466
  lIndices    : TIntegerList;
467
  lObj        : TGLMeshObject;
468
  lStrips     : TPersistentObjectList;
469

470
  lFaceGroup  : TFGVertexIndexList;
471
  i           : Integer;
472
begin
473
  // Extract raw triangle data to work with.
474
  lTrigList := GLFreeForm.MeshObjects.ExtractTriangles;
475

476
  // Builds a vector-count optimized indices list.
477
  lIndices := BuildVectorCountOptimizedIndices(lTrigList);
478
  // Alter reference/indice pair and removes unused reference values.
479
  RemapAndCleanupReferences(lTrigList, lIndices);
480
   // Calculate normals.
481
  lNormals := BuildNormals(lTrigList, lIndices);
482

483
  // Strip where posible.
484
  lStrips := StripifyMesh(lIndices, lTrigList.Count, True);
485

486
  // Clear current mesh object data.
487
  GLFreeForm.MeshObjects.Clear;
488

489
  // Setup new mesh object.
490
  lObj := TGLMeshObject.CreateOwned(GLFreeForm.MeshObjects);
491
  lObj.Vertices := lTrigList;
492
  lObj.Mode := momFaceGroups;
493
  lObj.Normals := lNormals;
494

495
  for i:=0 to lStrips.Count-1 do
496
  begin
497
    lFaceGroup := TFGVertexIndexList.CreateOwned(lObj.FaceGroups);
498
    lFaceGroup.VertexIndices := (lStrips[i] as TIntegerList);
499
    if i > 0 then
500
      lFaceGroup.Mode := fgmmTriangleStrip
501
    else
502
      lFaceGroup.Mode := fgmmTriangles;
503
    lFaceGroup.MaterialName:=IntToStr(i and 15);
504
  end;
505
  // Redraw freeform
506
  GLFreeForm.StructureChanged;
507

508
  lTrigList.Free;
509
  lNormals.Free;
510
  lIndices.Free;
511
end;
512

513
end.
514