_Title "From Paper 2 Ball Collision with Vectors, press r to restart" 'B+ 2021-05-13 ' Collision tests based on Paper https://www.vobarian.com/collisions/2dcollisions2.pdf
' The vector functions are modifications of tsh73 JB code converted to QB64 by me.
' earlier code 2 Ball Collision with Vectors by Arrow Addition ' B+ 2021-05-10
' 2021-05-10 fixed arrow so points from base x,y To angle
' from Collision Study #4 press spacebar to toggle tracer" ' b+ 2021-05-09
' !!!!!!!!!!!!!!!! Adjust Ball according to experiment 2 is always good
Const Balls
= 2 '<<<<<<<<< change this to 2 to test special case setups: head on, parallel and perpendicular 'Const Balls = 5 '<<<<<<<<< the more the balls the more problems pop up for Random Numbers experiments
' no more than 20! because have to start all balls not overlapping any other
Const Xmax
= 600 ' screen width Const Ymax
= 600 ' screen height Const R
= 50 ' balls radii Const R22
= R
* R
* 4 ' save some time with (2 * R) * (2 * R)
Const MV_Speed
= 45 ' magnitude of Force Arrow say it's constant for simplicity sake As Double dx
, dy
, a
' dx, dy = change x, y axis
' these can be static as no balls added or subtracted in closed system
Dim As Ball b
(1 To Balls
), nf
(1 To Balls
) ' b() is current frame balls data , nf( ) is for next frame balls data b(1).colr = &HFFFF0000 'red ball 1 is red
b(2).colr = &HFF0000FF 'blue ball 2 is blue
clrMode = 1
Dim v1$
, v2$
, dv1$
, dv2$
, dv1u$
, dv2u$
, norm$
, unitNorm$
, unitTan$
'vectors Dim vp1n$
, vp1t$
, vp2n$
, vp2t$
' post collision vectors Dim As Double vp1n
, vp1t
, vp2n
, vp2t
' post collision dot products restart:
'horizontal collisions Head On
'b(1).dx = 5
'b(1).dy = 0 ' b1 is just moving on x axis to the right at 5 pixels per frame
'b(2).dx = -5
'b(2).dy = 0 ' b2 is just moving on x axis to the left at 5 pixels per frame
'b(1).x = 300 - 5 * b(1).dx - R ' in 5 frames b1 will meet b2 kiss at center of screen
'b(1).y = 300
'b(2).x = 300 - 5 * b(2).dx + R ' in 5 frames b1 will meet b2 kiss at center of screen
'b(2).y = 300
'vertical collisions Head On
'b(1).dy = 5
'b(1).dx = 0 ' b1 is just moving on x axis to the right at 5 pixels per frame
'b(2).dy = -5
'b(2).dx = 0 ' b2 is just moving on x axis to the left at 5 pixels per frame
'b(1).y = 300 - 5 * b(1).dy - R ' in 5 frames b1 will meet b2 kiss at center of screen
'b(1).x = 300
'b(2).y = 300 - 5 * b(2).dy + R ' in 5 frames b1 will meet b2 kiss at center of screen
'b(2).x = 300
' 45 & 135 collsions Head On
'b(1).dy = 5
'b(1).dx = 5 ' b1 is just moving on x axis to the right at 5 pixels per frame
'b(2).dy = -5
'b(2).dx = -5 ' b2 is just moving on x axis to the left at 5 pixels per frame
'b(1).y = 300 - 5 * b(1).dy - R ' in 5 frames b1 will meet b2 kiss at center of screen
'b(1).x = 300 - 5 * b(1).dx - R
'b(2).y = 300 - 5 * b(2).dy + R ' in 5 frames b1 will meet b2 kiss at center of screen
'b(2).x = 300 - 5 * b(2).dx + R
' Parallel and converging paths
'b(1).dy = -6
'b(1).dx = 1 ' b1 is just moving on x axis to the right at 5 pixels per frame
'b(2).dy = -6
'b(2).dx = -1 ' b2 is just moving on x axis to the left at 5 pixels per frame
'b(1).y = Ymax - R ' in 5 frames b1 will meet b2 kiss at center of screen
'b(1).x = 300 - 20 * b(1).dx - R
'b(2).y = Ymax - R ' in 5 frames b1 will meet b2 kiss at center of screen
'b(2).x = 300 - 20 * b(2).dx + R
' Perpendicular and 90 degree collision should be just before mid screen
b(1).dy = 0
b(1).dx = -5
b(2).dy = -5
b(2).dx = 0
b(1).y = 300
b(1).x = Xmax - R
b(2).y = Ymax - R ' north
b(2).x = 300
' random assignments
'For i = 1 To Balls
' tryAgain:
' Print i
' b(i).x = rand&(R, Xmax - R)
' b(i).y = rand&(R, Ymax - R)
' For j = 1 To i - 1
' If _Hypot(b(i).x - b(j).x, b(i).y - b(j).y) < R + R Then GoTo tryAgain
' Next
' b(i).dx = (Rnd * 4 + 1) * rdir
' b(i).dy = (Rnd * 4 + 1) * rdir
' rdm = rand&(1, 7)
' If rdm < 1 Or rdm > 7 Then Beep
' Select Case rdm
' Case 1: b(i).colr = _RGB32(Rnd * 200 + 55, 0, 0)
' Case 2: b(i).colr = _RGB32(0, Rnd * 100 + 55, 0)
' Case 3: b(i).colr = _RGB32(0, 0, Rnd * 200 + 55)
' Case 4: b(i).colr = &HFFFF6600
' Case 5: b(i).colr = &HFFFF0088
' Case 6: b(i).colr = &HFF00FF88
' Case 7: b(i).colr = _RGB32(Rnd * 200 + 55, Rnd * 200 + 55, Rnd * 200 + 55)
' End Select
'Next
For i
= 1 To Balls
' draw balls then update for next frame
' this just draw the balls with arrows pointing to their headings
Circle (b
(i
).x
, b
(i
).y
), R
, b
(i
).colr
b
(i
).a
= _Atan2(b
(i
).dy
, b
(i
).dx
) ArrowTo b(i).x, b(i).y, b(i).a, MV_Speed, &HFFFFFF00
' debug
'_PrintString (b(i).x - 8, b(i).y - 8), _Trim$(Right$("00" + Str$(i), 2)) 'all the balls weren't getting colored
' check for collision
cd = 100000: saveJ = 0
For j
= 1 To Balls
'find deepest collision in case more than one we want earliest = deepest penetration dx = b(i).x - b(j).x: dy = b(i).y - b(j).y
If dx
* dx
+ dy
* dy
<= R22
Then ' collision but is it first or deepest collision If R22
- dx
* dx
+ dy
* dy
< cd
Then cd
= R22
- dx
* dx
+ dy
* dy: saveJ
= j
If cd
<> 100000 Then ' found collision change ball i dx, dy calc new course for ball i
''reflection from circle using Vectors from JB, thanks tsh73
v1$ = vect$(b(i).x, b(i).y) ' circle i
v2$ = vect$(b(saveJ).x, b(saveJ).y) ' the other circle j
dv1$ = vect$(b(i).dx, b(i).dy) ' change in velocity vector
dv2$ = vect$(b(saveJ).dx, b(saveJ).dy)
dv1u$ = vectUnit$(dv1$) '1 pixel
dv2u$ = vectUnit$(dv2$)
'Print dv$, cv$, dv0$ ' check on things
'_Display
'Sleep
Do ' this should back up the balls to kiss point thanks tsh73 v1$ = vectSub$(v1$, dv1u$)
v2$ = vectSub(v2$, dv2u$)
Loop While vectLen
(vectSub$
(v1$
, v2$
)) < R
+ R
'back up our circle i to point on kiss ''now, get reflection speed
''radius to radius, norm is
norm$ = vectSub$(v1$, v2$) ' this to this worked without all between from that collision paper
' step 1 unit norm and tangent
unitNorm$ = vectUnit$(norm$)
unitTan$ = vect$(-vectY(unitNorm$), vectX(unitNorm$))
' step 2 v$ and cv$ are 2 ball vectors (locations) done already
' step 3 dot products before collision projecting onto normal and tangent vectors
v1n = vectDotProduct(dv1$, unitNorm$)
v1t = vectDotProduct(dv1$, unitTan$)
v2n = vectDotProduct(dv2$, unitNorm$)
v2t = vectDotProduct(dv2$, unitTan$)
' step 4 simplest post collision dot products
vp1t = v1t
vp2t = v2t
' step 5 simplified by m = 1 for both balls just swap the numbers
vp1n = v2n
vp2n = v1n
' step 6 vp vectors mult the n, t numbers by unit vectors
vp1n$ = vectScale$(vp1n, unitNorm$)
vp1t$ = vectScale$(vp1t, unitTan$)
vp2n$ = vectScale$(vp2n, unitNorm$)
vp2t$ = vectScale$(vp2t, unitTan$)
'step 7 add the 2 vectors n and t
dv1$ = vectAdd$(vp1n$, vp1t$)
' to this now just switch tangent and norm
'dv1$ = vectSub$(vectNorm$(dv1$, norm$), vectTangent$(dv1$, norm$)) 'to this
' store in next frame array
nf(i).dx = vectX(dv1$)
nf(i).dy = vectY(dv1$)
nf(i).dx = b(i).dx
nf(i).dy = b(i).dy
'update location of ball next frame
nf(i).x = b(i).x + nf(i).dx
nf(i).y = b(i).y + nf(i).dy
' check in bounds next frame
If nf
(i
).x
< R
Then nf
(i
).dx
= -nf
(i
).dx: nf
(i
).x
= R
If nf
(i
).x
> Xmax
- R
Then nf
(i
).dx
= -nf
(i
).dx: nf
(i
).x
= Xmax
- R
If nf
(i
).y
< R
Then nf
(i
).dy
= -nf
(i
).dy: nf
(i
).y
= R
If nf
(i
).y
> Ymax
- R
Then nf
(i
).dy
= -nf
(i
).dy: nf
(i
).y
= Ymax
- R
''now that we've gone through all old locations update b() with nf() data
b(i).x = nf(i).x: b(i).y = nf(i).y
b(i).dx = nf(i).dx: b(i).dy = nf(i).dy
' next frame ready to draw
'Cls ' debug why aren't all the balls getting colored
'For i = 1 To Balls
' Print i, b(i).colr
'Next
rand&
= Int(Rnd * (hi
- lo
) + 1) + lo
x1
= BaseX
+ lngth
* Cos(rAngle
) y1
= BaseY
+ lngth
* Sin(rAngle
) x2
= BaseX
+ .8 * lngth
* Cos(rAngle
- _Pi(.05)) y2
= BaseY
+ .8 * lngth
* Sin(rAngle
- _Pi(.05)) x3
= BaseX
+ .8 * lngth
* Cos(rAngle
+ _Pi(.05)) y3
= BaseY
+ .8 * lngth
* Sin(rAngle
+ _Pi(.05)) Line (BaseX
, BaseY
)-(x1
, y1
), colr
Line (x1
, y1
)-(x2
, y2
), colr
Line (x1
, y1
)-(x3
, y3
), colr
' convert some vector functions from JB, turns out much easier to use string functions to pass vectors
' than using SUBs to do vector calcs
Function vect$
(x
, y
) ' convert x, y to string for passing vectors with Functions
vectX
= Val(LeftOf$
(v$
, ","))
vectY
= Val(RightOf$
(v$
, ","))
x
= Val(LeftOf$
(v$
, ",")) y
= Val(RightOf$
(v$
, ",")) vectLen
= Sqr(x
* x
+ y
* y
)
x
= Val(LeftOf$
(v$
, ",")) y
= Val(RightOf$
(v$
, ",")) vectUnit$ = vect$(x / vl, y / vl)
x1
= Val(LeftOf$
(v1$
, ",")) y1
= Val(RightOf$
(v1$
, ",")) x2
= Val(LeftOf$
(v2$
, ",")) y2
= Val(RightOf$
(v2$
, ",")) vectAdd$ = vect$(x1 + x2, y1 + y2)
x1
= Val(LeftOf$
(v1$
, ",")) y1
= Val(RightOf$
(v1$
, ",")) x2
= Val(LeftOf$
(v2$
, ",")) y2
= Val(RightOf$
(v2$
, ",")) vectSub$ = vect$(x1 - x2, y1 - y2)
x1
= Val(LeftOf$
(v1$
, ",")) y1
= Val(RightOf$
(v1$
, ",")) x2
= Val(LeftOf$
(v2$
, ",")) y2
= Val(RightOf$
(v2$
, ",")) vectDotProduct = x1 * x2 + y1 * y2
Function vectScale$
(a
, v$
) 'a * vector v$ x
= Val(LeftOf$
(v$
, ",")) y
= Val(RightOf$
(v$
, ",")) vectScale$ = vect$(a * x, a * y)
vectTangent$ = vectScale$(vectDotProduct(n$, v$), n$)
vectNorm$
= vectSub$
(v$
, vectTangent$
(v$
, base$
))
' update these 2 in case of$ is not found! 2021-02-13
' update these 2 in case of$ is not found! 2021-02-13
