### Author Topic: CircleFiller  (Read 1181 times)

0 Members and 1 Guest are viewing this topic.

#### SMcNeill ##### CircleFiller
« on: February 06, 2019, 02:13:34 PM »
Since Bplus likes balls so much, I thought I'd give him a new, never before seen, SUPER CircleFiller!!

Code: QB64: [Select]
1. SCREEN _NEWIMAGE(640, 480, 32)
2.
3. CONST Red = &HFFFF0000
4.
5. LINE (200, 200)-(400, 400), Red, B
6. CircleFiller 300, 300, 10, Red
7.
8. CLS , 0
9. CIRCLE (320, 240), 100, Red
10. CircleFiller 320, 240, 10, Red
11.
12.
13. SUB CircleFiller (x, y, r, k AS _UNSIGNED LONG)
14.     IF CircleFillValid(x, y, r, k) THEN
15.         CircleFill x, y, r, k
16.         CircleFiller x - r - r - 1, y, r, k
17.         CircleFiller x + r + r + 1, y, r, k
18.         CircleFiller x, y - r - r - 1, r, k
19.         CircleFiller x, y + r + r + 1, r, k
20.
21.
22.
23.
24.
25.
26. SUB CircleFill (cx AS INTEGER, cy AS INTEGER, r AS INTEGER, c AS _UNSIGNED LONG)
27.     DIM xx AS LONG, yy AS LONG
28.     DIM sx AS LONG, sy AS LONG
29.     rx = r: ry = r
30.
31.     a = 2 * rx * rx
32.     b = 2 * ry * ry
33.     x = rx
34.     xx = ry * ry * (1 - rx - rx)
35.     yy = rx * rx
36.     sx = b * rx
37.
38.     DO WHILE sx >= sy
39.         LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
40.         IF y <> 0 THEN LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
41.
42.         y = y + 1
43.         sy = sy + a
44.         e = e + yy
45.         yy = yy + a
46.
47.         IF (e + e + xx) > 0 THEN
48.             x = x - 1
49.             sx = sx - b
50.             e = e + xx
51.             xx = xx + b
52.
53.     x = 0
54.     y = ry
55.     xx = rx * ry
56.     yy = rx * rx * (1 - ry - ry)
57.     e = 0
58.     sx = 0
59.     sy = a * ry
60.
61.     DO WHILE sx <= sy
62.         LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
63.         LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
64.
65.             x = x + 1
66.             sx = sx + b
67.             e = e + xx
68.             xx = xx + b
69.         LOOP UNTIL (e + e + yy) > 0
70.
71.         y = y - 1
72.         sy = sy - a
73.         e = e + yy
74.         yy = yy + a
75.
76.
77.
78.
79. FUNCTION CircleFillValid (cx AS INTEGER, cy AS INTEGER, r AS INTEGER, c AS _UNSIGNED LONG)
80.     DIM xx AS LONG, yy AS LONG
81.     DIM sx AS LONG, sy AS LONG
82.     rx = r: ry = r
83.
84.     a = 2 * rx * rx
85.     b = 2 * ry * ry
86.     x = rx
87.     xx = ry * ry * (1 - rx - rx)
88.     yy = rx * rx
89.     sx = b * rx
90.
91.     DO WHILE sx >= sy
92.         FOR i = cx - x TO cx + x
93.             IF POINT(i, cy - y) = c THEN EXIT FUNCTION
94.         'LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
95.         IF y <> 0 THEN
96.             'LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
97.             FOR i = cx - x TO cx + x
98.                 IF POINT(i, cy + y) = c THEN EXIT FUNCTION
99.
100.         y = y + 1
101.         sy = sy + a
102.         e = e + yy
103.         yy = yy + a
104.
105.         IF (e + e + xx) > 0 THEN
106.             x = x - 1
107.             sx = sx - b
108.             e = e + xx
109.             xx = xx + b
110.
111.     x = 0
112.     y = ry
113.     xx = rx * ry
114.     yy = rx * rx * (1 - ry - ry)
115.     e = 0
116.     sx = 0
117.     sy = a * ry
118.
119.     DO WHILE sx <= sy
120.         'LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
121.         'LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
122.         FOR i = cx - x TO cx + x
123.             IF POINT(i, cy - y) = c THEN EXIT FUNCTION
124.             IF POINT(i, cy + y) = c THEN EXIT FUNCTION
125.
126.             x = x + 1
127.             sx = sx + b
128.             e = e + xx
129.             xx = xx + b
130.         LOOP UNTIL (e + e + yy) > 0
131.
132.         y = y - 1
133.         sy = sy - a
134.         e = e + yy
135.         yy = yy + a
136.
137.     CircleFillValid = -1
138.

This can also be easily modified to become an EllipseFiller (as I'm actually using the EllipseFill routines for this and modified them so rx/ry are both passed by r instead...), if case anyone wants a nice EllipseFiller utility.

And what's the purpose of this, you ask?

I was thinking of plugging it into my little hourglass program so it'd drop balls instead of sand, but then I figured, "Nah... I'm too lazy.  This is good enough.  Somebody else can go back and insert the routines into the program if they want to now.  I'm going to dinner and a movie with the wife..."

:P
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

#### bplus ##### Re: CircleFiller
« Reply #1 on: February 06, 2019, 05:33:39 PM »
Oh balls! ;-))

I have check on 1 to show that no more balls can be placed inside the random rectangle, but for a fun show change check to 0.
Code: QB64: [Select]
1. _TITLE "Circle Filled by Steve mod B+" '2019-02-06
2. CONST xmax = 800
3. CONST ymax = 600
4. SCREEN _NEWIMAGE(xmax, ymax, 32)
5.
6. CONST Red = &HFF880000
7. DIM SHARED check
8. check = 1 ' 0 or 1 to check the rack
9.
10. PRINT "Test rack: (200, 200)-(400, 400), radius =10, color =Red"
11. LINE (200, 200)-(400, 400), &HFFFFFFFF, B
12. fillWithBalls 200, 200, 200, 200, 10, Red
13. INPUT "To see a show, press enter,  and other + enter ends program... "; wate\$
14. WHILE _KEYDOWN(27) = 0
15.     IF check = 1 THEN CLS
16.     w = rand(50, 300): h = rand(50, 300)
17.     fillWithBalls rand(0, xmax - w - 1), rand(0, ymax - h - 1), w, h, rand(4, 20), _RGB32(RND * 255, RND * 255, RND * 255)
18.     IF check THEN _LIMIT .3 ELSE _LIMIT 1
19.
20. SUB fillWithBalls (topX, topY, wide, height, ballRadius, ballColr AS _UNSIGNED LONG)
21.     xLeft = topX + wide
22.     yBelow = topY + height
23.     'check the rack
24.     IF check = 1 THEN LINE (topX, topY)-(xLeft, yBelow), &HFFFFFFFF, B
25.     FOR y = yBelow - ballRadius TO topY + ballRadius STEP -SQR(3) * ballRadius
26.         layer = layer + 1
27.         IF layer MOD 2 = 0 THEN spacer = ballRadius ELSE spacer = 0
28.         IF y + SQR(3) * ballRadius <= yBelow + ballRadius THEN
29.             FOR x = topX + ballRadius TO xLeft STEP 2 * ballRadius
30.                 IF spacer + x - ballRadius >= topX AND spacer + x + ballRadius <= xLeft + 2 THEN
31.                     ball spacer + x, y, ballRadius, ballColr
32.                     'check ball fill = tangent white circles
33.                     IF check = 1 THEN CIRCLE (spacer + x, y), ballRadius, &HFFFFFFFF ' be honest with edges
34.                     'check ball fill = tangent white circles
35.                     IF check = 1 THEN CIRCLE (spacer + x, y), ballRadius, &HFFFFFFFF ' be honest with edges
36.
37.
38. 'here it is! The ball sub !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
39.     rd = _RED32(K): g = _GREEN32(K): b = _BLUE32(K)
40.     FOR rad = r TO 1 STEP -1
41.         kr = _RGB32((r - rad) / r * rd, (r - rad) / r * g, (r - rad) / r * b)
42.         fel x, y, rad, rad, kr
43.
44. 'FillEllipse is too much typing so using fel
45. ' with Steve's EllipseFill, who needs CircleFill? fix for 0 radii 2019-02-05
46. ' Is this fast enough for general circle fill (June 2018):  https://www.qb64.org/forum/index.php?topic=298.msg1942#msg1942
47. '  EllipseFill SMcNeill (Nov 3, 2018) https://www.qb64.org/forum/index.php?topic=755.msg6506#msg6506
48.     DIM xx AS LONG, yy AS LONG
49.     DIM sx AS LONG, sy AS LONG
50.
51.     IF rx = 0 OR ry = 0 THEN EXIT SUB 'nothing to draw
52.
53.     a = 2 * rx * rx
54.     b = 2 * ry * ry
55.     x = rx
56.     xx = ry * ry * (1 - rx - rx)
57.     yy = rx * rx
58.     sx = b * rx
59.
60.     DO WHILE sx >= sy
61.         LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
62.         IF y <> 0 THEN LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
63.
64.         y = y + 1
65.         sy = sy + a
66.         e = e + yy
67.         yy = yy + a
68.
69.         IF (e + e + xx) > 0 THEN
70.             x = x - 1
71.             sx = sx - b
72.             e = e + xx
73.             xx = xx + b
74.
75.     x = 0
76.     y = ry
77.     xx = rx * ry
78.     yy = rx * rx * (1 - ry - ry)
79.     e = 0
80.     sx = 0
81.     sy = a * ry
82.
83.     DO WHILE sx <= sy
84.         LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
85.         LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
86.
87.             x = x + 1
88.             sx = sx + b
89.             e = e + xx
90.             xx = xx + b
91.         LOOP UNTIL (e + e + yy) > 0
92.
93.         y = y - 1
94.         sy = sy - a
95.         e = e + yy
96.         yy = yy + a
97.
98.
99.
100. FUNCTION rand% (lo%, hi%)
101.     rand% = INT(RND * (hi% - lo% + 1)) + lo%
102.

« Last Edit: February 06, 2019, 05:39:15 PM by bplus »

#### STxAxTIC ##### Re: CircleFiller
« Reply #2 on: February 06, 2019, 05:40:49 PM »
Ah cool, your screenshot shows you got the right packing density for circles.
TOXIC

#### SMcNeill ##### Re: CircleFiller
« Reply #3 on: February 06, 2019, 05:50:47 PM »
Only one thing, Bp:  Mine fills any area, like a paint fill would.  Yours is just working on creating balls in a rectangular area, unless I’m mistaken?
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

#### STxAxTIC ##### Re: CircleFiller
« Reply #4 on: February 06, 2019, 05:53:54 PM »
While we're on this, someone tell me why everyone's ellipse fill functions are getting so huge. This is all you need at most for regular ellipses (yeah, it works in the code above, but I plead Steve's argument - I'm to lazy to fix his code and show you!):

Code: QB64: [Select]
1.
2. CALL efill(50, 150, 80, 40, 4)
3.
4. SUB efill (x0, y0, a, b, c)
5.     FOR i = -a TO a
6.         y1 = b * SQR(1 - i ^ 2 / a ^ 2)
7.         y2 = -b * SQR(1 - i ^ 2 / a ^ 2)
8.         LINE (i + 320 + x0, -y1 + 240 - y0)-(i + 320 + x0, -y2 + 240 - y0), c, B
« Last Edit: February 06, 2019, 05:56:06 PM by STxAxTIC »
TOXIC

#### bplus ##### Re: CircleFiller
« Reply #5 on: February 06, 2019, 05:56:28 PM »
Only one thing, Bp:  Mine fills any area, like a paint fill would.  Yours is just working on creating balls in a rectangular area, unless I’m mistaken?

Steve, you are not mistaken. I missed the "fill any area" from your demo. So you could fill a circle or triangle without going outside the lines?

#### bplus ##### Re: CircleFiller
« Reply #6 on: February 06, 2019, 05:57:01 PM »
While we're on this, someone tell me why everyone's ellipse fill functions are getting so huge. This is all you need at most for regular ellipses (yeah, it works in the code above, but I plead Steve's argument - I'm to lazy to fix his code and show you!):

Code: QB64: [Select]
1.
2. CALL efill(50, 150, 80, 40, 4)
3.
4. SUB efill (x0, y0, a, b, c)
5.     FOR i = -a TO a
6.         y1 = b * SQR(1 - i ^ 2 / a ^ 2)
7.         y2 = -b * SQR(1 - i ^ 2 / a ^ 2)
8.         LINE (i + 320 + x0, -y1 + 240 - y0)-(i + 320 + x0, -y2 + 240 - y0), c, B

You want to race? ;-))

#### STxAxTIC ##### Re: CircleFiller
« Reply #7 on: February 06, 2019, 06:05:22 PM »
Sure, run the speed test. I'm curious to see if my two uses of SQR are slower than the fluffy version yall are using.

EDIT

Lol, you can remove the ,B at the end of my LINE statement though... Oh and for that matter, I can see how this can be made 4 times as fast. Let me know if you actually want to run a test and I'll cook up a different function. Or hell, use the one as-is, I'm still curious.
« Last Edit: February 06, 2019, 06:09:57 PM by STxAxTIC »
TOXIC

#### SMcNeill ##### Re: CircleFiller
« Reply #8 on: February 06, 2019, 06:10:28 PM »
Only one thing, Bp:  Mine fills any area, like a paint fill would.  Yours is just working on creating balls in a rectangular area, unless I’m mistaken?

Steve, you are not mistaken. I missed the "fill any area" from your demo. So you could fill a circle or triangle without going outside the lines?

Hit any key..  The demo itself already has a circle filled with circles.  ;)

Code: QB64: [Select]
1. CLS , 0
2. CIRCLE (320, 240), 100, Red
3. CircleFiller 320, 240, 10, Red

It’s more or less ready to plug directly into the hourglass demo.  (Just widen the gap to the size of your circle so it looks “natural”.)
« Last Edit: February 06, 2019, 06:13:15 PM by SMcNeill »
https://github.com/SteveMcNeill/Steve64 — A github collection of all things Steve!

#### STxAxTIC ##### Re: CircleFiller
« Reply #9 on: February 06, 2019, 06:42:42 PM »
Throw this into the test bucket too. Test case involves transparency!

Code: QB64: [Select]
1. SCREEN _NEWIMAGE(800, 600, 32)
2.
3. CALL efill(50, 150, 80, 40, _RGBA(100, 200, 0, 100))
4. CALL efill(70, 130, 80, 40, _RGBA(200, 100, 0, 100))
5.
6. SUB efill (x0, y0, a, b, c AS LONG)
7.     a2 = a / SQR(2)
8.     b2 = b / SQR(2)
9.     LINE (-a2 + _WIDTH / 2 + x0, -b2 + _HEIGHT / 2 - y0)-(a2 + _WIDTH / 2 + x0, b2 + _HEIGHT / 2 - y0), c, BF
10.     LINE (0 + _WIDTH / 2 + x0, -b + _HEIGHT / 2 - y0)-(0 + _WIDTH / 2 + x0, -b2 - 1 + _HEIGHT / 2 - y0), c
11.     LINE (0 + _WIDTH / 2 + x0, b + _HEIGHT / 2 - y0)-(0 + _WIDTH / 2 + x0, b2 + 1 + _HEIGHT / 2 - y0), c
12.     LINE (-a + _WIDTH / 2 + x0, 0 + _HEIGHT / 2 - y0)-(-a2 - 1 + _WIDTH / 2 + x0, 0 + _HEIGHT / 2 - y0), c
13.     LINE (a + _WIDTH / 2 + x0, 0 + _HEIGHT / 2 - y0)-(a2 + 1 + _WIDTH / 2 + x0, 0 + _HEIGHT / 2 - y0), c
14.     FOR i = 1 TO a2
15.         y1 = b * SQR(1 - i ^ 2 / a ^ 2)
16.         LINE (i + _WIDTH / 2 + x0, -y1 + _HEIGHT / 2 - y0)-(i + _WIDTH / 2 + x0, -b2 - 1 + _HEIGHT / 2 - y0), c
17.         LINE (-i + _WIDTH / 2 + x0, -y1 + _HEIGHT / 2 - y0)-(-i + _WIDTH / 2 + x0, -b2 - 1 + _HEIGHT / 2 - y0), c
18.         LINE (i + _WIDTH / 2 + x0, b2 + 1 + _HEIGHT / 2 - y0)-(i + _WIDTH / 2 + x0, y1 + _HEIGHT / 2 - y0), c
19.         LINE (-i + _WIDTH / 2 + x0, b2 + 1 + _HEIGHT / 2 - y0)-(-i + _WIDTH / 2 + x0, y1 + _HEIGHT / 2 - y0), c
20.     FOR j = 1 TO b2
21.         x1 = a * SQR(1 - j ^ 2 / b ^ 2)
22.         LINE (-x1 + _WIDTH / 2 + x0, j + _HEIGHT / 2 - y0)-(-a2 - 1 + _WIDTH / 2 + x0, j + _HEIGHT / 2 - y0), c
23.         LINE (-x1 + _WIDTH / 2 + x0, -j + _HEIGHT / 2 - y0)-(-a2 - 1 + _WIDTH / 2 + x0, -j + _HEIGHT / 2 - y0), c
24.         LINE (x1 + _WIDTH / 2 + x0, j + _HEIGHT / 2 - y0)-(a2 + 1 + _WIDTH / 2 + x0, j + _HEIGHT / 2 - y0), c
25.         LINE (x1 + _WIDTH / 2 + x0, -j + _HEIGHT / 2 - y0)-(a2 + 1 + _WIDTH / 2 + x0, -j + _HEIGHT / 2 - y0), c
26.
TOXIC

#### bplus ##### Re: CircleFiller
« Reply #10 on: February 06, 2019, 07:30:17 PM »
Only one thing, Bp:  Mine fills any area, like a paint fill would.  Yours is just working on creating balls in a rectangular area, unless I’m mistaken?

Steve, you are not mistaken. I missed the "fill any area" from your demo. So you could fill a circle or triangle without going outside the lines?

Hit any key..  The demo itself already has a circle filled with circles.  ;)

Code: QB64: [Select]
1. CLS , 0
2. CIRCLE (320, 240), 100, Red
3. CircleFiller 320, 240, 10, Red

It’s more or less ready to plug directly into the hourglass demo.  (Just widen the gap to the size of your circle so it looks “natural”.)

OK now I see it, POINT in the verification code. Yes, just draw a boundary, good!

My Minute Timer did need a fix for filling the top bowl. It was taking longer to fill the bowl than to run the timer, :P

#### bplus ##### Re: CircleFiller
« Reply #11 on: February 06, 2019, 07:30:59 PM »
Throw this into the test bucket too. Test case involves transparency!

Code: QB64: [Select]
1. SCREEN _NEWIMAGE(800, 600, 32)
2.
3. CALL efill(50, 150, 80, 40, _RGBA(100, 200, 0, 100))
4. CALL efill(70, 130, 80, 40, _RGBA(200, 100, 0, 100))
5.
6. SUB efill (x0, y0, a, b, c AS LONG)
7.     a2 = a / SQR(2)
8.     b2 = b / SQR(2)
9.     LINE (-a2 + _WIDTH / 2 + x0, -b2 + _HEIGHT / 2 - y0)-(a2 + _WIDTH / 2 + x0, b2 + _HEIGHT / 2 - y0), c, BF
10.     LINE (0 + _WIDTH / 2 + x0, -b + _HEIGHT / 2 - y0)-(0 + _WIDTH / 2 + x0, -b2 - 1 + _HEIGHT / 2 - y0), c
11.     LINE (0 + _WIDTH / 2 + x0, b + _HEIGHT / 2 - y0)-(0 + _WIDTH / 2 + x0, b2 + 1 + _HEIGHT / 2 - y0), c
12.     LINE (-a + _WIDTH / 2 + x0, 0 + _HEIGHT / 2 - y0)-(-a2 - 1 + _WIDTH / 2 + x0, 0 + _HEIGHT / 2 - y0), c
13.     LINE (a + _WIDTH / 2 + x0, 0 + _HEIGHT / 2 - y0)-(a2 + 1 + _WIDTH / 2 + x0, 0 + _HEIGHT / 2 - y0), c
14.     FOR i = 1 TO a2
15.         y1 = b * SQR(1 - i ^ 2 / a ^ 2)
16.         LINE (i + _WIDTH / 2 + x0, -y1 + _HEIGHT / 2 - y0)-(i + _WIDTH / 2 + x0, -b2 - 1 + _HEIGHT / 2 - y0), c
17.         LINE (-i + _WIDTH / 2 + x0, -y1 + _HEIGHT / 2 - y0)-(-i + _WIDTH / 2 + x0, -b2 - 1 + _HEIGHT / 2 - y0), c
18.         LINE (i + _WIDTH / 2 + x0, b2 + 1 + _HEIGHT / 2 - y0)-(i + _WIDTH / 2 + x0, y1 + _HEIGHT / 2 - y0), c
19.         LINE (-i + _WIDTH / 2 + x0, b2 + 1 + _HEIGHT / 2 - y0)-(-i + _WIDTH / 2 + x0, y1 + _HEIGHT / 2 - y0), c
20.     FOR j = 1 TO b2
21.         x1 = a * SQR(1 - j ^ 2 / b ^ 2)
22.         LINE (-x1 + _WIDTH / 2 + x0, j + _HEIGHT / 2 - y0)-(-a2 - 1 + _WIDTH / 2 + x0, j + _HEIGHT / 2 - y0), c
23.         LINE (-x1 + _WIDTH / 2 + x0, -j + _HEIGHT / 2 - y0)-(-a2 - 1 + _WIDTH / 2 + x0, -j + _HEIGHT / 2 - y0), c
24.         LINE (x1 + _WIDTH / 2 + x0, j + _HEIGHT / 2 - y0)-(a2 + 1 + _WIDTH / 2 + x0, j + _HEIGHT / 2 - y0), c
25.         LINE (x1 + _WIDTH / 2 + x0, -j + _HEIGHT / 2 - y0)-(a2 + 1 + _WIDTH / 2 + x0, -j + _HEIGHT / 2 - y0), c
26.

OK but Jeopardy is on now, so a little later...

#### bplus ##### Re: CircleFiller
« Reply #12 on: February 07, 2019, 12:54:50 AM »
OK here is a little mod of Steve's original post (now that I know how it works):
Code: QB64: [Select]
1. _TITLE "Circle Paint by Steve mod B+" '2019-02-06
2. SCREEN _NEWIMAGE(640, 480, 32)
3.
4. CONST Red = &HFFFF0000
5.
6. LINE (200, 200)-(400, 400), Red, B
7. CircleFiller 300, 300, 10, Red
8. PRINT "Hit any key for real fun!"
9. CLS , 0
10. WHILE _KEYDOWN(27) = 0
11.     LINE (1, 1)-(639, 479), Red, B
12.     LINE (0, 0)-(640, 480), Red, B
13.     FOR i = 1 TO 5
14.         CIRCLE (RND * 640, RND * 480), RND * 30 + 20, Red
15.     CircleFiller 320, 240, 10, Red
16.     _LIMIT .5
17.
18. SUB CircleFiller (x, y, r, k AS _UNSIGNED LONG)
19.     IF CircleFillValid(x, y, r, k) THEN
20.         CircleFill x, y, r, k
21.         CircleFiller x - r - r - 1, y, r, k
22.         CircleFiller x + r + r + 1, y, r, k
23.         CircleFiller x, y - r - r - 1, r, k
24.         CircleFiller x, y + r + r + 1, r, k
25.
26.
27. SUB CircleFill (cx AS INTEGER, cy AS INTEGER, r AS INTEGER, c AS _UNSIGNED LONG)
28.     DIM xx AS LONG, yy AS LONG
29.     DIM sx AS LONG, sy AS LONG
30.     rx = r: ry = r
31.
32.     a = 2 * rx * rx
33.     b = 2 * ry * ry
34.     x = rx
35.     xx = ry * ry * (1 - rx - rx)
36.     yy = rx * rx
37.     sx = b * rx
38.
39.     DO WHILE sx >= sy
40.         LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
41.         IF y <> 0 THEN LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
42.
43.         y = y + 1
44.         sy = sy + a
45.         e = e + yy
46.         yy = yy + a
47.
48.         IF (e + e + xx) > 0 THEN
49.             x = x - 1
50.             sx = sx - b
51.             e = e + xx
52.             xx = xx + b
53.
54.     x = 0
55.     y = ry
56.     xx = rx * ry
57.     yy = rx * rx * (1 - ry - ry)
58.     e = 0
59.     sx = 0
60.     sy = a * ry
61.
62.     DO WHILE sx <= sy
63.         LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
64.         LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
65.
66.             x = x + 1
67.             sx = sx + b
68.             e = e + xx
69.             xx = xx + b
70.         LOOP UNTIL (e + e + yy) > 0
71.
72.         y = y - 1
73.         sy = sy - a
74.         e = e + yy
75.         yy = yy + a
76.
77.
78.
79.
80. FUNCTION CircleFillValid (cx AS INTEGER, cy AS INTEGER, r AS INTEGER, c AS _UNSIGNED LONG)
81.     DIM xx AS LONG, yy AS LONG
82.     DIM sx AS LONG, sy AS LONG
83.     rx = r: ry = r
84.
85.     a = 2 * rx * rx
86.     b = 2 * ry * ry
87.     x = rx
88.     xx = ry * ry * (1 - rx - rx)
89.     yy = rx * rx
90.     sx = b * rx
91.
92.     DO WHILE sx >= sy
93.         FOR i = cx - x TO cx + x
94.             IF POINT(i, cy - y) = c THEN EXIT FUNCTION
95.         'LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
96.         IF y <> 0 THEN
97.             'LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
98.             FOR i = cx - x TO cx + x
99.                 IF POINT(i, cy + y) = c THEN EXIT FUNCTION
100.
101.         y = y + 1
102.         sy = sy + a
103.         e = e + yy
104.         yy = yy + a
105.
106.         IF (e + e + xx) > 0 THEN
107.             x = x - 1
108.             sx = sx - b
109.             e = e + xx
110.             xx = xx + b
111.
112.     x = 0
113.     y = ry
114.     xx = rx * ry
115.     yy = rx * rx * (1 - ry - ry)
116.     e = 0
117.     sx = 0
118.     sy = a * ry
119.
120.     DO WHILE sx <= sy
121.         'LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
122.         'LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
123.         FOR i = cx - x TO cx + x
124.             IF POINT(i, cy - y) = c THEN EXIT FUNCTION
125.             IF POINT(i, cy + y) = c THEN EXIT FUNCTION
126.
127.             x = x + 1
128.             sx = sx + b
129.             e = e + xx
130.             xx = xx + b
131.         LOOP UNTIL (e + e + yy) > 0
132.
133.         y = y - 1
134.         sy = sy - a
135.         e = e + yy
136.         yy = yy + a
137.
138.     CircleFillValid = -1
139.
140.

#### bplus ##### Re: CircleFiller
« Reply #13 on: February 07, 2019, 03:23:04 AM »
And so likewise, Paint with Balls:
Code: QB64: [Select]
1. _TITLE "Circle Filled by Steve mod B+" '2019-02-06
2. CONST xmax = 800
3. CONST ymax = 600
4.
5. SCREEN _NEWIMAGE(xmax, ymax, 32)
6. black = _RGB32(0, 0, 0)
7.
8. LINE (0, 0)-(800, 600), black, BF
9. LINE (200, 200)-(400, 400), &HFFFFFFFF, B
10. PaintWithBalls 300, 300, 10, _RGB32(255, 128, 0)
11. INPUT "To see a show, press enter,  and other + enter ends program... "; wate\$
12.
13. WHILE _KEYDOWN(27) = 0
14.     LINE (0, 0)-(800, 600), &HFF000000, BF
15.     LINE (0, 0)-(800, 600), _RGB32(255, 255, 255), B
16.     LINE (1, 1)-(799, 599), _RGB32(255, 255, 255), B
17.     FOR i = 1 TO 5
18.         LINE (RND * 800, RND * 600)-STEP(RND * 50 + 50, RND * 50 + 50), _RGB32(RND * 255, RND * 255, RND * 255), B
19.     PaintWithBalls 200, 200, INT(RND * 45 + 5), _RGB32(255, 100, 0)
20.
21. SUB PaintWithBalls (X, Y, ballRadius, ballColr AS _UNSIGNED LONG)
22.     ra = _PI(2 / 6)
23.     br = 2 * ballRadius + 1
24.     IF circClear(X, Y, ballRadius) THEN
25.         ball X, Y, ballRadius, ballColr
26.         PaintWithBalls X + br * COS(0), Y + br * SIN(0), ballRadius, ballColr
27.         PaintWithBalls X + br * COS(ra), Y + br * SIN(ra), ballRadius, ballColr
28.         PaintWithBalls X + br * COS(ra * 2), Y + br * SIN(ra * 2), ballRadius, ballColr
29.         PaintWithBalls X + br * COS(ra * 3), Y + br * SIN(ra * 3), ballRadius, ballColr
30.         PaintWithBalls X + br * COS(ra * 4), Y + br * SIN(ra * 4), ballRadius, ballColr
31.         PaintWithBalls X + br * COS(ra * 5), Y + br * SIN(ra * 5), ballRadius, ballColr
32.
33. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
34. FUNCTION circClear (CX AS LONG, CY AS LONG, R AS LONG)
35.     DIM subRadius AS LONG, RadiusError AS LONG
36.
37.     subRadius = ABS(R)
38.     RadiusError = -subRadius
39.     X = subRadius
40.     Y = 0
41.
42.     'IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
43.
44.     ' Draw the middle span here so we don't draw it twice in the main loop,
45.     ' which would be a problem with blending turned on.
46.     FOR i = CX - X TO CX + X
47.         IF POINT(i, CY) <> black THEN EXIT FUNCTION
48.     WHILE X > Y
49.         RadiusError = RadiusError + Y * 2 + 1
50.         IF RadiusError >= 0 THEN
51.             IF X <> Y + 1 THEN
52.                 FOR i = CX - Y TO CX + Y
53.                     IF POINT(i, CY - X) <> black THEN EXIT FUNCTION
54.                 'LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
55.                 FOR i = CX - Y TO CX + Y
56.                     IF POINT(i, CY + X) <> black THEN EXIT FUNCTION
57.                 'LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
58.             X = X - 1
59.             RadiusError = RadiusError - X * 2
60.         Y = Y + 1
61.         FOR i = CX - X TO CX + X
62.             IF POINT(i, CY - Y) <> black THEN EXIT FUNCTION
63.         'LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
64.
65.         FOR i = CX - X TO CX + X
66.             IF POINT(i, CY + Y) <> black THEN EXIT FUNCTION
67.         'LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
68.
69.     circClear = -1
70.
71.     rd = _RED32(K): g = _GREEN32(K): b = _BLUE32(K)
72.     FOR rad = r TO 1 STEP -1
73.         kr = _RGB32((r - rad) / r * rd, (r - rad) / r * g, (r - rad) / r * b)
74.         fel x, y, rad, rad, kr
75.
76. 'FillEllipse is too much typing so aballRadiuseviated to fel
77. ' with Steve's EllipseFill, who needs CircleFill? fix for 0 radii 2019-02-05
78. ' Is this fast enough for general circle fill (June 2018):  https://www.qb64.org/forum/index.php?topic=298.msg1942#msg1942
79. '  EllipseFill SMcNeill (Nov 3, 2018) https://www.qb64.org/forum/index.php?topic=755.msg6506#msg6506
80.     DIM xx AS LONG, yy AS LONG
81.     DIM sx AS LONG, sy AS LONG
82.
83.     IF rx = 0 OR ry = 0 THEN EXIT SUB 'nothing to draw
84.
85.     a = 2 * rx * rx
86.     b = 2 * ry * ry
87.     x = rx
88.     xx = ry * ry * (1 - rx - rx)
89.     yy = rx * rx
90.     sx = b * rx
91.
92.     DO WHILE sx >= sy
93.         LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
94.         IF y <> 0 THEN LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
95.
96.         y = y + 1
97.         sy = sy + a
98.         e = e + yy
99.         yy = yy + a
100.
101.         IF (e + e + xx) > 0 THEN
102.             x = x - 1
103.             sx = sx - b
104.             e = e + xx
105.             xx = xx + b
106.
107.     x = 0
108.     y = ry
109.     xx = rx * ry
110.     yy = rx * rx * (1 - ry - ry)
111.     e = 0
112.     sx = 0
113.     sy = a * ry
114.
115.     DO WHILE sx <= sy
116.         LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
117.         LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
118.
119.             x = x + 1
120.             sx = sx + b
121.             e = e + xx
122.             xx = xx + b
123.         LOOP UNTIL (e + e + yy) > 0
124.
125.         y = y - 1
126.         sy = sy - a
127.         e = e + yy
128.         yy = yy + a
129.
130.
131.
132. FUNCTION rand% (lo%, hi%)
133.     rand% = INT(RND * (hi% - lo% + 1)) + lo%
134.
135.