2D ball collisions without trigonometry.

[OldMoses]

For a head on, elastic collision between two moving balls of equal mass and material, I think that trading vector magnitudes in rebound would be appropriate. In lieu of a more complete knowledge of the subject, on my part.

That said, it would be rather rare for two independent balls to be moving on direct, inverted vectors. They're typically going to be striking at different vectors, or be on inverted vectors that are slightly (or grossly) offset. The angle between their travel vector and the line between the ball centers at the point of collision (I'll call it the strike vector) would govern how each shears away from the other.

Most treatises I've seen on the subject give a shear angle that is perpendicular (orthogonal) to the strike vector, although most of those are assuming a stationary target ball, as per the graphic I posted earlier. There are two orthogonals to the strike vector, and one has to control which is used in order for a ball to not deflect to the "inside", which looks rather weird. I reasoned that one would chose the shear orthogonal that would be closest to a projected point of the striking balls original incoming vector. There may be a simpler method that I'm missing.

After that it gets interesting. I normalized the strike vector and the striking balls incoming vector and apply dot product to those to figure out how much force is transferred to the struck ball, while 1 - dot product result would be retained by the striking ball on its new course. That seemed to yield a satisfying look to my eye, but my application had issues with balls blowing through each other and trading places or getting stuck on one another when in tight groups or high relative speeds. I assume they were moving beyond the collision test before it even had a chance to implement. Oh well, back to the drawing board...

[bplus]

Speaking of Dot Product, I call foul! the paper said no Trig but look at how Dot Product is calc'd with COS!
https://www.mathsisfun.com/algebra/vectors-dot-product.html

[OldMoses]

The easy method of dot product calculation is:

a · b = ax × bx + ay × by

I typically assign a function to it.

Code: QB64: [Select]

1. FUNCTION VecDot (var AS V2, var2 AS V2)
2.     VecDot = var.x * var2.x + var.y * var2.y
3. END FUNCTION 'VecDot
4.  

I have to assume it's much faster than COS in the CPU

[bplus]

Trying to understand the 7 steps and Dot Product is hanging me up.

From Stx notes on vector math here is Dot Product without need of COS(angle between vectors)

Code: QB64: [Select]

1. Function v2DotProduct (A As xyType, B As xyType) 'shadow or projection  if A Dot B = 0 then A , B are perpendicular
2.     v2DotProduct = A.x * B.x + A.y * B.y
3. End Function
4.  

ha I was just going to post this.

[NOVARSEG]

 Working with vector addition using the parallelogram method (what I call the mvector) There are times when this works OK and other times when it don't.  Sometimes the mvector is 0, 0  which is valid for 180 degree collisions with a strike angle of zero but any attempt to rotate 0,  0 to a required vector results in loss of final direction of one of the balls.

Mvector is strange. Sometimes it has no direction or magnitude (0, 0 ) at other times it acts like a real vector.  At other times it points in both directions (or should).

From a code example :  say mvector is  0X,   113.137 Y.  That works fine for the red ball but the cyan ball expects
 0X,   -113.137 Y..     It is possible that mvector can point in opposite directions. I'm not sure if that fits the definitions of a vector.

[johnno56]

I am pretty sure I said no desire for coffee, coffee still exists at least until it gets cyber attacked.

Almost as bad... No 'desire' for coffee... You should have your mouth washed out with soap... Blasphemy! LOL

[OldMoses]

Working with vector addition using the parallelogram method (what I call the mvector) There are times when this works OK and other times when it don't.  Sometimes the mvector is 0, 0  which is valid for 180 degree collisions with a strike angle of zero but any attempt to rotate 0,  0 to a required vector results in loss of final direction of one of the balls.

Mvector is strange. Sometimes it has no direction or magnitude (0, 0 ) at other times it acts like a real vector.  At other times it points in both directions (or should).

From a code example :  say mvector is  0X,   113.137 Y.  That works fine for the red ball but the cyan ball expects
 0X,   -113.137 Y..     It is possible that mvector can point in opposite directions. I'm not sure if that fits the definitions of a vector.

It sounds like your "Mvector" is just like the strike orthogonals that I mention above, which indeed would go in two different directions. One ball would take one "Mvector" and the other ball would take the other. The important part is controlling which takes which. After determining the magnitude of each Mvector, you would then do the vector addition of the balls respective incoming vector and their separate Mvectors. That would conserve some of their original momentum. If the balls were striking head on, then the Dot product calculation would reflect that fact by resulting in an Mvector magnitude of 0, and should result in a swapping of velocities for the balls as Bplus proved earlier. The result would work whether one ball, or both were moving. Isn't math fun....

[bplus]

Isn't math fun....

It is a total b... until you learn the jargon. I am pretty comfortable with Trig but find physics vectors difficult because I haven't practiced with 100's of exercises in it's terminology. The challenge with Trig and Physics is that Basic uses an upside down Quadrant 1 only graphics system which is not how you learned it in math at school. That, I learned is an artifact of printing with print lines always positive and increasing as you go down the screen a rows and cols system for chars. QB64's Locate row, col is a good example.

I have to say it is fun when it starts producing results for you in computer applications, it's like magic. They say knowledge is power and when math works it is a power alright!

Coffee helps with the practicing ;-)) Maybe something stronger when you've had enough abstract jargon for the day.

2 Ball Collision is really good challenge for any style math.

[OldMoses]

Yeah, the quadrant issue is such a bear that I generally resort to WINDOW to redefine my coordinate system. Then when I do use trig, I have to remain cognizant of the reversals of various SIN/COS/TAN functions with respect to my redefined system.

The only reason that I've been able to fool with vector math is Stx's tutorials, and many hours watching Professor Leonard's calculus videos on Youtube.

I'm toying with doing a little program to demo a Cross product function in action.

[bplus]

https://www.vobarian.com/collisions/2dcollisions2.pdf

but my application had issues with balls blowing through each other and trading places or getting stuck on one another when in tight groups or high relative speeds.

Last night I coded the whole paper step by step. The code passes the head on test but I am getting balls sticking together also. I will recheck code today and show. Meanwhile I did get a JB by tsh73 port using vectors working fine and much simpler than paper. I will show that one later too. I want to set up 2 more special cases other than Head on ones where 2 balls travel nearly parallel but converging paths and see their bump and reflection then with 2 balls at 90 degree collision and se that reflection.

[bplus]

OK here is first vector code I got working for 2 or more ball collisions by barrowing from tsh73 at JB forum. He was working study for an app for pin ball and one ball was always moving and the other was stationary circle, so I adapted to 2 moving balls and may have oversimplified. Anyway it can handle 20 balls no sticking:

All the special case experiments work fine with expected results.

Code: QB64: [Select]

1. Option _Explicit
2. _Title "tsh73 from JB: 2 Ball Collision with Vectors,  r will restart a test" 'B+ 2021-05-13
3. ' This is tsh73 code for collision though he was doing stationary and moving, I made mod for both moving.
4. ' The vector functions are modifications of tsh73 JB code converted to QB64 by me.
5. ' earlier code 2 Ball Collision with Vectors by Arrow Addition ' B+ 2021-05-10
6. ' 2021-05-10  fixed arrow so points from base x,y To angle
7. ' from Collision Study #4   press spacebar to toggle tracer" ' b+ 2021-05-09 by bplus
8.  
9. ' !!!!!!!!!!!!!!!! Adjust Ball according to experiment (just after restart: line label) 2 is always good!
10.  
11. 'Const Balls = 2 '<<<<<<<<< change this to 2 to test special case setups: head on, parallel and perpendicular
12. Const Balls = 6 '<<<<<<<<<  no more than 20! because have to start all balls not overlapping any other
13.  
14.  
15. Const Xmax = 600 ' screen width
16. Const Ymax = 600 ' screen height
17. Const R = 50 '     balls radii
18. Const R22 = R * R * 4 ' save some time with (2 * R) * (2 * R)
19.  
20. Const MV_Speed = 45 ' magnitude of Force Arrow say it's constant for simplicity sake
21. Type Ball
22.     As Long x, y
23.     As Double dx, dy, a ' dx, dy = change x, y axis
24.     As _Unsigned Long colr
25. End Type
26.  
27. Randomize Timer
28. Screen _NewImage(Xmax, Ymax, 32)
29. _Delay .25
30. _ScreenMove _Middle
31. ' these can be static as no balls added or subtracted in closed system
32. Dim As Ball b(1 To Balls), nf(1 To Balls) ' b() is current frame balls data , nf( ) is for next frame balls data
33. Dim As Long clrMode, i, j, rdm
34. b(1).colr = &HFFFF0000 'red ball 1 is red
35. b(2).colr = &HFF0000FF 'blue ball 2 is blue
36. clrMode = 1
37. Dim v1$, v2$, dv1$, dv2$, dv1u$, dv2u$, norm$ 'vectors
38.  
39. restart:
40. 'horizontal collisions  Head On
41. 'b(1).dx = 5
42. 'b(1).dy = 0 ' b1 is just moving on x axis to the right at 5 pixels per frame
43. 'b(2).dx = -5
44. 'b(2).dy = 0 ' b2 is just moving on x axis to the left at 5 pixels per frame
45. 'b(1).x = 300 - 5 * b(1).dx - R ' in 5 frames b1 will meet b2  kiss at center of screen
46. 'b(1).y = 300
47. 'b(2).x = 300 - 5 * b(2).dx + R ' in 5 frames b1 will meet b2  kiss at center of screen
48. 'b(2).y = 300
49.  
50. 'vertical collisions  Head On
51. 'b(1).dy = 5
52. 'b(1).dx = 0 ' b1 is just moving on x axis to the right at 5 pixels per frame
53. 'b(2).dy = -5
54. 'b(2).dx = 0 ' b2 is just moving on x axis to the left at 5 pixels per frame
55. 'b(1).y = 300 - 5 * b(1).dy - R ' in 5 frames b1 will meet b2  kiss at center of screen
56. 'b(1).x = 300
57. 'b(2).y = 300 - 5 * b(2).dy + R ' in 5 frames b1 will meet b2  kiss at center of screen
58. 'b(2).x = 300
59.  
60. ' 45 & 135 collsions   Head On
61. 'b(1).dy = 5
62. 'b(1).dx = 5 ' b1 is just moving on x axis to the right at 5 pixels per frame
63. 'b(2).dy = -5
64. 'b(2).dx = -5 ' b2 is just moving on x axis to the left at 5 pixels per frame
65. 'b(1).y = 300 - 5 * b(1).dy - R ' in 5 frames b1 will meet b2  kiss at center of screen
66. 'b(1).x = 300 - 5 * b(1).dx - R
67. 'b(2).y = 300 - 5 * b(2).dy + R ' in 5 frames b1 will meet b2  kiss at center of screen
68. 'b(2).x = 300 - 5 * b(2).dx + R
69.  
70. ' Parallel and converging paths
71. 'b(1).dy = -6
72. 'b(1).dx = 1 ' b1 is just moving on x axis to the right at 5 pixels per frame
73. 'b(2).dy = -6
74. 'b(2).dx = -1 ' b2 is just moving on x axis to the left at 5 pixels per frame
75. 'b(1).y = Ymax - R ' in 5 frames b1 will meet b2  kiss at center of screen
76. 'b(1).x = 300 - 20 * b(1).dx - R
77. 'b(2).y = Ymax - R ' in 5 frames b1 will meet b2  kiss at center of screen
78. 'b(2).x = 300 - 20 * b(2).dx + R
79.  
80. ' Perpendicular and 90 degree collision   should be just before mid screen
81. 'b(1).dy = 0
82. 'b(1).dx = 5
83. 'b(2).dy = -5
84. 'b(2).dx = 0
85. 'b(1).y = 300
86. 'b(1).x = R
87. 'b(2).y = Ymax - R
88. 'b(2).x = 300
89.  
90. ' Random assignments    (comment this block for special case 2 ball experiments  and set balls to 2 !)  ==============
91. For i = 1 To Balls
92.     tryAgain:
93.     Print i
94.     b(i).x = rand&(R, Xmax - R)
95.     b(i).y = rand&(R, Ymax - R)
96.     For j = 1 To i - 1
97.         If _Hypot(b(i).x - b(j).x, b(i).y - b(j).y) < R + R Then GoTo tryAgain
98.     Next
99.     b(i).dx = (Rnd * 4 + 1) * rdir
100.     b(i).dy = (Rnd * 4 + 1) * rdir
101.     rdm = rand&(1, 7)
102.     If rdm < 1 Or rdm > 7 Then Beep
103.     Select Case rdm
104.         Case 1: b(i).colr = _RGB32(Rnd * 200 + 55, 0, 0)
105.         Case 2: b(i).colr = _RGB32(0, Rnd * 100 + 55, 0)
106.         Case 3: b(i).colr = _RGB32(0, 0, Rnd * 200 + 55)
107.         Case 4: b(i).colr = &HFFFF6600
108.         Case 5: b(i).colr = &HFFFF0088
109.         Case 6: b(i).colr = &HFF00FF88
110.         Case 7: b(i).colr = _RGB32(Rnd * 200 + 55, Rnd * 200 + 55, Rnd * 200 + 55)
111.     End Select
112. Next
113. '====================================================================================================================
114.  
115. While _KeyDown(27) = 0
116.     Dim k$
117.     k$ = InKey$
118.     If Len(k$) Then
119.         If Asc(k$) = 32 Then clrMode = -1 * clrMode
120.         If Asc(k$) = 27 And Len(k$) = 1 Then End
121.         If k$ = "r" Then GoTo restart
122.     End If
123.     If clrMode > 0 Then Cls
124.     Circle (300, 300), 2
125.     For i = 1 To Balls ' draw balls then  update for next frame
126.  
127.         ' this just draw the balls with arrows pointing to their headings
128.         Circle (b(i).x, b(i).y), R, b(i).colr
129.         b(i).a = _Atan2(b(i).dy, b(i).dx)
130.         ArrowTo b(i).x, b(i).y, b(i).a, MV_Speed, &HFFFFFF00
131.         ' debug
132.         '_PrintString (b(i).x - 8, b(i).y - 8), _Trim$(Right$("00" + Str$(i), 2)) 'all the balls weren't getting colored
133.  
134.         ' check for collision
135.         Dim cd, saveJ
136.         cd = 100000: saveJ = 0
137.         For j = 1 To Balls 'find deepest collision in case more than one we want earliest = deepest penetration
138.             If i <> j Then
139.                 Dim dx, dy
140.                 dx = b(i).x - b(j).x: dy = b(i).y - b(j).y
141.                 If dx * dx + dy * dy <= R22 Then ' collision but is it first or deepest collision
142.                     If R22 - dx * dx + dy * dy < cd Then cd = R22 - dx * dx + dy * dy: saveJ = j
143.                 End If
144.             End If
145.         Next
146.         If cd <> 100000 Then ' found collision change ball i dx, dy   calc new course for ball i
147.  
148.             ''reflection  from circle  using Vectors  from JB, thanks tsh73
149.             v1$ = vect$(b(i).x, b(i).y) ' circle i
150.             v2$ = vect$(b(saveJ).x, b(saveJ).y) ' the other circle j
151.             dv1$ = vect$(b(i).dx, b(i).dy) ' change in velocity vector
152.             dv2$ = vect$(b(saveJ).dx, b(saveJ).dy)
153.             dv1u$ = vectUnit$(dv1$) '1 pixel
154.             dv2u$ = vectUnit$(dv2$)
155.             'Print dv$, cv$, dv0$   ' check on things
156.             '_Display
157.             'Sleep
158.             Do ' this should back up the balls to kiss point thanks tsh73
159.                 v1$ = vectSub$(v1$, dv1u$)
160.                 v2$ = vectSub(v2$, dv2u$)
161.             Loop While vectLen(vectSub$(v1$, v2$)) < R + R 'back up our circle i to point on kiss
162.             ''now, get reflection
163.             ''radius to radius, norm is
164.             norm$ = vectSub$(v1$, v2$)
165.             dv1$ = vectSub$(vectNorm$(dv1$, norm$), vectTangent$(dv1$, norm$)) 'to this
166.  
167.             ' store in next frame array
168.             nf(i).dx = vectX(dv1$)
169.             nf(i).dy = vectY(dv1$)
170.  
171.         Else ' no collision
172.             nf(i).dx = b(i).dx
173.             nf(i).dy = b(i).dy
174.         End If
175.         'update location of ball next frame
176.         nf(i).x = b(i).x + nf(i).dx
177.         nf(i).y = b(i).y + nf(i).dy
178.  
179.         ' check in bounds next frame
180.         If nf(i).x < R Then nf(i).dx = -nf(i).dx: nf(i).x = R
181.         If nf(i).x > Xmax - R Then nf(i).dx = -nf(i).dx: nf(i).x = Xmax - R
182.         If nf(i).y < R Then nf(i).dy = -nf(i).dy: nf(i).y = R
183.         If nf(i).y > Ymax - R Then nf(i).dy = -nf(i).dy: nf(i).y = Ymax - R
184.     Next
185.  
186.     ''now that we've gone through all old locations update b() with nf() data
187.     For i = 1 To Balls
188.         b(i).x = nf(i).x: b(i).y = nf(i).y
189.         b(i).dx = nf(i).dx: b(i).dy = nf(i).dy
190.     Next
191.     ' next frame ready to draw
192.     _Display
193.     _Limit 30
194. Wend
195. 'Cls   ' debug why aren't all the balls getting colored
196. 'For i = 1 To Balls
197. '    Print i, b(i).colr
198. 'Next
199.  
200. Function rand& (lo As Long, hi As Long) ' fixed?
201.     rand& = Int(Rnd * (hi - lo) + 1) + lo
202. End Function
203.  
204. Function rdir ()
205.     If Rnd < .5 Then rdir = -1 Else rdir = 1
206. End Function
207.  
208. Sub ArrowTo (BaseX As Long, BaseY As Long, rAngle As Double, lngth As Long, colr As _Unsigned Long)
209.     Dim As Long x1, y1, x2, y2, x3, y3
210.     x1 = BaseX + lngth * Cos(rAngle)
211.     y1 = BaseY + lngth * Sin(rAngle)
212.     x2 = BaseX + .8 * lngth * Cos(rAngle - _Pi(.05))
213.     y2 = BaseY + .8 * lngth * Sin(rAngle - _Pi(.05))
214.     x3 = BaseX + .8 * lngth * Cos(rAngle + _Pi(.05))
215.     y3 = BaseY + .8 * lngth * Sin(rAngle + _Pi(.05))
216.     Line (BaseX, BaseY)-(x1, y1), colr
217.     Line (x1, y1)-(x2, y2), colr
218.     Line (x1, y1)-(x3, y3), colr
219. End Sub
220.  
221. ' convert some vector functions from JB, turns out much easier to use string functions to pass vectors
222. ' than using SUBs to do vector calcs
223.  
224. Function vect$ (x, y) ' convert x, y to string for passing vectors with Functions
225.     vect$ = _Trim$(Str$(x)) + "," + _Trim$(Str$(y))
226. End Function
227.  
228. Function vectX (v$)
229.     vectX = Val(LeftOf$(v$, ","))
230. End Function
231.  
232. Function vectY (v$)
233.     vectY = Val(RightOf$(v$, ","))
234. End Function
235.  
236. Function vectLen (v$)
237.     Dim x, y
238.     x = Val(LeftOf$(v$, ","))
239.     y = Val(RightOf$(v$, ","))
240.     vectLen = Sqr(x * x + y * y)
241. End Function
242.  
243. Function vectUnit$ (v$)
244.     Dim x, y, vl
245.     x = Val(LeftOf$(v$, ","))
246.     y = Val(RightOf$(v$, ","))
247.     vl = Sqr(x * x + y * y)
248.     vectUnit$ = vect$(x / vl, y / vl)
249. End Function
250.  
251. Function vectAdd$ (v1$, v2$)
252.     Dim x1, y1, x2, y2
253.     x1 = Val(LeftOf$(v1$, ","))
254.     y1 = Val(RightOf$(v1$, ","))
255.     x2 = Val(LeftOf$(v2$, ","))
256.     y2 = Val(RightOf$(v2$, ","))
257.     vectAdd$ = vect$(x1 + x2, y1 + y2)
258. End Function
259.  
260. Function vectSub$ (v1$, v2$)
261.     Dim x1, y1, x2, y2
262.     x1 = Val(LeftOf$(v1$, ","))
263.     y1 = Val(RightOf$(v1$, ","))
264.     x2 = Val(LeftOf$(v2$, ","))
265.     y2 = Val(RightOf$(v2$, ","))
266.     vectSub$ = vect$(x1 - x2, y1 - y2)
267. End Function
268.  
269. Function vectDotProduct (v1$, v2$)
270.     Dim x1, y1, x2, y2
271.     x1 = Val(LeftOf$(v1$, ","))
272.     y1 = Val(RightOf$(v1$, ","))
273.     x2 = Val(LeftOf$(v2$, ","))
274.     y2 = Val(RightOf$(v2$, ","))
275.     vectDotProduct = x1 * x2 + y1 * y2
276. End Function
277.  
278. Function vectScale$ (a, v$) 'a * vector v$
279.     Dim x, y
280.     x = Val(LeftOf$(v$, ","))
281.     y = Val(RightOf$(v$, ","))
282.     vectScale$ = vect$(a * x, a * y)
283. End Function
284.  
285. Function vectTangent$ (v$, base$)
286.     Dim n$
287.     n$ = vectUnit$(base$)
288.     vectTangent$ = vectScale$(vectDotProduct(n$, v$), n$)
289. End Function
290.  
291. Function vectNorm$ (v$, base$)
292.     vectNorm$ = vectSub$(v$, vectTangent$(v$, base$))
293. End Function
294.  
295. ' update these 2 in case of$ is not found! 2021-02-13
296. Function LeftOf$ (source$, of$)
297.     If InStr(source$, of$) > 0 Then LeftOf$ = Mid$(source$, 1, InStr(source$, of$) - 1) Else LeftOf$ = source$
298. End Function
299.  
300. ' update these 2 in case of$ is not found! 2021-02-13
301. Function RightOf$ (source$, of$)
302.     If InStr(source$, of$) > 0 Then RightOf$ = Mid$(source$, InStr(source$, of$) + Len(of$)) Else RightOf$ = ""
303. End Function
304.  
305.  
306.  

[justsomeguy]

Nice. Seems to work pretty good. Occasionally two balls would get stuck on each other, but awesome progress. Physics is hard! 

[bplus]

Oh man you are getting sticky balls with that code! Well this next is much more fragile keep number of balls low and not too bad, it does really interesting things with ball speeds!

This is my attempt to follow the paper OldMoses gave link to, see ref in code:

Code: QB64: [Select]

1. Option _Explicit
2. _Title "From Paper 2 Ball Collision with Vectors,  press r to restart" 'B+ 2021-05-13
3. ' Collision tests based on Paper       https://www.vobarian.com/collisions/2dcollisions2.pdf
4. ' The vector functions are modifications of tsh73 JB code converted to QB64 by me.
5. ' earlier code 2 Ball Collision with Vectors by Arrow Addition ' B+ 2021-05-10
6. ' 2021-05-10  fixed arrow so points from base x,y To angle
7. ' from Collision Study #4   press spacebar to toggle tracer" ' b+ 2021-05-09
8.  
9. ' !!!!!!!!!!!!!!!! Adjust Ball according to experiment 2 is always good
10.  
11. 'Const Balls = 2 '<<<<<<<<< change this to 2 to test special case setups: head on, parallel and perpendicular
12. Const Balls = 5 '<<<<<<<<< the more the balls the more problems pop up for Random Numbers experiments
13. '                            no more than 20! because have to start all balls not overlapping any other
14.  
15.  
16. Const Xmax = 600 ' screen width
17. Const Ymax = 600 ' screen height
18. Const R = 50 '     balls radii
19. Const R22 = R * R * 4 ' save some time with (2 * R) * (2 * R)
20.  
21. Const MV_Speed = 45 ' magnitude of Force Arrow say it's constant for simplicity sake
22. Type Ball
23.     As Long x, y
24.     As Double dx, dy, a ' dx, dy = change x, y axis
25.     As _Unsigned Long colr
26. End Type
27.  
28. Randomize Timer
29. Screen _NewImage(Xmax, Ymax, 32)
30. _Delay .25
31. _ScreenMove _Middle
32. ' these can be static as no balls added or subtracted in closed system
33. Dim As Ball b(1 To Balls), nf(1 To Balls) ' b() is current frame balls data , nf( ) is for next frame balls data
34. Dim As Long clrMode, i, j, rdm
35. b(1).colr = &HFFFF0000 'red ball 1 is red
36. b(2).colr = &HFF0000FF 'blue ball 2 is blue
37. clrMode = 1
38. Dim v1$, v2$, dv1$, dv2$, dv1u$, dv2u$, norm$, unitNorm$, unitTan$ 'vectors
39. Dim vp1n$, vp1t$, vp2n$, vp2t$ ' post collision vectors
40. Dim As Double v1n, v1t, v2n, v2t ' dot products
41. Dim As Double vp1n, vp1t, vp2n, vp2t ' post collision dot products
42. restart:
43. 'horizontal collisions  Head On
44. 'b(1).dx = 5
45. 'b(1).dy = 0 ' b1 is just moving on x axis to the right at 5 pixels per frame
46. 'b(2).dx = -5
47. 'b(2).dy = 0 ' b2 is just moving on x axis to the left at 5 pixels per frame
48. 'b(1).x = 300 - 5 * b(1).dx - R ' in 5 frames b1 will meet b2  kiss at center of screen
49. 'b(1).y = 300
50. 'b(2).x = 300 - 5 * b(2).dx + R ' in 5 frames b1 will meet b2  kiss at center of screen
51. 'b(2).y = 300
52.  
53. 'vertical collisions  Head On
54. 'b(1).dy = 5
55. 'b(1).dx = 0 ' b1 is just moving on x axis to the right at 5 pixels per frame
56. 'b(2).dy = -5
57. 'b(2).dx = 0 ' b2 is just moving on x axis to the left at 5 pixels per frame
58. 'b(1).y = 300 - 5 * b(1).dy - R ' in 5 frames b1 will meet b2  kiss at center of screen
59. 'b(1).x = 300
60. 'b(2).y = 300 - 5 * b(2).dy + R ' in 5 frames b1 will meet b2  kiss at center of screen
61. 'b(2).x = 300
62.  
63. ' 45 & 135 collsions   Head On
64. 'b(1).dy = 5
65. 'b(1).dx = 5 ' b1 is just moving on x axis to the right at 5 pixels per frame
66. 'b(2).dy = -5
67. 'b(2).dx = -5 ' b2 is just moving on x axis to the left at 5 pixels per frame
68. 'b(1).y = 300 - 5 * b(1).dy - R ' in 5 frames b1 will meet b2  kiss at center of screen
69. 'b(1).x = 300 - 5 * b(1).dx - R
70. 'b(2).y = 300 - 5 * b(2).dy + R ' in 5 frames b1 will meet b2  kiss at center of screen
71. 'b(2).x = 300 - 5 * b(2).dx + R
72.  
73. ' Parallel and converging paths
74. 'b(1).dy = -6
75. 'b(1).dx = 1 ' b1 is just moving on x axis to the right at 5 pixels per frame
76. 'b(2).dy = -6
77. 'b(2).dx = -1 ' b2 is just moving on x axis to the left at 5 pixels per frame
78. 'b(1).y = Ymax - R ' in 5 frames b1 will meet b2  kiss at center of screen
79. 'b(1).x = 300 - 20 * b(1).dx - R
80. 'b(2).y = Ymax - R ' in 5 frames b1 will meet b2  kiss at center of screen
81. 'b(2).x = 300 - 20 * b(2).dx + R
82.  
83. ' Perpendicular and 90 degree collision   should be just before mid screen
84. 'b(1).dy = 0
85. 'b(1).dx = 5
86. 'b(2).dy = -5
87. 'b(2).dx = 0
88. 'b(1).y = 300
89. 'b(1).x = R
90. 'b(2).y = Ymax - R
91. 'b(2).x = 300
92.  
93. ' random assignments
94. For i = 1 To Balls
95.     tryAgain:
96.     Print i
97.     b(i).x = rand&(R, Xmax - R)
98.     b(i).y = rand&(R, Ymax - R)
99.     For j = 1 To i - 1
100.         If _Hypot(b(i).x - b(j).x, b(i).y - b(j).y) < R + R Then GoTo tryAgain
101.     Next
102.     b(i).dx = (Rnd * 4 + 1) * rdir
103.     b(i).dy = (Rnd * 4 + 1) * rdir
104.     rdm = rand&(1, 7)
105.     If rdm < 1 Or rdm > 7 Then Beep
106.     Select Case rdm
107.         Case 1: b(i).colr = _RGB32(Rnd * 200 + 55, 0, 0)
108.         Case 2: b(i).colr = _RGB32(0, Rnd * 100 + 55, 0)
109.         Case 3: b(i).colr = _RGB32(0, 0, Rnd * 200 + 55)
110.         Case 4: b(i).colr = &HFFFF6600
111.         Case 5: b(i).colr = &HFFFF0088
112.         Case 6: b(i).colr = &HFF00FF88
113.         Case 7: b(i).colr = _RGB32(Rnd * 200 + 55, Rnd * 200 + 55, Rnd * 200 + 55)
114.     End Select
115. Next
116.  
117. While _KeyDown(27) = 0
118.     Dim k$
119.     k$ = InKey$
120.     If Len(k$) Then
121.         If Asc(k$) = 32 Then clrMode = -1 * clrMode
122.         If Asc(k$) = 27 And Len(k$) = 1 Then End
123.         If k$ = "r" Then GoTo restart
124.     End If
125.     If clrMode > 0 Then Cls
126.     Circle (300, 300), 2
127.     For i = 1 To Balls ' draw balls then  update for next frame
128.  
129.         ' this just draw the balls with arrows pointing to their headings
130.         Circle (b(i).x, b(i).y), R, b(i).colr
131.         b(i).a = _Atan2(b(i).dy, b(i).dx)
132.         ArrowTo b(i).x, b(i).y, b(i).a, MV_Speed, &HFFFFFF00
133.         ' debug
134.         '_PrintString (b(i).x - 8, b(i).y - 8), _Trim$(Right$("00" + Str$(i), 2)) 'all the balls weren't getting colored
135.  
136.         ' check for collision
137.         Dim cd, saveJ
138.         cd = 100000: saveJ = 0
139.         For j = 1 To Balls 'find deepest collision in case more than one we want earliest = deepest penetration
140.             If i <> j Then
141.                 Dim dx, dy
142.                 dx = b(i).x - b(j).x: dy = b(i).y - b(j).y
143.                 If dx * dx + dy * dy <= R22 Then ' collision but is it first or deepest collision
144.                     If R22 - dx * dx + dy * dy < cd Then cd = R22 - dx * dx + dy * dy: saveJ = j
145.                 End If
146.             End If
147.         Next
148.         If cd <> 100000 Then ' found collision change ball i dx, dy   calc new course for ball i
149.  
150.             ''reflection  from circle  using Vectors  from JB, thanks tsh73
151.             v1$ = vect$(b(i).x, b(i).y) ' circle i
152.             v2$ = vect$(b(saveJ).x, b(saveJ).y) ' the other circle j
153.             dv1$ = vect$(b(i).dx, b(i).dy) ' change in velocity vector
154.             dv2$ = vect$(b(saveJ).dx, b(saveJ).dy)
155.             dv1u$ = vectUnit$(dv1$) '1 pixel
156.             dv2u$ = vectUnit$(dv2$)
157.             'Print dv$, cv$, dv0$   ' check on things
158.             '_Display
159.             'Sleep
160.             Do ' this should back up the balls to kiss point thanks tsh73
161.                 v1$ = vectSub$(v1$, dv1u$)
162.                 v2$ = vectSub(v2$, dv2u$)
163.             Loop While vectLen(vectSub$(v1$, v2$)) < R + R 'back up our circle i to point on kiss
164.             ''now, get reflection speed
165.             ''radius to radius, norm is
166.             norm$ = vectSub$(v1$, v2$) ' this to this worked without all between from that collision paper
167.  
168.             '  step 1 unit norm and tangent
169.             unitNorm$ = vectUnit$(norm$)
170.             unitTan$ = vect$(-vectY(unitNorm$), vectX(unitNorm$))
171.             ' step 2 v$ and cv$ are 2 ball vectors (locations)  done already
172.             ' step 3 dot products before collision projecting onto normal and tangent vectors
173.             v1n = vectDotProduct(dv1$, unitNorm$)
174.             v1t = vectDotProduct(dv1$, unitTan$)
175.             v2n = vectDotProduct(dv2$, unitNorm$)
176.             v2t = vectDotProduct(dv2$, unitTan$)
177.             ' step 4 simplest  post collision dot products
178.             vp1t = v1t
179.             vp2t = v2t
180.             ' step 5  simplified by m = 1 for both balls just swap the numbers
181.             vp1n = v2n
182.             vp2n = v1n
183.             ' step 6  vp vectors mult the n, t numbers by unit vectors
184.             vp1n$ = vectScale$(vp1n, unitNorm$)
185.             vp1t$ = vectScale$(vp1t, unitTan$)
186.             vp2n$ = vectScale$(vp2n, unitNorm$)
187.             vp2t$ = vectScale$(vp2t, unitTan$)
188.             'step  7  add the 2 vectors n and t
189.             dv1$ = vectAdd$(vp1n$, vp1t$)
190.  
191.             ' to this  now just switch tangent and norm
192.             'dv1$ = vectSub$(vectNorm$(dv1$, norm$), vectTangent$(dv1$, norm$)) 'to this
193.  
194.             ' store in next frame array
195.             nf(i).dx = vectX(dv1$)
196.             nf(i).dy = vectY(dv1$)
197.  
198.         Else ' no collision
199.             nf(i).dx = b(i).dx
200.             nf(i).dy = b(i).dy
201.         End If
202.         'update location of ball next frame
203.         nf(i).x = b(i).x + nf(i).dx
204.         nf(i).y = b(i).y + nf(i).dy
205.  
206.         ' check in bounds next frame
207.         If nf(i).x < R Then nf(i).dx = -nf(i).dx: nf(i).x = R
208.         If nf(i).x > Xmax - R Then nf(i).dx = -nf(i).dx: nf(i).x = Xmax - R
209.         If nf(i).y < R Then nf(i).dy = -nf(i).dy: nf(i).y = R
210.         If nf(i).y > Ymax - R Then nf(i).dy = -nf(i).dy: nf(i).y = Ymax - R
211.     Next
212.  
213.     ''now that we've gone through all old locations update b() with nf() data
214.     For i = 1 To Balls
215.         b(i).x = nf(i).x: b(i).y = nf(i).y
216.         b(i).dx = nf(i).dx: b(i).dy = nf(i).dy
217.     Next
218.     ' next frame ready to draw
219.     _Display
220.     _Limit 30
221. Wend
222. 'Cls   ' debug why aren't all the balls getting colored
223. 'For i = 1 To Balls
224. '    Print i, b(i).colr
225. 'Next
226.  
227.  
228. Function rand& (lo As Long, hi As Long) ' fixed?
229.     rand& = Int(Rnd * (hi - lo) + 1) + lo
230. End Function
231.  
232. Function rdir ()
233.     If Rnd < .5 Then rdir = -1 Else rdir = 1
234. End Function
235.  
236.  
237.  
238. Sub ArrowTo (BaseX As Long, BaseY As Long, rAngle As Double, lngth As Long, colr As _Unsigned Long)
239.     Dim As Long x1, y1, x2, y2, x3, y3
240.     x1 = BaseX + lngth * Cos(rAngle)
241.     y1 = BaseY + lngth * Sin(rAngle)
242.     x2 = BaseX + .8 * lngth * Cos(rAngle - _Pi(.05))
243.     y2 = BaseY + .8 * lngth * Sin(rAngle - _Pi(.05))
244.     x3 = BaseX + .8 * lngth * Cos(rAngle + _Pi(.05))
245.     y3 = BaseY + .8 * lngth * Sin(rAngle + _Pi(.05))
246.     Line (BaseX, BaseY)-(x1, y1), colr
247.     Line (x1, y1)-(x2, y2), colr
248.     Line (x1, y1)-(x3, y3), colr
249. End Sub
250.  
251. ' convert some vector functions from JB, turns out much easier to use string functions to pass vectors
252. ' than using SUBs to do vector calcs
253.  
254. Function vect$ (x, y) ' convert x, y to string for passing vectors with Functions
255.     vect$ = _Trim$(Str$(x)) + "," + _Trim$(Str$(y))
256. End Function
257.  
258. Function vectX (v$)
259.     vectX = Val(LeftOf$(v$, ","))
260. End Function
261.  
262. Function vectY (v$)
263.     vectY = Val(RightOf$(v$, ","))
264. End Function
265.  
266. Function vectLen (v$)
267.     Dim x, y
268.     x = Val(LeftOf$(v$, ","))
269.     y = Val(RightOf$(v$, ","))
270.     vectLen = Sqr(x * x + y * y)
271. End Function
272.  
273. Function vectUnit$ (v$)
274.     Dim x, y, vl
275.     x = Val(LeftOf$(v$, ","))
276.     y = Val(RightOf$(v$, ","))
277.     vl = Sqr(x * x + y * y)
278.     vectUnit$ = vect$(x / vl, y / vl)
279. End Function
280.  
281. Function vectAdd$ (v1$, v2$)
282.     Dim x1, y1, x2, y2
283.     x1 = Val(LeftOf$(v1$, ","))
284.     y1 = Val(RightOf$(v1$, ","))
285.     x2 = Val(LeftOf$(v2$, ","))
286.     y2 = Val(RightOf$(v2$, ","))
287.     vectAdd$ = vect$(x1 + x2, y1 + y2)
288. End Function
289.  
290. Function vectSub$ (v1$, v2$)
291.     Dim x1, y1, x2, y2
292.     x1 = Val(LeftOf$(v1$, ","))
293.     y1 = Val(RightOf$(v1$, ","))
294.     x2 = Val(LeftOf$(v2$, ","))
295.     y2 = Val(RightOf$(v2$, ","))
296.     vectSub$ = vect$(x1 - x2, y1 - y2)
297. End Function
298.  
299. Function vectDotProduct (v1$, v2$)
300.     Dim x1, y1, x2, y2
301.     x1 = Val(LeftOf$(v1$, ","))
302.     y1 = Val(RightOf$(v1$, ","))
303.     x2 = Val(LeftOf$(v2$, ","))
304.     y2 = Val(RightOf$(v2$, ","))
305.     vectDotProduct = x1 * x2 + y1 * y2
306. End Function
307.  
308. Function vectScale$ (a, v$) 'a * vector v$
309.     Dim x, y
310.     x = Val(LeftOf$(v$, ","))
311.     y = Val(RightOf$(v$, ","))
312.     vectScale$ = vect$(a * x, a * y)
313. End Function
314.  
315. Function vectTangent$ (v$, base$)
316.     Dim n$
317.     n$ = vectUnit$(base$)
318.     vectTangent$ = vectScale$(vectDotProduct(n$, v$), n$)
319. End Function
320.  
321. Function vectNorm$ (v$, base$)
322.     vectNorm$ = vectSub$(v$, vectTangent$(v$, base$))
323. End Function
324.  
325. ' update these 2 in case of$ is not found! 2021-02-13
326. Function LeftOf$ (source$, of$)
327.     If InStr(source$, of$) > 0 Then LeftOf$ = Mid$(source$, 1, InStr(source$, of$) - 1) Else LeftOf$ = source$
328. End Function
329.  
330. ' update these 2 in case of$ is not found! 2021-02-13
331. Function RightOf$ (source$, of$)
332.     If InStr(source$, of$) > 0 Then RightOf$ = Mid$(source$, InStr(source$, of$) + Len(of$)) Else RightOf$ = ""
333. End Function
334.  
335.  
336.  

PS It also passed all the special case collision tests: head on (3 angles), parallel converging and perpendicular.
The more balls the more sticky ball syndrome and sometime code will hang because not calculating fast enough for _limit to keep it smooth? But as I said really interesting, realistic?, changes in speed from collisions.

PPS make sure you have Const Balls set to 2 for all the Special Case Tests and comment last experiment and uncomment your next experiment.

[OldMoses]

That looks pretty good. I like how it handles balls getting into tight bunches, which was the downfall of my billiards program.

[bplus]

That looks pretty good. I like how it handles balls getting into tight bunches, which was the downfall of my billiards program.

Yes, I was very pleasantly surprised the ball action could stun balls into stillness or nearly so and then be made active again with just another little bump. The tsh73 version (which may never have been intended for 2 moving balls) and my own ball collision with trig only always have balls moving. My trig version you could start with overlapping balls and they will sort themselves and be clear of each other in a few frames, never a sticky ball but I never got balls stunned to stillness. It's a nice effect hinting I should do some more work trying to speed up the system.

How could I loose the $ Functions and use numbers and still have functions for vectors?
Yeah go ahead and say FB LOL!