From cb547e36746f4fa9f4b9f710c67b8b1babc6091e Mon Sep 17 00:00:00 2001 From: Olly Date: Sun, 15 Oct 2023 02:29:20 +0100 Subject: [PATCH] TSimbaImage: Add approximated gaussian blur (in linear time) --- Source/image/simba.image.pas | 61 +++++- Source/image/simba.image_gaussblur.pas | 180 ++++++++++++++++++ .../simbaclasses/simba.import_class_image.pas | 23 ++- 3 files changed, 254 insertions(+), 10 deletions(-) create mode 100644 Source/image/simba.image_gaussblur.pas diff --git a/Source/image/simba.image.pas b/Source/image/simba.image.pas index c7a241dd6..513446254 100644 --- a/Source/image/simba.image.pas +++ b/Source/image/simba.image.pas @@ -177,7 +177,8 @@ TSimbaImage = class(TSimbaBaseClass) function Posterize(Value: Integer): TSimbaImage; function Convolute(Matrix: TDoubleMatrix): TSimbaImage; function Mirror(Style: ESimbaImageMirrorStyle): TSimbaImage; - function Blur(Block: Integer): TSimbaImage; + function BlockBlur(Block: Integer): TSimbaImage; + function GaussBlur(Radius: Double): TSimbaImage; function Blend(Points: TPointArray; Radius: Integer): TSimbaImage; function Downsample(Scale: Integer): TSimbaImage; @@ -233,7 +234,7 @@ implementation simba.arraybuffer, simba.geometry, simba.tpa, simba.encoding, simba.compress, simba.nativeinterface, simba.singlematrix, - simba.image_lazbridge, simba.rgbsumtable, simba.image_integral; + simba.image_lazbridge, simba.rgbsumtable, simba.image_integral, simba.image_gaussblur; function GetDistinctColor(const Color, Index: Integer): Integer; inline; const @@ -1704,7 +1705,7 @@ function TSimbaImage.Posterize(Value: Integer): TSimbaImage; end; end; -function TSimbaImage.Blur(Block: Integer): TSimbaImage; +function TSimbaImage.BlockBlur(Block: Integer): TSimbaImage; var X, Y, W, H: Integer; Size: Integer; @@ -1716,7 +1717,7 @@ function TSimbaImage.Blur(Block: Integer): TSimbaImage; Size := Sqr(Block); if (Size <= 1) or (not Odd(Size)) then - SimbaException('TSimbaImage.Blur: Block(%d) must be a odd number (1,3,7,etc)', [Block]); + SimbaException('TSimbaImage.BlockBlur: Block(%d) must be a odd number (1,3,7,etc)', [Block]); Color := Default(TColorBGRA); Block := Block div 2; @@ -1825,6 +1826,58 @@ function TSimbaImage.Mirror(Style: ESimbaImageMirrorStyle): TSimbaImage; end; end; +function TSimbaImage.GaussBlur(Radius: Double): TSimbaImage; +var + r,g,b: TByteArray; + i: Integer; + ptr: PColorBGRA; + ptrR, ptrG, ptrB: PByte; +begin + Result := TSimbaImage.Create(FWidth, FHeight); + if (FWidth = 0) or (FHeight = 0) then + Exit; + + SetLength(r, FWidth*FHeight); + SetLength(g, FWidth*FHeight); + SetLength(b, FWidth*FHeight); + + ptr := FData; + ptrR := @r[0]; + ptrG := @g[0]; + ptrB := @b[0]; + + for i := 0 to (FWidth * FHeight) - 1 do + begin + ptrR^ := ptr^.R; + ptrG^ := ptr^.G; + ptrB^ := ptr^.B; + + Inc(ptr); + Inc(ptrR); + Inc(ptrG); + Inc(ptrB); + end; + + imgGaussBlur(Radius, r,g,b, FWidth, FHeight); + + ptr := Result.FData; + ptrR := @r[0]; + ptrG := @g[0]; + ptrB := @b[0]; + + for i := 0 to (FWidth * FHeight) - 1 do + begin + ptr^.R := ptrR^; + ptr^.G := ptrG^; + ptr^.B := ptrB^; + + Inc(ptr); + Inc(ptrR); + Inc(ptrG); + Inc(ptrB); + end; +end; + function TSimbaImage.Blend(Points: TPointArray; Radius: Integer): TSimbaImage; var P: TPoint; diff --git a/Source/image/simba.image_gaussblur.pas b/Source/image/simba.image_gaussblur.pas new file mode 100644 index 000000000..ebdfa73a4 --- /dev/null +++ b/Source/image/simba.image_gaussblur.pas @@ -0,0 +1,180 @@ +// https://blog.ivank.net/fastest-gaussian-blur.html +unit simba.image_gaussblur; + +{$i simba.inc} + +interface + +uses + Classes, SysUtils, + simba.mufasatypes; + +procedure imgGaussBlur(radius: Double; var r,g,b: TByteArray; width, height: Integer); + +implementation + +uses + Math; + +function boxesForGauss(sigma: Double; n: Integer): TIntegerArray; +var + wIdeal: Double; + wl, wu: Integer; + mIdeal, m: Double; + i: Integer; +begin + wIdeal := Sqrt((12 * sigma * sigma / n) + 1); // Ideal averaging filter width + wl := Floor(wIdeal); + if (wl mod 2 = 0) then + wl := wl - 1; + wu := wl + 2; + + mIdeal := (12 * sigma * sigma - n * wl * wl - 4 * n * wl - 3 * n) / (-4 * wl - 4); + m := Round(mIdeal); + + SetLength(Result, n); + for i := 0 to n - 1 do + begin + if i < m then + Result[i] := wl + else + Result[i] := wu; + end; +end; + +procedure boxBlurH_4(var scl, tcl: TByteArray; w, h: Integer; r: Integer); +var + iarr: Double; + i,j: Integer; + ti, li, ri, fv, lv: Integer; + val: Double; +begin + iarr := 1.0 / (r + r + 1); + + for i := 0 to h-1 do + begin + ti := i * w; + li := ti; + ri := Round(ti + r); + fv := scl[ti]; + lv := scl[ti + w - 1]; + val := (r + 1) * fv; + + for j := 0 to r-1 do + val += scl[ti + j]; + + for j := 0 to r do + begin + val += scl[ri] - fv; + inc(ri); + tcl[ti] := Round(val * iarr); + Inc(ti); + end; + + for j := r + 1 to (w - r) - 1 do + begin + val += scl[ri] - scl[li]; + inc(ri); + inc(li); + tcl[ti] := Round(val * iarr); + inc(ti); + end; + + for j := w - r to w-1 do + begin + val += lv - scl[li]; + inc(li); + tcl[ti] := Round(val * iarr); + inc(ti); + end; + end; +end; + +procedure boxBlurT_4(var scl, tcl: TByteArray; w, h: Integer; r: Integer); +var + iarr: Double; + i,j: Integer; + ti, li, ri, fv, lv: Integer; + val: Double; +begin + iarr := 1.0 / (r + r + 1); + + for i := 0 to w-1 do + begin + ti := i; + li := ti; + ri := round(ti + r * w); + fv := scl[ti]; + lv := scl[ti + w * (h - 1)]; + val := (r + 1) * fv; + + for j := 0 to r-1 do + val += scl[ti + j * w]; + + for j := 0 to r do + begin + val += scl[ri] - fv; + tcl[ti] := Round(val * iarr); + ri += w; + ti += w; + end; + + for j := r + 1 to (h - r) - 1 do + begin + val += scl[ri] - scl[li]; + tcl[ti] := round(val * iarr); + li += w; + ri += w; + ti += w; + end; + + for j := h - r to h-1 do + begin + val += lv - scl[li]; + tcl[ti] := round(val * iarr); + li += w; + ti += w; + end; + end; +end; + +procedure boxBlur_4(var scl, tcl: TByteArray; w,h: Integer; r: Integer); +var + i: Integer; +begin + for i:=0 to High(scl) do + tcl[i] := scl[i]; + + boxBlurH_4(tcl, scl, w, h, r); + boxBlurT_4(scl, tcl, w, h, r); +end; + +procedure gaussBlur_4(var scl, tcl: TByteArray; w,h: Integer; r: Double; bxs: TIntegerArray); +begin + boxBlur_4(scl, tcl, w, h, (bxs[0] - 1) div 2); + boxBlur_4(tcl, scl, w, h, (bxs[1] - 1) div 2); + boxBlur_4(scl, tcl, w, h, (bxs[2] - 1) div 2); +end; + +procedure imgGaussBlur(radius: Double; var r, g, b: TByteArray; width, height: Integer); +var + outR, outG, outB: TByteArray; + boxes: TIntegerArray; +begin + SetLength(outR, Length(r)); + SetLength(outG, Length(g)); + SetLength(outB, Length(b)); + + boxes := boxesForGauss(radius, 3); + + gaussBlur_4(r, outR, width, height-1, radius, boxes); + gaussBlur_4(g, outG, width, height, radius, boxes); + gaussBlur_4(b, outB, width, height, radius, boxes); + + r := outR; + g := outG; + b := outB; +end; + +end. + diff --git a/Source/script/imports/simbaclasses/simba.import_class_image.pas b/Source/script/imports/simbaclasses/simba.import_class_image.pas index 813dd4af1..33ecde622 100644 --- a/Source/script/imports/simbaclasses/simba.import_class_image.pas +++ b/Source/script/imports/simbaclasses/simba.import_class_image.pas @@ -515,13 +515,23 @@ procedure _LapeImage_GetPixels(const Params: PParamArray; const Result: Pointer) end; (* -TImage.Blur -~~~~~~~~~~~ -> function TImage.Blur(Block: Integer): TImage; +TImage.BlockBlur +~~~~~~~~~~~~~~~~ +> function TImage.BlockBlur(Block: Integer): TImage; +*) +procedure _LapeImage_BlockBlur(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +begin + PSimbaImage(Result)^ := PSimbaImage(Params^[0])^.BlockBlur(PInteger(Params^[1])^); +end; + +(* +TImage.GaussBlur +~~~~~~~~~~~~~~~~ +> function TImage.GaussBlur(Radius: Double): TImage; *) -procedure _LapeImage_Blur(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV +procedure _LapeImage_GaussBlur(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV begin - PSimbaImage(Result)^ := PSimbaImage(Params^[0])^.Blur(PInteger(Params^[1])^); + PSimbaImage(Result)^ := PSimbaImage(Params^[0])^.GaussBlur(PDouble(Params^[1])^); end; (* @@ -1440,7 +1450,8 @@ procedure ImportSimbaImage(Compiler: TSimbaScript_Compiler); addGlobalFunc('function TImage.Posterize(Value: Integer): TImage', @_LapeImage_Posterize); addGlobalFunc('function TImage.Convolute(Matrix: TDoubleMatrix): TImage', @_LapeImage_Convolute); addGlobalFunc('function TImage.Mirror(Style: EImageMirrorStyle): TImage', @_LapeImage_Mirror); - addGlobalFunc('function TImage.Blur(Block: Integer): TImage', @_LapeImage_Blur); + addGlobalFunc('function TImage.BoxBlur(Block: Integer): TImage', @_LapeImage_BlockBlur); + addGlobalFunc('function TImage.GaussBlur(Radius: Double): TImage', @_LapeImage_GaussBlur); addGlobalFunc('function TImage.Blend(Points: TPointArray; Radius: Integer): TImage', @_LapeImage_Blend); addGlobalFunc('function TImage.Downsample(Scale: Integer): TImage', @_LapeImage_Downsample);