Test for 4 and 8 way stepping FloodFill and RowByRowFill.

Post your FreeBASIC tips and tricks here. Please don’t post your code without including an explanation.
D.J.Peters
Posts: 7852
Joined: May 28, 2005 3:28

Test for 4 and 8 way stepping FloodFill and RowByRowFill.

Postby D.J.Peters » Sep 08, 2006 2:54

FloodFill needs more calls/time and stackspace as RowByRowFill.

Joshy

Code: Select all

'  #########################
' # flood versus row fill #
'#########################
private sub _
Draw8(byval x as integer, _
      byval y as integer, _
      byval c as ulong, _
      byval z as integer)
  line (x-8*z,y-14*z)-step(16*z,28*z),c,b
  line (x-4*z,y-10*z)-step( 8*z, 8*z),c,b
  line (x-4*z,y+ 2*z)-step( 8*z, 8*z),c,b
end sub

private sub _
FloodFill (byval x as integer, _
           byval y as integer, _
           byval o as ulong, _
           byval n as ulong)
  If Point(x, y)<>o Then Exit Sub
 
  Pset(x,y),n
  floodfill(x-1, y  , o,n)
  floodfill(x+1, y  , o,n)
  floodfill(x  , y-1, o,n)
  floodfill(x  , y+1, o,n)
 
End Sub


private sub _
RowByRowFill(byval x as integer, _
             byval y as integer, _
             byval o as ulong, _
             byval n as ulong)
  dim as integer i,l,r,lastx=x+1
 
  while point(x,y)=o
    Pset(x, y),n:x-=1
  wend
  l=x+1:x=lastx
  while point(x,y)=o
    Pset(x, y),n:x+=1
  wend
  r=x-1
  for x=l to r-1
    if point(x,y-1)=o then RowByRowFill(x,y-1,o,n)
    if point(x,y+1)=o then RowByRowFill(x,y+1,o,n)
  next
end sub

'
' main
'
dim as ulong c,newColor,oldColor=RGBA(0,0,0,255)
dim as double t1,t2

screenres 640, 480, 32
draw8 160,220,RGBA(255,255,255,255),10
draw8 480,220,RGBA(255,255,255,255),10

t1=timer
for c=1 to 255
  newColor=rgba(c,0,0,255)
  screenlock
  FloodFill    160, 220, oldColor,newColor
  screenunlock
  oldColor=newColor
next
t1=timer-t1

oldColor=RGBA(0,0,0,255)

t2=timer
for c=1 to 255
  newColor=rgba(c,0,0,255)
  screenlock
  RowByRowfill 480, 220, oldColor,newColor
  screenunlock
  oldColor=newColor
next
t2=timer-t2

? t1,t2
Sleep
Last edited by D.J.Peters on Aug 05, 2016 21:16, edited 2 times in total.
axipher
Posts: 891
Joined: Dec 27, 2005 16:37
Location: Sudbury,Ontario
Contact:

Postby axipher » Sep 08, 2006 12:13

Nice work here.
D.J.Peters
Posts: 7852
Joined: May 28, 2005 3:28

Postby D.J.Peters » Sep 08, 2006 13:29

axipher wrote:Nice work here.

Not my work this are old standard algos i posted only this compare for the peoples that use often FloodFill without to know about RowByRowFill.

But i like recursive algos.

Joshy
D.J.Peters
Posts: 7852
Joined: May 28, 2005 3:28

Postby D.J.Peters » Sep 08, 2006 14:15

Code: Select all

'  ##########################################
' # 4 and 8 way stepping versus row by row #
'##########################################

private sub _
Draw8(byval x as integer, _
      byval y as integer, _
      byval c as ulong, _
      byval z as integer=10)
  line (x-8*z,y-14*z)-step(16*z,28*z),c,b
  line (x-4*z,y-10*z)-step( 8*z, 8*z),c,b
  line (x-4*z,y+ 2*z)-step( 8*z, 8*z),c,b
end sub

' 4 way stepping
private sub _
FloodFill (byval x as integer, _
           byval y as integer, _
           byval o as ulong, _
           byval n as ulong)
  If Point(x, y)<>o Then Exit Sub
 
  Pset(x,y),n
  FloodFill x - 1, y    , o,n
  FloodFill x + 1, y    , o,n
  FloodFill x    , y - 1, o,n
  FloodFill x    , y + 1, o,n
 
End Sub

' 8 way stepping
private sub _
BoundaryFill(byval x as integer, _
             byval y as integer, _
             byval o as ulong, _
             byval n as ulong)

  if point(x,y)=o then
    pset(x,y),n
    BoundaryFill(x+1, y  ,o,n)
    BoundaryFill(x+1, y+1,o,n)
    BoundaryFill(x,   y+1,o,n)
    BoundaryFill(x-1, y+1,o,n)
    BoundaryFill(x-1, y  ,o,n)
    BoundaryFill(x-1, y-1,o,n)
    BoundaryFill(x,   y-1,o,n)
    BoundaryFill(x+1, y-1,o,n)
  end if
end sub

' line by line stepping
private sub _
RowByRowFill(byval x as integer, _
             byval y as integer, _
             byval o as ulong, _
             byval n as ulong)
  dim as integer i,l,r,lastx=x+1
 
  while point(x,y)=o
    Pset(x, y),n:x-=1
  wend
  l=x+1:x=lastx
  while point(x,y)=o
    Pset(x, y),n:x+=1
  wend
  r=x-1
  for x=l to r-1
    if (point(x,y-1)=o) then RowByRowFill(x,y-1,o,n)
    if (point(x,y+1)=o) then RowByRowFill(x,y+1,o,n)
  next
end sub



'
' main
'
dim as ulong c,oldcolor=rgba(0,0,0,255),newcolor
dim as double t1,t2,t3

screenres 640, 480, 32
draw8 150,220,rgba(255,255,255,255),10
draw8 320,220,rgba(255,255,255,255),10
draw8 490,220,rgba(255,255,255,255),10
locate 6,13
? "4 way stepping      8 way stepping    top bottom row stepping"
t1=timer
for c=1 to 255
  newcolor=rgba(c,0,0,255)
  screenlock
  FloodFill    150, 220, oldcolor,newcolor
  screenunlock
  oldcolor=newcolor
next
t1=timer-t1

oldcolor=rgba(0,0,0,255)

t2=timer
for c=1 to 255
  newcolor=rgba(0,c,0,255)
  screenlock
  BoundaryFill 320, 220, oldcolor,newcolor
  screenunlock
  oldcolor=newcolor
next
t2=timer-t2

oldcolor=rgba(0,0,0,255)

t3=timer
for c=1 to 255
  newcolor=rgba(0,0,c,255)
  screenlock
  RowByRowfill 490, 220, oldcolor,newcolor
  screenunlock
  oldcolor=newcolor
next
t3=timer-t3
locate 48,1
? "4 way stepping: " & t1
? "8 way stepping: " & t2
? "row by row    : " & t3

Sleep
Last edited by D.J.Peters on Aug 05, 2016 21:24, edited 1 time in total.
parakeet
Posts: 48
Joined: Mar 30, 2006 15:46
Location: Lille, France

25% gain

Postby parakeet » Sep 08, 2006 15:35

The floodfill algo is recursive :
For each pixel, the algo tests if the color is not already set. If not, it sets it, then does the same for each 4 neighbours : left, right, up, down.

my proposition is to avoid propagation to the pixel from which we come, because we know for sure that its color has already been set

Anselme

Code: Select all

'  ##################
' # improved flood #
'##################
private Sub _
Draw8(Byval x As Integer, _
      Byval y As Integer, _
      Byval c As Integer, _
      Byval z As Integer=10)
  Line (x-8*z,y-14*z)-Step(16*z,28*z),c,b
  Line (x-4*z,y-10*z)-Step( 8*z, 8*z),c,b
  Line (x-4*z,y+ 2*z)-Step( 8*z, 8*z),c,b
End Sub

private Sub _
FloodFill (Byval x   As Integer, _
           Byval y   As Integer, _
           Byval old As Integer, _
           Byval new As Integer)
  If Point(x, y)<>old Then Exit Sub
 
  Pset(x,y),new
  floodfill x - 1, y    , old,new
  floodfill x + 1, y    , old,new
  floodfill x    , y - 1, old,new
  floodfill x    , y + 1, old,new
 
End Sub

''''''''''''''''''''''''''''''''''''''''
declare Sub _
AllButDownfloodfill (Byval x   As Integer, _
           Byval y   As Integer, _
           Byval old As Integer, _
           Byval new As Integer)

declare Sub _
AllButUpfloodfill (Byval x   As Integer, _
           Byval y   As Integer, _
           Byval old As Integer, _
           Byval new As Integer)


private Sub _
AllButRightfloodfill (Byval x   As Integer, _
           Byval y   As Integer, _
           Byval old As Integer, _
           Byval new As Integer)
  If Point(x, y)<>old Then Exit Sub
 
  Pset(x,y),new
  AllButRightfloodfill x - 1, y    , old,new
  AllButDownfloodfill x    , y - 1, old,new
  AllButUpfloodfill x    , y + 1, old,new
 
End Sub

private Sub _
AllButLeftfloodfill (Byval x   As Integer, _
           Byval y   As Integer, _
           Byval old As Integer, _
           Byval new As Integer)
  If Point(x, y)<>old Then Exit Sub
 
  Pset(x,y),new
  AllButLeftfloodfill x + 1, y    , old,new
  AllButDownfloodfill x    , y - 1, old,new
  AllButUpfloodfill x    , y + 1, old,new
 
End Sub

private Sub _
AllButDownfloodfill (Byval x   As Integer, _
           Byval y   As Integer, _
           Byval old As Integer, _
           Byval new As Integer)
  If Point(x, y)<>old Then Exit Sub
 
  Pset(x,y),new
  AllButRightfloodfill x - 1, y    , old,new
  AllButLeftfloodfill x + 1, y    , old,new
  AllButDownfloodfill x    , y - 1, old,new
 
End Sub

private Sub _
AllButUpfloodfill (Byval x   As Integer, _
           Byval y   As Integer, _
           Byval old As Integer, _
           Byval new As Integer)
  If Point(x, y)<>old Then Exit Sub
 
  Pset(x,y),new
  AllButRightfloodfill x - 1, y    , old,new
  AllButLeftfloodfill x + 1, y    , old,new
  AllButUpfloodfill x    , y + 1, old,new
 
End Sub


private Sub _
AllFloodFill (Byval x   As Integer, _
           Byval y   As Integer, _
           Byval old As Integer, _
           Byval new As Integer)
  If Point(x, y)<>old Then Exit Sub
 
  Pset(x,y),new
  AllButRightfloodfill x - 1, y    , old,new
  AllButLeftfloodfill x + 1, y    , old,new
  AllButDownfloodfill x    , y - 1, old,new
  AllButUpfloodfill x    , y + 1, old,new
 
End Sub


'
' main
'
Dim As Double t1, t2

screenres 640, 480, 32
draw8 160,220,&HFFFFFF,10
draw8 480,220,&HFFFFFF,10

sleep 1000

oldcolor = 0

t1=Timer
For c=1 To 255
  newcolor=rgb(c,0,0)
  FloodFill    150, 220, oldcolor,newcolor
  oldcolor=newcolor
Next
t1=timer-t1

oldcolor = 0

t2=Timer
For c=1 To 255
  newcolor=rgb(c,0,0)
  AllFloodFill    480, 220, oldcolor,newcolor
  oldcolor=newcolor
Next
t2=timer-t2

?t1,t2
Sleep
[/quote]
D.J.Peters
Posts: 7852
Joined: May 28, 2005 3:28

Postby D.J.Peters » Sep 08, 2006 15:49

Hello parakeet thanks for your idea.

All 4 algos together RowByRow is faster on my box.

Joshy

Code: Select all

'  ##############################################
' # 4 and 8 way stepping rowbyrow Allfloodfill #
'##############################################
private sub _
Draw8(byval x as integer, _
      byval y as integer, _
      byval c as integer, _
      byval z as integer=10)
  line (x-8*z,y-14*z)-step(16*z,28*z),c,b
  line (x-4*z,y-10*z)-step( 8*z, 8*z),c,b
  line (x-4*z,y+ 2*z)-step( 8*z, 8*z),c,b
end sub

Declare Sub _
AllButDownfloodfill (Byval x   As Integer, _
           Byval y   As Integer, _
           Byval old As Integer, _
           Byval new As Integer)

Declare Sub _
AllButUpfloodfill (Byval x   As Integer, _
           Byval y   As Integer, _
           Byval old As Integer, _
           Byval new As Integer)


private Sub _
AllButRightfloodfill (Byval x   As Integer, _
           Byval y   As Integer, _
           Byval old As Integer, _
           Byval new As Integer)
  If Point(x, y)<>old Then Exit Sub
 
  Pset(x,y),new
  AllButRightfloodfill x - 1, y    , old,new
  AllButDownfloodfill  x    , y - 1, old,new
  AllButUpfloodfill    x    , y + 1, old,new
End Sub

private Sub _
AllButLeftfloodfill (Byval x   As Integer, _
                     Byval y   As Integer, _
                     Byval old As Integer, _
                     Byval new As Integer)
  If Point(x, y)<>old Then Exit Sub
  Pset(x,y),new
  AllButLeftfloodfill x + 1, y    , old,new
  AllButDownfloodfill x    , y - 1, old,new
  AllButUpfloodfill x    , y + 1, old,new
End Sub

private Sub _
AllButDownfloodfill (Byval x   As Integer, _
                     Byval y   As Integer, _
                     Byval old As Integer, _
                     Byval new As Integer)
  If Point(x, y)<>old Then Exit Sub
 
  Pset(x,y),new
  AllButRightfloodfill x - 1, y    , old,new
  AllButLeftfloodfill x + 1, y    , old,new
  AllButDownfloodfill x    , y - 1, old,new
End Sub

private Sub _
AllButUpfloodfill (Byval x   As Integer, _
                   Byval y   As Integer, _
                   Byval old As Integer, _
                   Byval new As Integer)
  If Point(x, y)<>old Then Exit Sub
  Pset(x,y),new
  AllButRightfloodfill x - 1, y    , old,new
  AllButLeftfloodfill x + 1, y    , old,new
  AllButUpfloodfill x    , y + 1, old,new
End Sub

private Sub _
AllFloodFill (Byval x   As Integer, _
              Byval y   As Integer, _
              Byval old As Integer, _
              Byval new As Integer)
  If Point(x, y)<>old Then Exit Sub
  Pset(x,y),new
  AllButRightfloodfill x - 1, y    , old,new
  AllButLeftfloodfill x + 1, y    , old,new
  AllButDownfloodfill x    , y - 1, old,new
  AllButUpfloodfill x    , y + 1, old,new
End Sub


' vour way stepping
private sub _
FloodFill (byval x   as integer, _
           byval y   as integer, _
           byval old as integer, _
           byval new as integer)
  If Point(x, y)<>old Then Exit Sub
 
  Pset(x,y),new
  FloodFill x - 1, y    , old,new
  FloodFill x + 1, y    , old,new
  FloodFill x    , y - 1, old,new
  FloodFill x    , y + 1, old,new
 
End Sub

' 8 way stepping
private sub _
BoundaryFill(byval x   as integer, _
             byval y   as integer, _
             byval old as integer, _
             byval new as integer)

  if point(x,y)=old then
    pset(x,y),new
    BoundaryFill(x+1, y  ,old,new)
    BoundaryFill(x+1, y+1,old,new)
    BoundaryFill(x,   y+1,old,new)
    BoundaryFill(x-1, y+1,old,new)
    BoundaryFill(x-1, y  ,old,new)
    BoundaryFill(x-1, y-1,old,new)
    BoundaryFill(x,   y-1,old,new)
    BoundaryFill(x+1, y-1,old,new)
  end if
end sub

' line by line stepping
private sub _
RowByRowFill(byval x   as integer, _
             byval y   as integer, _
             byval old as integer, _
             byval new as integer)
  dim as integer i,l,r,lastx=x+1
 
  while point(x,y)=old
    Pset(x, y),new:x-=1
  wend
  l=x+1:x=lastx
  while point(x,y)=old
    Pset(x, y),new:x+=1
  wend
  r=x-1
  for x=l to r-1
    if (point(x,y-1)= old) then RowByRowFill(x,y-1,old,new)
    if (point(x,y+1)= old) then RowByRowFill(x,y+1,old,new)
  next 
end sub



'
' main
'
dim as integer c,oldcolor,newcolor
dim as double t1,t2,t3,t4

screenres 640, 480, 32
draw8 128,220,&HFFFFFF,7
draw8 256,220,&HFFFFFF,7
draw8 384,220,&HFFFFFF,7
draw8 512,220,&HFFFFFF,7

t1=timer
for c=1 to 255
  newcolor=rgb(c,0,0)
  FloodFill    128, 220, oldcolor,newcolor
  oldcolor=newcolor
next
t1=timer-t1

oldcolor=0

t2=timer
for c=1 to 255
  newcolor=rgb(0,c,0)
  BoundaryFill 256, 220, oldcolor,newcolor
  oldcolor=newcolor
next
t2=timer-t2

oldcolor=0

t3=timer
for c=1 to 255
  newcolor=rgb(0,0,c)
  RowByRowfill 384, 220, oldcolor,newcolor
  oldcolor=newcolor
next
t3=timer-t3

oldcolor=0

t4=timer
for c=1 to 255
  newcolor=rgb(c,c,c)
  AllFloodFill 512, 220, oldcolor,newcolor
  oldcolor=newcolor
next
t4=timer-t4


locate 48,1
? "4 way stepping:" & str(t1)
? "8 way stepping:" & str(t2)
? "row by row    :" & str(t3)
? "AllFloodFill  :" & str(t4)
Sleep
Last edited by D.J.Peters on Sep 08, 2006 15:53, edited 1 time in total.
duke4e
Posts: 717
Joined: Dec 04, 2005 0:16
Location: Varazdin, Croatia, Europe
Contact:

Postby duke4e » Sep 08, 2006 15:53

Here's Ken Silvermans flood fill

Code: Select all

Dim a(80, 25), px(80 * 25), py(80 * 25)
For yy = 1 To 25
   Read z$: If z$ = "" Then Exit For
   Print z$: xx = Instr(z$, "0"): If xx Then x = xx: y = yy
   For xx = 1 To Len(z$): a(xx, yy) = Asc(MID$(z$, xx, 1)): Next
Next
Data "    ############   "
Data "    #  #       ####"
Data "#####  #  ####    #"
Data "#      ####    ####"
Data "#    0         #  #"
Data "#      ## #       #"
Data "#      #  #       #"
Data "#      #  #       #"
Data "#      #  #    ####"
Data "################   "

Do
   Locate y, x
   Print HEX$(d);
   Sleep 30
   
   If a(x - 1, y) = 32 Then a(x - 1, y) = 1: px(w) = x - 1: py(w) = y: w = w + 1
   If a(x + 1, y) = 32 Then a(x + 1, y) = 1: px(w) = x + 1: py(w) = y: w = w + 1
   If a(x, y - 1) = 32 Then a(x, y - 1) = 1: px(w) = x: py(w) = y - 1: w = w + 1
   If a(x, y + 1) = 32 Then a(x, y + 1) = 1: px(w) = x: py(w) = y + 1: w = w + 1
   
   If r = w Then Exit Do
   x = px(r)
   y = py(r)
   r = r + 1
   
Loop
parakeet
Posts: 48
Joined: Mar 30, 2006 15:46
Location: Lille, France

row_by_row_fill+

Postby parakeet » Sep 10, 2006 13:37

Same idea as the one I had for 4 ways, but applied to the fast "row by row". Gives the fastest algo (25%) on my machine.

Anselme


Code: Select all

'  ##############################################
' # 4 and 8 way stepping rowbyrow rowbyrow+ #
'##############################################
private Sub _
Draw8(Byval x As Integer, _
      Byval y As Integer, _
      Byval c As Integer, _
      Byval z As Integer=10)
  Line (x-8*z,y-14*z)-Step(16*z,28*z),c,b
  Line (x-4*z,y-10*z)-Step( 8*z, 8*z),c,b
  Line (x-4*z,y+ 2*z)-Step( 8*z, 8*z),c,b
End Sub

' vour way stepping
private Sub _
FloodFill (Byval x   As Integer, _
           Byval y   As Integer, _
           Byval old As Integer, _
           Byval new As Integer)
  If Point(x, y)<>old Then Exit Sub
 
  Pset(x,y),new
  FloodFill x - 1, y    , old,new
  FloodFill x + 1, y    , old,new
  FloodFill x    , y - 1, old,new
  FloodFill x    , y + 1, old,new
 
End Sub

' 8 way stepping
private Sub _
BoundaryFill(Byval x   As Integer, _
             Byval y   As Integer, _
             Byval old As Integer, _
             Byval new As Integer)

  If Point(x,y)=old Then
    Pset(x,y),new
    BoundaryFill(x+1, y  ,old,new)
    BoundaryFill(x+1, y+1,old,new)
    BoundaryFill(x,   y+1,old,new)
    BoundaryFill(x-1, y+1,old,new)
    BoundaryFill(x-1, y  ,old,new)
    BoundaryFill(x-1, y-1,old,new)
    BoundaryFill(x,   y-1,old,new)
    BoundaryFill(x+1, y-1,old,new)
  End If
End Sub

' line by line stepping
private Sub _
RowByRowFill(Byval x   As Integer, _
             Byval y   As Integer, _
             Byval old As Integer, _
             Byval new As Integer)
  Dim As Integer i,l,r,lastx=x+1
 
  While Point(x,y)=old
    Pset(x, y),new:x-=1
  Wend
  l=x+1:x=lastx
  While Point(x,y)=old
    Pset(x, y),new:x+=1
  Wend
  r=x-1
  For x=l To r-1
    If (Point(x,y-1)= old) Then RowByRowFill(x,y-1,old,new)
    If (Point(x,y+1)= old) Then RowByRowFill(x,y+1,old,new)
  Next 
End Sub







' line by line stepping plus
private Sub _
RowByRowFillLeft(Byval x   As Integer, _
             Byval y   As Integer, _
             Byval old As Integer, _
             Byval new As Integer)
  Dim As Integer i,l,r,lastx=x+1
 
  While Point(x,y)=old
    Pset(x, y),new:x-=1
  Wend
  l=x+1:x=lastx
  While Point(x,y)=old
    Pset(x, y),new:x+=1
  Wend
  r=x-1
  For x=l To r-1
    If (Point(x,y-1)= old) Then RowByRowFillLeft(x,y-1,old,new)
  Next 
End Sub

private Sub _
RowByRowFillRight(Byval x   As Integer, _
             Byval y   As Integer, _
             Byval old As Integer, _
             Byval new As Integer)
  Dim As Integer i,l,r,lastx=x+1
 
  While Point(x,y)=old
    Pset(x, y),new:x-=1
  Wend
  l=x+1:x=lastx
  While Point(x,y)=old
    Pset(x, y),new:x+=1
  Wend
  r=x-1
  For x=l To r-1
    If (Point(x,y+1)= old) Then RowByRowFillRight(x,y+1,old,new)
  Next 
End Sub

private Sub _
RowByRowFillPlus(Byval x   As Integer, _
             Byval y   As Integer, _
             Byval old As Integer, _
             Byval new As Integer)
  Dim As Integer i,l,r,lastx=x+1
 
  While Point(x,y)=old
    Pset(x, y),new:x-=1
  Wend
  l=x+1:x=lastx
  While Point(x,y)=old
    Pset(x, y),new:x+=1
  Wend
  r=x-1
  For x=l To r-1
    If (Point(x,y-1)= old) Then RowByRowFillLeft(x,y-1,old,new)
    If (Point(x,y+1)= old) Then RowByRowFillRight(x,y+1,old,new)
  Next 
End Sub




'
' main
'
Dim As Integer c,oldcolor,newcolor
Dim As Double t1,t2,t3,t4

screenres 640, 480, 32
draw8 128,220,&HFFFFFF,7
draw8 256,220,&HFFFFFF,7
draw8 384,220,&HFFFFFF,7
draw8 512,220,&HFFFFFF,7

t1=Timer
For c=1 To 255
  newcolor=rgb(c,0,0)
  FloodFill    128, 220, oldcolor,newcolor
  oldcolor=newcolor
Next
t1=timer-t1

oldcolor=0

t2=Timer
For c=1 To 255
  newcolor=rgb(0,c,0)
  BoundaryFill 256, 220, oldcolor,newcolor
  oldcolor=newcolor
Next
t2=timer-t2

oldcolor=0

t3=Timer
For c=1 To 255
  newcolor=rgb(0,0,c)
  RowByRowfill 384, 220, oldcolor,newcolor
  oldcolor=newcolor
Next
t3=timer-t3

oldcolor=0

t4=Timer
For c=1 To 255
  newcolor=rgb(c,c,c)
  RowByRowfillPlus 512, 220, oldcolor,newcolor
  oldcolor=newcolor
Next
t4=timer-t4


Locate 48,1
? "4 way stepping:" & Str(t1)
? "8 way stepping:" & Str(t2)
? "row by row    :" & Str(t3)
? "row by row +  :" & Str(t4)
Sleep
TbbW
Posts: 348
Joined: Aug 19, 2005 10:08
Contact:

Postby TbbW » Sep 12, 2006 6:46

yeh row by row whas alot faster then the 4 and 8
parakeet
Posts: 48
Joined: Mar 30, 2006 15:46
Location: Lille, France

Postby parakeet » Sep 12, 2006 7:36

I think you misunderstood me :

I optimized the row by row algo.

Yours,
Anselme
parakeet
Posts: 48
Joined: Mar 30, 2006 15:46
Location: Lille, France

optimized again the row_by_row by 40%

Postby parakeet » Sep 12, 2006 16:39

Hi,
This is another idea applied to the row by row :

The normal row_by_row is :
Imagine we are on pixel x,y
We pset this pixel
We test the pixel above and below, and eventually recurse above and below if they are empty.
we move to pixel x+1, y

The first optimization (25%) was not to test below if we came from below. Same for above.

The second optimization (15% more) : When the line above has been filled until column N, it is not necessary to test above before we are on pixel N,y

Yours,
Anselme

Code: Select all

'  ##############################################
' # 4 and 8 way stepping rowbyrow Allfloodfill #
'##############################################
private Sub _
Draw8(Byval x As Integer, _
      Byval y As Integer, _
      Byval c As Integer, _
      Byval z As Integer=10)
  Line (x-8*z,y-14*z)-Step(16*z,28*z),c,b
  Line (x-4*z,y-10*z)-Step( 8*z, 8*z),c,b
  Line (x-4*z,y+ 2*z)-Step( 8*z, 8*z),c,b
End Sub

' vour way stepping
private Sub _
FloodFill (Byval x   As Integer, _
           Byval y   As Integer, _
           Byval old As Integer, _
           Byval new As Integer)
  If Point(x, y)<>old Then Exit Sub
 
  Pset(x,y),new
  FloodFill x - 1, y    , old,new
  FloodFill x + 1, y    , old,new
  FloodFill x    , y - 1, old,new
  FloodFill x    , y + 1, old,new
 
End Sub

' 8 way stepping
private Sub _
BoundaryFill(Byval x   As Integer, _
             Byval y   As Integer, _
             Byval old As Integer, _
             Byval new As Integer)

  If Point(x,y)=old Then
    Pset(x,y),new
    BoundaryFill(x+1, y  ,old,new)
    BoundaryFill(x+1, y+1,old,new)
    BoundaryFill(x,   y+1,old,new)
    BoundaryFill(x-1, y+1,old,new)
    BoundaryFill(x-1, y  ,old,new)
    BoundaryFill(x-1, y-1,old,new)
    BoundaryFill(x,   y-1,old,new)
    BoundaryFill(x+1, y-1,old,new)
  End If
End Sub

' line by line stepping
private Sub _
RowByRowFill(Byval x   As Integer, _
             Byval y   As Integer, _
             Byval old As Integer, _
             Byval new As Integer)
  Dim As Integer i,l,r,lastx=x+1
 
  While Point(x,y)=old
    Pset(x, y),new:x-=1
  Wend
  l=x+1:x=lastx
  While Point(x,y)=old
    Pset(x, y),new:x+=1
  Wend
  r=x-1
  For x=l To r-1
    If (Point(x,y-1)= old) Then RowByRowFill(x,y-1,old,new)
    If (Point(x,y+1)= old) Then RowByRowFill(x,y+1,old,new)
  Next 
End Sub







''''''''''''''''''''PLUS''''''''''''''''''''''
' line by line stepping plus
private Sub _
RowByRowFillUp(Byval x   As Integer, _
             Byval y   As Integer, _
             Byval old As Integer, _
             Byval new As Integer)
  Dim As Integer i,l,r,lastx=x+1
 
  While Point(x,y)=old
    Pset(x, y),new:x-=1
  Wend
  l=x+1:x=lastx
  While Point(x,y)=old
    Pset(x, y),new:x+=1
  Wend
  r=x-1
  For x=l To r-1
    If (Point(x,y-1)= old) Then RowByRowFillUp(x,y-1,old,new)
  Next 
End Sub

private Sub _
RowByRowFillDown(Byval x   As Integer, _
             Byval y   As Integer, _
             Byval old As Integer, _
             Byval new As Integer)
  Dim As Integer i,l,r,lastx=x+1
 
  While Point(x,y)=old
    Pset(x, y),new:x-=1
  Wend
  l=x+1:x=lastx
  While Point(x,y)=old
    Pset(x, y),new:x+=1
  Wend
  r=x-1
  For x=l To r-1
    If (Point(x,y+1)= old) Then RowByRowFillDown(x,y+1,old,new)
  Next 
End Sub

private Sub _
RowByRowFillPlus(Byval x   As Integer, _
             Byval y   As Integer, _
             Byval old As Integer, _
             Byval new As Integer)
  Dim As Integer i,l,r,lastx=x+1
 
  While Point(x,y)=old
    Pset(x, y),new:x-=1
  Wend
  l=x+1:x=lastx
  While Point(x,y)=old
    Pset(x, y),new:x+=1
  Wend
  r=x-1
  For x=l To r-1
    If (Point(x,y-1)= old) Then RowByRowFillUp(x,y-1,old,new)
    If (Point(x,y+1)= old) Then RowByRowFillDown(x,y+1,old,new)
  Next 
End Sub


''''''''''''''''''''PLUS PLUS''''''''''''''''''''''

' line by line stepping plus plus
private Function _
RowByRowFillUpPP(Byval x   As Integer, _
             Byval y   As Integer, _
             Byval old As Integer, _
             Byval new As Integer) as integer
  Dim As Integer i,l,r,lastx=x+1
 
  While Point(x,y)=old
    Pset(x, y),new:x-=1
  Wend
  l=x+1:x=lastx
  While Point(x,y)=old
    Pset(x, y),new:x+=1
  Wend
  r=x-1
  dim as integer rUp = l
  For x=l To r-1
    If x>=rUp then
        if Point(x,y-1)= old Then rUp = RowByRowFillUpPP(x,y-1,old,new)
    endif
  Next 
  return x
End Function

private Function _
RowByRowFillDownPP(Byval x   As Integer, _
             Byval y   As Integer, _
             Byval old As Integer, _
             Byval new As Integer) as integer
  Dim As Integer i,l,r,lastx=x+1
 
  While Point(x,y)=old
    Pset(x, y),new:x-=1
  Wend
  l=x+1:x=lastx
  While Point(x,y)=old
    Pset(x, y),new:x+=1
  Wend
  r=x-1
  dim as integer rDown = l
  For x=l To r-1
    if x>=rDown then
        if Point(x,y+1)= old Then rDown = RowByRowFillDownPP(x,y+1,old,new)
    endif
  Next
  return x
End Function

private Sub _
RowByRowFillPlusPlus(Byval x   As Integer, _
             Byval y   As Integer, _
             Byval old As Integer, _
             Byval new As Integer)
  Dim As Integer i,l,r,lastx=x+1
 
  While Point(x,y)=old
    Pset(x, y),new:x-=1
  Wend
  l=x+1:x=lastx
  While Point(x,y)=old
    Pset(x, y),new:x+=1
  Wend
  r=x-1
  dim as integer rUp = l, rDown = l
  For x=l To r-1
    If x>=rUp then
        if Point(x,y-1)= old Then rUp = RowByRowFillUpPP(x,y-1,old,new)
    endif
    if x>=rDown then
        if Point(x,y+1)= old Then rDown = RowByRowFillDownPP(x,y+1,old,new)
    endif
  Next 
End Sub



'
' main
'
Dim As Integer c,oldcolor,newcolor
Dim As Double t1,t2,t3,t4,t5

screenres 640, 480, 32
draw8 66,220,&HFFFFFF,7
draw8 194,220,&HFFFFFF,7
draw8 322,220,&HFFFFFF,7
draw8 450,220,&HFFFFFF,7
draw8 578,220,&HFFFFFF,7

'goto Plusplus

t1=Timer
For c=1 To 255
  newcolor=rgb(c,0,0)
  FloodFill    66, 220, oldcolor,newcolor
  oldcolor=newcolor
Next
t1=timer-t1

oldcolor=0

t2=Timer
For c=1 To 255
  newcolor=rgb(0,c,0)
  BoundaryFill 194, 220, oldcolor,newcolor
  oldcolor=newcolor
Next
t2=timer-t2

oldcolor=0

t3=Timer
For c=1 To 255
  newcolor=rgb(0,0,c)
  RowByRowfill 322, 220, oldcolor,newcolor
  oldcolor=newcolor
Next
t3=timer-t3

oldcolor=0

t4=Timer
For c=1 To 255
  newcolor=rgb(c,c,c)
  RowByRowfillPlus 450, 220, oldcolor,newcolor
  oldcolor=newcolor
Next
t4=timer-t4

Plusplus:

oldcolor=0

'RowByRowfillPlusPlus 578, 220, 0,rgb(255,255,255)
'sleep:end

t5=Timer
For c=1 To 255
  newcolor=rgb(0,c,c)
  RowByRowfillPlusPlus 578, 220, oldcolor,newcolor
  oldcolor=newcolor
Next
t5=timer-t5

Locate 48,1
? "4 way stepping:" & Str(t1)
? "8 way stepping:" & Str(t2)
? "row by row    :" & Str(t3)
? "row by row +  :" & Str(t4)
? "row by row ++ :" & Str(t5)
Sleep

Return to “Tips and Tricks”

Who is online

Users browsing this forum: No registered users and 1 guest