Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Happy New Year Globe!
#1
Happy New Year Everyone!

Code: (Select All)

_Title "H A P P Y  N E W  Y E A R ! ! ! !          From SierraKen"
' Constants
Const pi = _Pi
Const radius = 275
centerX = 400
centerY = 300

' Rotation angles
Dim angleX As Single, angleY As Single
angleX = 90
angleY = 0

xx = 400: yy = 50
'Dim x As Single, y As Single

dir1 = 1
dir2 = 1

a& = _NewImage(800, 600, 32)
Screen a&

Color 1
Locate 1, 32: Print "Happy New Year!!!!"
For I = 248 To 375 Step .15
    For j = 0 To 12 Step .15
        If Point(I, j) > 0 Then
            Line ((I - 211) * 4, j * 4 + 50)-((I - 211) * 4 + 2, j * 4 + 52), _RGB32(0, 0, 0), BF
        Else
            PSet ((I - 211) * 4, j * 4 + 50), _RGB32(0, 255, 0)
        End If
    Next j
Next I

a& = _CopyImage(0)
b& = _NewImage(800, 600, 32)
Screen b&
_Dest b&
r = 100: g = 10: b = 10
dirc = 1

Do
    Cls
    _PutImage (xx, yy), a&, b&

    If dirc = 1 Then
        r = r + 5
        g = 10
        b = 10
    End If
    If r > 255 Then dirc = 2
    If dirc = 2 Then r = r - 5
    If dirc = 2 And r < 50 Then dirc = 3
    If dirc = 3 Then
        r = 10
        b = 10
        g = g + 5
    End If
    If g > 255 Then dirc = 4
    If dirc = 4 Then g = g - 5
    If dirc = 4 And g < 50 Then dirc = 5
    If dirc = 5 Then
        r = 10
        g = 10
        b = b + 5
    End If
    If b > 255 Then dirc = 6
    If dirc = 6 Then b = b - 5
    If dirc = 6 And b < 50 Then dirc = 1


    If dir1 = 1 Then xx = xx + 10
    If xx > 150 Then dir1 = 2
    If dir1 = 2 Then xx = xx - 10
    If xx < -150 Then dir1 = 1

    If dir2 = 1 Then yy = yy + 10
    If yy > 500 Then dir2 = 2
    If dir2 = 2 Then yy = yy - 10
    If yy < -50 Then dir2 = 1


    ' Draw latitude lines
    For lat = -pi / 2 To pi / 2 Step pi / 18
        Dim prevX As Single, prevY As Single
        For lon = 0 To 5 * pi Step pi / 36
            Call SphericalTo2D(lat, lon, x, y, angleX, angleY, centerX, centerY)
            If lon > 0 Then Line (prevX, prevY)-(x, y), _RGB32(r, g, b)
            prevX = x
            prevY = y
        Next lon
    Next lat

    ' Draw longitude lines
    For lon = 0 To 5 * pi Step pi / 12
        For lat = -pi / 2 To pi / 2 Step pi / 36
            Call SphericalTo2D(lat, lon, x, y, angleX, angleY, centerX, centerY)
            If lat > -pi / 2 Then Line (prevX, prevY)-(x, y), _RGB32(r, g, b)
            prevX = x
            prevY = y
        Next lat
    Next lon

    ' Update rotation angles
    angleX = angleX + 0.02
    angleY = angleY + 0.5

    _Delay .1
    _Display
Loop Until InKey$ <> ""

End


' Subroutine to convert spherical coordinates to 2D projection
Sub SphericalTo2D (lat As Single, lon As Single, x As Single, y As Single, angleX As Single, angleY As Single, centerx As Single, centery 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
    x = centerx + x3D
    y = centery - y3D
End Sub
Reply


Messages In This Thread
Happy New Year Globe! - by SierraKen - 01-01-2025, 09:08 AM
RE: Happy New Year Globe! - by bplus - 01-01-2025, 06:54 PM
RE: Happy New Year Globe! - by SierraKen - 01-01-2025, 08:57 PM



Users browsing this thread: 2 Guest(s)