PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Smoother FillArea routine

https://www.purebasic.fr/english/viewtopic.php?t=78061

Page 1 of 1

Smoother FillArea routine

Posted: Tue Oct 12, 2021 8:16 pm
by firace
I am a total 2D/3D graphics newbie, so I was wondering if there is any clever FillArea algorithms that can replace a color in an image such as the below without causing annoying artefacts due to antialiasing?

Image

Re: Smoother FillArea routine

Posted: Tue Oct 12, 2021 8:26 pm
by Olli
If nobody answers this question in less than a week, I switch my computer on and give an algo.

- Redo a filling algo
- Choose a three-color limit (here, 0;0;0)
- Blend the fill color with the background color, in the area of the filling algo.

This will be a very very good subject, because, just the title seems to talk about a light and shadow smooth, instead of just an aA.

Re: Smoother FillArea routine

Posted: Tue Oct 12, 2021 9:20 pm
by STARGÅTE
Here is an example algorithm which uses a color distance to blend the filling color with the pixel.
Use the left mouse click to fill areas with blue color and see the result.

Code: Select all


Enumeration
	#Window
	#Gadget
	#Image
EndEnumeration

Structure Vector
	X.i
	Y.i
EndStructure

; Calculate the distance between two colors. This value is between 0.0 and 441.67
Procedure.f ColorDistance(Color1.l, Color2.l)
	
	Protected dR.i = Abs(Red(Color1)-Red(Color2))
	Protected dG.i = Abs(Green(Color1)-Green(Color2))
	Protected dB.i = Abs(Blue(Color1)-Blue(Color2))
	
	ProcedureReturn Sqr(dR*dR + dG*dG + dB*dB)
	
EndProcedure

; Mix two colors with a linear interpolation. color = color1*(1-factor) + color2*factor
Procedure.l ColorMix(Color1.l, Color2.l, Factor.f)
	
	Protected R.i = Red(Color1)*(1-Factor) + Red(Color2)*Factor
	Protected G.i = Green(Color1)*(1-Factor) + Green(Color2)*Factor
	Protected B.i = Blue(Color1)*(1-Factor) + Blue(Color2)*Factor
	
	ProcedureReturn RGB(R, G, B)
	
EndProcedure

; Perform a smooth filling of area (x,y) with color FillColor using the max color distance MaxColorDistance
Procedure SmoothFillArea(X.i, Y.i, FillColor.l, MaxColorDistance.f)
	
	Protected Dim Filled.i(OutputWidth()-1, OutputHeight()-1)
	Protected NewList Seeds.Vector()
	Protected Factor.f
	Protected SeedColor.l = Point(X, Y)
	
	AddElement(Seeds()) : Seeds()\X = X : Seeds()\Y = Y : Filled(X, Y) = #True
	
	ResetList(Seeds())
	While NextElement(Seeds())
		*Seed.Vector = @Seeds()
		With *Seed
			If MaxColorDistance = 0
				Factor = Bool(ColorDistance(Point(\X, Seeds()\Y), SeedColor) <> 0.0)
			Else
				Factor = ColorDistance(Point(\X, Seeds()\Y), SeedColor) / MaxColorDistance
			EndIf
			If Factor < 1.0
				Plot(\X, \Y, ColorMix(FillColor, Point(\X, \Y), Factor*Factor)) 
				If \X > 0 And Filled(\X-1, \Y) = #False
					AddElement(Seeds()) : Seeds()\X = \X-1 : Seeds()\Y = \Y : Filled(\X-1, \Y) = #True
				EndIf
				If \X < OutputWidth()-1 And Filled(\X+1, \Y) = #False
					AddElement(Seeds()) : Seeds()\X = \X+1 : Seeds()\Y = \Y : Filled(\X+1, \Y) = #True
				EndIf
				If \Y > 0 And Filled(\X, \Y-1) = #False
					AddElement(Seeds()) : Seeds()\X = \X : Seeds()\Y = \Y-1 : Filled(\X, \Y-1) = #True
				EndIf
				If \Y < OutputHeight()-1 And Filled(\X, \Y+1) = #False
					AddElement(Seeds()) : Seeds()\X = \X : Seeds()\Y = \Y+1 : Filled(\X, \Y+1) = #True
				EndIf
				ChangeCurrentElement(Seeds(), *Seed)
			EndIf
		EndWith
	Wend
	
EndProcedure


;- Example

InitNetwork()

UsePNGImageDecoder()

CatchImage(#Image, ReceiveHTTPMemory("https://i.ibb.co/WP4XVGd/cat3.png"))

OpenWindow(#Window, 0, 0, ImageWidth(#Image), ImageHeight(#Image), "Smooth Fill Area", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
CanvasGadget(#Gadget, 0, 0, WindowWidth(#Window), WindowHeight(#Window))

If StartDrawing(CanvasOutput(#Gadget))
	DrawImage(ImageID(#Image), 0, 0)
	StopDrawing()
EndIf

Define FillColor.l = $FFB040       ; Filling color
Define MaxColorDistance.f = 400.0  ; Max distance of the colors: 0.0 until 441.67
                                   ; 0.0 meens only exacly same pixel color. Value over 441.67 fills all pixels

Repeat
	Select WaitWindowEvent()
		Case #PB_Event_CloseWindow
			Break
		Case #PB_Event_Gadget
			Select EventGadget()
				Case #Gadget
					Select EventType()
						Case #PB_EventType_LeftClick
							If StartDrawing(CanvasOutput(#Gadget))
								SmoothFillArea(GetGadgetAttribute(#Gadget, #PB_Canvas_MouseX), GetGadgetAttribute(#Gadget, #PB_Canvas_MouseY), FillColor, MaxColorDistance)
								StopDrawing()
							EndIf
					EndSelect
			EndSelect
	EndSelect
ForEver

End

Re: Smoother FillArea routine

Posted: Tue Oct 12, 2021 9:28 pm
by firace
@STARGÅTE: Awesome code, thanks! 8) 8)

Re: Smoother FillArea routine

Posted: Tue Oct 12, 2021 9:57 pm
by Caronte3D
+1000 :wink:

Re: Smoother FillArea routine

Posted: Wed Oct 13, 2021 5:27 am
by juergenkulow
Coloring the cat's eye takes 13 ms where the seeds list has 3536 elements,
Can this be done under 1 ms?

Re: Smoother FillArea routine

Posted: Wed Oct 13, 2021 7:04 pm
by Michael Vogel
Speeding up can be done by doing direct memory access instead using the Plot/Point functions. Anyhow it is a great example how difficult problems could be solved (by purebasic and a clever nerd) :P

Only added a slider quicly to see how different parameter values change the behaviour of the filling routine:

Code: Select all

Enumeration
	#Window
	#Gadget
	#Slider
	#Image
EndEnumeration

Structure Vector
	X.i
	Y.i
EndStructure

; Calculate the distance between two colors. This value is between 0.0 and 441.67
Procedure.f ColorDistance(Color1.l, Color2.l)

	Protected dR.i = Abs(Red(Color1)-Red(Color2))
	Protected dG.i = Abs(Green(Color1)-Green(Color2))
	Protected dB.i = Abs(Blue(Color1)-Blue(Color2))

	ProcedureReturn Sqr(dR*dR + dG*dG + dB*dB)

EndProcedure

; Mix two colors with a linear interpolation. color = color1*(1-factor) + color2*factor
Procedure.l ColorMix(Color1.l, Color2.l, Factor.f)

	Protected R.i = Red(Color1)*(1-Factor) + Red(Color2)*Factor
	Protected G.i = Green(Color1)*(1-Factor) + Green(Color2)*Factor
	Protected B.i = Blue(Color1)*(1-Factor) + Blue(Color2)*Factor

	ProcedureReturn RGB(R, G, B)

EndProcedure

; Perform a smooth filling of area (x,y) with color FillColor using the max color distance MaxColorDistance
Procedure SmoothFillArea(X.i, Y.i, FillColor.l, MaxColorDistance.f)

	Protected Dim Filled.i(OutputWidth()-1, OutputHeight()-1)
	Protected NewList Seeds.Vector()
	Protected Factor.f
	Protected SeedColor.l = Point(X, Y)

	AddElement(Seeds()) : Seeds()\X = X : Seeds()\Y = Y : Filled(X, Y) = #True

	ResetList(Seeds())
	While NextElement(Seeds())
		*Seed.Vector = @Seeds()
		With *Seed
			If MaxColorDistance = 0
				Factor = Bool(ColorDistance(Point(\X, Seeds()\Y), SeedColor) <> 0.0)
			Else
				Factor = ColorDistance(Point(\X, Seeds()\Y), SeedColor) / MaxColorDistance
			EndIf
			If Factor < 1.0
				Plot(\X, \Y, ColorMix(FillColor, Point(\X, \Y), Factor*Factor))
				If \X > 0 And Filled(\X-1, \Y) = #False
					AddElement(Seeds()) : Seeds()\X = \X-1 : Seeds()\Y = \Y : Filled(\X-1, \Y) = #True
				EndIf
				If \X < OutputWidth()-1 And Filled(\X+1, \Y) = #False
					AddElement(Seeds()) : Seeds()\X = \X+1 : Seeds()\Y = \Y : Filled(\X+1, \Y) = #True
				EndIf
				If \Y > 0 And Filled(\X, \Y-1) = #False
					AddElement(Seeds()) : Seeds()\X = \X : Seeds()\Y = \Y-1 : Filled(\X, \Y-1) = #True
				EndIf
				If \Y < OutputHeight()-1 And Filled(\X, \Y+1) = #False
					AddElement(Seeds()) : Seeds()\X = \X : Seeds()\Y = \Y+1 : Filled(\X, \Y+1) = #True
				EndIf
				ChangeCurrentElement(Seeds(), *Seed)
			EndIf
		EndWith
	Wend

EndProcedure


;- Example

InitNetwork()

UsePNGImageDecoder()

CatchImage(#Image, ReceiveHTTPMemory("https://i.ibb.co/WP4XVGd/cat3.png"))

width=ImageWidth(#Image)
height=ImageHeight(#Image)

OpenWindow(#Window,0,0,width,height+30,"Smooth Fill Area",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
CanvasGadget(#Gadget,0,0,width,height)
TrackBarGadget(#Slider,0,height,width,30,0,440)

If StartDrawing(CanvasOutput(#Gadget))
	DrawImage(ImageID(#Image), 0, 0)
	StopDrawing()
EndIf

Define FillColor.l = $FFB040       ; Filling color
Define MaxColorDistance.f = 200.0  ; Max distance of the colors: 0.0 until 441.67
; 0.0 meens only exacly same pixel color. Value over 441.67 fills all pixels

SetGadgetState(#Slider,MaxColorDistance)

Repeat
	Select WaitWindowEvent()
	Case #PB_Event_CloseWindow
		Break
	Case #PB_Event_Gadget
		Select EventGadget()
		Case #Slider
			MaxColorDistance=GetGadgetState(#Slider)
			SetWindowTitle(#Window,"Distance = "+Str(MaxColorDistance))
		Case #Gadget
			Select EventType()
			Case #PB_EventType_LeftClick
				If StartDrawing(CanvasOutput(#Gadget))
					SmoothFillArea(GetGadgetAttribute(#Gadget, #PB_Canvas_MouseX), GetGadgetAttribute(#Gadget, #PB_Canvas_MouseY), FillColor, MaxColorDistance)
					StopDrawing()
				EndIf
			EndSelect
		EndSelect
	EndSelect
ForEver

End

Re: Smoother FillArea routine

Posted: Thu Oct 14, 2021 9:19 am
by kernadec
hello,
Really nice thanks @ STARGÅTE, Michael Vogel
Best Regards
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited