Dropping Balls

[bplus]

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:

@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

[bplus]

@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.  
8. RANDOMIZE TIMER
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
17. NEXT
18. WHILE 1
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
71. WEND
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
92. END SUB
93.  

 

 

[Qwerkey]

Now added to Samples.

[_vince]

please fix bplus's name!

[bplus]

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.

[Qwerkey]

@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.

[bplus]

@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?

[FellippeHeitor]

Easy link to author's profile.

[bplus]

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.