Smoother FillArea routine

Just starting out? Need help? Post your questions and find answers here.
firace
Addict
Addict
Posts: 899
Joined: Wed Nov 09, 2011 8:58 am

Smoother FillArea routine

Post 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
Olli
Addict
Addict
Posts: 1071
Joined: Wed May 27, 2020 12:26 pm

Re: Smoother FillArea routine

Post 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.
User avatar
STARGÅTE
Addict
Addict
Posts: 2067
Joined: Thu Jan 10, 2008 1:30 pm
Location: Germany, Glienicke
Contact:

Re: Smoother FillArea routine

Post 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
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Lizard - Script language for symbolic calculations and moreTypeface - Sprite-based font include/module
firace
Addict
Addict
Posts: 899
Joined: Wed Nov 09, 2011 8:58 am

Re: Smoother FillArea routine

Post by firace »

@STARGÅTE: Awesome code, thanks! 8) 8)
User avatar
Caronte3D
Addict
Addict
Posts: 1027
Joined: Fri Jan 22, 2016 5:33 pm
Location: Some Universe

Re: Smoother FillArea routine

Post by Caronte3D »

+1000 :wink:
juergenkulow
Enthusiast
Enthusiast
Posts: 544
Joined: Wed Sep 25, 2019 10:18 am

Re: Smoother FillArea routine

Post by juergenkulow »

Coloring the cat's eye takes 13 ms where the seeds list has 3536 elements,
Can this be done under 1 ms?
Please ask your questions, because switch on the cognition apparatus decides on the only known life in the universe.Wersten :DDüsseldorf NRW Germany Europe Earth Solar System Flake Bubble Orionarm
Milky Way Local_Group Virgo Supercluster Laniakea Universe
User avatar
Michael Vogel
Addict
Addict
Posts: 2666
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

Re: Smoother FillArea routine

Post 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
User avatar
kernadec
Enthusiast
Enthusiast
Posts: 146
Joined: Tue Jan 05, 2010 10:35 am

Re: Smoother FillArea routine

Post by kernadec »

hello,
Really nice thanks @ STARGÅTE, Michael Vogel
Best Regards
Post Reply