Ball collisions

General FreeBASIC programming questions.
owen
Posts: 555
Joined: Apr 19, 2006 10:55
Location: Kissimmee, FL
Contact:

Re: Ball collisions

Post by owen »

So the first impulse might be the true one (from actual motion data).
But I'll let you ponder over which is properly correct.
properly correct?
well, i don't know that one either.
impules ranges from -1 to +1 (at actual point of impact)
but then it does affect the new velocities. food for thought. thanks.
owen
Posts: 555
Joined: Apr 19, 2006 10:55
Location: Kissimmee, FL
Contact:

Re: Ball collisions

Post by owen »

because i think in degrees i couldn't help myself. one more time around.
the thing you call impulse to me is the normal (the angle from ball 2's center to ball 1's center (at point of collision)
abtp = angle between two points

Code: Select all

	norm=abtp(b(ball_2).x,b(ball_2).y,b(ball_1).x,b(ball_1).y)
	normx=Cos(norm*pi/180)
	normy=Sin(norm*pi/180)
	'set one ball to nearest non overlap position
	b(ball_1).x=b(ball_2).x+(b(ball_2).r+b(ball_1).r)*normx
	b(ball_1).y=b(ball_2).y+(b(ball_2).r+b(ball_1).r)*normy
	norm=abtp(b(ball_2).x,b(ball_2).y,b(ball_1).x,b(ball_1).y)
	'readjust norm x and y
	normx=Cos(norm*pi/180)
	normy=Sin(norm*pi/180)
and the thing about hippasus (a few posts back) was due to a lot of beer. (i was investigating head on collision stuff)

any how here is the complete code for freeze-tag (update #11)

Code: Select all

''  physics engine that simulates bouncing balls using vector math
''  This code is based on the 2D elastic collision tutorial found at:
''  http://www.freebasic.net/forum/viewtopic.php?f=3&t=8903&sid=960dda2e5d05f308250b7017ff5f5629
''  inactive link http://www.geocities.com/vobarian/2dcollisions/
''  perhaps the original author was Chad Berchek which i found at vobarian.com
''  i reworked the algo removing the oop and condensing it into something that i can kinda understand
''  but still credit goes to vobarian.
''  also dodicat from the freebasic.net community helped me out a lot.
''  http://www.freebasic.net/forum/viewtopic.php?f=3&t=8903&start=15
''  see sub routine bouce at the bottom of this code.
''  conversation of this game can be found @ http://www.thejoyfulprogrammer.com/qb64/forum/showthread.php?tid=961
''  special thanks to waltersmind and bplus @ thejoyfulprogrammer.com

#include "fbgfx.bi"
#If __FB_LANG__ = "fb"
Using FB
#EndIf
#include once "fmod.bi"
Declare Function dist(x1 As Double,y1 As Double,x2 As Double,y2 As Double) As Double
Declare Function abtp(abtpx1 as Double,abtpy1 as Double,abtpx2 as Double,abtpy2 as Double) as Double
Declare Sub delay(delay_sec As Double)
Declare Sub calc_bnd()
Declare Sub bounce(ball_1 As Integer, ball_2 As Integer)

Type balls
	As Integer c,r
	As Double s,x,y,t,d
	As BOOLEAN a
	'x,y coordinates
	'c color
	'r radius
	'd direction in degrees: 0 degrees is at 3 O'clock, 90 degrees is at 12
	's speed
	't timer
End Type
Type ammo
	As Integer b,c,r,d
	As Double s,x,y
	As BOOLEAN a
	'x,y coordinates
	'c color
	'r radius
	'd direction in degrees: 0 degrees is at 3 O'clock, 90 degrees is at 12
	's speed
	'a active
End Type
Type emp_obj
	r As Integer'radius
	c As Integer'color
	x As Integer
	y As Integer
	'x,y coordinates
End Type
Const pi As Double = 4 * Atn(1)
Const hippasus As Double = Sqr(2)
Dim Shared As Integer bc
DIM AS Integer game_sound(12)
Dim As Integer i,j,k,bf(15),c,catch,level,bw,bh,game_level_val
Dim As BOOLEAN pass,fail,skip
Dim Shared As balls b()
Dim As ammo a()
Dim As Integer ammoc,ammor,ammors,abc,multibursts,multibursts_degrees
Dim As BOOLEAN ap

Dim As String game_level
Dim Shared As Double normal,rot,bid,bnd,boid,maxspeed
Dim As Integer b1d,b2d,sit
Dim As Double firet,timeout
Dim As BOOLEAN empa,empat,empcut
Dim As Integer empc,emps,empm,empct,empcutc,empcc
empcc=60
Dim As emp_obj emp(empcc)
Dim As Double empx,empy,empd
Dim As Double rip1,rip2,heading

' 48kHz sample rate, 8 channels.
FSOUND_Init(48000, 8, 0)

game_sound(0) = FSOUND_Sample_Load(FSOUND_FREE, "splash-screen-audio-clip.wav", 0, 0, 0)
game_sound(1) = FSOUND_Sample_Load(FSOUND_FREE, "Bounce-SoundBible.com-12678623.wav", 0, 0, 0)
game_sound(2) = FSOUND_Sample_Load(FSOUND_FREE, "Clean_Paper_Rip-Mike_Koenig-259504794.wav", 0, 0, 0)
game_sound(3) = FSOUND_Sample_Load(FSOUND_FREE, "UFO_Takeoff-Sonidor-1604321570.wav", 0, 0, 0)
game_sound(4) = FSOUND_Sample_Load(FSOUND_FREE, "Wood Whack-SoundBible.com-1254461064.wav", 0, 0, 0)
game_sound(5) = FSOUND_Sample_Load(FSOUND_FREE, "Audience_Applause-Matthiew11-1206899159.wav", 0, 0, 0)
game_sound(6) = FSOUND_Sample_Load(FSOUND_FREE, "1_person_cheering-Jett_Rifkin-1851518140.wav", 0, 0, 0)
game_sound(7) = FSOUND_Sample_Load(FSOUND_FREE, "Baby_Boy_Laugh-Mike_Koenig-1622212130.wav", 0, 0, 0)
game_sound(8) = FSOUND_Sample_Load(FSOUND_FREE, "Short_triumphal_fanfare-John_Stracke-815794903.wav", 0, 0, 0)
game_sound(9) = FSOUND_Sample_Load(FSOUND_FREE, "Ta Da-SoundBible.com-1884170640.wav", 0, 0, 0)
game_sound(10) = FSOUND_Sample_Load(FSOUND_FREE, "bullet_whizzing_by-Mike_Koenig-2005433595.wav", 0, 0, 0)
game_sound(11) = FSOUND_Sample_Load(FSOUND_FREE, "Metal_Gong-Dianakc-109711828-mod-1.wav", 0, 0, 0)
game_sound(12) = FSOUND_Sample_Load(FSOUND_FREE, "Mario_Jumping-Mike_Koenig-989896458-mod-1.wav", 0, 0, 0)




'FSOUND_Sample_SetMode(game_sound(0), FSOUND_LOOP_OFF)
'FSOUND_Sample_SetMode(game_sound(1), FSOUND_LOOP_OFF)
'FSOUND_Sample_SetMode(game_sound(2), FSOUND_LOOP_OFF)
'FSOUND_Sample_SetMode(game_sound(3), FSOUND_LOOP_OFF)

bw=600
bh=600
Randomize Timer
ScreenRes bw,bh
Window (0,0)-(bw,bh)
Dim img_splash As Any Ptr = ImageCreate( 600, 600 )
Dim img_level As Any Ptr = ImageCreate( 209, 75 )
Dim img_number_0 As Any Ptr = ImageCreate( 48, 67 )
Dim img_number_1 As Any Ptr = ImageCreate( 48, 67 )
Dim img_number_2 As Any Ptr = ImageCreate( 48, 67 )
Dim img_number_3 As Any Ptr = ImageCreate( 48, 67 )
Dim img_number_4 As Any Ptr = ImageCreate( 48, 67 )
Dim img_number_5 As Any Ptr = ImageCreate( 48, 67 )
Dim img_number_6 As Any Ptr = ImageCreate( 48, 67 )
Dim img_number_7 As Any Ptr = ImageCreate( 48, 67 )
Dim img_number_8 As Any Ptr = ImageCreate( 48, 67 )
Dim img_number_9 As Any Ptr = ImageCreate( 48, 67 )

BLoad "game_logo-1.bmp", img_splash
BLoad "level.bmp", img_level
BLoad "0.bmp", img_number_0
BLoad "1.bmp", img_number_1
BLoad "2.bmp", img_number_2
BLoad "3.bmp", img_number_3
BLoad "4.bmp", img_number_4
BLoad "5.bmp", img_number_5
BLoad "6.bmp", img_number_6
BLoad "7.bmp", img_number_7
BLoad "8.bmp", img_number_8
BLoad "9.bmp", img_number_9
Put (0,bh), img_splash
Draw String (10,492),"By Owen Reese   Fbcadcam.com/freezetag   opreese@gmail.com"
Draw String (30,475),"Using the FMOD Sound System by Firelight Technologies"
Draw String (50,463),"Free Sound bytes from SoundBible.com"
Draw String (60,454),"Thanks to Mike Koenig, Sonidor and Matthiew11"
FSOUND_PlaySound(FSOUND_FREE, game_sound(0))
ammoc=1
abc=1
level=6
maxspeed=5
delay 4

Randomize Timer
Do
	emps=3
	empm=3
	empa=FALSE
	empat=FALSE
	empc=0
	If level Mod 5 = 0 Then
		multibursts=Int(level/4)+1
	Else
			multibursts=1'Int(level/4)+1
	EndIf
	multibursts_degrees=Int(360/multibursts)
	If level Mod 10 = 0 Then
		ammor=level*2
		ap=TRUE
	Else
		If multibursts=1 Then
			ammor=level*3
		Else
			ammor=level*multibursts/2
		EndIf
	EndIf
	ammors=ammor
	ammoc=Int(level*multibursts/2)'Int(level/3)
	ReDim a(ammoc)
	delay 3
	Cls
	Put (100,500),img_level
	game_level=LTrim(Str(level))
	For i=1 To Len(game_level)
		game_level_val=Val(Mid(game_level,i,1))
		Select Case game_level_val
			Case 0
				Put (i*45+310,490),img_number_0
			Case 1
				Put (i*45+310,490),img_number_1
			Case 2
				Put (i*45+310,490),img_number_2
			Case 3
				Put (i*45+310,490),img_number_3
			Case 4
				Put (i*45+310,490),img_number_4
			Case 5
				Put (i*45+310,490),img_number_5
			Case 6
				Put (i*45+310,490),img_number_6
			Case 7
				Put (i*45+310,490),img_number_7
			Case 8
				Put (i*45+310,490),img_number_8
			Case 9
				Put (i*45+310,490),img_number_9
		End Select
	Next
	delay 2
	Cls

	bc=level
	ReDim b(bc)
	timeout=level*2
	For i=1 To 15
		bf(i)=0
	Next
	'new level, position the balls so that none of the overlap
	For i = 0 To bc
		b(i).x = Int(Rnd*(bw-60))+30
		b(i).y = Int(Rnd*(bh-60))+30
		If i=0 Then
			b(i).r = 30
		Else
			b(i).r = Int(Rnd*20)+20
		EndIf
		pass=TRUE
		For j=0 To i-1
			If dist(b(i).x,b(i).y,b(j).x,b(j).y)-6 < b(i).r+b(j).r Then
				i-=1
				pass=FALSE
				Exit For
			EndIf
		Next
		If pass=TRUE Then
			b(i).c = Int(Rnd*14)+1
			'If i=0 Then b(i).r=30
			b(i).d = Int(Rnd*360)
			b(i).s = Rnd+1
			If i<>0 Then
				bf(b(i).c)+=1
			EndIf
		EndIf
	Next
	catch=0
	For i =1 To 15
		If bf(i)>catch Then
			catch=bf(i)
			b(0).c=i
		EndIf
	Next
	
	Do
		If level>bc Then
			FSOUND_PlaySound(FSOUND_FREE, game_sound(Int(Rnd*5)+5))
			delay(1)
			Exit Do
		EndIf
		If empa=TRUE Then
			If empc<empcc Then
				empc+=1
				emp(empc).x=empx' +cos(empc*36*pi/180)*b(0).r
				emp(empc).y=empy' +sin(empc*36*pi/180)*b(0).r
				emp(empc).r=0'b(0).r
				emp(empc).c=empct
			EndIf
		EndIf
		ScreenLock
		Cls
		For i=0 To bc
			'move the balls
			b(i).x=b(i).x+cos(b(i).d*pi/180)*b(i).s
			b(i).y=b(i).y+sin(b(i).d*pi/180)*b(i).s
			If i=0 Then heading=b(0).d
			If b(i).s<>0 Then
				'bounce the balls off each other
				For j=0 To bc
					If j<>i Then
						If b(j).s<>0 Then
							'If dist(b(i).x,b(i).y,b(j).x,b(j).y)<=b(i).r+b(j).r Then
							'	b(j).x+=Cos(b(j).d*pi/180)*b(j).s
							'	b(j).y+=Sin(b(j).d*pi/180)*b(j).s
								If dist(b(i).x,b(i).y,b(j).x,b(j).y)<=b(i).r+b(j).r Then
									If i=0 Or j=0 Then
										If b(i).c=b(j).c Then
											Exit For
										Else
											FSOUND_PlaySound(FSOUND_FREE, game_sound(4))
										EndIf
									EndIf
									'put them back to where they were just prior to collision
									bounce(i,j)
									'If i=0 Then b(i).d=heading
									'If j=0 Then b(j).d=heading
									b(i).x+=Cos(b(i).d*pi/180)*b(i).s
									b(i).y+=Sin(b(i).d*pi/180)*b(i).s
									b(j).x+=Cos(b(j).d*pi/180)*b(j).s
									b(j).y+=Sin(b(j).d*pi/180)*b(j).s
									Exit For
								'Else
								'	b(j).x+=Cos((b(j).d+180)*pi/180)*b(j).s
								'	b(j).y+=sin((b(j).d+180)*pi/180)*b(j).s
								EndIf
							'EndIf
						End If
					EndIf
				Next
			EndIf
			'detect borders
			If b(i).x + b(i).r > bw Then
				bid=b(i).d
				normal=180
				calc_bnd
				b(i).d=bnd
				b(i).x = bw - b(i).r
				FSOUND_PlaySound(FSOUND_FREE, game_sound(1))
			EndIf
			If b(i).x - b(i).r < 0 Then
				bid=b(i).d
				normal=0
				calc_bnd
				b(i).d=bnd
				b(i).x = b(i).r
				'FSOUND_PlaySound(FSOUND_FREE, game_sound(1))
			EndIf
			If b(i).y + b(i).r > bh Then
				bid=b(i).d
				normal=270
				calc_bnd
				b(i).d=bnd
				b(i).y = bh - b(i).r
				'FSOUND_PlaySound(FSOUND_FREE, game_sound(1))
			EndIf
			If b(i).y - b(i).r < 0 Then
				bid=b(i).d
				normal=90
				calc_bnd
				b(i).d=bnd
				b(i).y = b(i).r
				'FSOUND_PlaySound(FSOUND_FREE, game_sound(1))
			EndIf
			'freeze the balls
			If i=0 Then
				For j=1 To bc
					If b(j).c=b(0).c Then
						''freeze the balls via emp
						If b(j).s<>0 Then
							If empa=TRUE And empat=TRUE Then
								If emp(1).r>dist(b(j).x,b(j).y,emp(1).x,emp(1).y)-b(j).r Then
									b(j).s = 0
									b(j).r = 4
									b(j).t = Timer
									bf(b(j).c)-=1
									If bf(b(j).c)=0 Then
										empat=FALSE
										catch=0
										For k =1 To 15
											If bf(k)>catch Then
												catch=bf(k)
												b(0).c=k
											EndIf
										Next
										If catch=0 Then
											level+=1
										EndIf
										For k=0 To ammoc
											a(k).a=FALSE
										Next
									EndIf
									FSOUND_PlaySound(FSOUND_FREE, game_sound(2))
								EndIf
							EndIf
						EndIf
						''freeze the balls via collision
						If b(j).s<>0 Then
							If dist(b(0).x,b(0).y,b(j).x,b(j).y) < b(0).r + b(j).r Then
								FSOUND_PlaySound(FSOUND_FREE, game_sound(2))
								b(j).s = 0
								b(j).r = 4
								b(j).t = Timer
								bf(b(j).c)-=1
								If bf(b(j).c)=0 Then
									catch=0
									For k =1 To 15
										If bf(k)>catch Then
											catch=bf(k)
											b(0).c=k
											empa=FALSE
											empc=0
										EndIf
									Next
									If catch=0 Then
										level+=1
									EndIf
									For k=0 To ammoc
										a(k).a=FALSE
									Next
								EndIf
								If ap=FALSE Then ammor+=Int(level/2)
								If ammor>ammors Then ammor=ammors
							EndIf
						EndIf
					Else
						'check if you got a ball cornered
						Select Case b(0).x
							Case Is < bw/2
								Select Case b(0).y
									Case Is < bh/2
										'blc
										'other ball b1radius*hippasus+b0radius/2
										
									Case Else
										'tlc
								End Select
							Case Else
						Select Case b(0).y
									Case Is < bh/2
										'brc
									Case Else
										'trc
								End Select
						End Select
					EndIf
				Next
			Else
				For j=1 To bc
					If j<>i Then
						If b(j).s = 0 Then
							If b(j).c = b(i).c Then
								If dist(b(i).x,b(i).y,b(j).x,b(j).y) < b(i).r + b(j).r Then
									b(j).a=TRUE
								EndIf
							EndIf
						EndIf
					EndIf
				Next
			EndIf
			'draw circles
			If i=0 Then
				Circle (b(0).x,b(0).y),b(0).r,b(0).c
				Circle (b(0).x,b(0).y),b(0).r/4,b(0).c,,,,f
				If ammor<>0 Then
					Circle (b(0).x,b(0).y),b(0).r/2+8,b(0).c,(pi / 180),(360*ammor/ammors * pi / 180)
					Circle (b(0).x,b(0).y),b(0).r/2+9,b(0).c,(pi / 180),(360*ammor/ammors * pi / 180)
				EndIf
				If emps<>0 Then
					Circle (b(0).x,b(0).y),b(0).r/2+2,b(0).c,(pi / 180),(360*emps/empm * pi / 180)
					Circle (b(0).x,b(0).y),b(0).r/2+3,b(0).c,(pi / 180),(360*emps/empm * pi / 180)
					Circle (b(0).x,b(0).y),b(0).r/2+4,b(0).c,(pi / 180),(360*emps/empm * pi / 180)
					Circle (b(0).x,b(0).y),b(0).r/2+5,b(0).c,(pi / 180),(360*emps/empm * pi / 180)
				EndIf
				Line(b(0).x,b(0).y)-(b(0).x+cos(b(0).d*pi/180)*b(0).r,b(0).y+sin(b(0).d*pi/180)*b(0).r)
				Line(b(0).x+cos(b(0).d*pi/180)*b(0).r,b(0).y+sin(b(0).d*pi/180)*b(0).r)-(b(0).x+cos((b(0).d+15)*pi/180)*(b(0).r-10),b(0).y+sin((b(0).d+15)*pi/180)*(b(0).r-10))
				Line(b(0).x+cos(b(0).d*pi/180)*b(0).r,b(0).y+sin(b(0).d*pi/180)*b(0).r)-(b(0).x+cos((b(0).d-15)*pi/180)*(b(0).r-10),b(0).y+sin((b(0).d-15)*pi/180)*(b(0).r-10))
			Else
				Circle (b(i).x,b(i).y),b(i).r,b(i).c,,,,f
				If b(i).s=0 Then
					If Timer>b(i).t+timeout Then
						b(i).a=TRUE
					EndIf
				EndIf
			EndIf
		Next
		'move ammo rounds and detect if round hits a target ball
		For i=0 To ammoc
			If a(i).a = TRUE Then
				Circle (a(i).x,a(i).y),a(i).r,a(i).c,,,,f
				a(i).x=a(i).x+cos(a(i).d*pi/180)*a(i).s
				a(i).y=a(i).y+sin(a(i).d*pi/180)*a(i).s
				For j=1 To bc
					If b(j).s<>0 Then
						If ap=TRUE Then
							If a(i).c=b(j).c Then
								If dist(a(i).x,a(i).y,b(j).x,b(j).y) < a(i).r + b(j).r Then
									a(i).a = FALSE
									FSOUND_PlaySound(FSOUND_FREE, game_sound(2))
									b(j).s = 0
									b(j).r = 4
									b(j).t = Timer
									bf(b(j).c)-=1
									If bf(b(j).c)=0 Then
										catch=0
										For k =1 To 15
											If bf(k)>catch Then
												catch=bf(k)
												b(0).c=k
											EndIf
										Next
										If catch=0 Then
											level+=1
										EndIf
										For k=0 To ammoc
											a(k).a=FALSE
										Next
									EndIf
									If ap=FALSE Then
										ammor+=Int(level/2)
									Else
										ammor+=Int(level/4)
									EndIf
									Exit For
								EndIf
							EndIf
						Else
							If dist(a(i).x,a(i).y,b(j).x,b(j).y) < a(i).r + b(j).r Then
								a(i).a = FALSE
								If a(i).c=b(j).c Then
								FSOUND_PlaySound(FSOUND_FREE, game_sound(2))
								b(j).s = 0
								b(j).r = 4
								b(j).t = Timer
								bf(b(j).c)-=1
								If bf(b(j).c)=0 Then
									catch=0
									For k =1 To 15
										If bf(k)>catch Then
											catch=bf(k)
											b(0).c=k
										EndIf
									Next
									If catch=0 Then
										level+=1
									EndIf
									For k=0 To ammoc
										a(k).a=FALSE
									Next
								EndIf
								Exit For
								EndIf
							EndIf
						EndIf
					EndIf
				Next
				'bounce the ammo off the borders
				If a(i).x<0 Then
					If a(i).b=abc Then a(i).a=FALSE
					a(i).b+=1
					bid=a(i).d
					normal=0
					calc_bnd
					a(i).d=bnd
					a(i).x = a(i).r
				EndIf
				If a(i).x>bw Then
					If a(i).b=abc Then a(i).a=FALSE
					a(i).b+=1
					bid=a(i).d
					normal=180
					calc_bnd
					a(i).d=bnd
					a(i).x = bw - a(i).r
				EndIf
				If a(i).y<0 Then
					If a(i).b=abc Then a(i).a=FALSE
					a(i).b+=1
					bid=a(i).d
					normal=90
					calc_bnd
					a(i).d=bnd
					a(i).y = a(i).r
				EndIf
				If a(i).y>bh Then
					If a(i).b=abc Then a(i).a=FALSE
					a(i).b+=1
					bid=a(i).d
					normal=270
					calc_bnd
					a(i).d=bnd
					a(i).y = bh - a(i).r
				EndIf
			EndIf
		Next
		'draw emp
		If empa=TRUE Then
			For i=1 To empc
				emp(i).r+=5
				Circle (emp(i).x,emp(i).y),emp(i).r,emp(i).c
				If emp(1).r>=empd Then
					empa=FALSE
					empat=FALSE
					empc=0
				EndIf
				If empc=empcc Then empcut=TRUE
				
				If i>empcutc Then Exit For
			Next
			If empcut=TRUE Then empcutc-=1
		EndIf	
		ScreenUnLock
		're-activate caught balls when there's enough space for it
		For i=1 To bc
			If b(i).a=TRUE Then
				pass=TRUE
				b(i).r = Int(Rnd*20)+10
				For j=0 To bc
					If j<>i And b(j).s<>0 Then
						If dist(b(i).x,b(i).y,b(j).x,b(j).y)-6 < b(i).r+b(j).r Then
							pass=FALSE
							Exit For
						EndIf
					EndIf
				Next
				If pass=TRUE Then
					b(i).a=FALSE
					FSOUND_PlaySound(FSOUND_FREE, game_sound(3))
					b(i).s = Rnd*2+.3
					bf(b(i).c)+=1
					If ap=FALSE Then ammor+=1
					If ammor>ammors Then ammor=ammors
					timeout+=.001
				Else
					b(i).r = 4
				EndIf
			EndIf
		Next
		'detect key press
		Select Case InKey
			Case "e","E"
				If emps>0 And empa=FALSE Then
					FSOUND_PlaySound(FSOUND_FREE, game_sound(11))
					empa=TRUE
					empat=TRUE
					empx=b(0).x
					empy=b(0).y
					empct=b(0).c
					emps-=1
					empc=0
					empcut=FALSE
					empcutc=empcc
					If b(0).x<bw/2 Then
						If b(0).y<bh/2 Then
							empd=Sqr((bw-b(0).x)^2 + (bh-b(0).y)^2)
						Else
							empd=Sqr((bw-b(0).x)^2 + (b(0).y)^2)
						EndIf
					Else
						If b(0).y<bh/2 Then
							empd=Sqr((b(0).x)^2 + (bh-b(0).y)^2)
						Else
							empd=Sqr((b(0).x)^2 + (b(0).y)^2)
						EndIf
					EndIf
				EndIf
			Case Chr(27),Chr(255)+"k"
				FSOUND_Close
				ImageDestroy(img_splash)
				ImageDestroy(img_level)
				ImageDestroy(img_number_0)
				ImageDestroy(img_number_1)
				ImageDestroy(img_number_2)
				ImageDestroy(img_number_3)
				ImageDestroy(img_number_4)
				ImageDestroy(img_number_5)
				ImageDestroy(img_number_6)
				ImageDestroy(img_number_7)
				ImageDestroy(img_number_8)
				ImageDestroy(img_number_9)
				End
		End Select
		If MultiKey(SC_SPACE ) Then
			If ammor>0 Then
				If Timer>firet Then
					firet=Timer+.15
					For j=0 To multibursts-1
						For i=0 To ammoc
							If a(i).a = FALSE Then
								a(i).x=b(0).x
								a(i).y=b(0).y
								a(i).c=b(0).c
								a(i).s=6
								a(i).d=b(0).d+j*multibursts_degrees
								a(i).r=4
								a(i).a=TRUE
								a(i).b=0
								If ammor > 0 then ammor-=1
								If ammor=0 And ap=TRUE Then
									ammor=level*4
									ammors=ammor
									ap=FALSE
								EndIf
								If ap=TRUE Then
									FSOUND_PlaySound(FSOUND_FREE, game_sound(12))
								Else
									FSOUND_PlaySound(FSOUND_FREE, game_sound(10))
								EndIf
								Exit For
							EndIf
						Next
					Next
				EndIf
			EndIf
		EndIf
		If MultiKey(SC_LEFT ) Then
			b(0).d+=2.2
			If b(0).d > 360 Then b(0).d=0
		EndIf
		If MultiKey(SC_RIGHT) Then
			b(0).d-=2.2
			If b(0).d < 0 Then b(0).d=360
		EndIf
		If MultiKey(SC_UP   ) Then
			b(0).s+=.05
			If b(0).s>maxspeed Then b(0).s=maxspeed
		EndIf
		If MultiKey(SC_DOWN ) Then
			b(0).s-=.05
			If b(0).s < .1 Then b(0).s = .1
		EndIf
		delay .01
	Loop

Loop

End

Function dist(x1 As Double,y1 As Double,x2 As Double,y2 As Double) As Double
	Return sqr((x1-x2)^2 + (y1-y2)^2)
End Function

Function abtp(abtpx1 as Double,abtpy1 as Double,abtpx2 as Double,abtpy2 as Double) as Double
	Dim As Double angle
	angle=atan2(abtpy2-abtpy1,abtpx2-abtpx1)/pi*180
	If angle<0 then angle=360+angle
	Return angle
End Function

Sub delay(delay_sec As Double)
	Dim As Double dt=Timer
	Do
		Sleep 1
		If Timer> dt+delay_sec Then Exit Do
	Loop
End Sub

Sub calc_bnd()
	boid=bid
	rot=180-normal
	normal=(normal+rot) Mod 360
	bid=(bid+rot) Mod 360
	If bid<0 Then bid=360+bid
	Select Case bid
		Case 0 To 90
			bnd=180-bid
			bnd=(bnd-rot) Mod 360
			If bnd<0 Then bnd=360+bnd
		Case 270 To 360
			bnd=360-bid+180
			bnd=(bnd-rot) Mod 360
			If bnd<0 Then bnd=360+bnd
		Case Else
			bnd=boid
	End Select
End Sub



Sub bounce(ball_1 As Integer, ball_2 As Integer)
	Dim As Double b1xv,b1yv,b2xv,b2yv
	Dim As Double b1xnv,b1ynv,b2xnv,b2ynv
	Dim As Double b1nx,b1ny,b2nx,b2ny
	Dim As Double ball_1_a,ball_2_a
	Dim As Double speedin,speedout,s1,s2
	Dim As Double norm,normx,normy
	
	speedin=b(ball_1).s+b(ball_2).s
	b1xv=cos(b(ball_1).d*pi/180)*b(ball_1).s
	b1yv=sin(b(ball_1).d*pi/180)*b(ball_1).s
	b2xv=cos(b(ball_2).d*pi/180)*b(ball_2).s
	b2yv=sin(b(ball_2).d*pi/180)*b(ball_2).s
	ball_1_a=(pi*b(ball_1).r)^2
	ball_2_a=(pi*b(ball_2).r)^2
	If ball_1=0 Then ball_1_a*=2
	If ball_2=0 Then ball_2_a*=2
	
	norm=abtp(b(ball_2).x,b(ball_2).y,b(ball_1).x,b(ball_1).y)
	normx=Cos(norm*pi/180)
	normy=Sin(norm*pi/180)
	'set one ball to nearest non overlap position
	b(ball_1).x=b(ball_2).x+(b(ball_2).r+b(ball_1).r)*normx
	b(ball_1).y=b(ball_2).y+(b(ball_2).r+b(ball_1).r)*normy
	norm=abtp(b(ball_2).x,b(ball_2).y,b(ball_1).x,b(ball_1).y)
	'readjust norm x and y
	normx=Cos(norm*pi/180)
	normy=Sin(norm*pi/180)
	b1xnv=(((((normx*b1xv+normy*b1yv) * (ball_1_a - ball_2_a) + 2 * ball_2_a * (normx*b2xv+normy*b2yv))) / (ball_1_a + ball_2_a))*normx+(normy*-1*b1xv+normx*b1yv)*normy*-1)
	b1ynv=(((((normx*b1xv+normy*b1yv) * (ball_1_a - ball_2_a) + 2 * ball_2_a * (normx*b2xv+normy*b2yv))) / (ball_1_a + ball_2_a))*normy+(normy*-1*b1xv+normx*b1yv)*normx)
	b2xnv=(((((normx*b2xv+normy*b2yv) * (ball_2_a - ball_1_a) + 2 * ball_1_a * (normx*b1xv+normy*b1yv))) / (ball_1_a + ball_2_a))*normx+(normy*-1*b2xv+normx*b2yv)*normy*-1)
	b2ynv=(((((normx*b2xv+normy*b2yv) * (ball_2_a - ball_1_a) + 2 * ball_1_a * (normx*b1xv+normy*b1yv))) / (ball_1_a + ball_2_a))*normy+(normy*-1*b2xv+normx*b2yv)*normx)
	b1nx=b(ball_1).x+b1xnv
	b1ny=b(ball_1).y+b1ynv
	b2nx=b(ball_2).x+b2xnv
	b2ny=b(ball_2).y+b2ynv
	
	b(ball_1).d=abtp(b(ball_1).x,b(ball_1).y,b1nx,b1ny)
	b(ball_2).d=abtp(b(ball_2).x,b(ball_2).y,b2nx,b2ny)
	s1=Sqr(b1xnv^2+b1ynv^2)
	s2=Sqr(b2xnv^2+b2ynv^2)
	speedout=s1+s2
	b(ball_1).s=s1*speedin/speedout'*.987
	b(ball_2).s=s2*speedin/speedout'*.987
	If b(ball_1).s<.0000001 Then b(ball_1).s=.0000001
	If b(ball_2).s<.0000001 Then b(ball_2).s=.0000001
	
End Sub

dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Ball collisions

Post by dodicat »

I don't have the sound or bitmaps, so I got the bare bones balls ( or discs, since the mass is proportional to radius^2).
Your collisions seem perfect.
Absolutely no sense in changing this to anything else.
Sometimes after a few beers, things become clearer, but only sometimes.
dafhi
Posts: 1640
Joined: Jun 04, 2005 9:51

Re: Ball collisions

Post by dafhi »

I had the coolest insight with respect to which balls to compare. The smallest only needs to test against, at max, 6 other balls.
owen
Posts: 555
Joined: Apr 19, 2006 10:55
Location: Kissimmee, FL
Contact:

Re: Ball collisions

Post by owen »

what do you mean?
are you saying only possible for at a maximum that 6 other balls could fit in the area around the small ball?
dafhi
Posts: 1640
Joined: Jun 04, 2005 9:51

Re: Ball collisions

Post by dafhi »

my 'insight,' even though I've tackled this problem before, examines a fraction of the problem.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Ball collisions

Post by dodicat »

Six balls will fit around a ball of the same radius of each ball.
Less than six, the centre ball must have a smaller radius.
Greater than six, the centre ball will have a greater radius.

Code: Select all




sub circles(numballs as long,OutsideRadius as long,cx as long,cy as long)
    Dim As Double r,bigr,num,x,y,k=OutsideRadius, pi=4*atn(1)
  #define rad *pi/180  
  dim as long counter
  num= (45*(2*numballs-4)/numballs) rad
    num=Cos(num)
    r=num/(1+num)
    bigr=((1-r))*k  'radius to ring ball centres
    r=(r)*k         'radius of ring balls
    For z As Double=0 To 2*pi Step 2*pi/numballs
      counter+=1
    x=cx+bigr*Cos(z)
    y=cy+bigr*Sin(z)
    if counter>numballs then exit for
    Circle(x,y),r
    circle(cx,cy),OutsideRadius-r*2
Next z
end sub
screen 20

circles(6,200,512,350)
sleep 
Post Reply