## Smoother FillArea routine

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

### Smoother FillArea routine

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? Olli
Enthusiast Posts: 421
Joined: Wed May 27, 2020 12:26 pm

### Re: Smoother FillArea routine

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

### Re: Smoother FillArea routine

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
#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()

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

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
Select EventType()
Case #PB_EventType_LeftClick
StopDrawing()
EndIf
EndSelect
EndSelect
EndSelect
ForEver

End
``````
PB 5.73 ― Win 10, 20H2 ― Ryzen 9 3900X ― Radeon RX 5600 XT ITX ― Vivaldi 4.0 ― www.unionbytes.de
Lizard - Script language for symbolic calculations and moreTypeface - Sprite-based font include/module
firace
Enthusiast Posts: 728
Joined: Wed Nov 09, 2011 8:58 am

### Re: Smoother FillArea routine

@STARGÅTE: Awesome code, thanks!  Caronte3D
Enthusiast Posts: 227
Joined: Fri Jan 22, 2016 5:33 pm
Location: Spain

### Re: Smoother FillArea routine

+1000 juergenkulow
User Posts: 64
Joined: Wed Sep 25, 2019 10:18 am

### Re: Smoother FillArea routine

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
Michael Vogel Posts: 2576
Joined: Thu Feb 09, 2006 11:27 pm
Contact:

### Re: Smoother FillArea routine

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) Only added a slider quicly to see how different parameter values change the behaviour of the filling routine:

Code: Select all

``````Enumeration
#Window
#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()

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

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

Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Break
Case #Slider
SetWindowTitle(#Window,"Distance = "+Str(MaxColorDistance))
Select EventType()
Case #PB_EventType_LeftClick
StopDrawing()
EndIf
EndSelect
EndSelect
EndSelect
ForEver

End
`````` 