Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: bplus on November 03, 2021, 01:39:42 am

Title: Recursive Fills (almost)
Post by: bplus on November 03, 2021, 01:39:42 am
I almost have it working, it has a little problem getting around circles, looks kind of interesting though. It's pretty fast! see random tests after first screen.
Code: QB64: [Select]
  1. _Title "Recursive Fill" 'b+ 2021-11-03
  2. Screen _NewImage(800, 600, 32)
  3. _Delay .25
  6.  
  7. Line (110, 200)-Step(580, 200), _RGB32(255, 0, 0), B
  8. Circle (400, 300), 280, _RGB32(255, 0, 0)
  9. 'Circle (400, 300), 200.5, _RGB32(255, 0, 0) ' some circle radius leak like radius = 200
  10. 'Circle (400, 300), 201, _RGB32(255, 0, 0)
  11. fill 400, 300, _RGB32(255, 0, 0)
  12. Line (300, 10)-Step(200, 580), _RGB32(255, 0, 0), B
  13. fill 400, 150, _RGB32(255, 0, 0)
  14. fill 400, 450, _RGB32(255, 0, 0)
  16. While _KeyDown(27) = 0
  17.     Cls
  18.     Line (0, 0)-(_Width - 1, _Height - 1), _RGB32(255, 0, 0), B
  19.     doBoxes = Int(Rnd * 2)
  20.     For i = 1 To 10
  21.         If doBoxes Then Line (Rnd * (_Width - 100) + 50, Rnd * (_Height - 100) + 50)-(Rnd * 100, Rnd * 100), _RGB32(255, 0, 0), B
  22.         x = Rnd * _Width: y = Rnd * _Height: r = Rnd * 50 + 10
  23.         Circle (x, y), r, _RGB32(255, 0, 0)
  24.         Circle (x, y), r + .5, _RGB32(255, 0, 0)
  25.         Circle (x, y), r + 1, _RGB32(255, 0, 0)
  26.     Next
  27.     fill 400, 300, _RGB32(255, 0, 0)
  28.     'Beep
  29.     Sleep
  31.  
  32. Function plus (x, y, c As _Unsigned Long)
  33.     If Point(x, y) <> c Then
  34.         For i = x - 1 To 0 Step -1
  35.             If Point(i, y) = c Then xl = i + 1: Exit For
  36.         Next
  37.         'if xl = 0 then xl = 0
  38.         For i = x + 1 To _Width - 1
  39.             If Point(i, y) = c Then xr = i - 1: Exit For
  40.         Next
  41.         If xr = 0 Then xr = _Width - 1
  42.         For i = y - 1 To 0 Step -1
  43.             If Point(x, i) = c Then yu = i + 1: Exit For
  44.         Next
  45.         'if yu = 0 then yu = 0
  46.         For i = y + 1 To _Height - 1
  47.             If Point(x, i) = c Then yd = i - 1: Exit For
  48.         Next
  49.         If yd = 0 Then yd = _Height - 1
  50.         Line (xl, y)-(xr, y), c
  51.         Line (x, yu)-(x, yd), c
  52.         plus = -1
  53.     End If
  55.  
  56. Sub fill (x, y, c As _Unsigned Long)
  57.     If plus(x, y, c) Then
  58.         fill x - 1, y - 1, c
  59.         fill x - 1, y + 1, c
  60.         fill x + 1, y - 1, c
  61.         fill x + 1, y + 1, c
  62.     End If
  64.  
  65.  
Title: Re: Recursive Fills (almost)
Post by: johnno56 on November 03, 2021, 03:40:21 am
Cool... Very fast... :)
Title: Re: Recursive Fills (almost)
Post by: bplus on November 03, 2021, 02:39:15 pm
Thanks @johnno56 got any ideas for use?

I am thinking a mod of this will get us through mazes.
Title: Re: Recursive Fills (almost)
Post by: johnno56 on November 04, 2021, 06:40:28 am
Been "out of the loop" today. Figured I would re-install my OS. Nice and fresh; quick and uncluttered... That should be good for another week... My Desktop is a magnet for junk and clutter... Where was I? Ideas you say? As long as the areas that require flood filling aren't too big, I suppose anything really... Mazes? 2D or 3D? Simple 2D mazes probably won't need a fill... After all, the walls, are just filled squares and rectangles... "line()-()" could take care of that... Raycasting could use vertical rectangle segments... Odd 4-sided walls could use a flood fill instead of using textures... Or any of the programs on QB64 that use that fcirc() routine... Board games like checkers or chess. Flood filling "pieces" of those sizes should be quick enough without cause memory issues... perhaps a flight sim (not the MS ones) like Red Baron etc. Might push memory limits... or the old Battle Zone (tank game)... Simple sprite editor... Struggling because of low caffeine levels...
Title: Re: Recursive Fills (almost)
Post by: Petr on November 04, 2021, 09:36:17 am
Hi, BPlus

I tried your program and unfortunately I was able to replicate a known program crash error using recursion. The added program will crash after a while with the announcement that the program has stopped working and will therefore be terminated. By no means would I want to look for a similar problem in large source code. The same mistake can be made in other ways - by sound, but I'm not talking about it now.

So the question. Is there a way to avoid such a recursion-induced program crash? This silly meaningless message from Windows is as beneficial as coat for the corpse.

Thanks for sharing.


Code: QB64: [Select]
  1. _Title "Recursive Fill" 'b+ 2021-11-03
  2. Screen _NewImage(1920, 1080, 32)
  3. _Delay .25
  6.  
  7. Line (110, 200)-Step(580, 200), _RGB32(255, 0, 0), B
  8. Circle (400, 300), 280, _RGB32(255, 0, 0)
  9. 'Circle (400, 300), 200.5, _RGB32(255, 0, 0) ' some circle radius leak like radius = 200
  10. 'Circle (400, 300), 201, _RGB32(255, 0, 0)
  11. fill 400, 300, _RGB32(255, 0, 0)
  12. Line (300, 10)-Step(200, 580), _RGB32(255, 0, 0), B
  13. fill 400, 150, _RGB32(255, 0, 0)
  14. fill 400, 450, _RGB32(255, 0, 0)
  15. fill 5, 5, &HFFFFFF00
  17. While _KeyDown(27) = 0
  18.     Cls
  19.     Line (0, 0)-(_Width - 1, _Height - 1), _RGB32(255, 0, 0), B
  20.     doBoxes = Int(Rnd * 2)
  21.     For i = 1 To 10
  22.         If doBoxes Then Line (Rnd * (_Width - 100) + 50, Rnd * (_Height - 100) + 50)-(Rnd * 100, Rnd * 100), _RGB32(255, 0, 0), B
  23.         x = Rnd * _Width: y = Rnd * _Height: r = Rnd * 50 + 10
  24.         Circle (x, y), r, _RGB32(255, 0, 0)
  25.         Circle (x, y), r + .5, _RGB32(255, 0, 0)
  26.         Circle (x, y), r + 1, _RGB32(255, 0, 0)
  27.     Next
  28.     fill 400, 300, _RGB32(255, 0, 0)
  29.     'Beep
  30.     Sleep
  32.  
  33. Function plus (x, y, c As _Unsigned Long)
  34.     If Point(x, y) <> c Then
  35.         For i = x - 1 To 0 Step -1
  36.             If Point(i, y) = c Then xl = i + 1: Exit For
  37.         Next
  38.         'if xl = 0 then xl = 0
  39.         For i = x + 1 To _Width - 1
  40.             If Point(i, y) = c Then xr = i - 1: Exit For
  41.         Next
  42.         If xr = 0 Then xr = _Width - 1
  43.         For i = y - 1 To 0 Step -1
  44.             If Point(x, i) = c Then yu = i + 1: Exit For
  45.         Next
  46.         'if yu = 0 then yu = 0
  47.         For i = y + 1 To _Height - 1
  48.             If Point(x, i) = c Then yd = i - 1: Exit For
  49.         Next
  50.         If yd = 0 Then yd = _Height - 1
  51.         Line (xl, y)-(xr, y), c
  52.         Line (x, yu)-(x, yd), c
  53.         plus = -1
  54.     End If
  56.  
  57. Sub fill (x, y, c As _Unsigned Long)
  58.     If plus(x, y, c) Then
  59.         fill x - 1, y - 1, c
  60.         fill x - 1, y + 1, c
  61.         fill x + 1, y - 1, c
  62.         fill x + 1, y + 1, c
  63.     End If
  65.  
  66.  
  67.  
  68.  
Title: Re: Recursive Fills (almost)
Post by: Petr on November 04, 2021, 09:54:53 am
@bplus
You don't have to answer, I found a recursion thread where Steve explains it. I'll try to find a way to reliably clean the memory tank (it will be a lot of beers and a lot of headaches) BUT I just have to try. When a reliable method is found, it opens up many possibilities. In this case, for example - how about dividing an image into images with a size of 100x100 pixels, doing coordinate conversions, then filling it in and finally reassembling? Damn, when I read it, I'm not feeling well...
Title: Re: Recursive Fills (almost)
Post by: bplus on November 04, 2021, 10:15:13 am
@Petr

The trouble making line in your mod of my code was this one:
fill 5, 5, &HFFFFFF00 
There was nothing to stop the color from flooding the whole screen and beyond.
This is fixed by drawing a containment border first around the area to fill with the same color you are about to fill with eg,
Code: QB64: [Select]
  1. _Title "Recursive Fill" 'b+ 2021-11-03
  2. Screen _NewImage(1280, 740, 32)  ' <<<<<<<<<<<<<<<<<< biggest screen I can see on laptop
  3. _Delay .25
  6.  
  7. Line (0, 0)-(_Width - 1, _Height - 1), &HFFFFFF00, B ' you must contain the color you are filling with that color border
  8. fill 5, 5, &HFFFFFF00
  10.  
  11. Function plus (x, y, c As _Unsigned Long)
  12.     If Point(x, y) <> c Then
  13.         For i = x - 1 To 0 Step -1
  14.             If Point(i, y) = c Then xl = i + 1: Exit For
  15.         Next
  16.         'if xl = 0 then xl = 0
  17.         For i = x + 1 To _Width - 1
  18.             If Point(i, y) = c Then xr = i - 1: Exit For
  19.         Next
  20.         If xr = 0 Then xr = _Width - 1
  21.         For i = y - 1 To 0 Step -1
  22.             If Point(x, i) = c Then yu = i + 1: Exit For
  23.         Next
  24.         'if yu = 0 then yu = 0
  25.         For i = y + 1 To _Height - 1
  26.             If Point(x, i) = c Then yd = i - 1: Exit For
  27.         Next
  28.         If yd = 0 Then yd = _Height - 1
  29.         Line (xl, y)-(xr, y), c
  30.         Line (x, yu)-(x, yd), c
  31.         plus = -1
  32.     End If
  34.  
  35. Sub fill (x, y, c As _Unsigned Long)
  36.     If plus(x, y, c) Then
  37.         fill x - 1, y - 1, c
  38.         fill x - 1, y + 1, c
  39.         fill x + 1, y - 1, c
  40.         fill x + 1, y + 1, c
  41.     End If
  43.  

When you hear the beep you will know you didn't crash.
Notice I had to use _Width -1, _Height - 1 to keep the containment box on screen.

BTW The fill routine is not better than Paint to Border color but worse! It's just an experiment with Recursive Sub to attempt a Paint like fill.

If you need a Fill / Paint that changes a color until contained by any other color I have a beauty I call Paint3.
Title: Re: Recursive Fills (almost)
Post by: bplus on November 04, 2021, 10:29:13 am
I suppose I could put checks on Fill to make sure x, y aren't off screen. Thus we won't need a containment box, yeah!

Code: QB64: [Select]
  1. _Title "Recursive Fill" 'b+ 2021-11-03
  2. Screen _NewImage(1280, 740, 32) ' <<<<<<<<<<<<<<<<<< biggest screen I can see on laptop
  3. _Delay .25
  6.  
  7. fill 5, 5, &HFFFFFF00
  9.  
  10. Function plus (x, y, c As _Unsigned Long)
  11.     If Point(x, y) <> c Then
  12.         For i = x - 1 To 0 Step -1
  13.             If Point(i, y) = c Then xl = i + 1: Exit For
  14.         Next
  15.         'if xl = 0 then xl = 0
  16.         For i = x + 1 To _Width - 1
  17.             If Point(i, y) = c Then xr = i - 1: Exit For
  18.         Next
  19.         If xr = 0 Then xr = _Width - 1
  20.         For i = y - 1 To 0 Step -1
  21.             If Point(x, i) = c Then yu = i + 1: Exit For
  22.         Next
  23.         'if yu = 0 then yu = 0
  24.         For i = y + 1 To _Height - 1
  25.             If Point(x, i) = c Then yd = i - 1: Exit For
  26.         Next
  27.         If yd = 0 Then yd = _Height - 1
  28.         Line (xl, y)-(xr, y), c
  29.         Line (x, yu)-(x, yd), c
  30.         plus = -1
  31.     End If
  33.  
  34. Sub fill (x, y, c As _Unsigned Long)
  35.     If x >= 0 And x < _Width And y >= 0 And y < _Height Then
  36.         If plus(x, y, c) Then
  37.             fill x - 1, y - 1, c
  38.             fill x - 1, y + 1, c
  39.             fill x + 1, y - 1, c
  40.             fill x + 1, y + 1, c
  41.         End If
  42.     End If
  44.  
  45.  

Fixed! Thanks @Petr
Title: Re: Recursive Fills (almost)
Post by: Petr on November 04, 2021, 12:11:59 pm
Very good, BPlus :) I don't know why I still need to scratch with my right foot behind my left ear...
Title: Re: Recursive Fills (almost)
Post by: bplus on November 04, 2021, 01:19:18 pm
@Petr you seem uncomfortable about something?

Well no worries this will replace Paint or Paint with Border. :) But might be useful pathfinding mod?
Title: Re: Recursive Fills (almost)
Post by: johnno56 on November 04, 2021, 03:20:46 pm
This may not make much sense but please read on.

I had a problem with scrolling background images. Set the two images in the right place. Moved both images at the same speed. The first image moves off the screen; the second image is placed next; the second image moves off the screen and the first image... you get the point? What has this got to do with fill?  The problem I had with the moving images was a tiny gap between them. I forgot to account for the speed.

My theory, for the fill example is, you are testing the pixel directly beneath where you want to draw - If Point(x,y) <> c - instead of checking the pixel you want to move towards. eg: if you land on a line (or the edge of the screen) it could be too late because the fill routine is already placing pixels beyond the 'landing' point. I'm not sure if I am making sense. Perhaps, checking the pixel you intend to move to first - If Point(x+speed,y) or '1' in this case - will give the fill routine enough warning before going beyond the 'limits'? Just a thought... Similar system in platform games. When moving a character you don't check for collision when you are already in place. You always check 'ahead' to see if the character 'can' move in that direction. Would not the same system apply to the 'collision' of the fill pixels? Apologies for babbling...
Title: Re: Recursive Fills (almost)
Post by: Petr on November 05, 2021, 07:29:46 am
@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.  
  6. Circle (900, 555), 450, Gold
  8. fill 900, 555, Gold
  10. fill 5, 5, Red
  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
  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
  48.  

I found my old solution for coloring. It's been a long time since I've dealt with this. Acceleration there would mean dropping PAINT and using MEM. But that's an old familiar thing. Here's what I use when I need to color something that doesn't have the same color areas. I see that it still stays with the first version. Well, I'm doing something else again...
My SLOW solution use not recursion, so its out of topic :)
Code: QB64: [Select]
  1. ' paint first pre - alternative. Program logic:
  2. '- User set coordinates and output color (border color is NOT NEED)
  3. '- Program find colors borders in easyest way. Create virtual screen and draw borders.
  4. '- Use QB64 statement PAINT in this virtual screen and then copy colored area back to visible screen
  5. '- Kill arrays and virtual screen and return back.
  6.  
  7. 'It is first version, extreme slow!
  8.  
  9. 'If is something "super", so has not big value. So this is named super.....slow.....wait........Sub :-D
  10. 'in true, i thing about - how do it many months. Because i have not enough time, i started this many times in different ways. First -   I wanted to do this by moving the X, Y pointer
  11. 'along the Y axis up to the border of the colors, and then copying the border of the color boundaries and reducing its radius at each turn. Unfortunately, when using a circle, the pointer
  12. 'has always run away. It was fun, but I did not to laugh ...
  13.  
  14. Screen _NewImage(800, 600, 32)
  15.  
  16.  
  17. Circle (400, 300), 250, _RGB32(100, 20, 33)
  18. Circle (400, 300), 450, _RGB32(10, 200, 133)
  19. Line (100, 100)-(400, 400), _RGB32(10, 200, 133), B
  20. Line (300, 300)-(500, 500), _RGB32(10, 20, 99), B
  22.  
  23. SuperPaint 338, 349, _RGB32(255, 0, 0)
  25.  
  26. SuperPaint 531, 219, _RGB32(10, 255, 0)
  28.  
  29. SuperPaint 436, 451, _RGB32(0, 10, 255)
  31.  
  32. SuperPaint 715, 242, _RGB32(255, 255, 0)
  34.  
  35.  
  36.  
  37.  
  38. Sub SuperPaint (x As Integer, y As Integer, clr As _Unsigned Long) '32 bit: ok   8 bit: ok
  39.     Background& = Point(x, y)
  40.     W = _Width(0)
  41.     H = _Height(0)
  42.     Dim O(W, H) As Integer, bclr As _Unsigned Long
  43.  
  44.     For Sy = 0 To H - 1
  45.         For sx = 1 To W - 2
  46.             If Point(sx, Sy) <> Point(sx + 1, Sy) Then
  47.                 oldsx = sx
  48.                 O(sx, Sy) = 1
  49.             End If
  50.     Next sx, Sy
  51.  
  52.     For sx = 0 To W - 1
  53.         For Sy = 0 To H - 1
  54.             If Point(sx, Sy) <> Point(sx, Sy + 1) Then
  55.                 oldsy = Sy
  56.                 O(sx, Sy) = 1
  57.             End If
  58.     Next Sy, sx
  59.     i = 0
  60.     bclr& = 255
  62.         Case 1: bclr = clr - 1: Depth = 256
  63.         Case 4: bclr = _RGB32(_Red32(clr) - 1, _Green32(clr) - 1, _Blue32(clr) - 1): Depth = 32
  64.     End Select
  65.     my& = _Dest
  66.     virtual& = _NewImage(W, H, Depth)
  67.     _Dest virtual&
  68.     For Sy = 0 To H
  69.         For sx = 0 To W
  70.             If O(sx, Sy) Then
  71.                 PSet (sx, Sy), bclr
  72.             End If
  73.     Next sx, Sy
  74.     _Dest virtual&
  75.     Paint (x, y), clr, bclr
  76.     Erase O
  77.     For sx = 0 To W
  78.         For Sy = 0 To H
  79.             _Source virtual&
  80.             _Dest my&
  81.             If Point(sx, Sy) = clr Then PSet (sx, Sy), clr
  82.             If Point(sx - 1, Sy) = clr Then PSet (sx, Sy), clr
  83.             If Point(sx, Sy - 1) = clr Then PSet (sx, Sy), clr
  84.     Next Sy, sx
  85.     _Dest my&
  86.     _FreeImage virtual&
  88.  
Title: Re: Recursive Fills (almost)
Post by: SMcNeill on November 05, 2021, 08:09:56 am
Here's the Fill I usually use, but it doesn't have any recursion going on with it.

Code: QB64: [Select]
  1. Screen _NewImage(1024, 720, 32)
  4.  
  5.  
  6. TestLimit = 100
  7. Radius = 350
  8.  
  10. t# = Timer
  11. For i = 1 To TestLimit
  12.     k& = &HFF000000 + Int(Rnd * &HFFFFFF)
  13.  
  14.     Circle (512, 360), Radius, k&
  15.     Fill 512, 360, k&
  17.  
  18. t1# = Timer
  19. For i = 1 To TestLimit
  20.     k& = &HFF000000 + Int(Rnd * &HFFFFFF)
  21.  
  22.     Circle (512, 360), Radius, k&
  23.     Paint (512, 360), k&
  25. t2# = Timer
  26.  
  27.  
  28. For i = 1 To TestLimit
  29.     k& = &HFF000000 + Int(Rnd * &HFFFFFF)
  30.  
  31.     CircleFill 512, 360, Radius, k&
  32.  
  34. t3# = Timer
  35.  
  36.  
  37. Print Using "###.#### seconds for Fill."; t1# - t#
  38. Print Using "###.#### seconds for Paint."; t2# - t1#
  39. Print Using "###.#### seconds for CircleFill."; t3# - t2#
  40.  
  41.  
  42.  
  43.  
  44.  
  45.  
  46.  
  47. Sub CircleFill (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
  48.     ' CX = center x coordinate
  49.     ' CY = center y coordinate
  50.     '  R = radius
  51.     '  C = fill color
  52.     Dim Radius As Integer, RadiusError As Integer
  53.     Dim X As Integer, Y As Integer
  54.     Radius = Abs(R)
  55.     RadiusError = -Radius
  56.     X = Radius
  57.     Y = 0
  58.     If Radius = 0 Then PSet (CX, CY), C: Exit Sub
  59.     Line (CX - X, CY)-(CX + X, CY), C, BF
  60.     While X > Y
  61.         RadiusError = RadiusError + Y * 2 + 1
  62.         If RadiusError >= 0 Then
  63.             If X <> Y + 1 Then
  64.                 Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  65.                 Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  66.             End If
  67.             X = X - 1
  68.             RadiusError = RadiusError - X * 2
  69.         End If
  70.         Y = Y + 1
  71.         Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  72.         Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  73.     Wend
  75.  
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  
  82.  
  83. Sub Fill (Passx, Passy, kolor As Long)
  85.     B = _Blend
  87.  
  88.     Dim TempGrid(_Width - 1, _Height - 1) As Long
  89.     Dim As _MEM m, m1: m = _Mem(TempGrid()): m1 = _MemImage(0)
  90.     Dim o As _Offset
  91.     _MemCopy m1, m1.OFFSET, m1.SIZE To m, m.OFFSET
  92.     o = 0
  93.     Do Until o >= m.SIZE
  94.         If _MemGet(m1, m1.OFFSET + o, _Unsigned Long) = kolor Then
  95.             _MemPut m, m.OFFSET + o, -1 As LONG
  96.             'Else
  97.             '_MemPut m, m.OFFSET + o, 0 As LONG
  98.         End If
  99.         o = o + 4
  100.     Loop
  101.  
  102.     TempGrid(Passx, Passy) = 1
  103.     startx = Passx - pass: finishx = Passx + pass
  104.     starty = Passy - pass: finishy = Passy + pass
  105.  
  106.     Do Until finished
  107.         pass = pass + 1
  108.         finished = -1
  109.         For x = startx To finishx
  110.             For y = starty To finishy
  111.                 If TempGrid(x, y) = pass Then
  112.                     tempx = x
  113.                     Do Until tempx = 0
  114.                         If TempGrid(tempx - 1, y) = 0 Then
  115.                             TempGrid(tempx - 1, y) = pass + 1
  116.                             tempx = tempx - 1
  117.                             If tempx < startx Then startx = tempx
  118.                             finished = 0
  119.                         Else
  120.                             tempx = 0
  121.                         End If
  122.                     Loop
  123.  
  124.                     tempx = x
  125.                     Do Until tempx = _Width - 1
  126.                         If TempGrid(tempx + 1, y) = 0 Then
  127.                             TempGrid(tempx + 1, y) = pass + 1
  128.                             tempx = tempx + 1
  129.                             If tempx > finishx Then finishx = tempx
  130.                             finished = 0
  131.                         Else
  132.                             tempx = _Width - 1
  133.                         End If
  134.                     Loop
  135.  
  136.                     tempy = y
  137.                     Do Until tempy = 0
  138.                         If TempGrid(x, tempy - 1) = 0 Then
  139.                             TempGrid(x, tempy - 1) = pass + 1
  140.                             tempy = tempy - 1
  141.                             If tempy < starty Then startx = tempy
  142.                             finished = 0
  143.                         Else
  144.                             tempy = 0
  145.                         End If
  146.                     Loop
  147.  
  148.                     tempy = y
  149.                     Do Until tempy = _Height - 1
  150.                         If TempGrid(x, tempy + 1) = 0 Then
  151.                             TempGrid(x, tempy + 1) = pass + 1
  152.                             tempy = tempy + 1
  153.                             If tempy > finishy Then finishy = tempy
  154.                             finished = 0
  155.                         Else
  156.                             tempy = _Height - 1
  157.                         End If
  158.                     Loop
  159.                 End If
  160.         Next y, x
  161.     Loop
  162.  
  163.     o = 0
  164.     Do Until o >= m.SIZE
  165.         If _MemGet(m, m.OFFSET + o, _Unsigned Long) <> 0 Then _MemPut m1, m1.OFFSET + o, kolor As _UNSIGNED LONG
  166.         o = o + 4
  167.     Loop
  168.     _MemFree m: _MemFree m1
  170.     If B Then _Blend

It's faster than PAINT, but still no where near the speeds of a decent CircleFIll routine.

 


NOTE:  This is also the same thing which I do for my 2D games which require pathfinding, though it's just usually on a much smaller scale.
Title: Re: Recursive Fills (almost)
Post by: Petr on November 05, 2021, 08:49:50 am
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)
  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
  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
  52.  
  53.  
  54. _MouseMove in program is used for us to show where is fill point.
  55.  
Title: Re: Recursive Fills (almost)
Post by: bplus on November 05, 2021, 09:21:33 am
Quote
@bplus  Your program works badly:

And thus the title of the thread: Recursive Fills (almost)

Steve's "simple" little recursive fill that doesn't work got me on the hunt for a

Recursive Fill Routine

I already offered a non recursive Paint Routine that covers (no pun intended) what Paint doesn't. It looks allot like Steve's without the Mem stuff because we had worked it out here this forum probably at least a year ago. Oh I can check the date a quick search for where it is in my new list of bas files...

Code: QB64: [Select]
  2. _Title "PAINT3 test" 'b+ 2020-06-26
  3. Screen _NewImage(800, 600, 32)
  4. _Delay .25
  6. Dim i, mb, mx, my
  7. For i = 1 To 50
  8.     Line (Rnd * 800, Rnd * 600)-(Rnd * 800, Rnd * 600), _RGB32(Rnd * 255, Rnd * 255, Rnd * 255, 128 + Rnd * 128)
  9.     Circle (Rnd * 800, Rnd * 600), Rnd * 50 + 10, _RGB32(Rnd * 255, Rnd * 255, Rnd * 255, 128 + Rnd * 128)
  13.     mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
  14.     If mb Then paint3 mx, my, &HFFFFFFFF
  15.     _Limit 200
  17.  
  18. Sub paint3 (x0, y0, fill As _Unsigned Long) ' needs max, min functions
  19.     Dim fillColor As _Unsigned Long, W, H, parentF, tick, ystart, ystop, xstart, xstop, x, y
  20.     fillColor = Point(x0, y0)
  21.     'PRINT fillColor
  22.     W = _Width - 1: H = _Height - 1
  23.     Dim temp(W, H)
  24.     temp(x0, y0) = 1: parentF = 1
  25.     PSet (x0, y0), fill
  26.     While parentF = 1
  27.         parentF = 0: tick = tick + 1
  28.         ystart = max(y0 - tick, 0): ystop = min(y0 + tick, H)
  29.         y = ystart
  30.         While y <= ystop
  31.             xstart = max(x0 - tick, 0): xstop = min(x0 + tick, W)
  32.             x = xstart
  33.             While x <= xstop
  34.                 If Point(x, y) = fillColor And temp(x, y) = 0 Then
  35.                     If temp(max(0, x - 1), y) Then
  36.                         temp(x, y) = 1: parentF = 1: PSet (x, y), fill
  37.                     ElseIf temp(min(x + 1, W), y) Then
  38.                         temp(x, y) = 1: parentF = 1: PSet (x, y), fill
  39.                     ElseIf temp(x, max(y - 1, 0)) Then
  40.                         temp(x, y) = 1: parentF = 1: PSet (x, y), fill
  41.                     ElseIf temp(x, min(y + 1, H)) Then
  42.                         temp(x, y) = 1: parentF = 1: PSet (x, y), fill
  43.                     End If
  44.                 End If
  45.                 x = x + 1
  46.             Wend
  47.             y = y + 1
  48.         Wend
  49.     Wend
  51.  
  52. Function min (n1, n2)
  53.     If n1 > n2 Then min = n2 Else min = n1
  55.  
  56. Function max (n1, n2)
  57.     If n1 < n2 Then max = n2 Else max = n1
  59.  
  60.  

But that's not recursive
Title: Re: Recursive Fills (almost)
Post by: SMcNeill on November 05, 2021, 09:40:37 am
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??
Title: Re: Recursive Fills (almost)
Post by: bplus on November 05, 2021, 09:55:44 am
Quote from: Petr on November 05, 2021, 08:49:50 am
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)
  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
  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
  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!  :(
Title: Re: Recursive Fills (almost)
Post by: SMcNeill on November 05, 2021, 10:06:41 am
Quote from: bplus on November 05, 2021, 09:55:44 am
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
Title: Re: Recursive Fills (almost)
Post by: bplus on November 05, 2021, 10:20:30 am
Quote from: SMcNeill on November 05, 2021, 10:06:41 am
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.
Title: Re: Recursive Fills (almost)
Post by: Petr on November 05, 2021, 10:29:45 am
@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!
Title: Re: Recursive Fills (almost)
Post by: bplus on November 05, 2021, 10:37:52 am
@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
Title: Re: Recursive Fills (almost)
Post by: bplus on November 05, 2021, 11:14:42 am
@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.  
  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
  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
  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
  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
  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!
  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.
Title: Re: Recursive Fills (almost)
Post by: Petr on November 05, 2021, 11:38:50 am
Nicely done, @bplus :)
Title: Re: Recursive Fills (almost)
Post by: bplus on November 05, 2021, 12:33:03 pm
@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.
Title: Re: Recursive Fills (almost)
Post by: bplus on November 05, 2021, 03:25:37 pm
Quote from: Petr on November 05, 2021, 07:29:46 am
@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.  
  6. Circle (900, 555), 450, Gold
  8. fill 900, 555, Gold
  10. fill 5, 5, Red
  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
  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
  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.  
  6. Circle (_Width / 2, _Height / 2), _Height / 2 - 5, Gold
  8. fill _Width / 2, _Height / 2, Gold
  10. fill 5, 5, Red
  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
  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
  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.
Title: Re: Recursive Fills (almost)
Post by: johnno56 on November 05, 2021, 04:40:38 pm
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
Text Only | Text with Attachments