GLSmoothNavigator.pas 53 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654
  1. //
  2. // This unit is part of the GLScene Engine, http://glscene.org
  3. //
  4. unit GLSmoothNavigator;
  5. (*
  6. An extention of TGLNavigator, which allows to move objects with inertia
  7. Note: it is not completely FPS-independant. Only Moving code is, but
  8. MoveAroundTarget, Turn[Vertical/Horizontal] and AdjustDistanceTo[..] is not.
  9. Don't know why, but when I make their code identical, these function stop
  10. working completely. So you probably have to call the AutoScaleParameters
  11. procedure once in a while for it to adjust to the current framerate.
  12. If someone knows a better way to solve this issue, please contact me via
  13. glscene newsgroups.
  14. TODO:
  15. 1) Scale "Old values" too, when callin the Scale parameter procedure to
  16. avoid the temporary "freeze" of controls.
  17. 2) AddImpulse procedures.
  18. *)
  19. interface
  20. {$I GLScene.inc}
  21. uses
  22. System.Types,
  23. System.Classes,
  24. GLScene,
  25. GLPersistentClasses,
  26. GLVectorTypes,
  27. GLNavigator,
  28. GLVectorGeometry,
  29. GLCoordinates,
  30. GLScreen,
  31. XCollection;
  32. type
  33. (* TGLNavigatorAdjustDistanceParameters includes a basic set of parameters
  34. that control the smoothness of movement. *)
  35. TGLNavigatorAbstractParameters = class(TPersistent)
  36. private
  37. FOwner: TPersistent;
  38. FInertia: Single;
  39. FSpeed: Single;
  40. FCutoff: Single;
  41. function StoreCutoff: Boolean;
  42. protected
  43. function StoreInertia: Boolean; virtual;
  44. function StoreSpeed: Boolean; virtual;
  45. function GetOwner: TPersistent; override;
  46. public
  47. constructor Create(AOwner: TPersistent); virtual;
  48. procedure Assign(Source: TPersistent); override;
  49. procedure ScaleParameters(const Value: Single); virtual;
  50. published
  51. property Inertia: Single read FInertia write FInertia stored StoreInertia;
  52. property Speed: Single read FSpeed write FSpeed stored StoreSpeed;
  53. property Cutoff: Single read FCutoff write FCutoff stored StoreCutoff;
  54. end;
  55. TGLSmoothNavigator = class;
  56. (* TGLNavigatorSmoothChangeItem includes a basic set of parameters
  57. that control the smoothness of movement. *)
  58. TGLNavigatorSmoothChangeItem = class(TXCollectionItem)
  59. private
  60. FInertia: Single;
  61. FSpeed: Single;
  62. FEnabled: Boolean;
  63. FSpeedLimit: Single;
  64. FCutoff: Double;
  65. function StoreInertia: Boolean;
  66. function StoreSpeed: Boolean;
  67. function StoreSpeedLimit: Boolean;
  68. function StoreCutoff: Boolean;
  69. protected
  70. function GetNavigator: TGLSmoothNavigator;
  71. public
  72. // Returns False if there was no change.
  73. function Proceed(ADeltaTime: Double): Boolean; virtual; abstract;
  74. constructor Create(aOwner: TXCollection); override;
  75. procedure Assign(Source: TPersistent); override;
  76. procedure ScaleParameters(const Value: Single); virtual;
  77. procedure ResetTargetValue(); virtual; abstract;
  78. published
  79. property Inertia: Single read FInertia write FInertia stored StoreInertia;
  80. property Speed: Single read FSpeed write FSpeed stored StoreSpeed;
  81. property SpeedLimit: Single read FSpeedLimit write FSpeedLimit stored StoreSpeedLimit;
  82. property Cutoff: Double read FCutoff write FCutoff stored StoreCutoff;
  83. property Enabled: Boolean read FEnabled write FEnabled default True;
  84. end;
  85. TGLNavigatorSmoothChangeSingle = class;
  86. TGLNavigatorSmoothChangeSingleGetEvent = function(const ASender: TGLNavigatorSmoothChangeSingle): Single of object;
  87. TGLNavigatorSmoothChangeSingleSetEvent = procedure(const ASender: TGLNavigatorSmoothChangeSingle; const AValue: Single) of object;
  88. // Smoothly change any Single value, so it will become TargetValue in the end.
  89. TGLNavigatorSmoothChangeSingle = class(TGLNavigatorSmoothChangeItem)
  90. private
  91. FTargetValue: Single;
  92. FOnGetCurrentValue: TGLNavigatorSmoothChangeSingleGetEvent;
  93. FOnSetCurrentValue: TGLNavigatorSmoothChangeSingleSetEvent;
  94. public
  95. class function FriendlyName: string; override;
  96. function Proceed(ADeltaTime: Double): Boolean; override;
  97. procedure Assign(Source: TPersistent); override;
  98. procedure ResetTargetValue(); override;
  99. published
  100. property TargetValue: Single read FTargetValue write FTargetValue;
  101. property OnGetCurrentValue: TGLNavigatorSmoothChangeSingleGetEvent read FOnGetCurrentValue write FOnGetCurrentValue;
  102. property OnSetCurrentValue: TGLNavigatorSmoothChangeSingleSetEvent read FOnSetCurrentValue write FOnSetCurrentValue;
  103. end;
  104. TGLNavigatorSmoothChangeVector = class;
  105. TGLNavigatorSmoothChangeVectorGetEvent = function(const ASender: TGLNavigatorSmoothChangeVector): TVector of object;
  106. TGLNavigatorSmoothChangeVectorSetEvent = procedure(const ASender: TGLNavigatorSmoothChangeVector; const AValue: TVector) of object;
  107. // Smoothly change any Vector4f value, so it will become TargetValue in the end.
  108. TGLNavigatorSmoothChangeVector = class(TGLNavigatorSmoothChangeItem)
  109. private
  110. FTargetValue: TGLCoordinates;
  111. FOnGetCurrentValue: TGLNavigatorSmoothChangeVectorGetEvent;
  112. FOnSetCurrentValue: TGLNavigatorSmoothChangeVectorSetEvent;
  113. procedure SetTargetValue(const Value: TGLCoordinates);
  114. public
  115. class function FriendlyName: string; override;
  116. function Proceed(ADeltaTime: Double): Boolean; override;
  117. procedure Assign(Source: TPersistent); override;
  118. constructor Create(aOwner: TXCollection); override;
  119. destructor Destroy; override;
  120. procedure ResetTargetValue(); override;
  121. published
  122. property TargetValue: TGLCoordinates read FTargetValue write SetTargetValue;
  123. property OnGetCurrentValue: TGLNavigatorSmoothChangeVectorGetEvent read FOnGetCurrentValue write FOnGetCurrentValue;
  124. property OnSetCurrentValue: TGLNavigatorSmoothChangeVectorSetEvent read FOnSetCurrentValue write FOnSetCurrentValue;
  125. end;
  126. TGLNavigatorSmoothChangeItemClass = class of TGLNavigatorSmoothChangeItem;
  127. // XCollection of TGLNavigatorSmoothChangeItem.
  128. TGLNavigatorSmoothChangeItems = class(TXCollection)
  129. private
  130. function GetItems(const Index : Integer): TGLNavigatorSmoothChangeItem;
  131. procedure SetItems(const Index : Integer; const Value: TGLNavigatorSmoothChangeItem);
  132. protected
  133. procedure DoProceed(ADeltaTime: Double);
  134. public
  135. function Add(AClass : TGLNavigatorSmoothChangeItemClass): TGLNavigatorSmoothChangeItem;
  136. function CanAdd(AClass: TXCollectionItemClass): Boolean; override;
  137. class function ItemsClass: TXCollectionItemClass; override;
  138. property Items[const Index : Integer]: TGLNavigatorSmoothChangeItem read GetItems write
  139. SetItems; default;
  140. end;
  141. (* TGLNavigatorAdjustDistanceParameters is wrapper for all parameters that
  142. affect how the AdjustDisanceTo[...] methods work *)
  143. TGLNavigatorAdjustDistanceParameters = class(TGLNavigatorAbstractParameters)
  144. private
  145. FOldDistanceRatio: Single;
  146. FImpulseSpeed: Single;
  147. function StoreImpulseSpeed: Boolean;
  148. public
  149. constructor Create(AOwner: TPersistent); override;
  150. procedure Assign(Source: TPersistent); override;
  151. procedure ScaleParameters(const Value: Single); override;
  152. procedure AddImpulse(const Impulse: Single); virtual;
  153. published
  154. property ImpulseSpeed: Single read FImpulseSpeed write FImpulseSpeed stored StoreImpulseSpeed;
  155. end;
  156. (* TGLNavigatorAdjustDistanceParameters is wrapper for all parameters that
  157. affect how the AdjustDisanceTo[...]Ex methods work
  158. You need to set the TargetObject and desired distance to it,
  159. then call AdjustDisanceTo[...]Ex() in your Cadencer.OnProgress code. *)
  160. TGLNavigatorAdjustDistanceParametersEx = class(TGLNavigatorAbstractParameters)
  161. private
  162. FSpeedLimit: Single;
  163. FTargetDistance: Single;
  164. function StoreSpeedLimit: Boolean;
  165. function StoreTargetDistance: Boolean;
  166. protected
  167. function StoreSpeed: Boolean; override;
  168. function StoreInertia: Boolean; override;
  169. public
  170. constructor Create(AOwner: TPersistent); override;
  171. procedure Assign(Source: TPersistent); override;
  172. published
  173. property TargetDistance: Single read FTargetDistance write FTargetDistance stored StoreTargetDistance;
  174. property SpeedLimit: Single read FSpeedLimit write FSpeedLimit stored StoreSpeedLimit;
  175. end;
  176. {TGLNavigatorInertiaParameters is wrapper for all parameters that affect the
  177. smoothness of movement
  178. }
  179. TGLNavigatorInertiaParameters = class(TPersistent)
  180. private
  181. FOwner: TPersistent;
  182. OldTurnHorizontalAngle: Single;
  183. OldTurnVerticalAngle: Single;
  184. OldMoveForwardDistance: Single;
  185. OldStrafeHorizontalDistance: Single;
  186. OldStrafeVerticalDistance: Single;
  187. FTurnInertia: Single;
  188. FTurnSpeed: Single;
  189. FTurnMaxAngle: Single;
  190. FMovementAcceleration: Single;
  191. FMovementInertia: Single;
  192. FMovementSpeed: Single;
  193. function StoreTurnMaxAngle: Boolean;
  194. function StoreMovementAcceleration: Boolean;
  195. function StoreMovementInertia: Boolean;
  196. function StoreMovementSpeed: Boolean;
  197. function StoreTurnInertia: Boolean;
  198. function StoreTurnSpeed: Boolean;
  199. protected
  200. function GetOwner: TPersistent; override;
  201. public
  202. constructor Create(AOwner: TPersistent); virtual;
  203. procedure Assign(Source: TPersistent); override;
  204. procedure ScaleParameters(const Value: Single); virtual;
  205. published
  206. property MovementAcceleration: Single read FMovementAcceleration write FMovementAcceleration stored StoreMovementAcceleration;
  207. property MovementInertia: Single read FMovementInertia write FMovementInertia stored StoreMovementInertia;
  208. property MovementSpeed: Single read FMovementSpeed write FMovementSpeed stored StoreMovementSpeed;
  209. property TurnMaxAngle: Single read FTurnMaxAngle write FTurnMaxAngle stored StoreTurnMaxAngle;
  210. property TurnInertia: Single read FTurnInertia write FTurnInertia stored StoreTurnInertia;
  211. property TurnSpeed: Single read FTurnSpeed write FTurnSpeed stored StoreTurnSpeed;
  212. end;
  213. {TGLNavigatorGeneralParameters is a wrapper for all general inertia parameters.
  214. These properties mean that if ExpectedMaxFPS is 100, FAutoScaleMin is 0.1,
  215. FAutoScaleMax is 0.75 then the "safe range" for it to change is [10..75].
  216. If these bounds are violated, then ExpectedMaxFPS is automaticly increased
  217. or decreased by AutoScaleMult.
  218. }
  219. TGLNavigatorGeneralParameters = class(TPersistent)
  220. private
  221. FOwner: TPersistent;
  222. FAutoScaleMin: Single;
  223. FAutoScaleMax: Single;
  224. FAutoScaleMult: Single;
  225. function StoreAutoScaleMax: Boolean;
  226. function StoreAutoScaleMin: Boolean;
  227. function StoreAutoScaleMult: Boolean;
  228. protected
  229. function GetOwner: TPersistent; override;
  230. public
  231. constructor Create(AOwner: TPersistent); virtual;
  232. procedure Assign(Source: TPersistent); override;
  233. published
  234. property AutoScaleMin: Single read FAutoScaleMin write FAutoScaleMin stored StoreAutoScaleMin;
  235. property AutoScaleMax: Single read FAutoScaleMax write FAutoScaleMax stored StoreAutoScaleMax;
  236. property AutoScaleMult: Single read FAutoScaleMult write FAutoScaleMult stored StoreAutoScaleMult;
  237. end;
  238. {TGLNavigatorMoveAroundParameters is a wrapper for all parameters that
  239. effect how the TGLBaseSceneObject.MoveObjectAround() procedure works
  240. }
  241. TGLNavigatorMoveAroundParameters = class(TPersistent)
  242. private
  243. FOwner: TPersistent;
  244. FTargetObject: TGLBaseSceneObject;
  245. FOldPitchInertiaAngle : Single;
  246. FOldTurnInertiaAngle : Single;
  247. FPitchSpeed : Single;
  248. FTurnSpeed : Single;
  249. FInertia : Single;
  250. FMaxAngle : Single;
  251. FCutoff: Double;
  252. function StoreInertia: Boolean;
  253. function StoreMaxAngle: Boolean;
  254. function StorePitchSpeed: Boolean;
  255. function StoreTurnSpeed: Boolean;
  256. procedure SetTargetObject(const Value: TGLBaseSceneObject);
  257. function StoreCutoff: Boolean;
  258. protected
  259. function GetOwner: TPersistent; override;
  260. public
  261. constructor Create(AOwner: TPersistent); virtual;
  262. procedure Assign(Source: TPersistent); override;
  263. procedure ScaleParameters(const Value: Single); virtual;
  264. published
  265. property Inertia: Single read FInertia write FInertia stored StoreInertia;
  266. property MaxAngle: Single read FMaxAngle write FMaxAngle stored StoreMaxAngle;
  267. property PitchSpeed: Single read FPitchSpeed write FPitchSpeed stored StorePitchSpeed;
  268. property TurnSpeed: Single read FTurnSpeed write FTurnSpeed stored StoreTurnSpeed;
  269. property TargetObject: TGLBaseSceneObject read FTargetObject write SetTargetObject;
  270. property Cutoff: Double read FCutoff write FCutoff stored StoreCutoff;
  271. end;
  272. {TGLSmoothNavigator is the component for moving a TGLBaseSceneObject, and all
  273. classes based on it, this includes all the objects from the Scene Editor.
  274. It uses complex smoothing algorithms, most of which are FPS-dependant.
  275. Make sure your limit your FPS and set MaxExpectedDeltaTime to a value
  276. that is aproximatly 5 times less than your usual deltatime.
  277. }
  278. TGLSmoothNavigator = class(TGLNavigator)
  279. private
  280. FMaxExpectedDeltaTime: Double;
  281. FInertiaParams: TGLNavigatorInertiaParameters;
  282. FGeneralParams: TGLNavigatorGeneralParameters;
  283. FMoveAroundParams: TGLNavigatorMoveAroundParameters;
  284. FAdjustDistanceParams: TGLNavigatorAdjustDistanceParameters;
  285. FAdjustDistanceParamsEx: TGLNavigatorAdjustDistanceParametersEx;
  286. FCustomAnimatedItems: TGLNavigatorSmoothChangeItems;
  287. procedure SetInertiaParams(const Value: TGLNavigatorInertiaParameters);
  288. function StoreMaxExpectedDeltaTime: Boolean;
  289. procedure SetGeneralParams(const Value: TGLNavigatorGeneralParameters);
  290. procedure SetMoveAroundParams(const Value: TGLNavigatorMoveAroundParameters);
  291. procedure SetAdjustDistanceParams(const Value: TGLNavigatorAdjustDistanceParameters);
  292. procedure SetAdjustDistanceParamsEx(
  293. const Value: TGLNavigatorAdjustDistanceParametersEx);
  294. procedure SetCustomAnimatedItems(
  295. const Value: TGLNavigatorSmoothChangeItems);
  296. protected
  297. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  298. public
  299. // Constructors-destructors.
  300. constructor Create(AOwner: TComponent); override;
  301. destructor Destroy; override;
  302. // From TGLNavigator. Probably, should not be public.
  303. procedure SetObject(Value: TGLBaseSceneObject); override;
  304. // Uses InertiaParams.
  305. procedure TurnHorizontal(Angle: Single; ADeltaTime: Double); virtual;
  306. procedure TurnVertical(Angle: Single; ADeltaTime: Double); virtual;
  307. procedure FlyForward(const Plus, Minus: Boolean; ADeltaTime: Double; const Accelerate: Boolean = False); virtual;
  308. procedure MoveForward(const Plus, Minus: Boolean; ADeltaTime: Double; const Accelerate: Boolean = False); virtual;
  309. procedure StrafeHorizontal(const Plus, Minus: Boolean; ADeltaTime: Double; const Accelerate: Boolean = False); virtual;
  310. procedure StrafeVertical(const Plus, Minus: Boolean; ADeltaTime: Double; const Accelerate: Boolean = False); virtual;
  311. // Uses MoveAroundParams. Returns True, if object was actually moved.
  312. function MoveAroundTarget(const PitchDelta, TurnDelta : Single; const ADeltaTime: Double): Boolean;
  313. function MoveObjectAround(const AObject: TGLBaseSceneObject; PitchDelta, TurnDelta : Single; ADeltaTime: Double): Boolean;
  314. // Uses AdjustDistanceParams.
  315. function AdjustDistanceToPoint(const APoint: TVector; const DistanceRatio : Single; ADeltaTime: Double): Boolean;
  316. function AdjustDistanceToTarget(const DistanceRatio : Single; const ADeltaTime: Double): Boolean;
  317. // Uses AdjustDistanceParamsEx.
  318. function AdjustDistanceToPointEx(const APoint: TVector; ADeltaTime: Double): Boolean;
  319. function AdjustDistanceToTargetEx(const ADeltaTime: Double): Boolean;
  320. // Uses CustomAnimatedItems.
  321. procedure AnimateCustomItems(const ADeltaTime: Double); virtual;
  322. // Uses GeneralParams.
  323. {In ScaleParameters, Value should be around 1. }
  324. procedure ScaleParameters(const Value: Single); virtual;
  325. procedure AutoScaleParameters(const FPS: Single); virtual;
  326. procedure AutoScaleParametersUp(const FPS: Single); virtual;
  327. published
  328. property MaxExpectedDeltaTime: Double read FMaxExpectedDeltaTime write FMaxExpectedDeltaTime stored StoreMaxExpectedDeltaTime;
  329. property InertiaParams: TGLNavigatorInertiaParameters read FInertiaParams write SetInertiaParams;
  330. property GeneralParams: TGLNavigatorGeneralParameters read FGeneralParams write SetGeneralParams;
  331. property MoveAroundParams: TGLNavigatorMoveAroundParameters read FMoveAroundParams write SetMoveAroundParams;
  332. property AdjustDistanceParams: TGLNavigatorAdjustDistanceParameters read FAdjustDistanceParams write SetAdjustDistanceParams;
  333. property AdjustDistanceParamsEx: TGLNavigatorAdjustDistanceParametersEx read FAdjustDistanceParamsEx write SetAdjustDistanceParamsEx;
  334. property CustomAnimatedItems: TGLNavigatorSmoothChangeItems read FCustomAnimatedItems write SetCustomAnimatedItems;
  335. end;
  336. {TGLSmoothUserInterface is the component which reads the userinput and transform it into action.
  337. Mouselook(ADeltaTime: double) : handles mouse look... Should be called
  338. in the Cadencer event. (Though it works everywhere!)
  339. The four properties to get you started are:
  340. InvertMouse : Inverts the mouse Y axis.
  341. AutoUpdateMouse : If enabled (by defaul), than handles all mouse updates.
  342. GLNavigator : The Navigator which receives the user movement.
  343. GLVertNavigator : The Navigator which if set receives the vertical user
  344. movement. Used mostly for cameras....
  345. }
  346. TGLSmoothUserInterface = class(TComponent)
  347. private
  348. FAutoUpdateMouse: Boolean;
  349. FMouseLookActive: Boolean;
  350. FSmoothNavigator: TGLSmoothNavigator;
  351. FSmoothVertNavigator: TGLSmoothNavigator;
  352. FInvertMouse: Boolean;
  353. FOriginalMousePos: TGLCoordinates2;
  354. procedure SetSmoothNavigator(const Value: TGLSmoothNavigator); virtual;
  355. procedure SetOriginalMousePos(const Value: TGLCoordinates2); virtual;
  356. procedure SetSmoothVertNavigator(const Value: TGLSmoothNavigator); virtual;
  357. procedure SetMouseLookActive(const Value: Boolean); virtual;
  358. protected
  359. procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  360. public
  361. constructor Create(AOwner: TComponent); override;
  362. destructor Destroy; override;
  363. procedure TurnHorizontal(const Angle : Single; const ADeltaTime: Double); virtual;
  364. procedure TurnVertical(const Angle : Single; const ADeltaTime: Double); virtual;
  365. procedure MouseLookActiveToggle; virtual;
  366. function MouseLook(const ADeltaTime: Double): Boolean; overload;
  367. function MouseLook(const NewXY: TPoint; const ADeltaTime: Double): Boolean; overload;
  368. function MouseLook(const NewX, NewY: Integer; const ADeltaTime: Double): Boolean; overload;
  369. published
  370. property AutoUpdateMouse: Boolean read FAutoUpdateMouse write FAutoUpdateMouse default True;
  371. property MouseLookActive: Boolean read FMouseLookActive write SetMouseLookActive default False;
  372. property SmoothVertNavigator: TGLSmoothNavigator read FSmoothVertNavigator write SetSmoothVertNavigator;
  373. property SmoothNavigator: TGLSmoothNavigator read FSmoothNavigator write SetSmoothNavigator;
  374. property InvertMouse: Boolean read FInvertMouse write FInvertMouse default False;
  375. property OriginalMousePos: TGLCoordinates2 read FOriginalMousePos write SetOriginalMousePos;
  376. end;
  377. implementation
  378. const
  379. EPS = 0.001;
  380. EPS2 = 0.0001;
  381. EPS8 = 0.00000001;
  382. { TGLSmoothNavigator }
  383. constructor TGLSmoothNavigator.Create(AOwner: TComponent);
  384. begin
  385. inherited;
  386. FMaxExpectedDeltaTime := 0.001;
  387. FInertiaParams := TGLNavigatorInertiaParameters.Create(Self);
  388. FGeneralParams := TGLNavigatorGeneralParameters.Create(Self);
  389. FMoveAroundParams := TGLNavigatorMoveAroundParameters.Create(Self);
  390. FAdjustDistanceParams := TGLNavigatorAdjustDistanceParameters.Create(Self);
  391. FAdjustDistanceParamsEx := TGLNavigatorAdjustDistanceParametersEx.Create(Self);
  392. FCustomAnimatedItems := TGLNavigatorSmoothChangeItems.Create(Self);
  393. end;
  394. destructor TGLSmoothNavigator.Destroy;
  395. begin
  396. FInertiaParams.Free;
  397. FGeneralParams.Free;
  398. FMoveAroundParams.Free;
  399. FAdjustDistanceParams.Free;
  400. FAdjustDistanceParamsEx.Free;
  401. FCustomAnimatedItems.Free;
  402. inherited;
  403. end;
  404. procedure TGLSmoothNavigator.SetInertiaParams(
  405. const Value: TGLNavigatorInertiaParameters);
  406. begin
  407. FInertiaParams.Assign(Value);
  408. end;
  409. procedure TGLSmoothNavigator.TurnHorizontal(Angle: Single; ADeltaTime: Double);
  410. var
  411. FinalAngle: Single;
  412. begin
  413. with FInertiaParams do
  414. begin
  415. FinalAngle := 0;
  416. Angle := Angle * FTurnSpeed;
  417. while ADeltaTime > FMaxExpectedDeltaTime do
  418. begin
  419. Angle := ClampValue((Angle * FMaxExpectedDeltaTime + OldTurnHorizontalAngle * FTurnInertia) / (FTurnInertia + 1), -FTurnMaxAngle, FTurnMaxAngle);
  420. OldTurnHorizontalAngle := Angle;
  421. ADeltaTime := ADeltaTime - FMaxExpectedDeltaTime;
  422. FinalAngle := FinalAngle + Angle;
  423. end;
  424. end;
  425. if (Abs(FinalAngle) > EPS) then
  426. inherited TurnHorizontal(FinalAngle);
  427. end;
  428. procedure TGLSmoothNavigator.TurnVertical(Angle: Single; ADeltaTime: Double);
  429. var
  430. FinalAngle: Single;
  431. begin
  432. with FInertiaParams do
  433. begin
  434. FinalAngle := 0;
  435. Angle := Angle * FTurnSpeed;
  436. while ADeltaTime > FMaxExpectedDeltaTime do
  437. begin
  438. Angle := ClampValue((Angle * FMaxExpectedDeltaTime + OldTurnVerticalAngle * FTurnInertia) / (FTurnInertia + 1), -FTurnMaxAngle, FTurnMaxAngle);
  439. OldTurnVerticalAngle := Angle;
  440. ADeltaTime := ADeltaTime - FMaxExpectedDeltaTime;
  441. FinalAngle := FinalAngle + Angle;
  442. end;
  443. end;
  444. if (Abs(FinalAngle) > EPS) then
  445. inherited TurnVertical(FinalAngle);
  446. end;
  447. procedure TGLSmoothNavigator.MoveForward(const Plus, Minus: Boolean; ADeltaTime: Double; const Accelerate: Boolean = False);
  448. var
  449. FinalDistance: Single;
  450. Distance: Single;
  451. begin
  452. with FInertiaParams do
  453. begin
  454. if Plus then
  455. Distance := FMovementSpeed
  456. else if Minus then
  457. Distance := -FMovementSpeed
  458. else
  459. Distance := 0;
  460. if Accelerate then
  461. Distance := Distance * FMovementAcceleration;
  462. FinalDistance := 0;
  463. while ADeltaTime > FMaxExpectedDeltaTime do
  464. begin
  465. OldMoveForwardDistance := (Distance * FMaxExpectedDeltaTime + OldMoveForwardDistance * FMovementInertia) / (FMovementInertia + 1);
  466. ADeltaTime := ADeltaTime - FMaxExpectedDeltaTime;
  467. FinalDistance := FinalDistance + OldMoveForwardDistance;
  468. end;
  469. end;
  470. if Abs(FinalDistance) > EPS then
  471. inherited MoveForward(FinalDistance);
  472. end;
  473. procedure TGLSmoothNavigator.FlyForward(const Plus, Minus: Boolean; ADeltaTime: Double; const Accelerate: Boolean = False);
  474. var
  475. FinalDistance: Single;
  476. Distance: Single;
  477. begin
  478. with FInertiaParams do
  479. begin
  480. if Plus then
  481. Distance := FMovementSpeed
  482. else if Minus then
  483. Distance := -FMovementSpeed
  484. else
  485. Distance := 0;
  486. if Accelerate then
  487. Distance := Distance * FMovementAcceleration;
  488. FinalDistance := 0;
  489. while ADeltaTime > FMaxExpectedDeltaTime do
  490. begin
  491. OldMoveForwardDistance := (Distance * FMaxExpectedDeltaTime + OldMoveForwardDistance * FMovementInertia) / (FMovementInertia + 1);
  492. ADeltaTime := ADeltaTime - FMaxExpectedDeltaTime;
  493. FinalDistance := FinalDistance + OldMoveForwardDistance;
  494. end;
  495. end;
  496. if Abs(FinalDistance) > EPS then
  497. inherited FlyForward(FinalDistance);
  498. end;
  499. procedure TGLSmoothNavigator.StrafeHorizontal(const Plus, Minus: Boolean; ADeltaTime: Double; const Accelerate: Boolean = False);
  500. var
  501. FinalDistance: Single;
  502. Distance: Single;
  503. begin
  504. with FInertiaParams do
  505. begin
  506. if Plus then
  507. Distance := FMovementSpeed
  508. else if Minus then
  509. Distance := -FMovementSpeed
  510. else
  511. Distance := 0;
  512. if Accelerate then
  513. Distance := Distance * FMovementAcceleration;
  514. FinalDistance := 0;
  515. while ADeltaTime > FMaxExpectedDeltaTime do
  516. begin
  517. OldStrafeHorizontalDistance := (Distance * FMaxExpectedDeltaTime + OldStrafeHorizontalDistance * FMovementInertia) / (FMovementInertia + 1);
  518. ADeltaTime := ADeltaTime - FMaxExpectedDeltaTime;
  519. FinalDistance := FinalDistance + OldStrafeHorizontalDistance;
  520. end;
  521. end;
  522. if Abs(FinalDistance) > EPS then
  523. inherited StrafeHorizontal(FinalDistance);
  524. end;
  525. procedure TGLSmoothNavigator.StrafeVertical(const Plus, Minus: Boolean; ADeltaTime: Double; const Accelerate: Boolean = False);
  526. var
  527. FinalDistance: Single;
  528. Distance: Single;
  529. begin
  530. with FInertiaParams do
  531. begin
  532. if Plus then
  533. Distance := FMovementSpeed
  534. else if Minus then
  535. Distance := -FMovementSpeed
  536. else
  537. Distance := 0;
  538. if Accelerate then
  539. Distance := Distance * FMovementAcceleration;
  540. FinalDistance := 0;
  541. while ADeltaTime > FMaxExpectedDeltaTime do
  542. begin
  543. OldStrafeVerticalDistance := (Distance * FMaxExpectedDeltaTime + OldStrafeVerticalDistance * FMovementInertia) / (FMovementInertia + 1);
  544. ADeltaTime := ADeltaTime - FMaxExpectedDeltaTime;
  545. FinalDistance := FinalDistance + OldStrafeVerticalDistance;
  546. end;
  547. end;
  548. if Abs(FinalDistance) > EPS then
  549. inherited StrafeVertical(FinalDistance);
  550. end;
  551. procedure TGLSmoothNavigator.AutoScaleParameters(const FPS: Single);
  552. begin
  553. with FGeneralParams do
  554. begin
  555. if FPS > FAutoScaleMax / FMaxExpectedDeltatime then
  556. ScaleParameters(FAutoScaleMult)
  557. else if FPS < FAutoScaleMin / FMaxExpectedDeltatime then
  558. ScaleParameters(1/FAutoScaleMult);
  559. end;
  560. end;
  561. procedure TGLSmoothNavigator.AutoScaleParametersUp(const FPS: Single);
  562. begin
  563. with FGeneralParams do
  564. begin
  565. if FPS > FAutoScaleMax / FMaxExpectedDeltatime then
  566. ScaleParameters(FAutoScaleMult)
  567. end;
  568. end;
  569. procedure TGLSmoothNavigator.ScaleParameters(const Value: Single);
  570. begin
  571. Assert(Value > 0);
  572. FMaxExpectedDeltatime := FMaxExpectedDeltatime / Value;
  573. FInertiaParams.ScaleParameters(Value);
  574. FMoveAroundParams.ScaleParameters(Value);
  575. FAdjustDistanceParams.ScaleParameters(Value);
  576. end;
  577. function TGLSmoothNavigator.StoreMaxExpectedDeltaTime: Boolean;
  578. begin
  579. Result := Abs(FMaxExpectedDeltaTime - 0.001) > EPS2;
  580. end;
  581. procedure TGLSmoothNavigator.SetGeneralParams(
  582. const Value: TGLNavigatorGeneralParameters);
  583. begin
  584. FGeneralParams.Assign(Value);
  585. end;
  586. procedure TGLSmoothNavigator.SetMoveAroundParams(
  587. const Value: TGLNavigatorMoveAroundParameters);
  588. begin
  589. FMoveAroundParams.Assign(Value);
  590. end;
  591. procedure TGLSmoothNavigator.Notification(AComponent: TComponent;
  592. Operation: TOperation);
  593. begin
  594. inherited;
  595. if Operation = opRemove then
  596. begin
  597. if AComponent = FMoveAroundParams.FTargetObject then
  598. FMoveAroundParams.FTargetObject := nil;
  599. end;
  600. end;
  601. procedure TGLSmoothNavigator.SetObject(Value: TGLBaseSceneObject);
  602. var
  603. I: Integer;
  604. begin
  605. inherited;
  606. // Try to detect a TargetObject.
  607. if Value <> nil then
  608. if FMoveAroundParams.TargetObject = nil then
  609. begin
  610. // May be it is a camera...
  611. if Value is TGLCamera then
  612. FMoveAroundParams.TargetObject := TGLCamera(Value).TargetObject
  613. else
  614. begin
  615. // May be it has camera children...
  616. if Value.Count <> 0 then
  617. for I := 0 to Value.Count - 1 do
  618. if Value.Children[I] is TGLCamera then
  619. begin
  620. FMoveAroundParams.TargetObject := TGLCamera(Value.Children[I]).TargetObject;
  621. Exit;
  622. end;
  623. end;
  624. end;
  625. end;
  626. function TGLSmoothNavigator.MoveAroundTarget(const PitchDelta, TurnDelta: Single;
  627. const ADeltaTime: Double): Boolean;
  628. begin
  629. Result := MoveObjectAround(FMoveAroundParams.FTargetObject, PitchDelta, TurnDelta, ADeltaTime);
  630. end;
  631. function TGLSmoothNavigator.MoveObjectAround(
  632. const AObject: TGLBaseSceneObject; PitchDelta, TurnDelta: Single;
  633. ADeltaTime: Double): Boolean;
  634. var
  635. FinalPitch: Single;
  636. FinalTurn: Single;
  637. lUp: TVector;
  638. begin
  639. Result := False;
  640. FinalPitch := 0;
  641. FinalTurn := 0;
  642. with FMoveAroundParams do
  643. begin
  644. PitchDelta := PitchDelta * FPitchSpeed;
  645. TurnDelta := TurnDelta * FTurnSpeed;
  646. while ADeltaTime > FMaxExpectedDeltatime do
  647. begin
  648. PitchDelta := ClampValue((PitchDelta * FMaxExpectedDeltatime + FOldPitchInertiaAngle * FInertia) / (FInertia + 1), - FMaxAngle, FMaxAngle);
  649. FOldPitchInertiaAngle := PitchDelta;
  650. FinalPitch := FinalPitch + PitchDelta;
  651. TurnDelta := ClampValue((TurnDelta * FMaxExpectedDeltatime + FOldTurnInertiaAngle * FInertia) / (FInertia + 1), - FMaxAngle, FMaxAngle);
  652. FOldTurnInertiaAngle := TurnDelta;
  653. FinalTurn := FinalTurn + TurnDelta;
  654. ADeltaTime := ADeltaTime - FMaxExpectedDeltatime;
  655. end;
  656. if UseVirtualUp then
  657. lUp := VirtualUp.AsVector
  658. else
  659. lUp := MovingObject.AbsoluteUp;
  660. if (Abs(FinalPitch) > FCutOff) or (Abs(FinalTurn) > FCutOff) then
  661. begin
  662. MovingObject.AbsolutePosition := GLVectorGeometry.MoveObjectAround(
  663. MovingObject.AbsolutePosition, lUp, AObject.AbsolutePosition, FinalPitch, FinalTurn);
  664. Result := True;
  665. end;
  666. end;
  667. end;
  668. function TGLSmoothNavigator.AdjustDistanceToPoint(const APoint: TVector;
  669. const DistanceRatio: Single; ADeltaTime: Double): Boolean;
  670. // Based on TGLCamera.AdjustDistanceToTarget
  671. procedure DoAdjustDistanceToPoint(const DistanceRatio: Single);
  672. var
  673. vect: TVector;
  674. begin
  675. vect := VectorSubtract(MovingObject.AbsolutePosition, APoint);
  676. ScaleVector(vect, (distanceRatio - 1));
  677. AddVector(vect, MovingObject.AbsolutePosition);
  678. if Assigned(MovingObject.Parent) then
  679. vect := MovingObject.Parent.AbsoluteToLocal(vect);
  680. MovingObject.Position.AsVector := vect;
  681. Result := True;
  682. end;
  683. var
  684. FinalDistanceRatio: Single;
  685. TempDistanceRatio: Single;
  686. begin
  687. with FAdjustDistanceParams do
  688. begin
  689. TempDistanceRatio := DistanceRatio * FSpeed;
  690. FinalDistanceRatio := 0;
  691. while ADeltaTime > FMaxExpectedDeltaTime do
  692. begin
  693. TempDistanceRatio := (TempDistanceRatio * FMaxExpectedDeltaTime + FOldDistanceRatio * FInertia) / (FInertia + 1);
  694. FOldDistanceRatio := TempDistanceRatio;
  695. ADeltaTime := ADeltaTime - FMaxExpectedDeltaTime;
  696. FinalDistanceRatio := FinalDistanceRatio + FOldDistanceRatio / FMaxExpectedDeltaTime;
  697. end;
  698. if Abs(FinalDistanceRatio) > FCutoff then
  699. begin
  700. if FinalDistanceRatio > 0 then
  701. DoAdjustDistanceToPoint(1 / (1 + FinalDistanceRatio))
  702. else
  703. DoAdjustDistanceToPoint(1 * (1 - FinalDistanceRatio))
  704. end
  705. else
  706. Result := False;
  707. end;
  708. end;
  709. function TGLSmoothNavigator.AdjustDistanceToTarget(const DistanceRatio: Single;
  710. const ADeltaTime: Double): Boolean;
  711. begin
  712. Assert(FMoveAroundParams.FTargetObject <> nil);
  713. Result := AdjustDistanceToPoint(FMoveAroundParams.FTargetObject.AbsolutePosition,
  714. DistanceRatio, ADeltaTime);
  715. end;
  716. procedure TGLSmoothNavigator.SetAdjustDistanceParams(
  717. const Value: TGLNavigatorAdjustDistanceParameters);
  718. begin
  719. FAdjustDistanceParams.Assign(Value);
  720. end;
  721. function TGLSmoothNavigator.AdjustDistanceToPointEx(const APoint: TVector;
  722. ADeltaTime: Double): Boolean;
  723. var
  724. lAbsolutePosition: TVector;
  725. lCurrentDistance: Single;
  726. lDistanceDifference, lTempCurrentDistance: Single;
  727. procedure DoAdjustDistanceToPoint(const DistanceValue: Single);
  728. var
  729. vect: TVector;
  730. begin
  731. vect := VectorSubtract(APoint, lAbsolutePosition);
  732. NormalizeVector(vect);
  733. ScaleVector(vect, DistanceValue);
  734. MovingObject.AbsolutePosition := VectorAdd(lAbsolutePosition, vect);
  735. Result := True;
  736. end;
  737. begin
  738. lAbsolutePosition := MovingObject.AbsolutePosition;
  739. lCurrentDistance := VectorDistance(lAbsolutePosition, APoint);
  740. lDistanceDifference := lCurrentDistance - FAdjustDistanceParamsEx.FTargetDistance;
  741. with FAdjustDistanceParamsEx do
  742. begin
  743. lTempCurrentDistance := 0;
  744. while ADeltaTime > FMaxExpectedDeltaTime do
  745. begin
  746. lTempCurrentDistance := (FSpeed * FMaxExpectedDeltaTime * lDistanceDifference * FInertia) / (FInertia + 1);
  747. // lTempCurrentDistance := (FSpeed * FMaxExpectedDeltaTime + lDistanceDifference * FInertia) / (FInertia + 1);- this also works, but a bit different.
  748. ADeltaTime := ADeltaTime - FMaxExpectedDeltaTime;
  749. end;
  750. lTempCurrentDistance := ClampValue(lTempCurrentDistance, -FSpeedLimit * ADeltaTime, FSpeedLimit * ADeltaTime);
  751. if Abs(lTempCurrentDistance) > FCutoff then
  752. DoAdjustDistanceToPoint(lTempCurrentDistance)
  753. else
  754. Result := False;
  755. end;
  756. end;
  757. function TGLSmoothNavigator.AdjustDistanceToTargetEx(
  758. const ADeltaTime: Double): Boolean;
  759. begin
  760. Assert(FMoveAroundParams.FTargetObject <> nil);
  761. Result := AdjustDistanceToPointEx(FMoveAroundParams.FTargetObject.AbsolutePosition,
  762. ADeltaTime);
  763. end;
  764. procedure TGLSmoothNavigator.SetAdjustDistanceParamsEx(
  765. const Value: TGLNavigatorAdjustDistanceParametersEx);
  766. begin
  767. FAdjustDistanceParamsEx.Assign(Value);
  768. end;
  769. procedure TGLSmoothNavigator.AnimateCustomItems(const ADeltaTime: Double);
  770. begin
  771. FCustomAnimatedItems.DoProceed(ADeltaTime);
  772. end;
  773. procedure TGLSmoothNavigator.SetCustomAnimatedItems(
  774. const Value: TGLNavigatorSmoothChangeItems);
  775. begin
  776. FCustomAnimatedItems.Assign(Value);
  777. end;
  778. { TGLSmoothUserInterface }
  779. function TGLSmoothUserInterface.MouseLook(
  780. const ADeltaTime: Double): Boolean;
  781. var
  782. MousePos: TPoint;
  783. begin
  784. Assert(FAutoUpdateMouse, 'AutoUpdateMouse must be True to use this function');
  785. if FMouseLookActive then
  786. begin
  787. GLGetCursorPos(MousePos);
  788. Result := Mouselook(MousePos.X, MousePos.Y, ADeltaTime);
  789. GLSetCursorPos(Round(OriginalMousePos.X), Round(OriginalMousePos.Y));
  790. end
  791. else
  792. Result := False;
  793. end;
  794. function TGLSmoothUserInterface.Mouselook(const NewX, NewY: Integer; const ADeltaTime: Double): Boolean;
  795. var
  796. DeltaX, DeltaY: Single;
  797. begin
  798. Result := False;
  799. if FMouseLookActive then
  800. begin
  801. Deltax := (NewX - FOriginalMousePos.X);
  802. Deltay := (FOriginalMousePos.Y - NewY);
  803. if InvertMouse then
  804. DeltaY := -DeltaY;
  805. SmoothNavigator.TurnHorizontal(DeltaX, ADeltaTime);
  806. SmoothNavigator.TurnVertical(DeltaY, ADeltaTime);
  807. Result := (DeltaX <> 0) or (DeltaY <> 0);
  808. end;
  809. end;
  810. function TGLSmoothUserInterface.MouseLook(const NewXY: TPoint; const ADeltaTime: Double): Boolean;
  811. begin
  812. Result := Mouselook(NewXY.X, NewXY.Y, ADeltaTime);
  813. end;
  814. constructor TGLSmoothUserInterface.Create(AOwner: TComponent);
  815. begin
  816. inherited;
  817. FMouseLookActive := False;
  818. FAutoUpdateMouse := True;
  819. FOriginalMousePos := TGLCoordinates2.CreateInitialized(Self,
  820. VectorMake(GLGetScreenWidth div 2,
  821. GLGetScreenHeight div 2, 0, 0), csPoint2D);
  822. end;
  823. procedure TGLSmoothUserInterface.Notification(AComponent: TComponent;
  824. Operation: TOperation);
  825. begin
  826. inherited;
  827. if (Operation = opRemove) then
  828. begin
  829. if AComponent = FSmoothNavigator then
  830. FSmoothNavigator := nil;
  831. if AComponent = FSmoothVertNavigator then
  832. FSmoothNavigator := nil;
  833. end;
  834. end;
  835. procedure TGLSmoothUserInterface.SetSmoothNavigator(
  836. const Value: TGLSmoothNavigator);
  837. begin
  838. if FSmoothNavigator <> nil then
  839. FSmoothNavigator.RemoveFreeNotification(Self);
  840. FSmoothNavigator := Value;
  841. if FSmoothNavigator <> nil then
  842. FSmoothNavigator.FreeNotification(Self);
  843. end;
  844. destructor TGLSmoothUserInterface.Destroy;
  845. begin
  846. FOriginalMousePos.Destroy;
  847. inherited;
  848. end;
  849. procedure TGLSmoothUserInterface.SetOriginalMousePos(
  850. const Value: TGLCoordinates2);
  851. begin
  852. FOriginalMousePos.Assign(Value);
  853. end;
  854. procedure TGLSmoothUserInterface.SetSmoothVertNavigator(
  855. const Value: TGLSmoothNavigator);
  856. begin
  857. if FSmoothVertNavigator <> nil then
  858. FSmoothVertNavigator.RemoveFreeNotification(Self);
  859. FSmoothVertNavigator := Value;
  860. if FSmoothVertNavigator <> nil then
  861. FSmoothVertNavigator.FreeNotification(Self);
  862. end;
  863. procedure TGLSmoothUserInterface.MouseLookActiveToggle;
  864. begin
  865. if FMouseLookActive then
  866. SetMouseLookActive(False)
  867. else
  868. SetMouseLookActive(True)
  869. end;
  870. procedure TGLSmoothUserInterface.SetMouseLookActive(const Value: Boolean);
  871. var
  872. MousePos: TPoint;
  873. begin
  874. if FMouseLookActive = Value then Exit;
  875. FMouseLookActive := Value;
  876. if FMouseLookActive then
  877. begin
  878. if FAutoUpdateMouse then
  879. begin
  880. GLGetCursorPos(MousePos);
  881. FOriginalMousePos.SetPoint2D(MousePos.X, MousePos.Y);
  882. GLShowCursor(False);
  883. end;
  884. end
  885. else
  886. begin
  887. if FAutoUpdateMouse then
  888. GLShowCursor(True);
  889. end;
  890. end;
  891. procedure TGLSmoothUserInterface.TurnHorizontal(const Angle: Single;
  892. const ADeltaTime: Double);
  893. begin
  894. FSmoothNavigator.TurnHorizontal(Angle, ADeltaTime);
  895. end;
  896. procedure TGLSmoothUserInterface.TurnVertical(const Angle: Single;
  897. const ADeltaTime: Double);
  898. begin
  899. if Assigned(FSmoothNavigator) then
  900. FSmoothNavigator.TurnVertical(Angle, ADeltaTime)
  901. else
  902. FSmoothVertNavigator.TurnVertical(Angle, ADeltaTime);
  903. end;
  904. { TGLNavigatorInertiaParameters }
  905. procedure TGLNavigatorInertiaParameters.Assign(Source: TPersistent);
  906. begin
  907. if Source is TGLNavigatorInertiaParameters then
  908. begin
  909. FMovementAcceleration := TGLNavigatorInertiaParameters(Source).FMovementAcceleration;
  910. FMovementInertia := TGLNavigatorInertiaParameters(Source).FMovementInertia;
  911. FMovementSpeed := TGLNavigatorInertiaParameters(Source).FMovementSpeed;
  912. FTurnMaxAngle := TGLNavigatorInertiaParameters(Source).FTurnMaxAngle;
  913. FTurnInertia := TGLNavigatorInertiaParameters(Source).FTurnInertia;
  914. FTurnSpeed := TGLNavigatorInertiaParameters(Source).FTurnSpeed;
  915. end
  916. else
  917. inherited; //to the pit of doom ;)
  918. end;
  919. constructor TGLNavigatorInertiaParameters.Create(AOwner: TPersistent);
  920. begin
  921. FOwner := AOwner;
  922. FTurnInertia := 150;
  923. FTurnSpeed := 50;
  924. FTurnMaxAngle := 0.5;
  925. FMovementAcceleration := 7;
  926. FMovementInertia := 200;
  927. FMovementSpeed := 200;
  928. end;
  929. function TGLNavigatorInertiaParameters.GetOwner: TPersistent;
  930. begin
  931. Result := FOwner;
  932. end;
  933. procedure TGLNavigatorInertiaParameters.ScaleParameters(
  934. const Value: Single);
  935. begin
  936. Assert(Value > 0);
  937. if Value > 1 then
  938. begin
  939. FMovementInertia := FMovementInertia * PowerSingle(2, 1 / Value);
  940. FTurnInertia := FTurnInertia * PowerSingle(2, 1 / Value);
  941. end
  942. else
  943. begin
  944. FMovementInertia := FMovementInertia / PowerSingle(2, Value);
  945. FTurnInertia := FTurnInertia / PowerSingle(2, Value);
  946. end;
  947. FTurnMaxAngle := FTurnMaxAngle / Value;
  948. FTurnSpeed := FTurnSpeed * Value;
  949. end;
  950. function TGLNavigatorInertiaParameters.StoreTurnMaxAngle: Boolean;
  951. begin
  952. Result := Abs(FTurnMaxAngle - 0.5) > EPS;
  953. end;
  954. function TGLNavigatorInertiaParameters.StoreMovementAcceleration: Boolean;
  955. begin
  956. Result := Abs(FMovementAcceleration - 7) > EPS;
  957. end;
  958. function TGLNavigatorInertiaParameters.StoreMovementInertia: Boolean;
  959. begin
  960. Result := Abs(FMovementInertia - 200) > EPS;
  961. end;
  962. function TGLNavigatorInertiaParameters.StoreMovementSpeed: Boolean;
  963. begin
  964. Result := Abs(FMovementSpeed - 200) > EPS;
  965. end;
  966. function TGLNavigatorInertiaParameters.StoreTurnInertia: Boolean;
  967. begin
  968. Result := Abs(FTurnInertia - 150) > EPS;
  969. end;
  970. function TGLNavigatorInertiaParameters.StoreTurnSpeed: Boolean;
  971. begin
  972. Result := Abs(FTurnSpeed - 50) > EPS;
  973. end;
  974. { TGLNavigatorGeneralParameters }
  975. procedure TGLNavigatorGeneralParameters.Assign(Source: TPersistent);
  976. begin
  977. if Source is TGLNavigatorGeneralParameters then
  978. begin
  979. FAutoScaleMin := TGLNavigatorGeneralParameters(Source).FAutoScaleMin;
  980. FAutoScaleMax := TGLNavigatorGeneralParameters(Source).FAutoScaleMax;
  981. FAutoScaleMult := TGLNavigatorGeneralParameters(Source).FAutoScaleMult;
  982. end
  983. else
  984. inherited; //die!
  985. end;
  986. constructor TGLNavigatorGeneralParameters.Create(AOwner: TPersistent);
  987. begin
  988. FOwner := AOwner;
  989. FAutoScaleMin := 0.1;
  990. FAutoScaleMax := 0.75;
  991. FAutoScaleMult := 2;
  992. end;
  993. function TGLNavigatorGeneralParameters.GetOwner: TPersistent;
  994. begin
  995. Result := FOwner;
  996. end;
  997. function TGLNavigatorGeneralParameters.StoreAutoScaleMax: Boolean;
  998. begin
  999. Result := Abs(FAutoScaleMax - 0.75) > EPS;
  1000. end;
  1001. function TGLNavigatorGeneralParameters.StoreAutoScaleMin: Boolean;
  1002. begin
  1003. Result := Abs(FAutoScaleMin - 0.1) > EPS;
  1004. end;
  1005. function TGLNavigatorGeneralParameters.StoreAutoScaleMult: Boolean;
  1006. begin
  1007. Result := Abs(FAutoScaleMult - 2) > EPS;
  1008. end;
  1009. { TGLNavigatorMoveAroundParameters }
  1010. procedure TGLNavigatorMoveAroundParameters.Assign(Source: TPersistent);
  1011. begin
  1012. if Source is TGLNavigatorMoveAroundParameters then
  1013. begin
  1014. FMaxAngle := TGLNavigatorMoveAroundParameters(Source).FMaxAngle;
  1015. FInertia := TGLNavigatorMoveAroundParameters(Source).FInertia;
  1016. FPitchSpeed := TGLNavigatorMoveAroundParameters(Source).FPitchSpeed;
  1017. FTurnSpeed := TGLNavigatorMoveAroundParameters(Source).FTurnSpeed;
  1018. FCutoff := TGLNavigatorMoveAroundParameters(Source).FCutoff;
  1019. SetTargetObject(TGLNavigatorMoveAroundParameters(Source).FTargetObject);
  1020. end
  1021. else
  1022. inherited; //die
  1023. end;
  1024. constructor TGLNavigatorMoveAroundParameters.Create(AOwner: TPersistent);
  1025. begin
  1026. FOwner := AOwner;
  1027. FPitchSpeed := 500;
  1028. FTurnSpeed := 500;
  1029. FInertia := 65;
  1030. FMaxAngle := 1.5;
  1031. FCutoff := EPS2;
  1032. end;
  1033. function TGLNavigatorMoveAroundParameters.GetOwner: TPersistent;
  1034. begin
  1035. Result := FOwner;
  1036. end;
  1037. procedure TGLNavigatorMoveAroundParameters.ScaleParameters(
  1038. const Value: Single);
  1039. begin
  1040. Assert(Value > 0);
  1041. if Value < 1 then
  1042. FInertia := FInertia / PowerSingle(2, Value)
  1043. else
  1044. FInertia := FInertia * PowerSingle(2, 1 / Value);
  1045. FMaxAngle := FMaxAngle / Value;
  1046. FPitchSpeed := FPitchSpeed * Value;
  1047. FTurnSpeed := FTurnSpeed * Value;
  1048. end;
  1049. procedure TGLNavigatorMoveAroundParameters.SetTargetObject(
  1050. const Value: TGLBaseSceneObject);
  1051. begin
  1052. if FTargetObject <> nil then
  1053. if FOwner is TGLSmoothNavigator then
  1054. FTargetObject.RemoveFreeNotification(TGLSmoothNavigator(FOwner));
  1055. FTargetObject := Value;
  1056. if FTargetObject <> nil then
  1057. if FOwner is TGLSmoothNavigator then
  1058. FTargetObject.FreeNotification(TGLSmoothNavigator(FOwner));
  1059. end;
  1060. function TGLNavigatorMoveAroundParameters.StoreCutoff: Boolean;
  1061. begin
  1062. Result := Abs(FCutoff - EPS2) > EPS8;
  1063. end;
  1064. function TGLNavigatorMoveAroundParameters.StoreInertia: Boolean;
  1065. begin
  1066. Result := Abs(FInertia - 65) > EPS;
  1067. end;
  1068. function TGLNavigatorMoveAroundParameters.StoreMaxAngle: Boolean;
  1069. begin
  1070. Result := Abs(FMaxAngle - 1.5) > EPS;
  1071. end;
  1072. function TGLNavigatorMoveAroundParameters.StorePitchSpeed: Boolean;
  1073. begin
  1074. Result := Abs(FPitchSpeed - 500) > EPS;
  1075. end;
  1076. function TGLNavigatorMoveAroundParameters.StoreTurnSpeed: Boolean;
  1077. begin
  1078. Result := Abs(FTurnSpeed - 500) > EPS;
  1079. end;
  1080. { TGLNavigatorAdjustDistanceParameters }
  1081. procedure TGLNavigatorAdjustDistanceParameters.AddImpulse(
  1082. const Impulse: Single);
  1083. begin
  1084. FOldDistanceRatio := FOldDistanceRatio + Impulse * FSpeed / FInertia * FImpulseSpeed;
  1085. end;
  1086. procedure TGLNavigatorAdjustDistanceParameters.Assign(Source: TPersistent);
  1087. begin
  1088. inherited Assign(Source);
  1089. if Source is TGLNavigatorAdjustDistanceParameters then
  1090. begin
  1091. FImpulseSpeed := TGLNavigatorAdjustDistanceParameters(Source).FImpulseSpeed;
  1092. end;
  1093. end;
  1094. constructor TGLNavigatorAdjustDistanceParameters.Create(
  1095. AOwner: TPersistent);
  1096. begin
  1097. inherited;
  1098. FImpulseSpeed := 0.02;
  1099. end;
  1100. procedure TGLNavigatorAdjustDistanceParameters.ScaleParameters(
  1101. const Value: Single);
  1102. begin
  1103. inherited;
  1104. FImpulseSpeed := FImpulseSpeed / Value;
  1105. end;
  1106. function TGLNavigatorAdjustDistanceParameters.StoreImpulseSpeed: Boolean;
  1107. begin
  1108. Result := Abs(FImpulseSpeed - 0.02) > EPS;
  1109. end;
  1110. { TGLNavigatorAbstractParameters }
  1111. procedure TGLNavigatorAbstractParameters.Assign(Source: TPersistent);
  1112. begin
  1113. if Source is TGLNavigatorAbstractParameters then
  1114. begin
  1115. FInertia := TGLNavigatorAbstractParameters(Source).FInertia;
  1116. FSpeed := TGLNavigatorAbstractParameters(Source).FSpeed;
  1117. FCutoff := TGLNavigatorAbstractParameters(Source).FCutoff;
  1118. end
  1119. else
  1120. inherited; //to the pit of doom ;)
  1121. end;
  1122. constructor TGLNavigatorAbstractParameters.Create(
  1123. AOwner: TPersistent);
  1124. begin
  1125. FOwner := AOwner;
  1126. FInertia := 100;
  1127. FSpeed := 0.005;
  1128. FCutoff := EPS;
  1129. end;
  1130. function TGLNavigatorAbstractParameters.GetOwner: TPersistent;
  1131. begin
  1132. Result := FOwner;
  1133. end;
  1134. procedure TGLNavigatorAbstractParameters.ScaleParameters(
  1135. const Value: Single);
  1136. begin
  1137. Assert(Value > 0);
  1138. if Value < 1 then
  1139. FInertia := FInertia / PowerSingle(2, Value)
  1140. else
  1141. FInertia := FInertia * PowerSingle(2, 1 / Value);
  1142. end;
  1143. function TGLNavigatorAbstractParameters.StoreCutoff: Boolean;
  1144. begin
  1145. Result := Abs(FCutoff - EPS) > EPS2;
  1146. end;
  1147. function TGLNavigatorAbstractParameters.StoreInertia: Boolean;
  1148. begin
  1149. Result := Abs(FInertia - 100) > EPS;
  1150. end;
  1151. function TGLNavigatorAbstractParameters.StoreSpeed: Boolean;
  1152. begin
  1153. Result := Abs(FSpeed - 0.005) > EPS2;
  1154. end;
  1155. { TGLNavigatorAdjustDistanceParametersEx }
  1156. procedure TGLNavigatorAdjustDistanceParametersEx.Assign(
  1157. Source: TPersistent);
  1158. begin
  1159. if Source is TGLNavigatorAdjustDistanceParametersEx then
  1160. begin
  1161. FTargetDistance := TGLNavigatorAdjustDistanceParametersEx(Source).FTargetDistance;
  1162. FSpeedLimit := TGLNavigatorAdjustDistanceParametersEx(Source).FSpeedLimit;
  1163. end
  1164. else
  1165. inherited;
  1166. end;
  1167. constructor TGLNavigatorAdjustDistanceParametersEx.Create(
  1168. AOwner: TPersistent);
  1169. begin
  1170. inherited;
  1171. FInertia := 0.5;
  1172. FTargetDistance := 100;
  1173. FSpeed := 100;
  1174. FSpeedLimit := 20000;
  1175. end;
  1176. function TGLNavigatorAdjustDistanceParametersEx.StoreInertia: Boolean;
  1177. begin
  1178. Result := Abs(FInertia - 0.5) > EPS2;
  1179. end;
  1180. function TGLNavigatorAdjustDistanceParametersEx.StoreSpeed: Boolean;
  1181. begin
  1182. Result := Abs(FSpeed - 100) > EPS2;
  1183. end;
  1184. function TGLNavigatorAdjustDistanceParametersEx.StoreSpeedLimit: Boolean;
  1185. begin
  1186. Result := Abs(FSpeedLimit - 20000) > EPS2;
  1187. end;
  1188. function TGLNavigatorAdjustDistanceParametersEx.StoreTargetDistance: Boolean;
  1189. begin
  1190. Result := Abs(FTargetDistance - 100) > EPS2;
  1191. end;
  1192. { TGLNavigatorSmoothChangeItem }
  1193. procedure TGLNavigatorSmoothChangeItem.Assign(Source: TPersistent);
  1194. begin
  1195. inherited Assign(Source);
  1196. if Source is TGLNavigatorSmoothChangeItem then
  1197. begin
  1198. FInertia := TGLNavigatorSmoothChangeItem(Source).FInertia;
  1199. FSpeed := TGLNavigatorSmoothChangeItem(Source).FSpeed;
  1200. FSpeedLimit := TGLNavigatorSmoothChangeItem(Source).FSpeedLimit;
  1201. FCutoff := TGLNavigatorSmoothChangeItem(Source).FCutoff;
  1202. FEnabled := TGLNavigatorSmoothChangeItem(Source).FEnabled;
  1203. end;
  1204. end;
  1205. constructor TGLNavigatorSmoothChangeItem.Create(aOwner: TXCollection);
  1206. begin
  1207. inherited;
  1208. FInertia := 1;
  1209. FSpeed := 5.5;
  1210. FSpeedLimit := 20000;
  1211. FCutoff := EPS;
  1212. FEnabled := True;
  1213. end;
  1214. function TGLNavigatorSmoothChangeItem.GetNavigator: TGLSmoothNavigator;
  1215. begin
  1216. Result := TGLSmoothNavigator(TGLNavigatorSmoothChangeItems(GetOwner).Owner);
  1217. end;
  1218. procedure TGLNavigatorSmoothChangeItem.ScaleParameters(
  1219. const Value: Single);
  1220. begin
  1221. Assert(Value > 0);
  1222. if Value < 1 then
  1223. FInertia := FInertia / PowerSingle(2, Value)
  1224. else
  1225. FInertia := FInertia * PowerSingle(2, 1 / Value);
  1226. end;
  1227. function TGLNavigatorSmoothChangeItem.StoreCutoff: Boolean;
  1228. begin
  1229. Result := Abs(FCutoff - EPS) > EPS8;
  1230. end;
  1231. function TGLNavigatorSmoothChangeItem.StoreInertia: Boolean;
  1232. begin
  1233. Result := Abs(FInertia - 1) > EPS;
  1234. end;
  1235. function TGLNavigatorSmoothChangeItem.StoreSpeed: Boolean;
  1236. begin
  1237. Result := Abs(FSpeed - 5.5) > EPS2;
  1238. end;
  1239. function TGLNavigatorSmoothChangeItem.StoreSpeedLimit: Boolean;
  1240. begin
  1241. Result := Abs(FSpeedLimit - 20000) > EPS2;
  1242. end;
  1243. { TGLNavigatorSmoothChangeItems }
  1244. function TGLNavigatorSmoothChangeItems.Add(AClass : TGLNavigatorSmoothChangeItemClass): TGLNavigatorSmoothChangeItem;
  1245. begin
  1246. Result := AClass.Create(Self);
  1247. end;
  1248. function TGLNavigatorSmoothChangeItems.CanAdd(AClass: TXCollectionItemClass): Boolean;
  1249. begin
  1250. Result := AClass.InheritsFrom(TGLNavigatorSmoothChangeItem);
  1251. end;
  1252. procedure TGLNavigatorSmoothChangeItems.DoProceed(ADeltaTime: Double);
  1253. var
  1254. I: Integer;
  1255. begin
  1256. for I := 0 to Count - 1 do
  1257. GetItems(I).Proceed(ADeltaTime);
  1258. end;
  1259. function TGLNavigatorSmoothChangeItems.GetItems(const Index : Integer): TGLNavigatorSmoothChangeItem;
  1260. begin
  1261. Result := TGLNavigatorSmoothChangeItem(inherited GetItems(Index));
  1262. end;
  1263. class function TGLNavigatorSmoothChangeItems.ItemsClass: TXCollectionItemClass;
  1264. begin
  1265. Result := TGLNavigatorSmoothChangeItem;
  1266. end;
  1267. procedure TGLNavigatorSmoothChangeItems.SetItems(const Index : Integer; const Value:
  1268. TGLNavigatorSmoothChangeItem);
  1269. begin
  1270. GetItems(Index).Assign(Value);
  1271. end;
  1272. { TGLNavigatorSmoothChangeSingle }
  1273. procedure TGLNavigatorSmoothChangeSingle.Assign(Source: TPersistent);
  1274. begin
  1275. inherited Assign(Source);
  1276. if Source is TGLNavigatorSmoothChangeVector then
  1277. begin
  1278. FTargetValue := TGLNavigatorSmoothChangeSingle(Source).TargetValue;
  1279. FOnGetCurrentValue := TGLNavigatorSmoothChangeSingle(Source).FOnGetCurrentValue;
  1280. FOnSetCurrentValue := TGLNavigatorSmoothChangeSingle(Source).FOnSetCurrentValue;
  1281. end;
  1282. end;
  1283. class function TGLNavigatorSmoothChangeSingle.FriendlyName: string;
  1284. begin
  1285. Result := 'Navigator SmoothChange Single';
  1286. end;
  1287. function TGLNavigatorSmoothChangeSingle.Proceed(ADeltaTime: Double): Boolean;
  1288. var
  1289. lCurrentValue: Single;
  1290. lCurrentDifference: Single;
  1291. lTotalDistanceToTravelThisTime, lDistanceToTravelThisTime: Single;
  1292. lMaxExpectedDeltaTime: Double;
  1293. begin
  1294. Result := False;
  1295. if not FEnabled then Exit;
  1296. if not Assigned(FOnGetCurrentValue) then Exit;
  1297. if not Assigned(FOnSetCurrentValue) then Exit;
  1298. lMaxExpectedDeltaTime := GetNavigator.FMaxExpectedDeltaTime;
  1299. lCurrentValue := FOnGetCurrentValue(Self);
  1300. lCurrentDifference := FTargetValue - lCurrentValue;
  1301. lTotalDistanceToTravelThisTime := 0;
  1302. while ADeltaTime > lMaxExpectedDeltaTime do
  1303. begin
  1304. lDistanceToTravelThisTime := MinFloat((lCurrentDifference * ADeltaTime * FSpeed * FInertia) / (FInertia + 1), FSpeedLimit);
  1305. // lDistanceToTravelThisTime := (lCurrentDistance * ADeltaTime + FSpeed * FInertia) / (FInertia + 1);- this also works, but a bit different.
  1306. lCurrentDifference := lCurrentDifference - lDistanceToTravelThisTime;
  1307. lTotalDistanceToTravelThisTime := lTotalDistanceToTravelThisTime + lDistanceToTravelThisTime;
  1308. ADeltaTime := ADeltaTime - lMaxExpectedDeltaTime;
  1309. end;
  1310. if Abs(lTotalDistanceToTravelThisTime) > FCutoff then
  1311. begin
  1312. FOnSetCurrentValue(Self, lCurrentValue + lTotalDistanceToTravelThisTime);
  1313. Result := True;
  1314. end;
  1315. end;
  1316. procedure TGLNavigatorSmoothChangeSingle.ResetTargetValue;
  1317. begin
  1318. FTargetValue := FOnGetCurrentValue(Self);
  1319. end;
  1320. { TGLNavigatorSmoothChangeVector }
  1321. procedure TGLNavigatorSmoothChangeVector.Assign(Source: TPersistent);
  1322. begin
  1323. inherited Assign(Source);
  1324. if Source is TGLNavigatorSmoothChangeVector then
  1325. begin
  1326. FTargetValue.Assign(TGLNavigatorSmoothChangeVector(Source).TargetValue);
  1327. FOnGetCurrentValue := TGLNavigatorSmoothChangeVector(Source).FOnGetCurrentValue;
  1328. FOnSetCurrentValue := TGLNavigatorSmoothChangeVector(Source).FOnSetCurrentValue;
  1329. end;
  1330. end;
  1331. constructor TGLNavigatorSmoothChangeVector.Create(aOwner: TXCollection);
  1332. begin
  1333. inherited;
  1334. FTargetValue := TGLCoordinates.CreateInitialized(Self, NullHmgVector, csVector);
  1335. end;
  1336. destructor TGLNavigatorSmoothChangeVector.Destroy;
  1337. begin
  1338. FTargetValue.Free;
  1339. inherited;
  1340. end;
  1341. class function TGLNavigatorSmoothChangeVector.FriendlyName: string;
  1342. begin
  1343. Result := 'Navigator SmoothChange Vector';
  1344. end;
  1345. function TGLNavigatorSmoothChangeVector.Proceed(ADeltaTime: Double): Boolean;
  1346. var
  1347. lAbsolutePosition: TVector;
  1348. lCurrentDistance: Single;
  1349. lTotalDistanceToTravelThisTime, lDistanceToTravelThisTime: Single;
  1350. lMaxExpectedDeltaTime: Double;
  1351. procedure DoAdjustDistanceToPoint();
  1352. var
  1353. vect: TVector;
  1354. begin
  1355. vect := VectorScale(VectorNormalize(VectorSubtract(FTargetValue.DirectVector, lAbsolutePosition)), lTotalDistanceToTravelThisTime);
  1356. AddVector(vect, lAbsolutePosition);
  1357. // Did we go too far?
  1358. if VectorDistance(vect, FTargetValue.DirectVector) > VectorDistance(lAbsolutePosition, FTargetValue.DirectVector) then
  1359. vect := FTargetValue.DirectVector;
  1360. FOnSetCurrentValue(Self, vect);
  1361. Result := True;
  1362. end;
  1363. begin
  1364. Result := False;
  1365. if not FEnabled then Exit;
  1366. if not Assigned(FOnGetCurrentValue) then Exit;
  1367. if not Assigned(FOnSetCurrentValue) then Exit;
  1368. lMaxExpectedDeltaTime := GetNavigator.FMaxExpectedDeltaTime;
  1369. lAbsolutePosition := FOnGetCurrentValue(Self);
  1370. lCurrentDistance := VectorDistance(lAbsolutePosition, FTargetValue.DirectVector);
  1371. lTotalDistanceToTravelThisTime := 0;
  1372. while ADeltaTime > lMaxExpectedDeltaTime do
  1373. begin
  1374. lDistanceToTravelThisTime := MinFloat((lCurrentDistance * ADeltaTime * FSpeed * FInertia) / (FInertia + 1), FSpeedLimit);
  1375. // lDistanceToTravelThisTime := (lCurrentDistance * ADeltaTime + FSpeed * FInertia) / (FInertia + 1);- this also works, but a bit different.
  1376. lCurrentDistance := lCurrentDistance - lDistanceToTravelThisTime;
  1377. lTotalDistanceToTravelThisTime := lTotalDistanceToTravelThisTime + lDistanceToTravelThisTime;
  1378. ADeltaTime := ADeltaTime - lMaxExpectedDeltaTime;
  1379. end;
  1380. if Abs(lTotalDistanceToTravelThisTime) > FCutoff then
  1381. DoAdjustDistanceToPoint();
  1382. end;
  1383. procedure TGLNavigatorSmoothChangeVector.ResetTargetValue;
  1384. begin
  1385. FTargetValue.DirectVector := FOnGetCurrentValue(Self);
  1386. end;
  1387. procedure TGLNavigatorSmoothChangeVector.SetTargetValue(
  1388. const Value: TGLCoordinates);
  1389. begin
  1390. FTargetValue.Assign(Value);
  1391. end;
  1392. //==========================================================
  1393. initialization
  1394. //==========================================================
  1395. RegisterClasses([
  1396. TGLSmoothNavigator, TGLSmoothUserInterface,
  1397. TGLNavigatorInertiaParameters, TGLNavigatorGeneralParameters,
  1398. TGLNavigatorMoveAroundParameters,
  1399. TGLNavigatorAdjustDistanceParameters, TGLNavigatorAdjustDistanceParametersEx
  1400. ]);
  1401. RegisterXCollectionItemClass(TGLNavigatorSmoothChangeSingle);
  1402. RegisterXCollectionItemClass(TGLNavigatorSmoothChangeVector);
  1403. end.