Gaussian Blur

This code has been declared by its author to be Public Domain code.

Gaussian Blur by elias_t

2003

Yoda.

;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

2015

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.

;---------------------------------
;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

2015

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

Andy_A

2015

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.

Code Archives Forum