Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: bplus on March 31, 2018, 12:54:05 am

Title: Dropping Balls
Post by: bplus on March 31, 2018, 12:54:05 am
Misunderstanding what Make71 wanted, I reworked my ball handling for bounces and collisions. Not bad for zero vectors or dot products... are you a fake physics fan?
Code: QB64: [Select]
  1. _TITLE "Dropping Balls by bplus 2018-03-31"
  3. CONST xmax = 800
  4. CONST ymax = 600
  5.  
  6. SCREEN _NEWIMAGE(xmax, ymax, 32)
  7.  
  8. gravity = 1
  9. balls = 8
  10. DIM x(balls), y(balls), r(balls), c(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)
  11. FOR i = 1 TO balls
  12.     r(i) = rand(15, 20)
  13.     x(i) = rand(r(i), xmax - r(i))
  14.     y(i) = rand(r(i), ymax - r(i))
  15.     c(i) = rand(1, 15)
  16.     dx(i) = rand(1, 3) * rdir
  17.     dy(i) = rand(10, 20)
  18.     rr(i) = rand(200, 255)
  19.     gg(i) = rand(200, 255)
  20.     bb(i) = rand(200, 255)
  23.     CLS
  24.     FOR i = 1 TO balls
  25.         'ready for collision
  26.         a(i) = _ATAN2(dy(i), dx(i))
  27.         power = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5
  28.         FOR j = i + 1 TO balls
  29.             IF SQR((x(i) - x(j)) ^ 2 + (y(i) - y(j)) ^ 2) < r(i) + r(j) THEN
  30.                 a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))
  31.                 a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))
  32.                 EXIT FOR
  33.             END IF
  34.         NEXT
  35.         dx(i) = power * COS(a(i))
  36.         dy(i) = power * SIN(a(i))
  37.         dy(i) = dy(i) + gravity
  38.         x(i) = x(i) + dx(i)
  39.         y(i) = y(i) + dy(i) '+ 2 * gravity
  40.         IF x(i) < -r(i) OR x(i) > xmax + r(i) THEN
  41.             x(i) = xmax / 2
  42.             y(i) = 0
  43.             dx(i) = rand(1, 3) * rdir
  44.             dy(i) = 0
  45.         END IF
  46.         IF y(i) + r(i) > ymax THEN y(i) = ymax - r(i): dy(i) = dy(i) * -.8
  47.         FOR rad = r(i) TO 1 STEP -1
  48.             COLOR _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)
  49.             fcirc x(i), y(i), rad
  50.         NEXT
  51.     NEXT
  52.     _DISPLAY
  53.     _LIMIT 20
  55.  
  56. FUNCTION rand (lo, hi)
  57.     rand = (RND * (hi - lo + 1)) \ 1 + lo
  59.  
  60. FUNCTION rdir ()
  61.     IF RND < .5 THEN rdir = -1 ELSE rdir = 1
  63.  
  64. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
  65. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
  66.     DIM subRadius AS LONG, RadiusError AS LONG
  67.     DIM X AS LONG, Y AS LONG
  68.  
  69.     subRadius = ABS(R)
  70.     RadiusError = -subRadius
  71.     X = subRadius
  72.     Y = 0
  73.  
  74.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
  75.  
  76.     ' Draw the middle span here so we don't draw it twice in the main loop,
  77.     ' which would be a problem with blending turned on.
  78.     LINE (CX - X, CY)-(CX + X, CY), , BF
  79.  
  80.     WHILE X > Y
  81.         RadiusError = RadiusError + Y * 2 + 1
  82.         IF RadiusError >= 0 THEN
  83.             IF X <> Y + 1 THEN
  84.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
  85.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
  86.             END IF
  87.             X = X - 1
  88.             RadiusError = RadiusError - X * 2
  89.         END IF
  90.         Y = Y + 1
  91.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
  92.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
  93.     WEND
  95.  
  96.  

Title: Re: Dropping Balls
Post by: bplus on March 31, 2018, 09:54:40 am
OK most of flaws mostly fixed.
Code: QB64: [Select]
  1. _TITLE "Dropping Balls 2 by bplus 2018-03-31"
  2. ' attempt to fix
  4. CONST xmax = 800
  5. CONST ymax = 600
  6.  
  7. SCREEN _NEWIMAGE(xmax, ymax, 32)
  8. _SCREENMOVE 360, 60
  9.  
  10. gravity = 1
  11. balls = 8
  12. DIM x(balls), y(balls), r(balls), c(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)
  13. FOR i = 1 TO balls
  14.     r(i) = rand(15, 20)
  15.     x(i) = rand(r(i), xmax - r(i))
  16.     y(i) = rand(r(i), ymax - r(i))
  17.     c(i) = rand(1, 15)
  18.     dx(i) = rand(0, 3) * rdir
  19.     dy(i) = rand(10, 20)
  20.     rr(i) = rand(200, 255)
  21.     gg(i) = rand(200, 255)
  22.     bb(i) = rand(200, 255)
  25.     CLS
  26.     FOR i = 1 TO balls
  27.         'ready for collision
  28.         dy(i) = dy(i) + gravity
  29.         a(i) = _ATAN2(dy(i), dx(i))
  30.         power1 = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5
  31.         imoved = 0
  32.         FOR j = i + 1 TO balls
  33.             IF SQR((x(i) - x(j)) ^ 2 + (y(i) - y(j)) ^ 2) < r(i) + r(j) THEN
  34.                 imoved = 1
  35.                 a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))
  36.                 a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))
  37.                 'update new dx, dy for i and j balls
  38.                 power2 = (dx(j) ^ 2 + dy(j) ^ 2) ^ .5
  39.                 power = .7 * (power1 + power2) / 2
  40.                 dx(i) = power * COS(a(i))
  41.                 dy(i) = power * SIN(a(i))
  42.                 dx(j) = power * COS(a(j))
  43.                 dy(j) = power * SIN(a(j))
  44.                 x(i) = x(i) + dx(i)
  45.                 y(i) = y(i) + dy(i)
  46.                 x(j) = x(j) + dx(j)
  47.                 y(j) = y(j) + dy(j)
  48.                 EXIT FOR
  49.             END IF
  50.         NEXT
  51.         IF imoved = 0 THEN
  52.             x(i) = x(i) + dx(i)
  53.             y(i) = y(i) + dy(i)
  54.         END IF
  55.         IF x(i) < -r(i) OR x(i) > xmax + r(i) THEN
  56.             x(i) = xmax / 2 + rand(0, 100) * rdir
  57.             y(i) = 0
  58.             dx(i) = rand(0, 3) * rdir
  59.             dy(i) = 1
  60.         END IF
  61.         IF y(i) + r(i) > ymax THEN y(i) = ymax - r(i): dy(i) = dy(i) * -.7: x(i) = x(i) + .1 * dx(i)
  62.         FOR rad = r(i) TO 1 STEP -1
  63.             COLOR _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)
  64.             fcirc x(i), y(i), rad
  65.         NEXT
  66.     NEXT
  67.     _DISPLAY
  68.     _LIMIT 20
  70.  
  71. FUNCTION rand (lo, hi)
  72.     rand = (RND * (hi - lo + 1)) \ 1 + lo
  74.  
  75. FUNCTION rdir ()
  76.     IF RND < .5 THEN rdir = -1 ELSE rdir = 1
  78.  
  79. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
  80. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
  81.     DIM subRadius AS LONG, RadiusError AS LONG
  82.     DIM X AS LONG, Y AS LONG
  83.  
  84.     subRadius = ABS(R)
  85.     RadiusError = -subRadius
  86.     X = subRadius
  87.     Y = 0
  88.  
  89.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
  90.  
  91.     ' Draw the middle span here so we don't draw it twice in the main loop,
  92.     ' which would be a problem with blending turned on.
  93.     LINE (CX - X, CY)-(CX + X, CY), , BF
  94.  
  95.     WHILE X > Y
  96.         RadiusError = RadiusError + Y * 2 + 1
  97.         IF RadiusError >= 0 THEN
  98.             IF X <> Y + 1 THEN
  99.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
  100.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
  101.             END IF
  102.             X = X - 1
  103.             RadiusError = RadiusError - X * 2
  104.         END IF
  105.         Y = Y + 1
  106.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
  107.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
  108.     WEND
  110.  
  111.  
Title: Re: Dropping Balls
Post by: bplus on March 31, 2018, 12:57:00 pm
Sound effects added, but a little off when lots of sound all at once, still it's fun to listen to:
Code: QB64: [Select]
  1. _TITLE "Dropping Balls 2 w sound by bplus 2018-03-31"
  2. ' attempt to fix
  4. CONST xmax = 800
  5. CONST ymax = 600
  6.  
  7. SCREEN _NEWIMAGE(xmax, ymax, 32)
  8. _SCREENMOVE 360, 60
  9.  
  10. gravity = 1
  11. balls = 8
  12. DIM x(balls), y(balls), r(balls), c(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)
  13. FOR i = 1 TO balls
  14.     r(i) = rand(15, 20)
  15.     x(i) = rand(r(i), xmax - r(i))
  16.     y(i) = rand(r(i), ymax - r(i))
  17.     c(i) = rand(1, 15)
  18.     dx(i) = rand(0, 3) * rdir
  19.     dy(i) = rand(10, 20)
  20.     rr(i) = rand(200, 255)
  21.     gg(i) = rand(200, 255)
  22.     bb(i) = rand(200, 255)
  25.     CLS
  26.     FOR i = 1 TO balls
  27.         'ready for collision
  28.         dy(i) = dy(i) + gravity
  29.         a(i) = _ATAN2(dy(i), dx(i))
  30.         power1 = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5
  31.         imoved = 0
  32.         FOR j = i + 1 TO balls
  33.             IF SQR((x(i) - x(j)) ^ 2 + (y(i) - y(j)) ^ 2) < r(i) + r(j) THEN
  34.                 imoved = 1
  35.                 a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))
  36.                 a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))
  37.                 'update new dx, dy for i and j balls
  38.                 power2 = (dx(j) ^ 2 + dy(j) ^ 2) ^ .5
  39.                 power = .7 * (power1 + power2) / 2
  40.                 dx(i) = power * COS(a(i))
  41.                 dy(i) = power * SIN(a(i))
  42.                 dx(j) = power * COS(a(j))
  43.                 dy(j) = power * SIN(a(j))
  44.                 x(i) = x(i) + dx(i)
  45.                 y(i) = y(i) + dy(i)
  46.                 x(j) = x(j) + dx(j)
  47.                 y(j) = y(j) + dy(j)
  48.                 snd 120 + r(i) * 250, r(j) * .15
  49.                 EXIT FOR
  50.             END IF
  51.         NEXT
  52.         IF imoved = 0 THEN
  53.             x(i) = x(i) + dx(i)
  54.             y(i) = y(i) + dy(i)
  55.         END IF
  56.         IF x(i) < -r(i) OR x(i) > xmax + r(i) THEN
  57.             x(i) = xmax / 2 + rand(0, 100) * rdir
  58.             y(i) = 0
  59.             dx(i) = rand(0, 3) * rdir
  60.             dy(i) = 1
  61.         END IF
  62.         IF y(i) + r(i) > ymax + gravity THEN snd (y(i) + r(i) - (ymax + gravity)) * 100 + r(i) * 20, 6 'only when hits floor, not for rolling balls
  63.         IF y(i) + r(i) > ymax THEN y(i) = ymax - r(i): dy(i) = dy(i) * -.7: x(i) = x(i) + .1 * dx(i)
  64.  
  65.         FOR rad = r(i) TO 1 STEP -1
  66.             COLOR _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)
  67.             fcirc x(i), y(i), rad
  68.         NEXT
  69.     NEXT
  70.     _DISPLAY
  71.     _LIMIT 20
  73.  
  74. FUNCTION rand (lo, hi)
  75.     rand = (RND * (hi - lo + 1)) \ 1 + lo
  77.  
  78. FUNCTION rdir ()
  79.     IF RND < .5 THEN rdir = -1 ELSE rdir = 1
  81.  
  82. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
  83. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
  84.     DIM subRadius AS LONG, RadiusError AS LONG
  85.     DIM X AS LONG, Y AS LONG
  86.  
  87.     subRadius = ABS(R)
  88.     RadiusError = -subRadius
  89.     X = subRadius
  90.     Y = 0
  91.  
  92.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
  93.  
  94.     ' Draw the middle span here so we don't draw it twice in the main loop,
  95.     ' which would be a problem with blending turned on.
  96.     LINE (CX - X, CY)-(CX + X, CY), , BF
  97.  
  98.     WHILE X > Y
  99.         RadiusError = RadiusError + Y * 2 + 1
  100.         IF RadiusError >= 0 THEN
  101.             IF X <> Y + 1 THEN
  102.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
  103.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
  104.             END IF
  105.             X = X - 1
  106.             RadiusError = RadiusError - X * 2
  107.         END IF
  108.         Y = Y + 1
  109.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
  110.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
  111.     WEND
  113.  
  114. SUB snd (frq, dur)
  115.     SOUND frq / 2.2, dur * .01
  117.  
Title: Re: Dropping Balls
Post by: FellippeHeitor on April 01, 2018, 07:19:26 pm
Love the sound synthesis with SOUND!
Title: Re: Dropping Balls
Post by: bplus on April 03, 2018, 05:39:05 pm
Dynamically built pyramid pile, thanks to STxAxTIC's help:
Code: QB64: [Select]
  1. _TITLE "Dropping Balls pile attempt bplus 2018-04-03"
  2. 'attempt to build pile by adjusting drop rate, elasticity, gravity
  3. ' remove sound and adjust dropping to center of screen
  4.  
  5.  
  6.  
  7. ' built from Dropping balls 4 w snd and STATIC created 2018-04-3
  8. ' add STATIC's moving ball before figuring bounce from collision
  9. ' which was a mod of Dropping Balls 2 w sound posted 2018-03-31
  11. CONST xmax = 800
  12. CONST ymax = 600
  13.  
  14. SCREEN _NEWIMAGE(xmax, ymax, 32)
  15. _SCREENMOVE 360, 60
  16. elastic = .5
  17. gravity = .5
  18. balls = 160
  19. DIM x(balls), y(balls), r(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)
  20. FOR i = 1 TO balls
  21.     r(i) = 15
  22.     x(i) = xmax / 2 + (i MOD 2) * 8 - 4
  23.     y(i) = 0
  24.     dx(i) = 0
  25.     dy(i) = 3
  26.     rr(i) = rand(200, 255)
  27.     gg(i) = rand(200, 255)
  28.     bb(i) = rand(200, 255)
  30. maxBall = 0
  32.     CLS
  33.     loopCnt = loopCnt + 1
  34.     IF loopCnt MOD 17 = 0 THEN
  35.         IF maxBall < balls THEN maxBall = maxBall + 1
  36.     END IF
  37.     COLOR _RGB32(255, 255, 255)
  38.     _PRINTSTRING (100, 10), "Balls:" + STR$(maxBall)
  39.  
  40.     FOR i = 1 TO maxBall
  41.         'ready for collision
  42.         dy(i) = dy(i) + gravity
  43.         a(i) = _ATAN2(dy(i), dx(i))
  44.  
  45.         imoved = 0
  46.         FOR j = i + 1 TO maxBall
  47.  
  48.             ' The following is STATIC's adjustment of ball positions if overlapping
  49.             ' before calcultion of new positions from collision
  50.             ' Displacement vector and its magnitude.  Thanks STxAxTIC !
  51.             nx = x(j) - x(i)
  52.             ny = y(j) - y(i)
  53.             nm = SQR(nx ^ 2 + ny ^ 2)
  54.             IF nm < 1 + r(i) + r(j) THEN
  55.                 nx = nx / nm
  56.                 ny = ny / nm
  57.  
  58.                 ' Regardless of momentum exchange, separate the balls along the lone connecting them.
  59.                 DO WHILE nm < 1 + r(i) + r(j)
  60.                     flub = .001 '* RND
  61.  
  62.                     x(j) = x(j) + flub * nx
  63.                     y(j) = y(j) + flub * ny
  64.  
  65.                     x(i) = x(i) - flub * nx
  66.                     y(i) = y(i) - flub * ny
  67.  
  68.                     nx = x(j) - x(i)
  69.                     ny = y(j) - y(i)
  70.                     nm = SQR(nx ^ 2 + ny ^ 2)
  71.                     nx = nx / nm
  72.                     ny = ny / nm
  73.                 LOOP
  74.  
  75.  
  76.                 imoved = 1
  77.                 a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))
  78.                 a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))
  79.  
  80.                 'update new dx, dy for i and j balls
  81.                 power1 = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5
  82.                 power2 = (dx(j) ^ 2 + dy(j) ^ 2) ^ .5
  83.                 power = elastic * (power1 + power2) / 2
  84.                 dx(i) = power * COS(a(i))
  85.                 dy(i) = power * SIN(a(i))
  86.                 dx(j) = power * COS(a(j))
  87.                 dy(j) = power * SIN(a(j))
  88.                 x(i) = x(i) + dx(i)
  89.                 y(i) = y(i) + dy(i)
  90.                 x(j) = x(j) + dx(j)
  91.                 y(j) = y(j) + dy(j)
  92.                 'EXIT FOR
  93.             END IF
  94.         NEXT
  95.         IF imoved = 0 THEN
  96.             x(i) = x(i) + dx(i)
  97.             y(i) = y(i) + dy(i)
  98.         END IF
  99.         IF x(i) < -r(i) OR x(i) > xmax + r(i) THEN
  100.             x(i) = xmax / 2 + (i MOD 2) * 4 * r(i) - 2 * r(i)
  101.             y(i) = 0
  102.             dx(i) = 0
  103.             dy(i) = 3
  104.         END IF
  105.  
  106.         IF y(i) + r(i) > ymax THEN y(i) = ymax - r(i): dy(i) = -dy(i) * elastic '???: x(i) = x(i) + .1 * dx(i)
  107.  
  108.         FOR rad = r(i) TO 1 STEP -1
  109.             COLOR _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)
  110.             fcirc x(i), y(i), rad
  111.         NEXT
  112.     NEXT
  113.     _DISPLAY
  114.     _LIMIT 20
  116.  
  117. FUNCTION rand (lo, hi)
  118.     rand = (RND * (hi - lo + 1)) \ 1 + lo
  120.  
  121. FUNCTION rdir ()
  122.     IF RND < .5 THEN rdir = -1 ELSE rdir = 1
  124.  
  125. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
  126. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
  127.     DIM subRadius AS LONG, RadiusError AS LONG
  128.     DIM X AS LONG, Y AS LONG
  129.  
  130.     subRadius = ABS(R)
  131.     RadiusError = -subRadius
  132.     X = subRadius
  133.     Y = 0
  134.  
  135.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
  136.  
  137.     ' Draw the middle span here so we don't draw it twice in the main loop,
  138.     ' which would be a problem with blending turned on.
  139.     LINE (CX - X, CY)-(CX + X, CY), , BF
  140.  
  141.     WHILE X > Y
  142.         RadiusError = RadiusError + Y * 2 + 1
  143.         IF RadiusError >= 0 THEN
  144.             IF X <> Y + 1 THEN
  145.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
  146.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
  147.             END IF
  148.             X = X - 1
  149.             RadiusError = RadiusError - X * 2
  150.         END IF
  151.         Y = Y + 1
  152.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
  153.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
  154.     WEND
  156.  
  157. SUB snd (frq, dur)
  158.     SOUND frq / 2.2, dur * .01
  160.  
  161.  
Title: Re: Dropping Balls
Post by: bplus on April 03, 2018, 11:19:54 pm
For perfect pyramids, I offer this:
Code: QB64: [Select]
  1. _TITLE "pyramid of circles 2 by bplus 2018-04-03"
  2. CONST xmax = 800
  3. CONST ymax = 600
  4.  
  5. SCREEN _NEWIMAGE(xmax, ymax, 32)
  6. _SCREENMOVE 360, 60
  7. DIM SHARED px(154), py(154), rr(154), gg(154), bb(154)
  8. FOR i = 1 TO 153
  9.     rr(i) = (RND * 55 + 200)
  10.     gg(i) = RND * 55 + 200 * INT(RND * 2)
  11.     bb(i) = RND * 55 + 200
  13. 'let n = number of circles at base of pile
  14. n = 10
  15.  
  16. 'let r = radius of each circle
  17. r = 20
  18.  
  19. 'let base be total length of pile
  20. baseLength = 2 * r * n
  21.  
  22. ' center pyramid in middle of screen
  23. startx = (xmax - baseLength) / 2
  24.  
  25. 'stacking circles that form equilateral triangles at their origins have a height change of
  26. deltaHeight = r * 3 ^ .5 'r times the sqr(3)
  27.  
  28. FOR row = n TO 1 STEP -1
  29.     IF row = n THEN y = ymax - r - 1 ELSE y = y - deltaHeight
  30.     FOR col = 1 TO row
  31.         x = startx + col * 2 * r - r
  32.         index = index + 1
  33.         target x, y, index
  34.     NEXT
  35.     startx = startx + r
  38.  
  39. SUB target (x, y, i)
  40.     nx = x: ny = y
  41.     ra = _PI(1 / (INT(RND * 7) + 4) + 1 / 2)
  42.     dx = 10 * COS(ra)
  43.     dy = 10 * SIN(ra)
  44.     bounce = 0: rb = INT(RND * 7) + 3
  45.     WHILE bounce < rb
  46.         IF nx + dx > xmax - 20 OR nx + dx < 20 THEN dx = -dx: bounce = bounce + 1
  47.         IF ny + dy > ymax - 20 OR ny + dy < 20 THEN dy = -dy: bounce = bounce + 1
  48.         nx = nx + dx: ny = ny + dy
  49.     WEND
  50.     dx = -dx: dy = -dy
  51.     WHILE bounce > 0
  52.         IF nx + dx > xmax - 20 OR nx + dx < 20 THEN dx = -dx: bounce = bounce - 1
  53.         IF ny + dy > ymax - 20 OR ny + dy < 20 THEN dy = -dy: bounce = bounce - 1
  54.         nx = nx + dx: ny = ny + dy
  55.         CLS
  56.         FOR j = 1 TO i - 1
  57.             FOR rad = 20 TO 1 STEP -1
  58.                 COLOR _RGB32(rr(j) - 10 * rad, gg(j) - 10 * rad, bb(j) - 10 * rad)
  59.                 fcirc px(j), py(j), rad
  60.             NEXT
  61.         NEXT
  62.         FOR rad = 20 TO 1 STEP -1
  63.             COLOR _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)
  64.             fcirc nx, ny, rad
  65.         NEXT
  66.         _DISPLAY
  67.         _LIMIT 200
  68.     WEND
  69.     'last bit
  70.     WHILE SQR((nx - x) ^ 2 + (ny - y) ^ 2) > 20
  71.         nx = nx + dx
  72.         ny = ny + dy
  73.         CLS
  74.         FOR j = 1 TO i - 1
  75.             FOR rad = 20 TO 1 STEP -1
  76.                 COLOR _RGB32(rr(j) - 10 * rad, gg(j) - 10 * rad, bb(j) - 10 * rad)
  77.                 fcirc px(j), py(j), rad
  78.             NEXT
  79.         NEXT
  80.         FOR rad = 20 TO 1 STEP -1
  81.             COLOR _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)
  82.             fcirc nx, ny, rad
  83.         NEXT
  84.         _DISPLAY
  85.         _LIMIT 200
  86.     WEND
  87.  
  88.     CLS
  89.     FOR j = 1 TO i - 1
  90.         FOR rad = 20 TO 1 STEP -1
  91.             COLOR _RGB32(rr(j) - 10 * rad, gg(j) - 10 * rad, bb(j) - 10 * rad)
  92.             fcirc px(j), py(j), rad
  93.         NEXT
  94.     NEXT
  95.     FOR rad = 20 TO 1 STEP -1
  96.         COLOR _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)
  97.         fcirc x, y, rad
  98.     NEXT
  99.     _DISPLAY
  100.     _DELAY .25
  101.     px(i) = x: py(i) = y
  103.  
  104.  
  105. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
  106. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
  107.     DIM subRadius AS LONG, RadiusError AS LONG
  108.     DIM X AS LONG, Y AS LONG
  109.  
  110.     subRadius = ABS(R)
  111.     RadiusError = -subRadius
  112.     X = subRadius
  113.     Y = 0
  114.  
  115.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
  116.  
  117.     ' Draw the middle span here so we don't draw it twice in the main loop,
  118.     ' which would be a problem with blending turned on.
  119.     LINE (CX - X, CY)-(CX + X, CY), , BF
  120.  
  121.     WHILE X > Y
  122.         RadiusError = RadiusError + Y * 2 + 1
  123.         IF RadiusError >= 0 THEN
  124.             IF X <> Y + 1 THEN
  125.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
  126.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
  127.             END IF
  128.             X = X - 1
  129.             RadiusError = RadiusError - X * 2
  130.         END IF
  131.         Y = Y + 1
  132.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
  133.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
  134.     WEND
  136.  
  137.  
  138.  
  139.  
Title: Re: Dropping Balls
Post by: bplus on April 04, 2018, 09:36:52 am
Dang! I could of drawn a picture with the colored balls AND have the pyramid magically appear as from all the balls flying around slowly finding their resting place. BBL




Title: Re: Dropping Balls
Post by: _vince on June 10, 2018, 10:35:11 am
How hard would it be to adapt for an hourglass simulator?
Title: Re: Dropping Balls
Post by: bplus on June 10, 2018, 11:41:07 am
Quote from: v on June 10, 2018, 10:35:11 am
How hard would it be to adapt for an hourglass simulator?

Wow, it's been just a couple of months since I have posted this but seems like a year. BTW I did finish the BBL later thing and was not impressed and other things came up, so apologies for that if anyone was waiting....

Sand in 2D is easy from this, if I recall, just adjust the bounce factors. But if you want a really cool 3D sim, Ashish would be likely of great help with the GL stuff.

Glass-like graphics effects might be interesting to explore! Does anyone have some simple models?

Oh Petr did some transparency stuff for buttons but need shiny glass reflecting surround colors if not images fit onto the glass surface and distorted according to glass shape. (Yikes more 3D stuff!)
Title: Re: Dropping Balls
Post by: bplus on June 10, 2018, 04:32:34 pm
Quote from: [banned user] on June 10, 2018, 04:15:37 pm
How is this for a nice effect?

...

I like this much better:
https://www.qb64.org/forum/index.php?topic=262.0

[banned user], if you modify my code could you write that somewhere on or around title.

I don't understand the need or use of map!

And what have you against the sounds?  ;D
Title: Re: Dropping Balls
Post by: _vince on June 10, 2018, 07:45:21 pm
Here's a draft, several flaws though.

Code: QB64: [Select]
  1. _TITLE "Dropping Balls 2 w sound by vince 2018-03-31"
  2. ' attempt to fix
  4. CONST xmax = 800
  5. CONST ymax = 600
  6.  
  9. pi = 3.1415926
  10.  
  11. SCREEN _NEWIMAGE(xmax, ymax, 32)
  12. '_SCREENMOVE 360, 60
  13.  
  14. gravity = 1
  15. balls = 1000
  16. DIM x(balls), y(balls), r(balls), c(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)
  17.  
  18.  
  19. screen ,,1,0
  20. line (0,0)-(800,600),_rgb(0,0,0),bf
  21. a=0
  22. xx = 150*sin(2*a)
  23. yy = 300*cos(a)
  24. pset (xx+400,yy+300), _rgb(100,100,100)
  25. for a = 0 to 2*pi step 0.01
  26.         xx = 150*sin(2*a)
  27.         yy = 300*cos(a)
  28.         line -(xx+400,yy+300), _rgb(100,100,100)
  30.  
  31. paint (400,150),_rgb(100,100,100)
  32. paint (400,450),_rgb(100,100,100)
  33. line (380,150)-(420,450),_rgb(100,100,100),bf
  34.  
  35. pcopy 1,0
  36.  
  37.  
  38. balls = 0
  39. for yy = 50 to 300-10 step 8
  40. for xx = 10 to 600-10 step 8
  41.         if point(xx,yy) <> _rgb(0,0,0) then
  42.                 balls = balls + 1
  43.  
  44.                 r(balls) = 3
  45.                 x(balls) = xx
  46.                 y(balls) = yy
  47.                 c(balls) = 15
  48.                 dx(balls) = rand(0, 3) * rdir
  49.                 dy(balls) = 15
  50.  
  51.                 rr(balls) = 255
  52.                 gg(balls) = 255
  53.                 bb(balls) = 0
  54.         end if
  57.  
  58. screen ,,0,0
  59.  
  60. 'FOR i = 1 TO balls
  61. '    r(i) = rand(15, 20)
  62. '    x(i) = rand(r(i), xmax - r(i))
  63. '    y(i) = rand(r(i), ymax - r(i))
  64. '    c(i) = rand(1, 15)
  65. '    dx(i) = rand(0, 3) * rdir
  66. '    dy(i) = rand(10, 20)
  67. '    rr(i) = rand(200, 255)
  68. '    gg(i) = rand(200, 255)
  69. '    bb(i) = rand(200, 255)
  70. 'NEXT
  72.         pcopy 1,0
  73.     FOR i = 1 TO balls
  74.         'ready for collision
  75.         dy(i) = dy(i) + gravity
  76.         a(i) = _ATAN2(dy(i), dx(i))
  77.         power1 = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5
  78.         imoved = 0
  79.         FOR j = i + 1 TO balls
  80.             IF SQR((x(i) - x(j)) ^ 2 + (y(i) - y(j)) ^ 2) < r(i) + r(j) THEN
  81.                 imoved = 1
  82.                 a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))
  83.                 a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))
  84.                 'update new dx, dy for i and j balls
  85.                 power2 = (dx(j) ^ 2 + dy(j) ^ 2) ^ .5
  86.                 power = .7 * (power1 + power2) / 2
  87.                 dx(i) = power * COS(a(i))
  88.                 dy(i) = power * SIN(a(i))
  89.                 dx(j) = power * COS(a(j))
  90.                 dy(j) = power * SIN(a(j))
  91.                 x(i) = x(i) + dx(i)
  92.                 y(i) = y(i) + dy(i)
  93.                 x(j) = x(j) + dx(j)
  94.                 y(j) = y(j) + dy(j)
  95.                 snd 120 + r(i) * 250, r(j) * .15
  96.                 EXIT FOR
  97.             END IF
  98.         NEXT
  99.         IF imoved = 0 THEN
  100.             x(i) = x(i) + dx(i)
  101.             y(i) = y(i) + dy(i)
  102.         END IF
  103.         'IF x(i) < -r(i) OR x(i) > xmax + r(i) THEN
  104.         '    x(i) = xmax / 2 + rand(0, 100) * rdir
  105.         '    y(i) = 0
  106.         '    dx(i) = rand(0, 3) * rdir
  107.         '    dy(i) = 1
  108.         'END IF
  109.         'IF y(i) + r(i) > ymax + gravity THEN snd (y(i) + r(i) - (ymax + gravity)) * 100 + r(i) * 20, 6 'only when hits floor, not for rolling balls
  110.                 screen ,,1,0
  111.                 '
  112.         IF point(x(i)+r(i),y(i))<>_rgb(100,100,100) THEN
  113.                         'y(i) = ymax - r(i)
  114.                         x(i) = x(i) - r(i)
  115.                         dy(i) = dy(i) * -.7
  116.                         dx(i) = dx(i) * -.7
  117.                         'x(i) = x(i) + .1 * dx(i)
  118.                 elseif  point(x(i)-r(i),y(i))<>_rgb(100,100,100) then
  119.                         x(i) = x(i) + r(i)
  120.                         dy(i) = dy(i) * -.7
  121.                         dx(i) = dx(i) * -.7
  122.                 elseif  point(x(i),y(i)+r(i))<>_rgb(100,100,100) then
  123.                         y(i) = y(i) - r(i)
  124.                         dy(i) = dy(i) * -.7
  125.                         dx(i) = dx(i) * -.7
  126.                 elseif  point(x(i),y(i)-r(i))<>_rgb(100,100,100) then
  127.                         y(i) = y(i) + r(i)
  128.                         dy(i) = dy(i) * -.7
  129.                         dx(i) = dx(i) * -.7
  130.                 end if
  131.                 screen ,,0,0
  132.  
  133.         FOR rad = r(i) TO 1 STEP -1
  134.             COLOR _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)
  135.             fcirc x(i), y(i), rad
  136.         NEXT
  137.     NEXT
  138.     _DISPLAY
  139.     _LIMIT 20
  141.  
  142. FUNCTION rand (lo, hi)
  143.     rand = (RND * (hi - lo + 1)) \ 1 + lo
  145.  
  146. FUNCTION rdir ()
  147.     IF RND < .5 THEN rdir = -1 ELSE rdir = 1
  149.  
  150. 'Steve McNeil's  copied from his forum  note: Radius is too common a name ;-)
  151. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
  152.     DIM subRadius AS LONG, RadiusError AS LONG
  153.     DIM X AS LONG, Y AS LONG
  154.  
  155.     subRadius = ABS(R)
  156.     RadiusError = -subRadius
  157.     X = subRadius
  158.     Y = 0
  159.  
  160.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
  161.  
  162.     ' Draw the middle span here so we don't draw it twice in the main loop,
  163.     ' which would be a problem with blending turned on ;-)
  164.     LINE (CX - X, CY)-(CX + X, CY), , BF
  165.  
  166.     WHILE X > Y
  167.         RadiusError = RadiusError + Y * 2 + 1
  168.         IF RadiusError >= 0 THEN
  169.             IF X <> Y + 1 THEN
  170.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
  171.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
  172.             END IF
  173.             X = X - 1
  174.             RadiusError = RadiusError - X * 2
  175.         END IF
  176.         Y = Y + 1
  177.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
  178.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
  179.     WEND
  181.  
  182. SUB snd (frq, dur)
  183.     'SOUND frq / 2.2, dur * .01
  185.  
  186.  
  187.  
Title: Re: Dropping Balls
Post by: _vince on June 10, 2018, 08:26:37 pm
As requested by Phil

Code: QB64: [Select]
  1. _TITLE "Dropping Balls pile attempt bplus ;-)"
  2. 'attempt to build pile by adjusting drop rate, elasticity, gravity
  3. ' remove sound and adjust dropping to center of screen
  4.  
  5. ' built from Dropping balls 4 w snd and STATIC created 2018-04-3
  6. ' add STATIC's moving ball before figuring bounce from collision
  7. ' which was a mod of Dropping Balls 2 w sound posted 2018-03-31
  9. CONST xmax = 800
  10. CONST ymax = 600
  11.  
  13. pi = 3.1415926
  14.  
  15. SCREEN _NEWIMAGE(xmax, ymax, 32)
  16. _SCREENMOVE 360, 60
  17. elastic = .5
  18. gravity = .5
  19. balls = 160
  20. DIM x(balls), y(balls), r(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)
  21.  
  22. dim aa(balls)
  23. dim aaa(balls)
  24. FOR i = 1 TO balls
  25.     r(i) = 50
  26.     x(i) = xmax / 2 + (i MOD 2) * 8 - 4
  27.     y(i) = 0
  28.     dx(i) = 0
  29.     dy(i) = 3
  30.     rr(i) = rand(200, 255)
  31.     gg(i) = rand(200, 255)
  32.     bb(i) = rand(200, 255)
  33.         aa(i) = 2*pi*rnd
  34.         aaa(i) = 0
  35.         'rnd*0.1-0.05
  37. maxBall = 0
  38.  
  39. t = timer
  41.     CLS
  42.     'loopCnt = loopCnt + 1
  43.     'IF loopCnt MOD 17 = 0 THEN
  44.         IF maxBall < balls and timer-t>1 THEN
  45.                 maxBall = maxBall + 1
  46.                 t = timer
  47.         end if
  48.  
  49.  
  50.     'END IF
  51.     COLOR _RGB32(255, 255, 255)
  52.     _PRINTSTRING (100, 10), "Balls:" + STR$(maxBall)
  53.  
  54.     FOR i = 1 TO maxBall
  55.                 aa(i) = aa(i) + aaa(i)
  56.  
  57.                 if abs(aaa(i)) > 0.5 then aaa(i)=aaa(i)+ sgn(aaa(i))*0.02
  58.  
  59.         'ready for collision
  60.         dy(i) = dy(i) + gravity
  61.         a(i) = _ATAN2(dy(i), dx(i))
  62.  
  63.         imoved = 0
  64.         FOR j = i + 1 TO maxBall
  65.  
  66.             ' The following is STATIC's adjustment of ball positions if overlapping
  67.             ' before calcultion of new positions from collision
  68.             ' Displacement vector and its magnitude.  Thanks STxAxTIC !
  69.             nx = x(j) - x(i)
  70.             ny = y(j) - y(i)
  71.             nm = SQR(nx ^ 2 + ny ^ 2)
  72.             IF nm < 1 + r(i) + r(j) THEN
  73.                 nx = nx / nm
  74.                 ny = ny / nm
  75.  
  76.                 ' Regardless of momentum exchange, separate the balls along the lone connecting them.
  77.                 DO WHILE nm < 1 + r(i) + r(j)
  78.                     flub = .001 '* RND
  79.  
  80.                     x(j) = x(j) + flub * nx
  81.                     y(j) = y(j) + flub * ny
  82.  
  83.                     x(i) = x(i) - flub * nx
  84.                     y(i) = y(i) - flub * ny
  85.  
  86.                     nx = x(j) - x(i)
  87.                     ny = y(j) - y(i)
  88.                     nm = SQR(nx ^ 2 + ny ^ 2)
  89.                     nx = nx / nm
  90.                     ny = ny / nm
  91.                 LOOP
  92.  
  93.  
  94.                 imoved = 1
  95.                 a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))
  96.                 a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))
  97.  
  98.                 'update new dx, dy for i and j balls
  99.                 power1 = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5
  100.                 power2 = (dx(j) ^ 2 + dy(j) ^ 2) ^ .5
  101.                 power = elastic * (power1 + power2) / 2
  102.                 dx(i) = power * COS(a(i))
  103.                 dy(i) = power * SIN(a(i))
  104.                 dx(j) = power * COS(a(j))
  105.                 dy(j) = power * SIN(a(j))
  106.                 x(i) = x(i) + dx(i)
  107.                 y(i) = y(i) + dy(i)
  108.                 x(j) = x(j) + dx(j)
  109.                 y(j) = y(j) + dy(j)
  110.                 'EXIT FOR
  111.  
  112.                                 aaa(i) = rnd*0.2-0.1
  113.             END IF
  114.         NEXT
  115.         IF imoved = 0 THEN
  116.             x(i) = x(i) + dx(i)
  117.             y(i) = y(i) + dy(i)
  118.         END IF
  119.         IF x(i) < -r(i) OR x(i) > xmax + r(i) THEN
  120.             x(i) = xmax / 2 + (i MOD 2) * 4 * r(i) - 2 * r(i)
  121.             y(i) = 0
  122.             dx(i) = 0
  123.             dy(i) = 3
  124.  
  125.                                 aaa(i) = rnd*0.2-0.1
  126.         END IF
  127.  
  128.         IF y(i) + r(i) > ymax THEN
  129.                 y(i) = ymax - r(i): dy(i) = -dy(i) * elastic '???: x(i) = x(i) + .1 * dx(i)
  130.  
  131.                                 aaa(i) = rnd*0.2-0.1
  132.                 end if
  133.  
  134.         FOR rad = r(i) TO 1 STEP -1
  135.             COLOR _RGB32(rr(i) - 3 * rad, gg(i) - 3 * rad, bb(i) - 3 * rad)
  136.             fcirc x(i), y(i), rad
  137.         NEXT
  138.                 textrot x(i), y(i), ltrim$(str$(i)), aa(i), aa(i)
  139.  
  140.     NEXT
  141.     _DISPLAY
  142.     _LIMIT 30
  143.  
  145.  
  146. sub textrot (x0 as integer, y0 as integer, s as string, a as double, b as double)
  147.  
  148.         dim img as long
  149.         img = _newimage(16,16,32)
  150.  
  151.         _dest img
  152.         line (0,0)-(16,16),_rgb(0,0,0),bf
  153.         color _rgb(255,255,255)
  154.         _printstring (0,0),left$(s$,2),img
  155.  
  156.         _source img
  157.         _dest 0
  158.         dim z as long
  159.         r = 0.5
  160.         for yy = -16/r to 16/r
  161.         for xx = -16/r to 16/r
  162.                 xxx=r*xx*cos(a)+r*yy*sin(a)+8
  163.                 yyy=r*yy*cos(a)-r*xx*sin(a)+8
  164.                 if xxx<15 and xxx>=0 then
  165.                 if yyy<15 and yyy>=0 then
  166.                 z = point(xxx,yyy)
  167.                 if z = _rgb(255,255,255) then
  168.                         pset (x0+xx,y0+yy),_rgb(0,0,0)
  169.                 end if
  170.                 end if
  171.                 end if
  172.         next
  173.         next
  174.  
  175.         _freeimage(img)
  176.  
  177.         _source 0
  179.  
  180. FUNCTION rand (lo, hi)
  181.     rand = (RND * (hi - lo + 1)) \ 1 + lo
  183.  
  184. FUNCTION rdir ()
  185.     IF RND < .5 THEN rdir = -1 ELSE rdir = 1
  187.  
  188. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
  189. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG)
  190.     DIM subRadius AS LONG, RadiusError AS LONG
  191.     DIM X AS LONG, Y AS LONG
  192.  
  193.     subRadius = ABS(R)
  194.     RadiusError = -subRadius
  195.     X = subRadius
  196.     Y = 0
  197.  
  198.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
  199.  
  200.     ' Draw the middle span here so we don't draw it twice in the main loop,
  201.     ' which would be a problem with blending turned on.
  202.     LINE (CX - X, CY)-(CX + X, CY), , BF
  203.  
  204.     WHILE X > Y
  205.         RadiusError = RadiusError + Y * 2 + 1
  206.         IF RadiusError >= 0 THEN
  207.             IF X <> Y + 1 THEN
  208.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), , BF
  209.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), , BF
  210.             END IF
  211.             X = X - 1
  212.             RadiusError = RadiusError - X * 2
  213.         END IF
  214.         Y = Y + 1
  215.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), , BF
  216.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), , BF
  217.     WEND
  219.  
  220. SUB snd (frq, dur)
  221.     'SOUND frq / 2.2, dur * .01
  223.  
Title: Re: Dropping Balls
Post by: FellippeHeitor on June 10, 2018, 08:28:22 pm
I'm stunned! That was awesome, Vince!
Title: Re: Dropping Balls
Post by: bplus on June 10, 2018, 08:36:39 pm
Hi [banned user],

The mirror effect helps explain what I first saw. I like silence too, and the song and unique sounds. Thanks for adding notes to code.


Hi V,

The hour glass is good start, ball containment seems first priority but some are being contained, I will look into what you are doing with that more closely.

The 2nd one with the numbers rotated on balls is cool and it would be really interesting if a constant but different spin were added to each ball as they move around. Nice one guys!

I have to confess, when I saw hour glass running I was thinking lottery and the ping pong balls WITH NUMBERS flying around! :D
Title: Re: Dropping Balls
Post by: FellippeHeitor on June 10, 2018, 08:40:24 pm
Quote from: bplus on June 10, 2018, 08:36:39 pm
I have to confess, when I saw hour glass running I was thinking lottery and the ping pong balls WITH NUMBERS flying around! :D

Exactly what I had in mind when I proposed it too!
Title: Re: Dropping Balls
Post by: bplus on June 10, 2018, 09:02:38 pm
Hey great minds think alike!  oops... ;D

Title: Re: Dropping Balls
Post by: Ashish on June 11, 2018, 08:16:29 am
@vince
That hourglass one simulation was good!
Title: Re: Dropping Balls
Post by: TempodiBasic on June 11, 2018, 09:34:16 am
Hy Guys
Hy Vincent

very very fine effect in your mod/demo... but it is outlaw! :-) for gravity law surely....
see image to get into issue....

Thank's to share code
Title: Re: Dropping Balls
Post by: bplus on June 11, 2018, 10:33:24 am
Yes, I found that problem developing in my run too, the problem with modifying over and over... I had that fixed (maybe I should say balanced) in original code by altering the drop point. It also has something to do with elastic = sticky variable the lower the elastic setting the higher the stickiness.
Title: Re: Dropping Balls
Post by: _vince on June 11, 2018, 01:27:02 pm
Quote from: TempodiBasic on June 11, 2018, 09:34:16 am
Hy Guys
Hy Vincent

very very fine effect in your mod/demo... but it is outlaw! :-) for gravity law surely....
see image to get into issue....

Thank's to share code

Entirely bplus's and xstatic's fault. I had no part in the physics simulation.
Title: Re: Dropping Balls
Post by: bplus on June 11, 2018, 02:26:35 pm
Quote from: v on June 11, 2018, 01:27:02 pm
Quote from: TempodiBasic on June 11, 2018, 09:34:16 am
Hy Guys
Hy Vincent

very very fine effect in your mod/demo... but it is outlaw! :-) for gravity law surely....
see image to get into issue....

Thank's to share code

Entirely bplus's and xstatic's fault. I had no part in the physics simulation.

V you have changed the code since I saw it (the problem is now exaggerated! probably due to big increase in Ball Radius), don't blame me for what you do with the code.

Append: I will say also (in your defense) that it is probably quite unexpected that a change in ball radius should effect "the physic's" but this code was modified from original dropping balls to try and get as perfect a pyramid formed and to do that "the physics" was already stretched beyond real world kind (if it was ever close to start).  Also by same logic, STxAxTIC should get 0 blame for what I did with his code.

Title: Re: Dropping Balls
Post by: _vince on June 11, 2018, 04:07:40 pm
I'm joking, bplus. Tempodibasic's riveting analysis warranted the response.
Title: Re: Dropping Balls
Post by: bplus on June 11, 2018, 04:23:18 pm
Quote from: v on June 11, 2018, 04:07:40 pm
I'm joking, bplus. Tempodibasic's riveting analysis warranted the response.

I was hoping that! but apparently I don't have much faith in my hopes.

Well I really like the numbers on the balls and would like to see them spin independently as they move and the hour glass thing might spin off to lottery thing. (pun intended)
Title: Re: Dropping Balls
Post by: _vince on June 13, 2018, 12:24:48 am
By the way, bplus, I may as well ask here. Since you make these screensaver/graphic demo type programs (as do I) in a variety of *BASICs (smallbasic, largebasic, purebasic, justbasic, etc), how do you feel about FreeBASIC?  It's pretty much the best for this sort of thing: makes small speedy exes, all the same graphics capability, cleaner syntax, and doesn't obscure advanced features, such as memory access, from the user. There's #lang "fblite" if you want it more QB-like, ie not forcing variable declaration. I suppose it doesn't have the same pull for the old DOS QB45 compatible nostalgia crowd and may not be as beginner friendly as the other BASICs but it is objectively the best.  I would certainly prefer it over QB64 for this type of thing, I wonder if you feel the same.
Title: Re: Dropping Balls
Post by: bplus on June 13, 2018, 09:23:44 am
Hi V,

I did try FB before QB64, quite a struggle to get started with it. Since I got into QB64, 50% of my FB no longer works. It is too confusing learning these 2 Basic's so similar and yet... I try running code off their forum and usually something goes wrong for me. Seems to me, QB64 has plenty of graphics devices for interesting screen stuff specially compared to what I had been using previous couple of years.

I started looking into your Hour Glass modification last night, looks like you are flipping between 2 screen pages which threw me (a technique I also found at FB instead of QB64 _DISPLAY which does the screen update in one go). But the one thing that really blew my mind was this:
Code: QB64: [Select]
  1.  
  2. SCREEN , , 1, 0 'hmm never used these before = active page 1, visual page 0
  3. LINE (0, 0)-(800, 600), _RGB(0, 0, 0), BF '>>>>>>>>>>>>>>>>>>>>> If I comment out just this one line
  4. a = 0
  5. xx = 150 * SIN(2 * a)
  6. yy = 300 * COS(a)
  7. PSET (xx + 400, yy + 300), _RGB(100, 100, 100)
  8. FOR a = 0 TO 2 * pi STEP 0.01
  9.     xx = 150 * SIN(2 * a)
  10.     yy = 300 * COS(a)
  11.     LINE -(xx + 400, yy + 300), _RGB(100, 100, 100)
  13.  
  14. PAINT (400, 150), _RGB(100, 100, 100)
  15. PAINT (400, 450), _RGB(100, 100, 100)
  16. LINE (380, 150)-(420, 450), _RGB(100, 100, 100), BF
  17.  
  18. PCOPY 1, 0  'new also to me
  19.  
  20.  
  21. balls = 0
  22. FOR yy = 50 TO 300 - 10 STEP 8
  23.     FOR xx = 10 TO 600 - 10 STEP 8
  24.         IF POINT(xx, yy) <> _RGB(0, 0, 0) THEN
  25.             balls = balls + 1
  26.             '  VVVVVVVVVVVVVVVVVVVVVV stuff here starts giving me errors, for ball array assignment???????
  27.             r(balls) = 3
  28.             x(balls) = xx
  29.             y(balls) = yy
  30.             c(balls) = 15
  31.             dx(balls) = rand(0, 3) * rdir
  32.             dy(balls) = 15
  33.  
  34.             rr(balls) = 255
  35.             gg(balls) = 255
  36.             bb(balls) = 0
  37.         END IF
  38.     NEXT
  40.  
  41. SCREEN , , 0, 0
  42.  
  43.  

How can a simple LINE statement that basically clears the screen be so vital to ball array assignments?

Also why do the balls immediately head to the right of the screen when not contained by the Hour glass figure? Their change in direction, dx (maybe called the x vector), should not be that uniform at all.

Title: Re: Dropping Balls
Post by: Petr on June 13, 2018, 02:51:10 pm
Quote
Hi V,

I did try FB before QB64, quite a struggle to get started with it. Since I got into QB64, 50% of my FB no longer works. It is too confusing learning these 2 Basic's so similar and yet... I try running code off their forum and usually something goes wrong for me. Seems to me, QB64 has plenty of graphics devices for interesting screen stuff specially compared to what I had been using previous couple of years.

I started looking into your Hour Glass modification last night, looks like you are flipping between 2 screen pages which threw me (a technique I also found at FB instead of QB64 _DISPLAY which does the screen update in one go). But the one thing that really blew my mind was this:
Code: [Select]

SCREEN , , 1, 0 'hmm never used these before = active page 1, visual page 0
LINE (0, 0)-(800, 600), _RGB(0, 0, 0), BF '>>>>>>>>>>>>>>>>>>>>> If I comment out just this one line
a = 0
xx = 150 * SIN(2 * a)
yy = 300 * COS(a)
PSET (xx + 400, yy + 300), _RGB(100, 100, 100)
FOR a = 0 TO 2 * pi STEP 0.01
    xx = 150 * SIN(2 * a)
    yy = 300 * COS(a)
    LINE -(xx + 400, yy + 300), _RGB(100, 100, 100)
NEXT

PAINT (400, 150), _RGB(100, 100, 100)
PAINT (400, 450), _RGB(100, 100, 100)
LINE (380, 150)-(420, 450), _RGB(100, 100, 100), BF

PCOPY 1, 0  'new also to me


balls = 0
FOR yy = 50 TO 300 - 10 STEP 8
    FOR xx = 10 TO 600 - 10 STEP 8
        IF POINT(xx, yy) <> _RGB(0, 0, 0) THEN
            balls = balls + 1
            '  VVVVVVVVVVVVVVVVVVVVVV stuff here starts giving me errors, for ball array assignment???????
            r(balls) = 3
            x(balls) = xx
            y(balls) = yy
            c(balls) = 15
            dx(balls) = rand(0, 3) * rdir
            dy(balls) = 15

            rr(balls) = 255
            gg(balls) = 255
            bb(balls) = 0
        END IF
    NEXT
NEXT

SCREEN , , 0, 0


How can a simple LINE statement that basically clears the screen be so vital to ball array assignments?

Also why do the balls immediately head to the right of the screen when not contained by the Hour glass figure? Their change in direction, dx (maybe called the x vector), should not be that uniform at all.



I was curious and tried it. And I got the hourglass body. Could you give me a link where this source comes from? Thanks

Code: QB64: [Select]
  1.  
  2. 'SCREEN , , 1, 0 'hmm never used these before = active page 1, visual page 0
  3.  
  4. one& = _NEWIMAGE(800, 600, 32)
  5. _DEST one&
  6.  
  7. LINE (0, 0)-(800, 600), _RGB(0, 0, 0), BF '>>>>>>>>>>>>>>>>>>>>> If I comment out just this one line
  8. a = 0
  9. xx = 150 * SIN(2 * a)
  10. yy = 300 * COS(a)
  11. PSET (xx + 400, yy + 300), _RGB(100, 100, 100)
  12. FOR a = 0 TO 2 * _PI STEP 0.01
  13.     xx = 150 * SIN(2 * a)
  14.     yy = 300 * COS(a)
  15.     LINE -(xx + 400, yy + 300), _RGB(100, 100, 100)
  17.  
  18. PAINT (400, 150), _RGB(100, 100, 100)
  19. PAINT (400, 450), _RGB(100, 100, 100)
  20. LINE (380, 150)-(420, 450), _RGB(100, 100, 100), BF
  21.  
  22. PCOPY 1, 0 'standard Qbasic statement - copy videomemory source, dest
  23.  
  24.  
  25. 'balls = 0
  26. TYPE balls
  27.     r AS INTEGER
  28.     x AS INTEGER
  29.     y AS INTEGER
  30.     c AS LONG
  31.     dx AS INTEGER
  32.     dy AS INTEGER
  33.     rr AS _UNSIGNED _BYTE
  34.     gg AS _UNSIGNED _BYTE
  35.     bb AS _UNSIGNED _BYTE
  37. REDIM balls(0) AS balls
  38.  
  39.  
  40. FOR yy = 50 TO 300 - 10 STEP 8
  41.     FOR xx = 10 TO 600 - 10 STEP 8
  42.         _SOURCE one&
  43.         IF POINT(xx, yy) <> _RGB(0, 0, 0) THEN
  44.             balls = balls + 1
  45.             REDIM _PRESERVE balls(balls) AS balls
  46.             '  VVVVVVVVVVVVVVVVVVVVVV stuff here starts giving me errors, for ball array assignment???????
  47.             balls(balls).r = 3
  48.             balls(balls).x = xx
  49.             balls(balls).y = yy
  50.             balls(balls).c = 15
  51.             balls(balls).dx = RND * 3 * rdir 'this i know not. What is it rdir?
  52.             balls(balls).dy = 15
  53.  
  54.             balls(balls).rr = 255
  55.             balls(balls).gg = 255
  56.             balls(balls).bb = 0
  57.         END IF
  58.     NEXT
  60.  
  61. 'SCREEN , , 0, 0
  62. SCREEN one&
  63.  

I have never seen Free Basic.
Title: Re: Dropping Balls
Post by: bplus on June 13, 2018, 03:58:42 pm
Quote
I was curious and tried it. And I got the hourglass body. Could you give me a link where this source comes from? Thanks

Reply #12 of this thread is Vince mod of Dropping Balls with the Hour Glass figure.

Title: Re: Dropping Balls
Post by: Petr on June 13, 2018, 05:22:26 pm
Aha! Good work. Thank for reply.
Title: Re: Dropping Balls
Post by: _vince on June 13, 2018, 07:26:20 pm
Quote from: bplus on June 13, 2018, 09:23:44 am
How can a simple LINE statement that basically clears the screen be so vital to ball array assignments?

The double for loop traverses the entire screen and only creates a ball if it's inside the hourglass by reading the colour of the screen.  I've used screen ,,1,0 for storing the hourglass image and drawing it on the main screen with pcopy 1,0, not for double buffering or screen syncing.  The same could be done with _source,_dest,_newimage, and _putimage.
Title: Re: Dropping Balls
Post by: bplus on June 14, 2018, 09:16:18 am
Thanks, have that figured out and can contain the balls inside hourglass but balls are disappearing at bottom so maybe a leak. I can do the thing without color detection by using two boundary arrays but getting build at bottom has been very frustrating .
Title: Re: Dropping Balls
Post by: bplus on March 04, 2020, 10:33:20 pm
The Hourglass challenge was finally solved here:
https://www.qb64.org/forum/index.php?topic=1035.msg102243#msg102243

and put to practical use as a minute timer (more or less).
https://www.qb64.org/forum/index.php?topic=1035.msg102358#msg102358

I am bumping to work with Qwerkey in regards to this:
Quote
@bplus, I'd like to add your Dropping Balls program https://www.qb64.org/forum/index.php?topic=194.0 to Samples Gallery (2D/3D Graphics without SUB _GL).  It has very good graphics and the whole post is a good demonstration of collaborative work between various members.  There is quite a bit of amazing stuff in that post.  I want to use the code of « Reply #4 on: April 03, 2018, 05:39:05 PM » in Samples.  That code could do with a bit of tidying up (and perhaps a few more explanatory comments).  Would you be able to do that before I add to Samples?  Thanks, Qwerkey
Title: Re: Dropping Balls
Post by: bplus on March 05, 2020, 01:28:20 am
@Qwerkey New and I think improved :)

Code: QB64: [Select]
  1. _TITLE "Dropping Balls: Pile Attempt #3" ' bplus started 2018-04-03"
  2. ' Attempt to build a pile by adjusting drop rate, elasticity, and gravity.
  3. ' Built from Dropping balls 4 w snd and STATIC created 2018-04-3
  4. ' Add STATIC's ball moving before figuring any bounce from collision
  5. ' which was a mod in Dropping Balls 2 w sound posted 2018-03-31.
  6. ' 2020-03-04 Pile Attempt #3 revive and tidy up
  7.  
  9. CONST xmax = 750, ymax = 720, elastic = .8, gravity = .75, balls = 400, br = 15
  10. SCREEN _NEWIMAGE(xmax, ymax, 32)
  11. _SCREENMOVE 360, 20
  12. DIM x(balls), y(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)
  13. FOR i = 1 TO balls 'initialize balls to drop
  14.     x(i) = xmax / 2 + (i MOD 2) * 8 - 4: y(i) = 0 '                                     location
  15.     dx(i) = 0: dy(i) = 3 '                                                        change on axis
  16.     rr(i) = 150 + RND * 100: gg(i) = 150 + RND * 100: bb(i) = 150 + RND * 100 '        rgb color
  19.     CLS
  20.     loopCnt = loopCnt + 1 '                   drop ball every 17 loops so previous ball is clear
  21.     IF loopCnt MOD 17 = 0 THEN
  22.         IF maxBall < balls THEN maxBall = maxBall + 1
  23.     END IF
  24.     _PRINTSTRING (100, 10), "Balls:" + STR$(maxBall)
  25.     FOR i = 1 TO maxBall
  26.         'ready for collision
  27.         dy(i) = dy(i) + gravity '                               gravity increase update on y axis
  28.         a(i) = _ATAN2(dy(i), dx(i)) '                                       angle ball is heading
  29.         imoved = 0
  30.         FOR j = i + 1 TO maxBall
  31.             '      The following is STxAxTIC's adjustment of ball positions if overlapping before
  32.             ' calculation of new positions from collision. Displacement vector and its magnitude:
  33.             nx = x(j) - x(i): ny = y(j) - y(i)
  34.             nm = SQR(nx ^ 2 + ny ^ 2)
  35.             IF nm < 1 + 2 * br THEN
  36.                 nx = nx / nm: ny = ny / nm
  37.                 ' Regardless of momentum exchange, separate balls along the line connecting them.
  38.                 DO WHILE nm < 1 + 2 * br
  39.                     flub = .001
  40.                     x(j) = x(j) + flub * nx: y(j) = y(j) + flub * ny
  41.                     x(i) = x(i) - flub * nx: y(i) = y(i) - flub * ny
  42.                     nx = x(j) - x(i): ny = y(j) - y(i)
  43.                     nm = SQR(nx ^ 2 + ny ^ 2)
  44.                     nx = nx / nm: ny = ny / nm
  45.                 LOOP
  46.                 imoved = 1
  47.                 a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))
  48.                 a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))
  49.                 power1 = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5 '       update new dx, dy for i and j balls
  50.                 power2 = (dx(j) ^ 2 + dy(j) ^ 2) ^ .5
  51.                 power = elastic * (power1 + power2) / 2
  52.                 dx(i) = power * COS(a(i)): dy(i) = power * SIN(a(i))
  53.                 dx(j) = power * COS(a(j)): dy(j) = power * SIN(a(j))
  54.                 x(i) = x(i) + dx(i): y(i) = y(i) + dy(i)
  55.                 x(j) = x(j) + dx(j): y(j) = y(j) + dy(j)
  56.             END IF '                                                              Thanks STxAxTIC
  57.         NEXT
  58.         IF imoved = 0 THEN x(i) = x(i) + dx(i): y(i) = y(i) + dy(i)
  59.         IF x(i) - br < 0 OR x(i) + br > xmax THEN '       keep balls inside sides and bottom edge
  60.             dx(i) = -dx(i)
  61.             IF x(i) - br < 0 THEN x(i) = br
  62.             IF x(i) + br > xmax THEN x(i) = xmax - br
  63.         END IF
  64.         IF y(i) + br > ymax THEN y(i) = ymax - br: dy(i) = -dy(i) * elastic
  65.         FOR rad = br TO 1 STEP -1 '                                         finally draw the ball
  66.             fcirc x(i), y(i), rad, _RGB32(rr(i) - 10 * rad, gg(i) - 10 * rad, bb(i) - 10 * rad)
  67.         NEXT
  68.     NEXT
  69.     _DISPLAY
  70.     _LIMIT 20
  72.  
  73. SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG, C AS _UNSIGNED LONG) '       SMcNeill's fill circle
  74.     DIM subRadius AS LONG, RadiusError AS LONG, X AS LONG, Y AS LONG
  75.     subRadius = ABS(R): RadiusError = -subRadius: X = subRadius: Y = 0
  76.     IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
  77.     LINE (CX - X, CY)-(CX + X, CY), C, BF
  78.     WHILE X > Y
  79.         RadiusError = RadiusError + Y * 2 + 1
  80.         IF RadiusError >= 0 THEN
  81.             IF X <> Y + 1 THEN
  82.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
  83.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
  84.             END IF
  85.             X = X - 1
  86.             RadiusError = RadiusError - X * 2
  87.         END IF
  88.         Y = Y + 1
  89.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
  90.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
  91.     WEND
  93.  

 

 
Title: Re: Dropping Balls
Post by: Qwerkey on March 05, 2020, 05:12:34 am
Now added to Samples.
Title: Re: Dropping Balls
Post by: _vince on March 05, 2020, 10:22:38 am
please fix bplus's name!
Title: Re: Dropping Balls
Post by: bplus on March 05, 2020, 11:24:46 am
Quote from: _vince on March 05, 2020, 10:22:38 am
please fix bplus's name!

Thanks _vince

@Qwerkey along with fixing names in Samples, I reworded a little as to how I remembered the experience.
Title: Re: Dropping Balls
Post by: Qwerkey on March 05, 2020, 12:16:27 pm
@bplus Thanks for fixing the text, but did you remove the @Author Name format in the Author ID line?  Fellippe wanted to change to this format.
Title: Re: Dropping Balls
Post by: bplus on March 05, 2020, 12:22:30 pm
Quote from: Qwerkey on March 05, 2020, 12:16:27 pm
@bplus Thanks for fixing the text, but did you remove the @Author Name format in the Author ID line?  Fellippe wanted to change to this format.

OK added @ but it does not make sense to me in a thread we can't reply in.

So what is the reasoning for @ here?
Title: Re: Dropping Balls
Post by: FellippeHeitor on March 05, 2020, 12:52:15 pm
Easy link to author's profile.
Title: Re: Dropping Balls
Post by: bplus on March 06, 2020, 10:38:36 am
OK now I see how it's working, good :)

@FellippeHeitor
Update: Dang! It did not notify me for Librarian's "Circle Intersect Line" post :(
It does seem to be working in Samples Child Boards.
Text Only | Text with Attachments