graphics/3D/stars.bas

   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
   6 \r
   7 DECLARE SUB AddStar (xPosition AS SINGLE, yPosition AS SINGLE, zPosition AS SINGLE)\r
   8 DECLARE SUB CreateGalaxy ()\r
   9 \r
  10 Dim Shared totalStars As Integer\r
  11 Dim Shared maxStars As Integer\r
  12 \r
  13 Randomize Timer\r
  14 maxStars = 2000\r
  15 totalStars = maxStars\r
  16 starFieldDepth = 500\r
  17 \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
  21 \r
  22 ' Initialize the positions of the stars\r
  23 For starIndex = 1 To totalStars\r
  24     starZPositions(starIndex) = Rnd * starFieldDepth + 20\r
  25     angle = Rnd * 100\r
  26     starXPositions(starIndex) = Sin(angle) * 20\r
  27     starYPositions(starIndex) = Cos(angle) * 20\r
  28 Next starIndex\r
  29 \r
  30 Screen 13\r
  31 \r
  32 \r
  33 Do\r
  34 \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
  40 \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
  46 \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
  51 \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
  55 \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
  59 \r
  60         ' Move the star closer to the viewer and wrap around if too close\r
  61         z = z - 3\r
  62         If z < 10 Then\r
  63             z = Rnd * 300 + 400\r
  64             x = Rnd * 800 - 400\r
  65             y = Rnd * 800 - 400\r
  66         End If\r
  67 \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
  74 \r
  75         ' Update the star's array positions\r
  76         starXPositions(starIndex) = x\r
  77         starYPositions(starIndex) = y\r
  78         starZPositions(starIndex) = z\r
  79     Next starIndex\r
  80 \r
  81     ' Add new stars to the galaxy if needed\r
  82     If maxStars - totalStars > Rnd * 800 + 100 Then CreateGalaxy: totalStars = totalStars + 1\r
  83 \r
  84     ' Remove the two farthest stars and replace them with new ones\r
  85     For a = 1 To 2\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
  90 \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
  98     Next a\r
  99 \r
 100 \r
 101     ' Check for user input to exit the program\r
 102     If InKey$ <> "" Then System\r
 103 \r
 104     ' sleep, to limit framerate\r
 105     Sound 0, 1\r
 106 Loop\r
 107 \r
 108 ' Subroutine to create a new galaxy of stars\r
 109 Sub CreateGalaxy\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
 114 \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
 122     Next starIndex\r
 123 \r
 124     ' Play a sound when creating new stars (commented out)\r
 125     ' SOUND 1000, 1\r
 126 End Sub\r
 127 \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
 132 \r
 133     starXPositions(starIndex) = xPosition\r
 134     starYPositions(starIndex) = yPosition\r
 135     starZPositions(starIndex) = zPosition\r
 136 End Sub\r
 137 \r