Author Topic: CircleFiller  (Read 5656 times)

0 Members and 1 Guest are viewing this topic.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
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.     END IF
  21.  
  22.  
  23.  
  24.  
  25.  
  26.  
  27. SUB CircleFill (cx AS INTEGER, cy AS INTEGER, r AS INTEGER, c AS _UNSIGNED LONG)
  28.     DIM a AS LONG, b AS LONG
  29.     DIM x AS LONG, y AS LONG
  30.     DIM xx AS LONG, yy AS LONG
  31.     DIM sx AS LONG, sy AS LONG
  32.     DIM e AS LONG
  33.     DIM rx AS INTEGER, ry AS INTEGER
  34.     rx = r: ry = r
  35.  
  36.     a = 2 * rx * rx
  37.     b = 2 * ry * ry
  38.     x = rx
  39.     xx = ry * ry * (1 - rx - rx)
  40.     yy = rx * rx
  41.     sx = b * rx
  42.  
  43.     DO WHILE sx >= sy
  44.         LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
  45.         IF y <> 0 THEN LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
  46.  
  47.         y = y + 1
  48.         sy = sy + a
  49.         e = e + yy
  50.         yy = yy + a
  51.  
  52.         IF (e + e + xx) > 0 THEN
  53.             x = x - 1
  54.             sx = sx - b
  55.             e = e + xx
  56.             xx = xx + b
  57.         END IF
  58.     LOOP
  59.  
  60.     x = 0
  61.     y = ry
  62.     xx = rx * ry
  63.     yy = rx * rx * (1 - ry - ry)
  64.     e = 0
  65.     sx = 0
  66.     sy = a * ry
  67.  
  68.     DO WHILE sx <= sy
  69.         LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
  70.         LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
  71.  
  72.         DO
  73.             x = x + 1
  74.             sx = sx + b
  75.             e = e + xx
  76.             xx = xx + b
  77.         LOOP UNTIL (e + e + yy) > 0
  78.  
  79.         y = y - 1
  80.         sy = sy - a
  81.         e = e + yy
  82.         yy = yy + a
  83.  
  84.     LOOP
  85.  
  86.  
  87.  
  88. FUNCTION CircleFillValid (cx AS INTEGER, cy AS INTEGER, r AS INTEGER, c AS _UNSIGNED LONG)
  89.     DIM a AS LONG, b AS LONG
  90.     DIM x AS LONG, y AS LONG
  91.     DIM xx AS LONG, yy AS LONG
  92.     DIM sx AS LONG, sy AS LONG
  93.     DIM e AS LONG
  94.     DIM rx AS INTEGER, ry AS INTEGER
  95.     rx = r: ry = r
  96.  
  97.     a = 2 * rx * rx
  98.     b = 2 * ry * ry
  99.     x = rx
  100.     xx = ry * ry * (1 - rx - rx)
  101.     yy = rx * rx
  102.     sx = b * rx
  103.  
  104.     DO WHILE sx >= sy
  105.         FOR i = cx - x TO cx + x
  106.             IF POINT(i, cy - y) = c THEN EXIT FUNCTION
  107.         NEXT
  108.         'LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
  109.         IF y <> 0 THEN
  110.             'LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
  111.             FOR i = cx - x TO cx + x
  112.                 IF POINT(i, cy + y) = c THEN EXIT FUNCTION
  113.             NEXT
  114.         END IF
  115.  
  116.         y = y + 1
  117.         sy = sy + a
  118.         e = e + yy
  119.         yy = yy + a
  120.  
  121.         IF (e + e + xx) > 0 THEN
  122.             x = x - 1
  123.             sx = sx - b
  124.             e = e + xx
  125.             xx = xx + b
  126.         END IF
  127.     LOOP
  128.  
  129.     x = 0
  130.     y = ry
  131.     xx = rx * ry
  132.     yy = rx * rx * (1 - ry - ry)
  133.     e = 0
  134.     sx = 0
  135.     sy = a * ry
  136.  
  137.     DO WHILE sx <= sy
  138.         'LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
  139.         'LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
  140.         FOR i = cx - x TO cx + x
  141.             IF POINT(i, cy - y) = c THEN EXIT FUNCTION
  142.             IF POINT(i, cy + y) = c THEN EXIT FUNCTION
  143.         NEXT
  144.  
  145.         DO
  146.             x = x + 1
  147.             sx = sx + b
  148.             e = e + xx
  149.             xx = xx + b
  150.         LOOP UNTIL (e + e + yy) > 0
  151.  
  152.         y = y - 1
  153.         sy = sy - a
  154.         e = e + yy
  155.         yy = yy + a
  156.  
  157.     LOOP
  158.     CircleFillValid = -1
  159.  

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!

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
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.     _DISPLAY
  19.     IF check THEN _LIMIT .3 ELSE _LIMIT 1
  20.  
  21. SUB fillWithBalls (topX, topY, wide, height, ballRadius, ballColr AS _UNSIGNED LONG)
  22.     xLeft = topX + wide
  23.     yBelow = topY + height
  24.     'check the rack
  25.     IF check = 1 THEN LINE (topX, topY)-(xLeft, yBelow), &HFFFFFFFF, B
  26.     FOR y = yBelow - ballRadius TO topY + ballRadius STEP -SQR(3) * ballRadius
  27.         layer = layer + 1
  28.         IF layer MOD 2 = 0 THEN spacer = ballRadius ELSE spacer = 0
  29.         IF y + SQR(3) * ballRadius <= yBelow + ballRadius THEN
  30.             FOR x = topX + ballRadius TO xLeft STEP 2 * ballRadius
  31.                 IF spacer + x - ballRadius >= topX AND spacer + x + ballRadius <= xLeft + 2 THEN
  32.                     ball spacer + x, y, ballRadius, ballColr
  33.                     'check ball fill = tangent white circles
  34.                     IF check = 1 THEN CIRCLE (spacer + x, y), ballRadius, &HFFFFFFFF ' be honest with edges
  35.                 ELSE
  36.                     'check ball fill = tangent white circles
  37.                     IF check = 1 THEN CIRCLE (spacer + x, y), ballRadius, &HFFFFFFFF ' be honest with edges
  38.                 END IF
  39.             NEXT
  40.         END IF
  41.     NEXT
  42.  
  43.  
  44. 'here it is! The ball sub !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  45.     rd = _RED32(K): g = _GREEN32(K): b = _BLUE32(K)
  46.     FOR rad = r TO 1 STEP -1
  47.         kr = _RGB32((r - rad) / r * rd, (r - rad) / r * g, (r - rad) / r * b)
  48.         fel x, y, rad, rad, kr
  49.     NEXT
  50.  
  51. 'FillEllipse is too much typing so using fel
  52. ' with Steve's EllipseFill, who needs CircleFill? fix for 0 radii 2019-02-05
  53. ' Is this fast enough for general circle fill (June 2018):  https://www.qb64.org/forum/index.php?topic=298.msg1942#msg1942
  54. '  EllipseFill SMcNeill (Nov 3, 2018) https://www.qb64.org/forum/index.php?topic=755.msg6506#msg6506
  55.     DIM a AS LONG, b AS LONG
  56.     DIM x AS LONG, y AS LONG
  57.     DIM xx AS LONG, yy AS LONG
  58.     DIM sx AS LONG, sy AS LONG
  59.     DIM e AS LONG
  60.  
  61.     IF rx = 0 OR ry = 0 THEN EXIT SUB 'nothing to draw
  62.  
  63.     a = 2 * rx * rx
  64.     b = 2 * ry * ry
  65.     x = rx
  66.     xx = ry * ry * (1 - rx - rx)
  67.     yy = rx * rx
  68.     sx = b * rx
  69.  
  70.     DO WHILE sx >= sy
  71.         LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
  72.         IF y <> 0 THEN LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
  73.  
  74.         y = y + 1
  75.         sy = sy + a
  76.         e = e + yy
  77.         yy = yy + a
  78.  
  79.         IF (e + e + xx) > 0 THEN
  80.             x = x - 1
  81.             sx = sx - b
  82.             e = e + xx
  83.             xx = xx + b
  84.         END IF
  85.     LOOP
  86.  
  87.     x = 0
  88.     y = ry
  89.     xx = rx * ry
  90.     yy = rx * rx * (1 - ry - ry)
  91.     e = 0
  92.     sx = 0
  93.     sy = a * ry
  94.  
  95.     DO WHILE sx <= sy
  96.         LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
  97.         LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
  98.  
  99.         DO
  100.             x = x + 1
  101.             sx = sx + b
  102.             e = e + xx
  103.             xx = xx + b
  104.         LOOP UNTIL (e + e + yy) > 0
  105.  
  106.         y = y - 1
  107.         sy = sy - a
  108.         e = e + yy
  109.         yy = yy + a
  110.  
  111.     LOOP
  112.  
  113.  
  114. FUNCTION rand% (lo%, hi%)
  115.     rand% = INT(RND * (hi% - lo% + 1)) + lo%
  116.  

Circle Filled mod B+.PNG
* Circle Filled mod B+.PNG (Filesize: 101.15 KB, Dimensions: 802x630, Views: 374)
« Last Edit: February 06, 2019, 05:39:15 pm by bplus »

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
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.
You're not done when it works, you're done when it's right.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
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!

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
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
  9.     NEXT
« Last Edit: February 06, 2019, 05:56:06 pm by STxAxTIC »
You're not done when it works, you're done when it's right.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
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?

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
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
  9.     NEXT

You want to race? ;-))

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
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 »
You're not done when it works, you're done when it's right.

Offline SMcNeill

  • QB64 Developer
  • Forum Resident
  • Posts: 3972
    • View Profile
    • Steve’s QB64 Archive Forum
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!

Offline STxAxTIC

  • Library Staff
  • Forum Resident
  • Posts: 1091
  • he lives
    • View Profile
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.     NEXT
  21.     FOR j = 1 TO b2
  22.         x1 = a * SQR(1 - j ^ 2 / b ^ 2)
  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.         LINE (x1 + _WIDTH / 2 + x0, -j + _HEIGHT / 2 - y0)-(a2 + 1 + _WIDTH / 2 + x0, -j + _HEIGHT / 2 - y0), c
  27.     NEXT
  28.  
You're not done when it works, you're done when it's right.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
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

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
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.     NEXT
  21.     FOR j = 1 TO b2
  22.         x1 = a * SQR(1 - j ^ 2 / b ^ 2)
  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.         LINE (x1 + _WIDTH / 2 + x0, -j + _HEIGHT / 2 - y0)-(a2 + 1 + _WIDTH / 2 + x0, -j + _HEIGHT / 2 - y0), c
  27.     NEXT
  28.  

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

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
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.     CLS
  12.     LINE (1, 1)-(639, 479), Red, B
  13.     LINE (0, 0)-(640, 480), Red, B
  14.     FOR i = 1 TO 5
  15.         CIRCLE (RND * 640, RND * 480), RND * 30 + 20, Red
  16.     NEXT
  17.     CircleFiller 320, 240, 10, Red
  18.     _DISPLAY
  19.     _LIMIT .5
  20.  
  21. SUB CircleFiller (x, y, r, k AS _UNSIGNED LONG)
  22.     IF CircleFillValid(x, y, r, k) THEN
  23.         CircleFill x, y, r, k
  24.         CircleFiller x - r - r - 1, y, r, k
  25.         CircleFiller x + r + r + 1, y, r, k
  26.         CircleFiller x, y - r - r - 1, r, k
  27.         CircleFiller x, y + r + r + 1, r, k
  28.     END IF
  29.  
  30.  
  31. SUB CircleFill (cx AS INTEGER, cy AS INTEGER, r AS INTEGER, c AS _UNSIGNED LONG)
  32.     DIM a AS LONG, b AS LONG
  33.     DIM x AS LONG, y AS LONG
  34.     DIM xx AS LONG, yy AS LONG
  35.     DIM sx AS LONG, sy AS LONG
  36.     DIM e AS LONG
  37.     DIM rx AS INTEGER, ry AS INTEGER
  38.     rx = r: ry = r
  39.  
  40.     a = 2 * rx * rx
  41.     b = 2 * ry * ry
  42.     x = rx
  43.     xx = ry * ry * (1 - rx - rx)
  44.     yy = rx * rx
  45.     sx = b * rx
  46.  
  47.     DO WHILE sx >= sy
  48.         LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
  49.         IF y <> 0 THEN LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
  50.  
  51.         y = y + 1
  52.         sy = sy + a
  53.         e = e + yy
  54.         yy = yy + a
  55.  
  56.         IF (e + e + xx) > 0 THEN
  57.             x = x - 1
  58.             sx = sx - b
  59.             e = e + xx
  60.             xx = xx + b
  61.         END IF
  62.     LOOP
  63.  
  64.     x = 0
  65.     y = ry
  66.     xx = rx * ry
  67.     yy = rx * rx * (1 - ry - ry)
  68.     e = 0
  69.     sx = 0
  70.     sy = a * ry
  71.  
  72.     DO WHILE sx <= sy
  73.         LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
  74.         LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
  75.  
  76.         DO
  77.             x = x + 1
  78.             sx = sx + b
  79.             e = e + xx
  80.             xx = xx + b
  81.         LOOP UNTIL (e + e + yy) > 0
  82.  
  83.         y = y - 1
  84.         sy = sy - a
  85.         e = e + yy
  86.         yy = yy + a
  87.  
  88.     LOOP
  89.  
  90.  
  91.  
  92. FUNCTION CircleFillValid (cx AS INTEGER, cy AS INTEGER, r AS INTEGER, c AS _UNSIGNED LONG)
  93.     DIM a AS LONG, b AS LONG
  94.     DIM x AS LONG, y AS LONG
  95.     DIM xx AS LONG, yy AS LONG
  96.     DIM sx AS LONG, sy AS LONG
  97.     DIM e AS LONG
  98.     DIM rx AS INTEGER, ry AS INTEGER
  99.     rx = r: ry = r
  100.  
  101.     a = 2 * rx * rx
  102.     b = 2 * ry * ry
  103.     x = rx
  104.     xx = ry * ry * (1 - rx - rx)
  105.     yy = rx * rx
  106.     sx = b * rx
  107.  
  108.     DO WHILE sx >= sy
  109.         FOR i = cx - x TO cx + x
  110.             IF POINT(i, cy - y) = c THEN EXIT FUNCTION
  111.         NEXT
  112.         'LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
  113.         IF y <> 0 THEN
  114.             'LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
  115.             FOR i = cx - x TO cx + x
  116.                 IF POINT(i, cy + y) = c THEN EXIT FUNCTION
  117.             NEXT
  118.         END IF
  119.  
  120.         y = y + 1
  121.         sy = sy + a
  122.         e = e + yy
  123.         yy = yy + a
  124.  
  125.         IF (e + e + xx) > 0 THEN
  126.             x = x - 1
  127.             sx = sx - b
  128.             e = e + xx
  129.             xx = xx + b
  130.         END IF
  131.     LOOP
  132.  
  133.     x = 0
  134.     y = ry
  135.     xx = rx * ry
  136.     yy = rx * rx * (1 - ry - ry)
  137.     e = 0
  138.     sx = 0
  139.     sy = a * ry
  140.  
  141.     DO WHILE sx <= sy
  142.         'LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
  143.         'LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
  144.         FOR i = cx - x TO cx + x
  145.             IF POINT(i, cy - y) = c THEN EXIT FUNCTION
  146.             IF POINT(i, cy + y) = c THEN EXIT FUNCTION
  147.         NEXT
  148.  
  149.         DO
  150.             x = x + 1
  151.             sx = sx + b
  152.             e = e + xx
  153.             xx = xx + b
  154.         LOOP UNTIL (e + e + yy) > 0
  155.  
  156.         y = y - 1
  157.         sy = sy - a
  158.         e = e + yy
  159.         yy = yy + a
  160.  
  161.     LOOP
  162.     CircleFillValid = -1
  163.  
  164.  

Circle Paint.PNG
* Circle Paint.PNG (Filesize: 28.88 KB, Dimensions: 637x504, Views: 297)

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
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.     NEXT
  20.     PaintWithBalls 200, 200, INT(RND * 45 + 5), _RGB32(255, 100, 0)
  21.     _LIMIT 1
  22.  
  23. SUB PaintWithBalls (X, Y, ballRadius, ballColr AS _UNSIGNED LONG)
  24.     ra = _PI(2 / 6)
  25.     br = 2 * ballRadius + 1
  26.     IF circClear(X, Y, ballRadius) THEN
  27.         ball X, Y, ballRadius, ballColr
  28.         PaintWithBalls X + br * COS(0), Y + br * SIN(0), ballRadius, ballColr
  29.         PaintWithBalls X + br * COS(ra), Y + br * SIN(ra), ballRadius, ballColr
  30.         PaintWithBalls X + br * COS(ra * 2), Y + br * SIN(ra * 2), ballRadius, ballColr
  31.         PaintWithBalls X + br * COS(ra * 3), Y + br * SIN(ra * 3), ballRadius, ballColr
  32.         PaintWithBalls X + br * COS(ra * 4), Y + br * SIN(ra * 4), ballRadius, ballColr
  33.         PaintWithBalls X + br * COS(ra * 5), Y + br * SIN(ra * 5), ballRadius, ballColr
  34.     END IF
  35.  
  36. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
  37. FUNCTION circClear (CX AS LONG, CY AS LONG, R AS LONG)
  38.     DIM subRadius AS LONG, RadiusError AS LONG
  39.     DIM X AS LONG, Y AS LONG
  40.  
  41.     subRadius = ABS(R)
  42.     RadiusError = -subRadius
  43.     X = subRadius
  44.     Y = 0
  45.  
  46.     'IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
  47.  
  48.     ' Draw the middle span here so we don't draw it twice in the main loop,
  49.     ' which would be a problem with blending turned on.
  50.     FOR i = CX - X TO CX + X
  51.         IF POINT(i, CY) <> black THEN EXIT FUNCTION
  52.     NEXT
  53.     WHILE X > Y
  54.         RadiusError = RadiusError + Y * 2 + 1
  55.         IF RadiusError >= 0 THEN
  56.             IF X <> Y + 1 THEN
  57.                 FOR i = CX - Y TO CX + Y
  58.                     IF POINT(i, CY - X) <> black THEN EXIT FUNCTION
  59.                 NEXT
  60.                 'LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
  61.                 FOR i = CX - Y TO CX + Y
  62.                     IF POINT(i, CY + X) <> black THEN EXIT FUNCTION
  63.                 NEXT
  64.                 'LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
  65.             END IF
  66.             X = X - 1
  67.             RadiusError = RadiusError - X * 2
  68.         END IF
  69.         Y = Y + 1
  70.         FOR i = CX - X TO CX + X
  71.             IF POINT(i, CY - Y) <> black THEN EXIT FUNCTION
  72.         NEXT
  73.         'LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
  74.  
  75.         FOR i = CX - X TO CX + X
  76.             IF POINT(i, CY + Y) <> black THEN EXIT FUNCTION
  77.         NEXT
  78.         'LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
  79.  
  80.     WEND
  81.     circClear = -1
  82.  
  83.     rd = _RED32(K): g = _GREEN32(K): b = _BLUE32(K)
  84.     FOR rad = r TO 1 STEP -1
  85.         kr = _RGB32((r - rad) / r * rd, (r - rad) / r * g, (r - rad) / r * b)
  86.         fel x, y, rad, rad, kr
  87.     NEXT
  88.  
  89. 'FillEllipse is too much typing so aballRadiuseviated to fel
  90. ' with Steve's EllipseFill, who needs CircleFill? fix for 0 radii 2019-02-05
  91. ' Is this fast enough for general circle fill (June 2018):  https://www.qb64.org/forum/index.php?topic=298.msg1942#msg1942
  92. '  EllipseFill SMcNeill (Nov 3, 2018) https://www.qb64.org/forum/index.php?topic=755.msg6506#msg6506
  93.     DIM a AS LONG, b AS LONG
  94.     DIM x AS LONG, y AS LONG
  95.     DIM xx AS LONG, yy AS LONG
  96.     DIM sx AS LONG, sy AS LONG
  97.     DIM e AS LONG
  98.  
  99.     IF rx = 0 OR ry = 0 THEN EXIT SUB 'nothing to draw
  100.  
  101.     a = 2 * rx * rx
  102.     b = 2 * ry * ry
  103.     x = rx
  104.     xx = ry * ry * (1 - rx - rx)
  105.     yy = rx * rx
  106.     sx = b * rx
  107.  
  108.     DO WHILE sx >= sy
  109.         LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
  110.         IF y <> 0 THEN LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
  111.  
  112.         y = y + 1
  113.         sy = sy + a
  114.         e = e + yy
  115.         yy = yy + a
  116.  
  117.         IF (e + e + xx) > 0 THEN
  118.             x = x - 1
  119.             sx = sx - b
  120.             e = e + xx
  121.             xx = xx + b
  122.         END IF
  123.     LOOP
  124.  
  125.     x = 0
  126.     y = ry
  127.     xx = rx * ry
  128.     yy = rx * rx * (1 - ry - ry)
  129.     e = 0
  130.     sx = 0
  131.     sy = a * ry
  132.  
  133.     DO WHILE sx <= sy
  134.         LINE (cx - x, cy - y)-(cx + x, cy - y), c, BF
  135.         LINE (cx - x, cy + y)-(cx + x, cy + y), c, BF
  136.  
  137.         DO
  138.             x = x + 1
  139.             sx = sx + b
  140.             e = e + xx
  141.             xx = xx + b
  142.         LOOP UNTIL (e + e + yy) > 0
  143.  
  144.         y = y - 1
  145.         sy = sy - a
  146.         e = e + yy
  147.         yy = yy + a
  148.  
  149.     LOOP
  150.  
  151.  
  152. FUNCTION rand% (lo%, hi%)
  153.     rand% = INT(RND * (hi% - lo% + 1)) + lo%
  154.  
  155.  

 
Paint with Balls.PNG