Collision Study #4

[bplus]

This version seems to be working better than my last:

Code: QB64: [Select]

1. _Title "Collision Study #4   press spacebar to toggle tracer" ' b+ 2021-05-09 by bplus
2. ' from  "Collision Study #3 Brownian Motion 2018-03-31 by bplus (which was terrible idea of Brownian Motion)
3. ' This time I want to bounce balls with the closest collision first (in case ball is coliidable with 2 or more others)
4. ' PLUS this time I wont change current arrays of ball data but store into NextArray so all bounces are calc'd
5. '      before any new drawing takes place.  YES! I think this works better.
6. ' All radii are const for less calc, need balls different colored
7.  
8.  
9. Const Xmax = 600 ' screen width
10. Const Ymax = 600 ' screen height
11. Const R = 50 '     balls radii
12. Const Balls = 18 ' number of balls
13. Type Ball
14.     As Long x, y, rr, gg, bb ' screen location and RGB colors
15.     As Double dx, dy ' dx, dy = change x, y axis
16. End Type
17.  
18. Randomize Timer
19. Screen _NewImage(Xmax, Ymax, 32)
20. _Delay .25
21. _ScreenMove _Middle
22. ' these can be static as no balls added or subtracted in closed system
23. Dim As Ball b(1 To Balls), nf(1 To Balls) ' b() is current frame balls data , nf( ) is for next frame balls data
24. Dim As Long clrMode, i, rad, j
25. clrMode = 1
26. For i = 1 To Balls
27.     b(i).x = rand(R, Xmax - R)
28.     b(i).y = rand(R, Ymax - R)
29.     b(i).dx = Rnd * 4 + 1 * rdir
30.     b(i).dy = Rnd * 4 + 1 * rdir
31.     b(i).rr = rand%(180, 255)
32.     b(i).gg = rand%(180, 255)
33.     b(i).bb = rand%(180, 255)
34. Next
35.  
36. While 1
37.     k$ = InKey$
38.     If Len(k$) Then
39.         If Asc(k$) = 32 Then clrMode = -1 * clrMode
40.         If Asc(k$) = 27 And Len(k$) = 1 Then End
41.     End If
42.     If clrMode > 0 Then Cls
43.  
44.     For i = 1 To Balls ' draw balls then  update for next frame
45.  
46.         For rad = R To 1 Step -1
47.             Color _RGB32(b(i).rr - rad / R * 150, b(i).gg - rad / R * 150, b(i).bb - rad / R * 150)
48.             fcirc b(i).x, b(i).y, rad
49.         Next
50.  
51.         ' check for collision
52.         cd = 100000: saveJ = 0
53.         For j = 1 To Balls 'find deepest collision
54.             If i <> j Then
55.                 dx = b(i).x - b(j).x: dy = b(i).y - b(j).y
56.                 If dx * dx + dy * dy < (2 * R) * (2 * R) Then ' collision but is it first or deepest collision
57.                     If R * R - dx * dx + dy * dy < cd Then cd = (2 * R) * (2 * R) - dx * dx + dy * dy: saveJ = j
58.                 End If
59.             End If
60.         Next
61.         If cd <> 100000 Then ' found collision change ball i dx, dy   calc new course for ball i
62.             a = _Atan2(b(i).y - b(saveJ).y, b(i).x - b(saveJ).x)
63.             power1 = (b(i).dx ^ 2 + b(i).dy ^ 2) ^ .5
64.             power2 = (b(saveJ).dx ^ 2 + b(saveJ).dy ^ 2) ^ .5
65.             power = (power1 + power2) / 2
66.             nf(i).dx = power * Cos(a)
67.             nf(i).dy = power * Sin(a)
68.         Else ' no collision
69.             nf(i).dx = b(i).dx
70.             nf(i).dy = b(i).dy
71.         End If
72.         'update location of ball next frame
73.         nf(i).x = b(i).x + nf(i).dx
74.         nf(i).y = b(i).y + nf(i).dy
75.  
76.         ' check in bounds next frame
77.         If nf(i).x < R Then nf(i).dx = -nf(i).dx: nf(i).x = R
78.         If nf(i).x > Xmax - R Then nf(i).dx = -nf(i).dx: nf(i).x = Xmax - R
79.         If nf(i).y < R Then nf(i).dy = -nf(i).dy: nf(i).y = R
80.         If nf(i).y > Ymax - R Then nf(i).dy = -nf(i).dy: nf(i).y = Ymax - R
81.     Next
82.  
83.     'now that we've gone through all old locations update b() with nf() data
84.     For i = 1 To Balls
85.         b(i).x = nf(i).x: b(i).y = nf(i).y
86.         b(i).dx = nf(i).dx: b(i).dy = nf(i).dy
87.     Next
88.     ' next frame ready to draw
89.     _Display
90.     _Limit 60
91. Wend
92.  
93. Function rand% (lo As Integer, hi As Integer)
94.     rand% = (Rnd * (hi - lo + 1)) \ 1 + lo
95. End Function
96.  
97. Function rdir ()
98.     If Rnd < .5 Then rdir = -1 Else rdir = 1
99. End Function
100.  
101. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
102. Sub fcirc (CX As Long, CY As Long, R As Long)
103.     Dim subRadius As Long, RadiusError As Long
104.     Dim X As Long, Y As Long
105.  
106.     subRadius = Abs(R)
107.     RadiusError = -subRadius
108.     X = subRadius
109.     Y = 0
110.  
111.     If subRadius = 0 Then PSet (CX, CY): Exit Sub
112.  
113.     ' Draw the middle span here so we don't draw it twice in the main loop,
114.     ' which would be a problem with blending turned on.
115.     Line (CX - X, CY)-(CX + X, CY), , BF
116.  
117.     While X > Y
118.         RadiusError = RadiusError + Y * 2 + 1
119.         If RadiusError >= 0 Then
120.             If X <> Y + 1 Then
121.                 Line (CX - Y, CY - X)-(CX + Y, CY - X), , BF
122.                 Line (CX - Y, CY + X)-(CX + Y, CY + X), , BF
123.             End If
124.             X = X - 1
125.             RadiusError = RadiusError - X * 2
126.         End If
127.         Y = Y + 1
128.         Line (CX - X, CY - Y)-(CX + X, CY - Y), , BF
129.         Line (CX - X, CY + Y)-(CX + X, CY + Y), , BF
130.     Wend
131. End Sub
132.  
133.  

[johnno56]

Well... I am impressed... I think I spotted at least one blue ball in that demo... Well done!

I am curious. The fcirc() routine. Is this routine used, instead of the built-in paint() command, because of the minimal use of memory compared with a flodfill (paint) command or is there something else at play here? Just curious.

J

[bplus]

Seems to work OK:

Code: QB64: [Select]

1. _Title "Collision Study #4   press spacebar to toggle tracer" ' b+ 2021-05-09 by bplus
2. ' from  "Collision Study #3 Brownian Motion 2018-03-31 by bplus (which was terrible idea of Brownian Motion)
3. ' This time I want to bounce balls with the closest collision first (in case ball is coliidable with 2 or more others)
4. ' PLUS this time I wont change current arrays of ball data but store into NextArray so all bounces are calc'd
5. '      before any new drawing takes place.  YES! I think this works better.
6. ' All radii are const for less calc, need balls different colored
7.  
8.  
9. Const Xmax = 600 ' screen width
10. Const Ymax = 600 ' screen height
11. Const R = 50 '     balls radii
12. Const Balls = 18 ' number of balls
13. Type Ball
14.     As Long x, y, rr, gg, bb ' screen location and RGB colors
15.     As Double dx, dy ' dx, dy = change x, y axis
16. End Type
17.  
18. Randomize Timer
19. Screen _NewImage(Xmax, Ymax, 32)
20. _Delay .25
21. _ScreenMove _Middle
22. ' these can be static as no balls added or subtracted in closed system
23. Dim As Ball b(1 To Balls), nf(1 To Balls) ' b() is current frame balls data , nf( ) is for next frame balls data
24. Dim As Long clrMode, i, rad, j
25. clrMode = 1
26. For i = 1 To Balls
27.     b(i).x = rand(R, Xmax - R)
28.     b(i).y = rand(R, Ymax - R)
29.     b(i).dx = Rnd * 4 + 1 * rdir
30.     b(i).dy = Rnd * 4 + 1 * rdir
31.     b(i).rr = rand%(180, 255)
32.     b(i).gg = rand%(180, 255)
33.     b(i).bb = rand%(180, 255)
34. Next
35.  
36. While 1
37.     k$ = InKey$
38.     If Len(k$) Then
39.         If Asc(k$) = 32 Then clrMode = -1 * clrMode
40.         If Asc(k$) = 27 And Len(k$) = 1 Then End
41.     End If
42.     If clrMode > 0 Then Cls
43.  
44.     For i = 1 To Balls ' draw balls then  update for next frame
45.  
46.         For rad = R To 1 Step -1
47.             Color _RGB32(b(i).rr - rad / R * 150, b(i).gg - rad / R * 150, b(i).bb - rad / R * 150)
48.             fcirc b(i).x, b(i).y, rad
49.         Next
50.  
51.         ' check for collision
52.         cd = 100000: saveJ = 0
53.         For j = 1 To Balls 'find deepest collision
54.             If i <> j Then
55.                 dx = b(i).x - b(j).x: dy = b(i).y - b(j).y
56.                 If dx * dx + dy * dy < (2 * R) * (2 * R) Then ' collision but is it first or deepest collision
57.                     If R * R - dx * dx + dy * dy < cd Then cd = (2 * R) * (2 * R) - dx * dx + dy * dy: saveJ = j
58.                 End If
59.             End If
60.         Next
61.         If cd <> 100000 Then ' found collision change ball i dx, dy   calc new course for ball i
62.             a = _Atan2(b(i).y - b(saveJ).y, b(i).x - b(saveJ).x)
63.             power1 = (b(i).dx ^ 2 + b(i).dy ^ 2) ^ .5
64.             power2 = (b(saveJ).dx ^ 2 + b(saveJ).dy ^ 2) ^ .5
65.             power = (power1 + power2) / 2
66.             nf(i).dx = power * Cos(a)
67.             nf(i).dy = power * Sin(a)
68.         Else ' no collision
69.             nf(i).dx = b(i).dx
70.             nf(i).dy = b(i).dy
71.         End If
72.         'update location of ball next frame
73.         nf(i).x = b(i).x + nf(i).dx
74.         nf(i).y = b(i).y + nf(i).dy
75.  
76.         ' check in bounds next frame
77.         If nf(i).x < R Then nf(i).dx = -nf(i).dx: nf(i).x = R
78.         If nf(i).x > Xmax - R Then nf(i).dx = -nf(i).dx: nf(i).x = Xmax - R
79.         If nf(i).y < R Then nf(i).dy = -nf(i).dy: nf(i).y = R
80.         If nf(i).y > Ymax - R Then nf(i).dy = -nf(i).dy: nf(i).y = Ymax - R
81.     Next
82.  
83.     'now that we've gone through all old locations update b() with nf() data
84.     For i = 1 To Balls
85.         b(i).x = nf(i).x: b(i).y = nf(i).y
86.         b(i).dx = nf(i).dx: b(i).dy = nf(i).dy
87.     Next
88.     ' next frame ready to draw
89.     _Display
90.     _Limit 60
91. Wend
92.  
93. Function rand% (lo As Integer, hi As Integer)
94.     rand% = (Rnd * (hi - lo + 1)) \ 1 + lo
95. End Function
96.  
97. Function rdir ()
98.     If Rnd < .5 Then rdir = -1 Else rdir = 1
99. End Function
100.  
101. Sub fcirc (CX As Long, CY As Long, R As Long)
102.     Circle (CX, CY), R, _DefaultColor
103.     Paint (CX, CY), _DefaultColor, _DefaultColor
104. End Sub
105.  

[bplus]

Oh! change the limit to 200, you will see the difference between Circle Fill methods. The Paint fill wont keep up.

This is the balls when they have too much coffee ;-))

[_vince]

yes, that is the gold standard

[bplus]

Found error in Collision detection and added constant to fix error and reduce Collision calculations a little:

Code: QB64: [Select]

1. _Title "Collision Study #4   press spacebar to toggle tracer" ' b+ 2021-05-09 by bplus
2. ' from  "Collision Study #3 Brownian Motion 2018-03-31 by bplus (which was terrible idea of Brownian Motion)
3. ' This time I want to bounce balls with the closest collision first (in case ball is coliidable with 2 or more others)
4. ' PLUS this time I wont change current arrays of ball data but store into NextArray so all bounces are calc'd
5. '      before any new drawing takes place.  YES! I think this works better.
6. ' All radii are const for less calc, need balls different colored
7.  
8.  
9. Const Xmax = 1200 ' screen width
10. Const Ymax = 600 ' screen height
11. Const R = 50 '     balls radii
12. Const R22 = R * R * 4 ' save some time with (2 * R) * (2 * R)
13. Const Balls = 18 ' number of balls
14. Type Ball
15.     As Long x, y, rr, gg, bb ' screen location and RGB colors
16.     As Double dx, dy ' dx, dy = change x, y axis
17. End Type
18.  
19. Randomize Timer
20. Screen _NewImage(Xmax, Ymax, 32)
21. _Delay .25
22. _ScreenMove _Middle
23. ' these can be static as no balls added or subtracted in closed system
24. Dim As Ball b(1 To Balls), nf(1 To Balls) ' b() is current frame balls data , nf( ) is for next frame balls data
25. Dim As Long clrMode, i, rad, j
26. clrMode = 1
27. For i = 1 To Balls
28.     b(i).x = rand(R, Xmax - R)
29.     b(i).y = rand(R, Ymax - R)
30.     b(i).dx = Rnd * 4 + 1 * rdir
31.     b(i).dy = Rnd * 4 + 1 * rdir
32.     b(i).rr = rand%(180, 255)
33.     b(i).gg = rand%(180, 255)
34.     b(i).bb = rand%(180, 255)
35. Next
36.  
37. While 1
38.     k$ = InKey$
39.     If Len(k$) Then
40.         If Asc(k$) = 32 Then clrMode = -1 * clrMode
41.         If Asc(k$) = 27 And Len(k$) = 1 Then End
42.     End If
43.     If clrMode > 0 Then Cls
44.  
45.     For i = 1 To Balls ' draw balls then  update for next frame
46.  
47.         For rad = R To 1 Step -1
48.             Color _RGB32(b(i).rr - rad / R * 150, b(i).gg - rad / R * 150, b(i).bb - rad / R * 150)
49.             fcirc b(i).x, b(i).y, rad
50.         Next
51.  
52.         ' check for collision
53.         cd = 100000: saveJ = 0
54.         For j = 1 To Balls 'find deepest collision
55.             If i <> j Then
56.                 dx = b(i).x - b(j).x: dy = b(i).y - b(j).y
57.                 If dx * dx + dy * dy < R22 Then ' collision but is it first or deepest collision
58.                     If R22 - dx * dx + dy * dy < cd Then cd = R22 - dx * dx + dy * dy: saveJ = j
59.                 End If
60.             End If
61.         Next
62.         If cd <> 100000 Then ' found collision change ball i dx, dy   calc new course for ball i
63.             a = _Atan2(b(i).y - b(saveJ).y, b(i).x - b(saveJ).x)
64.             power1 = (b(i).dx ^ 2 + b(i).dy ^ 2) ^ .5
65.             power2 = (b(saveJ).dx ^ 2 + b(saveJ).dy ^ 2) ^ .5
66.             power = (power1 + power2) / 2
67.             nf(i).dx = power * Cos(a)
68.             nf(i).dy = power * Sin(a)
69.         Else ' no collision
70.             nf(i).dx = b(i).dx
71.             nf(i).dy = b(i).dy
72.         End If
73.         'update location of ball next frame
74.         nf(i).x = b(i).x + nf(i).dx
75.         nf(i).y = b(i).y + nf(i).dy
76.  
77.         ' check in bounds next frame
78.         If nf(i).x < R Then nf(i).dx = -nf(i).dx: nf(i).x = R
79.         If nf(i).x > Xmax - R Then nf(i).dx = -nf(i).dx: nf(i).x = Xmax - R
80.         If nf(i).y < R Then nf(i).dy = -nf(i).dy: nf(i).y = R
81.         If nf(i).y > Ymax - R Then nf(i).dy = -nf(i).dy: nf(i).y = Ymax - R
82.     Next
83.  
84.     'now that we've gone through all old locations update b() with nf() data
85.     For i = 1 To Balls
86.         b(i).x = nf(i).x: b(i).y = nf(i).y
87.         b(i).dx = nf(i).dx: b(i).dy = nf(i).dy
88.     Next
89.     ' next frame ready to draw
90.     _Display
91.     _Limit 60
92. Wend
93.  
94. Function rand% (lo As Integer, hi As Integer)
95.     rand% = (Rnd * (hi - lo + 1)) \ 1 + lo
96. End Function
97.  
98. Function rdir ()
99.     If Rnd < .5 Then rdir = -1 Else rdir = 1
100. End Function
101.  
102. 'Steve McNeil's  copied from his forum   note: Radius is too common a name
103. Sub fcirc (CX As Long, CY As Long, R As Long)
104.     Dim subRadius As Long, RadiusError As Long
105.     Dim X As Long, Y As Long
106.  
107.     subRadius = Abs(R)
108.     RadiusError = -subRadius
109.     X = subRadius
110.     Y = 0
111.  
112.     If subRadius = 0 Then PSet (CX, CY): Exit Sub
113.  
114.     ' Draw the middle span here so we don't draw it twice in the main loop,
115.     ' which would be a problem with blending turned on.
116.     Line (CX - X, CY)-(CX + X, CY), , BF
117.  
118.     While X > Y
119.         RadiusError = RadiusError + Y * 2 + 1
120.         If RadiusError >= 0 Then
121.             If X <> Y + 1 Then
122.                 Line (CX - Y, CY - X)-(CX + Y, CY - X), , BF
123.                 Line (CX - Y, CY + X)-(CX + Y, CY + X), , BF
124.             End If
125.             X = X - 1
126.             RadiusError = RadiusError - X * 2
127.         End If
128.         Y = Y + 1
129.         Line (CX - X, CY - Y)-(CX + X, CY - Y), , BF
130.         Line (CX - X, CY + Y)-(CX + X, CY + Y), , BF
131.     Wend
132. End Sub
133.  
134.