### Author Topic: Dropping Balls by bplus  (Read 4988 times)

0 Members and 1 Guest are viewing this topic.

#### Qwerkey

• Forum Resident
• Posts: 755
##### Dropping Balls by bplus
« on: March 05, 2020, 05:10:08 am »
Dropping Balls

Author: @bplus
Source: qb64.org Forum
URL: https://www.qb64.org/forum/index.php?topic=194.0
Version: 2020
Tags: [gravity], [spherical collisions]

Description:
Dropping Balls an attempt to build a pile by adjusting drop rate, elasticity, and gravity.
Bplus used tools from SMcNeill for fill circle and STxAxTIC for non-overlapping balls.

This thread is a fun continuation of ball collision experiments from a number of members including: @_vince who offered an hourglass challenge, @[banned user], @SMcNeill, @STxAxTIC, creating a collection of interesting variations. The code given here is just one program from a variety produced.  Look through the whole of the designated thread, it continues into Hourglass thread linked near end of URL above.

Source Code:
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.     CONST xmax = 750, ymax = 720, elastic = .8, gravity = .75, balls = 400, br = 15
9.     SCREEN _NEWIMAGE(xmax, ymax, 32)
10.     _SCREENMOVE 360, 20
11.     DIM x(balls), y(balls), dx(balls), dy(balls), a(balls), rr(balls), gg(balls), bb(balls)
12.     FOR i = 1 TO balls 'initialize balls to drop
13.         x(i) = xmax / 2 + (i MOD 2) * 8 - 4: y(i) = 0 '                                     location
14.         dx(i) = 0: dy(i) = 3 '                                                        change on axis
15.         rr(i) = 150 + RND * 100: gg(i) = 150 + RND * 100: bb(i) = 150 + RND * 100 '        rgb color
16.         loopCnt = loopCnt + 1 '                   drop ball every 17 loops so previous ball is clear
17.         IF loopCnt MOD 17 = 0 THEN
18.             IF maxBall < balls THEN maxBall = maxBall + 1
19.         _PRINTSTRING (100, 10), "Balls:" + STR\$(maxBall)
20.         FOR i = 1 TO maxBall
22.             dy(i) = dy(i) + gravity '                               gravity increase update on y axis
23.             a(i) = _ATAN2(dy(i), dx(i)) '                                       angle ball is heading
24.             imoved = 0
25.             FOR j = i + 1 TO maxBall
26.                 '      The following is STxAxTIC's adjustment of ball positions if overlapping before
27.                 ' calculation of new positions from collision. Displacement vector and its magnitude:
28.                 nx = x(j) - x(i): ny = y(j) - y(i)
29.                 nm = SQR(nx ^ 2 + ny ^ 2)
30.                 IF nm < 1 + 2 * br THEN
31.                     nx = nx / nm: ny = ny / nm
32.                     ' Regardless of momentum exchange, separate balls along the line connecting them.
33.                     DO WHILE nm < 1 + 2 * br
34.                         flub = .001
35.                         x(j) = x(j) + flub * nx: y(j) = y(j) + flub * ny
36.                         x(i) = x(i) - flub * nx: y(i) = y(i) - flub * ny
37.                         nx = x(j) - x(i): ny = y(j) - y(i)
38.                         nm = SQR(nx ^ 2 + ny ^ 2)
39.                         nx = nx / nm: ny = ny / nm
40.                     imoved = 1
41.                     a(i) = _ATAN2(y(i) - y(j), x(i) - x(j))
42.                     a(j) = _ATAN2(y(j) - y(i), x(j) - x(i))
43.                     power1 = (dx(i) ^ 2 + dy(i) ^ 2) ^ .5 '       update new dx, dy for i and j balls
44.                     power2 = (dx(j) ^ 2 + dy(j) ^ 2) ^ .5
45.                     power = elastic * (power1 + power2) / 2
46.                     dx(i) = power * COS(a(i)): dy(i) = power * SIN(a(i))
47.                     dx(j) = power * COS(a(j)): dy(j) = power * SIN(a(j))
48.                     x(i) = x(i) + dx(i): y(i) = y(i) + dy(i)
49.                     x(j) = x(j) + dx(j): y(j) = y(j) + dy(j)
50.                 END IF '                                                              Thanks STxAxTIC
51.             IF imoved = 0 THEN x(i) = x(i) + dx(i): y(i) = y(i) + dy(i)
52.             IF x(i) - br < 0 OR x(i) + br > xmax THEN '       keep balls inside sides and bottom edge
53.                 dx(i) = -dx(i)
54.                 IF x(i) - br < 0 THEN x(i) = br
55.                 IF x(i) + br > xmax THEN x(i) = xmax - br
56.             IF y(i) + br > ymax THEN y(i) = ymax - br: dy(i) = -dy(i) * elastic
57.             FOR rad = br TO 1 STEP -1 '                                         finally draw the ball
59.         _LIMIT 20
60.
61.     SUB fcirc (CX AS LONG, CY AS LONG, R AS LONG, C AS _UNSIGNED LONG) '       SMcNeill's fill circle
62.         DIM subRadius AS LONG, RadiusError AS LONG, X AS LONG, Y AS LONG
64.         IF subRadius = 0 THEN PSET (CX, CY): EXIT SUB
65.         LINE (CX - X, CY)-(CX + X, CY), C, BF
66.         WHILE X > Y