Yesterday, 11:34 PM
I'm not sure how good this really is, but I made a ball that bounces up and down to music. I got the ball graphic code from ChatGPT.
Code: (Select All)
'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