Oil Paint Effect

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Oil Paint Effect

Post by BasicCoder2 »

Oil Paint Effect:

This algorithm is based on the one in the code project by Santhosh,

http://www.codeproject.com/Articles/471 ... aintEffect

It gives a BITMAP image an oil painting effect. If your image is in another format (eg. jpg or png) then you will have to use a paint or some other image program to load it and resave it as a bitmap image.

I have used point and pset which I think is slower than direct pixel access but easier to read so a large image will take longer to convert to an oil painted effect. Maybe I will speed it up later.

Code: Select all

'#include "fbgfx.bi"
screenres 640,480,32

Const NULL As Any Ptr = 0
dim shared as integer iWidth      'hold width of image
dim shared as integer iHeight     'hold height of image
dim shared as integer pad         'used to skip any pads at end of rows

function loadImage(file as string) as any ptr
    dim img1 as any ptr
    if img1 <> NULL then
        imageDestroy(img1)  'release memory
    end if
    dim as integer fileHnd = FreeFile()
    'get width and height of bitmap
    open file for binary as #fileHnd
    get #fileHnd, 19, iWidth
    get #fileHnd, 23, iHeight
    close #fileHnd    
    'initialize pointers to img1 bitmaps
    img1 = imagecreate(iWidth,iHeight,rgb(255,255,255))
    bload file,img1 'bload bitmap img1
    If img1 = NULL Then
        Print "image creation failed!"
        Sleep
        End
    Else
        'compute pad value of image required for direct access to pixel data
        pad = (4-(iWidth-((iWidth\4)*4)))and 3
    end if
    return img1
end function

function oilify(img1 as any ptr,radius as integer) as any ptr

    dim as integer i,max,maxIndex,r,g,b
    dim as double intensity,intensity2
    intensity = 5
    dim as integer intensityCount(256)
    dim as uinteger pixel
    dim as integer sumR(256),sumG(256),sumB(256)
    
    dim img2 as any ptr  'make pointer to point to bitmap    
    img2 = imagecreate(iWidth,iHeight,rgb(255,255,255)) 'duplicate image
    
    for y as integer = 0 to iHeight-radius
        for x as integer = 0 to iWidth-radius
            'clear table of values
            for ii as integer = 0 to 255
                sumR(ii)=0
                sumG(ii)=0
                sumB(ii)=0
                intensityCount(ii)=0
            next ii
            'find intensity of rgb value and apply intensity level
            for yy as integer = -radius to radius
                for xx as integer = -radius to radius
                    pixel = point(x+xx,y+yy,img1)
                    r = pixel shr 16 and &HFF
                    g = pixel shr 8 and &HFF
                    b = pixel and &HFF

                    intensity2 = (((r+g+b)/3.0)*intensity)/255

                    if intensity2 > 255 then
                        intensity2 = 255
                    end if
                    i = intensity2
                    intensityCount(i)=intensityCount(i)+1
                    'sum of each pixel value is calculated
                    sumR(i) = sumR(i)+r
                    sumG(i) = sumG(i)+g
                    sumB(i) = sumB(i)+b
                next xx
            next yy
            
            'find intensity with highest occurence
            max = 0
            maxIndex = 0
            for ii as integer = 0 to 255
                if intensityCount(ii)>max then
                    max = intensityCount(ii)  'most repeated intensity found so far
                    maxIndex = ii             'found at index ii
                end if
            next ii
            
            r = sumR(maxIndex)/max  'max = number of pixels with this intensity
            g = sumG(maxIndex)/max
            b = sumB(maxIndex)/max
            
            pset img2,(x,y),rgb(r,g,b)
            
        next x
    next y
    'copy img2 to img1
    put img1,(0,0),img2,(0,0)-(iWidth-1,iHeight-1),pset  'copy image2 to image1
    imageDestroy(img2)
    return img1
end function

' *******  MAIN PROGRAM ***********
dim img as any ptr     'pointer to point to a bitmap

dim as string filePath 'file path to your bitmap image
filePath = "C:/FreeBasic/bitmaps/scene.bmp"   'file path to a bitmap image
img = loadImage(filePath)  
put (0,0),img,pset            'display your image
sleep
img = oilify(img,2)
put (0,0),img,pset            'display your modified image
sleep

imageDestroy(img)
dafhi
Posts: 1640
Joined: Jun 04, 2005 9:51

Re: Oil Paint Effect

Post by dafhi »

point() is the slowest, but it's minor compared with all the calculation per source pixel

Code: Select all

#Macro pixelcalc()

  pixel = src[y_ * pitchBy4 + x_] 
  'pixel = point(x+xx,y+yy,img1)
  r = pixel shr 16 and &HFF
  g = pixel shr 8 and &HFF
  b = pixel and &HFF
  
  intensity2 = (r+g+b) * div255_3
  'intensity2 = (((r+g+b)* div3)*intensity) / 255
  
  if intensity2 > 255 then
  intensity2 = 255
  end if
  i = intensity2
  intensityCount(i)+= 1'=intensityCount(i)+1
  'sum of each pixel value is calculated
  sumR(i) += r
  sumG(i) += g
  sumB(i) += b
                            
#EndMacro

function oilify(img1 as any ptr,radius as integer) as any ptr

    dim as integer i,max,maxIndex,r,g,b
    dim as double intensity,intensity2
    intensity = 5
    dim as integer intensityCount(256)
    dim as uinteger pixel
    dim as integer sumR(256),sumG(256),sumB(256)
    
    dim img2 as any ptr  'make pointer to point to bitmap    
    img2 = imagecreate(iWidth,iHeight,rgb(255,255,255)) 'duplicate image
    
    ''
    ''
    Dim As Integer pitch, pitchBy4, bypp, wid, hgt
    Dim As UInteger Ptr src, dest_
    ImageInfo img1, wid, hgt, bypp, pitch, src
    ImageInfo img2,  ,  ,  ,  , dest_
    pitchBy4 = pitch / 4
    Dim As single div255 = intensity / 255
    Dim As single div255_3 = div255 / 3
    
    for y as integer = 0 to iHeight-radius
        Dim As UInteger Ptr dest = dest_ + y * pitchBy4  
        for x as integer = 0 to iWidth-radius
            'clear table of values
            for ii as integer = 0 to 255
                sumR(ii)=0
                sumG(ii)=0
                sumB(ii)=0
                intensityCount(ii)=0
            next ii
            'find intensity of rgb value and apply intensity level
            for yy as integer = -radius to radius
                for xx as integer = -radius to radius
                
                    ''
                    ''
                    Dim As Integer x_ = x + xx
                    If x_ >= 0 Then
                      If x_ < iWidth Then
                        Dim As Integer y_ = y + yy
                        If y_ >= 0 Then
                          If y_ < iHeight Then
                            pixelcalc()
                          EndIf
                        EndIf
                      EndIf
                    EndIf
                    
                next xx
            next yy
            
            'find intensity with highest occurence
            max = 0
            maxIndex = 0
            for ii as integer = 0 to 255
                if intensityCount(ii)>max then
                    max = intensityCount(ii)  'most repeated intensity found so far
                    maxIndex = ii             'found at index ii
                end if
            next ii
            
            ''
            ''
            Dim As Single divMax = 1 / max
            
            r = sumR(maxIndex)* divMax  'max = number of pixels with this intensity
            g = sumG(maxIndex)* divMax
            b = sumB(maxIndex)* divMax
            
            dest[x] = RGB(r,g,b)
            'pset img2,(x,y),rgb(r,g,b)
            
        next x
    next y
    'copy img2 to img1
    put img1,(0,0),img2,(0,0)-(iWidth-1,iHeight-1),pset  'copy image2 to image1
    imageDestroy(img2)
    return img1
end function
BasicCoder2
Posts: 3906
Joined: Jan 01, 2009 7:03
Location: Australia

Re: Oil Paint Effect

Post by BasicCoder2 »

dafhi wrote:point() is the slowest, but it's minor compared with all the calculation per source pixel
Thanks for the input dafhi. I don't use macros so I have rewritten it. I understand a macro becomes compiled inline code which is faster than calling a subroutine. I see you use direct image data access and put as much computation outside of the loops as possible. I wonder how much faster it would be in assembler.
Gonzo
Posts: 722
Joined: Dec 11, 2005 22:46

Re: Oil Paint Effect

Post by Gonzo »

Code: Select all

type rgb_t
	as integer r, g, b
End Type

dim as rgb_t test = type<rgb_t> (64, 128, 255)

'' Luma: 0.2989 * R + 0.5870 * G + 0.1140 * B

dim as integer intensity1 = (0.2989 * test.r + 0.5870 * test.g + 0.1140 * test.b) and 255
dim as integer intensity2 = test.r shr 2 + test.g shr 1 + test.b shr 2

print intensity1, intensity2
sleep
adding together colors and dividing by 3 does not give you the intensity of a pixel
i've added a cheap method that gives you a good enough value if you don't really care too much about it
if you still want to add 3 things together and divide by 3, you can try simply (r or g or b)
or perhaps (r and b) or g since g has the strongest luminance, but it probably won't work well
i think things like these will not affect your program too much
it's better to find a more effective algorithm, or split the work up and parallellize it
Gonzo
Posts: 722
Joined: Dec 11, 2005 22:46

Re: Oil Paint Effect

Post by Gonzo »

Code: Select all

#define NULL  0

const as string  filename    = "test.bmp"
const as integer OIL_RADIUS  = 12 '' brush radius
const as integer MAX_SAMPLES = 80 '' exit treshold

type imagesize_t
	as integer w, h
end type

type rgbi_t
	as integer r, g, b, i
end type


function imageSize(file as string) as imagesize_t
    
    dim as imagesize_t i
    dim as integer fileHnd = FreeFile()
    'get width and height of bitmap
    if open(file for binary as #fileHnd) = 0 then
    	get #fileHnd, 19, i.w
    	get #fileHnd, 23, i.h
    	close #fileHnd
    else
    	print "failed to open file... missing?"
    	sleep
    	end 0
    endif
	return i
	
end function

function loadImage(file as string, byref i as imagesize_t) as any ptr
    
    'initialize pointers to img1 bitmaps
    dim as any ptr img1 = imagecreate(i.w, i.h)
    bload file,img1 'bload bitmap img1
    if img1 = NULL then
        Print "image creation failed!"
        Sleep
        End
    endif
    return img1
    
end function

#Macro pixelcalc()
	
	pixel = src[y_ * pitchBy4 + x_] 
	
	r = pixel shr 16 and &hFF
	g = pixel shr 8 and &hFF
	b = pixel and &hFF
	
	i = 0.2989 * r + 0.5870 * g + 0.1140 * b
	'i = r shr 2 + g shr 1 + b shr 2
	
	with rgbi(i)
		'sum of each pixel value is calculated
		.r += r
		.g += g
		.b += b
		
		.i += 1
		if .i > max then
			max = .i : maxIndex = i
			if .i > MAX_SAMPLES then exit for, for
		EndIf
		
	End With
	
#EndMacro

function oilify(img1 as any ptr,radius as integer) as any ptr

    Dim As Integer pitch, pitchBy4, bypp, wid, hgt
    Dim As UInteger Ptr src, dest, dest_
    ImageInfo img1, wid, hgt, bypp, pitch, src
    
    'compute pad value of image required for direct access to pixel data
    dim as integer pad = (4-(wid-((wid shr 2) shl 2))) and 3
    
    dim img2 as any ptr  'make pointer to point to bitmap    
    img2 = imagecreate(wid, hgt) 'duplicate image
    ImageInfo img2,  ,  ,  ,  , dest_
    dest = dest_
    pitchBy4 = pitch / 4
    
    dim as integer i,max,maxIndex,r,g,b
    dim as uinteger pixel
    dim as rgbi_t rgbi(255)
    
    ''
    ''
    dim as integer x, y, x_, y_, xx, yy
    
    for y = 0 to hgt-1
        
        for x = 0 to wid-1
            
            'clear table of values
            erase rgbi
            max = -1
            
            'find intensity of rgb value and apply intensity level
            
            for yy = 0 to radius
            	
                for xx = 0 to radius
                	
                	if xx*xx + yy*yy <= radius*radius then
                		
                		y_ = y + yy
                		if y_ < hgt then
                			x_ = x + xx
	                		If x_ < wid Then
	                            pixelcalc()
	                		endif
	                		x_ = x - xx
	                		if x_ >= 0 and xx <> 0 then
	                            pixelcalc()
	                		endif
                		endif
                		y_ = y - yy
                		if y_ >= 0 and yy <> 0 then
                			x_ = x + xx
                			If x_ < wid Then
	                            pixelcalc()
                			endif
                			x_ = x - xx
                			if x_ >= 0 and xx <> 0 then
	                            pixelcalc()
                			endif
                		endif
                		
                	endif
                	
                next
                
            next
            
            'max = number of pixels with this intensity
            with rgbi(maxIndex)
            	.r /= max
            	.g /= max
            	.b /= max
            	
            	dest[x] = .b + .g shl 8 + .r shl 16
            	
            end with
            
        next
        
        if (y and 7) = 0 then print ".";
        dest += pitchBy4
        
    next
    
    'copy img2 to img1
    put img1,(0,0),img2,(0,0)-(wid-1,hgt-1),pset  'copy image2 to image1
    imageDestroy(img2)
    
    return img1
    
end function

' *******  MAIN PROGRAM ***********
dim as imagesize_t isize = imageSize(exepath() + "\" + filename)
	
	screenres isize.w, isize.h, 24
dim as any ptr img       = loadImage(exepath() + "\" + filename, isize)
	  
	put (0,0),img,pset
	print "painting..."
	
	img = oilify(img, OIL_RADIUS)
	put (0,0),img,pset            'display your modified image
	sleep
	
	imageDestroy(img)

lower max samples = faster
higher radius = slower

file i used in testing is here: http://fbcraft.fwsnet.net/test.bmp
sometimes lines are created, and i dont know why.. but its not intrusive
Post Reply