GLS.CameraController.pas 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996
  1. //
  2. // The graphics engine GLScene
  3. //
  4. unit GLS.CameraController;
  5. (*
  6. Component for animating camera movement.
  7. Can be used to zoom in/out, for linear movement, orbiting and Google Earth - like "fly-to"
  8. Main purpose was the SafeOrbitAndZoomToPos method, the others are usable as well
  9. *)
  10. interface
  11. uses
  12. System.Classes,
  13. System.SysUtils,
  14. System.Math,
  15. System.Contnrs,
  16. System.Types,
  17. Stage.VectorTypes,
  18. Stage.VectorGeometry,
  19. GLS.Coordinates,
  20. GLS.PersistentClasses,
  21. GLS.Scene,
  22. GLS.SmoothNavigator;
  23. type
  24. EGLCameraController = class(Exception);
  25. // Forward declaration of the camera controller main class
  26. TGLCameraController = class;
  27. // Forward declaration of a generic camera job
  28. TGLCameraJob = class;
  29. TGLCameraJobList = class(TObjectList)
  30. private
  31. FController: TGLCameraController;
  32. function GetCameraJob(const AIndex: integer): TGLCameraJob;
  33. procedure SetCameraJob(const AIndex: integer; const Value: TGLCameraJob);
  34. public
  35. constructor Create(AController: TGLCameraController);
  36. function Add(ACameraJob: TGLCameraJob): integer;
  37. property Items[const AIndex: integer]: TGLCameraJob read GetCameraJob
  38. write SetCameraJob; default;
  39. function First: TGLCameraJob;
  40. function Last: TGLCameraJob;
  41. end;
  42. TGLCameraJob = class(TObject)
  43. private
  44. FJoblist: TGLCameraJobList;
  45. protected
  46. FAbort: boolean;
  47. FInit: boolean;
  48. FRunning: boolean;
  49. FElapsedTime: Double;
  50. FDeltaTime: Double;
  51. FStartTime: Double;
  52. FProceedTime: Double;
  53. public
  54. constructor Create(const AJoblist: TGLCameraJobList); virtual;
  55. destructor Destroy; override;
  56. procedure Abort;
  57. procedure Step; virtual; abstract;
  58. procedure Init; virtual; abstract;
  59. property Running: boolean read FRunning write FRunning;
  60. property ElapsedTime: Double read FElapsedTime write FElapsedTime;
  61. property StartTime: Double read FStartTime write FStartTime;
  62. property ProceedTime: Double read FProceedTime write FProceedTime;
  63. end;
  64. TGLMoveToPosJob = class(TGLCameraJob)
  65. private
  66. FInitialPos: TGLVector;
  67. FFinalPos: TGLVector;
  68. public
  69. X: Double;
  70. Y: Double;
  71. Z: Double;
  72. Time: Double;
  73. procedure Step; override;
  74. procedure Init; override;
  75. // Properties.
  76. property InitialPos: TGLVector read FInitialPos;
  77. property FinalPos: TGLVector read FFinalPos;
  78. end;
  79. TGLZoomToDistanceJob = class(TGLCameraJob)
  80. private
  81. FInitialPos: TGLVector;
  82. FFinalPos: TGLVector;
  83. public
  84. Distance: Double;
  85. Time: Double;
  86. procedure Step; override;
  87. procedure Init; override;
  88. // Properties.
  89. property InitialPos: TGLVector read FInitialPos;
  90. property FinalPos: TGLVector read FFinalPos;
  91. end;
  92. TGLOrbitToPosJob = class(TGLCameraJob)
  93. private
  94. FFinalPos: TGLVector; // Yep, FFinalPos is stored in relative coordinates.
  95. FRotateSpeed: TVector2f;
  96. FCameraUpVector: TGLVector;
  97. // Absolute Coordinates, can even be not normalized by radius.
  98. // Procesed in Init, not used anywhere else.
  99. FTargetPosition: TGLVector;
  100. FTime: Double;
  101. public
  102. procedure Step; override;
  103. procedure Init; override;
  104. property RotateSpeed: TVector2f read FRotateSpeed;
  105. property CameraUpVector: TGLVector read FCameraUpVector;
  106. property TargetPosition: TGLVector read FTargetPosition;
  107. property FinalPos: TGLVector read FFinalPos;
  108. property Time: Double read FTime;
  109. end;
  110. TGLSmoothOrbitToPos = class(TGLOrbitToPosJob)
  111. private
  112. FCutoffAngle: Single;
  113. FNeedToRecalculateZoom: boolean;
  114. FShouldBeMatrix: TGLMatrix;
  115. FSmoothNavigator: TGLNavigatorSmoothChangeVector;
  116. public
  117. constructor Create(const AJoblist: TGLCameraJobList); override;
  118. procedure Step; override;
  119. property CutoffAngle: Single read FCutoffAngle write FCutoffAngle;
  120. property NeedToRecalculateZoom: boolean read FNeedToRecalculateZoom
  121. write FNeedToRecalculateZoom;
  122. end;
  123. TGLOrbitToPosAdvJob = class(TGLCameraJob)
  124. private
  125. FInitialPos: TGLVector;
  126. FFinalPos: TGLVector;
  127. FInitialUp: TGLVector;
  128. FInitialDir: TGLVector;
  129. FRotAxis: TGLVector;
  130. FAngle: Double;
  131. public
  132. X: Double;
  133. Y: Double;
  134. Z: Double;
  135. Time: Double;
  136. PreferUpAxis: boolean;
  137. procedure Step; override;
  138. procedure Init; override;
  139. // Properties.
  140. property InitialPos: TGLVector read FInitialPos;
  141. property InitialUp: TGLVector read FInitialUp;
  142. property InitialDir: TGLVector read FInitialDir;
  143. property FinalPos: TGLVector read FFinalPos;
  144. end;
  145. TGLSmoothOrbitToPosAdvJob = class(TGLOrbitToPosAdvJob)
  146. private
  147. FPreviousPosition: TGLVector;
  148. FSmoothNavigator: TGLNavigatorSmoothChangeVector;
  149. FRestoreUpVector: boolean;
  150. public
  151. procedure Step; override;
  152. procedure Init; override;
  153. end;
  154. TGLCameraJobEvent = procedure(Sender: TGLCameraJob) of object;
  155. TGLCameraController = class(TComponent)
  156. private
  157. // Objects.
  158. FCameraJobList: TGLCameraJobList;
  159. FCamera: TGLBaseSceneObject;
  160. FCameraTarget: TGLBaseSceneObject;
  161. // Events.
  162. FOnJobAdded: TGLCameraJobEvent;
  163. FOnJobFinished: TGLCameraJobEvent;
  164. FOnJobStep: TGLCameraJobEvent;
  165. // fields used by SafeOrbitAndZoomToPos
  166. FsoSafeDist, FsoTimeToSafePlacement, FsoTimeToOrbit,
  167. FsoTimeToZoomBackIn: Double;
  168. // private methods
  169. // used to test whether camera and cadencer are assigned
  170. // Extended = true -> will test also for Camera.TargetObject
  171. procedure CheckAssignments(Extended: boolean);
  172. // after AdjustScene the Camera.DepthofView will be modified
  173. // if you want to zoom back in from GUI
  174. // you should use something like
  175. // Camera.DepthOfView:=2*Camera.DistanceToTarget+2*camera.TargetObject.BoundingSphereRadius;
  176. procedure SetOnJobAdded(const Value: TGLCameraJobEvent);
  177. procedure SetOnJobFinished(const Value: TGLCameraJobEvent);
  178. procedure SetOnJobStep(const Value: TGLCameraJobEvent);
  179. procedure SetCamera(const Value: TGLBaseSceneObject);
  180. procedure SetCameraTarget(const Value: TGLBaseSceneObject);
  181. protected
  182. procedure Notification(AComponent: TComponent;
  183. Operation: TOperation); override;
  184. public
  185. constructor Create(AOwner: TComponent); override;
  186. destructor Destroy; override;
  187. (* linear movement from current pos *)
  188. function MoveToPos(X, Y, Z, Time: Double): TGLMoveToPosJob;
  189. (* orbiting from current pos to the pos where
  190. the camera points at the camera.targetObject TROUGH the given point
  191. it will not move to the given point(!), use SafeOrbitAndZoomToPos instead
  192. there has to be a camera.targetObject assigned! *)
  193. function OrbitToPos(X, Y, Z, Time: Double): TGLOrbitToPosJob;
  194. (* Same as OrbitToPos(), but makes use of SmoothNavigator to make
  195. sure all camera movements are smooth. *)
  196. function OrbitToPosSmooth(const ATargetPosition: TGLVector;
  197. const ATime: Double;
  198. const ASmoothNavigator: TGLNavigatorSmoothChangeVector;
  199. const AFNeedToRecalculateZoom: boolean;
  200. const ACameraUpVector: PGLVector = nil): TGLSmoothOrbitToPos;
  201. (* Same function as OrbitToPos but support all camera states
  202. PreferUpAxis value is to setup if function use Camera Up based rotation axis
  203. instead of Camera direction based rotation axis when destination and camera
  204. position are opposite from Camera Target *)
  205. function OrbitToPosAdvanced(X, Y, Z, Time: Double;
  206. PreferUpAxis: boolean = True): TGLOrbitToPosAdvJob;
  207. (* Same as OrbitToPosAdvanced(), but makes use of SmoothNavigator to make
  208. sure all camera movements are smooth. *)
  209. function OrbitToPosAdvancedSmooth(const X, Y, Z, Time: Double;
  210. const ASmoothNavigator: TGLNavigatorSmoothChangeVector;
  211. const PreferUpAxis: boolean = True): TGLSmoothOrbitToPosAdvJob;
  212. (* zooms in/out by moving to the given distance from camera.targetObject
  213. there has to be a camera.targetObject assigned! *)
  214. function ZoomToDistance(Distance, Time: Double): TGLZoomToDistanceJob;
  215. (* google earth - like "fly-to" = zoom out to safe distance, orbit,
  216. and then zoom in to the given point
  217. there has to be a camera.targetObject assigned! *)
  218. procedure SafeOrbitAndZoomToPos(X, Y, Z: Double);
  219. (* It might be a good idea to introduce ability to stop movement
  220. and return control to user, here it is *)
  221. procedure StopMovement;
  222. // Called by the cadencer to animate the camera
  223. procedure Step(const deltaTime, newTime: Double);
  224. property CameraJobList: TGLCameraJobList read FCameraJobList;
  225. published
  226. // Assign a Moving object (usually a TGLCamera).
  227. property Camera: TGLBaseSceneObject read FCamera write SetCamera;
  228. // Assign a target, around which Moving object should rotate(usually TGLCamera.TargetObject).
  229. property CameraTarget: TGLBaseSceneObject read FCameraTarget
  230. write SetCameraTarget;
  231. (* specifies whether user should be able interract with the GLSceneViewer
  232. it is set to false while the camera is moving and
  233. coders should check this value and block GUI access to GLSceneViewer *)
  234. // property AllowUserAction:boolean read FAllowUserAction;
  235. (* safe distance to avoid moving the camera trough the camera.targetObject
  236. while performing SafeOrbitAndZoomToPos *)
  237. property soSafeDistance: Double read FsoSafeDist write FsoSafeDist;
  238. // time to zoom in/out to the safe position while performing SafeOrbitAndZoomToPos
  239. property soTimeToSafePlacement: Double read FsoTimeToSafePlacement
  240. write FsoTimeToSafePlacement;
  241. // time to orbit while performing SafeOrbitAndZoomToPos
  242. property soTimeToOrbit: Double read FsoTimeToOrbit write FsoTimeToOrbit;
  243. // time to zoom in/out to the given final position while performing SafeOrbitAndZoomToPos
  244. property soTimeToZoomBackIn: Double read FsoTimeToZoomBackIn
  245. write FsoTimeToZoomBackIn;
  246. // this event is triggered when a job is init
  247. property OnJobAdded: TGLCameraJobEvent read FOnJobAdded write SetOnJobAdded;
  248. // this event is triggered when a job is step (like an OnMove)
  249. property OnJobStep: TGLCameraJobEvent read FOnJobStep write SetOnJobStep;
  250. // this event is triggered when a job is finished (not canceled)
  251. property OnJobFinished: TGLCameraJobEvent read FOnJobFinished
  252. write SetOnJobFinished;
  253. end;
  254. // ====================================================================
  255. implementation
  256. // ====================================================================
  257. const
  258. cGLCAMERACONTROLLER_CHECK_EXTENDED = True;
  259. cEPSILON = 0.001;
  260. //-------------------------------------
  261. // TGLCameraController
  262. //-------------------------------------
  263. constructor TGLCameraController.Create(AOwner: TComponent);
  264. begin
  265. inherited;
  266. // create the job list container
  267. FCameraJobList := TGLCameraJobList.Create(Self);
  268. FCameraJobList.OwnsObjects := True;
  269. // initialize values
  270. soSafeDistance := 10;
  271. soTimeToSafePlacement := 1;
  272. soTimeToOrbit := 2;
  273. soTimeToZoomBackIn := 1;
  274. end;
  275. destructor TGLCameraController.Destroy;
  276. begin
  277. // delete job list and all jobs inside
  278. FCameraJobList.Free;
  279. inherited;
  280. end;
  281. procedure TGLCameraController.CheckAssignments(Extended: boolean);
  282. begin
  283. /// Check camera assignment
  284. if not Assigned(FCamera) then
  285. begin
  286. Raise EGLCameraController.CreateFmt
  287. ('%s (%s) needs to have a Camera assigned', [Self.Name, Self.ClassName]);
  288. end;
  289. if Extended then
  290. /// Check camera;TargetObject assignment
  291. if not Assigned(FCameraTarget) then
  292. begin
  293. Raise EGLCameraController.CreateFmt
  294. ('%s (%s) needs Camera to have a TargetObject assigned',
  295. [Self.Name, Self.ClassName]);
  296. end;
  297. end;
  298. procedure TGLCameraController.Step(const deltaTime, newTime: Double);
  299. var
  300. CurrentJob: TGLCameraJob;
  301. begin
  302. if FCameraJobList.Count > 0 then
  303. begin
  304. CurrentJob := FCameraJobList.First;
  305. if CurrentJob.FInit then
  306. begin
  307. CurrentJob.Init;
  308. CurrentJob.FStartTime := newTime;
  309. CurrentJob.FRunning := True;
  310. CurrentJob.FInit := False;
  311. // Notify job
  312. if Assigned(FOnJobAdded) then
  313. FOnJobAdded(CurrentJob);
  314. end;
  315. if CurrentJob.FRunning then
  316. begin
  317. CurrentJob.FElapsedTime := newTime - CurrentJob.FStartTime;
  318. CurrentJob.FDeltaTime := deltaTime; // newTime - CurrentJob.FElapsedTime;
  319. CurrentJob.Step;
  320. // Notify job
  321. if Assigned(FOnJobStep) then
  322. FOnJobStep(CurrentJob);
  323. end;
  324. if not CurrentJob.FRunning then
  325. begin
  326. // Notify job
  327. if Assigned(FOnJobFinished) then
  328. FOnJobFinished(CurrentJob);
  329. FCameraJobList.Remove(CurrentJob);
  330. end;
  331. end;
  332. // AdjustScene;
  333. end;
  334. function TGLCameraController.MoveToPos(X, Y, Z, Time: Double): TGLMoveToPosJob;
  335. begin
  336. Result := TGLMoveToPosJob.Create(FCameraJobList);
  337. Result.X := X;
  338. Result.Y := Y;
  339. Result.Z := Z;
  340. Result.Time := Time;
  341. end;
  342. function TGLCameraController.ZoomToDistance(Distance, Time: Double)
  343. : TGLZoomToDistanceJob;
  344. begin
  345. Result := TGLZoomToDistanceJob.Create(FCameraJobList);
  346. Result.Distance := Distance;
  347. Result.Time := Time;
  348. end;
  349. function TGLCameraController.OrbitToPos(X, Y, Z, Time: Double)
  350. : TGLOrbitToPosJob;
  351. begin
  352. Result := TGLOrbitToPosJob.Create(FCameraJobList);
  353. Result.FTargetPosition := PointMake(X, Y, Z);
  354. Result.FCameraUpVector := FCameraJobList.FController.FCamera.AbsoluteUp;
  355. Result.FTime := Time;
  356. end;
  357. function TGLCameraController.OrbitToPosSmooth(const ATargetPosition: TGLVector;
  358. const ATime: Double; const ASmoothNavigator: TGLNavigatorSmoothChangeVector;
  359. const AFNeedToRecalculateZoom: boolean; const ACameraUpVector: PGLVector = nil)
  360. : TGLSmoothOrbitToPos;
  361. begin
  362. Result := TGLSmoothOrbitToPos.Create(FCameraJobList);
  363. Result.FTargetPosition := ATargetPosition;
  364. Result.FTime := ATime;
  365. Result.FSmoothNavigator := ASmoothNavigator;
  366. Result.FShouldBeMatrix := FCameraJobList.FController.FCamera.Matrix^;
  367. Result.FNeedToRecalculateZoom := AFNeedToRecalculateZoom;
  368. if ACameraUpVector = nil then
  369. Result.FCameraUpVector := FCameraJobList.FController.FCamera.AbsoluteUp
  370. else
  371. Result.FCameraUpVector := ACameraUpVector^;
  372. end;
  373. function TGLCameraController.OrbitToPosAdvanced(X, Y, Z, Time: Double;
  374. PreferUpAxis: boolean = True): TGLOrbitToPosAdvJob;
  375. begin
  376. Result := TGLOrbitToPosAdvJob.Create(FCameraJobList);
  377. Result.X := X;
  378. Result.Y := Y;
  379. Result.Z := Z;
  380. Result.PreferUpAxis := PreferUpAxis;
  381. Result.Time := Time;
  382. end;
  383. function TGLCameraController.OrbitToPosAdvancedSmooth(const X, Y, Z,
  384. Time: Double; const ASmoothNavigator: TGLNavigatorSmoothChangeVector;
  385. const PreferUpAxis: boolean = True): TGLSmoothOrbitToPosAdvJob;
  386. begin
  387. Result := TGLSmoothOrbitToPosAdvJob.Create(FCameraJobList);
  388. Result.X := X;
  389. Result.Y := Y;
  390. Result.Z := Z;
  391. Result.PreferUpAxis := PreferUpAxis;
  392. Result.Time := Time;
  393. Result.FSmoothNavigator := ASmoothNavigator;
  394. Result.FPreviousPosition := ASmoothNavigator.OnGetCurrentValue
  395. (ASmoothNavigator);
  396. Result.FRestoreUpVector := True;
  397. end;
  398. procedure TGLCameraController.SafeOrbitAndZoomToPos(X, Y, Z: Double);
  399. begin
  400. // this was the main purpose of this component
  401. // as you can see, it actually is a combination of the other 3 methods
  402. CheckAssignments(cGLCAMERACONTROLLER_CHECK_EXTENDED);
  403. ZoomToDistance(soSafeDistance, soTimeToSafePlacement);
  404. OrbitToPos(X, Y, Z, soTimeToOrbit);
  405. MoveToPos(X, Y, Z, soTimeToZoomBackIn);
  406. end;
  407. procedure TGLCameraController.StopMovement;
  408. begin
  409. FCameraJobList.Clear;
  410. end;
  411. procedure TGLCameraController.SetOnJobAdded(const Value: TGLCameraJobEvent);
  412. begin
  413. FOnJobAdded := Value;
  414. end;
  415. procedure TGLCameraController.SetOnJobStep(const Value: TGLCameraJobEvent);
  416. begin
  417. FOnJobStep := Value;
  418. end;
  419. procedure TGLCameraController.SetOnJobFinished(const Value: TGLCameraJobEvent);
  420. begin
  421. FOnJobFinished := Value;
  422. end;
  423. procedure TGLCameraController.SetCamera(const Value: TGLBaseSceneObject);
  424. begin
  425. if FCamera <> nil then
  426. FCamera.RemoveFreeNotification(Self);
  427. FCamera := Value;
  428. if FCamera <> nil then
  429. FCamera.FreeNotification(Self);
  430. if (FCamera is TGLCamera) and (FCameraTarget = nil) then
  431. SetCameraTarget(TGLCamera(FCamera).TargetObject);
  432. end;
  433. procedure TGLCameraController.SetCameraTarget(const Value: TGLBaseSceneObject);
  434. begin
  435. if FCameraTarget <> nil then
  436. FCameraTarget.RemoveFreeNotification(Self);
  437. FCameraTarget := Value;
  438. if FCameraTarget <> nil then
  439. FCameraTarget.FreeNotification(Self);
  440. end;
  441. procedure TGLCameraController.Notification(AComponent: TComponent;
  442. Operation: TOperation);
  443. begin
  444. inherited;
  445. if Operation = opRemove then
  446. begin
  447. if AComponent = FCamera then
  448. FCamera := nil
  449. else if AComponent = FCameraTarget then
  450. FCameraTarget := nil;
  451. end;
  452. end;
  453. //-------------------------------------
  454. // TGLCameraJobList
  455. //-------------------------------------
  456. constructor TGLCameraJobList.Create(AController: TGLCameraController);
  457. begin
  458. inherited Create;
  459. FController := AController;
  460. end;
  461. function TGLCameraJobList.GetCameraJob(const AIndex: integer): TGLCameraJob;
  462. begin
  463. Result := inherited Get(AIndex);
  464. end;
  465. procedure TGLCameraJobList.SetCameraJob(const AIndex: integer;
  466. const Value: TGLCameraJob);
  467. begin
  468. inherited Put(AIndex, Value);
  469. end;
  470. function TGLCameraJobList.Add(ACameraJob: TGLCameraJob): integer;
  471. begin
  472. Result := inherited Add(ACameraJob);
  473. end;
  474. function TGLCameraJobList.First: TGLCameraJob;
  475. begin
  476. Result := TGLCameraJob(inherited First);
  477. end;
  478. function TGLCameraJobList.Last: TGLCameraJob;
  479. begin
  480. Result := TGLCameraJob(inherited Last);
  481. end;
  482. //-------------------------------------
  483. // TGLCameraJob
  484. //-------------------------------------
  485. constructor TGLCameraJob.Create(const AJoblist: TGLCameraJobList);
  486. begin
  487. FJoblist := AJoblist;
  488. FJoblist.Add(Self);
  489. FInit := True;
  490. FStartTime := 0;
  491. FProceedTime := 0;
  492. end;
  493. destructor TGLCameraJob.Destroy;
  494. begin
  495. inherited;
  496. end;
  497. procedure TGLCameraJob.Abort;
  498. begin
  499. end;
  500. //-------------------------------------
  501. // TGLMoveToPosJob
  502. //-------------------------------------
  503. procedure TGLMoveToPosJob.Init;
  504. begin
  505. FProceedTime := Time;
  506. FInitialPos := VectorSubtract(FJoblist.FController.FCamera.AbsolutePosition,
  507. FJoblist.FController.FCameraTarget.AbsolutePosition);
  508. MakeVector(FFinalPos, X, Y, Z);
  509. end;
  510. procedure TGLMoveToPosJob.Step;
  511. var
  512. Vect: TGLVector;
  513. begin
  514. if FElapsedTime < FProceedTime then
  515. begin
  516. Vect := VectorLerp(FInitialPos, FFinalPos, FElapsedTime / FProceedTime);
  517. end
  518. else
  519. begin
  520. Vect := FFinalPos;
  521. FRunning := False;
  522. end;
  523. if Assigned(FJoblist.FController.FCamera.Parent) then
  524. Vect := FJoblist.FController.FCamera.Parent.AbsoluteToLocal(Vect);
  525. FJoblist.FController.FCamera.Position.AsVector := Vect;
  526. end;
  527. //-------------------------------------
  528. // TGLZoomToDistanceJob
  529. //-------------------------------------
  530. procedure TGLZoomToDistanceJob.Init;
  531. begin
  532. FProceedTime := Time;
  533. FInitialPos := VectorSubtract(FJoblist.FController.FCamera.AbsolutePosition,
  534. FJoblist.FController.FCameraTarget.AbsolutePosition);
  535. // To determine final position, we normalize original position and scale it with final distance
  536. SetVector(FFinalPos, FInitialPos);
  537. NormalizeVector(FFinalPos);
  538. ScaleVector(FFinalPos, Distance);
  539. end;
  540. procedure TGLZoomToDistanceJob.Step;
  541. var
  542. Vect: TGLVector;
  543. begin
  544. if FElapsedTime < FProceedTime then
  545. begin
  546. Vect := VectorLerp(FInitialPos, FFinalPos, FElapsedTime / FProceedTime);
  547. end
  548. else
  549. begin
  550. Vect := FFinalPos;
  551. FRunning := False;
  552. end;
  553. if Assigned(FJoblist.FController.FCamera.Parent) then
  554. Vect := FJoblist.FController.FCamera.Parent.AbsoluteToLocal(Vect);
  555. FJoblist.FController.FCamera.Position.AsVector := Vect;
  556. end;
  557. //-------------------------------------
  558. // TGLOrbitToPosJob
  559. //-------------------------------------
  560. procedure TGLOrbitToPosJob.Init;
  561. begin
  562. FProceedTime := FTime;
  563. FFinalPos := ShiftObjectFromCenter(FTargetPosition,
  564. FJoblist.FController.FCameraTarget.AbsolutePosition,
  565. VectorDistance(FJoblist.FController.FCamera.AbsolutePosition,
  566. FJoblist.FController.FCameraTarget.AbsolutePosition), True);
  567. // Yep, FFinalPos is stored in relative coordinates.
  568. if FJoblist.FController.FCamera.Parent <> nil then
  569. FFinalPos := FJoblist.FController.FCamera.Parent.AbsoluteToLocal(FFinalPos);
  570. FRotateSpeed := GetSafeTurnAngle
  571. (FJoblist.FController.FCamera.AbsolutePosition, FCameraUpVector,
  572. FTargetPosition, FJoblist.FController.FCameraTarget.AbsolutePosition);
  573. ScaleVector(FRotateSpeed, 1 / FProceedTime);
  574. FInit := True;
  575. end;
  576. procedure TGLOrbitToPosJob.Step;
  577. begin
  578. if FElapsedTime < FProceedTime then
  579. begin
  580. FJoblist.FController.FCamera.AbsolutePosition :=
  581. MoveObjectAround(FJoblist.FController.FCamera.AbsolutePosition,
  582. FCameraUpVector, FJoblist.FController.FCameraTarget.AbsolutePosition,
  583. FRotateSpeed.X * FDeltaTime, FRotateSpeed.Y * FDeltaTime);
  584. end
  585. else
  586. begin
  587. // Yep, FFinalPos is stored in ralative coordinates.
  588. FJoblist.FController.FCamera.Position.AsVector := FFinalPos;
  589. FRunning := False;
  590. end;
  591. end;
  592. //-------------------------------------
  593. // TGLOrbitToPosAdvJob
  594. //-------------------------------------
  595. procedure TGLOrbitToPosAdvJob.Init;
  596. var
  597. Right: TGLVector;
  598. lAbsVectorToTarget: TGLVector;
  599. begin
  600. FProceedTime := Time;
  601. FInitialPos := VectorSubtract(FJoblist.FController.FCamera.AbsolutePosition,
  602. FJoblist.FController.FCameraTarget.AbsolutePosition);
  603. if Assigned(FJoblist.FController.FCamera.Parent) then
  604. FFinalPos := VectorSubtract
  605. (FJoblist.FController.FCamera.Parent.LocalToAbsolute(VectorMake(X, Y, Z,
  606. 1)), FJoblist.FController.FCameraTarget.AbsolutePosition)
  607. else
  608. FFinalPos := VectorSubtract(VectorMake(X, Y, Z, 1),
  609. FJoblist.FController.FCameraTarget.AbsolutePosition);
  610. // if destination is Target Pos, we can't compute
  611. if VectorLength(FFinalPos) < cEPSILON then
  612. begin
  613. // FAllowUserAction := True;
  614. Exit;
  615. end;
  616. // Compute Angle of Rotation
  617. FAngle := ArcCos(VectorAngleCosine(Vector3fMake(FFinalPos),
  618. Vector3fMake(FInitialPos)));
  619. lAbsVectorToTarget := VectorNormalize
  620. (VectorSubtract(FJoblist.FController.FCameraTarget.AbsolutePosition,
  621. FJoblist.FController.FCamera.AbsolutePosition));
  622. Right := VectorNormalize(VectorCrossProduct(lAbsVectorToTarget,
  623. FJoblist.FController.FCamera.AbsoluteUp));
  624. FInitialDir := FJoblist.FController.FCamera.AbsoluteDirection;
  625. FInitialUp := FJoblist.FController.FCamera.AbsoluteUp;
  626. // Determine rotation Axis
  627. // if Angle equals 0 degrees.
  628. if FAngle < cEPSILON then
  629. if PreferUpAxis then
  630. FRotAxis := VectorNormalize
  631. (VectorCrossProduct(VectorCrossProduct(FFinalPos, FInitialUp),
  632. FFinalPos))
  633. else
  634. FRotAxis := Right
  635. else
  636. // if Angle equals 180 degrees.
  637. if FAngle > Pi - cEPSILON then
  638. if PreferUpAxis then
  639. FRotAxis := VectorNormalize
  640. (VectorCrossProduct(VectorCrossProduct(FFinalPos, FInitialUp),
  641. FFinalPos))
  642. else
  643. FRotAxis := Right
  644. else
  645. FRotAxis := VectorNormalize(VectorCrossProduct(FFinalPos, FInitialPos));
  646. end;
  647. procedure TGLOrbitToPosAdvJob.Step;
  648. var
  649. tempUp, tempDir, tempPos: TGLVector;
  650. begin
  651. if FElapsedTime < FProceedTime then
  652. begin
  653. // Compute Position
  654. tempPos := FInitialPos;
  655. RotateVector(tempPos, Vector3fMake(FRotAxis), FAngle * FElapsedTime /
  656. FProceedTime);
  657. FJoblist.FController.FCamera.AbsolutePosition :=
  658. VectorAdd(FJoblist.FController.FCameraTarget.AbsolutePosition, tempPos);
  659. // Compute Direction vector
  660. tempDir := FInitialDir;
  661. RotateVector(tempDir, Vector3fMake(FRotAxis), FAngle * FElapsedTime /
  662. FProceedTime);
  663. FJoblist.FController.FCamera.AbsoluteDirection := tempDir;
  664. // Compute Up Vector
  665. tempUp := FInitialUp;
  666. RotateVector(tempUp, Vector3fMake(FRotAxis), FAngle * FElapsedTime /
  667. FProceedTime);
  668. FJoblist.FController.FCamera.AbsoluteUp := tempUp;
  669. end
  670. else
  671. begin
  672. // Compute Position
  673. tempPos := FInitialPos;
  674. RotateVector(tempPos, Vector3fMake(FRotAxis), FAngle);
  675. FJoblist.FController.FCamera.AbsolutePosition :=
  676. VectorAdd(FJoblist.FController.FCameraTarget.AbsolutePosition, tempPos);
  677. // Compute Direction vector
  678. tempDir := FInitialDir;
  679. RotateVector(tempDir, Vector3fMake(FRotAxis), FAngle);
  680. FJoblist.FController.FCamera.AbsoluteDirection := tempDir;
  681. // Compute Up Vector
  682. tempUp := FInitialUp;
  683. RotateVector(tempUp, Vector3fMake(FRotAxis), FAngle);
  684. FJoblist.FController.FCamera.AbsoluteUp := tempUp;
  685. FRunning := False;
  686. end;
  687. end;
  688. //-------------------------------------
  689. // TGLSmoothOrbitToPosAdvJob
  690. //-------------------------------------
  691. procedure TGLSmoothOrbitToPosAdvJob.Init;
  692. var
  693. Right: TGLVector;
  694. begin
  695. FProceedTime := Time;
  696. FInitialPos := VectorSubtract(FPreviousPosition,
  697. FJoblist.FController.FCameraTarget.AbsolutePosition);
  698. if Assigned(FJoblist.FController.FCamera.Parent) then
  699. FFinalPos := VectorSubtract
  700. (FJoblist.FController.FCamera.Parent.LocalToAbsolute(VectorMake(X, Y, Z,
  701. 1)), FJoblist.FController.FCameraTarget.AbsolutePosition)
  702. else
  703. FFinalPos := VectorSubtract(VectorMake(X, Y, Z, 1),
  704. FJoblist.FController.FCameraTarget.AbsolutePosition);
  705. // if destination is Target Pos, we can't compute
  706. if VectorLength(FFinalPos) < cEPSILON then
  707. begin
  708. // FAllowUserAction := True;
  709. Exit;
  710. end;
  711. // Compute Angle of Rotation
  712. FAngle := ArcCos(VectorAngleCosine(Vector3fMake(FFinalPos),
  713. Vector3fMake(FInitialPos)));
  714. Right := VectorNormalize(VectorCrossProduct(
  715. // FJobList.FController.FCamera.AbsoluteVectorToTarget,
  716. VectorNormalize(VectorSubtract(FJoblist.FController.FCameraTarget.
  717. AbsolutePosition, FPreviousPosition)),
  718. FJoblist.FController.FCamera.AbsoluteUp));
  719. FInitialDir := FJoblist.FController.FCamera.AbsoluteDirection;
  720. FInitialUp := FJoblist.FController.FCamera.AbsoluteUp;
  721. // Determine rotation Axis
  722. // if Angle equals 0 degrees.
  723. if FAngle < cEPSILON then
  724. if PreferUpAxis then
  725. FRotAxis := VectorNormalize
  726. (VectorCrossProduct(VectorCrossProduct(FFinalPos, FInitialUp),
  727. FFinalPos))
  728. else
  729. FRotAxis := Right
  730. else
  731. // if Angle equals 180 degrees.
  732. if FAngle > Pi - cEPSILON then
  733. if PreferUpAxis then
  734. FRotAxis := VectorNormalize
  735. (VectorCrossProduct(VectorCrossProduct(FFinalPos, FInitialUp),
  736. FFinalPos))
  737. else
  738. FRotAxis := Right
  739. else
  740. FRotAxis := VectorNormalize(VectorCrossProduct(FFinalPos, FInitialPos));
  741. end;
  742. procedure TGLSmoothOrbitToPosAdvJob.Step;
  743. var
  744. tempUp, tempDir, tempPos: TGLVector;
  745. begin
  746. if FElapsedTime < FProceedTime then
  747. begin
  748. // Compute Position
  749. tempPos := FInitialPos;
  750. RotateVector(tempPos, Vector3fMake(FRotAxis), FAngle * FElapsedTime /
  751. FProceedTime);
  752. FSmoothNavigator.TargetValue.DirectVector :=
  753. VectorAdd(FJoblist.FController.FCameraTarget.AbsolutePosition, tempPos);
  754. FPreviousPosition := FSmoothNavigator.TargetValue.DirectVector;
  755. // Compute Direction vector
  756. tempDir := FInitialDir;
  757. RotateVector(tempDir, Vector3fMake(FRotAxis), FAngle * FElapsedTime /
  758. FProceedTime);
  759. FJoblist.FController.FCamera.AbsoluteDirection := tempDir;
  760. // Compute Up Vector
  761. if FRestoreUpVector then
  762. FJoblist.FController.FCamera.AbsoluteUp := FInitialUp
  763. else
  764. begin
  765. tempUp := FInitialUp;
  766. RotateVector(tempUp, Vector3fMake(FRotAxis), FAngle * FElapsedTime /
  767. FProceedTime);
  768. FJoblist.FController.FCamera.AbsoluteUp := tempUp;
  769. end;
  770. end
  771. else
  772. begin
  773. // Compute Position
  774. tempPos := FInitialPos;
  775. RotateVector(tempPos, Vector3fMake(FRotAxis), FAngle);
  776. FJoblist.FController.FCamera.AbsolutePosition :=
  777. VectorAdd(FJoblist.FController.CameraTarget.AbsolutePosition, tempPos);
  778. // Compute Direction vector
  779. tempDir := FInitialDir;
  780. RotateVector(tempDir, Vector3fMake(FRotAxis), FAngle);
  781. FJoblist.FController.FCamera.AbsoluteDirection := tempDir;
  782. // Compute Up Vector
  783. if FRestoreUpVector then
  784. FJoblist.FController.FCamera.AbsoluteUp := FInitialUp
  785. else
  786. begin
  787. tempUp := FInitialUp;
  788. RotateVector(tempUp, Vector3fMake(FRotAxis), FAngle);
  789. FJoblist.FController.FCamera.AbsoluteUp := tempUp;
  790. FRunning := False;
  791. end;
  792. FRunning := False;
  793. end;
  794. end;
  795. //-------------------------------------
  796. // TGLSmoothOrbitToPosAdv
  797. //-------------------------------------
  798. constructor TGLSmoothOrbitToPos.Create(const AJoblist: TGLCameraJobList);
  799. begin
  800. inherited;
  801. FCutoffAngle := 0.1;
  802. end;
  803. procedure TGLSmoothOrbitToPos.Step;
  804. var
  805. lCurrentDistanceToTarget: Single;
  806. lTargetPosition: TGLVector;
  807. lCurrentMatrix: TGLMatrix;
  808. lAngle: Single;
  809. lAbsTargetPosition: TGLVector;
  810. procedure RestoreDistanceToTarget();
  811. var
  812. lDirection: TGLVector;
  813. begin
  814. lDirection := VectorNormalize
  815. (VectorSubtract(FJoblist.FController.FCameraTarget.AbsolutePosition,
  816. FJoblist.FController.FCamera.AbsolutePosition));
  817. FJoblist.FController.FCamera.AbsolutePosition :=
  818. VectorAdd(FJoblist.FController.FCameraTarget.AbsolutePosition,
  819. VectorScale(lDirection, -lCurrentDistanceToTarget));
  820. end;
  821. procedure SetTargetValueRelative(const AAbsolutePosition: TGLVector);
  822. begin
  823. if FJoblist.FController.FCamera.Parent = nil then
  824. FSmoothNavigator.TargetValue.DirectVector := AAbsolutePosition
  825. else
  826. FSmoothNavigator.TargetValue.DirectVector :=
  827. FJoblist.FController.FCamera.Parent.AbsoluteToLocal(AAbsolutePosition);
  828. end;
  829. procedure ApplyDistanceToResult();
  830. var
  831. lDirection, lNewTargetPosition: TGLVector;
  832. begin
  833. lDirection := VectorNormalize
  834. (VectorSubtract(FJoblist.FController.FCameraTarget.AbsolutePosition,
  835. lAbsTargetPosition));
  836. lNewTargetPosition :=
  837. VectorAdd(FJoblist.FController.FCameraTarget.AbsolutePosition,
  838. VectorScale(lDirection, -lCurrentDistanceToTarget));
  839. SetTargetValueRelative(lNewTargetPosition);
  840. end;
  841. begin
  842. if FElapsedTime < FProceedTime then
  843. begin
  844. // Save current matrix.
  845. lCurrentMatrix := FJoblist.FController.FCamera.Matrix^;
  846. if FNeedToRecalculateZoom then
  847. lCurrentDistanceToTarget := FJoblist.FController.FCamera.DistanceTo
  848. (FJoblist.FController.FCameraTarget)
  849. else
  850. lCurrentDistanceToTarget := 0; // To avoid warning message.
  851. // Calculate the position, in which camera should have been.
  852. FJoblist.FController.FCamera.SetMatrix(FShouldBeMatrix);
  853. FJoblist.FController.FCamera.AbsolutePosition :=
  854. MoveObjectAround(FJoblist.FController.FCamera.AbsolutePosition,
  855. FCameraUpVector, FJoblist.FController.FCameraTarget.AbsolutePosition,
  856. FRotateSpeed.X * FDeltaTime, FRotateSpeed.Y * FDeltaTime);
  857. if FNeedToRecalculateZoom then
  858. RestoreDistanceToTarget();
  859. lTargetPosition := FJoblist.FController.FCamera.AbsolutePosition;
  860. FShouldBeMatrix := FJoblist.FController.FCamera.Matrix^;
  861. // Restore Camera position and move it to the desired vector.
  862. FJoblist.FController.FCamera.SetMatrix(lCurrentMatrix);
  863. SetTargetValueRelative(lTargetPosition);
  864. end
  865. else
  866. begin
  867. if FNeedToRecalculateZoom then
  868. begin
  869. if FJoblist.FController.FCamera.Parent = nil then
  870. lAbsTargetPosition := FFinalPos
  871. else
  872. lAbsTargetPosition := FJoblist.FController.FCamera.Parent.
  873. LocalToAbsolute(FFinalPos);
  874. lAngle := RadToDeg
  875. (AngleBetweenVectors(FJoblist.FController.FCamera.AbsolutePosition,
  876. lAbsTargetPosition,
  877. FJoblist.FController.FCameraTarget.AbsolutePosition));
  878. if lAngle < FCutoffAngle then
  879. begin
  880. FSmoothNavigator.Enabled := False;
  881. FRunning := False;
  882. end
  883. else
  884. begin
  885. lCurrentDistanceToTarget := FJoblist.FController.FCamera.DistanceTo
  886. (FJoblist.FController.FCameraTarget);
  887. ApplyDistanceToResult();
  888. end;
  889. end
  890. else
  891. begin
  892. FSmoothNavigator.TargetValue.DirectVector := FFinalPos;
  893. FRunning := False;
  894. end;
  895. end;
  896. end;
  897. end.