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?
Smoother FillArea routine
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.
- 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
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.
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 more ― Typeface - Sprite-based font include/module
Lizard - Script language for symbolic calculations and more ― Typeface - Sprite-based font include/module
Re: Smoother FillArea routine
@STARGÅTE: Awesome code, thanks!
-
- Enthusiast
- Posts: 544
- 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?
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
Milky Way Local_Group Virgo Supercluster Laniakea Universe
- Michael Vogel
- Addict
- Posts: 2666
- 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:
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
hello,
Really nice thanks @ STARGÅTE, Michael Vogel
Best Regards
Really nice thanks @ STARGÅTE, Michael Vogel
Best Regards