123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996 |
- //
- // The graphics engine GLScene
- //
- unit GLS.CameraController;
- (*
- Component for animating camera movement.
- Can be used to zoom in/out, for linear movement, orbiting and Google Earth - like "fly-to"
- Main purpose was the SafeOrbitAndZoomToPos method, the others are usable as well
- *)
- interface
- uses
- System.Classes,
- System.SysUtils,
- System.Math,
- System.Contnrs,
- System.Types,
- Stage.VectorTypes,
- Stage.VectorGeometry,
- GLS.Coordinates,
- GLS.PersistentClasses,
- GLS.Scene,
- GLS.SmoothNavigator;
- type
- EGLCameraController = class(Exception);
- // Forward declaration of the camera controller main class
- TGLCameraController = class;
- // Forward declaration of a generic camera job
- TGLCameraJob = class;
- TGLCameraJobList = class(TObjectList)
- private
- FController: TGLCameraController;
- function GetCameraJob(const AIndex: integer): TGLCameraJob;
- procedure SetCameraJob(const AIndex: integer; const Value: TGLCameraJob);
- public
- constructor Create(AController: TGLCameraController);
- function Add(ACameraJob: TGLCameraJob): integer;
- property Items[const AIndex: integer]: TGLCameraJob read GetCameraJob
- write SetCameraJob; default;
- function First: TGLCameraJob;
- function Last: TGLCameraJob;
- end;
- TGLCameraJob = class(TObject)
- private
- FJoblist: TGLCameraJobList;
- protected
- FAbort: boolean;
- FInit: boolean;
- FRunning: boolean;
- FElapsedTime: Double;
- FDeltaTime: Double;
- FStartTime: Double;
- FProceedTime: Double;
- public
- constructor Create(const AJoblist: TGLCameraJobList); virtual;
- destructor Destroy; override;
- procedure Abort;
- procedure Step; virtual; abstract;
- procedure Init; virtual; abstract;
- property Running: boolean read FRunning write FRunning;
- property ElapsedTime: Double read FElapsedTime write FElapsedTime;
- property StartTime: Double read FStartTime write FStartTime;
- property ProceedTime: Double read FProceedTime write FProceedTime;
- end;
- TGLMoveToPosJob = class(TGLCameraJob)
- private
- FInitialPos: TGLVector;
- FFinalPos: TGLVector;
- public
- X: Double;
- Y: Double;
- Z: Double;
- Time: Double;
- procedure Step; override;
- procedure Init; override;
- // Properties.
- property InitialPos: TGLVector read FInitialPos;
- property FinalPos: TGLVector read FFinalPos;
- end;
- TGLZoomToDistanceJob = class(TGLCameraJob)
- private
- FInitialPos: TGLVector;
- FFinalPos: TGLVector;
- public
- Distance: Double;
- Time: Double;
- procedure Step; override;
- procedure Init; override;
- // Properties.
- property InitialPos: TGLVector read FInitialPos;
- property FinalPos: TGLVector read FFinalPos;
- end;
- TGLOrbitToPosJob = class(TGLCameraJob)
- private
- FFinalPos: TGLVector; // Yep, FFinalPos is stored in relative coordinates.
- FRotateSpeed: TVector2f;
- FCameraUpVector: TGLVector;
- // Absolute Coordinates, can even be not normalized by radius.
- // Procesed in Init, not used anywhere else.
- FTargetPosition: TGLVector;
- FTime: Double;
- public
- procedure Step; override;
- procedure Init; override;
- property RotateSpeed: TVector2f read FRotateSpeed;
- property CameraUpVector: TGLVector read FCameraUpVector;
- property TargetPosition: TGLVector read FTargetPosition;
- property FinalPos: TGLVector read FFinalPos;
- property Time: Double read FTime;
- end;
- TGLSmoothOrbitToPos = class(TGLOrbitToPosJob)
- private
- FCutoffAngle: Single;
- FNeedToRecalculateZoom: boolean;
- FShouldBeMatrix: TGLMatrix;
- FSmoothNavigator: TGLNavigatorSmoothChangeVector;
- public
- constructor Create(const AJoblist: TGLCameraJobList); override;
- procedure Step; override;
- property CutoffAngle: Single read FCutoffAngle write FCutoffAngle;
- property NeedToRecalculateZoom: boolean read FNeedToRecalculateZoom
- write FNeedToRecalculateZoom;
- end;
- TGLOrbitToPosAdvJob = class(TGLCameraJob)
- private
- FInitialPos: TGLVector;
- FFinalPos: TGLVector;
- FInitialUp: TGLVector;
- FInitialDir: TGLVector;
- FRotAxis: TGLVector;
- FAngle: Double;
- public
- X: Double;
- Y: Double;
- Z: Double;
- Time: Double;
- PreferUpAxis: boolean;
- procedure Step; override;
- procedure Init; override;
- // Properties.
- property InitialPos: TGLVector read FInitialPos;
- property InitialUp: TGLVector read FInitialUp;
- property InitialDir: TGLVector read FInitialDir;
- property FinalPos: TGLVector read FFinalPos;
- end;
- TGLSmoothOrbitToPosAdvJob = class(TGLOrbitToPosAdvJob)
- private
- FPreviousPosition: TGLVector;
- FSmoothNavigator: TGLNavigatorSmoothChangeVector;
- FRestoreUpVector: boolean;
- public
- procedure Step; override;
- procedure Init; override;
- end;
- TGLCameraJobEvent = procedure(Sender: TGLCameraJob) of object;
- TGLCameraController = class(TComponent)
- private
- // Objects.
- FCameraJobList: TGLCameraJobList;
- FCamera: TGLBaseSceneObject;
- FCameraTarget: TGLBaseSceneObject;
- // Events.
- FOnJobAdded: TGLCameraJobEvent;
- FOnJobFinished: TGLCameraJobEvent;
- FOnJobStep: TGLCameraJobEvent;
- // fields used by SafeOrbitAndZoomToPos
- FsoSafeDist, FsoTimeToSafePlacement, FsoTimeToOrbit,
- FsoTimeToZoomBackIn: Double;
- // private methods
- // used to test whether camera and cadencer are assigned
- // Extended = true -> will test also for Camera.TargetObject
- procedure CheckAssignments(Extended: boolean);
- // after AdjustScene the Camera.DepthofView will be modified
- // if you want to zoom back in from GUI
- // you should use something like
- // Camera.DepthOfView:=2*Camera.DistanceToTarget+2*camera.TargetObject.BoundingSphereRadius;
- procedure SetOnJobAdded(const Value: TGLCameraJobEvent);
- procedure SetOnJobFinished(const Value: TGLCameraJobEvent);
- procedure SetOnJobStep(const Value: TGLCameraJobEvent);
- procedure SetCamera(const Value: TGLBaseSceneObject);
- procedure SetCameraTarget(const Value: TGLBaseSceneObject);
- protected
- procedure Notification(AComponent: TComponent;
- Operation: TOperation); override;
- public
- constructor Create(AOwner: TComponent); override;
- destructor Destroy; override;
- (* linear movement from current pos *)
- function MoveToPos(X, Y, Z, Time: Double): TGLMoveToPosJob;
- (* orbiting from current pos to the pos where
- the camera points at the camera.targetObject TROUGH the given point
- it will not move to the given point(!), use SafeOrbitAndZoomToPos instead
- there has to be a camera.targetObject assigned! *)
- function OrbitToPos(X, Y, Z, Time: Double): TGLOrbitToPosJob;
- (* Same as OrbitToPos(), but makes use of SmoothNavigator to make
- sure all camera movements are smooth. *)
- function OrbitToPosSmooth(const ATargetPosition: TGLVector;
- const ATime: Double;
- const ASmoothNavigator: TGLNavigatorSmoothChangeVector;
- const AFNeedToRecalculateZoom: boolean;
- const ACameraUpVector: PGLVector = nil): TGLSmoothOrbitToPos;
- (* Same function as OrbitToPos but support all camera states
- PreferUpAxis value is to setup if function use Camera Up based rotation axis
- instead of Camera direction based rotation axis when destination and camera
- position are opposite from Camera Target *)
- function OrbitToPosAdvanced(X, Y, Z, Time: Double;
- PreferUpAxis: boolean = True): TGLOrbitToPosAdvJob;
- (* Same as OrbitToPosAdvanced(), but makes use of SmoothNavigator to make
- sure all camera movements are smooth. *)
- function OrbitToPosAdvancedSmooth(const X, Y, Z, Time: Double;
- const ASmoothNavigator: TGLNavigatorSmoothChangeVector;
- const PreferUpAxis: boolean = True): TGLSmoothOrbitToPosAdvJob;
- (* zooms in/out by moving to the given distance from camera.targetObject
- there has to be a camera.targetObject assigned! *)
- function ZoomToDistance(Distance, Time: Double): TGLZoomToDistanceJob;
- (* google earth - like "fly-to" = zoom out to safe distance, orbit,
- and then zoom in to the given point
- there has to be a camera.targetObject assigned! *)
- procedure SafeOrbitAndZoomToPos(X, Y, Z: Double);
- (* It might be a good idea to introduce ability to stop movement
- and return control to user, here it is *)
- procedure StopMovement;
- // Called by the cadencer to animate the camera
- procedure Step(const deltaTime, newTime: Double);
- property CameraJobList: TGLCameraJobList read FCameraJobList;
- published
- // Assign a Moving object (usually a TGLCamera).
- property Camera: TGLBaseSceneObject read FCamera write SetCamera;
- // Assign a target, around which Moving object should rotate(usually TGLCamera.TargetObject).
- property CameraTarget: TGLBaseSceneObject read FCameraTarget
- write SetCameraTarget;
- (* specifies whether user should be able interract with the GLSceneViewer
- it is set to false while the camera is moving and
- coders should check this value and block GUI access to GLSceneViewer *)
- // property AllowUserAction:boolean read FAllowUserAction;
- (* safe distance to avoid moving the camera trough the camera.targetObject
- while performing SafeOrbitAndZoomToPos *)
- property soSafeDistance: Double read FsoSafeDist write FsoSafeDist;
- // time to zoom in/out to the safe position while performing SafeOrbitAndZoomToPos
- property soTimeToSafePlacement: Double read FsoTimeToSafePlacement
- write FsoTimeToSafePlacement;
- // time to orbit while performing SafeOrbitAndZoomToPos
- property soTimeToOrbit: Double read FsoTimeToOrbit write FsoTimeToOrbit;
- // time to zoom in/out to the given final position while performing SafeOrbitAndZoomToPos
- property soTimeToZoomBackIn: Double read FsoTimeToZoomBackIn
- write FsoTimeToZoomBackIn;
- // this event is triggered when a job is init
- property OnJobAdded: TGLCameraJobEvent read FOnJobAdded write SetOnJobAdded;
- // this event is triggered when a job is step (like an OnMove)
- property OnJobStep: TGLCameraJobEvent read FOnJobStep write SetOnJobStep;
- // this event is triggered when a job is finished (not canceled)
- property OnJobFinished: TGLCameraJobEvent read FOnJobFinished
- write SetOnJobFinished;
- end;
- // ====================================================================
- implementation
- // ====================================================================
- const
- cGLCAMERACONTROLLER_CHECK_EXTENDED = True;
- cEPSILON = 0.001;
- //-------------------------------------
- // TGLCameraController
- //-------------------------------------
- constructor TGLCameraController.Create(AOwner: TComponent);
- begin
- inherited;
- // create the job list container
- FCameraJobList := TGLCameraJobList.Create(Self);
- FCameraJobList.OwnsObjects := True;
- // initialize values
- soSafeDistance := 10;
- soTimeToSafePlacement := 1;
- soTimeToOrbit := 2;
- soTimeToZoomBackIn := 1;
- end;
- destructor TGLCameraController.Destroy;
- begin
- // delete job list and all jobs inside
- FCameraJobList.Free;
- inherited;
- end;
- procedure TGLCameraController.CheckAssignments(Extended: boolean);
- begin
- /// Check camera assignment
- if not Assigned(FCamera) then
- begin
- Raise EGLCameraController.CreateFmt
- ('%s (%s) needs to have a Camera assigned', [Self.Name, Self.ClassName]);
- end;
- if Extended then
- /// Check camera;TargetObject assignment
- if not Assigned(FCameraTarget) then
- begin
- Raise EGLCameraController.CreateFmt
- ('%s (%s) needs Camera to have a TargetObject assigned',
- [Self.Name, Self.ClassName]);
- end;
- end;
- procedure TGLCameraController.Step(const deltaTime, newTime: Double);
- var
- CurrentJob: TGLCameraJob;
- begin
- if FCameraJobList.Count > 0 then
- begin
- CurrentJob := FCameraJobList.First;
- if CurrentJob.FInit then
- begin
- CurrentJob.Init;
- CurrentJob.FStartTime := newTime;
- CurrentJob.FRunning := True;
- CurrentJob.FInit := False;
- // Notify job
- if Assigned(FOnJobAdded) then
- FOnJobAdded(CurrentJob);
- end;
- if CurrentJob.FRunning then
- begin
- CurrentJob.FElapsedTime := newTime - CurrentJob.FStartTime;
- CurrentJob.FDeltaTime := deltaTime; // newTime - CurrentJob.FElapsedTime;
- CurrentJob.Step;
- // Notify job
- if Assigned(FOnJobStep) then
- FOnJobStep(CurrentJob);
- end;
- if not CurrentJob.FRunning then
- begin
- // Notify job
- if Assigned(FOnJobFinished) then
- FOnJobFinished(CurrentJob);
- FCameraJobList.Remove(CurrentJob);
- end;
- end;
- // AdjustScene;
- end;
- function TGLCameraController.MoveToPos(X, Y, Z, Time: Double): TGLMoveToPosJob;
- begin
- Result := TGLMoveToPosJob.Create(FCameraJobList);
- Result.X := X;
- Result.Y := Y;
- Result.Z := Z;
- Result.Time := Time;
- end;
- function TGLCameraController.ZoomToDistance(Distance, Time: Double)
- : TGLZoomToDistanceJob;
- begin
- Result := TGLZoomToDistanceJob.Create(FCameraJobList);
- Result.Distance := Distance;
- Result.Time := Time;
- end;
- function TGLCameraController.OrbitToPos(X, Y, Z, Time: Double)
- : TGLOrbitToPosJob;
- begin
- Result := TGLOrbitToPosJob.Create(FCameraJobList);
- Result.FTargetPosition := PointMake(X, Y, Z);
- Result.FCameraUpVector := FCameraJobList.FController.FCamera.AbsoluteUp;
- Result.FTime := Time;
- end;
- function TGLCameraController.OrbitToPosSmooth(const ATargetPosition: TGLVector;
- const ATime: Double; const ASmoothNavigator: TGLNavigatorSmoothChangeVector;
- const AFNeedToRecalculateZoom: boolean; const ACameraUpVector: PGLVector = nil)
- : TGLSmoothOrbitToPos;
- begin
- Result := TGLSmoothOrbitToPos.Create(FCameraJobList);
- Result.FTargetPosition := ATargetPosition;
- Result.FTime := ATime;
- Result.FSmoothNavigator := ASmoothNavigator;
- Result.FShouldBeMatrix := FCameraJobList.FController.FCamera.Matrix^;
- Result.FNeedToRecalculateZoom := AFNeedToRecalculateZoom;
- if ACameraUpVector = nil then
- Result.FCameraUpVector := FCameraJobList.FController.FCamera.AbsoluteUp
- else
- Result.FCameraUpVector := ACameraUpVector^;
- end;
- function TGLCameraController.OrbitToPosAdvanced(X, Y, Z, Time: Double;
- PreferUpAxis: boolean = True): TGLOrbitToPosAdvJob;
- begin
- Result := TGLOrbitToPosAdvJob.Create(FCameraJobList);
- Result.X := X;
- Result.Y := Y;
- Result.Z := Z;
- Result.PreferUpAxis := PreferUpAxis;
- Result.Time := Time;
- end;
- function TGLCameraController.OrbitToPosAdvancedSmooth(const X, Y, Z,
- Time: Double; const ASmoothNavigator: TGLNavigatorSmoothChangeVector;
- const PreferUpAxis: boolean = True): TGLSmoothOrbitToPosAdvJob;
- begin
- Result := TGLSmoothOrbitToPosAdvJob.Create(FCameraJobList);
- Result.X := X;
- Result.Y := Y;
- Result.Z := Z;
- Result.PreferUpAxis := PreferUpAxis;
- Result.Time := Time;
- Result.FSmoothNavigator := ASmoothNavigator;
- Result.FPreviousPosition := ASmoothNavigator.OnGetCurrentValue
- (ASmoothNavigator);
- Result.FRestoreUpVector := True;
- end;
- procedure TGLCameraController.SafeOrbitAndZoomToPos(X, Y, Z: Double);
- begin
- // this was the main purpose of this component
- // as you can see, it actually is a combination of the other 3 methods
- CheckAssignments(cGLCAMERACONTROLLER_CHECK_EXTENDED);
- ZoomToDistance(soSafeDistance, soTimeToSafePlacement);
- OrbitToPos(X, Y, Z, soTimeToOrbit);
- MoveToPos(X, Y, Z, soTimeToZoomBackIn);
- end;
- procedure TGLCameraController.StopMovement;
- begin
- FCameraJobList.Clear;
- end;
- procedure TGLCameraController.SetOnJobAdded(const Value: TGLCameraJobEvent);
- begin
- FOnJobAdded := Value;
- end;
- procedure TGLCameraController.SetOnJobStep(const Value: TGLCameraJobEvent);
- begin
- FOnJobStep := Value;
- end;
- procedure TGLCameraController.SetOnJobFinished(const Value: TGLCameraJobEvent);
- begin
- FOnJobFinished := Value;
- end;
- procedure TGLCameraController.SetCamera(const Value: TGLBaseSceneObject);
- begin
- if FCamera <> nil then
- FCamera.RemoveFreeNotification(Self);
- FCamera := Value;
- if FCamera <> nil then
- FCamera.FreeNotification(Self);
- if (FCamera is TGLCamera) and (FCameraTarget = nil) then
- SetCameraTarget(TGLCamera(FCamera).TargetObject);
- end;
- procedure TGLCameraController.SetCameraTarget(const Value: TGLBaseSceneObject);
- begin
- if FCameraTarget <> nil then
- FCameraTarget.RemoveFreeNotification(Self);
- FCameraTarget := Value;
- if FCameraTarget <> nil then
- FCameraTarget.FreeNotification(Self);
- end;
- procedure TGLCameraController.Notification(AComponent: TComponent;
- Operation: TOperation);
- begin
- inherited;
- if Operation = opRemove then
- begin
- if AComponent = FCamera then
- FCamera := nil
- else if AComponent = FCameraTarget then
- FCameraTarget := nil;
- end;
- end;
- //-------------------------------------
- // TGLCameraJobList
- //-------------------------------------
- constructor TGLCameraJobList.Create(AController: TGLCameraController);
- begin
- inherited Create;
- FController := AController;
- end;
- function TGLCameraJobList.GetCameraJob(const AIndex: integer): TGLCameraJob;
- begin
- Result := inherited Get(AIndex);
- end;
- procedure TGLCameraJobList.SetCameraJob(const AIndex: integer;
- const Value: TGLCameraJob);
- begin
- inherited Put(AIndex, Value);
- end;
- function TGLCameraJobList.Add(ACameraJob: TGLCameraJob): integer;
- begin
- Result := inherited Add(ACameraJob);
- end;
- function TGLCameraJobList.First: TGLCameraJob;
- begin
- Result := TGLCameraJob(inherited First);
- end;
- function TGLCameraJobList.Last: TGLCameraJob;
- begin
- Result := TGLCameraJob(inherited Last);
- end;
- //-------------------------------------
- // TGLCameraJob
- //-------------------------------------
- constructor TGLCameraJob.Create(const AJoblist: TGLCameraJobList);
- begin
- FJoblist := AJoblist;
- FJoblist.Add(Self);
- FInit := True;
- FStartTime := 0;
- FProceedTime := 0;
- end;
- destructor TGLCameraJob.Destroy;
- begin
- inherited;
- end;
- procedure TGLCameraJob.Abort;
- begin
- end;
- //-------------------------------------
- // TGLMoveToPosJob
- //-------------------------------------
- procedure TGLMoveToPosJob.Init;
- begin
- FProceedTime := Time;
- FInitialPos := VectorSubtract(FJoblist.FController.FCamera.AbsolutePosition,
- FJoblist.FController.FCameraTarget.AbsolutePosition);
- MakeVector(FFinalPos, X, Y, Z);
- end;
- procedure TGLMoveToPosJob.Step;
- var
- Vect: TGLVector;
- begin
- if FElapsedTime < FProceedTime then
- begin
- Vect := VectorLerp(FInitialPos, FFinalPos, FElapsedTime / FProceedTime);
- end
- else
- begin
- Vect := FFinalPos;
- FRunning := False;
- end;
- if Assigned(FJoblist.FController.FCamera.Parent) then
- Vect := FJoblist.FController.FCamera.Parent.AbsoluteToLocal(Vect);
- FJoblist.FController.FCamera.Position.AsVector := Vect;
- end;
- //-------------------------------------
- // TGLZoomToDistanceJob
- //-------------------------------------
- procedure TGLZoomToDistanceJob.Init;
- begin
- FProceedTime := Time;
- FInitialPos := VectorSubtract(FJoblist.FController.FCamera.AbsolutePosition,
- FJoblist.FController.FCameraTarget.AbsolutePosition);
- // To determine final position, we normalize original position and scale it with final distance
- SetVector(FFinalPos, FInitialPos);
- NormalizeVector(FFinalPos);
- ScaleVector(FFinalPos, Distance);
- end;
- procedure TGLZoomToDistanceJob.Step;
- var
- Vect: TGLVector;
- begin
- if FElapsedTime < FProceedTime then
- begin
- Vect := VectorLerp(FInitialPos, FFinalPos, FElapsedTime / FProceedTime);
- end
- else
- begin
- Vect := FFinalPos;
- FRunning := False;
- end;
- if Assigned(FJoblist.FController.FCamera.Parent) then
- Vect := FJoblist.FController.FCamera.Parent.AbsoluteToLocal(Vect);
- FJoblist.FController.FCamera.Position.AsVector := Vect;
- end;
- //-------------------------------------
- // TGLOrbitToPosJob
- //-------------------------------------
- procedure TGLOrbitToPosJob.Init;
- begin
- FProceedTime := FTime;
- FFinalPos := ShiftObjectFromCenter(FTargetPosition,
- FJoblist.FController.FCameraTarget.AbsolutePosition,
- VectorDistance(FJoblist.FController.FCamera.AbsolutePosition,
- FJoblist.FController.FCameraTarget.AbsolutePosition), True);
- // Yep, FFinalPos is stored in relative coordinates.
- if FJoblist.FController.FCamera.Parent <> nil then
- FFinalPos := FJoblist.FController.FCamera.Parent.AbsoluteToLocal(FFinalPos);
- FRotateSpeed := GetSafeTurnAngle
- (FJoblist.FController.FCamera.AbsolutePosition, FCameraUpVector,
- FTargetPosition, FJoblist.FController.FCameraTarget.AbsolutePosition);
- ScaleVector(FRotateSpeed, 1 / FProceedTime);
- FInit := True;
- end;
- procedure TGLOrbitToPosJob.Step;
- begin
- if FElapsedTime < FProceedTime then
- begin
- FJoblist.FController.FCamera.AbsolutePosition :=
- MoveObjectAround(FJoblist.FController.FCamera.AbsolutePosition,
- FCameraUpVector, FJoblist.FController.FCameraTarget.AbsolutePosition,
- FRotateSpeed.X * FDeltaTime, FRotateSpeed.Y * FDeltaTime);
- end
- else
- begin
- // Yep, FFinalPos is stored in ralative coordinates.
- FJoblist.FController.FCamera.Position.AsVector := FFinalPos;
- FRunning := False;
- end;
- end;
- //-------------------------------------
- // TGLOrbitToPosAdvJob
- //-------------------------------------
- procedure TGLOrbitToPosAdvJob.Init;
- var
- Right: TGLVector;
- lAbsVectorToTarget: TGLVector;
- begin
- FProceedTime := Time;
- FInitialPos := VectorSubtract(FJoblist.FController.FCamera.AbsolutePosition,
- FJoblist.FController.FCameraTarget.AbsolutePosition);
- if Assigned(FJoblist.FController.FCamera.Parent) then
- FFinalPos := VectorSubtract
- (FJoblist.FController.FCamera.Parent.LocalToAbsolute(VectorMake(X, Y, Z,
- 1)), FJoblist.FController.FCameraTarget.AbsolutePosition)
- else
- FFinalPos := VectorSubtract(VectorMake(X, Y, Z, 1),
- FJoblist.FController.FCameraTarget.AbsolutePosition);
- // if destination is Target Pos, we can't compute
- if VectorLength(FFinalPos) < cEPSILON then
- begin
- // FAllowUserAction := True;
- Exit;
- end;
- // Compute Angle of Rotation
- FAngle := ArcCos(VectorAngleCosine(Vector3fMake(FFinalPos),
- Vector3fMake(FInitialPos)));
- lAbsVectorToTarget := VectorNormalize
- (VectorSubtract(FJoblist.FController.FCameraTarget.AbsolutePosition,
- FJoblist.FController.FCamera.AbsolutePosition));
- Right := VectorNormalize(VectorCrossProduct(lAbsVectorToTarget,
- FJoblist.FController.FCamera.AbsoluteUp));
- FInitialDir := FJoblist.FController.FCamera.AbsoluteDirection;
- FInitialUp := FJoblist.FController.FCamera.AbsoluteUp;
- // Determine rotation Axis
- // if Angle equals 0 degrees.
- if FAngle < cEPSILON then
- if PreferUpAxis then
- FRotAxis := VectorNormalize
- (VectorCrossProduct(VectorCrossProduct(FFinalPos, FInitialUp),
- FFinalPos))
- else
- FRotAxis := Right
- else
- // if Angle equals 180 degrees.
- if FAngle > Pi - cEPSILON then
- if PreferUpAxis then
- FRotAxis := VectorNormalize
- (VectorCrossProduct(VectorCrossProduct(FFinalPos, FInitialUp),
- FFinalPos))
- else
- FRotAxis := Right
- else
- FRotAxis := VectorNormalize(VectorCrossProduct(FFinalPos, FInitialPos));
- end;
- procedure TGLOrbitToPosAdvJob.Step;
- var
- tempUp, tempDir, tempPos: TGLVector;
- begin
- if FElapsedTime < FProceedTime then
- begin
- // Compute Position
- tempPos := FInitialPos;
- RotateVector(tempPos, Vector3fMake(FRotAxis), FAngle * FElapsedTime /
- FProceedTime);
- FJoblist.FController.FCamera.AbsolutePosition :=
- VectorAdd(FJoblist.FController.FCameraTarget.AbsolutePosition, tempPos);
- // Compute Direction vector
- tempDir := FInitialDir;
- RotateVector(tempDir, Vector3fMake(FRotAxis), FAngle * FElapsedTime /
- FProceedTime);
- FJoblist.FController.FCamera.AbsoluteDirection := tempDir;
- // Compute Up Vector
- tempUp := FInitialUp;
- RotateVector(tempUp, Vector3fMake(FRotAxis), FAngle * FElapsedTime /
- FProceedTime);
- FJoblist.FController.FCamera.AbsoluteUp := tempUp;
- end
- else
- begin
- // Compute Position
- tempPos := FInitialPos;
- RotateVector(tempPos, Vector3fMake(FRotAxis), FAngle);
- FJoblist.FController.FCamera.AbsolutePosition :=
- VectorAdd(FJoblist.FController.FCameraTarget.AbsolutePosition, tempPos);
- // Compute Direction vector
- tempDir := FInitialDir;
- RotateVector(tempDir, Vector3fMake(FRotAxis), FAngle);
- FJoblist.FController.FCamera.AbsoluteDirection := tempDir;
- // Compute Up Vector
- tempUp := FInitialUp;
- RotateVector(tempUp, Vector3fMake(FRotAxis), FAngle);
- FJoblist.FController.FCamera.AbsoluteUp := tempUp;
- FRunning := False;
- end;
- end;
- //-------------------------------------
- // TGLSmoothOrbitToPosAdvJob
- //-------------------------------------
- procedure TGLSmoothOrbitToPosAdvJob.Init;
- var
- Right: TGLVector;
- begin
- FProceedTime := Time;
- FInitialPos := VectorSubtract(FPreviousPosition,
- FJoblist.FController.FCameraTarget.AbsolutePosition);
- if Assigned(FJoblist.FController.FCamera.Parent) then
- FFinalPos := VectorSubtract
- (FJoblist.FController.FCamera.Parent.LocalToAbsolute(VectorMake(X, Y, Z,
- 1)), FJoblist.FController.FCameraTarget.AbsolutePosition)
- else
- FFinalPos := VectorSubtract(VectorMake(X, Y, Z, 1),
- FJoblist.FController.FCameraTarget.AbsolutePosition);
- // if destination is Target Pos, we can't compute
- if VectorLength(FFinalPos) < cEPSILON then
- begin
- // FAllowUserAction := True;
- Exit;
- end;
- // Compute Angle of Rotation
- FAngle := ArcCos(VectorAngleCosine(Vector3fMake(FFinalPos),
- Vector3fMake(FInitialPos)));
- Right := VectorNormalize(VectorCrossProduct(
- // FJobList.FController.FCamera.AbsoluteVectorToTarget,
- VectorNormalize(VectorSubtract(FJoblist.FController.FCameraTarget.
- AbsolutePosition, FPreviousPosition)),
- FJoblist.FController.FCamera.AbsoluteUp));
- FInitialDir := FJoblist.FController.FCamera.AbsoluteDirection;
- FInitialUp := FJoblist.FController.FCamera.AbsoluteUp;
- // Determine rotation Axis
- // if Angle equals 0 degrees.
- if FAngle < cEPSILON then
- if PreferUpAxis then
- FRotAxis := VectorNormalize
- (VectorCrossProduct(VectorCrossProduct(FFinalPos, FInitialUp),
- FFinalPos))
- else
- FRotAxis := Right
- else
- // if Angle equals 180 degrees.
- if FAngle > Pi - cEPSILON then
- if PreferUpAxis then
- FRotAxis := VectorNormalize
- (VectorCrossProduct(VectorCrossProduct(FFinalPos, FInitialUp),
- FFinalPos))
- else
- FRotAxis := Right
- else
- FRotAxis := VectorNormalize(VectorCrossProduct(FFinalPos, FInitialPos));
- end;
- procedure TGLSmoothOrbitToPosAdvJob.Step;
- var
- tempUp, tempDir, tempPos: TGLVector;
- begin
- if FElapsedTime < FProceedTime then
- begin
- // Compute Position
- tempPos := FInitialPos;
- RotateVector(tempPos, Vector3fMake(FRotAxis), FAngle * FElapsedTime /
- FProceedTime);
- FSmoothNavigator.TargetValue.DirectVector :=
- VectorAdd(FJoblist.FController.FCameraTarget.AbsolutePosition, tempPos);
- FPreviousPosition := FSmoothNavigator.TargetValue.DirectVector;
- // Compute Direction vector
- tempDir := FInitialDir;
- RotateVector(tempDir, Vector3fMake(FRotAxis), FAngle * FElapsedTime /
- FProceedTime);
- FJoblist.FController.FCamera.AbsoluteDirection := tempDir;
- // Compute Up Vector
- if FRestoreUpVector then
- FJoblist.FController.FCamera.AbsoluteUp := FInitialUp
- else
- begin
- tempUp := FInitialUp;
- RotateVector(tempUp, Vector3fMake(FRotAxis), FAngle * FElapsedTime /
- FProceedTime);
- FJoblist.FController.FCamera.AbsoluteUp := tempUp;
- end;
- end
- else
- begin
- // Compute Position
- tempPos := FInitialPos;
- RotateVector(tempPos, Vector3fMake(FRotAxis), FAngle);
- FJoblist.FController.FCamera.AbsolutePosition :=
- VectorAdd(FJoblist.FController.CameraTarget.AbsolutePosition, tempPos);
- // Compute Direction vector
- tempDir := FInitialDir;
- RotateVector(tempDir, Vector3fMake(FRotAxis), FAngle);
- FJoblist.FController.FCamera.AbsoluteDirection := tempDir;
- // Compute Up Vector
- if FRestoreUpVector then
- FJoblist.FController.FCamera.AbsoluteUp := FInitialUp
- else
- begin
- tempUp := FInitialUp;
- RotateVector(tempUp, Vector3fMake(FRotAxis), FAngle);
- FJoblist.FController.FCamera.AbsoluteUp := tempUp;
- FRunning := False;
- end;
- FRunning := False;
- end;
- end;
- //-------------------------------------
- // TGLSmoothOrbitToPosAdv
- //-------------------------------------
- constructor TGLSmoothOrbitToPos.Create(const AJoblist: TGLCameraJobList);
- begin
- inherited;
- FCutoffAngle := 0.1;
- end;
- procedure TGLSmoothOrbitToPos.Step;
- var
- lCurrentDistanceToTarget: Single;
- lTargetPosition: TGLVector;
- lCurrentMatrix: TGLMatrix;
- lAngle: Single;
- lAbsTargetPosition: TGLVector;
- procedure RestoreDistanceToTarget();
- var
- lDirection: TGLVector;
- begin
- lDirection := VectorNormalize
- (VectorSubtract(FJoblist.FController.FCameraTarget.AbsolutePosition,
- FJoblist.FController.FCamera.AbsolutePosition));
- FJoblist.FController.FCamera.AbsolutePosition :=
- VectorAdd(FJoblist.FController.FCameraTarget.AbsolutePosition,
- VectorScale(lDirection, -lCurrentDistanceToTarget));
- end;
- procedure SetTargetValueRelative(const AAbsolutePosition: TGLVector);
- begin
- if FJoblist.FController.FCamera.Parent = nil then
- FSmoothNavigator.TargetValue.DirectVector := AAbsolutePosition
- else
- FSmoothNavigator.TargetValue.DirectVector :=
- FJoblist.FController.FCamera.Parent.AbsoluteToLocal(AAbsolutePosition);
- end;
- procedure ApplyDistanceToResult();
- var
- lDirection, lNewTargetPosition: TGLVector;
- begin
- lDirection := VectorNormalize
- (VectorSubtract(FJoblist.FController.FCameraTarget.AbsolutePosition,
- lAbsTargetPosition));
- lNewTargetPosition :=
- VectorAdd(FJoblist.FController.FCameraTarget.AbsolutePosition,
- VectorScale(lDirection, -lCurrentDistanceToTarget));
- SetTargetValueRelative(lNewTargetPosition);
- end;
- begin
- if FElapsedTime < FProceedTime then
- begin
- // Save current matrix.
- lCurrentMatrix := FJoblist.FController.FCamera.Matrix^;
- if FNeedToRecalculateZoom then
- lCurrentDistanceToTarget := FJoblist.FController.FCamera.DistanceTo
- (FJoblist.FController.FCameraTarget)
- else
- lCurrentDistanceToTarget := 0; // To avoid warning message.
- // Calculate the position, in which camera should have been.
- FJoblist.FController.FCamera.SetMatrix(FShouldBeMatrix);
- FJoblist.FController.FCamera.AbsolutePosition :=
- MoveObjectAround(FJoblist.FController.FCamera.AbsolutePosition,
- FCameraUpVector, FJoblist.FController.FCameraTarget.AbsolutePosition,
- FRotateSpeed.X * FDeltaTime, FRotateSpeed.Y * FDeltaTime);
- if FNeedToRecalculateZoom then
- RestoreDistanceToTarget();
- lTargetPosition := FJoblist.FController.FCamera.AbsolutePosition;
- FShouldBeMatrix := FJoblist.FController.FCamera.Matrix^;
- // Restore Camera position and move it to the desired vector.
- FJoblist.FController.FCamera.SetMatrix(lCurrentMatrix);
- SetTargetValueRelative(lTargetPosition);
- end
- else
- begin
- if FNeedToRecalculateZoom then
- begin
- if FJoblist.FController.FCamera.Parent = nil then
- lAbsTargetPosition := FFinalPos
- else
- lAbsTargetPosition := FJoblist.FController.FCamera.Parent.
- LocalToAbsolute(FFinalPos);
- lAngle := RadToDeg
- (AngleBetweenVectors(FJoblist.FController.FCamera.AbsolutePosition,
- lAbsTargetPosition,
- FJoblist.FController.FCameraTarget.AbsolutePosition));
- if lAngle < FCutoffAngle then
- begin
- FSmoothNavigator.Enabled := False;
- FRunning := False;
- end
- else
- begin
- lCurrentDistanceToTarget := FJoblist.FController.FCamera.DistanceTo
- (FJoblist.FController.FCameraTarget);
- ApplyDistanceToResult();
- end;
- end
- else
- begin
- FSmoothNavigator.TargetValue.DirectVector := FFinalPos;
- FRunning := False;
- end;
- end;
- end;
- end.
|