1 // SPDX-License-Identifier: GPL-3.0-only
2 unit UFilterConnector;
3
4 {$mode objfpc}{$H+}
5
6 interface
7
8 uses
9 Classes, SysUtils, UImage, ULayerAction, UImageType, Forms,
10 LazPaintType, BGRABitmap, BGRABitmapTypes, uscripting;
11
12 type
13 TFilterConnector = class;
14 TFilterOnTryStopActionHandler = procedure(sender: TFilterConnector) of object;
15
16 { TFilterConnector }
17
18 TFilterConnector = class
19 private
20 FLazPaintInstance : TLazPaintCustomInstance;
21 FAction: TLayerAction;
22 FActionOwned: boolean;
23 FOnTryStopAction: TFilterOnTryStopActionHandler;
24 FWorkArea: TRect;
25 FWorkAreaFullySelected: boolean;
26 FParameters: TVariableSet;
GetActionDonenull27 function GetActionDone: boolean;
GetActiveLayeOffsetnull28 function GetActiveLayeOffset: TPoint;
GetActiveLayernull29 function GetActiveLayer: TBGRABitmap;
GetBackupLayernull30 function GetBackupLayer: TBGRABitmap;
GetCurrentSelectionnull31 function GetCurrentSelection: TBGRABitmap;
32 procedure Init(ALazPaintInstance: TLazPaintCustomInstance; AAction: TLayerAction; AOwned: boolean;
33 AParameters: TVariableSet; AApplyOfsBefore: boolean);
34 procedure OnTryStop({%H-}sender: TCustomLayerAction);
35 procedure DiscardAction;
36 procedure ApplySelectionMaskOn(AFilteredLayer: TBGRABitmap);
37 procedure ImageChanged;
38 public
39 ApplyOnSelectionLayer: boolean;
40 Form: TForm;
41 constructor Create(ALazPaintInstance : TLazPaintCustomInstance; AParameters: TVariableSet; AApplyOfsBefore: boolean);
42 constructor Create(ALazPaintInstance : TLazPaintCustomInstance; AParameters: TVariableSet; AAction: TLayerAction; AOwned: boolean);
43 destructor Destroy; override;
44 procedure ValidateAction;
45 procedure InvalidateActiveLayer; overload;
46 procedure InvalidateActiveLayer(ARect: TRect); overload;
47 procedure PutImage(AFilteredLayer: TBGRABitmap; AMayBeColored: boolean; AOwner: boolean; ADrawMode: TDrawMode = dmSet);
48 procedure PutImage(AFilteredLayer: TBGRABitmap; AModifiedRect: TRect; AMayBeColored: boolean; AOwner: boolean; ADrawMode: TDrawMode = dmSet);
49 procedure RestoreBackup;
50 property BackupLayer: TBGRABitmap read GetBackupLayer;
51 property CurrentSelection: TBGRABitmap read GetCurrentSelection;
52 property OnTryStopAction: TFilterOnTryStopActionHandler read FOnTryStopAction write FOnTryStopAction;
53 property ActionDone: boolean read GetActionDone;
54 property LazPaintInstance: TLazPaintCustomInstance read FLazPaintInstance;
55 property ActiveLayer: TBGRABitmap read GetActiveLayer;
56 property ActiveLayerOffset: TPoint read GetActiveLayeOffset;
57 property WorkArea: TRect read FWorkArea;
58 property Parameters: TVariableSet read FParameters;
59 end;
60
61 implementation
62
63 uses Types;
64
65 { TFilterConnector }
66
TFilterConnector.GetActiveLayernull67 function TFilterConnector.GetActiveLayer: TBGRABitmap;
68 begin
69 if FAction = nil then
70 result := nil
71 else if ApplyOnSelectionLayer then
72 result := FAction.GetSelectionLayerIfExists
73 else
74 result := FAction.SelectedImageLayer;
75 end;
76
GetActionDonenull77 function TFilterConnector.GetActionDone: boolean;
78 begin
79 if FAction = nil then
80 result := false
81 else
82 result := FAction.Done;
83 end;
84
GetActiveLayeOffsetnull85 function TFilterConnector.GetActiveLayeOffset: TPoint;
86 begin
87 if ApplyOnSelectionLayer then
88 result := Point(0,0)
89 else
90 result := FAction.SelectedImageLayerOffset;
91 end;
92
GetBackupLayernull93 function TFilterConnector.GetBackupLayer: TBGRABitmap;
94 begin
95 if ApplyOnSelectionLayer then
96 result := FAction.BackupSelectionLayer
97 else
98 result := FAction.BackupSelectedLayer;
99 end;
100
TFilterConnector.GetCurrentSelectionnull101 function TFilterConnector.GetCurrentSelection: TBGRABitmap;
102 begin
103 if ApplyOnSelectionLayer or FLazPaintInstance.Image.SelectionMaskEmpty then
104 result := nil
105 else
106 begin
107 result := FLazPaintInstance.Image.SelectionMaskReadonly;
108 if (result.Width <> ActiveLayer.Width) or (result.Height <> ActiveLayer.Height) then
109 result := nil;
110 end;
111 end;
112
113 procedure TFilterConnector.Init(ALazPaintInstance: TLazPaintCustomInstance; AAction: TLayerAction; AOwned: boolean;
114 AParameters: TVariableSet; AApplyOfsBefore: boolean);
115 var sel: TBGRABitmap;
116 y,x: integer;
117 p : PBGRAPixel;
118
119 begin
120 FLazPaintInstance := ALazPaintInstance;
121 FParameters := AParameters;
122 ApplyOnSelectionLayer:= not FLazPaintInstance.Image.SelectionLayerIsEmpty;
123
124 if AAction = nil then
125 AAction := ALazPaintInstance.Image.CreateAction(
126 AApplyOfsBefore and not ApplyOnSelectionLayer,
127 ApplyOnSelectionLayer);
128
129 FAction := AAction;
130 FActionOwned:= AOwned;
131 FAction.OnTryStop := @OnTryStop;
132
133 sel := CurrentSelection;
134 if sel <> nil then
135 FWorkArea := FLazPaintInstance.Image.SelectionMaskBounds
136 else
137 FWorkArea := rect(0,0,ActiveLayer.Width,ActiveLayer.Height);
138 FWorkAreaFullySelected := true;
139 if sel <> nil then
140 for y := FWorkArea.Top to FWorkArea.Bottom-1 do
141 begin
142 p := sel.ScanLine[y]+FWorkArea.Left;
143 for x := FWorkArea.Left to FWorkArea.Right-1 do
144 begin
145 if p^.green <> 255 then
146 begin
147 FWorkAreaFullySelected := false;
148 break;
149 end;
150 inc(p);
151 end;
152 if not FWorkAreaFullySelected then break;
153 end;
154 end;
155
156 procedure TFilterConnector.OnTryStop(sender: TCustomLayerAction);
157 begin
158 DiscardAction;
159 If FOnTryStopAction <> nil then FOnTryStopAction(self);
160 end;
161
162 procedure TFilterConnector.DiscardAction;
163 begin
164 if FActionOwned then
165 FreeAndNil(FAction)
166 else
167 if FAction <> nil then
168 begin
169 FAction.OnTryStop := nil;
170 FAction := nil;
171 end;
172 end;
173
174 constructor TFilterConnector.Create(ALazPaintInstance : TLazPaintCustomInstance; AParameters: TVariableSet; AApplyOfsBefore: boolean);
175 begin
176 Init(ALazPaintInstance,nil,True,AParameters,AApplyOfsBefore);
177 end;
178
179 constructor TFilterConnector.Create(ALazPaintInstance : TLazPaintCustomInstance; AParameters: TVariableSet; AAction: TLayerAction; AOwned: boolean);
180 begin
181 Init(ALazPaintInstance,AAction,AOwned,AParameters,false);
182 end;
183
184 destructor TFilterConnector.Destroy;
185 begin
186 DiscardAction;
187 inherited Destroy;
188 end;
189
190 procedure TFilterConnector.ValidateAction;
191 begin
192 FAction.Validate;
193 end;
194
195 procedure TFilterConnector.InvalidateActiveLayer;
196 begin
197 InvalidateActiveLayer(FWorkArea);
198 end;
199
200 procedure TFilterConnector.InvalidateActiveLayer(ARect: TRect);
201 begin
202 if IntersectRect(ARect, ARect, FWorkArea) then
203 begin
204 with FLazPaintInstance.Image.LayerOffset[FLazPaintInstance.Image.CurrentLayerIndex] do
205 OffsetRect(ARect, X,Y);
206 FLazPaintInstance.NotifyImageChange(True, ARect);
207 end;
208 end;
209
210 procedure TFilterConnector.PutImage(AFilteredLayer: TBGRABitmap; AMayBeColored: boolean; AOwner: boolean; ADrawMode: TDrawMode);
211 begin
212 PutImage(AFilteredLayer,FWorkArea,AMayBeColored,AOwner,ADrawMode);
213 end;
214
215 procedure TFilterConnector.PutImage(AFilteredLayer: TBGRABitmap;
216 AModifiedRect: TRect; AMayBeColored: boolean; AOwner: boolean; ADrawMode: TDrawMode);
217 var AMine: boolean;
218 imgRect: TRect;
219 begin
220 if IntersectRect(AModifiedRect,AModifiedRect,FWorkArea) then
221 begin
222 AMine := AOwner;
223 if AMayBeColored and LazPaintInstance.BlackAndWhite then
224 begin
225 if not AMine then
226 begin
227 AFilteredLayer := AFilteredLayer.Duplicate as TBGRABitmap;
228 AMine := true;
229 end;
230 AFilteredLayer.InplaceGrayscale(AModifiedRect);
231 end;
232 if not FWorkAreaFullySelected then
233 begin
234 if not AMine then
235 begin
236 AFilteredLayer := AFilteredLayer.Duplicate as TBGRABitmap;
237 AMine := true;
238 end;
239 ApplySelectionMaskOn(AFilteredLayer);
240 end;
241 ActiveLayer.PutImagePart(AModifiedRect.Left,AModifiedRect.Top,AFilteredLayer,AModifiedRect,ADrawMode);
242 if AMine then AFilteredLayer.Free;
243 imgRect := AModifiedRect;
244 with ActiveLayerOffset do
245 OffsetRect(imgRect, X,Y);
246 FLazPaintInstance.NotifyImageChange(True, imgRect);
247 end;
248 end;
249
250 procedure TFilterConnector.RestoreBackup;
251 var oldClip: TRect;
252 begin
253 if not IsRectEmpty(FWorkArea) then
254 begin
255 oldClip := ActiveLayer.ClipRect;
256 ActiveLayer.ClipRect := FWorkArea;
257 ActiveLayer.PutImage(0,0,BackupLayer,dmSet);
258 ActiveLayer.ClipRect := oldClip;
259 FLazPaintInstance.NotifyImageChange(False, FWorkArea);
260 end;
261 end;
262
263 procedure TFilterConnector.ImageChanged;
264 begin
265 FLazPaintInstance.NotifyImageChangeCompletely(True);
266 end;
267
268 procedure TFilterConnector.ApplySelectionMaskOn(AFilteredLayer: TBGRABitmap);
269 var
270 curSel: TBGRABitmap;
271 pfiltered,psource,pselection: PBGRAPixel;
272 n: integer;
273 alpha: byte;
274 begin
275 curSel := CurrentSelection;
276 if curSel <> nil then
277 begin
278 if (curSel.Width = AFilteredLayer.Width) and
279 (curSel.Height = AFilteredLayer.Height) and
280 (AFilteredLayer.Width = ActiveLayer.Width) and (AFilteredLayer.Height = ActiveLayer.Height) then
281 begin
282 pfiltered := AFilteredLayer.data;
283 psource := BackupLayer.data;
284 pselection:= curSel.data;
285 for n := AFilteredLayer.NbPixels-1 downto 0 do
286 begin
287 alpha := pselection^.green;
288 if alpha = 0 then
289 pfiltered^ := psource^
290 else if alpha <> 255 then
291 pfiltered^ := MergeBGRAWithGammaCorrection(pfiltered^,alpha,psource^,not alpha);
292 inc(pfiltered);
293 inc(psource);
294 inc(pselection);
295 end;
296 end;
297 end;
298 end;
299
300 end.
301
302