|
|
Post by william33 on Jan 14, 2024 14:51:20 GMT
So recently I made this FloodIt clone with Lua. Now I wanted to port it to QB64 but it seems that recursive subs are treated differently. My function (actually it's a subroutine but they are not existing in Lua):
function floodfill (x,y,new_color,prev_color)
if (x<1 or y<1 or x>columns or y>rows or level[x][y]~=prev_color) then
return
end
level[x][y]=new_color
floodfill(x + 1, y, new_color, prev_color)
floodfill(x, y + 1, new_color, prev_color)
floodfill(x - 1, y, new_color, prev_color)
floodfill(x, y - 1, new_color, prev_color)
end
I came up with this for QB64:
Sub floodfill (xf%, yf%, newcolor%, prevcolor%)
If xf% < 1 Then Exit Sub
If yf% < 1 Then Exit Sub
If xf% > columns% Then Exit Sub
If yf% > rows% Then Exit Sub
If level(xf%, yf%) <> prevcolor% Then Exit Sub
level(xf%, yf%) = newcolor%
floodfill xf% + 1, yf%, newcolor%, prevcolor%
floodfill xf%, yf% + 1, newcolor%, prevcolor%
floodfill xf% - 1, yf%, newcolor%, prevcolor%
floodfill xf%, yf% - 1, newcolor%, prevcolor%
End Sub
Well, if the program doesn't crash only one cell ist changed. Presumably because of level(xf%, yf%) = newcolor%
You should know that the starting cell is always (1,1) and there are six colors. Here is a screenshot of the Lua version:
Has anyone an idea what am I doing wrong?
|
|
|
|
Post by bplus on Jan 14, 2024 17:39:07 GMT
Update: Yes I thought I knew what you were trying to do, now after your edit, not so sure. But you should submit a complete demo in QB64 instead of just translated function. Your converted function is useless without more demo. I just tried to apply it in QB64 and failed to see how you get different rectangles full of color. Honestly can you do that? Sure like to see ; - )) I think your Sub needs to define both corners of a rectangle at least. I don't think I need a previous color??? BTW if you want another version of QB64 floodfill called Paint that can be used two ways let me know but first complete my challenge above. Then I will show you how to paint with images!  |
|
|
|
Post by bplus on Jan 14, 2024 18:44:25 GMT
|
|
|
|
Post by william33 on Jan 14, 2024 19:22:49 GMT
Oh, well I caused some confusion. I actually don't "paint". The squares are images. The board is an array of 17x17:
Dim Shared level(1 To columns%, 1 To rows%) As Integer
For x% = 1 To columns%
For y% = 1 To rows%
level(x%, y%) = Int(Rnd * 6) + 1
Next
Next
So literally there are just integers from 1 to 6. For each number I put a different image onto the board. When a color is chosen - in the screenshot green - the number for green (5) is set, like this:
floodfill 1,1,5, level(1,1)
Now I would click on blue in the example screenshot. So all green tiles become blue and a few more are part of the blue "flood".
The images/tiles are not the problem, the following screenshot shows the status of the QB64 port:
|
|
|
|
Post by bplus on Jan 14, 2024 19:44:03 GMT
So are you using Loadimage and PutImage or what is the qB64 code you are using and are you trying a simple click a tile into the larger board or is this some game to make all the tiles the same color in least amount of clicks? Show me the QB64 code that you are working with.
|
|
|
|
Post by william33 on Jan 14, 2024 19:46:40 GMT
Ok, I put a simple example together. Just a grid of 5x5 and only integers form 1 to 3. Also one has to type in the number of color. (The graphics are not relevant for this to work. If the numbers "floodfill" correct, the rest will also work ...)
$NoPrefix
Randomize Timer
Screen NewImage(800, 600, 32)
Dim Shared level(1 To 5, 1 To 5) As Integer
For x% = 1 To 5
For y% = 1 To 5
level(x%, y%) = Int(Rnd * 3) + 1
Next
Next
drawlevel
Do
Input "Which number (color)? ", cl%
If cl% >= 1 And cl% <= 3 Then
floodfill 1, 1, cl%, level(1, 1)
drawlevel
End If
Loop Until cl% = 0
End
Sub drawlevel
For x% = 1 To 5
For y% = 1 To 5
Print level(x%, y%);
Next
Print
Next
Print
End Sub
Sub floodfill (xf%, yf%, newcolor%, prevcolor%)
If xf% < 1 Then Exit Sub
If yf% < 1 Then Exit Sub
If xf% > 5 Then Exit Sub
If yf% > 5 Then Exit Sub
If level(xf%, yf%) <> prevcolor% Then Exit Sub
level(xf%, yf%) = newcolor%
floodfill xf% + 1, yf%, newcolor%, prevcolor%
floodfill xf%, yf% + 1, newcolor%, prevcolor%
floodfill xf% - 1, yf%, newcolor%, prevcolor%
floodfill xf%, yf% - 1, newcolor%, prevcolor%
End Sub
I just used the same subroutine as in my bigger example. Maybe with this smaller approach I can figure out how to do this correctly.
Do I need a STATIC behind the sub?
|
|
|
|
Post by william33 on Jan 14, 2024 19:51:15 GMT
Ah, yes, the goal of the game ist to flood the entire board with a single color in the fewest number of moves possible.
Well, fewer than 30 that is.
|
|
|
|
Post by bplus on Jan 14, 2024 20:11:38 GMT
You are bombing out by infinite or nearly so recursive calls. I like the simpler number version 3 stars!
What is supposed to happen with this grid when you input 2, you have it setup to always start at 1, 1 after the input.
1 2 3 1 2
2 2 3 2 2
1 3 2 1 1
3 3 3 3 2
1 1 3 3 3
I am thinking recursion is not best approach here?
|
|
|
|
Post by bplus on Jan 14, 2024 20:40:12 GMT
This does it, makes all cells one color by choosing a color other than the one at (1, 1) By picking the different color that surrounds 1, 1 color I think you minimize inputs to 3-5 ? $NoPrefix
Randomize Timer
Screen NewImage(800, 600, 32)
Dim Shared level(1 To 5, 1 To 5) As Integer
For y% = 1 To 5
For x% = 1 To 5
level(x%, y%) = Int(Rnd * 3) + 1
Next
Next
drawlevel
Do
Input "Which number (color)? ", cl%
count = count + 1
If cl% >= 1 And cl% <= 3 Then
floodfill cl%
drawlevel
End If
' check win
c = level(1, 1)
For y = 1 To 5
For x = 1 To 5
If level(x, y) <> c Then GoTo skip
Next
Next
Print "You win! Move Count:"; count: End
skip:
Loop Until cl% = 0
End
Sub drawlevel
For y% = 1 To 5
For x% = 1 To 5
Print level(x%, y%);
Next
Print
Next
Print
End Sub
Sub floodfill (newcolor%)
pre% = level(1, 1)
For y% = 1 To 5
For x% = 1 To 5
If level(x%, y%) = pre% Or level(x%, y%) = newcolor% Then
level(x%, y%) = newcolor%
Else
Exit For
End If
Next
Next
End Sub
maybe I missed something this is too easy  |
|
|
|
Post by william33 on Jan 14, 2024 21:03:17 GMT
No, sorry. That is not correct. I started a sesseion:
I have chosen 3, so the 2 where the arrow points to should be a 3.
|
|
|
|
Post by bplus on Jan 14, 2024 22:06:54 GMT
Yes a guy named Dav did something like that game in another QB64 forum.
I modified a Paint routine for filling out a color as long as it encounters the start color it goes on up, down, left right. I called it flood.
See if that works better for you, it's non recursive.
$NoPrefix
Randomize Timer
Screen NewImage(800, 600, 32)
Dim Shared level(1 To 5, 1 To 5) As Integer
For y% = 1 To 5
For x% = 1 To 5
level(x%, y%) = Int(Rnd * 3) + 1
Next
Next
drawlevel
Do
Input "Which number (color)? ", cl%
count = count + 1
If cl% >= 1 And cl% <= 3 Then
flood cl%
drawlevel
End If
' check win
c = level(1, 1)
For y = 1 To 5
For x = 1 To 5
If level(x, y) <> c Then GoTo skip
Next
Next
Print "You win! Move Count:"; count: End
skip:
Loop Until cl% = 0
End
Sub drawlevel
For y% = 1 To 5
For x% = 1 To 5
Print level(x%, y%);
Next
Print
Next
Print
End Sub
Sub floodfill (newcolor%)
pre% = level(1, 1)
For y% = 1 To 5
For x% = 1 To 5
If level(x%, y%) = pre% Or level(x%, y%) = newcolor% Then
level(x%, y%) = newcolor%
Else
Exit For
End If
Next
Next
End Sub
Sub flood (fill) ' needs max, min functions mod of my Paint3 sub
Dim fillColor, W, H, parentF, tick, ystart, ystop, xstart, xstop, x, y
fillColor = level(1, 1)
W = 5: H = 5
Dim temp(1 To W, 1 To H)
temp(1, 1) = 1: parentF = 1
'PSet (1, 1), fill
level(1, 1) = fill
While parentF = 1
parentF = 0: tick = tick + 1
ystart = max(1 - tick, 1): ystop = min(1 + tick, H)
y = ystart
While y <= ystop
xstart = max(1 - tick, 1): xstop = min(1 + tick, W)
x = xstart
While x <= xstop
If level(x, y) = fillColor And temp(x, y) = 0 Then
If temp(max(1, x - 1), y) Then
temp(x, y) = 1: parentF = 1: level(x, y) = fill
ElseIf temp(min(x + 1, W), y) Then
temp(x, y) = 1: parentF = 1: level(x, y) = fill
ElseIf temp(x, max(y - 1, 1)) Then
temp(x, y) = 1: parentF = 1: level(x, y) = fill
ElseIf temp(x, min(y + 1, H)) Then
temp(x, y) = 1: parentF = 1: level(x, y) = fill
End If
End If
x = x + 1
Wend
y = y + 1
Wend
Wend
End Sub
Function max (n1, n2)
If n1 > n2 Then max = n1 Else max = n2
End Function
Function min (n1, n2)
If n1 > n2 Then min = n2 Else min = n1
End Function
|
|
|
|
Post by bplus on Jan 15, 2024 2:16:57 GMT
Here is the 14 x 14 grid with 6 numbers for tiles:
$NoPrefix
Randomize Timer
Screen NewImage(800, 600, 32)
Dim Shared level(1 To 14, 1 To 14) As Integer
For y% = 1 To 14
For x% = 1 To 14
level(x%, y%) = Int(Rnd * 6) + 1
Next
Next
drawlevel
Do
Input "Which number (color)? ", cl%
count = count + 1
If cl% >= 1 And cl% <= 6 Then
flood cl%
drawlevel
End If
' check win
c = level(1, 1)
For y = 1 To 14
For x = 1 To 14
If level(x, y) <> c Then GoTo skip
Next
Next
Print "You win! Move Count:"; count: End
skip:
Loop Until cl% = 0
Sub drawlevel
For y% = 1 To 14
For x% = 1 To 14
Print level(x%, y%);
Next
Print
Next
Print
End Sub
Sub flood (fill) ' needs max, min functions mod of my Paint3 sub
Dim fillColor, W, H, parentF, tick, ystart, ystop, xstart, xstop, x, y
fillColor = level(1, 1)
W = 14: H = 14
Dim temp(1 To W, 1 To H)
temp(1, 1) = 1: parentF = 1
'PSet (1, 1), fill
level(1, 1) = fill
While parentF = 1
parentF = 0: tick = tick + 1
ystart = max(1 - tick, 1): ystop = min(1 + tick, H)
y = ystart
While y <= ystop
xstart = max(1 - tick, 1): xstop = min(1 + tick, W)
x = xstart
While x <= xstop
If level(x, y) = fillColor And temp(x, y) = 0 Then
If temp(max(1, x - 1), y) Then
temp(x, y) = 1: parentF = 1: level(x, y) = fill
ElseIf temp(min(x + 1, W), y) Then
temp(x, y) = 1: parentF = 1: level(x, y) = fill
ElseIf temp(x, max(y - 1, 1)) Then
temp(x, y) = 1: parentF = 1: level(x, y) = fill
ElseIf temp(x, min(y + 1, H)) Then
temp(x, y) = 1: parentF = 1: level(x, y) = fill
End If
End If
x = x + 1
Wend
y = y + 1
Wend
Wend
End Sub
Function max (n1, n2)
If n1 > n2 Then max = n1 Else max = n2
End Function
Function min (n1, n2)
If n1 > n2 Then min = n2 Else min = n1
End Function
|
|
|
|
Post by william33 on Jan 15, 2024 15:51:46 GMT
Thanks, I will try it soon. Looks promising, though.
|
|
|
|
Post by bplus on Jan 15, 2024 19:54:02 GMT
Here is colorized version under 100 lines:
Option _Explicit
_Title "Flood (1,1) game" ' b+ 2024-01-15
' thanks william33 who got me interested in flood fill problem then the game
' https://qb64.boards.net/thread/267/floodfill-recursive-algorithm
Randomize Timer
Screen _NewImage(800, 600, 12)
_PrintMode _KeepBackground
Dim Shared level(1 To 14, 1 To 14) As Integer
Dim As Long x, y, cl, count, c
For y = 1 To 14
For x = 1 To 14
level(x, y) = Int(Rnd * 6) + 1
Next
Next
drawlevel
Do
Input "Which number (color)? ", cl
count = count + 1
If cl >= 1 And cl <= 6 Then
flood cl
drawlevel
End If
' check win
c = level(1, 1)
For y = 1 To 14
For x = 1 To 14
If level(x, y) <> c Then GoTo skip
Next
Next
Print "You win! Move Count:"; count: End
skip:
Loop Until cl = 0
Sub drawlevel
Dim As Long x, y
Cls
Color 0
For y = 1 To 14
For x = 1 To 14
Line ((x - 1) * 16, (y - 1) * 16)-Step(15, 15), level(x, y) + 8, BF
Print " " + _Trim$(Str$(level(x, y)));
Next
Print
Next
Print
Color 15
End Sub
Sub flood (fill) ' needs max, min functions mod of my Paint3 sub
Dim fillColor, W, H, parentF, tick, ystart, ystop, xstart, xstop, x, y
fillColor = level(1, 1)
W = 14: H = 14
Dim temp(1 To W, 1 To H)
temp(1, 1) = 1: parentF = 1
'PSet (1, 1), fill
level(1, 1) = fill
While parentF = 1
parentF = 0: tick = tick + 1
ystart = max(1 - tick, 1): ystop = min(1 + tick, H)
y = ystart
While y <= ystop
xstart = max(1 - tick, 1): xstop = min(1 + tick, W)
x = xstart
While x <= xstop
If level(x, y) = fillColor And temp(x, y) = 0 Then
If temp(max(1, x - 1), y) Then
temp(x, y) = 1: parentF = 1: level(x, y) = fill
ElseIf temp(min(x + 1, W), y) Then
temp(x, y) = 1: parentF = 1: level(x, y) = fill
ElseIf temp(x, max(y - 1, 1)) Then
temp(x, y) = 1: parentF = 1: level(x, y) = fill
ElseIf temp(x, min(y + 1, H)) Then
temp(x, y) = 1: parentF = 1: level(x, y) = fill
End If
End If
x = x + 1
Wend
y = y + 1
Wend
Wend
End Sub
Function max (n1, n2)
If n1 > n2 Then max = n1 Else max = n2
End Function
Function min (n1, n2)
If n1 > n2 Then min = n2 Else min = n1
End Function
|
|
|
|
Post by william33 on Jan 15, 2024 20:13:25 GMT
Thanks. Your algorithm works flawlessly. 👍
|
|
