## Ball collisions

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

### Re: Ball collisions

in an attempt to learn how to bounce balls i decided to give h4tt3n's rework of vobarian's work a try.

I have a real hard time seeing the big picture with too much oop.
so i broke it all down and re worked h4tt3n's rework of vobarian's work.

in this example i do use oop for the balls but not the vectors (in other words vectorx is vextorx not v.x but ballx is b.x)

in my mind, in order to see the big picture i think a ball as an angular direction, i have a hard time thinking in radians so i use 360 degrees to represent the direction a ball is going. then of course there's speed, if the speed is 1 and the direction is 0 degrees the ball will move 1 on the x axis and 0 on the y. if the direction is 45 degrees then the ball will move to x = 0.7 and y = 0.7. Also a ball has mass which i simply convert it from the ball's area. pi*r^2. In my example game (freeze tag) i set the main ball (the ball you move around) mass to 3 times that of the others so it is simpler to control.

the game, source code, exe, pics and sound files are at fbcadcam.com/freezetag/freeze-tag.zip

here is my rework of vorbarian's work. see the sub routine at the bottom called bounce.

Code: Select all

`#include "fbgfx.bi"#If __FB_LANG__ = "fb"Using FB '' Scan code constants are stored in the FB namespace in lang 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,d   As Double s,x,y,t   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,timeout,bw,bh,game_level_valDim As BOOLEAN pass,fail,skipDim Shared As balls b()Dim As ammo a()Dim As Integer ammoc,ammor,ammors,abcDim As BOOLEAN apDim As String game_levelDim Shared As Double normal,rot,bid,bnd,boid,maxspeedDim As Integer b1d,b2d,sitDim As Double firetDim 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,rip_apart,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=13maxspeed=5delay 4ReDim b(50)Randomize TimerDo   emps=3   empm=3   empa=FALSE   empat=FALSE   empc=0   If level>19 Then      ammor=level      ap=TRUE   Else      ammor=level*4   EndIf   ammors=ammor   ammoc=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   timeout=level*2   If timeout>30 Then timeout=30   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 = 30'Int(Rnd*20)+10      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+.3         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                           b(i).x+=Cos((b(i).d+180)*pi/180)*b(i).s                           b(i).y+=Sin((b(i).d+180)*pi/180)*b(i).s                           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                           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                           rip_apart=abtp(b(i).x,b(i).y,b(j).x,b(j).y)                           b(j).x+=cos(rip_apart*pi/180)*b(j).s                           b(j).y+=sin(rip_apart*pi/180)*b(j).s                           rip_apart+=180                           b(i).x+=Cos(rip_apart*pi/180)*b(i).s                           b(i).y+=Sin(rip_apart*pi/180)*b(i).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                           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                                    empat=FALSE                                 EndIf                              Next                              If catch=0 Then                                 level+=1                              EndIf                              For k=0 To ammoc                                 a(k).a=FALSE                              Next                           EndIf                        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+=level                        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+=1                           ammor+=1                           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            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 i=0 To ammoc                  If a(i).a = FALSE Then                     If ap=TRUE Then                        FSOUND_PlaySound(FSOUND_FREE, game_sound(12))                     Else                        FSOUND_PlaySound(FSOUND_FREE, game_sound(10))                     EndIf                                          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                     a(i).r=4                     a(i).a=TRUE                     a(i).b=0                     ammor-=1                     If ammor=0 And ap=TRUE Then                        ammor=level*4                        ammors=ammor                        ap=FALSE                     EndIf                     Exit For                  EndIf               Next            EndIf         EndIf      EndIf      If MultiKey(SC_LEFT ) Then         b(0).d+=2         If b(0).d > 360 Then b(0).d=0      EndIf      If MultiKey(SC_RIGHT) Then         b(0).d-=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 ball_1_x_v,ball_1_y_v,ball_2_x_v,ball_2_y_v   Dim As Double ball_1_x_nv,ball_1_y_nv,ball_2_x_nv,ball_2_y_nv   Dim As Double b1nx,b1ny,b2nx,b2ny   Dim As Double ball_1_a,ball_2_a   Dim As Double v_n_x,v_n_y   Dim As Double v_un_x,v_un_y,v_ut_x,v_ut_y   Dim As Double v1n,v2n,v1t,v2t   Dim As Double v1np,v2np,v1tp,v2tp   Dim As Double speedin,speedout,s1,s2   speedin=b(ball_1).s+b(ball_2).s   ball_1_x_v=cos(b(ball_1).d*pi/180)*b(ball_1).s   ball_1_y_v=sin(b(ball_1).d*pi/180)*b(ball_1).s   ball_2_x_v=cos(b(ball_2).d*pi/180)*b(ball_2).s   ball_2_y_v=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*=3   If ball_2=0 Then ball_2_a*=3   v_n_x = b(ball_2).x-b(ball_1).x   v_n_y = b(ball_2).y-b(ball_1).y   v_un_x=v_n_x/Sqr((v_n_x)^2)   v_un_y=v_n_y/Sqr((v_n_y)^2)   v_ut_x=v_un_y*-1   v_ut_y=v_un_x   v1n=v_un_x*ball_1_x_v+v_un_y*ball_1_y_v   v1t=v_ut_x*ball_1_x_v+v_ut_y*ball_1_y_v   v2n=v_un_x*ball_2_x_v+v_un_y*ball_2_y_v   v2t=v_ut_x*ball_2_x_v+v_ut_y*ball_2_y_v   v1np=((v1n * (ball_1_a - ball_2_a) + 2 * ball_2_a * v2n)) / (ball_1_a + ball_2_a)   v2np=((v2n * (ball_2_a - ball_1_a) + 2 * ball_1_a * v1n)) / (ball_1_a + ball_2_a)   v1tp=v1t   v2tp=v2t   ball_1_x_nv=(v1np*v_un_x+v1tp*v_ut_x)   ball_1_y_nv=(v1np*v_un_y+v1tp*v_ut_y)   ball_2_x_nv=(v2np*v_un_x+v2tp*v_ut_x)   ball_2_y_nv=(v2np*v_un_y+v2tp*v_ut_y)   b1nx=b(ball_1).x+ball_1_x_nv   b1ny=b(ball_1).y+ball_1_y_nv   b2nx=b(ball_2).x+ball_2_x_nv   b2ny=b(ball_2).y+ball_2_y_nv   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(ball_1_x_nv^2+ball_1_y_nv^2)   s2=Sqr(ball_2_x_nv^2+ball_2_y_nv^2)   speedout=s1+s2   b(ball_1).s=s1/speedout*speedin*.987   b(ball_2).s=s2/speedout*speedin*.987   'If ball_1<>0 Or ball_2<>0 Then   'b(ball_1).s-=.1   'b(ball_2).s-=.1   'EndIf   If b(ball_1).s<.0001 Then b(ball_1).s=.0001   If b(ball_2).s<.0001 Then b(ball_2).s=.0001   End Sub`
owen
Posts: 433
Joined: Apr 19, 2006 10:55
Location: Kissimmee, FL
Contact:

### Re: Ball collisions

here is a simpler example similar to vorbarian's

Code: Select all

`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 bounce(ball_1 As Integer, ball_2 As Integer)Declare Sub calc_bnd()Const Pi = 4*Atn(1)Type balls   As Integer r,d   As Double s,x,y,c   'x,y coordinates   'c color   'r radius   'd direction in degrees: 0 degrees is at 3 O'clock, 90 degrees is at 12   's speedEnd TypeDim Shared As balls b(5)Dim As Integer i,j,k,bw,bhDim As Double rip_apartDim Shared As Double normal,rot,bid,bnd,boid',maxspeed''  screen settingsbw = 600          ''  screen widthbh = 400          ''  screen heightscreenres bw, bh, 16With b(1)  .r = 20  .x = 100  .y = 200  .c = RGB(255, 32, 32)  .s = 3  .d = 0End WithWith b(2)  .r = 25  .x = 200  .y = 200  .c = RGB(255, 32, 255)  .s = 3  .d = 0End WithWith b(3)  .r = 30  .x = 300  .y = 200  .c = RGB(32, 32, 255)  .s = 3  .d = 0End WithWith b(4)  .r = 35  .x = 400  .y = 200  .c = RGB(32, 255, 32)  .s = 3  .d = 0End WithWith b(5)  .r = 40  .x = 500  .y = 200  .c = RGB(255, 255, 32)  .s = 3  .d = 0End WithDo   Screenlock       Cls         For i=1 To 5         '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            'bounce the balls off each other            For j=1 To 5               If j<>i Then                  If dist(b(i).x,b(i).y,b(j).x,b(j).y)<=b(i).r+b(j).r Then                     b(i).x+=Cos((b(i).d+180)*pi/180)*b(i).s                     b(i).y+=Sin((b(i).d+180)*pi/180)*b(i).s                     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                     bounce(i,j)                     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                     rip_apart=abtp(b(i).x,b(i).y,b(j).x,b(j).y)                     b(j).x+=cos(rip_apart*pi/180)*b(j).s                     b(j).y+=sin(rip_apart*pi/180)*b(j).s                     rip_apart+=180                     b(i).x+=Cos(rip_apart*pi/180)*b(i).s                     b(i).y+=Sin(rip_apart*pi/180)*b(i).s                     Exit For                  EndIf               EndIf            Next         '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         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         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         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         EndIf         'draw circles         Circle (b(i).x,b(i).y),b(i).r,b(i).c,,,,f      Next     screenunlock   Sleep 1    If InKey=Chr(27) Then Exit DoLoopEnd'-------------------------------------------------------------------------------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 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 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 ball_1_x_v,ball_1_y_v,ball_2_x_v,ball_2_y_v   Dim As Double ball_1_x_nv,ball_1_y_nv,ball_2_x_nv,ball_2_y_nv   Dim As Double b1nx,b1ny,b2nx,b2ny   Dim As Double ball_1_a,ball_2_a   Dim As Double v_n_x,v_n_y   Dim As Double v_un_x,v_un_y,v_ut_x,v_ut_y   Dim As Double v1n,v2n,v1t,v2t   Dim As Double v1np,v2np,v1tp,v2tp   Dim As Double speedin,speedout,s1,s2   speedin=b(ball_1).s+b(ball_2).s   ball_1_x_v=cos(b(ball_1).d*pi/180)*b(ball_1).s   ball_1_y_v=sin(b(ball_1).d*pi/180)*b(ball_1).s   ball_2_x_v=cos(b(ball_2).d*pi/180)*b(ball_2).s   ball_2_y_v=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   v_n_x = b(ball_2).x-b(ball_1).x   v_n_y = b(ball_2).y-b(ball_1).y   v_un_x=v_n_x/Sqr((v_n_x)^2)   v_un_y=v_n_y/Sqr((v_n_y)^2)   v_ut_x=v_un_y*-1   v_ut_y=v_un_x   v1n=v_un_x*ball_1_x_v+v_un_y*ball_1_y_v   v1t=v_ut_x*ball_1_x_v+v_ut_y*ball_1_y_v   v2n=v_un_x*ball_2_x_v+v_un_y*ball_2_y_v   v2t=v_ut_x*ball_2_x_v+v_ut_y*ball_2_y_v   v1np=((v1n * (ball_1_a - ball_2_a) + 2 * ball_2_a * v2n)) / (ball_1_a + ball_2_a)   v2np=((v2n * (ball_2_a - ball_1_a) + 2 * ball_1_a * v1n)) / (ball_1_a + ball_2_a)   v1tp=v1t   v2tp=v2t   ball_1_x_nv=(v1np*v_un_x+v1tp*v_ut_x)   ball_1_y_nv=(v1np*v_un_y+v1tp*v_ut_y)   ball_2_x_nv=(v2np*v_un_x+v2tp*v_ut_x)   ball_2_y_nv=(v2np*v_un_y+v2tp*v_ut_y)   b1nx=b(ball_1).x+ball_1_x_nv   b1ny=b(ball_1).y+ball_1_y_nv   b2nx=b(ball_2).x+ball_2_x_nv   b2ny=b(ball_2).y+ball_2_y_nv   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(ball_1_x_nv^2+ball_1_y_nv^2)   s2=Sqr(ball_2_x_nv^2+ball_2_y_nv^2)   speedout=s1+s2   b(ball_1).s=s1/speedout*speedin*.987   b(ball_2).s=s2/speedout*speedin*.987   'If ball_1<>0 Or ball_2<>0 Then   'b(ball_1).s-=.1   'b(ball_2).s-=.1   'EndIf   If b(ball_1).s<.0001 Then b(ball_1).s=.0001   If b(ball_2).s<.0001 Then b(ball_2).s=.0001   End Sub`
owen
Posts: 433
Joined: Apr 19, 2006 10:55
Location: Kissimmee, FL
Contact:

### Re: Ball collisions

i have a hard time understanding vector math which is why i converted vorbarians / h4tt3n's work to non oop.

now that i can see the algorithm all together in a few lines instead of spread out in oop, perhaps i will be able to wrap my head around it.

perhaps i will be able to see it and explain it in laymen terms. but at the moment i am still thinking about it.

all the explanations i read about this subject have explanations which use vector math. effectively they say things like well you go to do this and that and then "Normalize the dot product" as relsoft would say...

and i really appreciate what has been contributed so far but i feel like an old dog that can't learn a new trick.

at the moment, my rework of the algo seems to be working fine.
in order to address possible over lap i re position the two colliding balls to where they were just prior to the detected moment of collision.

Code: Select all

`                  If dist(b(i).x,b(i).y,b(j).x,b(j).y)<=b(i).r+b(j).r Then                     b(i).x+=Cos((b(i).d+180)*pi/180)*b(i).s                     b(i).y+=Sin((b(i).d+180)*pi/180)*b(i).s                     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                     bounce(i,j)                     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                     rip_apart=abtp(b(i).x,b(i).y,b(j).x,b(j).y)                     b(j).x+=cos(rip_apart*pi/180)*b(j).s                     b(j).y+=sin(rip_apart*pi/180)*b(j).s                     rip_apart+=180                     b(i).x+=Cos(rip_apart*pi/180)*b(i).s                     b(i).y+=Sin(rip_apart*pi/180)*b(i).s                     Exit For                  EndIf`

then after bounce(i,j)
i set the two balls x,y to their new locations
then i rip them apart a bit (separate them) in order to avoid the stick situation which effectively results in the two balls spinning around one another rather then bouncing off and heading in their new trajectories. ripping them apart each in the opposite relative direction. the relative direction to separate them has nothing to do with what direction they were heading in. any how it is subtle but does cause a bit of a glitch (unless you look at it under a microscope)

the stuff happening in the bounce routine for the most part i am still studying.
but at the end of the bounce routine, i adjust the speed of algo's output.
the idea of an elastic collision where no energy is lost is the combined speed in equals the combined speed out.

Code: Select all

`   s1=Sqr(ball_1_x_nv^2+ball_1_y_nv^2)   s2=Sqr(ball_2_x_nv^2+ball_2_y_nv^2)   speedout=s1+s2   b(ball_1).s=s1/speedout*speedin*.987   b(ball_2).s=s2/speedout*speedin*.987`

the bit at the bottom which is commented out just slows the balls down a bit in my game.

Code: Select all

`   'If ball_1<>0 Or ball_2<>0 Then   'b(ball_1).s-=.1   'b(ball_2).s-=.1   'EndIf`

when i move around (using the up arrow key to accelerate), acceleration adds energy to the ball you collide with. this additional energy effectively gets spread out among all the balls as they eventually collide with one another, so much so that unless i slow them down they would keep bouncing around to fast to play the game.

interesting to run that last simplified example for 10 minutes or so. the balls slow down on their own (without forcing them to slow down). this must be due to accumulative precision loss in the algo.
dafhi
Posts: 976
Joined: Jun 04, 2005 9:51

### Re: Ball collisions

cool. i researched inelastic circle collisions once. the one piece i was missing was "completing the square"

if you can run gfx32, this will do aa

replace

Code: Select all

`''  screen settingsbw = 600          ''  screen widthbh = 400          ''  screen heightscreenres bw, bh, 16`

with

Code: Select all

`type imagevars '2017 Aug 31 - by dafhi  '1. quick reference for ScreenInfo & ImageInfo  '2. encapsulate standard metrics  '3. convenient additional vars, subs and functions  as integer            w,h, bpp,bypp,pitch, rate  as string             driver_name  as any ptr            im  as any ptr            pixels    'same address  as ulong ptr          p32       '  as single             midx,midy  as integer            pitchBy, wm = -1, hm = -1, ub = -1, is_screen  declare sub           screen_init(w as integer=0, h as integer=0, bpp as integer=32, npages as integer=1, flags as integer=0)  declare sub           create(w as integer=0, h as integer=0, col as ulong=&HFF000000)                        '2017 Aug 17  declare sub           get_info(im as any ptr=0)  declare               destructor  declare sub           release private:  declare sub           destroy  as any ptr            hReleaseend typeDestructor.imagevars:  releaseEnd Destructorsub imagevars.release                             '2016 Aug 30  w=0: h=0: bpp=0: bypp=0: im=0: pixels=0  If ImageInfo(hRelease) = 0 Then ImageDestroy hRelease:  hRelease = 0End Subsub imagevars.get_info(im as any ptr)  if im=0 then    ScreenInfo w,h, bpp, bypp, pitch, rate, driver_name:  pixels=screenptr    is_screen = -1: im=0  elseif Imageinfo(im)=0 then    ImageInfo im, w, h, bypp, pitch, pixels:  bpp = bypp * 8    this.im = im:  is_screen = 0  endif: hRelease = im:  p32=pixels  wm=w-1:  midx=w/2:  pitchBy=pitch/bypp '' crashes if \ and bypp = 0  hm=h-1:  midy=h/2:  ub = h*pitchBy - 1end subsub imagevars.screen_init(w as integer, h as integer, bpp as integer, npages as integer, flags as integer)  release '2017 July 3  if w=0 or h=0 then get_info: w=this.w: h=this.h  screenres w,h,bpp,npages,flags: pixels = screenptr  get_info:  if npages > 1 then screenset 0,1end subsub imagevars.create(_w as integer, _h as integer, col as ulong)  release:  get_info imagecreate(_w,_h,col)End Sub#Macro Alpha256(ret,back, fore, a256) '2017 Mar 26  ret=((_  (fore And &Hff00ff) * a256 + _  (back And &Hff00ff) * (256-a256) + &H800080) And &Hff00ff00 Or (_  (fore And &H00ff00) * a256 + _  (back And &H00ff00) * (256-a256) + &H008000) And &H00ff0000) Shr 8#EndMacrotype dotvars  as ulong            col=-1  as single           rad=1,slope=1End Typetype AaDot  as dotvars          o  as dotvars ptr      p  declare sub         render_target(byref buf as imagevars)  declare sub         draw(x as single=0, y as single=0)  declare constructor private:  as single           dy,dxLeft,salpha,cone_h,coneSq,sq  as long             x0,y0,x1,y1,alph,alpha_max  as imagevars ptr    pimend typeconstructor.AaDot: p=@oend constructorsub AaDot.render_target(byref buf as imagevars)  pim = @bufend subsub AaDot.draw(x as single, y as single)  salpha=(p->col shr 24)/255:  alpha_max=salpha*256  var slope = p->slope    'slope = 1 .. 1 pixel aa edge  'slope = 2 .. 1/2 pixel (sharp)  'slope = 1/p->rad .. max blur  'slope < 1/p->rad .. rendering artifact    sq=1/p->rad                   '' clamp prevents artifact  slope=iif(slope<sq,sq,slope)  ''    cone_h=slope*p->rad     'pre-inverted aadot imagined as side-viewed cone \/  coneSq=cone_h*cone_h    'avoid sqr() at blit corners  sq=(cone_h-1)*(cone_h-1)'avoid sqr() in dot center at max brightness    dim as long x0=x-p->rad:  if x0<0 then x0=0  dim as long y0=y-p->rad:  if y0<0 then y0=0  dim as long x1=x+p->rad:  if x1>pim->wm then x1=pim->wm  dim as long y1=y+p->rad:  if y1>pim->hm then y1=pim->hm  dy=(y0-y)*slope: dxLeft=(x0-x)*slope    for py as long ptr = @pim->p32[ y0*pim->pitchBy ] to @pim->p32[ y1*pim->pitchBy ] step pim->pitchBy    dim as single dx=dxleft, dySq=dy*dy    for px as ulong ptr = @py[x0] to @py[x1]      salpha = dx*dx+dySq      if salpha<sq then          Alpha256(*px,*px,p->col,alpha_max)      elseif salpha<=coneSq then          alph=(cone_h-sqr(salpha))*alpha_max          Alpha256(*px,*px,p->col,alph)      endif:  dx+=slope    next: dy+=slope  nextend sub''  screen settingsbw = 600          ''  screen widthbh = 400          ''  screen heightdim as imagevars  buf:  buf.screen_init bw,bhdim as aadot dot:  dot.render_target buf`

and then

Code: Select all

`         'Circle (b(i).x,b(i).y),b(i).r,b(i).c,,,,f         with b(i)         dot.o.rad = .r         dot.o.col = .c         dot.draw .x,.y         end with`
Last edited by dafhi on Sep 01, 2017 7:56, edited 1 time in total.
dodicat
Posts: 4633
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Ball collisions

Without any outside energy pumping.
The kinetic energy of a system should be constant (in practice, fluctuate, but keep a constant average with elastic collisions)
and
The balls should not leak out of the screen.
These vector collisions are hopefully arithmetically correct, but because a computer uses digital jumps, whereas in reality a smooth motion prevails, there is always a chance a ball could go off screen.
So I have added a check function for this.
Also your demo is very nice.

Code: Select all

`Screen 20,32Dim Shared As Integer xres,yresScreeninfo xres,yresType v2D    As Single x,y    Declare function length As Single    Declare function unit As v2D    #define vct Type<v2D>    #define dot *End TypeType line    As v2D v1,v2End TypeType _object    As v2D position,velocity    As Single mass,radius    as ulong colourEnd TypeOperator + (v1 As v2D,v2 As v2D) As v2DReturn vct(v1.x+v2.x,v1.y+v2.y)End OperatorOperator -(v1 As v2D,v2 As v2D) As v2DReturn vct(v1.x-v2.x,v1.y-v2.y)End OperatorOperator * (f As Single,v1 As v2D) As v2D 'scalar*v2DReturn vct(f*v1.x,f*v1.y)End OperatorOperator * (v1 As v2D,v2 As v2D) As Single 'dot productReturn v1.x*v2.x+v1.y*v2.yEnd Operatorfunction v2D.length As SingleReturn Sqr(this.x*this.x+this.y*this.y)End functionfunction v2D.unit As v2DDim n As Single=this.lengthIf n=0 Then n=1e-20Return vct(this.x/n,this.y/n)End function'=========== VARIABLES ==============================Redim  As _object ball()dim  as line Ln(1 to 8)'the central boxln(1)=type<line>(vct(.5*xres,.3*yres),vct(.65*xres,.5*yres))ln(2)=type<line>(vct(.65*xres,.5*yres),vct(.5*xres,.7*yres))ln(3)=type<line>(vct(.5*xres,.7*yres),vct(.35*xres,.5*yres))ln(4)=type<line>(vct(.35*xres,.5*yres),vct(.5*xres,.3*yres))'the screen edgesln(5)=type<line>(vct(0,yres),vct(xres,yres))'baseln(6)=type<line>(vct(xres,0),vct(xres,yres))'rightln(7)=type<line>(vct(0,0),vct(0,yres))'leftln(8)=type<line>(vct(0,0),vct(xres,0))'top'================ subs and macros =====================#define rr(f,l) (Rnd*(l-f)+f)#define incircle(cx,cy,radius,x,y) (cx-x)*(cx-x) +(cy-y)*(cy-y)<= radius*radius    Sub setup(ball() as _object,num As long)        Dim As long count        Dim As v2D ppos        For n As long=1 To num            ppos=vct(rr(30,(xres-30)),rr(30,(yres-30)))                if incircle((xres/2),(yres/2),.2*yres,ppos.x,ppos.y)=0 then                count=count+1                Redim Preserve ball(1 To count)                ball(count).position=ppos                ball(count).radius=rr(10,30)                ball(count).mass=ball(count).radius^2                ball(count).velocity=2*(vct(rr(-1,1),rr(-1,1))).unit                ball(count).colour=Rgb(50+Rnd*205,50+Rnd*205,50+Rnd*205)            End If        Next     End Sub        sub drawlines(z() as line)        for n as long=lbound(z) to 4            line(z(n).v1.x,z(n).v1.y)-(z(n).v2.x,z(n).v2.y)            next n    end sub        Function segment_distance(l As line,p As v2D,Byref ip As v2D=vct(0,0)) As Single                          Dim As Single M1,M2,C1,C2,B             B=(l.v2.x-l.v1.x):If B=0 Then B=1e-20             M2=(l.v2.y-l.v1.y)/B:If M2=0 Then M2=1e-20             M1=-1/M2             C1=p.y-M1*p.x             C2=(l.v1.y*l.v2.x-l.v1.x*l.v2.y)/B    var L1=((p.x-l.v1.x)*(p.x-l.v1.x)+(p.y-l.v1.y)*(p.y-l.v1.y)),L2=((p.x-l.v2.x)*(p.x-l.v2.x)+(p.y-l.v2.y)*(p.y-l.v2.y))    var a=((l.v1.x-l.v2.x)*(l.v1.x-l.v2.x) + (l.v1.y-l.v2.y)*(l.v1.y-l.v2.y))        var a1=a+L1        var a2=a+L2        var f1=a1>L2,f2=a2>L1         If f1 Xor f2 Then     var d1=((p.x-l.v1.x)*(p.x-l.v1.x)+(p.y-l.v1.y)*(p.y-l.v1.y))    var d2=((p.x-l.v2.x)*(p.x-l.v2.x)+(p.y-l.v2.y)*(p.y-l.v2.y))    If d1<d2 Then ip.x=l.v1.x:ip.y=l.v1.y : Return Sqr(d1) Else  ip.x=l.v2.x:ip.y=l.v2.y:Return Sqr(d2)End Ifvar M=M1-M2:if M=0 then M=1e-20    ip.x=(C2-C1)/(M1-M2)    ip.y=(M1*C2-M2*C1)/M    Return Sqr((p.x-ip.x)*(p.x-ip.x)+(p.y-ip.y)*(p.y-ip.y))  End Function  Function DetectBallCollisions(Byref _that As _object,_this As _object) As Single    Dim As Single xdiff = _this.position.x-_that.position.x    Dim As Single ydiff = _this.position.y-_that.position.y    If Abs(xdiff) > (_this.radius+_that.radius) Then Return 0    If Abs(ydiff) > (_this.radius+_that.radius) Then Return 0    var L=Sqr(xdiff*xdiff+ydiff*ydiff)    If L<=(_this.radius+_that.radius) Then Function=LEnd FunctionSub check_ball_to_ball_collisions(ball() as _object)    For x As long=lbound(ball) To Ubound(ball)-1        For y As long=x+1 To Ubound(ball)               if DetectBallCollisions(ball(x),ball(y)) then            var impulse=(ball(x).position-ball(y).position).unit                'put ball into real physical location                ball(x).position=ball(y).position+(ball(x).radius+ball(y).radius)*impulse                var impact=ball(x).velocity-ball(y).velocity                var dv=impact dot impulse                var ma=ball(x).mass: var mb=ball(y).mass                ball(x).velocity=ball(x).velocity-dv*((2*mb/(ma+mb)))*impulse                ball(y).velocity=ball(y).velocity+dv*((2*ma/(mb+ma)))*impulse            End If        Next y    Next xEnd Subsub check_ball_to_line_collisions(Ball() as _object,Ln() as line)For z As long=lbound(ball) To Ubound(ball)    For z2 As long=lbound(Ln) To Ubound(Ln)        dim as v2D closepoint,test        var seperation=segment_distance(Ln(z2),ball(z).position,closepoint)        If seperation<=ball(z).radius Then            var impact=-1*ball(z).velocity            var impulse=(closepoint-ball(z).position).unit            'put ball into real physical location            ball(z).position=closepoint-(ball(z).radius)*impulse                var dv=(impact dot impulse)                 ball(z).velocity=ball(z).velocity+2*dv*impulse             End If    Next z2Next zend subfunction AllIn(b() as _object) as long    for n as long=lbound(b) to ubound(b)        if b(n).position.x<0 or b(n).position.x>xres then return 0          if b(n).position.y<0 or b(n).position.y>yres then return 0        next        return 1    end functionSub drawballs(ball() as _object,Byref ke As long,fps as long)    For n As long=1 To Ubound(ball)        ball(n).position=ball(n).position+ball(n).velocity        ke=ke+.5*ball(n).mass*ball(n).velocity*ball(n).velocity' kinetic energy        Circle (ball(n).position.x,ball(n).position.y),ball(n).radius,ball(n).colour,,,,f    Next n    Draw String(10,10), " Number= "  & Ubound(ball) & ",  Kinetic energy " & ke    Draw String(10,30), "FPS  "  & fps    Draw String(10,50), "STATUS:  "  & iif(AllIn(ball()),"OK","Escapees")End SubFunction Regulate(Byval MyFps As long,Byref fps As long) As long    Static As Double timervalue,lastsleeptime,t3,frames    frames+=1    If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0    Var sleeptime=lastsleeptime+((1/myfps)-Timer+timervalue)*1000    If sleeptime<1 Then sleeptime=1    lastsleeptime=sleeptime    timervalue=Timer    Return sleeptimeEnd Functionsetup(ball(),80)Dim As String idim as long fpsDo      check_ball_to_line_collisions(ball(),Ln())    check_ball_to_ball_collisions(ball())        var    ke=0    i=Inkey    Screenlock    Cls        drawballs(ball(),ke,fps)    drawlines(ln())'only the inner box        Screenunlock    Sleep regulate(60,fps),1Loop Until I=Chr(27)'print tallySleep  `
dafhi
Posts: 976
Joined: Jun 04, 2005 9:51

### Re: Ball collisions

I also considered mass. Nice. I see it's the classic circle against every other circle test, also like I did.

I'm sensing fun to be had. Like quicksort's divide-and-conquer strategy which I haven't fully wrapped my head around, there could be a similar approach to this problem.
owen
Posts: 433
Joined: Apr 19, 2006 10:55
Location: Kissimmee, FL
Contact:

### Re: Ball collisions

@ dodicat
WOW

@ dafhi
dafhi
Posts: 976
Joined: Jun 04, 2005 9:51

### Re: Ball collisions

anti-aliased circles
owen
Posts: 433
Joined: Apr 19, 2006 10:55
Location: Kissimmee, FL
Contact:

### Re: Ball collisions

oh, ok.
thanks that might come in handy for my ammo and emp level indicators.
owen
Posts: 433
Joined: Apr 19, 2006 10:55
Location: Kissimmee, FL
Contact:

### Re: Ball collisions

i think this will be my last update to the bounce algo.
while breaking it down i noticed there were multiple pieces that basically represented a negative or positive sqr(2)

so this is how it looks now.
ps i call the sqr(2) hippasus

Code: Select all

`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 hippasus_x,hippasus_y      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   Select Case b(ball_2).x-b(ball_1).x      Case 0         hippasus_x=0      Case Is > 0         hippasus_x=hippasus      Case Is < 0         hippasus_x=hippasus*-1   End Select   Select Case b(ball_2).y-b(ball_1).y      Case 0         hippasus_y=0      Case Is > 0         hippasus_y=hippasus      Case Is < 0         hippasus_y=hippasus*-1   End Select      b1xnv=(((((hippasus_x*b1xv+hippasus_y*b1yv) * (ball_1_a - ball_2_a) + 2 * ball_2_a * (hippasus_x*b2xv+hippasus_y*b2yv))) / (ball_1_a + ball_2_a))*hippasus_x+(hippasus_y*-1*b1xv+hippasus_x*b1yv)*hippasus_y*-1)   b1ynv=(((((hippasus_x*b1xv+hippasus_y*b1yv) * (ball_1_a - ball_2_a) + 2 * ball_2_a * (hippasus_x*b2xv+hippasus_y*b2yv))) / (ball_1_a + ball_2_a))*hippasus_y+(hippasus_y*-1*b1xv+hippasus_x*b1yv)*hippasus_x)   b2xnv=(((((hippasus_x*b2xv+hippasus_y*b2yv) * (ball_2_a - ball_1_a) + 2 * ball_1_a * (hippasus_x*b1xv+hippasus_y*b1yv))) / (ball_1_a + ball_2_a))*hippasus_x+(hippasus_y*-1*b2xv+hippasus_x*b2yv)*hippasus_y*-1)   b2ynv=(((((hippasus_x*b2xv+hippasus_y*b2yv) * (ball_2_a - ball_1_a) + 2 * ball_1_a * (hippasus_x*b1xv+hippasus_y*b1yv))) / (ball_1_a + ball_2_a))*hippasus_y+(hippasus_y*-1*b2xv+hippasus_x*b2yv)*hippasus_x)   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/speedout*speedin*.987   b(ball_2).s=s2/speedout*speedin*.987   If b(ball_1).s<.0001 Then b(ball_1).s=.0001   If b(ball_2).s<.0001 Then b(ball_2).s=.0001   End Sub`
dodicat
Posts: 4633
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Ball collisions

Looks good owen.
Here's my last, no vector operators and simpler,
Attenuation is done on .dx and .dy, either in the open (friction) -- sub moveanddraw, or in sub BallCollisions (restitution), which I left blank,

(It's alright, I looked up attenuation and restitution)
Aso line 52/53 lets the balls wriggle themselves free if they start their journey from the same point.

Code: Select all

`  type ball   x as single    'position x component   y as single    'position y component   dx as single   'velocity x component   dy as single   'velocity y component   col as uLong   'colour    as Long r,m    'radius, massend type sub MoveAndDraw( b() as ball,byref e as Long)'get energy also    for n as Long=lbound(b) to ubound(b)           ' b(n).dx=.995*b(n).dx    'b(n).dy=.995*b(n).dy       b(n).x+=b(n).dx:b(n).y+=b(n).dy    circle(b(n).x,b(n).y),b(n).r,b(n).col,,,,f    e+=.5*b(n).m*(b(n).dx*b(n).dx + b(n).dy*b(n).dy)    next nend sub sub edges(b() as ball,xres as Long,yres as Long,byref status as Long ) 'get status also    for n as Long=lbound(b) to ubound(b)    if(b(n).x<b(n).r) then b(n).x=b(n).r: b(n).dx=-b(n).dx    if(b(n).x>xres-b(n).r )then b(n).x=xres-b(n).r: b(n).dx=-b(n).dx    if(b(n).y<b(n).r)then b(n).y=b(n).r:b(n).dy=-b(n).dy    if(b(n).y>yres-b(n).r)then  b(n).y=yres-b(n).r:b(n).dy=-b(n).dy    if b(n).x<0 or b(n).x>xres then status=0    if b(n).y<0 or b(n).y>yres then status=0    next nend subFunction DetectBallCollisions( B1 As ball,B2 As ball) As single 'avoid using sqr if they are well seperated    Dim As single xdiff = B2.x-B1.x    Dim As single ydiff = B2.y-B1.y    If Abs(xdiff) > (B2.r+B1.r) Then Return 0    If Abs(ydiff) > (B2.r+B1.r) Then Return 0    var L=Sqr(xdiff*xdiff+ydiff*ydiff)    If L<=(B2.r+B1.r) Then Function=L else Function=0End Function sub BallCollisions(b() as ball)    for n1 as Long=lbound(b) to ubound(b)-1        for n2 as Long=n1+1 to ubound(b)            dim as single  L= DetectBallCollisions(b(n1),b(n2))            if L then       dim as single  impulsex=(b(n1).x-b(n2).x)/L       dim as single  impulsey=(b(n1).y-b(n2).y)/L       'set one ball to nearest non overlap position       b(n1).x=b(n2).x+(b(n2).r+b(n1).r)*impulsex       b(n1).y=b(n2).y+(b(n2).r+b(n1).r)*impulsey              dim as single  impactx=b(n1).dx-b(n2).dx       dim as single  impacty=b(n1).dy-b(n2).dy       dim as single  dot=impactx*impulsex+impacty*impulsey       dim as single  mn2=b(n1).m/(b(n1).m+b(n2).m),mn1=b(n2).m/(b(n1).m+b(n2).m)            b(n1).dx-=dot*impulsex*2*mn1        b(n1).dy-=dot*impulsey*2*mn1        b(n2).dx+=dot*impulsex*2*mn2        b(n2).dy+=dot*impulsey*2*mn2        end ifnext n2next n1end sub'steady framerateFunction Regulate(Byval MyFps As Long,Byref fps As Long) As Long    Static As double timervalue,lastsleeptime,t3,frames    frames+=1    If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0    Var sleeptime=lastsleeptime+((1/myfps)-Timer+timervalue)*1000    If sleeptime<1 Then sleeptime=1    lastsleeptime=sleeptime    timervalue=Timer    Return sleeptimeEnd Functionsub Start()    dim  as ball b(0 to 10)    dim as Long fps,energy,status=1    dim as integer xres,yres    screen 20,32     color ,rgb(0,0,50)    screeninfo xres,yres        for n as Long=lbound(b) to ubound(b)        with b(n)            .x=xres/2            .y=yres/2            .dx=rnd*5-rnd*5            .dy=rnd*5-rnd*5            .col=rgb(rnd*255,rnd*255,rnd*255)            .r=20+rnd*40            .m=.r^2            end with        next      while 1        energy=0      edges(b(),xres,yres,status)      BallCollisions(b())      screenlock        cls                MoveAndDraw(b(),energy)      draw string(50, 10), " Press escape key to end", rgb(255, 200, 0)      draw string(50, 55), "framerate " &fps , rgb(0, 200, 0)      draw string (50,100),"System energy " &energy        draw string (50,145),"System stauus " & iif(1,"OK","Leaks")      screenunlock         sleep regulate(65, fps)      if inkey=chr(27) then exit while   wendend subStartsleep`

The system energy fluctuates a bit, but it doesn't go into critical.
owen
Posts: 433
Joined: Apr 19, 2006 10:55
Location: Kissimmee, FL
Contact:

### Re: Ball collisions

dodicat that simplified version is great. i think im getting the picture now.

ps wouldn't you readjust impules x and y after the move

Code: Select all

` sub BallCollisions(b() as ball)    for n1 as Long=lbound(b) to ubound(b)-1        for n2 as Long=n1+1 to ubound(b)            dim as single  L= DetectBallCollisions(b(n1),b(n2))            if L then       dim as single  impulsex=(b(n1).x-b(n2).x)/L       dim as single  impulsey=(b(n1).y-b(n2).y)/L       'set one ball to nearest non overlap position       b(n1).x=b(n2).x+(b(n2).r+b(n1).r)*impulsex       b(n1).y=b(n2).y+(b(n2).r+b(n1).r)*impulsey'readjust impulse x and y       impulsex=(b(n1).x-b(n2).x)/(b(n1).r+b(n2).r)       impulsey=(b(n1).y-b(n2).y)/(b(n1).r+b(n2).r)       dim as single  impactx=b(n1).dx-b(n2).dx       dim as single  impacty=b(n1).dy-b(n2).dy       dim as single  dot=impactx*impulsex+impacty*impulsey       dim as single  mn2=b(n1).m/(b(n1).m+b(n2).m),mn1=b(n2).m/(b(n1).m+b(n2).m)            b(n1).dx-=dot*impulsex*2*mn1       b(n1).dy-=dot*impulsey*2*mn1       b(n2).dx+=dot*impulsex*2*mn2       b(n2).dy+=dot*impulsey*2*mn2       end ifnext n2next n1end sub`
dodicat
Posts: 4633
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Ball collisions

There is a sight difference in impulses -- true

Code: Select all

`impulsexold               renewed-0.1886361    -0.1886362 0.4466563     0.4466564-0.8825526    -0.8825528-0.3068343    -0.3068347 0.2552532     0.2552534 0.7791622     0.7791622-0.3976328    -0.3976327-0.9436295    -0.9436297-0.4231996    -0.4231995 0.7869689     0.7869692-0.173381     -0.173381 0.858995      0.8589947 0.02620443    0.02620409 `

( I got these by writing the values to a text file, before and after re-setting the ball)
The difference seems small here.
Re setting the ball gets rid of those discrete jumps as best as possible, your code also does this.
So the first impulse might be the true one (from actual motion data).
But I'll let you ponder over which is properly correct.
srvaldez
Posts: 1434
Joined: Sep 25, 2005 21:54

### Re: Ball collisions

<off-topic> I saw this game http://www.ticalc.org/archives/files/fi ... 46908.html and thought that it might interest you to make a clone.
I personally have no time for playing games but it looked like an interesting concept.
dodicat
Posts: 4633
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Ball collisions

Thanks srvaldez
A paracetamol clone perhaps.