LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
  Component for animating camera movement.
6
  Can be used to zoom in/out, for linear movement, orbiting and Google Earth - like "fly-to"
7
  Main purpose was the SafeOrbitAndZoomToPos method, the others are usable as well
8

9
   History :  
10
       30/06/11 - DaStr - [Smooth]OrbitToPos now correctly uses local and absolute coordinates
11
                             Camera is now a TGLBaseSceneObject
12
                             Added CameraTarget property
13
                             Most procedures now use "const" parameters
14
                             Restructured TGLCameraJob: published some properties, deleted others
15
                             Added basic Notification
16
                             Removed Cadencer dependancy 
17
       14/06/11 - Vince - Correct positioning errors (OrbitToPosAdvance)
18
       07/05/11 - DaStr - Added Smooth OrbitToPos support
19
       20/05/11 - YanP - GLCameraController refactored as a Job manager, each camera movement is a job in a list
20
       10/05/11 - Vince - Add OnMove event
21
       04/05/11 - Vince - Add OrbitToPosAdvanced function to support OrbitToPos when axis are different from -1,0 or 1
22
       24/07/09 - DaStr - Got rid of compiler hints
23
       20/03/09 - DanB - Donated to GLScene by Bogdan Deaky.
24
     
25
}
26

27
//GLCameraController v1.1
28
//Bogdan Deaky / Bluemind Software
29
//Bluemind Software allows free usage and distribution of this component
30
//Do let the author know if you do code changes/improvements
31
//bogdan@bluemind-software.ro
32
//v1.0 2007
33
//v1.1 2009 (for GLScene, ships with glscene_icon_TGLCameraController.bmp)
34

35

36
//IMPORTANT!
37
//You should block user GUI access to the GLSceneViewer
38
//while movement is being done, check the AllowUserAction property!
39
//Block user GUI access while AllowUserAction is false to avoid behaviour errors
40
//simply put
41
//if GLCameraController1.AllowUserAction then
42
// //do whatever you want on mouse move, form wheel etc
43

44
// methods and properties are explained in the interface section (through comments)
45
// additional comments might apear in implementation section where needed
46

47
unit GLCameraController;
48

49
interface
50

51
uses
52
  GLScene, Classes, SysUtils, Contnrs, GLVectorGeometry,
53
  GLSmoothNavigator {$IFNDEF GLS_DELPHI},GLVectorTypes{$ENDIF};
54

55
type
56

57
  EGLCameraController = class(Exception);
58

59
  // Forward declaration of the camera controller main class
60
  TGLCameraController = class;
61

62
  // Forward declaration of a generic camera job
63
  TGLCameraJob = class;
64

65
  TGLCameraJobList = class(TObjectList)
66
  private
67
    FController : TGLCameraController;
68
    function GetCameraJob(const AIndex: integer): TGLCameraJob;
69
    procedure SetCameraJob(const AIndex: integer; const Value: TGLCameraJob);
70
  public
71
    constructor Create(AController: TGLCameraController);
72
    function Add(ACameraJob: TGLCameraJob): integer;
73
    property Items[const AIndex: integer]: TGLCameraJob read GetCameraJob write SetCameraJob; default;
74
    function First: TGLCameraJob;
75
    function Last: TGLCameraJob;
76
  end;
77

78
  TGLCameraJob = class(TObject)
79
  private
80
    FJoblist : TGLCameraJobList;
81
  protected
82
    FAbort         : boolean;
83
    FInit          : boolean;
84
    FRunning       : Boolean;
85

86
    FElapsedTime   : Double;
87
    FDeltaTime      : Double;
88
    FStartTime     : Double;
89
    FProceedTime   : Double;
90
  public
91
    constructor Create(const AJoblist : TGLCameraJobList); virtual;
92
    destructor Destroy; override;
93

94
    procedure Abort;
95
    procedure Step; virtual; abstract;
96
    procedure Init; virtual; abstract;
97

98
    property Running: Boolean read FRunning write FRunning;
99
    property ElapsedTime: Double read FElapsedTime write FElapsedTime;
100
    property StartTime: Double read FStartTime write FStartTime;
101
    property ProceedTime: Double read FProceedTime write FProceedTime;
102
  end;
103

104
  TGLMoveToPosJob = class(TGLCameraJob)
105
  private
106
    FInitialPos    : TVector;
107
    FFinalPos      : TVector;
108
  public
109
    X : Double;
110
    Y : Double;
111
    Z : Double;
112
    Time : Double;
113
    procedure Step; override;
114
    procedure Init; override;
115

116
    // Properties.
117
    property InitialPos: TVector read FInitialPos;
118
    property FinalPos: TVector read FFinalPos;    
119
  end;
120

121
  TGLZoomToDistanceJob = class(TGLCameraJob)
122
  private
123
    FInitialPos    : TVector;
124
    FFinalPos      : TVector;
125
  public
126
    Distance : Double;
127
    Time : Double;
128
    procedure Step; override;
129
    procedure Init; override;
130

131
    // Properties.
132
    property InitialPos: TVector read FInitialPos;
133
    property FinalPos: TVector read FFinalPos;
134
  end;
135

136
  TGLOrbitToPosJob = class(TGLCameraJob)
137
  private
138
    FFinalPos: TVector; // Yep, FFinalPos is stored in relative coordinates.
139
    FRotateSpeed: TVector2f;
140
    FCameraUpVector: TVector;
141

142
    // Absolute Coordinates, can even be not normalized by radius.
143
    // Procesed in Init, not used anywhere else.
144
    FTargetPosition: TVector;
145
    FTime : Double;
146
  public
147
    procedure Step; override;
148
    procedure Init; override;
149

150
    // Properties.
151
    property RotateSpeed: TVector2f read FRotateSpeed;
152
    property CameraUpVector: TVector read FCameraUpVector;
153
    property TargetPosition: TVector read FTargetPosition;
154
    property FinalPos: TVector read FFinalPos;
155
    property Time: Double read FTime;
156
  end;
157

158
  TGLSmoothOrbitToPos = class(TGLOrbitToPosJob)
159
  private
160
    FCutoffAngle: Single;
161
    FNeedToRecalculateZoom: Boolean;
162
    FShouldBeMatrix: TMatrix;
163
    FSmoothNavigator: TGLNavigatorSmoothChangeVector;
164
  public
165
    constructor Create(const AJoblist : TGLCameraJobList); override;
166
    procedure Step; override;
167
    property CutoffAngle: Single read FCutoffAngle write FCutoffAngle;
168
    property NeedToRecalculateZoom: Boolean read FNeedToRecalculateZoom write FNeedToRecalculateZoom;
169
  end;
170

171
  TGLOrbitToPosAdvJob = class(TGLCameraJob)
172
  private
173
    FInitialPos    : TVector;
174
    FFinalPos      : TVector;
175
    FInitialUp     : TVector;
176
    FInitialDir    : TVector;
177

178
    FRotAxis : TVector;
179
    FAngle   : Double;
180
  public
181
    X : Double;
182
    Y : Double;
183
    Z : Double;
184
    Time : Double;
185
    PreferUpAxis : Boolean;
186
    procedure Step; override;
187
    procedure Init; override;
188

189
    // Properties.
190
    property InitialPos: TVector read FInitialPos;
191
    property InitialUp: TVector read FInitialUp;
192
    property InitialDir: TVector read FInitialDir;
193
    property FinalPos: TVector read FFinalPos;
194
  end;
195

196
  TGLSmoothOrbitToPosAdvJob = class(TGLOrbitToPosAdvJob)
197
  private
198
    FPreviousPosition: TVector;
199
    FSmoothNavigator: TGLNavigatorSmoothChangeVector;
200
    FRestoreUpVector: Boolean;
201
  public
202
    procedure Step; override;
203
    procedure Init; override;
204
  end;
205

206
  TGLCameraJobEvent = procedure(Sender : TGLCameraJob) of object;
207

208
  TGLCameraController = class(TComponent)
209
  private
210
    // Objects.
211
    FCameraJobList : TGLCameraJobList;
212
    FCamera: TGLBaseSceneObject;
213
    FCameraTarget: TGLBaseSceneObject;
214

215
    // Events.
216
    FOnJobAdded: TGLCameraJobEvent;
217
    FOnJobFinished: TGLCameraJobEvent;
218
    FOnJobStep: TGLCameraJobEvent;
219

220
    //fields used by SafeOrbitAndZoomToPos
221
    FsoSafeDist, FsoTimeToSafePlacement, FsoTimeToOrbit, FsoTimeToZoomBackIn:double;
222

223
    //private methods
224
    //used to test whether camera and cadencer are assigned
225
    //Extended = true -> will test also for Camera.TargetObject
226
    procedure CheckAssignments(Extended: boolean);
227

228
    //after AdjustScene the Camera.DepthofView will be modified
229
    //if you want to zoom back in from GUI
230
    //you should use something like
231
    //  Camera.DepthOfView:=2*Camera.DistanceToTarget+2*camera.TargetObject.BoundingSphereRadius;
232
    procedure SetOnJobAdded(const Value: TGLCameraJobEvent);
233
    procedure SetOnJobFinished(const Value: TGLCameraJobEvent);
234
    procedure SetOnJobStep(const Value: TGLCameraJobEvent);
235
    procedure SetCamera(const Value: TGLBaseSceneObject);
236
    procedure SetCameraTarget(const Value: TGLBaseSceneObject);
237
  protected
238
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
239
  public
240
    // Constructor.
241
    constructor Create(AOwner:TComponent); override;
242
    destructor Destroy; override;
243

244
    //methods
245
    //linear movement from current pos
246
    function MoveToPos(x,y,z,time:double): TGLMoveToPosJob;
247

248
    //orbiting from current pos to the pos where
249
    //the camera points at the camera.targetObject TROUGH the given point
250
    //it will not move to the given point(!), use SafeOrbitAndZoomToPos instead
251
    //there has to be a camera.targetObject assigned!
252
    function OrbitToPos(x,y,z,time:double): TGLOrbitToPosJob;
253

254
    // Same as OrbitToPos(), but makes use of SmoothNavigator to make
255
    // sure all camera movements are smooth.
256
    function OrbitToPosSmooth(const ATargetPosition: TVector; const ATime: Double;
257
      const ASmoothNavigator: TGLNavigatorSmoothChangeVector; const AFNeedToRecalculateZoom: Boolean;
258
      const ACameraUpVector: PVector = nil): TGLSmoothOrbitToPos;
259

260
    //Same function as OrbitToPos but support all camera states
261
    //PreferUpAxis value is to setup if function use Camera Up based rotation axis
262
    //instead of Camera direction based rotation axis when destination and camera
263
    //position are opposite from Camera Target
264
    function OrbitToPosAdvanced(x,y,z,time:double; PreferUpAxis: Boolean = True): TGLOrbitToPosAdvJob;
265

266

267
    // Same as OrbitToPosAdvanced(), but makes use of SmoothNavigator to make
268
    // sure all camera movements are smooth.
269
    function OrbitToPosAdvancedSmooth(const x,y,z, time: double;
270
      const ASmoothNavigator: TGLNavigatorSmoothChangeVector;
271
      const PreferUpAxis: Boolean = True): TGLSmoothOrbitToPosAdvJob;
272

273
    //zooms in/out by moving to the given distance from camera.targetObject
274
    //there has to be a camera.targetObject assigned!
275
    function ZoomToDistance(Distance,Time:double): TGLZoomToDistanceJob;
276

277
    //google earth - like "fly-to"
278
    // = zoom out to safe distance, orbit, and then zoom in to the given point
279
    //there has to be a camera.targetObject assigned!
280
    procedure SafeOrbitAndZoomToPos(x,y,z:double);
281

282
    //Dan Bartlett said in the GLScene newsgroup that it might be a good idea
283
    //to introduce ability to stop movement and return control to user
284
    //here it is
285
    procedure StopMovement;
286

287
    // Called by the cadencer to animate the camera
288
    procedure Step(const deltaTime, newTime: Double);
289

290
    property CameraJobList: TGLCameraJobList read FCameraJobList;
291
  published
292
    // Moving object (usually a TGLCamera).
293
    property Camera: TGLBaseSceneObject read FCamera write SetCamera;
294

295
    // Target, around which Moving object should rotate(usually TGLCamera.TargetObject).
296
    property CameraTarget: TGLBaseSceneObject read FCameraTarget write SetCameraTarget;
297

298
    //specifies whether user should be able interract with the GLSceneViewer
299
    //it is set to false while the camera is moving and
300
    //coders should check this value and block GUI access to GLSceneViewer
301
    //property AllowUserAction:boolean read FAllowUserAction;
302

303
    //safe distance to avoid moving the camera trough the camera.targetObject
304
    //while performing  SafeOrbitAndZoomToPos
305
    property soSafeDistance:double read FsoSafeDist write FsoSafeDist;
306
    //time to zoom in/out to the safe position while performing  SafeOrbitAndZoomToPos
307
    property soTimeToSafePlacement:double read FsoTimeToSafePlacement write FsoTimeToSafePlacement;
308
    //time to orbit while performing  SafeOrbitAndZoomToPos
309
    property soTimeToOrbit:double read FsoTimeToOrbit write FsoTimeToOrbit;
310
    //time to zoom in/out to the given final position while performing  SafeOrbitAndZoomToPos
311
    property soTimeToZoomBackIn:double read FsoTimeToZoomBackIn write FsoTimeToZoomBackIn;
312

313
    //this event is triggered when a job is init
314
    property OnJobAdded : TGLCameraJobEvent read FOnJobAdded write SetOnJobAdded;
315

316
    //this event is triggered when a job is step (like an OnMove)
317
    property OnJobStep : TGLCameraJobEvent read FOnJobStep write SetOnJobStep;
318

319
    //this event is triggered when a job is finished (not canceled)
320
    property OnJobFinished : TGLCameraJobEvent read FOnJobFinished write SetOnJobFinished;
321
  end;
322

323
implementation
324

325

326
const
327
  cGLCAMERACONTROLLER_CHECK_EXTENDED = TRUE;
328
  cEPSILON = 0.001;
329

330
{ TGLCameraController }
331

332
constructor TGLCameraController.Create(AOwner:TComponent);
333
begin
334
  inherited;
335
  //create the job list container
336
  FCameraJobList := TGLCameraJobList.Create(Self);
337
  FCameraJobList.OwnsObjects := true;
338

339
  //initialize values
340
  soSafeDistance:=10;
341
  soTimeToSafePlacement:=1;
342
  soTimeToOrbit:=2;
343
  soTimeToZoomBackIn:=1;
344
end;
345

346
destructor TGLCameraController.Destroy;
347
begin
348
  //delete job list and all jobs inside
349
  FCameraJobList.Free;
350
  inherited;
351
end;
352

353

354
procedure TGLCameraController.CheckAssignments(Extended:boolean);
355
begin
356
  /// Check camera assignment
357
  if not Assigned(FCamera) then
358
  begin
359
    Raise EGLCameraController.CreateFmt('%s (%s) needs to have a Camera assigned',[Self.Name, Self.ClassName]);
360
  end;
361

362
  if Extended then
363
    /// Check camera;TargetObject assignment
364
    if not Assigned(FCameraTarget) then
365
    begin
366
      Raise EGLCameraController.CreateFmt('%s (%s) needs Camera to have a TargetObject assigned',[Self.Name, Self.ClassName]);
367
    end;
368
end;
369

370
procedure TGLCameraController.Step(const deltaTime, newTime: Double);
371
var
372
  CurrentJob : TGLCameraJob;
373
begin
374

375
  if FCameraJobList.Count > 0 then
376
  begin
377
    CurrentJob := FCameraJobList.First;
378

379
    if CurrentJob.FInit then
380
    begin
381
      CurrentJob.Init;
382
      CurrentJob.FStartTime := newTime;
383
      CurrentJob.FRunning := True;
384
      CurrentJob.FInit := False;
385

386
      // Notify job
387
      if Assigned(FOnJobAdded) then
388
        FOnJobAdded(CurrentJob);
389
    end;
390

391
    if CurrentJob.FRunning then
392
    begin
393
      CurrentJob.FElapsedTime := newTime - CurrentJob.FStartTime;
394
      CurrentJob.FDeltaTime := deltaTime;// newTime - CurrentJob.FElapsedTime;
395
      CurrentJob.Step;
396

397
      // Notify job
398
      if Assigned(FOnJobStep) then
399
        FOnJobStep(CurrentJob);
400
    end;
401

402
    if not CurrentJob.FRunning then
403
    begin
404
      FCameraJobList.Remove(CurrentJob);
405

406
      // Notify job
407
      if Assigned(FOnJobFinished) then
408
        FOnJobFinished(CurrentJob);
409
    end;
410

411
  end;
412

413
  //AdjustScene;
414
end;
415

416

417
function TGLCameraController.MoveToPos(x,y,z, time:double): TGLMoveToPosJob;
418
begin
419
  Result := TGLMoveToPosJob.Create(FCameraJobList);
420

421
  Result.X := x;
422
  Result.Y := y;
423
  Result.Z := z;
424
  Result.Time := time;
425
end;
426

427

428
function TGLCameraController.ZoomToDistance(Distance, Time:double): TGLZoomToDistanceJob;
429
begin
430
  Result := TGLZoomToDistanceJob.Create(FCameraJobList);
431
  Result.Distance := Distance;
432
  Result.Time := Time;
433
end;
434

435

436
function TGLCameraController.OrbitToPos(x,y,z,time:double): TGLOrbitToPosJob;
437
begin
438
  Result := TGLOrbitToPosJob.Create(FCameraJobList);
439
  Result.FTargetPosition := PointMake(x, y, z);
440
  Result.FCameraUpVector := FCameraJobList.FController.FCamera.AbsoluteUp;
441
  Result.FTime := time;
442
end;
443

444

445
function TGLCameraController.OrbitToPosSmooth(const ATargetPosition: TVector; const ATime: Double;
446
  const ASmoothNavigator: TGLNavigatorSmoothChangeVector; const AFNeedToRecalculateZoom: Boolean;
447
  const ACameraUpVector: PVector = nil): TGLSmoothOrbitToPos;
448
begin
449
  Result := TGLSmoothOrbitToPos.Create(FCameraJobList);
450

451
  Result.FTargetPosition := ATargetPosition;
452
  Result.FTime := ATime;
453
  Result.FSmoothNavigator := ASmoothNavigator;
454
  Result.FShouldBeMatrix := FCameraJobList.FController.FCamera.Matrix;
455
  Result.FNeedToRecalculateZoom := AFNeedToRecalculateZoom;
456
  if ACameraUpVector = nil then
457
    Result.FCameraUpVector := FCameraJobList.FController.FCamera.AbsoluteUp
458
  else
459
    Result.FCameraUpVector := ACameraUpVector^;
460
end;
461

462
function TGLCameraController.OrbitToPosAdvanced(x,y,z,time:double; PreferUpAxis: Boolean = True): TGLOrbitToPosAdvJob;
463
begin
464
  Result := TGLOrbitToPosAdvJob.Create(FCameraJobList);
465

466
  Result.X := x;
467
  Result.Y := y;
468
  Result.Z := z;
469
  Result.PreferUpAxis := PreferUpAxis;
470
  Result.Time := time;
471
end;
472

473
function TGLCameraController.OrbitToPosAdvancedSmooth(const x,y,z, time: double;
474
  const ASmoothNavigator: TGLNavigatorSmoothChangeVector; const PreferUpAxis: Boolean = True): TGLSmoothOrbitToPosAdvJob;
475
begin
476
  Result := TGLSmoothOrbitToPosAdvJob.Create(FCameraJobList);
477

478
  Result.X := x;
479
  Result.Y := y;
480
  Result.Z := z;
481
  Result.PreferUpAxis := PreferUpAxis;
482
  Result.Time := time;
483
  Result.FSmoothNavigator := ASmoothNavigator;
484
  Result.FPreviousPosition := ASmoothNavigator.OnGetCurrentValue(ASmoothNavigator);
485
  Result.FRestoreUpVector := True;
486
end;
487

488
procedure TGLCameraController.SafeOrbitAndZoomToPos(x,y,z:double);
489
begin
490
  //this was the main purpose of this component
491
  //as you can see, it actually is a combination of the other 3 methods
492
  CheckAssignments(cGLCAMERACONTROLLER_CHECK_EXTENDED);
493
  ZoomToDistance(soSafeDistance,soTimeToSafePlacement);
494
  OrbitToPos(x,y,z,soTimeToOrbit);
495
  MoveToPos(x,y,z,soTimeToZoomBackIn);
496
end;
497

498

499
procedure TGLCameraController.StopMovement;
500
begin
501
  FCameraJobList.Clear;
502
end;
503

504

505
procedure TGLCameraController.SetOnJobAdded(const Value: TGLCameraJobEvent);
506
begin
507
  FOnJobAdded := Value;
508
end;
509

510
procedure TGLCameraController.SetOnJobStep(const Value: TGLCameraJobEvent);
511
begin
512
  FOnJobStep := Value;
513
end;
514

515
procedure TGLCameraController.SetOnJobFinished(const Value: TGLCameraJobEvent);
516
begin
517
  FOnJobFinished := Value;
518
end;
519

520
procedure TGLCameraController.SetCamera(const Value: TGLBaseSceneObject);
521
begin
522
  if FCamera <> nil then FCamera.RemoveFreeNotification(Self);
523
  FCamera := Value;
524
  if FCamera <> nil then FCamera.FreeNotification(Self);
525
  
526
  if (FCamera is TGLCamera) and (FCameraTarget = nil) then
527
    SetCameraTarget(TGLCamera(FCamera).TargetObject);
528
end;
529

530
procedure TGLCameraController.SetCameraTarget(
531
  const Value: TGLBaseSceneObject);
532
begin
533
  if FCameraTarget <> nil then FCameraTarget.RemoveFreeNotification(Self);
534
  FCameraTarget := Value;
535
  if FCameraTarget <> nil then FCameraTarget.FreeNotification(Self);
536
end;
537

538
procedure TGLCameraController.Notification(AComponent: TComponent;
539
  Operation: TOperation);
540
begin
541
  inherited;
542
  if Operation = opRemove then
543
  begin
544
    if AComponent = FCamera then
545
      FCamera := nil
546
    else if AComponent = FCameraTarget then
547
      FCameraTarget := nil;
548
  end;
549
end;
550

551
{ TGLCameraJobList }
552

553

554
constructor TGLCameraJobList.Create(AController: TGLCameraController);
555
begin
556
  inherited Create;
557
  FController := AController;
558
end;
559

560
function TGLCameraJobList.GetCameraJob(const AIndex: integer): TGLCameraJob;
561
begin
562
  Result := inherited Get(AIndex);
563
end;
564

565
procedure TGLCameraJobList.SetCameraJob(const AIndex: integer;
566
  const Value: TGLCameraJob);
567
begin
568
  inherited Put(AIndex, Value);
569
end;
570

571
function TGLCameraJobList.Add(ACameraJob: TGLCameraJob): integer;
572
begin
573
  Result := inherited Add(ACameraJob);
574
end;
575

576
function TGLCameraJobList.First: TGLCameraJob;
577
begin
578
  Result := TGLCameraJob(inherited First);
579
end;
580

581
function TGLCameraJobList.Last: TGLCameraJob;
582
begin
583
  Result := TGLCameraJob(inherited Last);
584
end;
585

586
{ TGLCameraJob }
587

588
constructor TGLCameraJob.Create(const AJoblist : TGLCameraJobList);
589
begin
590
  FJoblist := AJoblist;
591
  FJoblist.Add(Self);
592

593
  FInit := True;
594
  FStartTime := 0;
595
  FProceedTime := 0;
596
end;
597

598
destructor TGLCameraJob.Destroy;
599
begin
600

601
  inherited;
602
end;
603

604
procedure TGLCameraJob.Abort;
605
begin
606

607
end;
608

609

610
{ TGLMoveToPosJob }
611

612
procedure TGLMoveToPosJob.Init;
613
begin
614
  FProceedTime := Time;
615
  FInitialPos := VectorSubtract(FJobList.FController.FCamera.AbsolutePosition, FJobList.FController.FCameraTarget.AbsolutePosition);
616
  MakeVector(FFinalPos, X, Y, Z);
617
end;
618

619
procedure TGLMoveToPosJob.Step;
620
var
621
  Vect : TVector;
622
begin
623
  if FElapsedTime < FProceedTime then
624
  begin
625
    Vect := VectorLerp(FInitialPos, FFinalPos, FElapsedTime/FProceedTime);
626
  end
627
    else
628
  begin
629
    Vect := FFinalPos;
630
    FRunning := false;
631
  end;
632

633
  if Assigned(FJobList.FController.FCamera.Parent) then
634
    Vect:=FJobList.FController.FCamera.Parent.AbsoluteToLocal(Vect);
635

636
  FJobList.FController.FCamera.Position.AsVector := Vect;
637
end;
638

639
{ TGLZoomToDistanceJob }
640

641
procedure TGLZoomToDistanceJob.Init;
642
begin
643
  FProceedTime := Time;
644
  FInitialPos := VectorSubtract(FJobList.FController.FCamera.AbsolutePosition, FJobList.FController.FCameraTarget.AbsolutePosition);
645
  // To determine final position, we normalize original position and scale it with final distance
646
  SetVector(FFinalPos, FInitialPos);
647
  NormalizeVector(FFinalPos);
648
  ScaleVector(FFinalPos, Distance);
649
end;
650

651
procedure TGLZoomToDistanceJob.Step;
652
var
653
  Vect : TVector;
654
begin
655
  if FElapsedTime < FProceedTime then
656
  begin
657
    Vect := VectorLerp(FInitialPos, FFinalPos, FElapsedTime/FProceedTime);
658
  end
659
    else
660
  begin
661
    Vect := FFinalPos;
662
    FRunning := false;
663
  end;
664

665
  if Assigned(FJobList.FController.FCamera.Parent) then
666
    Vect:=FJobList.FController.FCamera.Parent.AbsoluteToLocal(Vect);
667

668
  FJobList.FController.FCamera.Position.AsVector := Vect;
669
end;
670

671

672

673
{ TGLOrbitToPosJob }
674

675

676
procedure TGLOrbitToPosJob.Init;
677
begin
678
  FProceedTime := FTime;
679

680
  FFinalPos := ShiftObjectFromCenter(FTargetPosition, FJobList.FController.FCameraTarget.AbsolutePosition,
681
    VectorDistance(FJobList.FController.FCamera.AbsolutePosition, FJobList.FController.FCameraTarget.AbsolutePosition), True);
682

683
  // Yep, FFinalPos is stored in relative coordinates.
684
  if FJobList.FController.FCamera.Parent <> nil then
685
    FFinalPos := FJobList.FController.FCamera.Parent.AbsoluteToLocal(FFinalPos);
686

687
  FRotateSpeed := GLVectorGeometry.GetSafeTurnAngle(
688
    FJobList.FController.FCamera.AbsolutePosition, FCameraUpVector, FTargetPosition,
689
    FJobList.FController.FCameraTarget.AbsolutePosition);
690

691
  ScaleVector(FRotateSpeed, 1 / FProceedTime);
692

693
  FInit := True;
694
end;
695

696
procedure TGLOrbitToPosJob.Step;
697
begin
698

699
  if FElapsedTime < FProceedTime then
700
  begin
701
    FJobList.FController.FCamera.AbsolutePosition := MoveObjectAround(
702
      FJobList.FController.FCamera.AbsolutePosition, FCameraUpVector,
703
      FJobList.FController.FCameraTarget.AbsolutePosition,
704
      FRotateSpeed.V[0] * FDeltaTime, FRotateSpeed.V[1] * FDeltaTime);
705
  end
706
    else
707
  begin
708
    // Yep, FFinalPos is stored in ralative coordinates.
709
    FJobList.FController.FCamera.Position.AsVector := FFinalPos;
710
    FRunning := False;
711
  end;
712

713
end;
714

715

716
{ TGLOrbitToPosAdvJob }
717

718
procedure TGLOrbitToPosAdvJob.Init;
719
var
720
  Right: TVector;
721
  lAbsVectorToTarget: TVector;
722
begin
723

724
  FProceedTime := time;
725
  FInitialPos := VectorSubtract(FJobList.FController.FCamera.AbsolutePosition, FJobList.FController.FCameraTarget.AbsolutePosition);
726

727
  if Assigned(FJobList.FController.FCamera.Parent) then
728
    FFinalPos := VectorSubtract(FJobList.FController.FCamera.Parent.LocalToAbsolute(VectorMake(x,y,z,1)), FJobList.FController.FCameraTarget.AbsolutePosition)
729
  else
730
    FFinalPos := VectorSubtract(VectorMake(x,y,z,1), FJobList.FController.FCameraTarget.AbsolutePosition);
731

732
  //if destination is Target Pos, we can't compute
733
  if VectorLength(FFinalPos)<cEPSILON then
734
  begin
735
    //FAllowUserAction := True;
736
    Exit;
737
  end;
738

739
  //Compute Angle of Rotation
740
  FAngle:= ArcCos(VectorAngleCosine(Vector3fMake(FFinalPos), Vector3fMake(FInitialPos)));
741

742
  lAbsVectorToTarget := VectorNormalize(VectorSubtract(
743
      FJobList.FController.FCameraTarget.AbsolutePosition,
744
      FJobList.FController.FCamera.AbsolutePosition));
745

746
  Right := VectorNormalize(VectorCrossProduct(lAbsVectorToTarget, FJobList.FController.FCamera.AbsoluteUp));
747

748
  FInitialDir := FJobList.FController.FCamera.AbsoluteDirection;
749
  FInitialUp := FJobList.FController.FCamera.AbsoluteUp;
750

751
  // Determine rotation Axis
752
  // if Angle equals 0 degrees.
753
  if FAngle < cEPSILON then
754
    if PreferUpAxis then
755
      FRotAxis := VectorNormalize(VectorCrossProduct(
756
                   VectorCrossProduct(FFinalPos, FInitialUp), FFinalPos))
757
    else
758
      FRotAxis := Right
759
  else
760
    // if Angle equals 180 degrees.
761
    if FAngle >Pi - cEPSILON  then
762
      if PreferUpAxis then
763
        FRotAxis := VectorNormalize(VectorCrossProduct(VectorCrossProduct(FFinalPos, FInitialUp), FFinalPos))
764
      else
765
        FRotAxis := Right
766
    else
767
      FRotAxis:= VectorNormalize(VectorCrossProduct(FFinalPos, FInitialPos));
768

769
end;
770

771
procedure TGLOrbitToPosAdvJob.Step;
772
var
773
  tempUp, tempDir, tempPos : TVector;
774
begin
775

776
  if FElapsedTime < FProceedTime then
777
  begin
778
    //Compute Position
779
    tempPos := FInitialPos;
780
    RotateVector(tempPos, Vector3fMake(FRotAxis), FAngle * FElapsedTime/FProceedTime);
781
    FJobList.FController.FCamera.AbsolutePosition := VectorAdd(FJobList.FController.FCameraTarget.AbsolutePosition, tempPos);
782

783
    //Compute Direction vector
784
    tempDir := FInitialDir;
785
    RotateVector(tempDir, Vector3fMake(FRotAxis), FAngle * FElapsedTime/FProceedTime);
786
    FJobList.FController.FCamera.AbsoluteDirection := tempDir;
787

788
    //Compute Up Vector
789
    tempUp := FInitialUp;
790
    RotateVector(tempUp, Vector3fMake(FRotAxis), FAngle * FElapsedTime/FProceedTime);
791
    FJobList.FController.FCamera.AbsoluteUp := tempUp;
792
  end
793
    else
794
  begin
795
    //Compute Position
796
    tempPos := FInitialPos;
797
    RotateVector(tempPos, Vector3fMake(FRotAxis), FAngle);
798
    FJoblist.FController.FCamera.AbsolutePosition := VectorAdd(
799
       FJoblist.FController.FCameraTarget.AbsolutePosition, tempPos);
800

801
    //Compute Direction vector
802
    tempDir := FInitialDir;
803
    RotateVector(tempDir, Vector3fMake(FRotAxis), FAngle);
804
    FJoblist.FController.FCamera.AbsoluteDirection := tempDir;
805

806
    //Compute Up Vector
807
    tempUp := FInitialUp;
808
    RotateVector(tempUp, Vector3fMake(FRotAxis), FAngle);
809
    FJoblist.FController.FCamera.AbsoluteUp := tempUp;
810

811
    FRunning := false;
812
  end;
813

814
end;
815

816
{ TGLSmoothOrbitToPosAdvJob }
817

818
procedure TGLSmoothOrbitToPosAdvJob.Init;
819
var
820
  Right: TVector;
821
begin
822
  FProceedTime := time;
823
  FInitialPos:= VectorSubtract(FPreviousPosition, FJobList.FController.FCameraTarget.AbsolutePosition);
824

825
  if Assigned(FJobList.FController.FCamera.Parent) then
826
    FFinalPos := VectorSubtract(FJobList.FController.FCamera.Parent.LocalToAbsolute(VectorMake(x,y,z,1)), FJobList.FController.FCameraTarget.AbsolutePosition)
827
  else
828
    FFinalPos := VectorSubtract(VectorMake(x,y,z,1), FJobList.FController.FCameraTarget.AbsolutePosition);
829

830
  //if destination is Target Pos, we can't compute
831
  if VectorLength(FFinalPos)<cEPSILON then
832
  begin
833
    //FAllowUserAction := True;
834
    Exit;
835
  end;
836

837
  //Compute Angle of Rotation
838
  FAngle:= ArcCos(VectorAngleCosine(Vector3fMake(FFinalPos), Vector3fMake(FInitialPos)));
839

840
  Right := VectorNormalize(VectorCrossProduct(
841
//    FJobList.FController.FCamera.AbsoluteVectorToTarget,
842
    VectorNormalize(VectorSubtract(FJobList.FController.FCameraTarget.AbsolutePosition, FPreviousPosition)),
843
    FJobList.FController.FCamera.AbsoluteUp));
844

845
  FInitialDir := FJobList.FController.FCamera.AbsoluteDirection;
846
  FInitialUp := FJobList.FController.FCamera.AbsoluteUp;
847

848
  // Determine rotation Axis
849
  // if Angle equals 0 degrees.
850
  if FAngle < cEPSILON then
851
    if PreferUpAxis then
852
      FRotAxis := VectorNormalize(VectorCrossProduct(
853
                   VectorCrossProduct(FFinalPos, FInitialUp), FFinalPos))
854
    else
855
      FRotAxis := Right
856
  else
857
    // if Angle equals 180 degrees.
858
    if FAngle >Pi - cEPSILON  then
859
      if PreferUpAxis then
860
        FRotAxis := VectorNormalize(VectorCrossProduct(VectorCrossProduct(FFinalPos, FInitialUp), FFinalPos))
861
      else
862
        FRotAxis := Right
863
    else
864
      FRotAxis:= VectorNormalize(VectorCrossProduct(FFinalPos, FInitialPos));
865

866
end;
867

868
procedure TGLSmoothOrbitToPosAdvJob.Step;
869
var
870
  tempUp, tempDir, tempPos : TVector;
871
begin
872

873
  if FElapsedTime < FProceedTime then
874
  begin
875
    //Compute Position
876
    tempPos := FInitialPos;
877
    RotateVector(tempPos, Vector3fMake(FRotAxis), FAngle * FElapsedTime/FProceedTime);
878
    FSmoothNavigator.TargetValue.DirectVector := VectorAdd(FJobList.FController.FCameraTarget.AbsolutePosition, tempPos);
879
    FPreviousPosition := FSmoothNavigator.TargetValue.DirectVector;
880

881
    //Compute Direction vector
882
    tempDir := FInitialDir;
883
    RotateVector(tempDir, Vector3fMake(FRotAxis), FAngle * FElapsedTime/FProceedTime);
884
    FJobList.FController.FCamera.AbsoluteDirection := tempDir;
885

886
    //Compute Up Vector
887
    if FRestoreUpVector then
888
      FJobList.FController.FCamera.AbsoluteUp := FInitialUp
889
    else
890
    begin
891
      tempUp := FInitialUp;
892
      RotateVector(tempUp, Vector3fMake(FRotAxis), FAngle * FElapsedTime/FProceedTime);
893
      FJobList.FController.FCamera.AbsoluteUp := tempUp;
894
    end;
895
  end
896
  else
897
  begin
898
    //Compute Position
899
    tempPos := FInitialPos;
900
    RotateVector(tempPos, Vector3fMake(FRotAxis), FAngle);
901
    FJoblist.FController.FCamera.AbsolutePosition := VectorAdd(
902
      FJoblist.FController.CameraTarget.AbsolutePosition, tempPos);
903

904
    //Compute Direction vector
905
    tempDir := FInitialDir;
906
    RotateVector(tempDir, Vector3fMake(FRotAxis), FAngle);
907
    FJoblist.FController.FCamera.AbsoluteDirection := tempDir;
908

909
    //Compute Up Vector
910
    if FRestoreUpVector then
911
      FJoblist.FController.FCamera.AbsoluteUp := FInitialUp
912
    else
913
    begin
914
      tempUp := FInitialUp;
915
      RotateVector(tempUp, Vector3fMake(FRotAxis), FAngle);
916
      FJoblist.FController.FCamera.AbsoluteUp := tempUp;
917
      FRunning := false;
918
    end;
919

920
    FRunning := false;
921
  end;
922
end;
923

924
{ TGLSmoothOrbitToPosAdv }
925

926
constructor TGLSmoothOrbitToPos.Create(const AJoblist: TGLCameraJobList);
927
begin
928
  inherited;
929
  FCutoffAngle := 0.1;
930
end;
931

932
procedure TGLSmoothOrbitToPos.Step;
933
var
934
  lCurrentDistanceToTarget: Single;
935
  lTargetPosition: TVector;
936
  lCurrentMatrix: TMatrix;
937
  lAngle: Single;
938
  lAbsTargetPosition: TVector;
939

940
  procedure RestoreDistanceToTarget();
941
  var
942
    lDirection: TVector;
943
  begin
944
    lDirection := VectorNormalize(VectorSubtract(
945
      FJobList.FController.FCameraTarget.AbsolutePosition,
946
      FJobList.FController.FCamera.AbsolutePosition));
947

948
    FJobList.FController.FCamera.AbsolutePosition := VectorAdd(
949
      FJobList.FController.FCameraTarget.AbsolutePosition,
950
      VectorScale(lDirection, - lCurrentDistanceToTarget));
951
  end;
952

953

954
  procedure SetTargetValueRelative(const AAbsolutePosition: TVector);
955
  begin
956
    if FJobList.FController.FCamera.Parent = nil then
957
      FSmoothNavigator.TargetValue.DirectVector := AAbsolutePosition
958
    else
959
      FSmoothNavigator.TargetValue.DirectVector := FJobList.FController.FCamera.Parent.AbsoluteToLocal(AAbsolutePosition);
960
  end;
961

962
  procedure ApplyDistanceToResult();
963
  var
964
    lDirection, lNewTargetPosition: TVector;
965
  begin
966
    lDirection := VectorNormalize(VectorSubtract(
967
      FJobList.FController.FCameraTarget.AbsolutePosition,
968
      lAbsTargetPosition));
969

970
    lNewTargetPosition := VectorAdd(
971
      FJobList.FController.FCameraTarget.AbsolutePosition,
972
      VectorScale(lDirection, - lCurrentDistanceToTarget));
973

974
    SetTargetValueRelative(lNewTargetPosition);
975
  end;
976

977
begin
978
  if FElapsedTime < FProceedTime then
979
  begin
980
    // Save current matrix.
981
    lCurrentMatrix := FJobList.FController.FCamera.Matrix;
982

983
    if FNeedToRecalculateZoom then
984
      lCurrentDistanceToTarget := FJobList.FController.FCamera.DistanceTo(FJobList.FController.FCameraTarget)
985
    else
986
      lCurrentDistanceToTarget := 0; // To avoid warning message.
987

988
    // Calculate the position, in which camera should have been.
989
    FJobList.FController.FCamera.Matrix := FShouldBeMatrix;
990

991
    FJobList.FController.FCamera.AbsolutePosition := MoveObjectAround(
992
      FJobList.FController.FCamera.AbsolutePosition, FCameraUpVector,
993
      FJobList.FController.FCameraTarget.AbsolutePosition,
994
      FRotateSpeed.V[0] * FDeltaTime, FRotateSpeed.V[1] * FDeltaTime);
995

996
    if FNeedToRecalculateZoom then
997
      RestoreDistanceToTarget();
998

999
    lTargetPosition := FJobList.FController.FCamera.AbsolutePosition;
1000
    FShouldBeMatrix := FJobList.FController.FCamera.Matrix;
1001

1002
    // Restore Camera position and move it to the desired vector.
1003
    FJobList.FController.FCamera.Matrix := lCurrentMatrix;
1004
    SetTargetValueRelative(lTargetPosition);
1005
  end
1006
  else
1007
  begin
1008
    if FNeedToRecalculateZoom then
1009
    begin
1010
      if FJobList.FController.FCamera.Parent = nil then
1011
        lAbsTargetPosition := FFinalPos
1012
      else
1013
        lAbsTargetPosition := FJobList.FController.FCamera.Parent.LocalToAbsolute(FFinalPos);
1014

1015
      lAngle := RadToDeg(AngleBetweenVectors(FJobList.FController.FCamera.AbsolutePosition,
1016
         lAbsTargetPosition, FJobList.FController.FCameraTarget.AbsolutePosition));
1017
      if lAngle < FCutoffAngle then
1018
      begin
1019
        FSmoothNavigator.Enabled := False;
1020
        FRunning := False;
1021
      end
1022
      else
1023
      begin
1024
        lCurrentDistanceToTarget := FJobList.FController.FCamera.DistanceTo(FJobList.FController.FCameraTarget);
1025
        ApplyDistanceToResult();
1026
      end;
1027
    end
1028
    else
1029
    begin
1030
      FSmoothNavigator.TargetValue.DirectVector := FFinalPos;
1031
      FRunning := False;
1032
    end;
1033
  end;
1034
end;
1035

1036
end.
1037