MathgeomGLS

1
unit fdGraphVol;
2

3
interface
4

5
uses
6
  Winapi.OpenGL,
7
  System.SysUtils,
8
  System.Variants,
9
  System.Classes,
10
  System.Types,
11
  System.Math,
12
  Vcl.Graphics,
13
  Vcl.Controls,
14
  Vcl.Forms,
15
  Vcl.Dialogs,
16
  Vcl.StdCtrls,
17
  Vcl.ComCtrls,
18
  Vcl.ToolWin,
19
  Vcl.ExtCtrls,
20

21
  GLS.Scene,
22
  GLS.Objects,
23
  GLS.Coordinates,
24
  GLS.VectorLists,
25
  GLS.SceneViewer,
26
  GLS.Nodes,
27
  GLS.BaseClasses,
28
  GLS.HUDObjects,
29
  GLS.BitmapFont,
30
  GLS.WindowsFont,
31
  GLS.RenderContextInfo,
32
  GLS.VectorGeometry,
33
  GLS.VectorTypes,
34
  GLS.Cadencer,
35
  GLS.Color,
36
  GLS.FileTGA,
37
  GLS.Graph;
38

39
type
40
  // ñòðàííàÿ òî÷êà ãðàôà, áåç Y
41
  T_Point = record
42
    X, Z: single;
43
    id: Integer;
44
    sub: array [0 .. 9] of single;
45
  end;
46

47
type
48
  TFormGrafvol = class(TForm)
49
    Memo1: TMemo;
50
    GLScene: TGLScene;
51
    GLSceneViewer: TGLSceneViewer;
52
    cam: TGLCamera;
53
    dcWorld: TGLDummyCube;
54
    dogl: TGLDirectOpenGL;
55
    sprite: TGLHUDSprite;
56
    txt1: TGLHUDText;
57
    GLWinBitFont: TGLWindowsBitmapFont;
58
    GLCadencer: TGLCadencer;
59
    Lines1: TGLLines;
60
    Lines2: TGLLines;
61
    Panel1: TPanel;
62
    Button1: TButton;
63
    Button2: TButton;
64
    Button3: TButton;
65
    Button4: TButton;
66
    grid1: TGLXYZGrid;
67
    grid2: TGLXYZGrid;
68
    txt2: TGLHUDText;
69
    pts: TGLPoints;
70
    cam_XY: TGLCamera;
71
    cam_XZ: TGLCamera;
72
    cam_YZ: TGLCamera;
73
    procedure FormCreate(Sender: TObject);
74
    procedure doglRender(Sender: TObject; var rci: TGLRenderContextInfo);
75
    procedure GLSceneViewerMouseDown(Sender: TObject; Button: TMouseButton;
76
      Shift: TShiftState; X, Y: Integer);
77
    procedure GLSceneViewerMouseUp(Sender: TObject; Button: TMouseButton;
78
      Shift: TShiftState; X, Y: Integer);
79
    procedure GLCadencerProgress(Sender: TObject;
80
      const deltaTime, newTime: Double);
81
    procedure Button1Click(Sender: TObject);
82
    procedure Button2Click(Sender: TObject);
83
    procedure Button3Click(Sender: TObject);
84
    procedure Button4Click(Sender: TObject);
85
  public
86
    procedure LoadData(aFileName: TFileName);
87
  private
88
    f, len: single;
89
    fs: TFormatSettings;
90
    p_cnt: Integer;
91
    m_turn: boolean; // = false;
92
    m_pos: TPoint;
93
    mx, my: Integer;
94
    points: array of T_Point; // âåðøèíû 3d ãðàôà
95
    PointFs: array of TPointF; // ìàññèâ âåðøèí 3d ãðàôà, â ïåðñïåêòèâå
96
    function _Getpid(s: string): TPoint;
97
  end;
98

99
var
100
  FormGrafvol: TFormGrafvol;
101

102
implementation // -------------------------------------------------------------
103

104
{$R *.dfm}
105

106
//
107
// FormCreate
108
//
109
procedure TFormGrafvol.FormCreate;
110
begin
111
  LoadData('data\datas');
112
end;
113

114
//
115
// Îïðåäåëåíèå òî÷êè âåðøèíû â ìàññèâå äàííûõ
116
//
117
function TFormGrafvol._Getpid(s: string): TPoint;
118
var
119
  f: single;
120
  Point: TPoint;
121
begin
122
  f := StrToFloat(s, fs);
123
  Point.X := Round(f) - 1;
124
  Point.Y := Round((f - Round(f)) * 100);
125
  Result := Point;
126
end;
127

128
//
129
// Çàãðóçêà äàííûõ
130
//
131
procedure TFormGrafvol.LoadData(aFileName: TFileName);
132
const
133
  c: array [1 .. 4] of cardinal = ($222222, $FF2222, $0000FF, $00FF00);
134
var
135
  s, t, u: TStringList;
136
  pi, li, pc, i, j, k: Integer;
137
  p1, p2, p3: TPoint;
138
  v1, v2, v3: TVector3f;
139
begin
140
  if not fileexists(aFileName) then
141
    exit;
142
  s := TStringList.Create;
143
  s.LoadFromFile(aFileName);
144
  pi := s.IndexOf('[points]');
145
  li := s.IndexOf('[links]');
146
  if (pi < 0) or (li < 0) then
147
  begin
148
    s.Free;
149
    exit;
150
  end;
151
  t := TStringList.Create;
152
  u := TStringList.Create;
153
  fs.DecimalSeparator := '.'; // ðàçäåëèòåëü òî÷êà
154
  // ïàðñèíã âåðøèí
155
  pc := 0;
156
  for i := pi + 1 to li - 1 do
157
    if Length(s[i]) > 7 then
158
      inc(pc);
159
  SetLength(points, pc);
160
  SetLength(PointFs, pc); // ïîêà íå èñïîëüçóåòñÿ
161
  p_cnt := 0;
162
  for i := 0 to pc - 1 do
163
  begin
164
    // ïîäãîòîâêà ìàññèâà
165
    for j := 0 to high(points[i].sub) do
166
      if j = 0 then
167
        points[i].sub[j] := 0
168
      else
169
        points[i].sub[j] := 9999;
170
    (*
171
      for j := 0 to high(PointFs[i].sub) do
172
      if j = 0 then
173
      PointFs[i].sub[j] := 0
174
      else
175
      PointFs[i].sub[j] := 9999;
176
    *)
177
    t.Text := stringReplace(s[i + pi + 1], ' ', #13#10, [rfReplaceAll]);
178
    // ïðèñâîåíèå çíà÷åíèé âåðøèíàì
179
    for j := 0 to t.Count - 1 do
180
    begin
181
      u.Text := stringReplace(t[j], ',', #13#10, [rfReplaceAll]);
182
      if u.Count = 3 then
183
      begin
184
        points[i].id := _Getpid(u[0]).X;
185
        points[i].X := StrToFloat(u[1], fs);
186
        points[i].Z := StrToFloat(u[2], fs);
187
        inc(p_cnt);
188
      end
189
      else
190
      begin
191
        points[i].sub[_Getpid(u[0]).Y] := StrToFloat(u[1], fs);
192
        inc(p_cnt);
193
      end;
194
    end;
195
  end;
196

197
  // óñòàíîâëåíèå ñâÿçè ñ ëèíèÿìè
198
  Lines1.Nodes.Clear;
199
  Lines2.Nodes.Clear;
200
  pts.Positions.Clear;
201
  pts.Colors.Clear;
202
  f := 0.11;
203
  for i := li + 1 to min(s.Count - 1, li + 5) do
204
  begin
205
    t.Text := stringReplace(s[i], ' ', #13#10, [rfReplaceAll]);
206
    for j := 0 to t.Count - 1 do
207
      if Length(t[j]) = 9 then
208
      begin
209
        u.Text := stringReplace(t[j], ':', #13#10, [rfReplaceAll]);
210
        p1 := _Getpid(u[0]);
211
        p2 := _Getpid(u[1]);
212
        if (points[p1.X].sub[p1.Y] = 9999) or (points[p2.X].sub[p2.Y] = 9999)
213
        then
214
          Continue;
215
        if points[p2.X].sub[p2.Y] > points[p1.X].sub[p1.Y] then
216
        begin
217
          p3 := p2;
218
          p2 := p1;
219
          p1 := p3;
220
        end;
221
        SetVector(v1, points[p1.X].X, points[p1.X].sub[p1.Y], points[p1.X].Z);
222
        // âåðøèíû âûøå è íèæå
223
        if (points[p2.X].sub[p2.Y] < 0) and (points[p1.X].sub[p1.Y] >= 0) then
224
        begin
225
          SetVector(v3, points[p2.X].X, points[p2.X].sub[p2.Y], points[p2.X].Z);
226
          // intersection with zero plane
227
          v2 := VectorLerp(v1, v3, -v1.Y / (v3.Y - v1.Y));
228
          pts.Positions.Add(v2);
229
          pts.Colors.Add(ConvertWinColor(c[i - li - 1]));
230

231
          len := vectorDistance(v2, v3);
232
          Lines2.Nodes.AddNode(v2);
233
          TGLLinesNode(Lines2.Nodes.Last).Color.AsWinColor := c[i - li - 1];
234
          Lines2.Nodes.AddNode(VectorLerp(v2, v3, 1 - f / len));
235
          TGLLinesNode(Lines2.Nodes.Last).Color.AsWinColor := c[i - li - 1];
236

237
          len := vectorDistance(v1, v2);
238
          Lines1.Nodes.AddNode(VectorLerp(v1, v2, f / len));
239
          TGLLinesNode(Lines1.Nodes.Last).Color.AsWinColor := c[i - li - 1];
240
          Lines1.Nodes.AddNode(v2);
241
          TGLLinesNode(Lines1.Nodes.Last).Color.AsWinColor := c[i - li - 1];
242
        end
243
        else
244
        begin
245
          SetVector(v2, points[p2.X].X, points[p2.X].sub[p2.Y], points[p2.X].Z);
246
          // îáå âåðøèíû íèæå
247
          if (points[p2.X].sub[p2.Y] < 0) and (points[p1.X].sub[p1.Y] < 0) then
248
          begin
249
            len := vectorDistance(v1, v2);
250
            Lines2.Nodes.AddNode(VectorLerp(v1, v2, f / len));
251
            TGLLinesNode(Lines2.Nodes.Last).Color.AsWinColor := c[i - li - 1];
252

253
            Lines2.Nodes.AddNode(VectorLerp(v1, v2, 1 - f / len));
254
            TGLLinesNode(Lines2.Nodes.Last).Color.AsWinColor := c[i - li - 1];
255
          end
256
          // îáå âåðøèíû âûøå
257
          else
258
          begin
259
            len := vectorDistance(v1, v2);
260
            Lines1.Nodes.AddNode(VectorLerp(v1, v2, f / len));
261
            TGLLinesNode(Lines1.Nodes.Last).Color.AsWinColor := c[i - li - 1];
262
            Lines1.Nodes.AddNode(VectorLerp(v1, v2, 1 - f / len));
263
            TGLLinesNode(Lines1.Nodes.Last).Color.AsWinColor := c[i - li - 1];
264
          end;
265
        end;
266
      end;
267
  end;
268
  s.Free;
269
  t.Free;
270
  u.Free;
271
end;
272

273
//
274
// vpMouseDown
275
//
276
procedure TFormGrafvol.GLSceneViewerMouseDown;
277
begin
278
  if Shift = [ssleft] then
279
  begin
280
    m_turn := True;
281
    m_pos := mouse.CursorPos;
282
  end;
283
end;
284

285
//
286
// vpMouseUp
287
//
288
procedure TFormGrafvol.GLSceneViewerMouseUp;
289
begin
290
  m_turn := False;
291
end;
292

293
//
294
// cadProgress
295
//
296
procedure TFormGrafvol.GLCadencerProgress;
297
begin
298
  if m_turn and (GLSceneViewer.Camera = cam) then
299
  begin
300
    with mouse.CursorPos do
301
      cam.MoveAroundTarget(m_pos.Y - Y, m_pos.X - X);
302

303
    m_pos := mouse.CursorPos;
304
  end;
305
  pts.Visible := GLSceneViewer.Camera = cam;
306

307
  Lines1.Visible := pts.Visible;
308
  Lines2.Visible := pts.Visible;
309
  grid1.Visible := pts.Visible;
310
  grid2.Visible := pts.Visible;
311
end;
312

313
//
314
// doglRender
315
//
316
procedure TFormGrafvol.doglRender;
317
var
318
  i, j, k: Integer;
319
  v: TGLVector;
320
  a1: array of record id, sub: Integer;
321
  sx, sy, depth: single;
322
end;
323

324
(* sub *) procedure shellSort;
325
var
326
  i, j, k, n: Integer;
327
  f: single;
328
begin
329
  k := high(a1) div 2;
330
  while k > 0 do
331
  begin
332
    for i := 0 to high(a1) - k do
333
    begin
334
      j := i;
335
      while (j >= 0) and (a1[j].depth < a1[j + k].depth) do
336
      begin
337
        n := a1[j].id;
338
        a1[j].id := a1[j + k].id;
339
        a1[j + k].id := n;
340
        n := a1[j].sub;
341
        a1[j].sub := a1[j + k].sub;
342
        a1[j + k].sub := n;
343
        f := a1[j].sx;
344
        a1[j].sx := a1[j + k].sx;
345
        a1[j + k].sx := f;
346
        f := a1[j].sy;
347
        a1[j].sy := a1[j + k].sy;
348
        a1[j + k].sy := f;
349
        f := a1[j].depth;
350
        a1[j].depth := a1[j + k].depth;
351
        a1[j + k].depth := f;
352
        if j > k then
353
          Dec(j, k)
354
        else
355
          j := 0;
356
      end;
357
    end;
358
    k := k div 2
359
  end;
360
end;
361

362
begin
363
  SetLength(a1, p_cnt);
364
  k := 0;
365
  for i := 0 to High(points) do
366
    for j := 0 to High(points[i].sub) do
367
    begin
368
      if points[i].sub[j] = 9999 then
369
        Continue;
370

371
      a1[k].id := points[i].id + 1;
372
      a1[k].sub := j;
373

374
      // ïîëîæåíèå è ðàññòîÿíèå äî êàìåðû
375
      with points[i] do
376
        SetVector(v, X, sub[j], Z);
377
      a1[k].depth := vectorNorm(vectorSubtract(v, cam.AbsolutePosition));
378

379
      // ïîçèöèÿ âåðøèíû â ýêðàííûõ êîîðäèíàòàõ
380
      v := GLSceneViewer.Buffer.WorldToScreen(v);
381
      a1[k].sx := v.X;
382
      a1[k].sy := GLSceneViewer.Height - v.Y;
383
      inc(k);
384
    end;
385

386
  // ñîðòèðîâêà ðàññòîÿíèé äî êàìåðû
387
  shellSort;
388
  for i := 0 to p_cnt - 1 do
389
    with a1[i] do
390
    begin
391
      sprite.Position.SetPoint(sx, sy, 0);
392
      sprite.Render(rci);
393
      txt1.Position.SetPoint(sx - 2, sy, 0);
394
      txt1.Text := IntToStr(id);
395
      txt1.Render(rci);
396

397
      if sub > 0 then
398
      begin
399
        txt2.Position.SetPoint(sx + GLWinBitFont.TextWidth(txt1.Text) / 2 + 1,
400
          sy - GLWinBitFont.CharHeight / 2 + 7, 0);
401
        txt2.Text := IntToStr(sub);
402
        txt2.Render(rci);
403
      end;
404
    end;
405
end;
406

407
// --------------------------------------------------------------------
408
procedure TFormGrafvol.Button1Click(Sender: TObject);
409
begin
410
  GLSceneViewer.Camera := cam_XY;
411
end;
412

413
procedure TFormGrafvol.Button2Click(Sender: TObject);
414
begin
415
  GLSceneViewer.Camera := cam_XZ
416
end;
417

418
procedure TFormGrafvol.Button3Click(Sender: TObject);
419
begin
420
  GLSceneViewer.Camera := cam_YZ;
421
end;
422

423
procedure TFormGrafvol.Button4Click(Sender: TObject);
424
begin
425
  GLSceneViewer.Camera := cam;
426
end;
427

428
end.
429