LZScene

1
//
2
// This unit is part of the GLScene Engine https://github.com/glscene
3
//
4
{
5
   Implements a HDS Filter that generates HeightData tiles in a seperate thread.
6

7
   This component is a TGLHeightDataSourceFilter, which uses a TGLHeightDataSourceThread,
8
   to asyncronously search the HeightData cache for any queued tiles.
9
   When found, it then prepares the queued tile in its own TGLHeightDataThread.
10

11
   This allows the GUI to remain responsive, and prevents freezes when new tiles are
12
   being prepared.  Although this keeps the framerate up, it may cause holes in the
13
   terrain to show, if the HeightDataThreads cant keep up with the TerrainRenderer's
14
   requests for new tiles.
15
   
16

17
	 History :  
18
       22/04/10 - Yar - Fixes after GLState revision
19
       11/10/07 - DaStr - Added $I GLScene.inc, removed unused dependancy
20
       25/03/07 - DaStr - Replaced Dialogs with GLCrossPlatform for Delphi5 compatibility
21
       22/03/07 - LIN - Added UseDirtyTiles property - Specifies how dirty tiles are replaced.
22
       22/03/07 - LIN - Data is now prepared in 3 stages:
23
                            BeforePreparingData : (Main Thread)
24
                            PreparingData       : (Sub-Thread)   (Main Thread if MaxThreads=0)
25
                            AfterPreparingData  : (Main Thread)
26
       05/03/07 - LIN - Added ThreadCount and WaitFor
27
       12/02/07 - LIN - Creation
28
	 
29
}
30

31
unit GLAsyncHDS;
32

33
interface
34

35
{$I GLScene.inc}
36

37
uses Classes, GLHeightData, GLCrossPlatform;
38

39
type
40
  TGLAsyncHDS = class;
41
  TIdleEvent = procedure(Sender:TGLAsyncHDS;TilesUpdated:boolean) of object;
42
  TNewTilePreparedEvent = procedure (Sender : TGLAsyncHDS; heightData : TGLHeightData) of object; //a tile was updated (called INSIDE the sub-thread?)
43

44
  // TUseDirtyTiles
45
  //
46
  {  TUseDirtyTiles determines if/how dirty tiles are displayed and when they are released.
47
      
48
      TUseDirtyTiles
49
      
50
       When a tile is maked as dirty, a replacement is queued immediately.
51
       However, the replacement cant be used until the HDThread has finished preparing it.
52
       Dirty tiles can be deleted as soon as they are no longer used/displayed.
53

54
     Possible states for a TUseDirtyTiles.
55
       hdsNever :            Dirty tiles get released immediately, leaving a hole in the terrain, until the replacement is hdsReady.
56
       hdsUntilReplaced :    Dirty tiles are used, until the HDThread has finished preparing the queued replacement.
57
       hdsUntilAllReplaced : Waits until the HDSThread has finished preparing ALL queued tiles,
58
                             before allowing the renderer to switch over to the new set of tiles.
59
                             (This prevents a fading checkerbox effect.)
60
        }
61
  TUseDirtyTiles=(dtNever,dtUntilReplaced,dtUntilAllReplaced);
62

63

64
	 TGLAsyncHDS = class (TGLHeightDataSourceFilter)
65
	   private
66
	       
67
       FOnIdleEvent :TIdleEvent;
68
       FOnNewTilePrepared : TNewTilePreparedEvent;
69
       FUseDirtyTiles:TUseDirtyTiles;
70
       FTilesUpdated:boolean;
71
	   protected
72
	       
73
    public
74
      //TilesUpdated:boolean;
75
	       
76
      constructor Create(AOwner: TComponent); override;
77
      destructor Destroy; override;
78
      procedure BeforePreparingData(heightData : TGLHeightData); override;
79
      procedure StartPreparingData(heightData : TGLHeightData); override;
80
      procedure ThreadIsIdle; override;
81
      procedure NewTilePrepared(heightData:TGLHeightData);
82
      function  ThreadCount:integer;
83
      procedure WaitFor(TimeOut:integer=2000);
84
      //procedure NotifyChange(Sender : TObject); override;
85
      function  TilesUpdated:boolean;        //Returns true if tiles have been updated since the flag was last reset
86
      procedure TilesUpdatedFlagReset;       //sets the TilesUpdatedFlag to false; (is ThreadSafe)
87
	   published
88
	       
89
      property OnIdle : TIdleEvent read FOnIdleEvent write FOnIdleEvent;
90
      property OnNewTilePrepared : TNewTilePreparedEvent read FOnNewTilePrepared write FOnNewTilePrepared;
91
      property UseDirtyTiles :TUseDirtyTiles read FUseDirtyTiles write FUseDirtyTiles;
92
      property MaxThreads;         //sets the maximum number of simultaineous threads that will prepare tiles.(>1 is rarely needed)
93
      property Active;             //set to false, to ignore new queued tiles.(Partially processed tiles will still be completed)
94
  end;
95

96
  TGLAsyncHDThread = class(TGLHeightDataThread)
97
    public
98
      Owner : TGLAsyncHDS;
99
      HDS   : TGLHeightDataSource;
100
      Procedure Execute; override;
101
      Procedure Sync;
102
  end;
103

104

105
// ------------------------------------------------------------------
106
// ------------------------------------------------------------------
107
// ------------------------------------------------------------------
108
implementation
109
// ------------------------------------------------------------------
110
// ------------------------------------------------------------------
111
// ------------------------------------------------------------------
112

113
uses SysUtils;
114

115
// ------------------
116
// ------------------ TGLAsyncHDS ------------------
117
// ------------------
118

119
// Create
120
//
121
constructor TGLAsyncHDS.Create(AOwner: TComponent);
122
begin
123
	 inherited Create(AOwner);
124
  MaxThreads:=1;
125
  FUseDirtyTiles:=dtNever;
126
  FTilesUpdated:=true;
127
end;
128

129
// Destroy
130
//
131
destructor TGLAsyncHDS.Destroy;
132
begin
133
	inherited Destroy;
134
end;
135

136
// BeforePreparingData
137
//
138
procedure TGLAsyncHDS.BeforePreparingData(heightData : TGLHeightData);
139
begin
140
  if FUseDirtyTiles=dtNever then begin
141
    if heightData.OldVersion<>nil then begin
142
      heightData.OldVersion.DontUse:=true;
143
      heightData.DontUse:=false;
144
    end;
145
  end;
146
  if assigned(HeightDataSource) then HeightDataSource.BeforePreparingData(heightData);
147
end;
148

149
// StartPreparingData
150
//
151
procedure TGLAsyncHDS.StartPreparingData(heightData : TGLHeightData);
152
var HDThread : TGLAsyncHDThread;
153
    HDS:TGLHeightDataSource;
154
begin
155
  HDS:=HeightDataSource;
156
  //---if there is no linked HDS then return an empty tile--
157
  if not Assigned(HDS) then begin
158
    heightData.DataState:=hdsNone;
159
    exit;
160
  end;
161
  if (Active=false) then exit;
162

163
  //---If not using threads then prepare the HD tile directly---  (everything else freezes until done)
164
  if MaxThreads=0 then begin
165
    HDS.StartPreparingData(HeightData);
166
    if heightData.DataState=hdsPreparing
167
      then heightData.DataState:=hdsReady
168
      else heightData.DataState:=hdsNone;
169
  end else begin //--MaxThreads>0 : start the thread and go back to start the next one--
170
    heightData.DataState:=hdsPreparing; //prevent other threads from preparing this HD.
171
    HDThread:=TGLAsyncHDThread.Create(true);
172
    HDThread.Owner:=self;
173
    HDThread.HDS:=self.HeightDataSource;
174
    HDThread.HeightData:=HeightData;
175
    heightData.Thread:=HDThread;
176
    HDThread.FreeOnTerminate:=false;
177
{$IFDEF GLS_DELPHI_2009_DOWN}
178
    HDThread.Resume;
179
{$ELSE}
180
    HDThread.Start;
181
{$ENDIF}
182
  end;
183
end;
184

185

186
//OnIdle event
187
//
188
procedure TGLAsyncHDS.ThreadIsIdle;
189
var i:integer;
190
    lst:TList;
191
    HD:TGLHeightData;
192
begin
193
  //----------- dtUntilAllReplaced -------------
194
  //Switch to the new version of ALL dirty tiles
195
    lst:=self.Data.LockList;
196
    try
197
      if FUseDirtyTiles=dtUntilAllReplaced then begin
198
        i:=lst.Count;
199
        while(i>0) do begin
200
          dec(i);
201
          HD:=TGLHeightData(lst.Items[i]);
202
          if (HD.DataState in [hdsReady,hdsNone])
203
            and(Hd.DontUse)and(HD.OldVersion<>nil) then begin
204
            HD.DontUse:=false;
205
            HD.OldVersion.DontUse:=true;
206
            FTilesUpdated:=true;
207
          end;
208
        end;
209
      end;//Until All Replaced
210
      if Assigned(FOnIdleEvent) then FOnIdleEvent(Self,FTilesUpdated);
211
    finally
212
      self.Data.UnlockList;
213
    end;
214
  //--------------------------------------------
215
end;
216

217
//OnNewTilePrepared event
218
//
219
procedure TGLAsyncHDS.NewTilePrepared(heightData:TGLHeightData);
220
var HD:TGLHeightData;
221
begin
222
  if assigned(HeightDataSource) then HeightDataSource.AfterPreparingData(HeightData);
223
  with self.Data.LockList do begin
224
    try
225
      HD:=heightdata;
226
      //--------------- dtUntilReplaced -------------
227
      //Tell terrain renderer to display the new tile
228
      if (FUseDirtyTiles=dtUntilReplaced)and(HD.DontUse)and(HD.OldVersion<>nil) then begin
229
        HD.DontUse:=false;            //No longer ignore the new tile
230
        HD.OldVersion.DontUse:=true;  //Start ignoring the old tile
231
      end;
232
      //---------------------------------------------
233
      if HD.DontUse=false then FTilesUpdated:=true;
234
      if Assigned(FOnNewTilePrepared) then FOnNewTilePrepared(Self,HeightData);           //OnNewTilePrepared Event
235
    finally
236
      self.Data.UnlockList;
237
    end;
238
  end;
239
end;
240

241
//ThreadCount
242
//  Count the active threads
243
//
244
function TGLAsyncHDS.ThreadCount:integer;
245
var lst: Tlist;
246
    i,TdCtr:integer;
247
    HD:TGLHeightData;
248
begin
249
  lst:=self.Data.LockList;
250
  i:=0;TdCtr:=0;
251
  while(i<lst.Count)and(TdCtr<self.MaxThreads) do begin
252
    HD:=TGLHeightData(lst.Items[i]);
253
    if HD.Thread<>nil then Inc(TdCtr);
254
    inc(i);
255
  end;
256
  self.Data.UnlockList;
257
  result:=TdCtr;
258
end;
259

260
//WaitFor
261
//  Wait for all running threads to finish.
262
//  Should only be called after setting Active to false,
263
//  to prevent new threads from starting.
264
procedure TGLAsyncHDS.WaitFor(TimeOut:Integer=2000);
265
var OutTime:TDateTime;
266
begin
267
  Assert(self.active=false);
268
  OutTime:=now+TimeOut;
269
  While ((now<OutTime)and(ThreadCount>0)) do begin
270
    sleep(0);
271
  end;
272
  Assert(ThreadCount=0);
273
end;
274

275
{
276
procedure TGLAsyncHDS.NotifyChange(Sender : TObject);
277
begin
278
  TilesChanged:=true;
279
end;
280
}
281

282
// This function prevents the user from trying to write directly to this variable.
283
// FTilesUpdated if NOT threadsafe and should only be reset with TilesUpdatedFlagReset.
284
function TGLAsyncHDS.TilesUpdated:boolean;
285
begin
286
  result:=FTilesUpdated;
287
end;
288

289
// Set the TilesUpdatedFlag to false. (is Threadsafe)
290
procedure TGLAsyncHDS.TilesUpdatedFlagReset;
291
begin
292
  if not assigned(self) then exit; //prevents AV on Application termination.
293
  with Data.LockList do try
294
    FTilesUpdated:=False;
295
  finally Data.UnlockList; end;
296
end;
297

298
//-------------------HD Thread----------------
299
Procedure TGLAsyncHDThread.Execute;
300
Begin
301
  HDS.StartPreparingData(HeightData);
302
  HeightData.Thread:=nil;
303
  Synchronize(sync);
304
end;
305

306
Procedure TGLAsyncHDThread.Sync;
307
begin
308
  Owner.NewTilePrepared(heightData);
309
  if heightData.DataState=hdsPreparing then heightData.DataState:=hdsReady;
310
end;
311

312
//--------------------------------------------
313

314
// ------------------------------------------------------------------
315
// ------------------------------------------------------------------
316
// ------------------------------------------------------------------
317
initialization
318
// ------------------------------------------------------------------
319
// ------------------------------------------------------------------
320
// ------------------------------------------------------------------
321

322
	// class registrations
323
   RegisterClass(TGLAsyncHDS);
324

325
end.
326