// / // The graphics engine GLXEngine. The unit of GXScene for Delphi // unit GXS.AsyncHDS; (* Implements a HDS Filter that generates HeightData tiles in a seperate thread. This component is a TgxHeightDataSourceFilter, which uses a TgxHeightDataSourceThread, to asyncronously search the HeightData cache for any queued tiles. When found, it then prepares the queued tile in its own TgxHeightDataThread. This allows the GUI to remain responsive, and prevents freezes when new tiles are being prepared. Although this keeps the framerate up, it may cause holes in the terrain to show, if the HeightDataThreads cant keep up with the TerrainRenderer's requests for new tiles. *) interface {$I Stage.Defines.inc} uses System.Classes, System.SysUtils, GXS.HeightData; type TgxAsyncHDS = class; TIdleEvent = procedure(Sender: TgxAsyncHDS; TilesUpdated: boolean) of object; TNewTilePreparedEvent = procedure(Sender: TgxAsyncHDS; HeightData: TgxHeightData) of object; // a tile was updated (called INSIDE the sub-thread?) (* Determines if/how dirty tiles are displayed and when they are released. When a tile is maked as dirty, a replacement is queued immediately. However, the replacement cant be used until the HDThread has finished preparing it. Dirty tiles can be deleted as soon as they are no longer used/displayed. Possible states for a TUseDirtyTiles. hdsNever : Dirty tiles get released immediately, leaving a hole in the terrain, until the replacement is hdsReady. hdsUntilReplaced : Dirty tiles are used, until the HDThread has finished preparing the queued replacement. hdsUntilAllReplaced : Waits until the HDSThread has finished preparing ALL queued tiles, before allowing the renderer to switch over to the new set of tiles. (This prevents a fading checkerbox effect.) *) TUseDirtyTiles=(dtNever,dtUntilReplaced,dtUntilAllReplaced); TgxAsyncHDS = class(TgxHeightDataSourceFilter) private FOnIdleEvent: TIdleEvent; FOnNewTilePrepared: TNewTilePreparedEvent; FUseDirtyTiles: TUseDirtyTiles; FTilesUpdated: boolean; public // TilesUpdated:boolean; constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure BeforePreparingData(HeightData: TgxHeightData); override; procedure StartPreparingData(HeightData: TgxHeightData); override; procedure ThreadIsIdle; override; procedure NewTilePrepared(HeightData: TgxHeightData); function ThreadCount: integer; (* Wait for all running threads to finish. Should only be called after setting Active to false, to prevent new threads from starting. *) procedure WaitFor(TimeOut: integer = 2000); // procedure NotifyChange(Sender : TObject); override; (* This function prevents the user from trying to write directly to this variable. FTilesUpdated if NOT threadsafe and should only be reset with TilesUpdatedFlagReset. *) function TilesUpdated: boolean; // Returns true if tiles have been updated since the flag was last reset procedure TilesUpdatedFlagReset; // sets the TilesUpdatedFlag to false; (is ThreadSafe) published property OnIdle: TIdleEvent read FOnIdleEvent write FOnIdleEvent; property OnNewTilePrepared: TNewTilePreparedEvent read FOnNewTilePrepared write FOnNewTilePrepared; property UseDirtyTiles: TUseDirtyTiles read FUseDirtyTiles write FUseDirtyTiles; property MaxThreads; // sets the maximum number of simultaineous threads that will prepare tiles.(>1 is rarely needed) property Active; // set to false, to ignore new queued tiles.(Partially processed tiles will still be completed) end; TgxAsyncHDThread = class(TgxHeightDataThread) public Owner: TgxAsyncHDS; HDS: TgxHeightDataSource; Procedure Execute; override; Procedure Sync; end; // ------------------------------------------------------------------ implementation // ------------------------------------------------------------------ // ------------------ // ------------------ TgxAsyncHDS ------------------ // ------------------ constructor TgxAsyncHDS.Create(AOwner: TComponent); begin inherited Create(AOwner); MaxThreads := 1; FUseDirtyTiles := dtNever; FTilesUpdated := true; end; destructor TgxAsyncHDS.Destroy; begin inherited Destroy; end; procedure TgxAsyncHDS.BeforePreparingData(HeightData: TgxHeightData); begin if FUseDirtyTiles = dtNever then begin if HeightData.OldVersion <> nil then begin HeightData.OldVersion.DontUse := true; HeightData.DontUse := false; end; end; if assigned(HeightDataSource) then HeightDataSource.BeforePreparingData(HeightData); end; procedure TgxAsyncHDS.StartPreparingData(HeightData: TgxHeightData); var HDThread: TgxAsyncHDThread; HDS: TgxHeightDataSource; begin HDS := HeightDataSource; // ---if there is no linked HDS then return an empty tile-- if not assigned(HDS) then begin HeightData.DataState := hdsNone; exit; end; if (Active = false) then exit; // ---If not using threads then prepare the HD tile directly--- (everything else freezes until done) if MaxThreads = 0 then begin HDS.StartPreparingData(HeightData); if HeightData.DataState = hdsPreparing then HeightData.DataState := hdsReady else HeightData.DataState := hdsNone; end else begin // --MaxThreads>0 : start the thread and go back to start the next one-- HeightData.DataState := hdsPreparing; // prevent other threads from preparing this HD. HDThread := TgxAsyncHDThread.Create(true); HDThread.Owner := self; HDThread.HDS := self.HeightDataSource; HDThread.HeightData := HeightData; HeightData.Thread := HDThread; HDThread.FreeOnTerminate := false; HDThread.Start; end; end; procedure TgxAsyncHDS.ThreadIsIdle; var i: integer; lst: TList; HD: TgxHeightData; begin // ----------- dtUntilAllReplaced ------------- // Switch to the new version of ALL dirty tiles lst := self.Data.LockList; try if FUseDirtyTiles = dtUntilAllReplaced then begin i := lst.Count; while (i > 0) do begin dec(i); HD := TgxHeightData(lst.Items[i]); if (HD.DataState in [hdsReady, hdsNone]) and (HD.DontUse) and (HD.OldVersion <> nil) then begin HD.DontUse := false; HD.OldVersion.DontUse := true; FTilesUpdated := true; end; end; end; // Until All Replaced if assigned(FOnIdleEvent) then FOnIdleEvent(self, FTilesUpdated); finally self.Data.UnlockList; end; // -------------------------------------------- end; procedure TgxAsyncHDS.NewTilePrepared(HeightData: TgxHeightData); var HD: TgxHeightData; begin if assigned(HeightDataSource) then HeightDataSource.AfterPreparingData(HeightData); with self.Data.LockList do begin try HD := HeightData; // --------------- dtUntilReplaced ------------- // Tell terrain renderer to display the new tile if (FUseDirtyTiles = dtUntilReplaced) and (HD.DontUse) and (HD.OldVersion <> nil) then begin HD.DontUse := false; // No longer ignore the new tile HD.OldVersion.DontUse := true; // Start ignoring the old tile end; // --------------------------------------------- if HD.DontUse = false then FTilesUpdated := true; if assigned(FOnNewTilePrepared) then FOnNewTilePrepared(self, HeightData); // OnNewTilePrepared Event finally self.Data.UnlockList; end; end; end; function TgxAsyncHDS.ThreadCount: integer; var lst: TList; i, TdCtr: integer; HD: TgxHeightData; begin lst := self.Data.LockList; i := 0; TdCtr := 0; while (i < lst.Count) and (TdCtr < self.MaxThreads) do begin HD := TgxHeightData(lst.Items[i]); if HD.Thread <> nil then Inc(TdCtr); Inc(i); end; self.Data.UnlockList; result := TdCtr; end; procedure TgxAsyncHDS.WaitFor(TimeOut: integer = 2000); var OutTime: TDateTime; begin Assert(self.Active = false); OutTime := now + TimeOut; While ((now < OutTime) and (ThreadCount > 0)) do begin sleep(0); end; Assert(ThreadCount = 0); end; { procedure TgxAsyncHDS.NotifyChange(Sender : TObject); begin TilesChanged:=true; end; } function TgxAsyncHDS.TilesUpdated: boolean; begin result := FTilesUpdated; end; // Set the TilesUpdatedFlag to false. (is Threadsafe) procedure TgxAsyncHDS.TilesUpdatedFlagReset; begin if not assigned(self) then exit; // prevents AV on Application termination. with Data.LockList do try FTilesUpdated := false; finally Data.UnlockList; end; end; // -------------------HD Thread---------------- Procedure TgxAsyncHDThread.Execute; Begin HDS.StartPreparingData(HeightData); HeightData.Thread := nil; Synchronize(Sync); end; Procedure TgxAsyncHDThread.Sync; begin Owner.NewTilePrepared(HeightData); if HeightData.DataState = hdsPreparing then HeightData.DataState := hdsReady; end; // ------------------------------------------------------------------ initialization // ------------------------------------------------------------------ RegisterClass(TgxAsyncHDS); end.