## Ball collisions

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

### Re: Ball collisions

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: 433
Joined: Apr 19, 2006 10:55
Location: Kissimmee, FL
Contact:

### Re: Ball collisions

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)

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 DoubleDeclare Function abtp(abtpx1 as Double,abtpy1 as Double,abtpx2 as Double,abtpy2 as Double) as DoubleDeclare 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 timerEnd TypeType 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 activeEnd TypeType emp_obj   r As Integer'radius   c As Integer'color   x As Integer   y As Integer   'x,y coordinatesEnd TypeConst pi As Double = 4 * Atn(1)Const hippasus As Double = Sqr(2)Dim Shared As Integer bcDIM AS Integer game_sound(12)Dim As Integer i,j,k,bf(15),c,catch,level,bw,bh,game_level_valDim As BOOLEAN pass,fail,skipDim Shared As balls b()Dim As ammo a()Dim As Integer ammoc,ammor,ammors,abc,multibursts,multibursts_degreesDim As BOOLEAN apDim As String game_levelDim Shared As Double normal,rot,bid,bnd,boid,maxspeedDim As Integer b1d,b2d,sitDim As Double firet,timeoutDim As BOOLEAN empa,empat,empcutDim As Integer empc,emps,empm,empct,empcutc,empccempcc=60Dim As emp_obj emp(empcc)Dim As Double empx,empy,empdDim 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=600bh=600Randomize TimerScreenRes bw,bhWindow (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_splashBLoad "level.bmp", img_levelBLoad "0.bmp", img_number_0BLoad "1.bmp", img_number_1BLoad "2.bmp", img_number_2BLoad "3.bmp", img_number_3BLoad "4.bmp", img_number_4BLoad "5.bmp", img_number_5BLoad "6.bmp", img_number_6BLoad "7.bmp", img_number_7BLoad "8.bmp", img_number_8BLoad "9.bmp", img_number_9Put (0,bh), img_splashDraw 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=1abc=1level=6maxspeed=5delay 4Randomize TimerDo   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   LoopLoopEndFunction dist(x1 As Double,y1 As Double,x2 As Double,y2 As Double) As Double   Return sqr((x1-x2)^2 + (y1-y2)^2)End FunctionFunction 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 angleEnd FunctionSub delay(delay_sec As Double)   Dim As Double dt=Timer   Do      Sleep 1      If Timer> dt+delay_sec Then Exit Do   LoopEnd SubSub 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 SelectEnd SubSub 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: 4632
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Ball collisions

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).
Absolutely no sense in changing this to anything else.
Sometimes after a few beers, things become clearer, but only sometimes.
dafhi
Posts: 976
Joined: Jun 04, 2005 9:51

### Re: Ball collisions

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: 433
Joined: Apr 19, 2006 10:55
Location: Kissimmee, FL
Contact:

### Re: Ball collisions

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: 976
Joined: Jun 04, 2005 9:51

### Re: Ball collisions

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

### Re: Ball collisions

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*2Next zend subscreen 20circles(6,200,512,350)sleep `