' 3D Starfield Simulation
' Originally made by Svjatoslav Agejenko in 2003.03
' In 2024 code was modernized using artificial intelligence
' Homepage: svjatoslav.eu
' Email: svjatoslav@svjatoslav.eu

DECLARE SUB AddStar (xPosition AS SINGLE, yPosition AS SINGLE, zPosition AS SINGLE)
DECLARE SUB CreateGalaxy ()

Dim Shared totalStars As Integer
Dim Shared maxStars As Integer

Randomize Timer
maxStars = 2000
totalStars = maxStars
starFieldDepth = 500

Dim Shared starXPositions(1 To maxStars + 1000) As Single
Dim Shared starYPositions(1 To maxStars + 1000) As Single
Dim Shared starZPositions(1 To maxStars + 1000) As Single

' Initialize the positions of the stars
For starIndex = 1 To totalStars
    starZPositions(starIndex) = Rnd * starFieldDepth + 20
    angle = Rnd * 100
    starXPositions(starIndex) = Sin(angle) * 20
    starYPositions(starIndex) = Cos(angle) * 20
Next starIndex

Screen 13


Do

    ' Calculate the camera's rotation and position offsets
    frameCount = frameCount + 1
    cameraRotation = (3.1412 / 2) + Sin(frameCount / 35) / 100 + Sin(frameCount / 21) / 100
    rs1 = Sin(cameraRotation)
    rc1 = Cos(cameraRotation)

    ' Update and draw each star
    For starIndex = 1 To totalStars
        x = starXPositions(starIndex)
        y = starYPositions(starIndex)
        z = starZPositions(starIndex)

        ' Project the star's 3D position onto the 2D screen
        projectedX = (x / z) * 160 + 160
        projectedY = (y / z) * 100 + 100
        PSet (projectedX, projectedY), 0 ' Erase the previous position

        ' Rotate the star's position around the camera
        x5 = x * rs1 - y * rc1
        y5 = x * rc1 + y * rs1

        ' Update the star's position with camera movement
        x = x5 + Sin(frameCount / 21) * 3
        y = y5 + Sin(frameCount / 18) * 3

        ' Move the star closer to the viewer and wrap around if too close
        z = z - 3
        If z < 10 Then
            z = Rnd * 300 + 400
            x = Rnd * 800 - 400
            y = Rnd * 800 - 400
        End If

        ' Project the new position and draw with perspective-based brightness
        projectedX = (x / z) * 160 + 160
        projectedY = (y / z) * 100 + 100
        colorCode = 3000 / z + 15
        If colorCode > 31 Then colorCode = 31
        PSet (projectedX, projectedY), colorCode

        ' Update the star's array positions
        starXPositions(starIndex) = x
        starYPositions(starIndex) = y
        starZPositions(starIndex) = z
    Next starIndex

    ' Add new stars to the galaxy if needed
    If maxStars - totalStars > Rnd * 800 + 100 Then CreateGalaxy: totalStars = totalStars + 1

    ' Remove the two farthest stars and replace them with new ones
    For a = 1 To 2
        starIndex = Int(Rnd * (totalStars - 10)) + 1
        Swap starXPositions(totalStars), starXPositions(starIndex)
        Swap starYPositions(totalStars), starYPositions(starIndex)
        Swap starZPositions(totalStars), starZPositions(starIndex)

        x = starXPositions(totalStars)
        y = starYPositions(totalStars)
        z = starZPositions(totalStars)
        projectedX = (x / z) * 160 + 160
        projectedY = (y / z) * 100 + 100
        PSet (projectedX, projectedY), 0 ' Erase the star
        totalStars = totalStars - 1
    Next a


    ' Check for user input to exit the program
    If InKey$ <> "" Then System

    ' sleep, to limit framerate
    Sound 0, 1
Loop

' Subroutine to create a new galaxy of stars
Sub CreateGalaxy
    xForce = Rnd * 4 - 2
    yForce = Rnd * 4 - 2
    xPositionOffset = Rnd * 200 - 100
    yPositionOffset = Rnd * 200 - 100

    ' Add a new set of stars with varying positions and velocities
    For starIndex = 1 To Int(Rnd * 15) + 10 Step .04
        x = Sin(starIndex) * starIndex * starIndex / 10
        y = Cos(starIndex) * starIndex * starIndex / 10
        AddStar x + RND * starIndex * starIndex / 30 + xPositionOffset, _
                   y + RND * starIndex * starIndex / 30 + yPositionOffset, _
                   700 + RND * starIndex * starIndex / 30 + (x * xForce) + (y * yForce)
    Next starIndex

    ' Play a sound when creating new stars (commented out)
    ' SOUND 1000, 1
End Sub

' Subroutine to add a new star at the specified position
Sub AddStar (xPosition As Single, yPosition As Single, zPosition As Single)
    totalStars = totalStars + 1
    starIndex = totalStars

    starXPositions(starIndex) = xPosition
    starYPositions(starIndex) = yPosition
    starZPositions(starIndex) = zPosition
End Sub