Fixed indentation and case
[qbasicapps.git] / graphics / 3D / stars.bas
index 1247455..dbd0701 100755 (executable)
-' 3D starfield\r
-' made by Svjatoslav Agejenko\r
-' in 2003.03\r
-' H-Page: svjatoslav.eu\r
-' E-Mail: svjatoslavagejenko@gmail.com\r
-\r
-DECLARE SUB setstar (x2!, y2!, z2!)\r
-DECLARE SUB galaxy ()\r
-DIM SHARED mitu\r
-DIM SHARED mituv\r
-\r
-\r
-RANDOMIZE TIMER\r
-mituv = 2000\r
-mitu = mituv\r
-rns = 500\r
-wl = 0\r
-\r
-DIM SHARED px(1 TO mitu + 1000)\r
-DIM SHARED py(1 TO mitu + 1000)\r
-DIM SHARED pz(1 TO mitu + 1000)\r
-\r
-FOR a = 1 TO mitu\r
-pz(a) = RND * 500 + 20\r
-  n = RND * 100\r
-  px(a) = SIN(n) * 20\r
-  py(a) = COS(n) * 20\r
-NEXT a\r
-\r
-\r
-SCREEN 13\r
-\r
-\r
-frm = 10\r
-1\r
-fps = fps + 1\r
-IF tm$ <> TIME$ THEN\r
-'LOCATE 1, 1\r
-'PRINT fps\r
-IF fps > 20 THEN wl = wl + 2 ELSE wl = wl - 1\r
-IF wl < 0 THEN wl = 0\r
-fps = 0\r
-tm$ = TIME$\r
-END IF\r
-frm = frm + 1\r
-xp = SIN(frm / 21) * 3\r
-yp = SIN(frm / 18) * 3\r
-\r
-nrk = (3.1412) / 2 + SIN(frm / 35) / 100 + SIN(frm / 21) / 100\r
-rs1 = SIN(nrk)\r
-rc1 = COS(nrk)\r
-\r
-FOR a = 1 TO mitu\r
-x = px(a)\r
-y = py(a)\r
-z = pz(a)\r
-x1 = x / z * 160 + 160\r
-y1 = y / z * 100 + 100\r
-PSET (x1, y1), 0\r
-\r
-x5 = x * rs1 - y * rc1\r
-y5 = x * rc1 + y * rs1\r
-\r
-x = x5\r
-y = y5\r
-\r
-z = z - 3\r
-x = x + xp\r
-y = y + yp\r
-IF z < 10 THEN\r
-z = RND * 300 + 400\r
-x = RND * 800 - 400\r
-y = RND * 800 - 400\r
-END IF\r
-\r
-x1 = x / z * 160 + 160\r
-y1 = y / z * 100 + 100\r
-c = 3000 / z + 15\r
-IF c > 31 THEN c = 31\r
-PSET (x1, y1), c\r
-\r
-px(a) = x\r
-py(a) = y\r
-pz(a) = z\r
-NEXT a\r
-\r
-\r
-IF mituv - mitu > rns THEN galaxy: rns = RND * 800 + 100\r
-\r
-FOR a = 1 TO 2\r
-b = RND * (mitu - 10) + 1\r
-SWAP px(mitu), px(b)\r
-SWAP py(mitu), py(b)\r
-SWAP pz(mitu), pz(b)\r
-\r
-x = px(mitu)\r
-y = py(mitu)\r
-z = pz(mitu)\r
-x1 = x / z * 160 + 160\r
-y1 = y / z * 100 + 100\r
-PSET (x1, y1), 0\r
-mitu = mitu - 1\r
-NEXT a\r
-\r
-'LOCATE 2, 1\r
-'PRINT wl\r
-FOR a = 0 TO wl\r
-FOR b = 0 TO 1000\r
-c = c / 100\r
-NEXT b\r
-NEXT a\r
-\r
-IF INKEY$ <> "" THEN SYSTEM\r
-GOTO 1\r
-\r
-SUB galaxy\r
-\r
-xf = RND * 4 - 2\r
-yf = RND * 4 - 2\r
-xp = RND * 200 - 100\r
-yp = RND * 200 - 100\r
-\r
-FOR a = 1 TO RND * 15 + 10 STEP .04\r
-x = SIN(a) * a * a / 10\r
-y = COS(a) * a * a / 10\r
-setstar x + RND * a * a / 30 + xp, y + RND * a * a / 30 + yp, 700 + RND * a * a / 30 + (x * xf) + (y * yf)\r
-NEXT a\r
-\r
-'SOUND 1000, 1\r
-END SUB\r
-\r
-SUB setstar (x2, y2, z2)\r
-mitu = mitu + 1\r
-s = mitu\r
-\r
-px(s) = x2\r
-py(s) = y2\r
-pz(s) = z2\r
-END SUB\r
+' 3D Starfield Simulation\r
+' Originally made by Svjatoslav Agejenko in 2003.03\r
+' In 2024 code was modernized using artificial intelligence\r
+' Homepage: svjatoslav.eu\r
+' Email: svjatoslav@svjatoslav.eu\r
+\r
+DECLARE SUB AddStar (xPosition AS SINGLE, yPosition AS SINGLE, zPosition AS SINGLE)\r
+DECLARE SUB CreateGalaxy ()\r
+\r
+Dim Shared totalStars As Integer\r
+Dim Shared maxStars As Integer\r
+\r
+Randomize Timer\r
+maxStars = 2000\r
+totalStars = maxStars\r
+starFieldDepth = 500\r
+\r
+Dim Shared starXPositions(1 To maxStars + 1000) As Single\r
+Dim Shared starYPositions(1 To maxStars + 1000) As Single\r
+Dim Shared starZPositions(1 To maxStars + 1000) As Single\r
+\r
+' Initialize the positions of the stars\r
+For starIndex = 1 To totalStars\r
+    starZPositions(starIndex) = Rnd * starFieldDepth + 20\r
+    angle = Rnd * 100\r
+    starXPositions(starIndex) = Sin(angle) * 20\r
+    starYPositions(starIndex) = Cos(angle) * 20\r
+Next starIndex\r
+\r
+Screen 13\r
+\r
+\r
+Do\r
+\r
+    ' Calculate the camera's rotation and position offsets\r
+    frameCount = frameCount + 1\r
+    cameraRotation = (3.1412 / 2) + Sin(frameCount / 35) / 100 + Sin(frameCount / 21) / 100\r
+    rs1 = Sin(cameraRotation)\r
+    rc1 = Cos(cameraRotation)\r
+\r
+    ' Update and draw each star\r
+    For starIndex = 1 To totalStars\r
+        x = starXPositions(starIndex)\r
+        y = starYPositions(starIndex)\r
+        z = starZPositions(starIndex)\r
+\r
+        ' Project the star's 3D position onto the 2D screen\r
+        projectedX = (x / z) * 160 + 160\r
+        projectedY = (y / z) * 100 + 100\r
+        PSet (projectedX, projectedY), 0 ' Erase the previous position\r
+\r
+        ' Rotate the star's position around the camera\r
+        x5 = x * rs1 - y * rc1\r
+        y5 = x * rc1 + y * rs1\r
+\r
+        ' Update the star's position with camera movement\r
+        x = x5 + Sin(frameCount / 21) * 3\r
+        y = y5 + Sin(frameCount / 18) * 3\r
+\r
+        ' Move the star closer to the viewer and wrap around if too close\r
+        z = z - 3\r
+        If z < 10 Then\r
+            z = Rnd * 300 + 400\r
+            x = Rnd * 800 - 400\r
+            y = Rnd * 800 - 400\r
+        End If\r
+\r
+        ' Project the new position and draw with perspective-based brightness\r
+        projectedX = (x / z) * 160 + 160\r
+        projectedY = (y / z) * 100 + 100\r
+        colorCode = 3000 / z + 15\r
+        If colorCode > 31 Then colorCode = 31\r
+        PSet (projectedX, projectedY), colorCode\r
+\r
+        ' Update the star's array positions\r
+        starXPositions(starIndex) = x\r
+        starYPositions(starIndex) = y\r
+        starZPositions(starIndex) = z\r
+    Next starIndex\r
+\r
+    ' Add new stars to the galaxy if needed\r
+    If maxStars - totalStars > Rnd * 800 + 100 Then CreateGalaxy: totalStars = totalStars + 1\r
+\r
+    ' Remove the two farthest stars and replace them with new ones\r
+    For a = 1 To 2\r
+        starIndex = Int(Rnd * (totalStars - 10)) + 1\r
+        Swap starXPositions(totalStars), starXPositions(starIndex)\r
+        Swap starYPositions(totalStars), starYPositions(starIndex)\r
+        Swap starZPositions(totalStars), starZPositions(starIndex)\r
+\r
+        x = starXPositions(totalStars)\r
+        y = starYPositions(totalStars)\r
+        z = starZPositions(totalStars)\r
+        projectedX = (x / z) * 160 + 160\r
+        projectedY = (y / z) * 100 + 100\r
+        PSet (projectedX, projectedY), 0 ' Erase the star\r
+        totalStars = totalStars - 1\r
+    Next a\r
+\r
+\r
+    ' Check for user input to exit the program\r
+    If InKey$ <> "" Then System\r
+\r
+    ' sleep, to limit framerate\r
+    Sound 0, 1\r
+Loop\r
+\r
+' Subroutine to create a new galaxy of stars\r
+Sub CreateGalaxy\r
+    xForce = Rnd * 4 - 2\r
+    yForce = Rnd * 4 - 2\r
+    xPositionOffset = Rnd * 200 - 100\r
+    yPositionOffset = Rnd * 200 - 100\r
+\r
+    ' Add a new set of stars with varying positions and velocities\r
+    For starIndex = 1 To Int(Rnd * 15) + 10 Step .04\r
+        x = Sin(starIndex) * starIndex * starIndex / 10\r
+        y = Cos(starIndex) * starIndex * starIndex / 10\r
+        AddStar x + RND * starIndex * starIndex / 30 + xPositionOffset, _\r
+                   y + RND * starIndex * starIndex / 30 + yPositionOffset, _\r
+                   700 + RND * starIndex * starIndex / 30 + (x * xForce) + (y * yForce)\r
+    Next starIndex\r
+\r
+    ' Play a sound when creating new stars (commented out)\r
+    ' SOUND 1000, 1\r
+End Sub\r
+\r
+' Subroutine to add a new star at the specified position\r
+Sub AddStar (xPosition As Single, yPosition As Single, zPosition As Single)\r
+    totalStars = totalStars + 1\r
+    starIndex = totalStars\r
+\r
+    starXPositions(starIndex) = xPosition\r
+    starYPositions(starIndex) = yPosition\r
+    starZPositions(starIndex) = zPosition\r
+End Sub\r
 \r