Recursive Fills (almost)

[SMcNeill]

The main thing mine is doing with _MEM is just copying our screen over into an array for us, so we can play with the values with the array, rather than having to use POINT each time, since POINT is slow.  I simply set my array to what elements need to be filled and then paint the screen based off those coordinates once I've gathered them all.

Weird enough however, I've ran into a real oddity that I can't explain at all in the process here: https://www.qb64.org/forum/index.php?topic=4361.0

The method that does the least mem duplication and copying of values is the one that runs the slowest for us -- by a 10 to 1 margin of speed!  Now, what the heck is up with that??

[bplus]

I sat down and now (since the last post here) I wrote something, that seems to work faster (as fast as paint). The solution is to create a two-color mask and then use the paint statement and finally insert the image over the original. It's not as fast as Steve's version, but it's definitely faster than what I created in 2018.

Code: QB64: [Select]

1.  
2. Screen _NewImage(1024, 768, 32)
3. $Color:32
4. Do
5.     Cls , Red
6.     For c = 1 To 40
7.         Circle (Rnd * 980, Rnd * 740), Rnd * 100 + 10, _RGB32(255 * Rnd)
8.         X = Rnd * 1024
9.         Y = Rnd * 768
10.         Lwidth = Rnd * 100
11.         Lheight = Rnd * 100
12.         Line (X, Y)-(X + Lwidth, Y + Lheight), _RGB32(255 * Rnd, 255 * Rnd, 255 * Rnd), BF
13.     Next
14.     _Delay .3
15.     _MouseMove 512, 384
16.  
17.  
18.     sp 512, 384, White
19.     _Delay .3
20. Loop
21.  
22. Sub sp (x, y, c~&)
23.     W = _Width: H = _Height
24.     Virtual = _NewImage(W, H, 32)
25.  
26.     Dim m As _MEM, n As _MEM, Bck As _Unsigned Long
27.     m = _MemImage(_Source)
28.     n = _MemImage(Virtual)
29.  
30.     'create mask (2 color image)
31.     position& = (y * W + x) * 4
32.     _MemGet m, m.OFFSET + position&, Bck
33.     Clr2~& = _RGB32(_Red32(Bck) - 1, _Green32(Bck) - 1, _Blue32(Bck) - 1)
34.     D& = 0
35.     Do Until D& = n.SIZE
36.         CLR~& = _MemGet(m, m.OFFSET + D&, _Unsigned Long)
37.         If CLR~& = Bck~& Then _MemPut n, n.OFFSET + D&, CLR~& Else _MemPut n, n.OFFSET + D&, Clr2~&
38.         D& = D& + 4
39.     Loop
40.  
41.  
42.     d = _Dest
43.     _Dest Virtual
44.     Paint (x, y), c~&, Clr2~&
45.     _Dest d
46.     _ClearColor Clr2~&, Virtual
47.     _PutImage , Virtual, d
48.     _MemFree m
49.     _MemFree n
50.     _FreeImage Virtual
51. End Sub
52.  
53.  
54. _MouseMove in program is used for us to show where is fill point.
55.  

WTF @Petr this completely disables my mouse and I have to shut down computer!  :(

[SMcNeill]

WTF @Petr this completely diables my mouse and I have to shut down computer!  :(

How does it disable the mouse?   It moves it into the center of the screen, but the mouse is still there.  All you have to do is Alt-F4 to close the program as it doesn't have any native QUIT built into it, but it doesn't require a PC reboot.  :P

[bplus]

How does it disable the mouse?   It moves it into the center of the screen, but the mouse is still there.  All you have to do is Alt-F4 to close the program as it doesn't have any native QUIT built into it, but it doesn't require a PC reboot.  :P

Alt+F4 didn't work, @SMcNeill so you've tried the code and works fine for you?

I'm using v2.0 does that make a difference?

What it does is take a screen shot of my IDE and everytime I move outside the screen shot with mouse it moves it back into screen.

BTW It was drawing (Drawing Screen) underneath the IDE Screen.

If I don't have control of mouse, I consider it disabling it, specially when I am pissed.

[Petr]

@bplus

BPlus, this is unexpected. I always test it before I release it to the world, I usually end it by pressing Ctrl + Pause and this is a reliable way to exit (unless it is disabled by the _EXIT command, which in this case is not). Via Ctrl + Pause it can always be terminated. If this program is not in focus, so switch to it with ALT + TAB and then also Alt+F4 works!

[bplus]

@Petr

OK I have noted Ctrl + Pause as something else to try. Hmm... my Pause is 2nd listing on my right shift key, don't think I've ever used it for anything before.

Why not draw arrow and label as Paint/Fill Point after drawing random stuff?

EDIT OK additional notes (after your edit) duly noted, thanks Petr

[bplus]

@Petr with some mods I can safely demo that great, fast fill! very nice, it was a painful birth but what a baby!

Code: QB64: [Select]

1. _Title "Fast Fill! by Petr, arrow points to fill point!" ' b+ mods for safer running/specailly exiting  2021-11-05
2. ' Very Nice Petr!!!  ref: https://www.qb64.org/forum/index.php?topic=4357.msg137803#msg137803
3. ' bplus changed screen size, centered it and is drawing arrow to paint point (3 additional subs for that!)
4.  
5. Screen _NewImage(1024, 700, 32) ' a little less height please, dang it sharnk again because bottom below screen bottom
6. _ScreenMove 150, 40 'Sorry guys _Middle is not!! why is this not centered I have room above title bar but screen extends below sight????
7.  
8. $Color:32
9. Do
10.     Cls , Red
11.     For c = 1 To 40
12.         Circle (Rnd * 980, Rnd * 740), Rnd * 100 + 10, _RGB32(255 * Rnd)
13.         X = Rnd * 1024
14.         Y = Rnd * _Height
15.         Lwidth = Rnd * 100
16.         Lheight = Rnd * 100
17.         Line (X, Y)-(X + Lwidth, Y + Lheight), _RGB32(255 * Rnd, 255 * Rnd, 255 * Rnd), BF
18.     Next
19.     arrow 514, 384, _Pi(1.25), 200
20.     _Delay .7
21.     '_MouseMove 512, 384  ' <<<<<<<< trouble maker!!!
22.     sp 512, 384, White
23.     _Delay 3
24. Loop Until _KeyDown(27) ' bug out if user wants
25.  
26. Sub sp (x, y, c~&)
27.     W = _Width: H = _Height
28.     Virtual = _NewImage(W, H, 32)
29.  
30.     Dim m As _MEM, n As _MEM, Bck As _Unsigned Long
31.     m = _MemImage(_Source)
32.     n = _MemImage(Virtual)
33.  
34.     'create mask (2 color image)
35.     position& = (y * W + x) * 4
36.     _MemGet m, m.OFFSET + position&, Bck
37.     Clr2~& = _RGB32(_Red32(Bck) - 1, _Green32(Bck) - 1, _Blue32(Bck) - 1)
38.     D& = 0
39.     Do Until D& = n.SIZE
40.         If _KeyDown(27) Then System '>>>>  bug out if user wants
41.         CLR~& = _MemGet(m, m.OFFSET + D&, _Unsigned Long)
42.         If CLR~& = Bck~& Then _MemPut n, n.OFFSET + D&, CLR~& Else _MemPut n, n.OFFSET + D&, Clr2~&
43.         D& = D& + 4
44.     Loop
45.  
46.     d = _Dest
47.     _Dest Virtual
48.     Paint (x, y), c~&, Clr2~&
49.     _Dest d
50.     _ClearColor Clr2~&, Virtual
51.     _PutImage , Virtual, d
52.     _MemFree m
53.     _MemFree n
54.     _FreeImage Virtual
55. End Sub
56.  
57. Sub arrow (x0, y0, rAngle, lngth)
58.     Dim x1, y1, x2, y2, pi, i As Integer
59.     pi = 3.14159265
60.     x2 = x0 - lngth * Cos(rAngle)
61.     y2 = y0 - lngth * Sin(rAngle)
62.     drawLink x0, y0, .001 * lngth, x2, y2, .01 * lngth, &HFF00BB00
63.     Line (x0, y0)-(x2, y2), &HFF00BB00
64.     x2 = x0 - .1 * lngth * Cos(rAngle - .2 * pi)
65.     y2 = y0 - .1 * lngth * Sin(rAngle - .2 * pi)
66.     x1 = x0 - .1 * lngth * Cos(rAngle + .2 * pi)
67.     y1 = y0 - .1 * lngth * Sin(rAngle + .2 * pi)
68.     ftri x0, y0, x1, y1, x2, y2, &HFFFF8800
69.     For i = .8 * lngth To lngth Step 3
70.         x1 = x0 - i * Cos(rAngle)
71.         y1 = y0 - i * Sin(rAngle)
72.         x2 = x1 - .1 * lngth * Cos(rAngle - .25 * pi)
73.         y2 = y1 - .1 * lngth * Sin(rAngle - .25 * pi)
74.         Line (x1, y1)-(x2, y2), &HFF0000FF
75.         x2 = x1 - .1 * lngth * Cos(rAngle + .25 * pi)
76.         y2 = y1 - .1 * lngth * Sin(rAngle + .25 * pi)
77.         Line (x1, y1)-(x2, y2), &HFF0000FF
78.     Next
79. End Sub
80.  
81. Sub drawLink (x1, y1, r1, x2, y2, r2, c As _Unsigned Long)
82.     Dim a, a1, a2, x3, x4, x5, x6, y3, y4, y5, y6
83.     a = _Atan2(y2 - y1, x2 - x1)
84.     a1 = a + _Pi(1 / 2)
85.     a2 = a - _Pi(1 / 2)
86.     x3 = x1 + r1 * Cos(a1): y3 = y1 + r1 * Sin(a1)
87.     x4 = x1 + r1 * Cos(a2): y4 = y1 + r1 * Sin(a2)
88.     x5 = x2 + r2 * Cos(a1): y5 = y2 + r2 * Sin(a1)
89.     x6 = x2 + r2 * Cos(a2): y6 = y2 + r2 * Sin(a2)
90.     fquad x3, y3, x4, y4, x5, y5, x6, y6, c
91. End Sub
92.  
93. 'need 4 non linear points (not all on 1 line) list them clockwise so x2, y2 is opposite of x4, y4
94. Sub fquad (x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer, x3 As Integer, y3 As Integer, x4 As Integer, y4 As Integer, c As _Unsigned Long)
95.     ftri x1, y1, x2, y2, x4, y4, c
96.     ftri x3, y3, x4, y4, x1, y1, c
97. End Sub
98.  
99. Sub ftri (x1, y1, x2, y2, x3, y3, K As _Unsigned Long)
100.     Dim a&
101.     a& = _NewImage(1, 1, 32)
102.     _Dest a&
103.     PSet (0, 0), K
104.     _Dest 0
105.     _MapTriangle _Seamless(0, 0)-(0, 0)-(0, 0), a& To(x1, y1)-(x2, y2)-(x3, y3)
106.     _FreeImage a& '<<< this is important!
107. End Sub
108.  
109.  

Updated code to deal with my _ScreenMove issues, no _Middle means no need for delay.
1024 X 700 QB64screen: 1024 is best max width for speedy graphics and 700 is max height that fits under a potential taskbar running along top of screen. RND y's fixed for new Height.

[Petr]

Nicely done, @bplus :)

[bplus]

@Petr

I made some changes for my _ScreenMove _Middle issues. If you have taskbar along top edge of your screen you might like this better now. The _Height is maximum screen that fits my laptop screen assuming a 40 pixel high Taskbar.

[bplus]

@johnno56  You are right!
@bplus  Your program works badly:

Code: QB64: [Select]

1. _Title "Recursive Fill" 'b+ 2021-11-03
2. Screen _NewImage(1980, 1050, 32) ' <<<<<<<<<<<<<<<<<< biggest screen I can see on laptop
3. _Delay .25
4.  
5. $Color:32
6. Circle (900, 555), 450, Gold
7. Sleep
8. fill 900, 555, Gold
9. Sleep
10. fill 5, 5, Red
11. Beep
12.  
13. Function plus (x, y, c As _Unsigned Long)
14.     plus = 0
15.     If Point(x, y) <> c Then
16.         For i = x - 1 To 0 Step -1
17.             If Point(i, y) = c Then xl = i + 1: Exit For
18.         Next
19.         'if xl = 0 then xl = 0
20.         For i = x + 1 To _Width - 1
21.             If Point(i, y) = c Then xr = i - 1: Exit For
22.         Next
23.         If xr = 0 Then xr = _Width - 1
24.         For i = y - 1 To 0 Step -1
25.             If Point(x, i) = c Then yu = i + 1: Exit For
26.         Next
27.         'if yu = 0 then yu = 0
28.         For i = y + 1 To _Height - 1
29.             If Point(x, i) = c Then yd = i - 1: Exit For
30.         Next
31.         If yd = 0 Then yd = _Height - 1
32.         Line (xl, y)-(xr, y), c
33.         Line (x, yu)-(x, yd), c
34.         plus = -1
35.     End If
36. End Function
37.  
38. Sub fill (x, y, c As _Unsigned Long)
39.     If x >= 0 And x < _Width And y >= 0 And y < _Height Then
40.         If plus(x, y, c) Then
41.             fill x - 1, y - 1, c
42.             fill x - 1, y + 1, c
43.             fill x + 1, y - 1, c
44.             fill x + 1, y + 1, c
45.         End If
46.     End If
47. End Sub
48.  

I found my old...

Not seeing a problem with this code that fits my screen:

Code: QB64: [Select]

1. _Title "Recursive Fill" 'b+ 2021-11-03
2. Screen _NewImage(1024, 700, 32) ' <<<<<<<<<<<<<<<<<< biggest screen I can see on laptop
3. _ScreenMove 150, 40
4.  
5. $Color:32
6. Circle (_Width / 2, _Height / 2), _Height / 2 - 5, Gold
7. Sleep
8. fill _Width / 2, _Height / 2, Gold
9. Sleep
10. fill 5, 5, Red
11. Beep
12.  
13. Function plus (x, y, c As _Unsigned Long)
14.     plus = 0
15.     If Point(x, y) <> c Then
16.         For i = x - 1 To 0 Step -1
17.             If Point(i, y) = c Then xl = i + 1: Exit For
18.         Next
19.         'if xl = 0 then xl = 0
20.         For i = x + 1 To _Width - 1
21.             If Point(i, y) = c Then xr = i - 1: Exit For
22.         Next
23.         If xr = 0 Then xr = _Width - 1
24.         For i = y - 1 To 0 Step -1
25.             If Point(x, i) = c Then yu = i + 1: Exit For
26.         Next
27.         'if yu = 0 then yu = 0
28.         For i = y + 1 To _Height - 1
29.             If Point(x, i) = c Then yd = i - 1: Exit For
30.         Next
31.         If yd = 0 Then yd = _Height - 1
32.         Line (xl, y)-(xr, y), c
33.         Line (x, yu)-(x, yd), c
34.         plus = -1
35.     End If
36. End Function
37.  
38. Sub fill (x, y, c As _Unsigned Long)
39.     If x >= 0 And x < _Width And y >= 0 And y < _Height Then
40.         If plus(x, y, c) Then
41.             fill x - 1, y - 1, c
42.             fill x - 1, y + 1, c
43.             fill x + 1, y - 1, c
44.             fill x + 1, y + 1, c
45.         End If
46.     End If
47. End Sub
48.  
49.  

It works as expected, this recursive fill only stops when it encounters the same color that it's filling, pretty useless actually, worse this fill wont go around circles but will around rectangles?

Anyway at least it's recursive.

[johnno56]

I remember this type of non-recursive flood fill. Back in '85, my old Amstrad, no paint or fill... Had to use a program similar to this one. Using a 4mhz CPU was 'painful' to watch... Compared to your 'thoroughbred' my old routine was a 'plough horse'... Nicely done... I have snaffled the min / max functions to store in my 'snippets' folder... bonus! ;) lol