Ball collisions

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

Re: Ball collisions

Postby owen » Sep 04, 2017 13:55

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

Postby owen » Sep 04, 2017 16:28

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: 4347
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Ball collisions

Postby dodicat » Sep 04, 2017 18:24

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

Re: Ball collisions

Postby dafhi » Sep 05, 2017 13:23

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

Postby owen » Sep 05, 2017 13:56

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

Re: Ball collisions

Postby dafhi » Sep 05, 2017 14:49

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

Re: Ball collisions

Postby dodicat » Sep 06, 2017 11:39

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

Return to “General”

Who is online

Users browsing this forum: No registered users and 5 guests