RosettaCodeData/Task/Bitmap-Flood-fill/FreeBASIC/bitmap-flood-fill.basic

56 lines
1.3 KiB
Plaintext

' version 04-11-2016
' compile with: fbc -s console
' the flood_fill needs to know the boundries of the window/screen
' without them the routine start to check outside the window
' this leads to crashes (out of stack)
' the Line routine has clipping it will not draw outside the window
Sub flood_fill(x As Integer, y As Integer, target As UInteger, fill_color As UInteger)
Dim As Long x_max, y_max
ScreenInfo x_max, y_max
' 0, 0 is top left corner
If Point(x,y) <> target Then Exit Sub
Dim As Long l = x, r = x
While Point(l -1, y) = target AndAlso l -1 > -1
l = l -1
Wend
While Point(r +1, y) = target AndAlso r +1 < x_max
r = r +1
Wend
Line (l,y) - (r,y), fill_color
For x = l To r
If y +1 < y_max Then flood_fill(x, y +1, target, fill_color)
If y -1 > -1 Then flood_fill(x, y -1, target, fill_color)
Next
End Sub
' ------=< MAIN >=------
Dim As ULong i, col, x, y
ScreenRes 400, 400, 32
Randomize Timer
For i As ULong = 1 To 5
Circle(Rnd * 400 ,Rnd * 400), i * 40, Rnd * &hFFFFFF
Next
' hit a key to end or close window
Do
x = Rnd * 400
y = Rnd * 400
col = Point(x, y)
flood_fill(x, y, col, Rnd * &hFFFFFF )
Sleep 2000
If InKey <> "" OrElse InKey = Chr(255) + "k" Then End
Loop