ArenaZ

1
unit Main;
2

3

4
interface
5

6
uses
7
  LCLType,  SysUtils, Variants, Classes, Graphics, Controls, Forms,
8
  Dialogs, GLHUDObjects, GLObjects, GLGraph, GLScene, GLGeomObjects,
9
  GLCoordinates, GLCrossPlatform, GLLCLViewer, GLBitmapFont,
10
  GLWindowsFont, ComCtrls, GLParticles, GLColor, OpenGLTokens,
11
  uGlobal, Menus, GLBaseClasses, GLVectorGeometry, ExtDlgs ;
12

13
type
14
  TViewForm = class(TForm)
15
    GLSViewer: TGLSceneViewer;
16
    GLScene1: TGLScene;
17
    GLLight: TGLLightSource;
18
    CameraCube: TGLDummyCube;
19
    Camera: TGLCamera;
20
    GLxyGrid: TGLXYZGrid;
21
    Fields: TGLDummyCube;
22
    GLWinBmpFont: TGLWindowsBitmapFont;
23
    StatusBar: TStatusBar;
24
    MainMenu: TMainMenu;
25
    File1: TMenuItem;
26
    New1: TMenuItem;
27
    Options1: TMenuItem;
28
    DefaultLayout1: TMenuItem;
29
    Open1: TMenuItem;
30
    Save1: TMenuItem;
31
    Saveas1: TMenuItem;
32
    Exit1: TMenuItem;
33
    Grid1: TMenuItem;
34
    GridColours1: TMenuItem;
35
    Evaluate1: TMenuItem;
36
    GLxzGrid: TGLXYZGrid;
37
    GLyzGrid: TGLXYZGrid;
38
    TargetCube: TGLDummyCube;
39
    xCoordLine: TGLLines;
40
    yCoordLine: TGLLines;
41
    zCoordLine: TGLLines;
42
    BoxLine1: TGLLines;
43
    BoxLine2: TGLLines;
44
    BoxLine3: TGLLines;
45
    BoxLine4: TGLLines;
46
    CoordText1: TMenuItem;
47
    YCoordsCube: TGLDummyCube;
48
    XCoordsCube: TGLDummyCube;
49
    ZCoordsCube: TGLDummyCube;
50
    xArrow: TGLArrowLine;
51
    yArrow: TGLArrowLine;
52
    Recent1: TMenuItem;
53
    DerivativeOps: TMenuItem;
54
    AddedField: TGLDummyCube;
55
    AddXLine: TGLLines;
56
    AddYLine: TGLLines;
57
    AddZLine: TGLLines;
58
    PlotColours1: TMenuItem;
59
    DerivativePlotColours1: TMenuItem;
60
    VolumeLines: TGLDummyCube;
61
    N2: TMenuItem;
62
    N3: TMenuItem;
63
    N4: TMenuItem;
64
    procedure FormCreate(Sender: TObject);
65
    procedure FormShow(Sender: TObject);
66
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
67

68
    procedure GLSViewerMouseDown(Sender: TObject; Button: TMouseButton;
69
                                  Shift: TShiftState; X, Y: Integer);
70
    procedure GLSViewerMouseMove(Sender: TObject;
71
                                  Shift: TShiftState; X, Y: Integer);
72
    procedure GLSViewerMouseUp(Sender: TObject; Button: TMouseButton;
73
                                Shift: TShiftState; X, Y: Integer);
74
    procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
75
      WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
76
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
77
    procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
78
    procedure DefaultLayout1Click(Sender: TObject);
79
    procedure Exit1Click(Sender: TObject);
80
    procedure Grid1Click(Sender: TObject);
81
    procedure GridColours1Click(Sender: TObject);
82
    procedure Evaluate1Click(Sender: TObject);
83
    procedure New1Click(Sender: TObject);
84
    procedure Open1Click(Sender: TObject);
85
    procedure Save1Click(Sender: TObject);
86
    procedure Saveas1Click(Sender: TObject);
87
    procedure FormDestroy(Sender: TObject);
88
    procedure FormActivate(Sender: TObject);
89
    procedure CoordText1Click(Sender: TObject);
90
    procedure RecentFilesClick(Sender: TObject);
91
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
92
    procedure DerivativeOpsClick(Sender: TObject);
93
    procedure PlotColours1Click(Sender: TObject);
94
    procedure DerivativePlotColours1Click(Sender: TObject);
95
  private
96
    { Private declarations }
97
    AtStart: Boolean;
98
    SelectedData: TPlotData;    { data used to evaluate dz/dx or dz/dy }
99
    procedure ShowCameraLocation;
100
    procedure ShowFocalLength;
101
    procedure ShowLightLocation;
102
    procedure DefaultView;
103
    procedure DefaultLayout;
104

105
    procedure Formulate(const x, y: Single; var z: Single;
106
              var color: TColorVector; var texPoint: TTexPoint);
107
    procedure CreateHeightFields(const n: integer);
108
    procedure PlotFunctions;
109
    procedure CreateAddedField;
110
    procedure PlotDerivativeField;
111
    procedure PlotIntegralField;
112
  public
113
    { Public declarations }
114
    MousePoint: TPoint;
115
    procedure ShowDisplacement;
116
    procedure UpdatePlot;
117
    procedure UpdateAdded;
118
    procedure ClearAddedField;
119
    procedure ClearAddedLines;
120
  end;
121

122
const
123
  crLightxz  = 1;
124
  crLightyz  = 2;
125
  crLightxy  = 3;
126
  crSlidexy  = 4;
127
  crSlideyz  = 5;
128
  crSlidexz  = 6;
129
  crRotate   = 7;
130
  crZoom     = 8;
131
  crHandMove = 9;
132
  crSlidezy  = 10;
133

134
var
135
  ViewForm: TViewForm;
136

137
implementation
138

139
{$R *.lfm}
140
{$R CURSORS.RES}
141

142
uses
143
  IniFiles,
144
  DateUtils,
145
  uParser, GLState, GLMaterial, Math, GLVectorTypes,
146
  GridOptions, Functions, Evaluate, CoordOptions,
147
  DerivativeOptions, GridColors, PlotColors, AddPlotColors;
148

149

150
function LoadCursorFromRes(CursorName:String):THandle;
151
var
152
   Cur: TCursorImage;
153
begin
154
   Cur := TCursorImage.Create;
155
   Cur.LoadFromResourceName(HInstance,CursorName);
156
   result := Cur.ReleaseHandle;
157
   Cur.Free;
158
end;
159

160
procedure TViewForm.FormCreate(Sender: TObject);
161
var
162
  aFolder: TFileName;
163

164
begin
165
  MainPath :=  ExtractFilePath(Application.ExeName);
166
  MainPath := IncludeTrailingPathDelimiter(MainPath);
167

168
  aFolder := Copy(MainPath, 1, 3)+'Plot 3D\';
169

170
  DataPath := aFolder + 'Examples\';
171
  if not DirectoryExists(DataPath) then ForceDirectories(DataPath);
172
  ImagePath := aFolder + 'Images\';
173
  if not DirectoryExists(ImagePath) then ForceDirectories(ImagePath);
174
  LayoutFName := aFolder + 'Layout.lay';
175
  RecentFName := aFolder + 'Recent.ini';
176

177

178
  if not DirectoryExists(ImagePath) then ForceDirectories(ImagePath);
179
  if not DirectoryExists(DataPath) then ForceDirectories(DataPath);
180

181
  Screen.Cursors[crLightxy] := LoadCursorFromRes('LIGHTXY');
182
  Screen.Cursors[crLightyz] := LoadCursorFromRes('LIGHTYZ');
183
  Screen.Cursors[crLightxz] := LoadCursorFromRes('LIGHTXZ');
184
  Screen.Cursors[crSlidexy] := LoadCursorFromRes('SLIDEXY');
185
  Screen.Cursors[crSlidexz] := LoadCursorFromRes('SLIDEXZ');
186
  Screen.Cursors[crSlideyz] := LoadCursorFromRes('SLIDEYZ');
187
  Screen.Cursors[crRotate]  := LoadCursorFromRes('ROTATE');
188
  Screen.Cursors[crZoom]    := LoadCursorFromRes('ZOOM');
189
  Screen.Cursors[crSlidezy] := LoadCursorFromRes('SLIDEZY');
190
  AtStart := True;
191
end;
192

193
procedure TViewForm.FormDestroy(Sender: TObject);
194
begin
195
  while Fields.Count > 0 do TGLHeightField(Fields.Children[0]).Free;
196
  ClearAddedField;
197
  ClearAddedLines;
198
end;
199

200
procedure TViewForm.FormShow(Sender: TObject);
201
var
202
  LayFile: File of TLayout;
203
  ini: TIniFile;
204
  i, c: integer;
205
  s: string;
206

207
begin
208
  if FileExists(LayoutFName) then
209
  begin
210
    try
211
      AssignFile(LayFile, LayoutFName);
212
      try
213
        Reset(LayFile);
214
        Read(LayFile, Layout);
215
      finally
216
        CloseFile(LayFile);
217
      end;
218

219
      with Layout do
220
      begin
221
        if IsMaximize then WindowState := wsMaximized
222
        else
223
        begin
224
          WindowState := wsNormal;
225
          Left := MainLeft;
226
          Top := MainTop;
227
          Width := MainWidth;
228
          Height := MainHeight;
229
        end;
230
        GraphFName := CurrentGraphFName;
231
        DataPath := CurrentDataPath;
232
        ImagePath := CurrentImagePath;
233

234
        with FunctionsForm do
235
        begin
236
          Left := FuncLeft;
237
          Top := FuncTop;
238
          Width := FuncWidth;
239
          Height := FuncHeight;
240
        end;
241

242
        if GridsVisible then GridOptionsForm.Show;
243
        with GridOptionsForm do
244
        begin
245
          Left := GridsLeft;
246
          Top := GridsTop;
247
        end;
248

249
        with GridColorsForm do
250
        begin
251
          Left := GridColorsLeft;
252
          Top := GridColorsTop;
253
        end;
254

255
        with PlotColorsForm do
256
        begin
257
          Left := PlotColorsLeft;
258
          Top := PlotColorsTop;
259
        end;
260

261
        if EvaluateVisible then EvaluateForm.Show;
262
        with EvaluateForm do
263
        begin
264
          Left := EvaluateLeft;
265
          Top := EvaluateTop;
266
        end;
267

268
        if CoordVisible then CoordsForm.Show;
269
        with CoordsForm do
270
        begin
271
          Left := CoordLeft;
272
          Top := CoordTop;
273
        end;
274

275
        with DerivativesForm do
276
        begin
277
          Left := DerivLeft;
278
          Top := DerivTop;
279
        end;
280

281
        with AddPlotColorsForm do
282
        begin
283
          Left := AddColorsLeft;
284
          Top := AddColorsTop;
285
        end;
286
      end;
287
      FunctionsForm.EditMinX.SetFocus;
288
    except
289
      MessageDlg('File Error! An Error has occurred when attempting to read'+
290
           #13#10'"'+LayoutFName+'".'+
291
           #13#10'The default layout will be used.',
292
           mtError, [mbOK], 0);
293
      DefaultLayout;
294
    end;
295
  end
296
  else DefaultLayout;
297

298
  if DataPath = '' then DataPath := MainPath + 'Examples\';
299
  if ImagePath = '' then ImagePath := MainPath + 'Images\';
300
  if not DirectoryExists(DataPath) then ForceDirectories(DataPath);
301
  if not DirectoryExists(ImagePath) then ForceDirectories(ImagePath);
302

303
  ShowCameraLocation;
304
{ focallength: right mouse drag up/down }
305
  ShowFocalLength;
306
{ displace origin: x axis: ctrl/left mouse drag left/right
307
                   y axis: alt/left mouse drag up/down
308
                   z axis: ctrl/left mouse drag up/down }
309
  ShowDisplacement;
310
{ move light: x axis: ctrl right mouse drag left/right
311
              y axis: alt right mouse drag up/down
312
              z axis: ctrl right mouse drag up/down }
313
  ShowLightLocation;
314

315
  FunctionsForm.ReadAndShowInitialData;
316
  Caption := GraphFName;
317
  Altered := False;
318
  CreateHeightFields(FunctionsForm.CheckListBox.Count);
319

320
  ini := TIniFile.Create(RecentFName);
321
  with ini do
322
  try
323
    c := ReadInteger(Name, 'RecentCount', 0);
324
    for i := 0 to c-1 do
325
    begin
326
      Recent1.Add(TMenuItem.Create(Self));
327
      Recent1.Items[i].Caption := ReadString(Name, IntToStr(i), '');
328
      Recent1.Items[i].OnClick := RecentFilesClick;
329
    end;
330
  finally
331
    Free;
332
  end;
333
end;
334

335
procedure TViewForm.FormActivate(Sender: TObject);
336
begin
337
  if AtStart then
338
  begin
339
    PlotFunctions;
340
    if GridColorsForm.Visible then GridColorsForm.ShowGridColorData;
341
    if PlotColorsForm.Visible then PlotColorsForm.ShowPlotColorData;
342
    AtStart := False;
343
  end;
344
end;
345

346
procedure TViewForm.FormClose(Sender: TObject; var Action: TCloseAction);
347
var
348
  ini: TIniFile;
349
  i: integer;
350

351
begin
352
  ini := TIniFile.Create(RecentFName);
353
  with ini do
354
  try
355
    WriteInteger(Name, 'RecentCount', Recent1.Count);
356
    for i := 0 to Recent1.Count-1 do
357
    WriteString(Name, IntToStr(i), Recent1.Items[i].Caption);
358
  finally
359
    Free;
360
  end;
361
end;
362

363
procedure TViewForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
364
var
365
  f: File of TLayout;
366

367
begin
368
  with Layout do
369
  begin
370
    IsMaximize := (Width >= Screen.Width) and (Height >= Screen.Height);
371
    MainLeft := Left;
372
    MainTop := Top;
373
    MainWidth := Width;
374
    MainHeight := Height;
375
    if GraphFName = '' then GraphFName := NewFName;
376
    CurrentGraphFName := GraphFName;
377
    CurrentDataPath := DataPath;
378
    CurrentImagePath := ImagePath;
379
    with FunctionsForm do
380
    begin
381
      FuncLeft := Left;
382
      FuncTop := Top;
383
      FuncWidth := Width;
384
      FuncHeight := Height;
385
    end;
386

387
    GridsVisible := GridOptionsForm.Visible;
388
    with GridOptionsForm do
389
    begin
390
      GridsLeft := Left;
391
      GridsTop := Top;
392
    end;
393

394
    with GridColorsForm do
395
    begin
396
      GridColorsLeft := Left;
397
      GridColorsTop := Top;
398
    end;
399

400
    with PlotColorsForm do
401
    begin
402
      PlotColorsLeft := Left;
403
      PlotColorsTop := Top;
404
    end;
405

406
    EvaluateVisible := EvaluateForm.Visible;
407
    with EvaluateForm do
408
    begin
409
      EvaluateLeft := Left;
410
      EvaluateTop := Top;
411
    end;
412

413
    CoordVisible := CoordsForm.Visible;
414
    with CoordsForm do
415
    begin
416
      CoordLeft := Left;
417
      CoordTop := Top;
418
    end;
419

420
    with DerivativesForm do
421
    begin
422
      DerivLeft := Left;
423
      DerivTop := Top;
424
      if Visible then Close;
425
    end;;
426

427
    with AddPlotColorsForm do
428
    begin
429
      AddColorsLeft := Left;
430
      AddColorsTop := Top;
431
      if Visible then Close;
432
    end;
433
  end;
434

435
  try
436
    AssignFile(f, LayoutFName);
437
    try
438
      Rewrite(f);
439
      write(f, Layout);
440
    finally
441
      CloseFile(f);
442
    end;
443
  except
444
    MessageDlg('File Error! An Error has occurred'+
445
         #13#10'when attempting to write to "'+LayoutFName+'".',
446
    mtError, [mbOK], 0);
447
  end;
448

449
  if Altered or GridColorsAltered or DerivativeAltered then
450
  begin
451
    case MessageDlg('The current graph''s data has been altered.'+
452
              #13#10'Do you wish to save the alterations ?', mtConfirmation,
453
                    [mbYes, mbNo, mbCancel], 0) of
454
    mrYes: FunctionsForm.SaveClick(Sender);
455
 mrCancel: begin
456
             CanClose := False;
457
             Exit;
458
           end;
459
    end;
460
  end;
461
end;
462

463
procedure TViewForm.FormKeyDown(Sender: TObject; var Key: Word;
464
                                 Shift: TShiftState);
465
var
466
  d: integer;
467

468
begin
469
  d := 0;
470
  case Key of
471
  VK_ADD:      d := -1; { zoom in }
472
  VK_SUBTRACT: d :=  1; { zoom out }
473
  end;
474
  if Key in [VK_ADD,  VK_SUBTRACT] then
475
  begin
476
    Screen.Cursor := crZoom;
477
    GLSViewer.SetFocus;
478
{ each step adjusts target distance by 2.5% another method to zoom in or out }
479
    Camera.AdjustDistanceToTarget(Power(1.025, d));
480
    ShowCameraLocation;
481
  end
482
  else
483
  case Key of
484
  VK_HOME, VK_NUMPAD7, 72: DefaultView; {'H'/'h' key}
485
(*-> = 39
486
<- = 37
487
^  = 38
488
|  = 40
489
-> and ^ = 33
490
<- and | = 35*)
491
  end;
492
  Key := 0;
493
end;
494

495
procedure TViewForm.FormKeyUp(Sender: TObject; var Key: Word;
496
                               Shift: TShiftState);
497
begin
498
  Screen.Cursor := crDefault;
499
end;
500

501
procedure TViewForm.FormMouseWheel(Sender: TObject; Shift: TShiftState;
502
            WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
503
begin
504
  if (MousePoint.X >= GLSViewer.Left) and
505
     (MousePoint.X <= GLSViewer.Left + GLSViewer.Width) and
506
     (MousePoint.Y >= GLSViewer.Top) and
507
     (MousePoint.y <= GLSViewer.Top + GLSViewer.Height) then
508
  begin
509
{ a wheel step = WheelDelta/300; each step adjusts target distance by 2.5%
510
  another method to zoom in or out }
511
    GLSViewer.SetFocus;
512
    Camera.AdjustDistanceToTarget(Power(1.025, WheelDelta/300));
513
    ShowCameraLocation;
514
  end;
515
end;
516

517
procedure TViewForm.GLSViewerMouseDown(Sender: TObject; Button: TMouseButton;
518
                                        Shift: TShiftState; X, Y: Integer);
519
begin
520
  MousePoint.X := X;
521
  MousePoint.Y := Y;
522
  if ssShift in Shift then        { Shift key down }
523
  begin
524
    if ssLeft in Shift then Screen.Cursor := crZoom;
525
  end
526
  else if ssCtrl in Shift then    { Ctrl key down }
527
  begin
528
    if ssLeft in Shift then Screen.Cursor := crSlidexz
529
    else
530
    if ssRight in Shift then Screen.Cursor := crLightxz;
531
  end
532
  else if ssAlt in Shift then     { Alt key down }
533
  begin
534
    if ssLeft in Shift then Screen.Cursor := crSlidezy
535
    else
536
    if ssRight in Shift then Screen.Cursor := crLightxy;
537
  end
538
  else { no shift, ctrl or alt key }
539
  begin
540
    if Shift = [ssLeft] then Screen.Cursor := crRotate
541
    else
542
    if Shift = [ssRight] then Screen.Cursor := crZoom;
543
  end;
544
end;
545

546
procedure TViewForm.GLSViewerMouseMove(Sender: TObject;
547
                                        Shift: TShiftState; X, Y: Integer);
548
var
549
  dx, dy: integer;
550

551
begin { refer GLScene\Demos\interface\camera\Camera.dpr }
552
  if MousePoint.X = MaxInt then    { FileOpenDialog is visible }
553
  begin
554
    MousePoint.X := X;
555
    Exit;
556
  end;
557

558
  dx := MousePoint.X - X;
559
  dy := MousePoint.Y - Y;
560

561
  if ssShift in Shift then   { shift key down }
562
  begin
563
    if ssLeft in Shift then  { shift - left mouse button }
564
    begin
565
  { dy = a step which adjusts target distance by 1.25%; zoom in or out }
566
      with Camera do AdjustDistanceToTarget(Power(1.0125, dy));
567
      ShowCameraLocation;
568
    end;
569
  end
570
  else
571
  if ssCtrl in Shift then    { Ctrl key down }
572
  begin
573
    if ssLeft in Shift then  { Ctrl - left mouse button }
574
    begin
575
      TargetCube.Position.X :=
576
      TargetCube.Position.X - dx*GLxzGrid.XSamplingScale.Step/10;
577
      TargetCube.Position.Z :=
578
      TargetCube.Position.Z - dy*GLxzGrid.ZSamplingScale.Step*ViewData.xyGrid.zScale/10;
579
      ShowDisplacement;
580
    end;
581
    if ssRight in Shift then { Ctrl - right mouse button }
582
    begin
583
      GLLight.Position.Z := GLLight.Position.Z + dy/10;
584
      GLLight.Position.X := GLLight.Position.X + dx/10;
585
      ShowLightLocation;
586
    end;
587
  end
588
  else
589
  if ssAlt in Shift then     { Alt key down }
590
  begin
591
    if ssRight in Shift then { Alt - right mouse button }
592
    begin
593
      GLLight.Position.X := GLLight.Position.X + dx/10;
594
      GLLight.Position.Y := GLLight.Position.Y + dy/10;
595
      ShowLightLocation;
596
    end
597
    else
598
    if ssLeft in Shift then  { Alt - left mouse button }
599
    begin
600
      TargetCube.Position.Y :=
601
      TargetCube.Position.Y + dx*GLyzGrid.YSamplingScale.Step/10;
602
      TargetCube.Position.Z :=
603
      TargetCube.Position.Z - dy*GLyzGrid.ZSamplingScale.Step*ViewData.xyGrid.zScale/10;
604
      ShowDisplacement;
605
    end;
606
  end
607
  else  { no shift key }
608
  begin
609
    if Shift = [ssLeft] then
610
  { Left mouse button changes camera angle by moving around target }
611
    begin
612
      Camera.MoveAroundTarget(dy, dx);
613
      ShowCameraLocation;
614
    end;
615
    if Shift = [ssRight] then
616
    begin
617
  { Right mouse button alters the camera's focal length;
618
    zoom out or in by moving cursor up or down }
619
      with Camera do
620
      begin
621
        FocalLength  := FocalLength - dy;
622
        if FocalLength > 3000 then FocalLength := 3000;   { max focal length }
623
        if FocalLength < 10 then FocalLength := 10;       { min focal length }
624
      end;
625
      ShowFocalLength;       { display in statusbar palel }
626
    end;
627
  end;
628
  MousePoint.X := X;         { update mouse position }
629
  MousePoint.Y := Y;
630
end;
631

632
procedure TViewForm.GLSViewerMouseUp(Sender: TObject; Button: TMouseButton;
633
                                      Shift: TShiftState; X, Y: Integer);
634
begin
635
  Screen.Cursor := crDefault;
636
end;
637

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

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

648
procedure TViewForm.Save1Click(Sender: TObject);
649
begin
650
  FunctionsForm.SaveClick(Sender);
651
end;
652

653
procedure TViewForm.Saveas1Click(Sender: TObject);
654
begin
655
  FunctionsForm.SaveAsClick(Sender);
656
end;
657

658
procedure TViewForm.ShowCameraLocation;
659
begin
660
  with Camera.Position do
661
  StatusBar.Panels[0].Text := 'Camera: '+FloatToStrF(X, ffNumber, 5, 2)+', '+
662
  FloatToStrF(Y, ffNumber, 5, 2)+', '+FloatToStrF(Z, ffNumber, 5, 2);
663
end;
664

665
procedure TViewForm.GridColours1Click(Sender: TObject);
666
begin
667
  GridColorsForm.Show;
668
end;
669

670
procedure TViewForm.CoordText1Click(Sender: TObject);
671
begin
672
  CoordsForm.Show;
673
end;
674

675
procedure TViewForm.ShowFocalLength;
676
begin
677
  with Camera do
678
  StatusBar.Panels[1].Text := 'f = '+FloatToStrF(FocalLength, ffnumber, 5, 2);
679
end;
680

681
procedure TViewForm.ShowDisplacement;
682
begin
683
  with TargetCube.Position do
684
  StatusBar.Panels[2].Text := 'Displaced: '+
685
  FloatToStrF(-X, ffNumber, 5, 2)+', '+FloatToStrF(-Y, ffNumber, 5, 2)+', '+
686
  FloatToStrF(-Z, ffNumber, 5, 2);
687
end;
688

689
procedure TViewForm.Evaluate1Click(Sender: TObject);
690
begin
691
  EvaluateForm.Show;
692
end;
693

694
procedure TViewForm.ShowLightLocation;
695
begin
696
  with GLLight.Position do
697
  StatusBar.Panels[3].Text := 'Light: '+
698
  FloatToStrF(X, ffNumber, 5, 2)+', '+FloatToStrF(Y, ffNumber, 5, 2)+', '+
699
  FloatToStrF(Z, ffNumber, 5, 2);
700
end;
701

702
procedure TViewForm.Grid1Click(Sender: TObject);
703
begin
704
  GridOptionsForm.Show;
705
end;
706

707
procedure TViewForm.DefaultLayout1Click(Sender: TObject);
708
begin
709
  DefaultLayout;
710
end;
711

712
procedure TViewForm.DefaultView;
713
begin
714
  CameraCube.Position.SetPoint(0, 0, 0);
715
  ShowDisplacement;
716
  Camera.FocalLength := 200;
717
  ShowFocalLength;
718
  Camera.Position.SetPoint(50, 50, 30);
719
  Camera.DepthOfView := 1000;
720
  ShowCameraLocation;
721
  GLLight.Position.SetPoint(50, 50, 50);
722
  ShowLightLocation;
723
  TargetCube.Position.SetPoint(0, 0, 0);
724
end;
725

726
procedure TViewForm.RecentFilesClick(Sender: TObject);
727
begin
728
  FunctionsForm.OpenRecentFile(TMenuItem(Sender).Caption);
729
end;
730

731
procedure TViewForm.Exit1Click(Sender: TObject);
732
begin
733
  Close;
734
end;
735

736
procedure TViewForm.DefaultLayout;
737
begin
738
  WindowState := wsNormal;
739
  ViewForm.Left := 0;
740
  ViewForm.Top := 0;
741
  FunctionsForm.Width := 335;
742
  FunctionsForm.Height := 387;
743
  ViewForm.Width := Screen.Width - FunctionsForm.Width + 18;
744
  ViewForm.Height := Screen.Height - 40;
745
  FunctionsForm.Left := ViewForm.Left + ViewForm.Width - 14;
746
  FunctionsForm.Top := ViewForm.Top;
747
  GridOptionsForm.Left := FunctionsForm.Left +5;
748
  GridOptionsForm.Top := FunctionsForm.Top + FunctionsForm.Height - 6;
749
  EvaluateForm.Left := GridOptionsForm.Left;
750
  EvaluateForm.Top := GridOptionsForm.Top + GridOptionsForm.Height - 3;
751
  EvaluateForm.Show;
752
  GridOptionsForm.Show;
753
  GridColorsForm.Left := 20;
754
  GridColorsForm.Top := 80;
755
  PlotColorsForm.Left := 30;
756
  PlotColorsForm.Top := 100;
757
  AddPlotColorsForm.Left := 40;
758
  AddPlotColorsForm.Top := 120;
759
  FunctionsForm.EditMinX.SetFocus;
760
end;
761

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

770
procedure TViewForm.DerivativePlotColours1Click(Sender: TObject);
771
begin
772
  if PlotColorsForm.Visible then PlotColorsForm.Close;
773
  PlotColours1.Enabled := False;
774
  AddPlotColorsForm.Show;
775
end;
776

777
procedure TViewForm.PlotFunctions;
778
  procedure PlotFunction(i: Integer);
779
  begin
780
    with PlotData do
781
    begin
782
      with TGLHeightField(Fields.Children[i]) do
783
      begin
784
        with XSamplingScale do
785
        begin
786
          Step := xInc;
787
          Min := xMin;
788
          Max := xMax;
789
        end;
790

791
        with YSamplingScale do
792
        begin
793
          Step := yInc;
794
          Min := yMin;
795
          Max := yMax;
796
        end;
797

798
        case ViewMode of
799
          vmAmbient:ColorMode := hfcmAmbient;
800
vmAmbientandDiffuse:ColorMode := hfcmAmbientAndDiffuse;
801
          vmDiffuse:ColorMode := hfcmDiffuse;
802
         vmEmmision:ColorMode := hfcmEmission;
803
             vmNone:ColorMode := hfcmNone;
804
        end;
805

806
        case fxyMode of
807
        fxyFill:Material.PolygonMode := pmFill;
808
       fxyLines:Material.PolygonMode := pmLines;
809
      fxyPoints:Material.PolygonMode := pmPoints;
810
        end;
811
        OnGetHeight := Formulate;
812
      end;
813
      GLSViewer.Refresh;  { needed to display each zField data in list }
814
    end;
815
  end;
816

817
var
818
  i: integer;
819
  fxyParser: TfxyParser;
820
  PD: TPlotData;          { save the current PlotData of selected function }
821

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

841
procedure TViewForm.Formulate(const x, y: Single; var z: Single;
842
                  var color: TColorVector; var texPoint: TTexPoint);
843
var
844
  e: byte;
845
  MaxZ, MinZ: TGLFloat;
846
  x1, x2, y1, y2, z1, z2: extended;
847

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

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

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

915
    AddVolume:    { this is for double integral }
916
    begin
917
      z := ParseEvaluateFxy(x, y, PlotData.fxyStr, e);
918
      with AddedData do
919
      begin
920
        z := z*ViewData.xyGrid.zScale;
921
        MaxZ := zMax*ViewData.xyGrid.zScale;
922
        MinZ := zMin*ViewData.xyGrid.zScale;
923
        if zCap then
924
        begin
925
          if zLim and (z > MaxZ) then z := MaxZ;
926
          if zLim and (z < MinZ) then z := MinZ;
927
        end
928
        else
929
        if zLim and ((z < MinZ) or (z > MaxZ)) then z := NaN;
930
        VectorLerp(LowerColor, UpperColor, z*ColorBlend - ColorMove, color);
931

932
        TGLLines.CreateAsChild(VolumeLines);
933
        with VolumeLines do
934
        begin
935
          with TGLLines(Children[Count -1]) do
936
          begin
937
            LineColor.AsWinColor := AddLineColor;
938
            LineWidth := AddLineWidth;
939
            NodesAspect := LnaInvisible;
940

941
            Nodes.Add;
942
            Nodes[0].X := x;      { start point }
943
            Nodes[0].Y := y;
944
            if zLim then Nodes[0].Z := MinZ else Nodes[0].Z := 0;
945

946
            Nodes.Add;
947
            Nodes[1].X := x;      { end point }
948
            Nodes[1].Y := y;
949
            Nodes[1].Z := z;
950
          end;
951
        end;
952
      end;
953
    end;
954
  end;    { case AddedData.AddedAs of... }
955
end;
956

957
procedure TViewForm.PlotDerivativeField;
958
var
959
  i: integer;
960
  FoundSelected: Boolean;
961

962
begin
963
  Screen.Cursor := crHourGlass;
964
  try
965
    i := 0;
966
    if FunctionsForm.CheckListBox.Count > 1 then { find Selected item }
967
    begin
968
      FoundSelected := False;
969
      while not FoundSelected and (i < FunctionsForm.CheckListBox.Count) do
970
      begin
971
        FoundSelected := FunctionsForm.CheckListBox.Selected[i];
972
        if not FoundSelected then Inc(i);
973
      end;
974
    end;
975

976
    with FunctionsForm.CheckListBox do
977
    SelectedData := TPlotDataObject(Items.Objects[i]).Data;
978

979
    with AddedData do
980
    begin
981
      with TGLHeightField(AddedField.Children[0]) do
982
      begin
983
        with XSamplingScale do
984
        begin
985
          Step := xInc;
986
          Min := xMin;
987
          Max := xMax;
988
        end;
989

990
        with YSamplingScale do
991
        begin
992
          Step := yInc;
993
          Min := yMin;
994
          Max := yMax;
995
        end;
996

997
        case ViewMode of
998
            vmAmbient:ColorMode := hfcmAmbient;
999
  vmAmbientandDiffuse:ColorMode := hfcmAmbientAndDiffuse;
1000
            vmDiffuse:ColorMode := hfcmDiffuse;
1001
           vmEmmision:ColorMode := hfcmEmission;
1002
               vmNone:ColorMode := hfcmNone;
1003
        end;
1004

1005
        case fxyMode of
1006
        fxyFill:Material.PolygonMode := pmFill;
1007
       fxyLines:Material.PolygonMode := pmLines;
1008
      fxyPoints:Material.PolygonMode := pmPoints;
1009
        end;
1010
        OnGetHeight := Formulate;
1011
      end;
1012
      GLSViewer.Refresh;  { needed to display each zField data in list }
1013
    end;
1014
  finally
1015
    Screen.Cursor := crDefault;
1016
  end;
1017
end;
1018

1019
procedure TViewForm.PlotIntegralField;
1020
  procedure PlotVolume;
1021
  begin   { PlotVolume }
1022
    with AddedData do
1023
    begin
1024
      with TGLHeightField(AddedField.Children[0]) do
1025
      begin
1026
        with XSamplingScale do
1027
        begin
1028
          Step := xInc;
1029
          Min := xMin;
1030
          Max := xMax;
1031
        end;
1032

1033
        with YSamplingScale do
1034
        begin
1035
          Step := yInc;
1036
          Min := yMin;
1037
          Max := yMax;
1038
        end;
1039

1040
        case ViewMode of
1041
          vmAmbient:ColorMode := hfcmAmbient;
1042
vmAmbientandDiffuse:ColorMode := hfcmAmbientAndDiffuse;
1043
          vmDiffuse:ColorMode := hfcmDiffuse;
1044
         vmEmmision:ColorMode := hfcmEmission;
1045
             vmNone:ColorMode := hfcmNone;
1046
        end;
1047

1048
        case fxyMode of
1049
        fxyFill:Material.PolygonMode := pmFill;
1050
       fxyLines:Material.PolygonMode := pmLines;
1051
      fxyPoints:Material.PolygonMode := pmPoints;
1052
        end;
1053
        OnGetHeight := Formulate;
1054
      end;
1055
      GLSViewer.Refresh;  { needed to display each zField data in list }
1056
    end;
1057
  end;    { PlotVolume }
1058

1059
  procedure CalculateVolume;
1060
  var
1061
    e: byte;
1062
    i, j, iCount, jCount: integer;
1063
    x, y, z, x0, y0, a, VolPos, VolNeg: TGLFloat;
1064

1065
  begin   { CalculateVolume }
1066
    with AddedData do
1067
    begin
1068
      a := xInc*yInc;                               { base area }
1069
      iCount := round((xMax - xMin)/xInc) -1;       { number of x points }
1070
      jCount := round((yMax - yMin)/yInc) -1;       { number of y points }
1071
      VolPos := 0;
1072
      VolNeg := 0;
1073
      x0 := xMin + xInc/2;                          { base centre x0 }
1074
      y0 := yMin + yInc/2;                          { base centre y0 }
1075
      for j := 0 to jCount do
1076
      begin
1077
        y := y0 + j*yInc;                           { next column wrt y }
1078
        for i := 0 to iCount do
1079
        begin
1080
          x := x0 + i*xInc;                         { next column wrt x }
1081
          z := ParseEvaluateFxy(x, y, PlotData.fxyStr, e);
1082

1083
          if zLim then                              { zLimit applied }
1084
          begin
1085
            if (zMax >= 0) and (zMin <= 0) then     { above and below zero }
1086
            begin
1087
              if z > 0 then
1088
              begin
1089
                if z > zMax then VolPos := VolPos + a*zMax
1090
                            else VolPos := VolPos + a*z;
1091
              end
1092
              else
1093
              begin
1094
                if z < zMin then VolNeg := VolNeg + a*zMin
1095
                            else VolNeg := VolNeg + a*z;
1096
              end;
1097
            end
1098
            else
1099
            if zMin > 0 then                        { both above zero }
1100
            begin
1101
              if z >= zMin then
1102
              begin
1103
                if z > zMax then VolPos := VolPos + a*(zMax - zMin)
1104
                            else VolPos := VolPos + a*(z - zMin);
1105
              end;
1106
            end
1107
            else
1108
            if zMax < 0 then                        { both below zero }
1109
            begin
1110
              if z <= zMax then
1111
              begin
1112
                if z < zMin then VolNeg := VolNeg + a*(zMax - zMin)
1113
                            else VolNeg := VolNeg + a*(z - zMax);
1114
              end;
1115
            end;
1116
          end
1117
          else                                      { no zLimit applied }
1118
          begin
1119
            if z > 0 then VolPos := VolPos + a*z
1120
                     else VolNeg := VolNeg + a*z;
1121
          end;
1122
        end;
1123
      end;
1124
    end;
1125

1126
    with DerivativesForm do
1127
    begin
1128
      PosVolLabel.Caption := 'Positive Volume: '+FloatToStr(VolPos);
1129
      NegVolLabel.Caption := 'Negative Volume: '+FloatToStr(VolNeg);
1130
      TotalLabel.Caption := 'Absolute Volume: '+FloatToStr(VolPos - VolNeg);
1131
      VolumeLabel.Caption := 'Total Volume: '+FloatToStr(VolPos + VolNeg);
1132
    end;
1133
  end;    { CalculateVolume }
1134

1135
begin   { TViewForm.PlotIntegralField }
1136
  Screen.Cursor := crHourGlass;
1137
  with AddedData do
1138
  begin
1139
    PlotVolume;
1140
    CalculateVolume;
1141
  end;
1142
  DerivativesForm.VolumeRB.Checked := False; //
1143
  Screen.Cursor := crDefault;
1144
end;    { TViewForm.PlotIntegralField }
1145

1146
procedure TViewForm.PlotColours1Click(Sender: TObject);
1147
begin
1148
  PlotColorsForm.Show;
1149
end;
1150

1151
procedure TViewForm.CreateHeightFields(const n: integer);
1152
var
1153
  i: integer;
1154

1155
begin
1156
  while Fields.Count > 0 do TGLHeightField(Fields.Children[0]).Free;
1157
  for i := 0 to n -1 do
1158
  begin
1159
    TGLHeightField.CreateAsChild(Fields);
1160
    TGLHeightField(
1161
    Fields.Children[Fields.Count -1]).Material.BlendingMode := bmTransparency;
1162
  end;
1163
end;
1164

1165
procedure TViewForm.CreateAddedField;
1166
begin
1167
  ClearAddedField;
1168
  TGLHeightField.CreateAsChild(AddedField);
1169
  TGLHeightField(AddedField.Children[0]).Material.BlendingMode := bmTransparency;
1170
end;
1171

1172
procedure TViewForm.UpdatePlot;
1173
begin
1174
  CreateHeightFields(FunctionsForm.CheckListBox.Count);
1175
  PlotFunctions;
1176
end;
1177

1178
procedure TViewForm.UpdateAdded;
1179
begin
1180
  CreateAddedField;
1181
  AddXLine.LineColor.AsWinColor := AddedData.AddLineColor;
1182
  AddYLine.LineColor.AsWinColor := AddedData.AddLineColor;
1183
  AddZLine.LineColor.AsWinColor := AddedData.AddLineColor;
1184
  AddXLine.LineWidth := AddedData.AddLineWidth;
1185
  AddYLine.LineWidth := AddedData.AddLineWidth;
1186
  AddZLine.LineWidth := AddedData.AddLineWidth;
1187
  if AddedData.AddedAs = AddVolume then PlotIntegralField
1188
  else PlotDerivativeField;
1189
end;
1190

1191
procedure TViewForm.ClearAddedField;
1192
begin
1193
  with TGLHeightField(AddedField) do if Count > 0 then Children[0].Free;
1194
end;
1195

1196
procedure TViewForm.ClearAddedLines;
1197
begin
1198
  Screen.Cursor := crHourGlass;
1199
  with TGLLines(VolumeLines) do
1200
  while Count > 0 do Children[Count -1].Free;
1201
  Screen.Cursor := crDefault;
1202
end;
1203

1204
end.
1205