1 ' 3D Starfield Simulation
\r
2 ' Originally made by Svjatoslav Agejenko in 2003.03
\r
3 ' In 2024 code was modernized using artificial intelligence
\r
4 ' Homepage: svjatoslav.eu
\r
5 ' Email: svjatoslav@svjatoslav.eu
\r
7 DECLARE SUB AddStar (xPosition AS SINGLE, yPosition AS SINGLE, zPosition AS SINGLE)
\r
8 DECLARE SUB CreateGalaxy ()
\r
10 Dim Shared totalStars As Integer
\r
11 Dim Shared maxStars As Integer
\r
15 totalStars = maxStars
\r
16 starFieldDepth = 500
\r
18 Dim Shared starXPositions(1 To maxStars + 1000) As Single
\r
19 Dim Shared starYPositions(1 To maxStars + 1000) As Single
\r
20 Dim Shared starZPositions(1 To maxStars + 1000) As Single
\r
22 ' Initialize the positions of the stars
\r
23 For starIndex = 1 To totalStars
\r
24 starZPositions(starIndex) = Rnd * starFieldDepth + 20
\r
26 starXPositions(starIndex) = Sin(angle) * 20
\r
27 starYPositions(starIndex) = Cos(angle) * 20
\r
35 ' Calculate the camera's rotation and position offsets
\r
36 frameCount = frameCount + 1
\r
37 cameraRotation = (3.1412 / 2) + Sin(frameCount / 35) / 100 + Sin(frameCount / 21) / 100
\r
38 rs1 = Sin(cameraRotation)
\r
39 rc1 = Cos(cameraRotation)
\r
41 ' Update and draw each star
\r
42 For starIndex = 1 To totalStars
\r
43 x = starXPositions(starIndex)
\r
44 y = starYPositions(starIndex)
\r
45 z = starZPositions(starIndex)
\r
47 ' Project the star's 3D position onto the 2D screen
\r
48 projectedX = (x / z) * 160 + 160
\r
49 projectedY = (y / z) * 100 + 100
\r
50 PSet (projectedX, projectedY), 0 ' Erase the previous position
\r
52 ' Rotate the star's position around the camera
\r
53 x5 = x * rs1 - y * rc1
\r
54 y5 = x * rc1 + y * rs1
\r
56 ' Update the star's position with camera movement
\r
57 x = x5 + Sin(frameCount / 21) * 3
\r
58 y = y5 + Sin(frameCount / 18) * 3
\r
60 ' Move the star closer to the viewer and wrap around if too close
\r
68 ' Project the new position and draw with perspective-based brightness
\r
69 projectedX = (x / z) * 160 + 160
\r
70 projectedY = (y / z) * 100 + 100
\r
71 colorCode = 3000 / z + 15
\r
72 If colorCode > 31 Then colorCode = 31
\r
73 PSet (projectedX, projectedY), colorCode
\r
75 ' Update the star's array positions
\r
76 starXPositions(starIndex) = x
\r
77 starYPositions(starIndex) = y
\r
78 starZPositions(starIndex) = z
\r
81 ' Add new stars to the galaxy if needed
\r
82 If maxStars - totalStars > Rnd * 800 + 100 Then CreateGalaxy: totalStars = totalStars + 1
\r
84 ' Remove the two farthest stars and replace them with new ones
\r
86 starIndex = Int(Rnd * (totalStars - 10)) + 1
\r
87 Swap starXPositions(totalStars), starXPositions(starIndex)
\r
88 Swap starYPositions(totalStars), starYPositions(starIndex)
\r
89 Swap starZPositions(totalStars), starZPositions(starIndex)
\r
91 x = starXPositions(totalStars)
\r
92 y = starYPositions(totalStars)
\r
93 z = starZPositions(totalStars)
\r
94 projectedX = (x / z) * 160 + 160
\r
95 projectedY = (y / z) * 100 + 100
\r
96 PSet (projectedX, projectedY), 0 ' Erase the star
\r
97 totalStars = totalStars - 1
\r
101 ' Check for user input to exit the program
\r
102 If InKey$ <> "" Then System
\r
104 ' sleep, to limit framerate
\r
108 ' Subroutine to create a new galaxy of stars
\r
110 xForce = Rnd * 4 - 2
\r
111 yForce = Rnd * 4 - 2
\r
112 xPositionOffset = Rnd * 200 - 100
\r
113 yPositionOffset = Rnd * 200 - 100
\r
115 ' Add a new set of stars with varying positions and velocities
\r
116 For starIndex = 1 To Int(Rnd * 15) + 10 Step .04
\r
117 x = Sin(starIndex) * starIndex * starIndex / 10
\r
118 y = Cos(starIndex) * starIndex * starIndex / 10
\r
119 AddStar x + RND * starIndex * starIndex / 30 + xPositionOffset, _
\r
120 y + RND * starIndex * starIndex / 30 + yPositionOffset, _
\r
121 700 + RND * starIndex * starIndex / 30 + (x * xForce) + (y * yForce)
\r
124 ' Play a sound when creating new stars (commented out)
\r
128 ' Subroutine to add a new star at the specified position
\r
129 Sub AddStar (xPosition As Single, yPosition As Single, zPosition As Single)
\r
130 totalStars = totalStars + 1
\r
131 starIndex = totalStars
\r
133 starXPositions(starIndex) = xPosition
\r
134 starYPositions(starIndex) = yPosition
\r
135 starZPositions(starIndex) = zPosition
\r