'seeding matrix (7:1) x (1:7)
DIM a%(-3 TO 3)
a%(-3) = 1: a%(-2) = 2: a%(-1) = 4: a%(0) = 8: a%(1) = 4: a%(2) = 2: a%(3) = 1
'alpha multiplier matrix kernel (7:7)
DIM kern%(LBOUND(a%) TO UBOUND(a%), LBOUND(a%) TO UBOUND(a%))
FOR x% = LBOUND(kern%, 1) TO UBOUND(kern%, 1) ' iterate kernel matrix columns
FOR y% = LBOUND(kern%, 2) TO UBOUND(kern%, 2) ' iterate kernel matrix rows
kern%(x%, y%) = a%(x%) * a%(y%) ' seed the gaussian kernel position
NEXT y%, x%
mult! = 255 / kern%(0, 0) ' set a multiplier to prevent alpha bleed through
'display clear image, create and display blurred image
_PUTIMAGE (1, 1), b& ' place clear bird image on left of mainscreen
FOR ox% = 0 TO _WIDTH(b&) - 1 '
FOR oy% = 0 TO _HEIGHT(b&) - 1 '
_SOURCE b& ' source: clear bird image
c~& = POINT(ox%, oy%) ' get source pixel color at (ox%, oy%)
_DEST r& ' destination: blurred receiving image
FOR x% = LBOUND(kern%, 1) TO UBOUND(kern%, 1) ' apply the alpha matrix around original point
FOR y% = LBOUND(kern%, 2) TO UBOUND(kern%, 2)
PSET (ox% + x%, oy% + y%), _RGBA32(_RED32(c~&), _GREEN32(c~&), _BLUE32(c~&), mult! * kern%(x%, y%))
NEXT y%, x%
NEXT oy%, ox%
_DEST 0 ' destination back to mainscreen
_PUTIMAGE (_WIDTH(0) - _WIDTH(r&) - 2, 1), r& ' place blurred receiving image on right of mainscreen
END
07-26-2023, 02:25 PM (This post was last modified: 07-26-2023, 02:26 PM by TerryRitchie.)
I modified RhoSigma's ApplyFilter& function from his Image Processing Library (imageprocess.bm) to only perform Gaussian blurs in the laser project I'm working on. Here is the result:
Code: (Select All)
' ______________________________________________________________________________________________________________________________________________
'/ \
FUNCTION ApplyGauss& (SourceHandle AS LONG) ' ApplyGauss& |
' __________________________________________________________________________________________________________________________________________|____
'/ \
'| Applies a Gaussian blur to the image passed in. |
'| |
'| BlurredImage = ApplyGauss&(OriginalImage) |
'| |
'| SourceHandle - the image to be blurred |
'| |
'| NOTE: This function is a modified version of RhoSigma's Image Processing Library's ApplyFilter& function found in imageprocess.bm. |
'| The function has been modified to only support the "gauss8" method of blurring with no optional parameters available. |
'| RhoSigma's unedited library can be obtained here: https://qb64phoenix.com/forum/showthread.php?tid=1033 |
'| Thanks to RhoSigma for offering this library. |
'\_______________________________________________________________________________________________________________________________________________/
DIM AS INTEGER SourceWidth, SourceHeight, FilterY, FilterX, y, x, NewAlpha, FilterWeight, NewRed, NewGreen, NewBlue, Size, Add, Div
DIM AS LONG NewHandle, SumRed, SumGreen, SumBlue
DIM AS _UNSIGNED LONG OriginalRGB, NewRGB
DIM AS _OFFSET PixelOffset, FilterOffset
DIM SourceBuffer AS _MEM
DIM NewBuffer AS _MEM
STATIC Weight(0 TO 6, 0 TO 6) AS INTEGER
'+-------------------------------------+
'| Iterate through source image pixels |
'+-------------------------------------+
y = -1 ' set y location
DO ' iterate vertically through source image
y = y + 1 ' increment y location
PixelOffset = (y * SourceWidth * 4) ' calculate pixel offset
x = -1 ' set x location
DO ' iterate horizontally through source image
x = x + 1 ' increment x location
_MEMGET SourceBuffer, SourceBuffer.OFFSET + PixelOffset, OriginalRGB ' get source image pixel
NewAlpha = _ALPHA32(OriginalRGB) ' record pixel's alpha value
SumRed = 0 ' clear previous summed pixel weight values
SumGreen = 0
SumBlue = 0
'+-------------------------------------------------------+
'| Iterate through neigboring pixels using filter matrix |
'+-------------------------------------------------------+
FilterY = y - Size - 1 ' calculate filter vertical start point
DO ' iterate vertically through filter matrix
FilterY = FilterY + 1 ' increment y location
FilterOffset = (FilterY * SourceWidth * 4) + ((x - Size) * 4) ' calculate filter offset
FilterX = x - Size - 1 ' calculate filter horizontal start point
DO ' iterate horizontally through filter matrix
FilterX = FilterX + 1 ' increment x location
IF FilterY >= 0 AND FilterY < SourceHeight AND FilterX >= 0 AND FilterX < SourceWidth THEN ' is position outside image?
_MEMGET SourceBuffer, SourceBuffer.OFFSET + FilterOffset, OriginalRGB ' no, get source image pixel
ELSE
_MEMGET SourceBuffer, SourceBuffer.OFFSET + PixelOffset, OriginalRGB ' yes, get center source image pixel
END IF
'+----------------------+
'| Sum up pixel weights |
'+----------------------+
FilterWeight = Weight(FilterY - y + 3, FilterX - x + 3) ' get weight value from filter array
SumRed = SumRed + (_RED32(OriginalRGB) * FilterWeight) ' apply weight value to RGB colors
SumGreen = SumGreen + (_GREEN32(OriginalRGB) * FilterWeight)
SumBlue = SumBlue + (_BLUE32(OriginalRGB) * FilterWeight)
FilterOffset = FilterOffset + 4 ' increment to next filter offset
LOOP UNTIL FilterX = x + Size
LOOP UNTIL FilterY = y + Size
NewRed = CINT(SumRed / Div) + Add ' calculate new pixel channel colors
NewGreen = CINT(SumGreen / Div) + Add
NewBlue = CINT(SumBlue / Div) + Add
NewRGB = _RGBA32(NewRed, NewGreen, NewBlue, NewAlpha) ' calculate new pixel color
_MEMPUT NewBuffer, NewBuffer.OFFSET + PixelOffset, NewRGB ' place new pixel color onto new image
PixelOffset = PixelOffset + 4 ' increment to next pixel offset
LOOP UNTIL x = SourceWidth - 1
LOOP UNTIL y = SourceHeight - 1
'+-----------------------------+
'| Free RAM then return result |
'+-----------------------------+
_MEMFREE NewBuffer ' remove image buffers from RAM
_MEMFREE SourceBuffer
ApplyGauss& = NewHandle ' return new image
END IF
$CHECKING:ON
END IF
END IF
END FUNCTION
There are two ways to write error-free programs; only the third one works. QB64 Tutorial
Nice Function, Terry. The _MEM stuff sure makes a speed increase. I think I will try to incorporate _MEM in mine to see how much faster it can get. Well, here's what I came up with after studying sources in other languages. This one let's you define the radius, higher values make it slower.
- Dav
Code: (Select All)
Screen _NewImage(800, 600, 32)
For t = 1 To 1000
size = Rnd * 255
x = Rnd * _Width: y = Rnd * _Height
Line (x, y)-(x + size, y + size), _RGB(Rnd * 255, Rnd * 255, Rnd * 255), BF
Next
For t = 1 To 50000
PSet (Rnd * _Width, Rnd * _Height), _RGB(Rnd * 255, Rnd * 255, Rnd * 255)
Next
Dim pix As Long
sigma = radius / 2
cons = 1 / (2 * 3.14159 * sigma * sigma)
_Source tempimage&
'apply Gaussian Blur
For y = starty To endy
For x = startx To endx
r = 0: g = 0: b = 0
For i = -radius To radius
For j = -radius To radius
If (y + j >= 0) And (x + i >= 0) And (y + j < _Height) And (x + i < _Width) Then
pix = Point(x + j, y + i)
k = cons * Exp(-((j * j + i * i) / (2 * sigma * sigma)))
r = r + k * _Red32(pix)
g = g + k * _Green32(pix)
b = b + k * _Blue32(pix)
End If
Next
Next
PSet (x, y), _RGB32(r, g, b)
Next
Next
(07-26-2023, 02:25 PM)TerryRitchie Wrote: I modified RhoSigma's ApplyFilter& function from his Image Processing Library (imageprocess.bm) to only perform Gaussian blurs in the laser project I'm working on. Here is the result:
You made a nice compact function out of it @TerryRitchie, you could replace the _NEWIMAGE/_PUTIMAGE combo in the "Copy the source image" section with _COPYIMAGE instead.
The reason to use that combo was at the time of writing my image processing library _COPYIMAGE had a bug in conjunction with _MEMIMAGE. It simply also copied the memory lock esteblished by _MEMIMAGE to the new image. This caused a problem when you _FREEIMAGEed either the original/copied image and after that freeing the other one. Because both images shared the same memory lock, which was freed with the first image, you cause a module error when freing the second one and the memory lock did no longer exist. The _NEWIMAGE/_PUTIMAGE combo was a safe workaround, however _COPYIMAGE has been fixed in QB64 v1.4
(07-26-2023, 06:24 PM)Dav Wrote: Nice Function, Terry. The _MEM stuff sure makes a speed increase. I think I will try to incorporate _MEM in mine to see how much faster it can get. Well, here's what I came up with after studying sources in other languages. This one let's you define the radius, higher values make it slower.
- Dav
Code: (Select All)
Screen _NewImage(800, 600, 32)
For t = 1 To 1000
size = Rnd * 255
x = Rnd * _Width: y = Rnd * _Height
Line (x, y)-(x + size, y + size), _RGB(Rnd * 255, Rnd * 255, Rnd * 255), BF
Next
For t = 1 To 50000
PSet (Rnd * _Width, Rnd * _Height), _RGB(Rnd * 255, Rnd * 255, Rnd * 255)
Next
Dim pix As Long
sigma = radius / 2
cons = 1 / (2 * 3.14159 * sigma * sigma)
_Source tempimage&
'apply Gaussian Blur
For y = starty To endy
For x = startx To endx
r = 0: g = 0: b = 0
For i = -radius To radius
For j = -radius To radius
If (y + j >= 0) And (x + i >= 0) And (y + j < _Height) And (x + i < _Width) Then
pix = Point(x + j, y + i)
k = cons * Exp(-((j * j + i * i) / (2 * sigma * sigma)))
r = r + k * _Red32(pix)
g = g + k * _Green32(pix)
b = b + k * _Blue32(pix)
End If
Next
Next
PSet (x, y), _RGB32(r, g, b)
Next
Next
(07-26-2023, 02:25 PM)TerryRitchie Wrote: I modified RhoSigma's ApplyFilter& function from his Image Processing Library (imageprocess.bm) to only perform Gaussian blurs in the laser project I'm working on. Here is the result:
You made a nice compact function out of it @TerryRitchie, you could replace the _NEWIMAGE/_PUTIMAGE combo in the "Copy the source image" section with _COPYIMAGE instead.
The reason to use that combo was at the time of writing my image processing library _COPYIMAGE had a bug in conjunction with _MEMIMAGE. It simply also copied the memory lock esteblished by _MEMIMAGE to the new image. This caused a problem when you _FREEIMAGEed either the original/copied image and after that freeing the other one. Because both images shared the same memory lock, which was freed with the first image, you cause a module error when freing the second one and the memory lock did no longer exist. The _NEWIMAGE/_PUTIMAGE combo was a safe workaround, however _COPYIMAGE has been fixed in QB64 v1.4
I was wondering why _COPYIMAGE was not used in favor of _PUTIMAGE when I was reworking the code. I'll make that change then. Thanks for the information.
By the way, your libraries are a wealth of knowledge. Thank you for sharing them. It wasn't until I needed your image processing library that I started snooping around in the rest of your libraries. Good stuff!
There are two ways to write error-free programs; only the third one works. QB64 Tutorial
07-26-2023, 09:08 PM (This post was last modified: 07-26-2023, 09:08 PM by RhoSigma.)
(07-26-2023, 07:00 PM)TerryRitchie Wrote: By the way, your libraries are a wealth of knowledge. Thank you for sharing them.
Thanks and Your welcome, it's good to know the stuff has some value for other people too.
(07-26-2023, 07:00 PM)TerryRitchie Wrote: It wasn't until I needed your image processing library that I started snooping around in the rest of your libraries. Good stuff!
(07-26-2023, 01:57 PM)bplus Wrote: Can you get an algo that goes the other way? I see enough blur already.
Yep, the ApplyFilter&() function of my imageprocess.bm library has also some "sharpen" filters as well as line/edge detect filters and some artistic ones.
