[bb] Gaussian Blur by elias_t [ 1+ years ago ]

[BlitzBot]

Title : Gaussian Blur
Author : elias_t
Posted : 1+ years ago

Description : Yoda.

Code :

Code (blitzbasic) Select Expand

;GAUSSIAN BLUR FUNCTION
;by elias_t
;----------------------


;example
Graphics 640,480,32,2

image=LoadImage("frame.png");your image here

image=gaussian_blur(image,5,5);[3,5,7,9]

DrawImage image,0,0
Flip

WaitKey()
End







;needed arrays
Dim maskData#(0)
Dim texel#(0,0,0)
Dim result#(0,0,0)

;ww and hh values
;should always be uneven numbers, [3,5,7,9]

Function gaussian_blur(input_image,ww,hh)

Width=ImageWidth(input_image)
Height=ImageHeight(input_image)

Dim texel#(Width,Height,2)
Dim result#(Width,Height,2)

SetBuffer ImageBuffer (input_image)
LockBuffer ImageBuffer (input_image)

For x=0 To Width-1
 For y=0 To Height-1
  rgb=ReadPixelFast (x,y,ImageBuffer(input_image))
  texel#(x,y,0)=(rgb Shr 16) And $ff;
  texel#(x,y,1)=(rgb Shr 8) And $ff;
  texel#(x,y,2)=rgb And $ff;
 Next
Next


maskWidth#  = ww;
maskHeight# = hh;

Dim maskData#(maskWidth#*maskHeight#);

mult# = 0.0;

For  ym# = 0  To   maskHeight#-1
For xm# = 0  To  maskWidth#-1
cx# = xm# - (maskWidth# - 1) / 2.0;
cy# = ym# - (maskHeight# - 1) / 2.0;
rt# = cx# * cx# + cy# * cy#;
mult# =mult#+ Exp(-0.35 * rt#);
Next
Next

mult# = 1.0 / mult#;

For ym# = 0 To  maskHeight#-1
For xm# = 0  To  maskWidth#-1
cx# = xm# - (maskWidth# - 1) / 2.0;
cy# = ym# - (maskHeight# - 1) / 2.0;
rt# = cx# * cx# + cy# * cy#;
maskData#(ym# * maskWidth# + xm#) = mult# * Exp(-0.35 * rt#);
Next
Next


Dim result#(Width,Height,3)

For ym# = 0 To Height-1
For  xm# = 0 To Width-1
rr#=0.0;
gg#=0.0;
bb#=0.0;
For yy = 0 To maskHeight# -1
For xx = 0 To maskWidth#-1  
If (xm + xx - Floor(maskWidth# / 2.0)<0) Or (ym + yy - Floor(maskHeight# / 2)<0) Or (xm + xx - Floor(maskWidth# / 2.0)>Width) Or (ym + yy - Floor(maskHeight# / 2)>Height)
rl#=0;
gl#=0;
bl#=0;
Else
rl#=texel#(xm + xx - Floor(maskWidth# / 2.0), ym + yy - Floor(maskHeight# / 2),0)
gl#=texel#(xm + xx - Floor(maskWidth# / 2.0), ym + yy - Floor(maskHeight# / 2),1)
bl#=texel#(xm + xx - Floor(maskWidth# / 2.0), ym + yy - Floor(maskHeight# / 2),2)
EndIf

rr# =rr#+rl# * maskData#(xx + yy * maskWidth#);
gg# =gg#+gl# * maskData#(xx + yy * maskWidth#);
bb# =bb#+bl# * maskData#(xx + yy * maskWidth#);
Next
Next
result#(xm#,ym#,0)=rr#;
result#(xm#,ym#,1)=gg#;
result#(xm#,ym#,2)=bb#;
Next
Next




For x=0 To Width-1
 For y=0 To Height-1
  WritePixelFast ( x,y,((result#(x,y,0) Shl 16)+(result#(x,y,1) Shl 8)+result#(x,y,2)),ImageBuffer(input_image) )
 Next
Next

UnlockBuffer ImageBuffer(input_image)

SetBuffer BackBuffer()

Dim maskData#(0)
Dim texel#(0,0,0)
Dim result#(0,0,0)

Return input_image

End Function

Comments :


Andy_A(Posted 1+ years ago)

 I don't know if anyone has tried this, but I found it to be extremely slow. More than 16 seconds to perform the blur when not in Debug mode on a 1024x768 image.After looking at the code, I found that some portions (inner loops) were good places to optimize. After the optimizations it only takes about 1 second (1024x768 image) to perform the blur.Included is a default demo screen to see the Gaussian blur in action. To use your own image set the 'blitzVersion' variable to 1 or 2  for BlitzPlus or Blitz3D respectively, otherwise the default image will be displayed.

Code Select Expand

;---------------------------------
;GAUSSIAN BLUR FUNCTION
;by elias_t
;---------------------------------
;Speed optimization of over 800%
;by Andres Amaya Jr.
;---------------------------------

AppTitle "Gaussian Blur Function by elias_t"
Global sw%, sh%
sw = 1024 ;screen width
sh =  768 ;screen height

;required arrays
Dim maskData#(0)
Dim texel#(0,0,0)
Dim result#(0,0,0)


Dim a#(2),b#(2),c#(2),d#(2),e#(2),f#(2)
Dim p#(2)
Dim pr%(24), pg%(24), pb%(24), hxc%(24)
Dim hx8$(3)
palette()

Graphics sw,sh,32,2
Cls


;=================================================================
;Set version number for Blitz3D/Classic or BlitzPlus or Default
;=================================================================
;set to 0 for Default  set to 1 for B+  anything else for B3D
blitzVersion = 0
;=================================================================

;create default image to perform Gaussian blur
If blitzVersion = 0 Then image = makeImage()

;load image using file requestor (B+)
If blitzVersion = 1 Then
fileName$ = RequestFile("Load image...","bmp;*.png;*.jpg",False)
If fileName$ = "" Then RuntimeError "Image load cancelled."
image = LoadImage(filename$)
If image = 0 Then RuntimeError "Image file not found."
End If

;load image using explicit file name (B3D)
If blitzVersion <> 0 And blitzVersion <> 1 Then
;===========================================================
; If Blitz3D or Classic then assign file name here.
;===========================================================
image = LoadImage("[your image here].png")
If image = 0 Then RuntimeError "Image file not found."
End If

picFlag = 1

DrawBlock image,0,0
Color 255,255,255
Text 512,sh-20,"Click to perform Gaussian Blur",True
Flip
WaitMouse()


st = MilliSecs()
image = gaussian_blur(image, 1, 1) ;Valid arg values are [1,2,3,4]
picFlag = 1
Cls
DrawBlock image,0,0
Color 215,215,215
Rect 5, sh-24, 80,25
Color 0,48,160
Text 5, sh-20, "et:"+(MilliSecs()-st)+"ms"
Flip

WaitMouse()
If picFlag = 1 Then FreeImage image: picFlag = 0
End

Function gaussian_blur(input_image,ww,hh)
;ww and hh values
;must always be between 1 and 4 (inclusive)
If ww>0 And ww<5 And hh>0 And hh<5 Then
ww = ww + ww + 1
hh = hh + hh + 1
Else
RuntimeError "Blur radius invalid. Must be 1 - 4."
FreeImage image
End
End If

Width=ImageWidth(input_image)
Height=ImageHeight(input_image)

Dim texel#(Width,Height,2)
Dim result#(Width,Height,2)

SetBuffer ImageBuffer (input_image)
LockBuffer ImageBuffer (input_image)

For x=0 To Width-1
For y=0 To Height-1
rgb=ReadPixelFast (x,y,ImageBuffer(input_image))
texel#(x,y,0)=(rgb Shr 16) And $ff
texel#(x,y,1)=(rgb Shr 8) And $ff
texel#(x,y,2)=rgb And $ff
Next
Next

maskWidth#  = ww
maskHeight# = hh

Dim maskData#(maskWidth#*maskHeight#)
mult# = 0.0
;======================================================================
;These values remain constant during this first step
;======================================================================
kmaskW# = ( maskWidth# - 1.0)/2.0
kmaskH# = (maskHeight# - 1.0)/2.0
;======================================================================
For  ym# = 0  To   maskHeight#-1
;==================================================================
; Take these two calcs out of the inner loop
;==================================================================
cy# = ym# - kmaskH#
cy22# = cy# * cy#
;==================================================================
For xm# = 0  To  maskWidth#-1
cx# = xm# - kmaskW#
rt# = cx# * cx# + cy22#
mult# =mult#+ Exp(-0.35 * rt#)
Next
Next
;======================================================================
;This value remains constant during this next step
;======================================================================
mult# = 1.0 / mult#
;======================================================================
For ym# = 0 To  maskHeight#-1
;==================================================================
; Take these three calcs out of the inner loop
;==================================================================
cy# = ym# - kmaskH#
ymMaskW# = ym# * maskWidth#
cy22# = cy# * cy#
;==================================================================
For xm# = 0  To  maskWidth#-1
cx# = xm# - kmaskW#
rt# = cx# * cx# + cy22#
maskData#(ymMaskW# + xm#) = mult# * Exp(-0.35 * rt#)
Next
Next

Dim result#(Width,Height,3)
;======================================================================
; These two values remain constant during this most intensive step.
; Since Blitz is NOT an optimizing compiler, this helps immensely.
;======================================================================
kmw = Floor(maskWidth#/2.0)
kmh = Floor(maskWidth#/2.0)
;======================================================================
For ym# = 0 To Height-1
For xm# = 0 To Width-1
rr#=0.0;
gg#=0.0;
bb#=0.0;
For yy = 0 To maskHeight# -1
;==========================================================
; take this calc out of the inner-most loop
;==========================================================
kymyy = ym+yy-kmh  ;<-----------------------------------------+
;==========================================================  ;|
For xx = 0 To maskWidth#-1   ;|
kxmxx = xm+xx-kmw   ;|
;kymyy = ym+yy-kmh ;--------------------------------------+

If (kxmxx <0)Or (kymyy <0) Or (kxmxx >Width) Or (kymyy >Height)
rl#=0;
gl#=0;
bl#=0;
Else
rl#=texel#(kxmxx, kymyy, 0)
gl#=texel#(kxmxx, kymyy, 1)
bl#=texel#(kxmxx, kymyy, 2)
EndIf

kxxyy = xx + yy * maskWidth#
rr# =rr#+rl# * maskData#(kxxyy )
gg# =gg#+gl# * maskData#(kxxyy )
bb# =bb#+bl# * maskData#(kxxyy )
Next
Next
result#(xm#,ym#,0) = rr#
result#(xm#,ym#,1) = gg#
result#(xm#,ym#,2) = bb#
Next
Next
For x=0 To Width-1
For y=0 To Height-1
WritePixelFast ( x,y,((result#(x,y,0) Shl 16)+(result#(x,y,1) Shl 8)+result#(x,y,2)),ImageBuffer(input_image) )
Next
Next
UnlockBuffer ImageBuffer(input_image)

SetBuffer BackBuffer()

Dim maskData#(0) ;free memory allocated to arrays
Dim texel#(0,0,0)
Dim result#(0,0,0)

Return input_image
End Function


Function makeImage()
Local k%, j%, i%, xp%, yp%, clr%, rep%, xOffset%, yOffset%, numRows%
Local xMult#, yMult#, xalt#, yalt#, x#, y#, pct#, cx#, cy#, band#, coff#

; aa078.ifs
; Andres Amaya Jr  2015.02.18
a(1)=0.6: b(1)= 0.5: c(1)=-0.3: d(1)= 0.6: e(1)=-1.1: f(1)=-0.3: p(1)=0.5368
a(2)=0.4: b(2)=-0.4: c(2)=-0.6: d(2)=-0.5: e(2)= 0.3: f(2)=-0.4: p(2)=0.4632
xMult=275.: yMult=330.: xOffset=763: yOffset=-337

; ; aa305.ifs
; ; Andres Amaya Jr  2015.02.19
; a(1)=-0.5: b(1)=-0.1: c(1)=0.2: d(1)=-0.3: e(1)=-0.2: f(1)=-0.9: p(1)=0.1683
; a(2)= 0.6: b(2)=-0.6: c(2)=0.4: d(2)= 1.0: e(2)=-1.1: f(2)= 0.5: p(2)=0.8317
; xMult=240.: yMult=290.: xOffset=707: yOffset=-575


numRows=2: cx = 512.0: cy = 384.0: band = 23.0: coff = 15.0
xalt=0.5 : yalt=0.5
LockBuffer()
For k = 1 To 30000
For j = 1 To 10
pct=Rnd(0.0, 1.0)
For i = 1 To numRows
If pct>p(i-1) And pct <= p(i) Then Exit
Next
If i > numRows Then i = numRows
x = a(i) * xalt + b(i) * yalt + e(i)
y = c(i) * xalt + d(i) * yalt + f(i)
xp = Int(x*xMult) + xOffset
yp = (768-Int(y*yMult)) + yOffset
clr = Int(Sqr((cx-xp)*(cx-xp) + (cy-yp)*(cy-yp))/band + coff) Mod 24
If xp>=0 And xp<sw And yp>=0 And yp<sh Then
WritePixelFast(xp,yp,hxc(clr))
End If
       xalt = x : yalt = y
    Next
Next
UnlockBuffer()
SetBuffer BackBuffer()
Flip
image = CreateImage(sw, sh)
GrabImage image,0,0
Return image
End Function


Function h2d$(hx$)
Local hi%, lo%
hx$ = Upper(hx$)
hi = Asc( Left(hx$,1))-48
lo = Asc(Right(hx$,1))-48
If hi>10 Then hi=hi-7
If lo>10 Then lo=lo-7
Return hi Shl 4 Or lo
End Function

Function palette()
Local i%, j%, count%
Local triplet$
hx8$(1)="0000FF4000FF7D00FFBE00FFFF00FFFF00BEFF007DFF0040"
hx8$(2)="FF0000FF4000FF7D00FFBE00FFFF00BEFF007DFF0040FF00"
hx8$(3)="00FF0000FF4000FF7D00FFBE00FFFF00BEFF007DFF0040FF"
count = 0
For i = 1 To 3
For j = 1 To 43 Step 6
triplet$ = Mid(hx8$(i),j,6)
pr(count) = h2d$(Mid(triplet$,1,2))
pg(count) = h2d$(Mid(triplet$,3,2))
pb(count) = h2d$(Mid(triplet$,5,2))
hxc(count) = pr(count) Shl 16 Or pg(count) Shl 8 Or pb(count)
count = count + 1
Next
Next
End Function


BlitzSupport(Posted 1+ years ago)

 Wow, it was extremely slow before -- nice speedup!


Andy_A(Posted 1+ years ago)

 I don't remember the exact number but the number of extraneous calculations in the inner loop was in the millions. Yes, it made a big difference in speed. [/i]