MathgeomGLS

1
unit fPlot3D;
2

3
interface
4

5
uses
6
  Winapi.Windows,
7
  Winapi.Messages,
8
  System.SysUtils,
9
  System.Variants,
10
  System.Classes,
11
  System.IniFiles,
12
  System.DateUtils,
13
  System.UITypes,
14
  System.Math,
15
  Vcl.Graphics,
16
  Vcl.Controls,
17
  Vcl.Forms,
18
  Vcl.Dialogs,
19
  Vcl.ComCtrls,
20
  Vcl.Menus,
21
  Vcl.ExtDlgs,
22

23
  GLS.OpenGLTokens,
24
  GLS.PersistentClasses,
25
  GLS.Scene,
26
  GLS.VectorTypes,
27
  GLS.GeomObjects,
28
  GLS.HUDObjects,
29
  GLS.Objects,
30
  GLS.Graph,
31
  GLS.Coordinates,
32

33
  GLS.SceneViewer,
34
  GLS.BitmapFont,
35
  GLS.WindowsFont,
36
  GLS.Particles,
37
  GLS.Color,
38
  GLS.BaseClasses,
39
  GLS.VectorGeometry,
40
  GLS.State,
41
  GLS.Material,
42

43
  uGlobal,
44
  uParser,
45
  fEvaluate,
46
  fGridColors,
47
  fAddPlotColors,
48
  fCoordOptions,
49
  fGridOptions,
50
  fDerivativeOptions,
51
  fPlotColors,
52
  fAbout;
53

54
type
55
  TViewForm = class(TForm)
56
    GLSViewer: TGLSceneViewer;
57
    GLScene: TGLScene;
58
    GLLight: TGLLightSource;
59
    CameraCube: TGLDummyCube;
60
    Camera: TGLCamera;
61
    GLxyGrid: TGLXYZGrid;
62
    Fields: TGLDummyCube;
63
    GLWinBmpFont: TGLWindowsBitmapFont;
64
    StatusBar: TStatusBar;
65
    MainMenu: TMainMenu;
66
    File1: TMenuItem;
67
    New1: TMenuItem;
68
    Options1: TMenuItem;
69
    DefaultLayout1: TMenuItem;
70
    OpenFile: TMenuItem;
71
    Save1: TMenuItem;
72
    Saveas1: TMenuItem;
73
    Exit1: TMenuItem;
74
    Grid1: TMenuItem;
75
    GridColours1: TMenuItem;
76
    Evaluate1: TMenuItem;
77
    GLxzGrid: TGLXYZGrid;
78
    GLyzGrid: TGLXYZGrid;
79
    TargetCube: TGLDummyCube;
80
    xCoordLine: TGLLines;
81
    yCoordLine: TGLLines;
82
    zCoordLine: TGLLines;
83
    BoxLine1: TGLLines;
84
    BoxLine2: TGLLines;
85
    BoxLine3: TGLLines;
86
    BoxLine4: TGLLines;
87
    CoordText1: TMenuItem;
88
    YCoordsCube: TGLDummyCube;
89
    XCoordsCube: TGLDummyCube;
90
    ZCoordsCube: TGLDummyCube;
91
    xArrow: TGLArrowLine;
92
    yArrow: TGLArrowLine;
93
    Recent1: TMenuItem;
94
    DerivativeOps: TMenuItem;
95
    AddedField: TGLDummyCube;
96
    AddXLine: TGLLines;
97
    AddYLine: TGLLines;
98
    AddZLine: TGLLines;
99
    PlotColours1: TMenuItem;
100
    DerivativePlotColours1: TMenuItem;
101
    VolumeLines: TGLDummyCube;
102
    N2: TMenuItem;
103
    N3: TMenuItem;
104
    N4: TMenuItem;
105
    Help1: TMenuItem;
106
    About1: TMenuItem;
107
    procedure FormCreate(Sender: TObject);
108
    procedure FormShow(Sender: TObject);
109
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
110
    procedure GLSViewerMouseDown(Sender: TObject; Button: TMouseButton;
111
      Shift: TShiftState; X, Y: Integer);
112
    procedure GLSViewerMouseMove(Sender: TObject; Shift: TShiftState;
113
      X, Y: Integer);
114
    procedure GLSViewerMouseUp(Sender: TObject; Button: TMouseButton;
115
      Shift: TShiftState; X, Y: Integer);
116
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
117
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
118
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
119
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
120
    procedure DefaultLayout1Click(Sender: TObject);
121
    procedure Exit1Click(Sender: TObject);
122
    procedure Grid1Click(Sender: TObject);
123
    procedure GridColours1Click(Sender: TObject);
124
    procedure Evaluate1Click(Sender: TObject);
125
    procedure New1Click(Sender: TObject);
126
    procedure OpenFileClick(Sender: TObject);
127
    procedure Save1Click(Sender: TObject);
128
    procedure Saveas1Click(Sender: TObject);
129
    procedure FormDestroy(Sender: TObject);
130
    procedure FormActivate(Sender: TObject);
131
    procedure CoordText1Click(Sender: TObject);
132
    procedure RecentFilesClick(Sender: TObject);
133
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
134
    procedure DerivativeOpsClick(Sender: TObject);
135
    procedure PlotColours1Click(Sender: TObject);
136
    procedure DerivativePlotColours1Click(Sender: TObject);
137
    procedure About1Click(Sender: TObject);
138
  private
139
    AtStart: Boolean;
140
    SelectedData: TPlotData; // data used to evaluate dz/dx or dz/dy
141
    procedure ShowCameraLocation;
142
    procedure ShowFocalLength;
143
    procedure ShowLightLocation;
144
    procedure DefaultView;
145
    procedure DefaultLayout;
146
    procedure Formulate(const X, Y: Single; var z: Single;
147
      var Color: TGLColorVector; var texPoint: TTexPoint);
148
    procedure CreateHeightFields(const n: Integer);
149
    procedure PlotFunctions;
150
    procedure CreateAddedField;
151
    procedure PlotDerivativeField;
152
    procedure PlotIntegralField;
153
  public
154
    MousePoint: TPoint;
155
    procedure ShowDisplacement;
156
    procedure UpdatePlot;
157
    procedure UpdateAdded;
158
    procedure ClearAddedField;
159
    procedure ClearAddedLines;
160
  end;
161

162
const
163
  crLightxz = 1;
164
  crLightyz = 2;
165
  crLightxy = 3;
166
  crSlidexy = 4;
167
  crSlideyz = 5;
168
  crSlidexz = 6;
169
  crRotate = 7;
170
  crZoom = 8;
171
  crHandMove = 9;
172
  crSlidezy = 10;
173

174
var
175
  ViewForm: TViewForm;
176

177
// =====================================================================
178
implementation
179
// =====================================================================
180

181
{$R *.dfm}
182
{$R CURSORS.RES}
183

184
uses
185
  fFunctions;
186

187
procedure TViewForm.FormCreate(Sender: TObject);
188
begin
189
  BinPath := ExtractFilePath(ParamStr(0));
190
  BinPath := IncludeTrailingPathDelimiter(BinPath);
191
//  PlotPath := BinPath;
192
//  Delete(PlotPath, Length(PlotPath) - 4, 4);
193
  DataPath := BinPath + 'Examples\'; // PlotPath
194
  SetCurrentDir(DataPath);
195
  ImagePath := BinPath + 'Images\';
196
  LayoutFName := BinPath + 'Layout.lay';
197
  RecentFName := BinPath + 'Recent.ini';
198

199
  Screen.Cursors[crLightxy] := LoadCursor(HInstance, 'LIGHTXY');
200
  Screen.Cursors[crLightyz] := LoadCursor(HInstance, 'LIGHTYZ');
201
  Screen.Cursors[crLightxz] := LoadCursor(HInstance, 'LIGHTXZ');
202
  Screen.Cursors[crSlidexy] := LoadCursor(HInstance, 'SLIDEXY');
203
  Screen.Cursors[crSlidexz] := LoadCursor(HInstance, 'SLIDEXZ');
204
  Screen.Cursors[crSlideyz] := LoadCursor(HInstance, 'SLIDEYZ');
205
  Screen.Cursors[crRotate] := LoadCursor(HInstance, 'ROTATE');
206
  Screen.Cursors[crZoom] := LoadCursor(HInstance, 'ZOOM');
207
  Screen.Cursors[crSlidezy] := LoadCursor(HInstance, 'SLIDEZY');
208
  AtStart := True;
209
end;
210

211
procedure TViewForm.FormShow(Sender: TObject);
212
var
213
  LayFile: File of TLayout;
214
  ini: TIniFile;
215
  i, c: Integer;
216
  s: string;
217

218
begin
219
  if FileExists(LayoutFName) then
220
  begin
221
    try
222
      AssignFile(LayFile, LayoutFName);
223
      try
224
        Reset(LayFile);
225
        Read(LayFile, Layout);
226
      finally
227
        CloseFile(LayFile);
228
      end;
229
      with Layout do
230
      begin
231
        if IsMaximize then
232
          WindowState := wsMaximized
233
        else
234
        begin
235
          WindowState := wsNormal;
236
          Left := MainLeft;
237
          Top := MainTop;
238
          Width := MainWidth;
239
          Height := MainHeight;
240
        end;
241
        GraphFName := CurrentGraphFName;
242
        DataPath := CurrentDataPath;
243
        ImagePath := CurrentImagePath;
244
        // FunctionsForm
245
        FunctionsForm.Left := FuncLeft;
246
        FunctionsForm.Top := FuncTop;
247
        FunctionsForm.Width := FuncWidth;
248
        FunctionsForm.Height := FuncHeight;
249
        // GridOptionsForm
250
        if GridsVisible then
251
          GridOptionsForm.Show;
252
        GridOptionsForm.Left := GridsLeft;
253
        GridOptionsForm.Top := GridsTop;
254
        // GridColorsForm
255
        GridColorsForm.Left := GridColorsLeft;
256
        GridColorsForm.Top := GridColorsTop;
257
        // PlotColorsForm
258
        PlotColorsForm.Left := PlotColorsLeft;
259
        PlotColorsForm.Top := PlotColorsTop;
260
        // EvaluateForm
261
        if EvaluateVisible then
262
          EvaluateForm.Show;
263
        EvaluateForm.Left := EvaluateLeft;
264
        EvaluateForm.Top := EvaluateTop;
265
        // CoordsForm
266
        if CoordVisible then
267
          CoordsForm.Show;
268
        CoordsForm.Left := CoordLeft;
269
        CoordsForm.Top := CoordTop;
270
        // DerivativesForm
271
        DerivativesForm.Left := DerivLeft;
272
        DerivativesForm.Top := DerivTop;
273
        // AddPlotColorsForm
274
        AddPlotColorsForm.Left := AddColorsLeft;
275
        AddPlotColorsForm.Top := AddColorsTop;
276
      end;
277
      FunctionsForm.EditMinX.SetFocus;
278
    except
279
      MessageDlg('File Error! An Error has occurred when attempting to read' +
280
        #13#10'"' + LayoutFName + '".' +
281
        #13#10'The default layout will be used.', mtError, [mbOK], 0);
282
      DefaultLayout;
283
    end;
284
  end
285
  else
286
    DefaultLayout;
287

288
  ShowCameraLocation;
289
  // focallength: right mouse drag up/down
290
  ShowFocalLength;
291
  (* displace origin: x axis: ctrl/left mouse drag left/right
292
    y axis: alt/left mouse drag up/down
293
    z axis: ctrl/left mouse drag up/down *)
294
  ShowDisplacement;
295
  (* move light: x axis: ctrl right mouse drag left/right
296
    y axis: alt right mouse drag up/down
297
    z axis: ctrl right mouse drag up/down *)
298
  ShowLightLocation;
299

300
  FunctionsForm.ReadAndShowInitialData;
301
  Caption := GraphFName;
302
  Altered := False;
303
  CreateHeightFields(FunctionsForm.CheckListBox.Count);
304

305
  ini := TIniFile.Create(RecentFName);
306
  with ini do
307
    try
308
      c := ReadInteger(Name, 'RecentCount', 0);
309
      for i := 0 to c - 1 do
310
      begin
311
        Recent1.Add(TMenuItem.Create(Self));
312
        Recent1.Items[i].Caption := ReadString(Name, IntToStr(i), '');
313
        Recent1.Items[i].OnClick := RecentFilesClick;
314
      end;
315
    finally
316
      Free;
317
    end;
318
end;
319

320
procedure TViewForm.FormActivate(Sender: TObject);
321
begin
322
  if AtStart then
323
  begin
324
    PlotFunctions;
325
    if GridColorsForm.Visible then
326
      GridColorsForm.ShowGridColorData;
327
    if PlotColorsForm.Visible then
328
      PlotColorsForm.ShowPlotColorData;
329
    AtStart := False;
330
  end;
331
end;
332

333
procedure TViewForm.FormClose(Sender: TObject; var Action: TCloseAction);
334
var
335
  ini: TIniFile;
336
  i: Integer;
337
begin
338
  ini := TIniFile.Create(RecentFName);
339
  try
340
    ini.WriteInteger(Name, 'RecentCount', Recent1.Count);
341
    for i := 0 to Recent1.Count - 1 do
342
      ini.WriteString(Name, IntToStr(i), Recent1.Items[i].Caption);
343
  finally
344
    ini.Free;
345
  end;
346
end;
347

348
procedure TViewForm.FormDestroy(Sender: TObject);
349
begin
350
  while Fields.Count > 0 do
351
    TGLHeightField(Fields.Children[0]).Free;
352
  ClearAddedField;
353
  ClearAddedLines;
354
end;
355

356
procedure TViewForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
357
var
358
  f: File of TLayout;
359

360
begin
361
  with Layout do
362
  begin
363
    IsMaximize := (Width >= Screen.Width) and (Height >= Screen.Height);
364
    MainLeft := Left;
365
    MainTop := Top;
366
    MainWidth := Width;
367
    MainHeight := Height;
368
    if GraphFName = '' then
369
      GraphFName := NewFName;
370
    CurrentGraphFName := GraphFName;
371
    CurrentDataPath := DataPath;
372
    CurrentImagePath := ImagePath;
373

374
    // FunctionsForm
375
    FuncLeft := FunctionsForm.Left;
376
    FuncTop := FunctionsForm.Top;
377
    FuncWidth := FunctionsForm.Width;
378
    FuncHeight := FunctionsForm.Height;
379

380
    // GridOptionsForm
381
    GridsVisible := GridOptionsForm.Visible;
382
    GridsLeft := GridOptionsForm.Left;
383
    GridsTop := GridOptionsForm.Top;
384

385
    // GridColorsForm
386
    GridColorsLeft := GridColorsForm.Left;
387
    GridColorsTop := GridColorsForm.Top;
388

389
    // PlotColorsForm
390
    PlotColorsLeft := PlotColorsForm.Left;
391
    PlotColorsTop := PlotColorsForm.Top;
392

393
    // EvaluateForm
394
    EvaluateVisible := EvaluateForm.Visible;
395
    EvaluateLeft := EvaluateForm.Left;
396
    EvaluateTop := EvaluateForm.Top;
397

398
    // CoordsForm
399
    CoordVisible := CoordsForm.Visible;
400
    CoordLeft := CoordsForm.Left;
401
    CoordTop := CoordsForm.Top;
402

403
    // DerivativesForm
404
    DerivLeft := DerivativesForm.Left;
405
    DerivTop := DerivativesForm.Top;
406
    if DerivativesForm.Visible then
407
      DerivativesForm.Close;
408

409
    // AddPlotColorsForm
410
    AddColorsLeft := AddPlotColorsForm.Left;
411
    AddColorsTop := AddPlotColorsForm.Top;
412
    if AddPlotColorsForm.Visible then
413
      AddPlotColorsForm.Close;
414
  end;
415

416
  try
417
    AssignFile(f, LayoutFName);
418
    try
419
      Rewrite(f);
420
      write(f, Layout);
421
    finally
422
      CloseFile(f);
423
    end;
424
  except
425
    MessageDlg('File Error! An Error has occurred' +
426
      #13#10'when attempting to write to "' + LayoutFName + '".', mtError,
427
      [mbOK], 0);
428
  end;
429

430
  if Altered or GridColorsAltered or DerivativeAltered then
431
  begin
432
    case MessageDlg('The current graph''s data has been altered.' +
433
      #13#10'Do you wish to save the alterations ?', mtConfirmation,
434
      [mbYes, mbNo, mbCancel], 0) of
435
      mrYes:
436
        FunctionsForm.SaveClick(Sender);
437
      mrCancel:
438
        begin
439
          CanClose := False;
440
          Exit;
441
        end;
442
    end;
443
  end;
444
end;
445

446
procedure TViewForm.FormKeyDown(Sender: TObject; var Key: Word;
447
  Shift: TShiftState);
448
var
449
  d: Integer;
450
begin
451
  d := 0;
452
  case Key of
453
    VK_ADD:
454
      d := -1; // zoom in
455
    VK_SUBTRACT:
456
      d := 1; // zoom out
457
  end;
458
  if Key in [VK_ADD, VK_SUBTRACT] then
459
  begin
460
    Screen.Cursor := crZoom;
461
    GLSViewer.SetFocus;
462
    // each step adjusts target distance by 2.5% another method to zoom in or out
463
    Camera.AdjustDistanceToTarget(Power(1.025, d));
464
    ShowCameraLocation;
465
  end
466
  else
467
    case Key of
468
      VK_HOME, VK_NUMPAD7, 72:
469
        DefaultView; // 'H'/'h' key
470
      (* -> = 39
471
        <- = 37
472
        ^  = 38
473
        |  = 40
474
        -> and ^ = 33
475
        <- and | = 35 *)
476
    end;
477
  Key := 0;
478
end;
479

480
procedure TViewForm.FormKeyUp(Sender: TObject; var Key: Word;
481
  Shift: TShiftState);
482
begin
483
  Screen.Cursor := crDefault;
484
end;
485

486
procedure TViewForm.FormMouseWheel(Sender: TObject; Shift: TShiftState;
487
  WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
488
begin
489
  if (MousePoint.X >= GLSViewer.Left) and
490
    (MousePoint.X <= GLSViewer.Left + GLSViewer.Width) and
491
    (MousePoint.Y >= GLSViewer.Top) and
492
    (MousePoint.Y <= GLSViewer.Top + GLSViewer.Height) then
493
  begin
494
    (*
495
      a wheel step = WheelDelta/300; each step adjusts target distance by 2.5%
496
      another method to zoom in or out
497
    *)
498
    GLSViewer.SetFocus;
499
    Camera.AdjustDistanceToTarget(Power(1.025, WheelDelta / 300));
500
    ShowCameraLocation;
501
  end;
502
end;
503

504
procedure TViewForm.GLSViewerMouseDown(Sender: TObject; Button: TMouseButton;
505
  Shift: TShiftState; X, Y: Integer);
506
begin
507
  MousePoint.X := X;
508
  MousePoint.Y := Y;
509
  if ssShift in Shift then // Shift key down
510
  begin
511
    if ssLeft in Shift then
512
      Screen.Cursor := crZoom;
513
  end
514
  else if ssCtrl in Shift then // Ctrl key down
515
  begin
516
    if ssLeft in Shift then
517
      Screen.Cursor := crSlidexz
518
    else if ssRight in Shift then
519
      Screen.Cursor := crLightxz;
520
  end
521
  else if ssAlt in Shift then // Alt key down
522
  begin
523
    if ssLeft in Shift then
524
      Screen.Cursor := crSlidezy
525
    else if ssRight in Shift then
526
      Screen.Cursor := crLightxy;
527
  end
528
  else // no shift, ctrl or alt key
529
  begin
530
    if Shift = [ssLeft] then
531
      Screen.Cursor := crRotate
532
    else if Shift = [ssRight] then
533
      Screen.Cursor := crZoom;
534
  end;
535
end;
536

537
procedure TViewForm.GLSViewerMouseMove(Sender: TObject; Shift: TShiftState;
538
  X, Y: Integer);
539
var
540
  dx, dy: Integer;
541

542
begin // refer GLScene\Demos\interface\camera\Camera.dpr
543
  if MousePoint.X = MaxInt then // FileOpenDialog is visible
544
  begin
545
    MousePoint.X := X;
546
    Exit;
547
  end;
548

549
  dx := MousePoint.X - X;
550
  dy := MousePoint.Y - Y;
551

552
  if ssShift in Shift then // shift key down
553
  begin
554
    if ssLeft in Shift then // shift - left mouse button
555
    begin
556
      (* dy = a step which adjusts target distance by 1.25%; zoom in or out *)
557
      Camera.AdjustDistanceToTarget(Power(1.0125, dy));
558
      ShowCameraLocation;
559
    end;
560
  end
561
  else if ssCtrl in Shift then // Ctrl key down
562
  begin
563
    if ssLeft in Shift then // Ctrl - left mouse button
564
    begin
565
      TargetCube.Position.X := TargetCube.Position.X - dx *
566
        GLxzGrid.XSamplingScale.Step / 10;
567
      TargetCube.Position.z := TargetCube.Position.z - dy *
568
        GLxzGrid.ZSamplingScale.Step * ViewData.xyGrid.zScale / 10;
569
      ShowDisplacement;
570
    end;
571
    if ssRight in Shift then // Ctrl - right mouse button
572
    begin
573
      GLLight.Position.z := GLLight.Position.z + dy / 10;
574
      GLLight.Position.X := GLLight.Position.X + dx / 10;
575
      ShowLightLocation;
576
    end;
577
  end
578
  else if ssAlt in Shift then // Alt key down
579
  begin
580
    if ssRight in Shift then // Alt - right mouse button
581
    begin
582
      GLLight.Position.X := GLLight.Position.X + dx / 10;
583
      GLLight.Position.Y := GLLight.Position.Y + dy / 10;
584
      ShowLightLocation;
585
    end
586
    else if ssLeft in Shift then // Alt - left mouse button
587
    begin
588
      TargetCube.Position.Y := TargetCube.Position.Y + dx *
589
        GLyzGrid.YSamplingScale.Step / 10;
590
      TargetCube.Position.z := TargetCube.Position.z - dy *
591
        GLyzGrid.ZSamplingScale.Step * ViewData.xyGrid.zScale / 10;
592
      ShowDisplacement;
593
    end;
594
  end
595
  else // no shift key
596
  begin
597
    if Shift = [ssLeft] then
598
    (* Left mouse button changes camera angle by moving around target *)
599
    begin
600
      Camera.MoveAroundTarget(dy, dx);
601
      ShowCameraLocation;
602
    end;
603
    if Shift = [ssRight] then
604
    begin
605
      (*
606
        Right mouse button alters the camera's focal length;
607
        zoom out or in by moving cursor up or down
608
      *)
609
      Camera.FocalLength := Camera.FocalLength - dy;
610
      if Camera.FocalLength > 3000 then
611
        Camera.FocalLength := 3000; // max focal length
612
      if Camera.FocalLength < 10 then
613
        Camera.FocalLength := 10; // min focal length
614

615
      ShowFocalLength; // display in statusbar palel
616
    end;
617
  end;
618
  MousePoint.X := X; // update mouse position
619
  MousePoint.Y := Y;
620
end;
621

622
procedure TViewForm.GLSViewerMouseUp(Sender: TObject; Button: TMouseButton;
623
  Shift: TShiftState; X, Y: Integer);
624
begin
625
  Screen.Cursor := crDefault;
626
end;
627

628
procedure TViewForm.New1Click(Sender: TObject);
629
begin
630
  FunctionsForm.New1Click(Sender);
631
end;
632

633
procedure TViewForm.OpenFileClick(Sender: TObject);
634
begin
635
  FunctionsForm.OpenFileClick(Sender);
636
end;
637

638
procedure TViewForm.Save1Click(Sender: TObject);
639
begin
640
  FunctionsForm.SaveClick(Sender);
641
end;
642

643
procedure TViewForm.Saveas1Click(Sender: TObject);
644
begin
645
  FunctionsForm.SaveAsClick(Sender);
646
end;
647

648
procedure TViewForm.ShowCameraLocation;
649
begin
650
  StatusBar.Panels[0].Text := 'Camera: ' +
651
    FloatToStrF(Camera.Position.X, ffNumber, 5, 2) + ', ' +
652
    FloatToStrF(Camera.Position.Y, ffNumber, 5, 2) + ', ' +
653
    FloatToStrF(Camera.Position.Z, ffNumber, 5, 2);
654
end;
655

656
procedure TViewForm.GridColours1Click(Sender: TObject);
657
begin
658
  GridColorsForm.Show;
659
end;
660

661
procedure TViewForm.CoordText1Click(Sender: TObject);
662
begin
663
  CoordsForm.Show;
664
end;
665

666
procedure TViewForm.ShowFocalLength;
667
begin
668
  StatusBar.Panels[1].Text := 'f = ' + FloatToStrF(Camera.FocalLength,
669
    ffNumber, 5, 2);
670
end;
671

672
procedure TViewForm.ShowDisplacement;
673
begin
674
  StatusBar.Panels[2].Text := 'Displaced: ' +
675
    FloatToStrF(-TargetCube.Position.X, ffNumber, 5, 2) + ', ' +
676
    FloatToStrF(-TargetCube.Position.Y, ffNumber, 5, 2) + ', ' +
677
    FloatToStrF(-TargetCube.Position.Z, ffNumber, 5, 2);
678
end;
679

680
procedure TViewForm.Evaluate1Click(Sender: TObject);
681
begin
682
  EvaluateForm.Show;
683
end;
684

685
procedure TViewForm.ShowLightLocation;
686
begin
687
  StatusBar.Panels[3].Text := 'Light: ' +
688
    FloatToStrF(GLLight.Position.X, ffNumber, 5, 2) + ', ' +
689
    FloatToStrF(GLLight.Position.Y, ffNumber, 5, 2) + ', ' +
690
    FloatToStrF(GLLight.Position.Z, ffNumber, 5, 2);
691
end;
692

693
procedure TViewForm.Grid1Click(Sender: TObject);
694
begin
695
  GridOptionsForm.Show;
696
end;
697

698
procedure TViewForm.DefaultLayout1Click(Sender: TObject);
699
begin
700
  DefaultLayout;
701
end;
702

703
procedure TViewForm.DefaultView;
704
begin
705
  CameraCube.Position.SetPoint(0, 0, 0);
706
  ShowDisplacement;
707
  Camera.FocalLength := 200;
708
  ShowFocalLength;
709
  Camera.Position.SetPoint(50, 50, 30);
710
  Camera.DepthOfView := 1000;
711
  ShowCameraLocation;
712
  GLLight.Position.SetPoint(50, 50, 50);
713
  ShowLightLocation;
714
  TargetCube.Position.SetPoint(0, 0, 0);
715
end;
716

717
procedure TViewForm.RecentFilesClick(Sender: TObject);
718
begin
719
  FunctionsForm.OpenRecentFile(TMenuItem(Sender).Caption);
720
end;
721

722
procedure TViewForm.Exit1Click(Sender: TObject);
723
begin
724
  Close;
725
end;
726

727
procedure TViewForm.DefaultLayout;
728
begin
729
  WindowState := wsNormal;
730
  ViewForm.Left := 0;
731
  ViewForm.Top := 0;
732
  FunctionsForm.Width := 335;
733
  FunctionsForm.Height := 387;
734
  ViewForm.Width := Screen.Width - FunctionsForm.Width + 18;
735
  ViewForm.Height := Screen.Height - 40;
736
  FunctionsForm.Left := ViewForm.Left + ViewForm.Width - 14;
737
  FunctionsForm.Top := ViewForm.Top;
738
  GridOptionsForm.Left := FunctionsForm.Left + 5;
739
  GridOptionsForm.Top := FunctionsForm.Top + FunctionsForm.Height - 6;
740
  EvaluateForm.Left := GridOptionsForm.Left;
741
  EvaluateForm.Top := GridOptionsForm.Top + GridOptionsForm.Height - 3;
742
  EvaluateForm.Show;
743
  GridOptionsForm.Show;
744
  GridColorsForm.Left := 20;
745
  GridColorsForm.Top := 80;
746
  PlotColorsForm.Left := 30;
747
  PlotColorsForm.Top := 100;
748
  AddPlotColorsForm.Left := 40;
749
  AddPlotColorsForm.Top := 120;
750
  FunctionsForm.EditMinX.SetFocus;
751
end;
752

753
procedure TViewForm.DerivativeOpsClick(Sender: TObject);
754
begin
755
  if PlotColorsForm.Visible then
756
    PlotColorsForm.Close;
757
  PlotColours1.Enabled := False;
758
  DerivativePlotColours1.Enabled := True;
759
  DerivativesForm.Show;
760
end;
761

762
procedure TViewForm.DerivativePlotColours1Click(Sender: TObject);
763
begin
764
  if PlotColorsForm.Visible then
765
    PlotColorsForm.Close;
766
  PlotColours1.Enabled := False;
767
  AddPlotColorsForm.Show;
768
end;
769

770
procedure TViewForm.PlotFunctions;
771

772
  procedure PlotFunction(i: Integer);
773
  begin
774
    with PlotData do
775
    begin
776
      with TGLHeightField(Fields.Children[i]) do
777
      begin
778
        XSamplingScale.Step := xInc;
779
        XSamplingScale.Min := xMin;
780
        XSamplingScale.Max := xMax;
781

782
        YSamplingScale.Step := yInc;
783
        YSamplingScale.Min := yMin;
784
        YSamplingScale.Max := yMax;
785

786
        case ViewMode of
787
          vmAmbient:
788
            ColorMode := hfcmAmbient;
789
          vmAmbientandDiffuse:
790
            ColorMode := hfcmAmbientAndDiffuse;
791
          vmDiffuse:
792
            ColorMode := hfcmDiffuse;
793
          vmEmmision:
794
            ColorMode := hfcmEmission;
795
          vmNone:
796
            ColorMode := hfcmNone;
797
        end;
798

799
        case fxyMode of
800
          fxyFill:
801
            Material.PolygonMode := pmFill;
802
          fxyLines:
803
            Material.PolygonMode := pmLines;
804
          fxyPoints:
805
            Material.PolygonMode := pmPoints;
806
        end;
807
        OnGetHeight := Formulate;
808
      end;
809
      GLSViewer.Refresh; // needed to display each zField data in list
810
    end;
811
  end;
812

813
var
814
  i: Integer;
815
  fxyParser: TfxyParser;
816
  PD: TPlotData; // save the current PlotData of selected function
817

818
begin // PlotFunctions
819
  Screen.Cursor := crHourGlass;
820
  PD := PlotData;
821
  fxyParser := TfxyParser.Create(0, 0);
822
  try
823
    with FunctionsForm.CheckListBox do
824
      for i := 0 to Items.Count - 1 do
825
        if Checked[i] then
826
        begin
827
          // an item is checked; get the plot data
828
          PlotData := TPlotDataObject(Items.Objects[i]).Data;
829
          PlotFunction(i);
830
        end;
831
  finally
832
    Screen.Cursor := crDefault;
833
    fxyParser.Destroy;
834
    PlotData := PD; // restor the current PlotData
835
  end;
836
end;
837

838
procedure TViewForm.Formulate(const X, Y: Single; var z: Single;
839
  var Color: TGLColorVector; var texPoint: TTexPoint);
840
var
841
  e: byte;
842
  MaxZ, MinZ: TGLFloat;
843
  x1, x2, y1, y2, z1, z2: extended;
844

845
begin
846
  case AddedData.AddedAs of
847
    AddNone: // no AddedData to plot; just plot the PlotData
848
      begin
849
        z := ParseEvaluateFxy(X, Y, PlotData.fxyStr, e);
850
        z := z * ViewData.xyGrid.zScale;
851
        with PlotData do
852
        begin
853
          MaxZ := zMax * ViewData.xyGrid.zScale;
854
          MinZ := zMin * ViewData.xyGrid.zScale;
855
          if zCap then
856
          begin
857
            if zLim and (z > MaxZ) then
858
              z := MaxZ;
859
            if zLim and (z < MinZ) then
860
              z := MinZ;
861
          end
862
          else if zLim and ((z < MinZ) or (z > MaxZ)) then
863
            z := NaN;
864
          VectorLerp(LowerColor, UpperColor, z * ColorBlend - ColorMove, Color);
865
        end;
866
      end;
867

868
    AddDerivX: // this is for partial derivative wrt x
869
      begin
870
        x1 := X - AddedData.xInc;
871
        x2 := X + AddedData.xInc;
872
        z1 := ParseEvaluateFxy(x1, Y, SelectedData.fxyStr, e);
873
        // evaluate z1,x1,y
874
        z2 := ParseEvaluateFxy(x2, Y, SelectedData.fxyStr, e);
875
        // evaluate z2,x2,y
876
        z := (z2 - z1) / (x2 - x1); // z = slope wrt x axis
877
        z := z * ViewData.xyGrid.zScale;
878
        with AddedData do
879
        begin
880
          MaxZ := zMax * ViewData.xyGrid.zScale;
881
          MinZ := zMin * ViewData.xyGrid.zScale;
882
          if zCap then
883
          begin
884
            if zLim and (z > MaxZ) then
885
              z := MaxZ;
886
            if zLim and (z < MinZ) then
887
              z := MinZ;
888
          end
889
          else if zLim and ((z < MinZ) or (z > MaxZ)) then
890
            z := NaN;
891
          VectorLerp(LowerColor, UpperColor, z * ColorBlend - ColorMove, Color);
892
        end;
893
      end;
894

895
    AddDerivY: // this is for partial derivative wrt y
896
      begin
897
        y1 := Y - AddedData.yInc;
898
        y2 := Y + AddedData.yInc;
899
        z1 := ParseEvaluateFxy(X, y1, SelectedData.fxyStr, e);
900
        // evaluate z1,x,y1
901
        z2 := ParseEvaluateFxy(X, y2, SelectedData.fxyStr, e);
902
        // evaluate z2,x,y2
903
        z := (z2 - z1) / (y2 - y1); // z = slope wrt y axis
904
        z := z * ViewData.xyGrid.zScale;
905
        with AddedData do
906
        begin
907
          MaxZ := zMax * ViewData.xyGrid.zScale;
908
          MinZ := zMin * ViewData.xyGrid.zScale;
909
          if zCap then
910
          begin
911
            if zLim and (z > MaxZ) then
912
              z := MaxZ;
913
            if zLim and (z < MinZ) then
914
              z := MinZ;
915
          end
916
          else if zLim and ((z < MinZ) or (z > MaxZ)) then
917
            z := NaN;
918
          VectorLerp(LowerColor, UpperColor, z * ColorBlend - ColorMove, Color);
919
        end;
920
      end;
921

922
    AddVolume: // this is for double integral
923
      begin
924
        z := ParseEvaluateFxy(X, Y, PlotData.fxyStr, e);
925
        with AddedData do
926
        begin
927
          z := z * ViewData.xyGrid.zScale;
928
          MaxZ := zMax * ViewData.xyGrid.zScale;
929
          MinZ := zMin * ViewData.xyGrid.zScale;
930
          if zCap then
931
          begin
932
            if zLim and (z > MaxZ) then
933
              z := MaxZ;
934
            if zLim and (z < MinZ) then
935
              z := MinZ;
936
          end
937
          else if zLim and ((z < MinZ) or (z > MaxZ)) then
938
            z := NaN;
939
          VectorLerp(LowerColor, UpperColor, z * ColorBlend - ColorMove, Color);
940

941
          TGLLines.CreateAsChild(VolumeLines);
942
          with VolumeLines do
943
          begin
944
            with TGLLines(Children[Count - 1]) do
945
            begin
946
              LineColor.AsWinColor := AddLineColor;
947
              LineWidth := AddLineWidth;
948
              NodesAspect := LnaInvisible;
949

950
              Nodes.Add;
951
              Nodes[0].X := X; // start point
952
              Nodes[0].Y := Y;
953
              if zLim then
954
                Nodes[0].z := MinZ
955
              else
956
                Nodes[0].z := 0;
957

958
              Nodes.Add;
959
              Nodes[1].X := X; // end point
960
              Nodes[1].Y := Y;
961
              Nodes[1].z := z;
962
            end;
963
          end;
964
        end;
965
      end;
966
  end; // case AddedData.AddedAs of...
967
end;
968

969
procedure TViewForm.PlotDerivativeField;
970
var
971
  i: Integer;
972
  FoundSelected: Boolean;
973

974
begin
975
  Screen.Cursor := crHourGlass;
976
  try
977
    i := 0;
978
    if FunctionsForm.CheckListBox.Count > 1 then // find Selected item
979
    begin
980
      FoundSelected := False;
981
      while not FoundSelected and (i < FunctionsForm.CheckListBox.Count) do
982
      begin
983
        FoundSelected := FunctionsForm.CheckListBox.Selected[i];
984
        if not FoundSelected then
985
          Inc(i);
986
      end;
987
    end;
988

989
    with FunctionsForm.CheckListBox do
990
      SelectedData := TPlotDataObject(Items.Objects[i]).Data;
991

992
    with AddedData do
993
    begin
994
      with TGLHeightField(AddedField.Children[0]) do
995
      begin
996
        with XSamplingScale do
997
        begin
998
          Step := xInc;
999
          Min := xMin;
1000
          Max := xMax;
1001
        end;
1002

1003
        with YSamplingScale do
1004
        begin
1005
          Step := yInc;
1006
          Min := yMin;
1007
          Max := yMax;
1008
        end;
1009

1010
        case ViewMode of
1011
          vmAmbient:
1012
            ColorMode := hfcmAmbient;
1013
          vmAmbientandDiffuse:
1014
            ColorMode := hfcmAmbientAndDiffuse;
1015
          vmDiffuse:
1016
            ColorMode := hfcmDiffuse;
1017
          vmEmmision:
1018
            ColorMode := hfcmEmission;
1019
          vmNone:
1020
            ColorMode := hfcmNone;
1021
        end;
1022

1023
        case fxyMode of
1024
          fxyFill:
1025
            Material.PolygonMode := pmFill;
1026
          fxyLines:
1027
            Material.PolygonMode := pmLines;
1028
          fxyPoints:
1029
            Material.PolygonMode := pmPoints;
1030
        end;
1031
        OnGetHeight := Formulate;
1032
      end;
1033
      GLSViewer.Refresh; // needed to display each zField data in list
1034
    end;
1035
  finally
1036
    Screen.Cursor := crDefault;
1037
  end;
1038
end;
1039

1040
procedure TViewForm.PlotIntegralField;
1041
  procedure PlotVolume;
1042
  begin // PlotVolume
1043
    with AddedData do
1044
    begin
1045
      with TGLHeightField(AddedField.Children[0]) do
1046
      begin
1047
        with XSamplingScale do
1048
        begin
1049
          Step := xInc;
1050
          Min := xMin;
1051
          Max := xMax;
1052
        end;
1053

1054
        with YSamplingScale do
1055
        begin
1056
          Step := yInc;
1057
          Min := yMin;
1058
          Max := yMax;
1059
        end;
1060

1061
        case ViewMode of
1062
          vmAmbient:
1063
            ColorMode := hfcmAmbient;
1064
          vmAmbientandDiffuse:
1065
            ColorMode := hfcmAmbientAndDiffuse;
1066
          vmDiffuse:
1067
            ColorMode := hfcmDiffuse;
1068
          vmEmmision:
1069
            ColorMode := hfcmEmission;
1070
          vmNone:
1071
            ColorMode := hfcmNone;
1072
        end;
1073

1074
        case fxyMode of
1075
          fxyFill:
1076
            Material.PolygonMode := pmFill;
1077
          fxyLines:
1078
            Material.PolygonMode := pmLines;
1079
          fxyPoints:
1080
            Material.PolygonMode := pmPoints;
1081
        end;
1082
        OnGetHeight := Formulate;
1083
      end;
1084
      GLSViewer.Refresh; // needed to display each zField data in list
1085
    end;
1086
  end; // PlotVolume
1087

1088
  procedure CalculateVolume;
1089
  var
1090
    e: byte;
1091
    i, j, iCount, jCount: Integer;
1092
    X, Y, z, x0, y0, a, VolPos, VolNeg: TGLFloat;
1093

1094
  begin // CalculateVolume
1095
    with AddedData do
1096
    begin
1097
      a := xInc * yInc; // base area
1098
      iCount := round((xMax - xMin) / xInc) - 1; // number of x points
1099
      jCount := round((yMax - yMin) / yInc) - 1; // number of y points
1100
      VolPos := 0;
1101
      VolNeg := 0;
1102
      x0 := xMin + xInc / 2; // base centre x0
1103
      y0 := yMin + yInc / 2; // base centre y0
1104
      for j := 0 to jCount do
1105
      begin
1106
        Y := y0 + j * yInc; // next column wrt y
1107
        for i := 0 to iCount do
1108
        begin
1109
          X := x0 + i * xInc; // next column wrt x
1110
          z := ParseEvaluateFxy(X, Y, PlotData.fxyStr, e);
1111

1112
          if zLim then // zLimit applied
1113
          begin
1114
            if (zMax >= 0) and (zMin <= 0) then // above and below zero
1115
            begin
1116
              if z > 0 then
1117
              begin
1118
                if z > zMax then
1119
                  VolPos := VolPos + a * zMax
1120
                else
1121
                  VolPos := VolPos + a * z;
1122
              end
1123
              else
1124
              begin
1125
                if z < zMin then
1126
                  VolNeg := VolNeg + a * zMin
1127
                else
1128
                  VolNeg := VolNeg + a * z;
1129
              end;
1130
            end
1131
            else if zMin > 0 then // both above zero
1132
            begin
1133
              if z >= zMin then
1134
              begin
1135
                if z > zMax then
1136
                  VolPos := VolPos + a * (zMax - zMin)
1137
                else
1138
                  VolPos := VolPos + a * (z - zMin);
1139
              end;
1140
            end
1141
            else if zMax < 0 then // both below zero
1142
            begin
1143
              if z <= zMax then
1144
              begin
1145
                if z < zMin then
1146
                  VolNeg := VolNeg + a * (zMax - zMin)
1147
                else
1148
                  VolNeg := VolNeg + a * (z - zMax);
1149
              end;
1150
            end;
1151
          end
1152
          else // no zLimit applied
1153
          begin
1154
            if z > 0 then
1155
              VolPos := VolPos + a * z
1156
            else
1157
              VolNeg := VolNeg + a * z;
1158
          end;
1159
        end;
1160
      end;
1161
    end;
1162

1163
    with DerivativesForm do
1164
    begin
1165
      PosVolLabel.Caption := 'Positive Volume: ' + FloatToStr(VolPos);
1166
      NegVolLabel.Caption := 'Negative Volume: ' + FloatToStr(VolNeg);
1167
      TotalLabel.Caption := 'Absolute Volume: ' + FloatToStr(VolPos - VolNeg);
1168
      VolumeLabel.Caption := 'Total Volume: ' + FloatToStr(VolPos + VolNeg);
1169
    end;
1170
  end; // CalculateVolume
1171

1172
begin // TViewForm.PlotIntegralField
1173
  Screen.Cursor := crHourGlass;
1174
  with AddedData do
1175
  begin
1176
    PlotVolume;
1177
    CalculateVolume;
1178
  end;
1179
  DerivativesForm.VolumeRB.Checked := False; //
1180
  Screen.Cursor := crDefault;
1181
end; // TViewForm.PlotIntegralField
1182

1183
procedure TViewForm.PlotColours1Click(Sender: TObject);
1184
begin
1185
  PlotColorsForm.Show;
1186
end;
1187

1188
procedure TViewForm.CreateHeightFields(const n: Integer);
1189
var
1190
  i: Integer;
1191

1192
begin
1193
  while Fields.Count > 0 do
1194
    TGLHeightField(Fields.Children[0]).Free;
1195
  for i := 0 to n - 1 do
1196
  begin
1197
    TGLHeightField.CreateAsChild(Fields);
1198
    TGLHeightField(Fields.Children[Fields.Count - 1]).Material.BlendingMode :=
1199
      bmTransparency;
1200
  end;
1201
end;
1202

1203
procedure TViewForm.CreateAddedField;
1204
begin
1205
  ClearAddedField;
1206
  TGLHeightField.CreateAsChild(AddedField);
1207
  TGLHeightField(AddedField.Children[0]).Material.BlendingMode :=
1208
    bmTransparency;
1209
end;
1210

1211
procedure TViewForm.UpdatePlot;
1212
begin
1213
  CreateHeightFields(FunctionsForm.CheckListBox.Count);
1214
  PlotFunctions;
1215
end;
1216

1217
procedure TViewForm.UpdateAdded;
1218
begin
1219
  CreateAddedField;
1220
  AddXLine.LineColor.AsWinColor := AddedData.AddLineColor;
1221
  AddYLine.LineColor.AsWinColor := AddedData.AddLineColor;
1222
  AddZLine.LineColor.AsWinColor := AddedData.AddLineColor;
1223
  AddXLine.LineWidth := AddedData.AddLineWidth;
1224
  AddYLine.LineWidth := AddedData.AddLineWidth;
1225
  AddZLine.LineWidth := AddedData.AddLineWidth;
1226
  if AddedData.AddedAs = AddVolume then
1227
    PlotIntegralField
1228
  else
1229
    PlotDerivativeField;
1230
end;
1231

1232
procedure TViewForm.About1Click(Sender: TObject);
1233
begin
1234
  FormAbout.Show;
1235
end;
1236

1237
procedure TViewForm.ClearAddedField;
1238
begin
1239
  with TGLHeightField(AddedField) do
1240
    if Count > 0 then
1241
      Children[0].Free;
1242
end;
1243

1244
procedure TViewForm.ClearAddedLines;
1245
begin
1246
  Screen.Cursor := crHourGlass;
1247
  with TGLLines(VolumeLines) do
1248
    while Count > 0 do
1249
      Children[Count - 1].Free;
1250
  Screen.Cursor := crDefault;
1251
end;
1252

1253
end.
1254