1 // SPDX-License-Identifier: GPL-3.0-only
2 unit UFilterThread;
3
4 {$mode objfpc}{$H+}
5
6 interface
7
8 uses
9 Classes, SysUtils, BGRABitmap, BGRAFilters, UFilterConnector;
10
11 type
12 TFilterThread = class;
13
14 TThreadManagerEvent = (tmeStartingNewTask, tmeCompletedTask, tmeAbortedTask);
15 TThreadManagerEventHandler = procedure(ASender:TObject; AEvent: TThreadManagerEvent) of object;
16
17 { TFilterThreadManager }
18
19 TFilterThreadManager = class
20 private
21 FThread: TFilterThread;
22 FFilterConnector: TFilterConnector;
23 FQuitting,FCancellingPreview: boolean;
24 FNextTask: TFilterTask;
25 FOnEvent: TThreadManagerEventHandler;
26 FLastUpdatedY: integer;
GetReadyToClosenull27 function GetReadyToClose: boolean;
28 procedure StartNextTask;
29 procedure RaiseEvent(AEvent: TThreadManagerEvent);
30 protected
31 procedure OnFilterDone({%H-}ASender: TThread; {%H-}AFilteredLayer: TBGRABitmap);
32 procedure OnFilterTerminate({%H-}ASender: TObject);
33 public
34 constructor Create(AFilterConnector: TFilterConnector);
35 destructor Destroy; override;
36 procedure WantPreview(ATask: TFilterTask);
37 procedure Quit;
RegularChecknull38 function RegularCheck: boolean;
39 property Quitting: boolean read FQuitting;
40 property ReadyToClose: boolean read GetReadyToClose;
41 property CancellingPreview: boolean read FCancellingPreview;
42 property OnEvent: TThreadManagerEventHandler read FOnEvent write FOnEvent;
43 end;
44
45 TFilterThreadOnDoneHandler = procedure(ASender: TThread; AFilteredLayer: TBGRABitmap) of object;
46
47 { TFilterThread }
48
49 TFilterThread = class(TThread)
50 strict private
51 FConnector: TFilterConnector;
52 FOnDone: TFilterThreadOnDoneHandler;
53 FTask: TFilterTask;
54 FFilteredLayer: TBGRABitmap;
55 FCurrentY: integer;
56 protected
57 procedure SynchronizedOnDone;
58 procedure CallOnDone;
CheckShouldStopnull59 function CheckShouldStop(ACurrentY: integer): boolean;
CreateFilterTasknull60 function CreateFilterTask: TFilterTask; virtual; abstract;
61 public
62 constructor Create(AConnector: TFilterConnector; ASuspended: boolean);
63 procedure Execute; override;
64 destructor Destroy; override;
65 property OnFilterDone: TFilterThreadOnDoneHandler read FOnDone write FOnDone;
66 property FilteredLayer: TBGRABitmap read FFilteredLayer;
67 property FilterConnector: TFilterConnector read FConnector;
68 property CurrentY: integer read FCurrentY;
69 end;
70
71 { TSingleTaskFilterThread }
72
73 TSingleTaskFilterThread = class(TFilterThread)
74 private
75 FTask: TFilterTask;
76 protected
CreateFilterTasknull77 function CreateFilterTask: TFilterTask; override;
78 public
79 constructor Create(AFilterConnector: TFilterConnector; ATask: TFilterTask; ASuspended: boolean);
80 destructor Destroy; override;
81 end;
82
83 implementation
84
85 { TSingleTaskFilterThread }
86
TSingleTaskFilterThread.CreateFilterTasknull87 function TSingleTaskFilterThread.CreateFilterTask: TFilterTask;
88 begin
89 result := FTask;
90 FTask := nil;
91 end;
92
93 constructor TSingleTaskFilterThread.Create(AFilterConnector: TFilterConnector;
94 ATask: TFilterTask; ASuspended: boolean);
95 begin
96 FTask := ATask;
97 inherited Create(AFilterConnector,ASuspended);
98 end;
99
100 destructor TSingleTaskFilterThread.Destroy;
101 begin
102 FTask.Free;
103 inherited Destroy;
104 end;
105
106 { TFilterThreadManager }
107
108 procedure TFilterThreadManager.StartNextTask;
109 begin
110 if not Assigned(FNextTask) then exit;
111 FThread := TSingleTaskFilterThread.Create(FFilterConnector, FNextTask, True);
112 FNextTask := nil;
113 FThread.OnTerminate:= @OnFilterTerminate;
114 FThread.OnFilterDone := @OnFilterDone;
115 FThread.Start;
116 FLastUpdatedY:= 0;
117 RaiseEvent(tmeStartingNewTask);
118 end;
119
GetReadyToClosenull120 function TFilterThreadManager.GetReadyToClose: boolean;
121 begin
122 result := FQuitting and not FCancellingPreview;
123 end;
124
125 procedure TFilterThreadManager.RaiseEvent(AEvent: TThreadManagerEvent);
126 begin
127 if Assigned(FOnEvent) then FOnEvent(self,AEvent);
128 end;
129
130 procedure TFilterThreadManager.OnFilterDone(ASender: TThread;
131 AFilteredLayer: TBGRABitmap);
132 var changedBounds: TRect;
133 begin
134 if FLastUpdatedY < FFilterConnector.WorkArea.Bottom then
135 begin
136 changedBounds := rect(FFilterConnector.WorkArea.Left,FLastUpdatedY,FFilterConnector.WorkArea.Right,FFilterConnector.WorkArea.Bottom);
137 If Assigned(AFilteredLayer) then
138 FFilterConnector.PutImage(AFilteredLayer,changedBounds,False,False)
139 else
140 FFilterConnector.InvalidateActiveLayer(changedBounds);
141 FLastUpdatedY := FFilterConnector.WorkArea.Bottom;
142 end;
143 FThread := nil; //it will free itself, set it now to nil so that it cannot be cancelled
144 RaiseEvent(tmeCompletedTask);
145 end;
146
147 procedure TFilterThreadManager.OnFilterTerminate(ASender: TObject);
148 begin
149 FThread := nil; //it will free itself
150 if FCancellingPreview then
151 begin
152 if Quitting or not Assigned(FNextTask) then FFilterConnector.RestoreBackup;
153 FCancellingPreview := false;
154 RaiseEvent(tmeAbortedTask);
155 end;
156 if not Quitting then StartNextTask;
157 end;
158
159 constructor TFilterThreadManager.Create(AFilterConnector: TFilterConnector);
160 begin
161 FFilterConnector := AFilterConnector;
162 end;
163
164 destructor TFilterThreadManager.Destroy;
165 begin
166 if Assigned(FThread) then
167 raise exception.Create('Current task is not terminated');
168 inherited Destroy;
169 end;
170
171 procedure TFilterThreadManager.WantPreview(ATask: TFilterTask);
172 begin
173 if FQuitting then
174 begin
175 FreeAndNil(ATask);
176 exit;
177 end;
178 FreeAndNil(FNextTask);
179 FNextTask := ATask;
180 if Assigned(FThread) then
181 begin
182 FCancellingPreview:= true;
183 FThread.Terminate;
184 end else
185 StartNextTask;
186 end;
187
188 procedure TFilterThreadManager.Quit;
189 begin
190 FQuitting:= true;
191 if Assigned(FThread) then
192 begin
193 FCancellingPreview:= true;
194 FThread.Terminate;
195 end;
196 FreeAndNil(FNextTask);
197 end;
198
TFilterThreadManager.RegularChecknull199 function TFilterThreadManager.RegularCheck: boolean;
200 var filteredLayer: TBGRABitmap;
201 currentY: integer;
202 changedBounds: TRect;
203 begin
204 if Assigned(FThread) and not FQuitting and not FCancellingPreview then
205 begin
206 filteredLayer := (FThread as TFilterThread).FilteredLayer;
207 currentY := FThread.CurrentY;
208 if currentY >= FLastUpdatedY then
209 begin
210 changedBounds := rect(FFilterConnector.WorkArea.Left,FLastUpdatedY,FFilterConnector.WorkArea.Right,currentY);
211 if (currentY < FFilterConnector.WorkArea.Bottom) and (currentY=FLastUpdatedY) then currentY+=1;
212 if filteredLayer <> nil then
213 FFilterConnector.PutImage(filteredLayer,changedBounds,False,False)
214 else
215 FFilterConnector.InvalidateActiveLayer(changedBounds);
216 end;
217 FLastUpdatedY := currentY;
218 end else
219 if Assigned(FNextTask) then
220 begin
221 if not FCancellingPreview then StartNextTask;
222 end;
223 result := Assigned(FThread);
224 end;
225
226 { TFilterThread }
227
228 procedure TFilterThread.SynchronizedOnDone;
229 begin
230 if Assigned(FOnDone) then FOnDone(self, FFilteredLayer);
231 end;
232
233 procedure TFilterThread.CallOnDone;
234 begin
235 Synchronize(@SynchronizedOnDone);
236 end;
237
CheckShouldStopnull238 function TFilterThread.CheckShouldStop(ACurrentY: integer): boolean;
239 begin
240 FCurrentY:= ACurrentY;
241 result := Terminated;
242 end;
243
244 constructor TFilterThread.Create(AConnector: TFilterConnector;
245 ASuspended: boolean);
246 begin
247 inherited Create(True);
248 FConnector := AConnector;
249 FreeOnTerminate := True;
250 FFilteredLayer := nil;
251 if not ASuspended then Start;
252 end;
253
254 procedure TFilterThread.Execute;
255 begin
256 FCurrentY:= 0;
257 FreeAndNil(FFilteredLayer);
258 FTask := CreateFilterTask;
259 If FTask.Destination = nil then
260 begin
261 FFilteredLayer := FConnector.BackupLayer.Duplicate() as TBGRABitmap;
262 FTask.Destination := FFilteredLayer;
263 end;
264 FTask.CheckShouldStop := @CheckShouldStop;
265 try
266 FTask.Execute;
267 if not Terminated then CallOnDone;
268 finally
269 FreeAndNil(FTask);
270 end;
271 end;
272
273 destructor TFilterThread.Destroy;
274 begin
275 FreeAndNil(FFilteredLayer);
276 inherited Destroy;
277 end;
278
279
280 end.
281
282