1// SPDX-License-Identifier: LGPL-3.0-linking-exception
2
3var
4  blurRowY,blurRowX: packed array of UInt32or64;
5  iRadiusX,iRadiusY: Int32or64;
6  weightFactor: UInt32or64;
7
8  { Compute weights of pixels in a row }
9  procedure ComputeBlurRow;
10  var
11    i: Int32or64;
12    ofs: single;
13  begin
14    SetLength(blurRowX, 2*iRadiusX+1);
15    if frac(radiusX)=0 then ofs := 1 else ofs := frac(radiusX);
16    for i := 0 to iRadiusX do
17    begin
18      blurRowX[i] := round((i+ofs)*weightFactor);
19      blurRowX[high(blurRowX)-i] := blurRowX[i];
20    end;
21    SetLength(blurRowY, 2*iRadiusY+1);
22    if frac(radiusY)=0 then ofs := 1 else ofs := frac(radiusY);
23    for i := 0 to iRadiusY do
24    begin
25      blurRowY[i] := round((i+ofs)*weightFactor);
26      blurRowY[high(blurRowY)-i] := blurRowY[i];
27    end;
28  end;
29
30
31var
32  srcDelta,srcPixSize,
33  verticalWeightShift, horizontalWeightShift: Int32or64;
34  ys1,ys2: Int32or64;
35
36  { Compute blur result in a vertical direction }
37  procedure ComputeVerticalRow(psrc: PByte; var sums: TRowSum; pw: PNativeUInt; count: Int32or64);
38  begin
39    while count > 0 do
40    with sums do
41    begin
42      dec(count);
43      AccumulatePixel(psrc, pw^, sums, verticalWeightShift);
44      inc(pw);
45      inc(psrc,srcDelta);
46    end;
47  end;
48
49var
50  psum, psumEnd: PRowSum;
51  sums: packed array of TRowSum;
52  sumStartIndex: Int32or64;
53  total: TRowSum;
54  extendedTotal: TExtendedRowSum;
55  yb,xb,xs,x,xEnd: Int32or64;
56  pw: PNativeUInt;
57  psrc, pdest: PByte;
58  bmpWidth,bmpHeight : Int32or64;
59  accumulationFactor: double;
60  bounds: TRect;
61  highSum: Int32or64;
62  tempDest: TCustomUniversalBitmap;
63  destPixSize: Integer;
64
65begin
66  radiusX := round(radiusX*10)*0.1;
67  radiusY := round(radiusY*10)*0.1;
68  if (radiusX <= 0) and (radiusY <= 0) then
69  begin
70    ADestination.PutImage(0,0,bmp,dmSet);
71    exit;
72  end;
73  iRadiusX := ceil(radiusX);
74  iRadiusY := ceil(radiusY);
75  if (frac(radiusX)=0) and (frac(radiusY)=0) then
76    weightFactor:= 1
77  else
78    weightFactor:= 10;
79  bmpWidth := bmp.Width;
80  bmpHeight := bmp.Height;
81  //create output
82  if (ADestination.Width <> bmp.Width) or (ADestination.Height <> bmp.Height) then
83    raise exception.Create('Dimension mismatch');
84  bounds := bmp.GetImageBounds;
85  if bounds.IsEmpty then exit;
86  bounds.Left   := max(0, bounds.Left - iRadiusX);
87  bounds.Top    := max(0, bounds.Top - iRadiusY);
88  bounds.Right  := min(bmp.Width, bounds.Right + iRadiusX);
89  bounds.Bottom := min(bmp.Height, bounds.Bottom + iRadiusY);
90  bounds.Intersect(ABounds);
91  if bounds.IsEmpty then exit;
92
93  if radiusX*radiusY >= 100 then
94  begin
95    tempDest := ADestination.NewBitmap;
96    tempDest.SetSize(ADestination.Width,ADestination.Height);
97    FilterBlurBox(bmp,bounds,radiusX/3.2,radiusY/3.2,tempDest);
98    FilterBlurBox(tempDest,bounds,radiusX/2.9,radiusY/2.9,ADestination);
99    FilterBlurBox(ADestination,bounds,radiusX/3.2,radiusY/3.2,tempDest);
100    FilterBlurBox(tempDest,bounds,radiusX/2.3,radiusY/2.3,ADestination, ACheckShouldStop);
101    tempDest.Free;
102    exit;
103  end;
104
105  accumulationFactor := (iRadiusY+2)*(iRadiusY+1) div 2 + (iRadiusY+1)*iRadiusY div 2;
106  accumulationFactor := accumulationFactor * sqr(weightFactor);
107  verticalWeightShift := 0;
108  while accumulationFactor > (high(TRegularRowValue) shr BitMargin) + 1 do
109  begin
110    inc(verticalWeightShift);
111    accumulationFactor := accumulationFactor * 0.5;
112  end;
113  horizontalWeightShift:= 0;
114  accumulationFactor := accumulationFactor *
115         ((iRadiusX+2)*(iRadiusX+1) div 2 + (iRadiusX+1)*iRadiusX div 2) *
116         sqr(weightFactor);
117  while accumulationFactor > (high(TRegularRowValue) shr BitMargin) + 1 do
118  begin
119    inc(horizontalWeightShift);
120    accumulationFactor := accumulationFactor * 0.5;
121  end;
122  ComputeBlurRow;
123  //current vertical sums
124  setlength(sums, 2*iRadiusX+1);
125  highSum := high(Sums);
126  psumEnd := @sums[highSum];
127  inc(psumEnd);
128  if bmp.LineOrder = riloTopToBottom then
129    srcDelta := bmp.RowSize else srcDelta := -bmp.RowSize;
130  srcPixSize := bmp.Colorspace.GetSize;
131  destPixSize := ADestination.Colorspace.GetSize;
132  bmp.LoadFromBitmapIfNeeded;
133
134  xEnd := bounds.left-iRadiusX+highSum;
135  if xEnd >= bmpWidth then xEnd := bmpWidth-1;
136  //loop through destination bitmap
137  for yb := bounds.top to bounds.bottom-1 do
138  begin
139    if (ACheckShouldStop <> nil) and ACheckShouldStop(yb) then break;
140    //evalute available vertical range
141    if yb - iRadiusY < 0 then
142      ys1 := iRadiusY - yb
143    else
144      ys1 := 0;
145    if yb + iRadiusY >= bmpHeight then
146      ys2 := bmpHeight-1 - yb + iRadiusY
147    else
148      ys2 := 2*iRadiusY;
149
150    { initial vertical rows are computed here. Later,
151      for each pixel, vertical sums are shifted, so there
152      is only one vertical sum to calculate }
153    fillchar(sums[0],sizeof(TRowSum)*length(sums),0);
154    x := bounds.left-iRadiusX;
155    if x < 0 then
156    begin
157      xs := -x;
158      x := 0;
159    end else
160      xs := 0;
161    psrc := bmp.GetPixelAddress(x, yb-iRadiusY+ys1);
162    psum := @sums[xs];
163    pw := @blurRowY[ys1];
164    while true do
165    begin
166      ComputeVerticalRow(psrc,psum^,pw,ys2-ys1+1);
167      inc(x);
168      inc(psrc, srcPixSize);
169      if x > xEnd then break;
170      inc(psum);
171    end;
172    sumStartIndex := 0;
173
174    pdest := ADestination.GetPixelAddress(bounds.Left, yb);
175    for xb := bounds.left to bounds.right-1 do
176    begin
177      //add vertical rows
178      pw := @blurRowX[0];
179      psum := @sums[sumStartIndex];
180      if horizontalWeightShift > 4 then
181      begin //we don't want to loose too much precision
182        fillchar({%H-}extendedTotal,sizeof(extendedTotal),0);
183        for xs := highSum downto 0 do
184        begin
185          AccumulateExtended(extendedTotal, psum, pw^);
186          inc(pw);
187          inc(psum);
188          if psum >= psumEnd then pSum := @sums[0];
189        end;
190        ComputeExtendedAverage(extendedTotal, pdest);
191      end else
192      if horizontalWeightShift > 0 then
193      begin //lossy but efficient way
194        fillchar({%H-}total,sizeof(total),0);
195        for xs := highSum downto 0 do
196        begin
197          AccumulateShr(total, psum, pw^, horizontalWeightShift);
198          inc(pw);
199          inc(psum);
200          if psum >= psumEnd then pSum := @sums[0];
201        end;
202        ComputeClampedAverage(total, pdest);
203      end else
204      begin //normal way
205        {$hints off}
206        fillchar(total,sizeof(total),0);
207        {$hints on}
208        for xs := highSum downto 0 do
209        begin
210          AccumulateNormal(total, psum, pw^);
211          inc(pw);
212          inc(psum);
213          if psum >= psumEnd then pSum := @sums[0];
214        end;
215        ComputeAverage(total, pdest)
216      end;
217      inc(pdest, destPixSize);
218      //shift vertical rows
219      psum := @sums[sumStartIndex];
220      fillchar(psum^,sizeof(TRowSum),0);
221      if x < bmpWidth then
222      begin
223        ComputeVerticalRow(psrc,psum^,@blurRowY[ys1],ys2-ys1+1);
224        inc(x);
225        inc(psrc, srcPixSize);
226      end;
227      inc(sumStartIndex);
228      if sumStartIndex > highSum then sumStartIndex := 0;
229    end;
230  end;
231  ADestination.InvalidateBitmap;
232end;
233
234