GLS.BaseClasses.pas 4.5 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170
  1. //
  2. // The graphics engine GLScene
  3. //
  4. unit GLS.BaseClasses;
  5. (* Base classes *)
  6. interface
  7. uses
  8. System.Classes,
  9. System.SysUtils,
  10. Stage.Strings,
  11. GLS.PersistentClasses;
  12. type
  13. TGLProgressTimes = packed record
  14. DeltaTime, NewTime: Double;
  15. SqrDeltaTime, InvSqrDeltaTime: Single;
  16. end;
  17. (* Progression event for time-base animations/simulations.
  18. deltaTime is the time delta since last progress and newTime is the new
  19. time after the progress event is completed. *)
  20. TGLProgressEvent = procedure(Sender: TObject; const DeltaTime, NewTime: Double) of object;
  21. IGLNotifyAble = interface(IInterface)
  22. ['{00079A6C-D46E-4126-86EE-F9E2951B4593}']
  23. procedure NotifyChange(Sender: TObject);
  24. end;
  25. IGLProgessAble = interface(IInterface)
  26. ['{95E44548-B0FE-4607-98D0-CA51169AF8B5}']
  27. procedure DoProgress(const progressTime: TGLProgressTimes);
  28. end;
  29. // An abstract class describing the "update" interface.
  30. TGLUpdateAbleObject = class(TGLInterfacedPersistent, IGLNotifyAble)
  31. private
  32. FOwner: TPersistent;
  33. FUpdating: Integer;
  34. FOnNotifyChange: TNotifyEvent;
  35. protected
  36. function GetOwner: TPersistent; override; final;
  37. public
  38. constructor Create(AOwner: TPersistent); virtual;
  39. procedure NotifyChange(Sender: TObject); virtual;
  40. procedure Notification(Sender: TObject; Operation: TOperation); virtual;
  41. property Updating: Integer read FUpdating;
  42. procedure BeginUpdate; inline;
  43. procedure EndUpdate; inline;
  44. property Owner: TPersistent read FOwner;
  45. property OnNotifyChange: TNotifyEvent read FOnNotifyChange write FOnNotifyChange;
  46. end;
  47. // A base class describing the "cadenceing" interface.
  48. TGLCadenceAbleComponent = class(TComponent, IGLProgessAble)
  49. public
  50. procedure DoProgress(const progressTime: TGLProgressTimes); virtual;
  51. end;
  52. // A base class describing the "update" interface.
  53. TGLUpdateAbleComponent = class(TGLCadenceAbleComponent, IGLNotifyAble)
  54. public
  55. procedure NotifyChange(Sender: TObject); virtual;
  56. end;
  57. TGNotifyCollection = class(TOwnedCollection)
  58. strict private
  59. FOnNotifyChange: TNotifyEvent;
  60. strict protected
  61. procedure Update(item: TCollectionItem); override;
  62. public
  63. constructor Create(AOwner: TPersistent; AItemClass: TCollectionItemClass);
  64. property OnNotifyChange: TNotifyEvent read FOnNotifyChange write FOnNotifyChange;
  65. end;
  66. implementation //---------------------------------------------------------------
  67. constructor TGLUpdateAbleObject.Create(AOwner: TPersistent);
  68. begin
  69. inherited Create;
  70. FOwner := AOwner;
  71. end;
  72. procedure TGLUpdateAbleObject.NotifyChange(Sender: TObject);
  73. begin
  74. if FUpdating = 0 then
  75. begin
  76. if Assigned(FOwner) then
  77. begin
  78. if FOwner is TGLUpdateAbleObject then
  79. TGLUpdateAbleObject(FOwner).NotifyChange(Self)
  80. else if FOwner is TGLUpdateAbleComponent then
  81. TGLUpdateAbleComponent(FOwner).NotifyChange(Self);
  82. end;
  83. if Assigned(FOnNotifyChange) then
  84. FOnNotifyChange(Self);
  85. end;
  86. end;
  87. procedure TGLUpdateAbleObject.Notification(Sender: TObject; Operation: TOperation);
  88. begin
  89. end;
  90. function TGLUpdateAbleObject.GetOwner: TPersistent;
  91. begin
  92. Result := FOwner;
  93. end;
  94. procedure TGLUpdateAbleObject.BeginUpdate;
  95. begin
  96. Inc(FUpdating);
  97. end;
  98. procedure TGLUpdateAbleObject.EndUpdate;
  99. begin
  100. Dec(FUpdating);
  101. if FUpdating <= 0 then
  102. begin
  103. Assert(FUpdating = 0);
  104. NotifyChange(Self);
  105. end;
  106. end;
  107. // ------------------
  108. // ------------------ TGLCadenceAbleComponent ------------------
  109. // ------------------
  110. procedure TGLCadenceAbleComponent.DoProgress(const progressTime: TGLProgressTimes);
  111. begin
  112. // nothing
  113. end;
  114. // ------------------
  115. // ------------------ TGLUpdateAbleObject ------------------
  116. // ------------------
  117. procedure TGLUpdateAbleComponent.NotifyChange(Sender: TObject);
  118. begin
  119. if Assigned(Owner) then
  120. if (Owner is TGLUpdateAbleComponent) then
  121. (Owner as TGLUpdateAbleComponent).NotifyChange(Self);
  122. end;
  123. // ------------------
  124. // ------------------ TGNotifyCollection ------------------
  125. // ------------------
  126. constructor TGNotifyCollection.Create(AOwner: TPersistent; AItemClass: TCollectionItemClass);
  127. begin
  128. inherited Create(AOwner, AItemClass);
  129. if Assigned(AOwner) and (AOwner is TGLUpdateAbleComponent) then
  130. FOnNotifyChange := TGLUpdateAbleComponent(AOwner).NotifyChange;
  131. end;
  132. procedure TGNotifyCollection.Update(Item: TCollectionItem);
  133. begin
  134. inherited;
  135. if Assigned(FOnNotifyChange) then
  136. FOnNotifyChange(Self);
  137. end;
  138. //----------------------------------------------------------------------------
  139. end.