'Sound Ball by SierraKen

'Dec. 17, 2024



_Title "Sound Ball"

Screen _NewImage(800, 600, 32)

Dim tim As Single

Dim tim2 As Single

Dim yn$

start:

Clear

Cls

Dim file$

Dim press As Single

'Dim radius As Single, centerx As Single, centery As Single

Dim angleX As Single, angleY As Single

Dim xx As Single, yy As Single

Dim lat As Single, lon As Single

Dim prevX As Single, prevY As Single



Const radius = 150

Const centerx = 400

Const centery = 300

angleX = 0

angleY = 0

Const pi = _Pi



file$ = ""

Line (300, 100)-(550, 200), _RGB32(255, 255, 255), BF

Color _RGB32(255, 0, 0), _RGB(255, 255, 255)

_PrintString (330, 150), "Click Here To Load Music"

Do

    Do

        While _MouseInput

            If _MouseButton(1) And _MouseX > 300 And _MouseX < 550 And _MouseY > 100 And _MouseY < 200 Then press = 1

        Wend

    Loop Until press = 1

    start2:

    Line (300, 100)-(550, 200), _RGB32(255, 0, 0), BF

    tim = Timer

    Do

        tim2 = Timer

        If tim2 - tim > .5 Then

            Line (300, 100)-(550, 200), _RGB32(255, 255, 255), BF

            Timer Off

            Exit Do

        End If

    Loop

    tim = 0: tim2 = 0

    Color _RGB32(255, 255, 255), _RGB32(0, 0, 0)

    Print

    file$ = _OpenFileDialog$(, "Music File")

    If file$ = "" Then

        Locate 6, 70: Print "              "

        Locate 6, 38

        Input "Would you like to continue (Y/N)", yn$

        If Left$(yn$, 1) = "y" Or Left$(yn$, 1) = "Y" Then

            GoTo start2:

        End If

    End If

Loop Until press = 1

press = 0

yn$ = ""

DefLng A-Z

Option _Explicit

Option _ExplicitArray





Dim a$

Print "Loading...";

Dim Song As Long

Song = _SndOpen(file$) ' Replace this with your (rad, mid, it, xm, s3m, mod, mp3, flac, ogg, wav) sound file

If Song < 1 Then

    End

End If

_Display

_SndPlay Song



Dim SampleData As _MEM

SampleData = _MemSound(Song, 1) ' This can now be 0 or 1

If SampleData.SIZE = 0 Then

    Print "Failed to access sound sample data."

    End

End If



Dim y As Long, i As _Unsigned _Integer64, sf As Single

Dim sz As _Unsigned _Integer64



sz = _CV(_Unsigned _Integer64, _MK$(_Offset, SampleData.ELEMENTSIZE)) ' sz is the total size of the sound in bytes





Do Until Not _SndPlaying(Song) Or i + (_Width * sz) > SampleData.SIZE

    _Limit 500

    a$ = InKey$

    If a$ = Chr$(27) Then _SndClose Song: End



    $Checking:Off

    If (sz = 8 Or sz = 4) And (SampleData.TYPE And 256) Then

        For y = 0 To 100

            sf = _MemGet(SampleData, SampleData.OFFSET + i + y * sz, Single) 'get sound data

            If sf * 300 = 0 Then GoTo skip:

            ' Update rotation angles

            Cls

            angleX = angleX + (sf * 90)

            angleY = angleY + (sf * 90)

            ' Draw latitude lines

            For lat = -pi / 2 To pi / 2 Step pi / 12



                For lon = 0 To 2 * pi Step pi / 36

                    SphericalTo2D lat, lon, xx, yy, angleX, angleY

                    yy = yy + (sf * 360)

                    If lon > 0 Then Line (prevX, prevY)-(xx, yy), _RGB32(0, 200, 50)

                    prevX = xx

                    prevY = yy

                Next lon

            Next lat



            ' Draw longitude lines

            For lon = 0 To 2 * pi Step pi / 12

                For lat = -pi / 2 To pi / 2 Step pi / 36

                    SphericalTo2D lat, lon, xx, yy, angleX, angleY

                    yy = yy + (sf * 360)

                    If lat > -pi / 2 Then Line (prevX, prevY)-(xx, yy), _RGB32(0, 50, 200)

                    prevX = xx

                    prevY = yy

                Next lat

            Next lon



        Next

        skip:



        ' Update rotation angles

        angleX = angleX + 0.02

        angleY = angleY + 0.01

    End If

    _Display

    i = Fix(_SndGetPos(Song) * _SndRate) * sz ' Calculate the new sample frame position

Loop

$Checking:On

_SndClose Song 'closing the sound releases the mem blocks

_AutoDisplay

GoTo start:



' Subroutine to convert spherical coordinates to 2D projection

Sub SphericalTo2D (lat As Single, lon As Single, xx As Single, yy As Single, angleX As Single, angleY As Single)

    ' Convert latitude and longitude to 3D coordinates

    Dim x3D As Single, y3D As Single, z3D As Single

    x3D = radius * Cos(lat) * Cos(lon)

    y3D = radius * Cos(lat) * Sin(lon)

    z3D = radius * Sin(lat)



    ' Apply rotation around the X-axis

    Dim tempY As Single, tempZ As Single

    tempY = y3D * Cos(angleX) - z3D * Sin(angleX)

    tempZ = y3D * Sin(angleX) + z3D * Cos(angleX)

    y3D = tempY

    z3D = tempZ



    ' Apply rotation around the Y-axis

    Dim tempX As Single

    tempX = x3D * Cos(angleY) + z3D * Sin(angleY)

    z3D = -x3D * Sin(angleY) + z3D * Cos(angleY)

    x3D = tempX



    ' Project the 3D point onto 2D screen

    xx = centerx + x3D

    yy = centery - y3D

End Sub