Freeze Tag
#41
freeze tag update Waltersmind's - Single Color LED sign with scrolling letters is online. http://www.fbcadcam.com/freezetag/freeze-tag.zip
testing the modified vector math.
bounce angles are more realistic but still sorting out speed issues.

use the left and right arrow keys to rotate.
use the up and down arrow keys to speed up and slow down.
use the space bar to fire.
press E for emp
press escape to end.

Code:
#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 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,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 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 = 3.1415926535897932

Dim Shared As Integer bc
DIM AS Integer game_sound(12)
Dim As Integer i,j,k,bf(15),c,catch,level,timeout,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
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
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,rip_apart

' 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=3
maxspeed=5
delay 4
ReDim b(50)
Randomize Timer
Do
    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
        b(i).r = Int(Rnd*20)+20
        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 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=b(j).x+cos(b(j).d*pi/180)*b(j).s
                                b(j).y=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
                                    EndIf
                                    bounce(i,j)
                                    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
                                    b(j).x=b(j).x+cos(b(j).d*pi/180)*b(j).s
                                    b(j).y=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)+180
                                    b(i).x+=+cos(rip_apart*pi/180)*b(i).s
                                    b(i).y+=+sin(rip_apart*pi/180)*b(i).s
                                    b(j).x+=cos((rip_apart+180)*pi/180)*b(j).s
                                    b(j).y+=+sin((rip_apart+180)*pi/180)*b(j).s
                                    If i = 0 Or j=0 Then FSOUND_PlaySound(FSOUND_FREE, game_sound(4))
                                    Exit For
                                Else
                                    b(j).x=b(j).x+cos((b(j).d+180)*pi/180)*b(j).s
                                    b(j).y=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
                        '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
                        '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
                    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
    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 ball_1_x, ball_1_y, ball_1_r, ball_1_x_v, ball_1_y_v, ball_1_x_new_v, ball_1_y_new_v
    Dim As Double ball_2_x, ball_2_y, ball_2_r, ball_2_x_v, ball_2_y_v, ball_2_x_new_v, ball_2_y_new_v
    Dim As Double b1_speed_t,b2_speed_t,bspeedt,initbspeedt,over_lap
    Dim As Double ball_speed_sum,brt,brd1,brd2,bxvt,byvt
    Dim As Integer i
    For i= 1 To bc
        ball_speed_sum+=b(i).s
    Next
    
    ball_1_x=b(ball_1).x
    ball_1_y=b(ball_1).y
    ball_1_r=b(ball_1).r
    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=b(ball_2).x
    ball_2_y=b(ball_2).y
    ball_2_r=b(ball_2).r
    brt=ball_1_r+ball_2_r
    brd1=ball_1_r-ball_2_r
    brd2=ball_2_r-ball_1_r
    bxvt=ball_1_x-ball_2_x
    byvt=ball_1_y-ball_2_y
    
    
    
    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_x_new_v=((bxvt)/(brt)*((((bxvt)/(brt)*ball_1_x_v+(byvt)/(brt)*ball_1_y_v * (brd1) + 2 * ball_2_r * ((bxvt)/(brt)*ball_2_x_v+(byvt)/(brt)*ball_2_y_v))) / (brt)))+((byvt)/(brt)*-1*((byvt)/(brt)*-1*ball_1_x_v+(bxvt)/(brt)*ball_1_y_v))
    ball_1_y_new_v=((byvt)/(brt)*((((bxvt)/(brt)*ball_1_x_v+(byvt)/(brt)*ball_1_y_v * (brd1) + 2 * ball_2_r * ((bxvt)/(brt)*ball_2_x_v+(byvt)/(brt)*ball_2_y_v))) / (brt)))+((bxvt)/(brt)*((byvt)/(brt)*-1*ball_1_x_v+(bxvt)/(brt)*ball_1_y_v))
    ball_2_x_new_v=((bxvt)/(brt)*((((bxvt)/(brt)*ball_2_x_v+(byvt)/(brt)*ball_2_y_v * (brd2) + 2 * ball_1_r * ((bxvt)/(brt)*ball_1_x_v+(byvt)/(brt)*ball_1_y_v))) / (brt)))+((byvt)/(brt)*-1*((byvt)/(brt)*-1*ball_2_x_v+(bxvt)/(brt)*ball_2_y_v))
    ball_2_y_new_v=((byvt)/(brt)*((((bxvt)/(brt)*ball_2_x_v+(byvt)/(brt)*ball_2_y_v * (brd2) + 2 * ball_1_r * ((bxvt)/(brt)*ball_1_x_v+(byvt)/(brt)*ball_1_y_v))) / (brt)))+((bxvt)/(brt)*((byvt)/(brt)*-1*ball_2_x_v+(bxvt)/(brt)*ball_2_y_v))
    ball_1_x+=ball_1_x_new_v
    ball_1_y+=ball_1_y_new_v
    b(ball_1).d=abtp(b(ball_1).x,b(ball_1).y,ball_1_x,ball_1_y)
    ball_2_x+=ball_2_x_new_v
    ball_2_y+=ball_2_y_new_v
    b(ball_2).d=abtp(b(ball_2).x,b(ball_2).y,ball_2_x,ball_2_y)

    b1_speed_t=dist(b(ball_1).x,b(ball_1).y,ball_1_x,ball_1_y)
    b2_speed_t=dist(b(ball_2).x,b(ball_2).y,ball_2_x,ball_2_y)

    bspeedt=b1_speed_t+b2_speed_t
    initbspeedt=b(ball_1).s+b(ball_2).s
    If ball_speed_sum-b(ball_1).s-b(ball_2).s+bspeedt>ball_speed_sum Then
        b(ball_1).s=b1_speed_t*initbspeedt/bspeedt
        b(ball_2).s=b2_speed_t*initbspeedt/bspeedt
    Else
        b(ball_1).s=initbspeedt*b1_speed_t/bspeedt
        b(ball_2).s=initbspeedt*b2_speed_t/bspeedt
    EndIf

    b(ball_1).s-=.001
    b(ball_2).s-=.001
    If b(ball_1).s<.001 Then b(ball_1).s=.001
    If b(ball_1).s<.001 Then b(ball_1).s=.001
End Sub
Reply
#42
the speed was not correct in update 7.
so now it looks better in update 8. update 8 is online.
current version http://www.fbcadcam.com/freezetag/freeze-tag.zip
old versions http://www.fbcadcam.com/freezetag/old

i changed this:
Code:
    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)


to this:
Code:
    ball_1_x_v=(cos(b(ball_1).d*pi/180)*b(ball_1).s*b(ball_1).r)
    ball_1_y_v=(sin(b(ball_1).d*pi/180)*b(ball_1).s*b(ball_1).r)
Reply
#43
#9 is up.

re-worked the bounce sub routine again.
the ball you move has 3 times the mass in comparison to other balls its size.
makes it a bit easier to control.

i also experimented with total control of the ball you move but the excitement / frustration (fun factor) diminished some what.

however there was a cool thing about doing that.
you could corner another ball.
i started working on a bit to detect and stop the constant knock sound that plays when the balls collide.
[Image: freeze-tag-geomety-12.PNG]
kind of an interesting math subject i thought i would share.
calculate the red and purple radii given the the x,y coordinates and radii of the green and yellow balls.
Reply
#44
in an attempt to try and understand vorbarian's math i shared freeze tag with the fb community.
http://www.freebasic.net/forum/viewtopic.php?f=3&t=8903

the algorithm used in this game came from there originally.
if you look on page 2 of that topic you can find an my example of vorbarian's 5 balls example using my latest rework of the algo.

so...

no takers on that last question in my previous post?
Quote:calculate the red and purple radii given the the x,y coordinates and radii of the green and yellow balls

well, the way i would go about figuring the purple circle radius would be to draw a square around the green circle then draw a line from the bottom left to the top right forming an hypotenuse. so the purple circle radius =
(sqr( (red circle radus * 2)^2 + (red circle radus * 2)^2 ) - red circle radus * 2) / 2 + red circle radus * 2
Reply
#45
Ah, I see by your link that you've run into the two balls "mating" (spinning around each other as if attached) problem too.

If 2 balls of equal mass and speed collide head on (180 degrees) wouldn't both be stunned to stillness?

I like to let them bounce off each other into the opposite direction at the same speed as before the bounce.
B += x
Reply
#46
yup. its got that problem.
Code:
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 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 speed
End Type
Dim Shared As balls b(5)
Dim As Integer i,j,k,bw,bh
Dim As Double rip_apart
Dim Shared As Double normal,rot,bid,bnd,boid',maxspeed

''  screen settings
bw = 600          ''  screen width
bh = 400          ''  screen height
screenres bw, bh, 16


With b(1)
  .r = 40
  .x = 100
  .y = 200
  .c = RGB(255, 32, 32)
  .s = 3
  .d = 0
End With

With b(2)
  .r = 40
  .x = 500
  .y = 200
  .c = RGB(255, 32, 255)
  .s = 3
  .d = 180
End With

With b(3)
  .r = 30
  .x = 300
  .y = 200
  .c = RGB(32, 32, 255)
  .s = 3
  .d = 0
End With

With b(4)
  .r = 35
  .x = 400
  .y = 200
  .c = RGB(32, 255, 32)
  .s = 3
  .d = 0
End With

With b(5)
  .r = 40
  .x = 500
  .y = 200
  .c = RGB(255, 255, 32)
  .s = 3
  .d = 0
End With

Do

  Screenlock
  
    Cls
  
      For i=1 To 2
         '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 2
               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 Do
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 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 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
Reply
#47
@owen,

I am not a math genious, but using my powers of deduction... and your drawing of the purple, green, red, and yellow circles, here is what I am thinking.

Remember, these ideas are only based on your drawing.

The Radius (half width) of the "Purple" circle is exactly the Diameter (full width) of the "Green" circle.

so I would define it as: 

PurpleCircleRadius = GreenCircleRadius * 2

or


PurpleCircleRadius = GreenCircleRadius + GreenCircleRadius

The Radius (half width) of the "Red" circle is exactly the Diameter (full width) of the the "Green" circle, plus the radius (half width) of the "Yellow" circle.

So I would define that as: 

RedCircleRadius = GreenCircleRadius * 2 + YellowCircleRadius

or

RedCircleRadius = GreenCircleRadius + GreenCircleRadius + YellowCircleRadius

That was just a thought based on your drawing.


Walter Whitman
The Joyful Programmer
Dedicated to empowering computer programming hobbyists, tinkerers, amateurs, and enthusiasts.
profile for Walter Whitman at Stack Overflow, Q&A for professional and enthusiast programmers


Reply
#48
purple circle radius is a bit more then twice the green circle's radius
[Image: freeze-tag-geomety-13.PNG]
Reply
#49
@Owen,

You are correct! I made a mistake.

However, here is a demo I wrote in QB64 that doesn't use square roots to find the size of the purple circle and the red circle, just by defining the size of the green circle and yellow circle.

Code:
DIM GreenCircleRadius AS _FLOAT
DIM GreenCircleDiameter AS _FLOAT
DIM YellowCircleRadius AS _FLOAT
DIM YellowCircleDiameter AS _FLOAT
DIM PurpleCircleRadius AS _FLOAT
DIM RedCircleRadius AS _FLOAT

DIM GreenCircleBoundingBoxDiagonalDistance AS _FLOAT

DIM CenterX AS INTEGER
DIM CenterY AS INTEGER

DIM Degrees AS _FLOAT

Degrees = _PI / 180

SCREEN _NEWIMAGE(700, 500, 32)


GreenCircleRadius = 39.51
GreenCircleDiameter = GreenCircleRadius * 2

YellowCircleRadius = 60
YellowCircleDiameter = YellowCircleRadius * 2

GreenCircleBoundingBoxDiagonalDistance = 1.414213562373095 * GreenCircleDiameter

PurpleCircleRadius = GreenCircleBoundingBoxDiagonalDistance / 2 + GreenCircleRadius
RedCircleRadius = PurpleCircleRadius + YellowCircleDiameter

CenterX = (_WIDTH / 4) * 2.5
CenterY = _HEIGHT / 2

'  PURPLE CIRCLE
CIRCLE (CenterX, CenterY), PurpleCircleRadius, _RGB32(255, 0, 255)

'  RED CIRCLE
CIRCLE (CenterX, CenterY), RedCircleRadius, _RGB32(255, 0, 0)

'  GREEN CIRCLE
CIRCLE (CenterX + GreenCircleRadius, CenterY - GreenCircleRadius), GreenCircleRadius, _RGB32(0, 255, 0)
LINE (CenterX + GreenCircleRadius, CenterY)-(CenterX + GreenCircleRadius, CenterY - GreenCircleDiameter), _RGB32(0, 160, 0)
LINE (CenterX, CenterY - GreenCircleRadius)-(CenterX + GreenCircleDiameter, CenterY - GreenCircleRadius), _RGB32(0, 160, 0)

'  YELLOW CIRCLE - I AM USING A SIMPLE HACK TO PLACE THE YELLOW CIRCLE
YellowCircleX = CenterX + (PurpleCircleRadius + YellowCircleRadius) * COS(Degrees * 45)
YellowCircleY = CenterY - (PurpleCircleRadius + YellowCircleRadius) * SIN(Degrees * 45)

CIRCLE (YellowCircleX, YellowCircleY), YellowCircleRadius, _RGB32(255, 255, 0)
LINE (YellowCircleX - YellowCircleRadius, YellowCircleY)-(YellowCircleX + YellowCircleRadius, YellowCircleY), _RGB32(255, 255, 0)
LINE (YellowCircleX, YellowCircleY - YellowCircleRadius)-(YellowCircleX, YellowCircleY + YellowCircleRadius), _RGB32(255, 255, 0)

'  WHITE LINES
LINE (CenterX, 0)-(CenterX, CenterY), _RGB32(255, 255, 255)
LINE -(_WIDTH, CenterY), _RGB32(255, 255, 255)

'  TEAL BOX
LINE (CenterX, CenterY)-(CenterX + GreenCircleDiameter, CenterY - GreenCircleDiameter), _RGB32(102, 208, 239), B
LINE (CenterX, CenterY)-(CenterX + GreenCircleDiameter, CenterY - GreenCircleDiameter), _RGB32(102, 208, 239)

LOCATE 2, 1

COLOR _RGB32(255, 200, 0), 0
PRINT " Green Circle Radius: "
PRINT " ";
COLOR 0, _RGB32(0, 255, 0)
PRINT GreenCircleRadius
PRINT

COLOR _RGB32(255, 200, 0), 0
PRINT " Purple Circle Radius: "
PRINT " ";
COLOR 0, _RGB32(255, 0, 255)
PRINT PurpleCircleRadius
PRINT

COLOR _RGB32(255, 200, 0), 0
PRINT " Yellow Circle Radius: "
PRINT " ";
COLOR 0, _RGB32(255, 255, 0)
PRINT YellowCircleRadius
PRINT

COLOR _RGB32(255, 200, 0), 0
PRINT " Red Circle Radius: "
PRINT " ";
COLOR 0, _RGB32(255, 0, 0)
PRINT RedCircleRadius


SLEEP
SYSTEM

I said it doesn't contain any square roots, and that is true, but I played a little trick in the program. I know that to find the diagonal distance of a square, we need to use the equation: Distance = SQR(2) * SideLength. Since the value for SQR(2) never changes, I simple took the calculated value and replaced the SQR(2) statement with it.

Here is a screenshot:




You can change the radius of either the green or yellow circle (or both) and this demo will calculate the size of the purple and red circles with basic math.


Walter Whitman
The Joyful Programmer
Dedicated to empowering computer programming hobbyists, tinkerers, amateurs, and enthusiasts.
profile for Walter Whitman at Stack Overflow, Q&A for professional and enthusiast programmers


Reply
#50
nice solution

putting it all in one line:
PurpleCircleRadius = 1.414213562373095 * GreenCircleRadius * 2 / 2 + GreenCircleRadius
or better yet
PurpleCircleRadius = 1.414213562373095 * GreenCircleRadius + GreenCircleRadius

and then of course:
RedCircleRadius = PurpleCircleRadius + YellowCircleRadius * 2

so in order to know the RedCircleRadius it is a matter of first calculating the PurpleCircleRadius

if the goal were to just know the RedCircleRadius then in a single line equation it would look like:

RedCircleRadius = (PurpleCircleRadius) + YellowCircleRadius * 2
RedCircleRadius = (1.414213562373095 * GreenCircleRadius + GreenCircleRadius) + YellowCircleRadius * 2

now i have to apologize.
i made a mistake. i wasn't interested in the RedCircleRadius, rather the WhiteCircleRadius.
[Image: freeze-tag-geomety-14.PNG]
but no matter. Waltersmind provided the base of the formula.
WhiteCircleRadius = (1.414213562373095 * GreenCircleRadius + GreenCircleRadius) + YellowCircleRadius

reason why i'm interested in the WhiteCircleRadius is cuz that's the distance the YellowCircles Center point (x,y) is from the corner. The goal was to derive a simple equation for the value of this distance.

so if the distance ( yellow ball to corner ) <= whitecircleradius and distance (red ball to corner) < distance ( yellow ball to corner ) then bounce yellow ball away from the corner in order to prevent the red ball from being cornered. either that or just detect that the situation exists in order to stop the repetitive bonking sound that freeze tag plays when the yellow ball collides with the red ball.

now about the square root of two. 1.414213562373095
ain't that an interesting number.
i think it ought'a have a name. i vote we call it hippasus.
and like pi
in our programs we set up these variables as constants.
Const pi As Double = 4 * Atn(1)
Const hippasus As Double = Sqr(2)

so the equation is:
WhiteCircleRadius = (hippasus * GreenCircleRadius + GreenCircleRadius) + YellowCircleRadius
Reply
#51
ok back to work on the bounce algo.

bplus brought to my attention a flaw in the algo that i was unaware of.
Quote:If 2 balls of equal mass and speed collide head on (180 degrees) wouldn't both be stunned to stillness?
and sure enough vorbarian's algo has the flaw as well as my algo since it is a rework of his.

i don't know why exactly yet or what the solution could be other then what bplus suggests.
Quote:I like to let them bounce off each other into the opposite direction at the same speed as before the bounce.
so thank you bplus.
Reply
#52
If 2 balls of equal mass and speed collide head on (180 degrees) wouldn't both be stunned to stillness?

I don't think that is a flaw. It is proper physics accounting of momentums and vector math.

Have you seen a demo or Newton's Cradle?

In pool, it works too if the cue ball has 0 forward or backward spin and hits an object ball dead center, it will stop still and all momentum transferred to object ball.

But when 2 balls collide, where does all that momentum go? It just cancels out, that's what mass will do, I guess.
B += x
Reply
#53
the flaw i was referring to in vobarian's code was when i set two of the balls with the same mass and pointed them in each others direction to collide head on and everything was working correct till i changed the starting point of one of the balls. now i just looked at why it was causing a problem and realized my error. never mind. vobarian's code is fine.

no i haven't tested or looked at the other physic engines yet. my goal is to rework vobarian's code to something simpler.

about what happens on a pool table. the two balls should come to a dead stop. i don't know about that. but definitely i have seen plenty of times the que ball stopping and the other takes off.
Reply
#54
Still curious where all that momentum goes? 
Momentum is a force or energy. 
Energy equations must be balanced.
So do you think this is where heat / noise comes from?
Every though the balls are stationary, they are vibrating at higher frequency?
B += x
Reply
#55
i like the way you think bplus.
considering the idea of molecular or atomic frequency...
i'll keep that thought in mind.

after looking at a few things... they say that momentum and kinetic energy are two different beasts and kinetic energy will only be conserved in some situations.

i'm just learning this stuff myself.
today i watched some of these vids:
https://youtu.be/NzgIGd0MbR4
https://youtu.be/Y0NYXy5p5_0

side note:
i have managed to rework it in terms of hippasus. (the square root of 2)
hippasus_x and hippasus_y will be pos/neg 1.4142...
there will be 4 possibilities
hx,hy or -hx,hy or -hx,-hy or hx,-hy
ball 2 relative to ball 1
(0-90) or (90-180) or (180-270) or (270-360)
Code:
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*=3
    If ball_2=0 Then ball_2_a*=3
    hippasus_x=hippasus*(b(ball_2).x-b(ball_1).x)/Abs(b(ball_2).x-b(ball_1).x)
    hippasus_y=hippasus*(b(ball_2).y-b(ball_1).y)/Abs(b(ball_2).y-b(ball_1).y)
    
    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 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
Reply
#56
note: the algo is still ridden with a divide by zero errors.
but now that i have in such terms perhaps i can see the big picture and address this issue.

first, is the test of two balls head on collision on x axis. they y values will cause a divide by zero error.
(b(ball_2).y-b(ball_1).y)/Abs(b(ball_2).y-b(ball_1).y)
0/abs(0)

Code:
    hippasus_x=hippasus*(b(ball_2).x-b(ball_1).x)/Abs(b(ball_2).x-b(ball_1).x)
    hippasus_y=hippasus*(b(ball_2).y-b(ball_1).y)/Abs(b(ball_2).y-b(ball_1).y)
Reply
#57
cool. no more error with one simple change. the balls bounce off each other in head on collisions with equal mass.

all i changed was the first divide by zero error
Code:
    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
there are other potential divide by zero errors but it seems to work.
Reply
#58
Sorting algorithms for ya is up loaded
added multiburst ammo

note: possible memory leak.
sometimes when you catch all the balls of one color, it gets stuck on that color instead of switching to the next available color of balls to catch. let me know if you experience this too. thanks
Reply
#59
the thing about hippasus (a few posts back) was due to a lot of beer. (i was investigating head on collision stuff)
update QB64 Spiro-Roses is up.
the bounce routine looks like this:
Code:
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
Reply
#60
update QB64 Filled Circle Tests Using the Pythagorean Theorem in 32-Bit mode
added auto pilot.
sit back and relax while the auto pilot takes over.
if you think he needs a bit of help perhaps you can light off a few rounds.
Reply