Skip to content

Commit

Permalink
TSimbaImage: Add approximated gaussian blur (in linear time)
Browse files Browse the repository at this point in the history
  • Loading branch information
@ollydev
ollydev committed Oct 15, 2023
1 parent ffb6bff commit cb547e3
Show file tree
Hide file tree
Showing 3 changed files with 254 additions and 10 deletions.
61 changes: 57 additions & 4 deletions Source/image/simba.image.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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;

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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;
Expand All @@ -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;
Expand Down Expand Up @@ -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;
Expand Down
180 changes: 180 additions & 0 deletions Source/image/simba.image_gaussblur.pas
View file
Original file line number Diff line number Diff line change
@@ -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.

23 changes: 17 additions & 6 deletions Source/script/imports/simbaclasses/simba.import_class_image.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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;

(*
Expand Down Expand Up @@ -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);

Expand Down

0 comments on commit cb547e3

Please sign in to comment.