LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   Time based events mannager using the Cadencer
6
   can be useful to make animations with GlScene
7

8
	 History :  
9
       07/01/10 - DaStr - Added TGLTimeEventsMGR.Reset()
10
                             Fixed code formating
11
       25/11/09 - DanB - Changed TTimeEvent.Name from ShortString to String
12
       11/10/07 - DaStr - TTimeEvent.SetEnabled now updates StartTime to
13
                             Cadencers's current time.
14
                             (Thanks Lukasz Sokol) (BugTracker ID = 1811141)
15
       28/03/07 - DaStr - Cosmetic fix for FPC compatibility
16
       29/01/07 - DaStr - Moved registration to GLSceneRegister.pas
17
       07/02/02 - EG - Added Notification, DoEvent, ElapsedTime and changed Event type
18
}
19

20
unit GLTimeEventsMgr;
21

22
interface
23

24
uses
25
  Classes, SysUtils,
26
  GLCadencer,  GLBaseClasses;
27

28
type
29

30
    TTimeEvent = class;
31
    TTimeEvents = class;
32

33
	// TGLTimeEventsMGR
34
	//
35
   TGLTimeEventsMGR = class(TGLUpdateAbleComponent)
36
   private
37
       
38
      FCadencer : TGLCadencer;
39
      FEnabled : boolean;
40
      FFreeEventOnEnd : boolean;
41
      FEvents : TTimeEvents;
42

43
   protected
44
      { Déclarations protégées }
45
      procedure Notification(AComponent: TComponent; Operation: TOperation); override;
46

47
      procedure SetCadencer(const val : TGLCadencer);
48
      procedure SetEvents(const val : TTimeEvents);
49

50
   public
51
       
52
      constructor Create(aOwner : TComponent); override;
53
      destructor Destroy; override;
54

55
      procedure DoProgress(const progressTime : TProgressTimes); override;
56
      procedure Reset();
57

58
   published
59
      { Déclarations publiées }
60
      property Cadencer : TGLCadencer read FCadencer write SetCadencer;
61
      property Enabled : boolean read FEnabled write FEnabled default True;
62
      property FreeEventOnEnd : boolean read FFreeEventOnEnd write FFreeEventOnEnd default False;
63
      property Events : TTimeEvents read FEvents write SetEvents;
64
   end;
65

66
	// TTimeEvents
67
	//
68
	TTimeEvents = class (TCollection)
69
   protected
70
       
71
      Owner : TComponent;
72
      function GetOwner: TPersistent; override;
73
      procedure SetItems(index : Integer; const val : TTimeEvent);
74
      function GetItems(index : Integer) : TTimeEvent;
75

76
   public
77
       
78
      constructor Create(AOwner : TComponent);
79

80
      function Add: TTimeEvent;
81
      function FindItemID(ID: Integer): TTimeEvent;
82
      function EventByName(name:String): TTimeEvent;
83

84
      property Items[index : Integer] : TTimeEvent read GetItems write SetItems; default;
85
   end;
86

87
   TTimeEventType = (etOneShot, etContinuous, etPeriodic);
88
   TTimeEventProc = procedure (event : TTimeEvent) of object;
89

90
   // TTimeEvent
91
   //
92
   TTimeEvent = class (TCollectionItem)
93
      private
94
          
95
         FName: String;
96
         FStartTime, FEndTime, FElapsedTime : Double;
97
         FPeriod : Double;
98
         FEventType: TTimeEventType;
99
         FOnEvent:TTimeEventProc;
100
         FEnabled: boolean;
101

102
         FTickCount : Cardinal;
103
         procedure SetEnabled(const Value: Boolean);
104

105
      protected
106
          
107
         function GetDisplayName : String; override;
108
         procedure SetName(val : String);
109

110
         procedure DoEvent(const curTime : Double);
111

112
      public
113
          
114
         constructor Create(Collection : TCollection); override;
115
         destructor Destroy; override;
116

117
         // Number of times the event was triggered since activation
118
         property TickCount : Cardinal read FTickCount;
119
         // Elapsed time since the event was activated
120
         property ElapsedTime : Double read FElapsedTime; 
121

122
      published
123
          
124
         property Name : String read FName write SetName;
125
         property StartTime : Double read FStartTime write FStartTime;
126
         property EndTime : Double read FEndTime write FEndTime;
127
         property Period : Double read  FPeriod write FPeriod;
128
         property EventType : TTimeEventType read FEventType write FEventType default etOneShot;
129
         property OnEvent : TTimeEventProc read FOnEvent write FOnEvent;
130
         property Enabled : Boolean read FEnabled write SetEnabled  default True;
131

132
    end;
133

134
implementation
135

136
// ------------------
137
// ------------------ TGLTimeEventsMGR ------------------
138
// ------------------
139

140
// Create
141
//
142
constructor TGLTimeEventsMGR.Create(aOwner : TComponent);
143
begin
144
    inherited;
145
    FEnabled:=True;
146
    FFreeEventOnEnd:=False;
147
    FEvents:=TTimeEvents.Create(self);
148
end;
149

150
// Destroy
151
//
152
destructor TGLTimeEventsMGR.Destroy;
153
begin
154
    Cadencer:=nil;
155
    FEvents.Free;
156
    inherited Destroy;
157
end;
158

159
// Notification
160
//
161
procedure TGLTimeEventsMGR.Notification(AComponent: TComponent; Operation: TOperation);
162
begin
163
   if (Operation=opRemove) and (AComponent=Cadencer) then
164
      FCadencer:=nil;
165
   inherited;
166
end;
167

168
// SetCadencer
169
//
170
procedure TGLTimeEventsMGR.SetCadencer(const val : TGLCadencer);
171
begin
172
   if FCadencer<>val then begin
173
      if Assigned(FCadencer) then
174
         FCadencer.UnSubscribe(Self);
175
      FCadencer:=val;
176
      if Assigned(FCadencer) then
177
         FCadencer.Subscribe(Self);
178
   end;
179
end;
180

181

182
// SetEvents
183
//
184
procedure TGLTimeEventsMGR.SetEvents(const val : TTimeEvents);
185
begin
186
   FEvents.Assign(val);
187
end;
188

189
// DoProgress
190
//
191
procedure TGLTimeEventsMGR.DoProgress(const progressTime : TProgressTimes);
192
var
193
   i : Integer;
194
begin
195
   if not Enabled then Exit;
196

197
   i:=0;
198
   with progressTime do while i<=Events.Count-1 do with Events.Items[i] do begin
199
      if Enabled and Assigned(FOnEvent) then begin
200
         case EventType of
201
            etOneShot :
202
               if (newTime>=StartTime) and (TickCount=0) then
203
                  DoEvent(newTime);
204
            etContinuous :
205
               if (newTime>=StartTime) and ((newTime<=EndTime) or (EndTime<=0)) then
206
                  DoEvent(newTime);
207
            etPeriodic :
208
               if (newTime>=StartTime+TickCount*Period) and ((newTime<=EndTime) or (EndTime<=0)) then
209
                  DoEvent(newTime);
210
         else
211
            Assert(False);
212
         end;
213
      end;
214
      if FreeEventOnEnd and
215
           ( ((EventType<>etOneShot) and (newTime>EndTime) and (EndTime>=0)) or
216
             ((EventType=etOneShot) and (TickCount>0)) ) then
217
         Events[i].Free
218
      else begin
219
         // if we delete current event, the next will have same index
220
         // so increment only if we don't delete
221
         Inc(i);
222
      end;
223
   end;
224
end;
225

226
// Reset
227
//
228
procedure TGLTimeEventsMGR.Reset;
229
var
230
  I: Integer;
231
begin
232
  if FEvents.Count <> 0 then
233
    for I := 0 to FEvents.Count - 1 do
234
      FEvents[I].FTickCount := 0;
235
end;
236

237

238
// ------------------
239
// ------------------ TTimeEvents ------------------
240
// ------------------
241

242
// Create
243
//
244
constructor TTimeEvents.Create(AOwner : TComponent);
245
begin
246
	Owner:=AOwner;
247
	inherited Create(TTimeEvent);
248
end;
249

250
// GetOwner
251
//
252
function TTimeEvents.GetOwner: TPersistent;
253
begin
254
	Result:=Owner;
255
end;
256

257
// Setitems
258
//
259
procedure TTimeEvents.SetItems(index : Integer; const val : TTimeEvent);
260
begin
261
	inherited Items[index]:=val;
262
end;
263

264
// GetItems
265
//
266
function TTimeEvents.GetItems(index : Integer) : TTimeEvent;
267
begin
268
	Result:=TTimeEvent(inherited Items[index]);
269
end;
270

271
// Add
272
//
273
function TTimeEvents.Add : TTimeEvent;
274
begin
275
	Result:=(inherited Add) as TTimeEvent;
276
end;
277

278
// FindItemID
279
//
280
function TTimeEvents.FindItemID(ID: Integer): TTimeEvent;
281
begin
282
	Result:=(inherited FindItemID(ID)) as TTimeEvent;
283
end;
284

285
// EventByName
286
//
287
function TTimeEvents.EventByName(name:String): TTimeEvent;
288
var i:integer;
289
begin
290
    i:=0;
291
    while (i<Count) and (Items[i].FName<>name) do inc(i);
292

293
    if i=Count then result:=nil else result:=Items[i];
294
end;
295

296

297

298

299
// ------------------
300
// ------------------ TTimeEvent ------------------
301
// ------------------
302

303
// Create
304
//
305
constructor TTimeEvent.Create(Collection : TCollection);
306
begin
307
   inherited Create(Collection);
308
   FEventType:=etOneShot;
309
   FName:=Format('Event%d', [index]); // give a default name different for each event
310
   FEnabled:=True;
311
end;
312

313
// Destroy
314
//
315
destructor TTimeEvent.Destroy;
316
begin
317
    inherited Destroy;
318
end;
319

320
// GetDisplayName
321
//
322
function TTimeEvent.GetDisplayName : String;
323
begin
324
    case EventType of
325
        etOneShot:
326
            Result:=Name+Format(' (OneShot ST=%g)',[StartTime]);
327
        etContinuous:
328
            Result:=Name+Format(' (Continuous ST=%g ET=%g)',[StartTime,EndTime]);
329
        etPeriodic:
330
            Result:=Name+Format(' (Periodic ST=%g ET=%g P=%g)',[StartTime,EndTime,Period]);
331
    end;
332
end;
333

334
// SetName
335
//
336
procedure TTimeEvent.SetName(val : String);
337
var
338
   i : Integer;
339
   ok : Boolean;
340
begin
341
   ok := True;
342
   with self.Collection as TTimeEvents do // we mustn't have 2 events with the same name (for EventByName)
343
       for i:=0 to Count-1 do
344
           if Items[i].FName = val then Ok := False;
345

346
   if Ok and (val<>'') then FName:=val;
347
end;
348

349
// DoEvent
350
//
351
procedure TTimeEvent.DoEvent(const curTime : Double);
352
begin
353
   if Assigned(FOnEvent) then begin
354
      FElapsedTime:=curTime-StartTime;
355
      FOnEvent(Self);
356
   end;
357
   Inc(FTickCount);
358
end;
359

360
// SetEnabled
361
//
362
procedure TTimeEvent.SetEnabled(const Value: Boolean);
363
begin
364
  FEnabled := Value;
365
  FStartTime := ((GetOwner as TTimeEvents).Owner as TGLTimeEventsMGR).Cadencer.CurrentTime;
366
end;
367

368
end.
369