+++ /dev/null
-' Svjatoslav Agejenko\r
-' year 2001\r
-\r
-' arrow keys - move around\r
-' 2, 6, 4, 8 - look around\r
-' - - fly up\r
-' + - fly down\r
-\r
-DECLARE SUB mkkoll ()\r
-DECLARE SUB putkol ()\r
-DECLARE SUB rend ()\r
-DECLARE SUB env ()\r
-DECLARE SUB start ()\r
-DIM SHARED npo, nlo, np, nl\r
-DIM SHARED px(1 TO 1000)\r
-DIM SHARED py(1 TO 1000)\r
-DIM SHARED pz(1 TO 1000)\r
-DIM SHARED rpx(1 TO 1000)\r
-DIM SHARED rpy(1 TO 1000)\r
-DIM SHARED orpx(1 TO 1000)\r
-DIM SHARED orpy(1 TO 1000)\r
-DIM SHARED onp\r
-DIM SHARED lin1(1 TO 1000)\r
-DIM SHARED lin2(1 TO 1000)\r
-DIM SHARED linc(1 TO 1000)\r
-DIM SHARED olin1(1 TO 1000)\r
-DIM SHARED olin2(1 TO 1000)\r
-DIM SHARED onl\r
-DIM SHARED myx, myxs\r
-DIM SHARED myy, myys\r
-DIM SHARED myz, myzs\r
-DIM SHARED an1, an1s\r
-DIM SHARED an2, an2s\r
-DIM SHARED kolx(1 TO 10)\r
-DIM SHARED koly(1 TO 10)\r
-DIM SHARED kolz(1 TO 10)\r
-DIM SHARED kolxs(1 TO 10)\r
-DIM SHARED kolys(1 TO 10)\r
-DIM SHARED kolzs(1 TO 10)\r
-DIM SHARED kolm\r
-\r
-ON ERROR GOTO 2\r
-\r
-start\r
-env\r
-putkol\r
-\r
-' The main loop of the program\r
-1\r
-np = npo\r
-nl = nlo\r
-\r
-mkkoll\r
-rend\r
-\r
-' Update positions and angles\r
-myx = myx + myxs\r
-myy = myy + myys\r
-myz = myz + myzs\r
-an1 = an1 + an1s\r
-an2 = an2 + an2s\r
-\r
-a$ = INKEY$\r
-IF a$ <> "" THEN\r
-\r
- ' Handle arrow keys for movement\r
- IF a$ = CHR$(0) + "H" THEN\r
- myzs = myzs - SIN(an1) / 100\r
- myxs = myxs - COS(an1) / 100\r
- END IF\r
- IF a$ = CHR$(0) + "P" THEN\r
- myzs = myzs + SIN(an1) / 100\r
- myxs = myxs + COS(an1) / 100\r
- END IF\r
- IF a$ = CHR$(0) + "M" THEN\r
- myzs = myzs + COS(an1) / 100\r
- myxs = myxs - SIN(an1) / 100\r
- END IF\r
- IF a$ = CHR$(0) + "K" THEN\r
- myzs = myzs - COS(an1) / 100\r
- myxs = myxs + SIN(an1) / 100\r
- END IF\r
-\r
- ' Handle number keys for looking around\r
- IF a$ = "6" THEN an1s = an1s - .01\r
- IF a$ = "4" THEN an1s = an1s + .01\r
- IF a$ = "8" THEN an2s = an2s - .01\r
- IF a$ = "2" THEN an2s = an2s + .01\r
-\r
- ' Handle plus and minus keys for flying up and down\r
- IF a$ = "+" THEN myys = myys - .01\r
- IF a$ = "-" THEN myys = myys + .01\r
-\r
- ' Exit the program on pressing ESC\r
- IF a$ = CHR$(27) THEN SYSTEM\r
-END IF\r
-' Go back to the main loop\r
-GOTO 1\r
-\r
-2\r
-END\r
-RESUME\r
-\r
-SUB env\r
-\r
-' This subroutine initializes environment points\r
-FOR z = -5 TO 5\r
- FOR x = -5 TO 5\r
- np = np + 1\r
- px(np) = x\r
- py(np) = 0\r
- pz(np) = z\r
-\r
- ' Add lines between points\r
- IF x > -5 THEN\r
- nl = nl + 1\r
- lin1(nl) = np\r
- lin2(nl) = np - 1\r
- linc(nl) = 3\r
- END IF\r
- IF z > -5 THEN\r
- nl = nl + 1\r
- lin1(nl) = np\r
- lin2(nl) = np - 11\r
- linc(nl) = 3\r
- END IF\r
- NEXT x\r
-NEXT z\r
-\r
-' Store the number of points and lines\r
-npo = np\r
-nlo = nl\r
-\r
-END SUB\r
-\r
-SUB env1\r
-\r
-' This subroutine initializes a simple environment with two points\r
-np = 1\r
-px(np) = -2\r
-py(np) = 0\r
-pz(np) = 0\r
-\r
-np = np + 1\r
-px(np) = 2\r
-py(np) = 0\r
-pz(np) = 0\r
-\r
-' Add a line between the two points\r
-nl = 1\r
-lin1(nl) = 1\r
-lin2(nl) = 2\r
-linc(nl) = 14\r
-\r
-END SUB\r
-\r
-SUB mkkoll\r
-\r
-' This subroutine updates the positions and angles of colliders\r
-FOR a = 1 TO kolm\r
- x = kolx(a)\r
- y = koly(a)\r
- z = kolz(a)\r
- xs = kolxs(a)\r
- ys = kolys(a)\r
- zs = kolzs(a)\r
-\r
- ' Update the Y-axis position\r
- ys = ys - .01\r
-\r
- ' Update the X and Z positions\r
- x = x + xs\r
- y = y + ys\r
- z = z + zs\r
-\r
- ' Bounce off walls\r
- IF x > 5 THEN xs = -.1\r
- IF z > 5 THEN zs = -.1\r
- IF x < -5 THEN xs = .1\r
- IF z < -5 THEN zs = .1\r
-\r
- ' Reset Y position if it falls below a threshold\r
- IF y < .5 THEN ys = RND * .2 + .1\r
-\r
- ' Create lines for visualization\r
- nl = nl + 1\r
- lin1(nl) = np + 1\r
- lin2(nl) = np + 2\r
- linc(nl) = 14\r
-\r
- nl = nl + 1\r
- lin1(nl) = np + 3\r
- lin2(nl) = np + 2\r
- linc(nl) = 14\r
-\r
- nl = nl + 1\r
- lin1(nl) = np + 3\r
- lin2(nl) = np + 4\r
- linc(nl) = 14\r
-\r
- nl = nl + 1\r
- lin1(nl) = np + 1\r
- lin2(nl) = np + 4\r
- linc(nl) = 14\r
-\r
- nl = nl + 1\r
- lin1(nl) = np + 1\r
- lin2(nl) = np + 5\r
- linc(nl) = 14\r
-\r
- nl = nl + 1\r
- lin1(nl) = np + 2\r
- lin2(nl) = np + 6\r
- linc(nl) = 14\r
-\r
- nl = nl + 1\r
- lin1(nl) = np + 3\r
- lin2(nl) = np + 7\r
- linc(nl) = 14\r
-\r
- nl = nl + 1\r
- lin1(nl) = np + 4\r
- lin2(nl) = np + 8\r
- linc(nl) = 14\r
-\r
- nl = nl + 1\r
- lin1(nl) = np + 5\r
- lin2(nl) = np + 6\r
- linc(nl) = 14\r
-\r
- nl = nl + 1\r
- lin1(nl) = np + 7\r
- lin2(nl) = np + 6\r
- linc(nl) = 14\r
-\r
- nl = nl + 1\r
- lin1(nl) = np + 7\r
- lin2(nl) = np + 8\r
- linc(nl) = 14\r
-\r
- nl = nl + 1\r
- lin1(nl) = np + 5\r
- lin2(nl) = np + 8\r
- linc(nl) = 14\r
-\r
- ' Update the array with new positions and speeds\r
- np = np + 1\r
- px(np) = x - .5\r
- py(np) = y - .5\r
- pz(np) = z - .5\r
-\r
- np = np + 1\r
- px(np) = x + .5\r
- py(np) = y - .5\r
- pz(np) = z - .5\r
-\r
- np = np + 1\r
- px(np) = x + .5\r
- py(np) = y + .5\r
- pz(np) = z - .5\r
-\r
- np = np + 1\r
- px(np) = x - .5\r
- py(np) = y + .5\r
- pz(np) = z - .5\r
-\r
- np = np + 1\r
- px(np) = x - .5\r
- py(np) = y - .5\r
- pz(np) = z + .5\r
-\r
- np = np + 1\r
- px(np) = x + .5\r
- py(np) = y - .5\r
- pz(np) = z + .5\r
-\r
- np = np + 1\r
- px(np) = x + .5\r
- py(np) = y + .5\r
- pz(np) = z + .5\r
-\r
- np = np + 1\r
- px(np) = x - .5\r
- py(np) = y + .5\r
- pz(np) = z + .5\r
-\r
- ' Update the collider array with new positions and speeds\r
- kolx(a) = x\r
- koly(a) = y\r
- kolz(a) = z\r
- kolxs(a) = xs\r
- kolys(a) = ys\r
- kolzs(a) = zs\r
-NEXT a\r
-\r
-END SUB\r
-\r
-SUB putkol\r
-\r
-' This subroutine initializes colliders with random positions and speeds\r
-FOR a = 1 TO kolm\r
- kolx(a) = RND * 10 - 5\r
- koly(a) = 2\r
- kolz(a) = RND * 10 - 5\r
- kolxs(a) = RND * .5 - .25\r
- kolys(a) = RND * .5 + .1\r
- kolzs(a) = RND * .5 - .25\r
-NEXT a\r
-\r
-END SUB\r
-\r
-SUB rend\r
-\r
-' Calculate sine and cosine for angle rotation\r
-s1 = SIN(an1)\r
-c1 = COS(an1)\r
-s2 = SIN(an2)\r
-c2 = COS(an2)\r
-\r
-' Loop through all points to render them\r
-FOR a = 1 TO np\r
- x = px(a) + myx\r
- y = py(a) - myy\r
- z = pz(a) + myz\r
-\r
- ' Rotate the point\r
- x1 = x * s1 - z * c1\r
- z1 = x * c1 + z * s1\r
- y1 = y * s2 - z1 * c2\r
- z2 = y * c2 + z1 * s2\r
-\r
- ' Project the 3D point to a 2D screen coordinate\r
- IF z2 < .1 THEN\r
- rpx(a) = -1\r
- ELSE\r
- rpx(a) = 320 + (x1 / z2 * 400)\r
- rpy(a) = 240 - (y1 / z2 * 400)\r
- END IF\r
-NEXT a\r
-\r
-' Render all lines\r
-FOR a = 1 TO nl\r
- l1 = olin1(a)\r
- l2 = olin2(a)\r
- ' Skip rendering if either end of the line is out of view\r
- IF orpx(l1) = -1 OR orpx(l2) = -1 THEN\r
- ELSE\r
- LINE (orpx(l1), orpy(l1))-(orpx(l2), orpy(l2)), 0\r
- END IF\r
-\r
- ' Update line indices for next frame\r
- l1 = lin1(a)\r
- l2 = lin2(a)\r
- ' Skip rendering if either end of the line is out of view\r
- IF rpx(l1) = -1 OR rpx(l2) = -1 THEN\r
- ELSE\r
- LINE (rpx(l1), rpy(l1))-(rpx(l2), rpy(l2)), linc(a)\r
- END IF\r
-NEXT\r
-\r
-' Handle lines that were added during the frame\r
-IF nl < onl THEN\r
- FOR a = nl + 1 TO onl\r
- l1 = olin1(a)\r
- l2 = olin2(a)\r
- ' Skip rendering if either end of the line is out of view\r
- IF orpx(l1) = -1 OR orpx(l2) = -1 THEN\r
- ELSE\r
- LINE (orpx(l1), orpy(l1))-(orpx(l2), orpy(l2)), 0\r
- END IF\r
- NEXT\r
-END IF\r
-\r
-' Save the current frame's points and lines for next frame\r
-FOR a = 1 TO np\r
- orpx(a) = rpx(a)\r
- orpy(a) = rpy(a)\r
-NEXT a\r
-onp = np\r
-\r
-FOR a = 1 TO nl\r
- olin1(a) = lin1(a)\r
- olin2(a) = lin2(a)\r
-NEXT a\r
-onl = nl\r
-\r
-END SUB\r
-\r
-SUB start\r
-\r
-' Initialize the screen and variables\r
-SCREEN 12\r
-npo = 0\r
-nlo = 0\r
-np = npo\r
-nl = nlo\r
-kolm = 9\r
-\r
-myx = 0\r
-myy = 4\r
-myz = 7\r
-an1 = 3.14 / 2\r
-an2 = an1 + .6\r
-\r
-' Initialize all lines to have a thickness of 4\r
-FOR a = 1 TO 1000\r
- linc(a) = 4\r
-NEXT a\r
-\r
-' Store the initial state of all lines\r
-FOR a = 1 TO 1000\r
- olin1(a) = 1\r
- olin2(a) = 1\r
-NEXT a\r
-\r
-END SUB
\ No newline at end of file
--- /dev/null
+' 3D Universe Explorer. User can freely fly around.\r
+' Universe is made of galaxy clusters.\r
+' Galaxy cluster is made of galaxies.\r
+' Galaxies are made of stars.\r
+'\r
+' Total amount of stars in the universe is enormous.\r
+' This program implements clever algorithm to dynamically increase\r
+' and decrease level of detail of the universe regions depending\r
+' on where user is in the universe and maintaining reasonable\r
+' quantity of stars to render at any given time.\r
+'\r
+' By Svjatoslav Agejenko.\r
+' Email: svjatoslav@svjatoslav.eu\r
+' Homepage: http://www.svjatoslav.eu\r
+'\r
+' Changelog:\r
+' 2003.12, Initial version\r
+' 2024, Improved program readability using AI\r
+\r
+DECLARE SUB loadScript (scriptName$)\r
+\r
+DECLARE SUB timerAdd (element!, time!, value!)\r
+DECLARE SUB timerinit ()\r
+DECLARE SUB timerprocess ()\r
+\r
+DECLARE SUB getCloudXYZ (a!, x1!, y1!, z2!)\r
+DECLARE FUNCTION gdist! (x!, y!, z!)\r
+DECLARE SUB mkworld ()\r
+DECLARE SUB galacloud (rx!, ry!, rz!)\r
+DECLARE SUB temp ()\r
+DECLARE SUB mkgalaxy (x!, y!, z!)\r
+DECLARE SUB rndinit ()\r
+DECLARE FUNCTION rn! ()\r
+DECLARE SUB disp ()\r
+DECLARE SUB startext ()\r
+DECLARE SUB control ()\r
+DECLARE SUB putbyte (addr!, dat!)\r
+DECLARE SUB putword (addr!, dat!)\r
+DECLARE FUNCTION getword! (addr!)\r
+DECLARE FUNCTION getbyte! (addr!)\r
+DECLARE SUB start ()\r
+DECLARE SUB animate ()\r
+\r
+DIM SHARED an1, an2, an3\r
+\r
+DIM SHARED tim\r
+\r
+DIM SHARED extSEG, extADDR\r
+\r
+DIM SHARED myx, myy, myz\r
+DIM SHARED myxs, myys, myzs\r
+DIM SHARED buttL, buttR\r
+DIM SHARED maxmove\r
+\r
+DIM SHARED zoom\r
+DIM SHARED rndval(0 TO 10000)\r
+DIM SHARED rndp\r
+\r
+DIM SHARED px(1 TO 10000)\r
+DIM SHARED py(1 TO 10000)\r
+DIM SHARED pz(1 TO 10000)\r
+DIM SHARED pc(1 TO 10000)\r
+DIM SHARED nump\r
+DIM SHARED myspd\r
+\r
+DIM SHARED tempr(0 TO 10)\r
+\r
+DIM SHARED vd\r
+\r
+DIM SHARED oftcloud(0 TO 3)\r
+\r
+DIM SHARED oftGalaX(0 TO 19)\r
+DIM SHARED oftGalaY(0 TO 19)\r
+DIM SHARED oftGalaZ(0 TO 19)\r
+\r
+DIM SHARED timerTime(0 TO 50, 0 TO 100)\r
+DIM SHARED timerValue(0 TO 50, 0 TO 100)\r
+\r
+DIM SHARED timerCplace(0 TO 50)\r
+DIM SHARED timerCtime(0 TO 50)\r
+DIM SHARED timerCvalue(0 TO 50)\r
+DIM SHARED timerLast\r
+\r
+DIM SHARED timerStartScript\r
+DIM SHARED ScriptRunning\r
+\r
+start\r
+\r
+cx = 0\r
+cy = 0\r
+cz = 0\r
+\r
+myx = 123456\r
+myy = 321\r
+myz = 23\r
+\r
+nump = 9999\r
+1\r
+mkworld\r
+\r
+va = INT(RND * 3)\r
+\r
+SELECT CASE va\r
+CASE 0\r
+ cx = RND * 500 - 250\r
+CASE 1\r
+ cy = RND * 100 - 50\r
+CASE 2\r
+ cz = RND * 500 - 250\r
+END SELECT\r
+\r
+control\r
+disp\r
+\r
+timerprocess\r
+\r
+PCOPY 0, 1\r
+CLS\r
+GOTO 1\r
+\r
+SUB control\r
+\r
+IF getbyte(8) <> 0 THEN\r
+ putbyte 8, 0\r
+ xp = getword(2)\r
+ putword 2, 0\r
+ yp = getword(4)\r
+ putword 4, 0\r
+ butt = getword(6)\r
+ putword 6, 0\r
+ buttL = 0\r
+ buttR = 0\r
+ IF butt = 1 THEN buttL = 1\r
+ IF butt = 2 THEN buttR = 1\r
+ IF butt = 3 THEN buttL = 1: buttR = 1\r
+\r
+ IF buttR = 1 THEN\r
+ IF buttL = 1 THEN\r
+ myxs = myxs + SIN(an1) * yp / 4\r
+ myzs = myzs - COS(an1) * yp / 4\r
+ GOTO 3\r
+ END IF\r
+ myys = myys + yp / 4\r
+3\r
+ yp = 0\r
+ END IF\r
+\r
+END IF\r
+\r
+IF xp < -maxmove THEN xp = -maxmove\r
+IF xp > maxmove THEN xp = maxmove\r
+an1 = an1 - xp / 150\r
+\r
+IF yp < -maxmove THEN yp = -maxmove\r
+IF yp > maxmove THEN yp = maxmove\r
+an2 = an2 - yp / 150\r
+\r
+a$ = INKEY$\r
+\r
+IF a$ = "a" THEN myxs = myxs - COS(an1): myzs = myzs - SIN(an1)\r
+IF a$ = "d" THEN myxs = myxs + COS(an1): myzs = myzs + SIN(an1)\r
+IF a$ = "w" THEN myxs = myxs - SIN(an1): myzs = myzs + COS(an1)\r
+IF a$ = "s" THEN myxs = myxs + SIN(an1): myzs = myzs - COS(an1)\r
+\r
+IF a$ = "1" THEN myspd = .1\r
+IF a$ = "2" THEN myspd = 1\r
+IF a$ = "3" THEN myspd = 10\r
+IF a$ = "4" THEN myspd = 100\r
+IF a$ = "5" THEN myspd = 1000\r
+IF a$ = "6" THEN myspd = 10000\r
+IF a$ = "7" THEN myspd = 100000\r
+IF a$ = "8" THEN myspd = 1000000\r
+\r
+IF a$ = "q" THEN SYSTEM\r
+\r
+IF a$ = " " THEN\r
+ IF timerStartScript = 0 THEN\r
+ OPEN "script.dat" FOR OUTPUT AS #1\r
+ timerStartScript = TIMER\r
+ END IF\r
+ PRINT #1, TIMER - timerStartScript;\r
+ PRINT #1, myx; myy; myz; an1; an2\r
+ SOUND 2000, .1\r
+END IF\r
+\r
+IF a$ = "r" THEN\r
+ IF ScriptRunning = 0 THEN\r
+ timerinit\r
+ loadScript "script.dat"\r
+ ELSE\r
+ ScriptRunning = 0\r
+\r
+ END IF\r
+END IF\r
+\r
+myxs = myxs / 1.1\r
+myys = myys / 1.1\r
+myzs = myzs / 1.1\r
+\r
+myx = myx + myxs * myspd\r
+myz = myz + myzs * myspd\r
+myy = myy + myys * myspd\r
+\r
+IF ScriptRunning = 1 THEN\r
+ myx = timerCvalue(1)\r
+ myy = timerCvalue(2)\r
+ myz = timerCvalue(3)\r
+ an1 = timerCvalue(4)\r
+ an2 = timerCvalue(5)\r
+END IF\r
+\r
+END SUB\r
+\r
+SUB disp\r
+\r
+s1 = SIN(an1)\r
+c1 = COS(an1)\r
+s2 = SIN(an2)\r
+c2 = COS(an2)\r
+\r
+vdn = 100000000\r
+\r
+FOR a = 1 TO nump\r
+\r
+ x = px(a) - myx\r
+ y = py(a) - myy\r
+ z = pz(a) - myz\r
+\r
+ IF ABS(x) < vdn THEN\r
+ IF ABS(y) < vdn THEN\r
+ IF ABS(z) < vdn THEN vdn = SQR(x * x + y * y + z * z)\r
+ END IF\r
+ END IF\r
+\r
+ x1 = x * c1 + z * s1\r
+ z1 = z * c1 - x * s1\r
+\r
+ y1 = y * c2 + z1 * s2\r
+ z2 = z1 * c2 - y * s2\r
+\r
+ IF z2 > 3 THEN\r
+ PSET (x1 / z2 * 130 + 160, y1 / z2 * 130 + 100), pc(a)\r
+ END IF\r
+\r
+NEXT a\r
+\r
+vd = (vd * 5 + vdn) / 6\r
+\r
+END SUB\r
+\r
+SUB galacloud (rx, ry, rz)\r
+\r
+a = INT(RND * 100)\r
+\r
+d = (a + 30) * 500\r
+\r
+x = d\r
+y = 0\r
+z = 0\r
+\r
+a1 = SIN(a * (123.45 - (rx MOD 1235))) * 100\r
+a2 = SIN(a * 324 + (ry MOD 5431)) * 120\r
+\r
+s1 = SIN(a1)\r
+c1 = COS(a1)\r
+s2 = SIN(a2)\r
+c2 = COS(a2)\r
+\r
+x1 = x * c1 + z * s1\r
+z1 = z * c1 - x * s1\r
+\r
+y1 = y * c2 + z1 * s2\r
+z2 = z1 * c2 - y * s2\r
+\r
+fx = x1 + rx\r
+fy = y1 + ry\r
+fz = z2 + rz\r
+\r
+dist = gdist(fx, fy, fz)\r
+\r
+IF dist < 20000 THEN\r
+ pl = INT(RND * 20)\r
+ oftGalaX(pl) = fx\r
+ oftGalaY(pl) = fy\r
+ oftGalaZ(pl) = fz\r
+ mkgalaxy fx, fy, fz\r
+ELSE\r
+ IF (RND * 100 < 10) OR (vd > 500000) THEN\r
+ mkgalaxy fx, fy, fz\r
+ END IF\r
+END IF\r
+\r
+END SUB\r
+\r
+FUNCTION gdist (x, y, z)\r
+gdist = SQR((x - myx) ^ 2 + (y - myy) ^ 2 + (z - myz) ^ 2)\r
+\r
+END FUNCTION\r
+\r
+FUNCTION getbyte (addr)\r
+getbyte = PEEK(extADDR + addr)\r
+END FUNCTION\r
+\r
+SUB getCloudXYZ (a, x1, y1, z2)\r
+\r
+d = a * 1000000\r
+\r
+x = d\r
+y = 0\r
+z = 0\r
+\r
+a1 = SIN(a * 123) * 100\r
+a2 = SIN(a * 975) * 120\r
+\r
+s1 = SIN(a1)\r
+c1 = COS(a1)\r
+s2 = SIN(a2)\r
+c2 = COS(a2)\r
+\r
+x1 = x * c1 + z * s1\r
+z1 = z * c1 - x * s1\r
+\r
+y1 = y * c2 + z1 * s2\r
+z2 = z1 * c2 - y * s2\r
+\r
+END SUB\r
+\r
+FUNCTION getword (addr)\r
+a = PEEK(extADDR + addr)\r
+b = PEEK(extADDR + addr + 1)\r
+\r
+c$ = HEX$(a)\r
+IF LEN(c$) = 1 THEN c$ = "0" + c$\r
+IF LEN(c$) = 0 THEN c$ = "00"\r
+\r
+c = VAL("&H" + HEX$(b) + c$)\r
+\r
+getword = c\r
+END FUNCTION\r
+\r
+SUB loadScript (scriptName$)\r
+ScriptRunning = 1\r
+rt = 2\r
+\r
+OPEN scriptName$ FOR INPUT AS #2\r
+5\r
+IF EOF(2) <> 0 THEN GOTO 6\r
+\r
+INPUT #2, t\r
+t = t / 2\r
+rt = rt + 6\r
+FOR a = 1 TO 5\r
+ INPUT #2, b\r
+ timerAdd a, rt, b\r
+NEXT a\r
+\r
+GOTO 5\r
+6\r
+CLOSE #2\r
+\r
+FOR a = 1 TO 5\r
+ timerAdd a, -1, b\r
+NEXT a\r
+\r
+END SUB\r
+\r
+SUB mkgalaxy (lx, ly, lz)\r
+\r
+IF (lx = 0) AND (ly = 0) AND (lz = 0) THEN GOTO 4\r
+\r
+rndp = ABS(lx + ly + lz) MOD 9000\r
+n1 = rn * 100\r
+n2 = rn * 100\r
+n3 = rn * 100\r
+\r
+gs1 = SIN(n1)\r
+gc1 = COS(n1)\r
+gs2 = SIN(n2)\r
+gc2 = COS(n2)\r
+gs3 = SIN(n3)\r
+gc3 = COS(n3)\r
+\r
+siz = rn * 50 + 75\r
+pi = 3.14\r
+sbm = INT(rn * 3) + 1\r
+\r
+dist = gdist(lx, ly, lz)\r
+amo = 1\r
+IF dist < 20000 THEN amo = 1\r
+IF dist < 5000 THEN amo = 2\r
+IF dist < 1000 THEN amo = 10\r
+IF dist < 500 THEN amo = 50\r
+\r
+FOR a = 1 TO amo\r
+\r
+ b = RND * 10\r
+ s = b * b / 30\r
+\r
+ v1 = RND * (11.5 - b) / 3\r
+ v1p = v1 / 2\r
+\r
+ ane = RND * (s / 2) / sbm * 2\r
+ sba = 2 * pi / sbm * INT(RND * sbm)\r
+\r
+ x = (SIN(b - sba + ane) * s + RND * v1 - v1p) * siz\r
+ z = (COS(b - sba + ane) * s + RND * v1 - v1p) * siz\r
+ y = (RND * v1 - v1p) * siz\r
+\r
+ x1 = x * gc1 + z * gs1\r
+ z1 = z * gc1 - x * gs1\r
+\r
+ y1 = y * gc2 + z1 * gs2\r
+ z2 = z1 * gc2 - y * gs2\r
+\r
+ y2 = y1 * gc3 + x1 * gs3\r
+ x2 = x1 * gc3 - y1 * gs3\r
+\r
+ pla = INT(RND * nump) + 1\r
+\r
+ px(pla) = x2 + lx\r
+ py(pla) = y2 + ly\r
+ pz(pla) = z2 + lz\r
+ pc(pla) = INT(RND * 15) + 1\r
+NEXT a\r
+\r
+4\r
+END SUB\r
+\r
+SUB mkworld\r
+\r
+FOR b = 1 TO 10\r
+ a = INT(RND * 100)\r
+ getCloudXYZ a, x, y, z\r
+ IF gdist(x, y, z) < vd * 3 THEN oftcloud(INT(RND * 4)) = a\r
+ galacloud x, y, z\r
+NEXT b\r
+\r
+IF vd < 4000000 THEN\r
+ FOR b = 0 TO 3\r
+ a = oftcloud(b)\r
+ getCloudXYZ a, x, y, z\r
+ galacloud x, y, z\r
+ NEXT b\r
+END IF\r
+\r
+IF vd < 10000 THEN\r
+\r
+ FOR b = 0 TO 19\r
+ x = oftGalaX(b)\r
+ y = oftGalaY(b)\r
+ z = oftGalaZ(b)\r
+ mkgalaxy x, y, z\r
+ NEXT b\r
+ELSE\r
+END IF\r
+\r
+END SUB\r
+\r
+SUB mousedemo\r
+\r
+cx = 150\r
+cy = 100\r
+maxmove = 50\r
+100\r
+frm = frm + 1\r
+\r
+LOCATE 1, 1\r
+PRINT cx, cy\r
+PRINT frm\r
+\r
+CIRCLE (cx, cy), 10, 0\r
+xp = getword(2)\r
+putword 2, 0\r
+yp = getword(4)\r
+putword 4, 0\r
+\r
+IF xp < -maxmove THEN xp = -maxmove\r
+IF xp > maxmove THEN xp = maxmove\r
+cx = cx + xp\r
+\r
+IF yp < -maxmove THEN yp = -maxmove\r
+IF yp > maxmove THEN yp = maxmove\r
+cy = cy + yp\r
+\r
+CIRCLE (cx, cy), 10, 10\r
+\r
+SOUND 0, .05\r
+GOTO 100\r
+\r
+END SUB\r
+\r
+SUB putbyte (addr, dat)\r
+\r
+POKE (extADDR + addr), dat\r
+END SUB\r
+\r
+SUB putword (addr, dat)\r
+\r
+b$ = HEX$(dat)\r
+\r
+2\r
+IF LEN(b$) < 4 THEN b$ = "0" + b$: GOTO 2\r
+\r
+n1 = VAL("&H" + LEFT$(b$, 2))\r
+n2 = VAL("&H" + RIGHT$(b$, 2))\r
+\r
+POKE (extADDR + addr), n2\r
+POKE (extADDR + addr + 1), n1\r
+\r
+END SUB\r
+\r
+FUNCTION rn\r
+\r
+rndp = rndp + 1\r
+IF rndp > 10000 THEN rndp = 0\r
+rn = rndval(rndp)\r
+\r
+END FUNCTION\r
+\r
+SUB rndinit\r
+\r
+FOR a = 0 TO 10000\r
+ rndval(a) = RND\r
+NEXT a\r
+\r
+rndp = 0\r
+END SUB\r
+\r
+SUB start\r
+\r
+PRINT "Universe Explorer"\r
+PRINT "by Svjatoslav Agejenko, n0@hot.ee"\r
+PRINT "2003.12"\r
+PRINT\r
+PRINT "Use mouse to aim."\r
+PRINT "Use keys: a, s, d, w to move around,"\r
+PRINT "1 2 3 4 5 6 7 to change speed multiplier."\r
+PRINT "r - to start/stop demo."\r
+PRINT "q - to quit program."\r
+\r
+PRINT "right mouse button, to move UP <> DOWN."\r
+PRINT "both right & left mouse buttons pressed to move BACK <> FRONT."\r
+\r
+PRINT "At least P3 500 MHz, would be nice."\r
+PRINT "Better CPU, more details and higher framerate."\r
+PRINT "Requires mouse driver, and QBasic extension TSR"\r
+PRINT "to be loaded first."\r
+\r
+PRINT\r
+PRINT "In this program:"\r
+\r
+PRINT "Several stars, make up galaxy."\r
+PRINT "Several galaxies makes metagalaxy."\r
+PRINT "Several metagalaxies makes up universe."\r
+\r
+PRINT\r
+PRINT "Press Any key To Continue."\r
+a$ = INPUT$(1)\r
+\r
+startext\r
+\r
+SCREEN 7, , , 1\r
+\r
+maxmove = 50\r
+rndinit\r
+myspd = 1000000\r
+\r
+END SUB\r
+\r
+SUB startext\r
+\r
+DEF SEG = 0 ' read first from interrupt table\r
+\r
+extSEG = PEEK(&H79 * 4 + 3) * 256\r
+extSEG = extSEG + PEEK(&H79 * 4 + 2)\r
+\r
+PRINT "Segment is: " + HEX$(extSEG)\r
+\r
+extADDR = PEEK(&H79 * 4 + 1) * 256\r
+extADDR = extADDR + PEEK(&H79 * 4 + 0)\r
+\r
+PRINT "relative address is:"; extADDR\r
+\r
+DEF SEG = extSEG\r
+\r
+IF getword(0) <> 1983 THEN\r
+ PRINT "FATAL ERROR: you must load"\r
+ PRINT "QBasic extension TSR first!"\r
+ SYSTEM\r
+END IF\r
+\r
+END SUB\r
+\r
+SUB timerAdd (element, time, value)\r
+\r
+FOR a = 0 TO 100\r
+ IF (timerTime(element, a) = 0) AND (timerValue(element, a) = 0) THEN GOTO timer3\r
+NEXT a\r
+timer3:\r
+\r
+timerTime(element, a) = time\r
+timerValue(element, a) = value\r
+\r
+END SUB\r
+\r
+SUB timerdisp\r
+LOCATE 1, 1\r
+\r
+FOR a = 0 TO 10\r
+ PRINT timerCplace(a), timerCtime(a), timerCvalue(a)\r
+NEXT a\r
+\r
+END SUB\r
+\r
+SUB timerinit\r
+timerLast = TIMER\r
+\r
+FOR a = 1 TO 50\r
+ FOR b = 1 TO 100\r
+ timerTime(a, b) = 0\r
+ timerValue(a, b) = 0\r
+ NEXT b\r
+NEXT a\r
+\r
+END SUB\r
+\r
+SUB timerprocess\r
+\r
+timerCurrent = TIMER\r
+timerDiff = timerCurrent - timerLast\r
+timerLast = timerCurrent\r
+\r
+FOR a = 0 TO 50\r
+ ctim = timerCtime(a) + timerDiff\r
+ Cplace = timerCplace(a)\r
+timer2:\r
+ IF timerTime(a, Cplace + 1) = -1 THEN\r
+ ctim = 0\r
+ Cplace = 0\r
+ END IF\r
+ IF timerTime(a, Cplace + 1) < ctim THEN\r
+ IF timerTime(a, Cplace + 1) = 0 THEN\r
+ timerCvalue(a) = timerValue(a, Cplace)\r
+ GOTO timer1:\r
+ END IF\r
+ Cplace = Cplace + 1\r
+ GOTO timer2\r
+ END IF\r
+\r
+ v1 = timerValue(a, Cplace)\r
+ t1 = timerTime(a, Cplace)\r
+ v2 = timerValue(a, Cplace + 1)\r
+ t2 = timerTime(a, Cplace + 1)\r
+\r
+ IF v1 = v2 THEN\r
+ timerCvalue(a) = v1\r
+ ELSE\r
+ Tdiff1 = t2 - t1\r
+ Tdiff2 = ctim - t1\r
+ Vdiff = v2 - v1\r
+ timerCvalue(a) = Tdiff2 / Tdiff1 * Vdiff + v1\r
+ END IF\r
+timer1:\r
+ timerCplace(a) = Cplace\r
+ timerCtime(a) = ctim\r
+NEXT a\r
+\r
+END SUB\r
+\r
+++ /dev/null
-' 3D Universe Explorer
-' made by Svjatoslav Agejenko
-' in 2003.12
-' H-Page: svjatoslav.eu
-' E-Mail: svjatoslav@svjatoslav.eu
-
-DECLARE SUB loadScript (scriptName$)
-
-DECLARE SUB timerAdd (element!, time!, value!)
-DECLARE SUB timerinit ()
-DECLARE SUB timerprocess ()
-
-DECLARE SUB getCloudXYZ (a!, x1!, y1!, z2!)
-DECLARE FUNCTION gdist! (x!, y!, z!)
-DECLARE SUB mkworld ()
-DECLARE SUB galacloud (rx!, ry!, rz!)
-DECLARE SUB temp ()
-DECLARE SUB mkgalaxy (x!, y!, z!)
-DECLARE SUB rndinit ()
-DECLARE FUNCTION rn! ()
-DECLARE SUB disp ()
-DECLARE SUB startext ()
-DECLARE SUB control ()
-DECLARE SUB putbyte (addr!, dat!)
-DECLARE SUB putword (addr!, dat!)
-DECLARE FUNCTION getword! (addr!)
-DECLARE FUNCTION getbyte! (addr!)
-DECLARE SUB start ()
-DECLARE SUB animate ()
-
-DIM SHARED an1, an2, an3
-
-DIM SHARED tim
-
-DIM SHARED extSEG, extADDR
-
-DIM SHARED myx, myy, myz
-DIM SHARED myxs, myys, myzs
-DIM SHARED buttL, buttR
-DIM SHARED maxmove
-
-DIM SHARED zoom
-DIM SHARED rndval(0 TO 10000)
-DIM SHARED rndp
-
-DIM SHARED px(1 TO 10000)
-DIM SHARED py(1 TO 10000)
-DIM SHARED pz(1 TO 10000)
-DIM SHARED pc(1 TO 10000)
-DIM SHARED nump
-DIM SHARED myspd
-
-DIM SHARED tempr(0 TO 10)
-
-DIM SHARED vd
-
-DIM SHARED oftcloud(0 TO 3)
-
-DIM SHARED oftGalaX(0 TO 19)
-DIM SHARED oftGalaY(0 TO 19)
-DIM SHARED oftGalaZ(0 TO 19)
-
-DIM SHARED timerTime(0 TO 50, 0 TO 100)
-DIM SHARED timerValue(0 TO 50, 0 TO 100)
-
-DIM SHARED timerCplace(0 TO 50)
-DIM SHARED timerCtime(0 TO 50)
-DIM SHARED timerCvalue(0 TO 50)
-DIM SHARED timerLast
-
-DIM SHARED timerStartScript
-DIM SHARED ScriptRunning
-
-start
-
-cx = 0
-cy = 0
-cz = 0
-
-myx = 123456
-myy = 321
-myz = 23
-
-nump = 9999
-1
-mkworld
-
-va = INT(RND * 3)
-
-SELECT CASE va
-CASE 0
- cx = RND * 500 - 250
-CASE 1
- cy = RND * 100 - 50
-CASE 2
- cz = RND * 500 - 250
-END SELECT
-
-control
-disp
-
-timerprocess
-
-PCOPY 0, 1
-CLS
-GOTO 1
-
-SUB control
-
-IF getbyte(8) <> 0 THEN
- putbyte 8, 0
- xp = getword(2)
- putword 2, 0
- yp = getword(4)
- putword 4, 0
- butt = getword(6)
- putword 6, 0
- buttL = 0
- buttR = 0
- IF butt = 1 THEN buttL = 1
- IF butt = 2 THEN buttR = 1
- IF butt = 3 THEN buttL = 1: buttR = 1
-
- IF buttR = 1 THEN
- IF buttL = 1 THEN
- myxs = myxs + SIN(an1) * yp / 4
- myzs = myzs - COS(an1) * yp / 4
- GOTO 3
- END IF
- myys = myys + yp / 4
-3
- yp = 0
- END IF
-
-END IF
-
-IF xp < -maxmove THEN xp = -maxmove
-IF xp > maxmove THEN xp = maxmove
-an1 = an1 - xp / 150
-
-IF yp < -maxmove THEN yp = -maxmove
-IF yp > maxmove THEN yp = maxmove
-an2 = an2 - yp / 150
-
-a$ = INKEY$
-
-IF a$ = "a" THEN myxs = myxs - COS(an1): myzs = myzs - SIN(an1)
-IF a$ = "d" THEN myxs = myxs + COS(an1): myzs = myzs + SIN(an1)
-IF a$ = "w" THEN myxs = myxs - SIN(an1): myzs = myzs + COS(an1)
-IF a$ = "s" THEN myxs = myxs + SIN(an1): myzs = myzs - COS(an1)
-
-IF a$ = "1" THEN myspd = .1
-IF a$ = "2" THEN myspd = 1
-IF a$ = "3" THEN myspd = 10
-IF a$ = "4" THEN myspd = 100
-IF a$ = "5" THEN myspd = 1000
-IF a$ = "6" THEN myspd = 10000
-IF a$ = "7" THEN myspd = 100000
-IF a$ = "8" THEN myspd = 1000000
-
-IF a$ = "q" THEN SYSTEM
-
-IF a$ = " " THEN
- IF timerStartScript = 0 THEN
- OPEN "script.dat" FOR OUTPUT AS #1
- timerStartScript = TIMER
- END IF
- PRINT #1, TIMER - timerStartScript;
- PRINT #1, myx; myy; myz; an1; an2
- SOUND 2000, .1
-END IF
-
-IF a$ = "r" THEN
- IF ScriptRunning = 0 THEN
- timerinit
- loadScript "script.dat"
- ELSE
- ScriptRunning = 0
-
- END IF
-END IF
-
-myxs = myxs / 1.1
-myys = myys / 1.1
-myzs = myzs / 1.1
-
-myx = myx + myxs * myspd
-myz = myz + myzs * myspd
-myy = myy + myys * myspd
-
-IF ScriptRunning = 1 THEN
-'DIM SHARED timerCvalue(0 TO 50)
- myx = timerCvalue(1)
- myy = timerCvalue(2)
- myz = timerCvalue(3)
- an1 = timerCvalue(4)
- an2 = timerCvalue(5)
-
- LOCATE 20, 1
-' PRINT "demo"
-END IF
-
-END SUB
-
-SUB disp
-
-s1 = SIN(an1)
-c1 = COS(an1)
-s2 = SIN(an2)
-c2 = COS(an2)
-
-vdn = 100000000
-
-FOR a = 1 TO nump
-
- x = px(a) - myx
- y = py(a) - myy
- z = pz(a) - myz
-
- IF ABS(x) < vdn THEN
- IF ABS(y) < vdn THEN
- IF ABS(z) < vdn THEN vdn = SQR(x * x + y * y + z * z)
- END IF
- END IF
-
- x1 = x * c1 + z * s1
- z1 = z * c1 - x * s1
-
- y1 = y * c2 + z1 * s2
- z2 = z1 * c2 - y * s2
-
- IF z2 > 3 THEN
- PSET (x1 / z2 * 130 + 160, y1 / z2 * 130 + 100), pc(a)
- END IF
-
-NEXT a
-
-vd = (vd * 5 + vdn) / 6
-
-LOCATE 1, 1
-'PRINT vdn
-LOCATE 1, 20
-'PRINT vd
-
-END SUB
-
-SUB galacloud (rx, ry, rz)
-
-a = INT(RND * 100)
-
-d = (a + 30) * 500
-
-x = d
-y = 0
-z = 0
-
-a1 = SIN(a * (123.45 - (rx MOD 1235))) * 100
-a2 = SIN(a * 324 + (ry MOD 5431)) * 120
-
-s1 = SIN(a1)
-c1 = COS(a1)
-s2 = SIN(a2)
-c2 = COS(a2)
-
-x1 = x * c1 + z * s1
-z1 = z * c1 - x * s1
-
-y1 = y * c2 + z1 * s2
-z2 = z1 * c2 - y * s2
-
-fx = x1 + rx
-fy = y1 + ry
-fz = z2 + rz
-
-dist = gdist(fx, fy, fz)
-
-IF dist < 20000 THEN
- pl = INT(RND * 20)
- oftGalaX(pl) = fx
- oftGalaY(pl) = fy
- oftGalaZ(pl) = fz
- mkgalaxy fx, fy, fz
-ELSE
- IF (RND * 100 < 10) OR (vd > 500000) THEN
- mkgalaxy fx, fy, fz
- END IF
-END IF
-
-END SUB
-
-FUNCTION gdist (x, y, z)
-gdist = SQR((x - myx) ^ 2 + (y - myy) ^ 2 + (z - myz) ^ 2)
-
-END FUNCTION
-
-FUNCTION getbyte (addr)
-getbyte = PEEK(extADDR + addr)
-END FUNCTION
-
-SUB getCloudXYZ (a, x1, y1, z2)
-
-d = a * 1000000
-
-x = d
-y = 0
-z = 0
-
-a1 = SIN(a * 123) * 100
-a2 = SIN(a * 975) * 120
-
-s1 = SIN(a1)
-c1 = COS(a1)
-s2 = SIN(a2)
-c2 = COS(a2)
-
-x1 = x * c1 + z * s1
-z1 = z * c1 - x * s1
-
-y1 = y * c2 + z1 * s2
-z2 = z1 * c2 - y * s2
-
-END SUB
-
-FUNCTION getword (addr)
-a = PEEK(extADDR + addr)
-b = PEEK(extADDR + addr + 1)
-
-c$ = HEX$(a)
-IF LEN(c$) = 1 THEN c$ = "0" + c$
-IF LEN(c$) = 0 THEN c$ = "00"
-
-c = VAL("&H" + HEX$(b) + c$)
-
-getword = c
-END FUNCTION
-
-SUB loadScript (scriptName$)
-ScriptRunning = 1
-rt = 2
-
-OPEN scriptName$ FOR INPUT AS #2
-5
-IF EOF(2) <> 0 THEN GOTO 6
-
-INPUT #2, t
-t = t / 2
-rt = rt + 6
-FOR a = 1 TO 5
- INPUT #2, b
- timerAdd a, rt, b
-NEXT a
-
-GOTO 5
-6
-CLOSE #2
-
-FOR a = 1 TO 5
- timerAdd a, -1, b
-NEXT a
-
-END SUB
-
-SUB mkgalaxy (lx, ly, lz)
-
-IF (lx = 0) AND (ly = 0) AND (lz = 0) THEN GOTO 4
-
-rndp = ABS(lx + ly + lz) MOD 9000
-n1 = rn * 100
-n2 = rn * 100
-n3 = rn * 100
-
-gs1 = SIN(n1)
-gc1 = COS(n1)
-gs2 = SIN(n2)
-gc2 = COS(n2)
-gs3 = SIN(n3)
-gc3 = COS(n3)
-
-siz = rn * 50 + 75
-pi = 3.14
-sbm = INT(rn * 3) + 1
-
-dist = gdist(lx, ly, lz)
-amo = 1
-IF dist < 20000 THEN amo = 1
-IF dist < 5000 THEN amo = 2
-IF dist < 1000 THEN amo = 10
-IF dist < 500 THEN amo = 50
-
-FOR a = 1 TO amo
-
- b = RND * 10
- s = b * b / 30
-
- v1 = RND * (11.5 - b) / 3
- v1p = v1 / 2
-
- ane = RND * (s / 2) / sbm * 2
- sba = 2 * pi / sbm * INT(RND * sbm)
-
- x = (SIN(b - sba + ane) * s + RND * v1 - v1p) * siz
- z = (COS(b - sba + ane) * s + RND * v1 - v1p) * siz
- y = (RND * v1 - v1p) * siz
-
- x1 = x * gc1 + z * gs1
- z1 = z * gc1 - x * gs1
-
- y1 = y * gc2 + z1 * gs2
- z2 = z1 * gc2 - y * gs2
-
- y2 = y1 * gc3 + x1 * gs3
- x2 = x1 * gc3 - y1 * gs3
-
- pla = INT(RND * nump) + 1
-
- px(pla) = x2 + lx
- py(pla) = y2 + ly
- pz(pla) = z2 + lz
- pc(pla) = INT(RND * 15) + 1
-NEXT a
-
-4
-END SUB
-
-SUB mkworld
-
-FOR b = 1 TO 10
- a = INT(RND * 100)
- getCloudXYZ a, x, y, z
- IF gdist(x, y, z) < vd * 3 THEN oftcloud(INT(RND * 4)) = a
- galacloud x, y, z
-NEXT b
-
-IF vd < 4000000 THEN
- LOCATE 3
-' PRINT "galaxy cloud zoom"
-
- FOR b = 0 TO 3
- a = oftcloud(b)
- getCloudXYZ a, x, y, z
- galacloud x, y, z
- NEXT b
-END IF
-
-IF vd < 10000 THEN
- LOCATE 4, 1
-' PRINT "Galaxy zoom"
-
- FOR b = 0 TO 19
- x = oftGalaX(b)
- y = oftGalaY(b)
- z = oftGalaZ(b)
-' PRINT x; y; z
- mkgalaxy x, y, z
- NEXT b
-ELSE
-' FOR b = 0 TO 3
-' oftGalaX(b) = 0
-' oftGalaY(b) = 0
-' oftGalaZ(b) = 0
-' NEXT b
-END IF
-
-END SUB
-
-SUB mousedemo
-
-cx = 150
-cy = 100
-maxmove = 50
-100
-frm = frm + 1
-
-LOCATE 1, 1
-PRINT cx, cy
-PRINT frm
-
-CIRCLE (cx, cy), 10, 0
-xp = getword(2)
-putword 2, 0
-yp = getword(4)
-putword 4, 0
-
-IF xp < -maxmove THEN xp = -maxmove
-IF xp > maxmove THEN xp = maxmove
-cx = cx + xp
-
-IF yp < -maxmove THEN yp = -maxmove
-IF yp > maxmove THEN yp = maxmove
-cy = cy + yp
-
-CIRCLE (cx, cy), 10, 10
-
-SOUND 0, .05
-GOTO 100
-
-END SUB
-
-SUB putbyte (addr, dat)
-
-POKE (extADDR + addr), dat
-END SUB
-
-SUB putword (addr, dat)
-
-b$ = HEX$(dat)
-
-2
-IF LEN(b$) < 4 THEN b$ = "0" + b$: GOTO 2
-
-n1 = VAL("&H" + LEFT$(b$, 2))
-n2 = VAL("&H" + RIGHT$(b$, 2))
-
-POKE (extADDR + addr), n2
-POKE (extADDR + addr + 1), n1
-
-END SUB
-
-FUNCTION rn
-
-rndp = rndp + 1
-IF rndp > 10000 THEN rndp = 0
-rn = rndval(rndp)
-
-END FUNCTION
-
-SUB rndinit
-
-FOR a = 0 TO 10000
- rndval(a) = RND
-NEXT a
-
-rndp = 0
-END SUB
-
-SUB start
-
-PRINT "Universe Explorer"
-PRINT "by Svjatoslav Agejenko, n0@hot.ee"
-PRINT "2003.12"
-PRINT
-PRINT "Use mouse to aim."
-PRINT "Use keys: a, s, d, w to move around,"
-PRINT "1 2 3 4 5 6 7 to change speed multiplier."
-PRINT "r - to start/stop demo."
-PRINT "q - to quit program."
-
-PRINT "right mouse button, to move UP <> DOWN."
-PRINT "both right & left mouse buttons pressed to move BACK <> FRONT."
-
-PRINT "At least P3 500 MHz, would be nice."
-PRINT "Better CPU, more details and higher framerate."
-PRINT "Requires mouse driver, and QBasic extension TSR"
-PRINT "to be loaded first."
-
-PRINT
-PRINT "In this program:"
-
-PRINT "Several stars, make up galaxy."
-PRINT "Several galaxies makes metagalaxy."
-PRINT "Several metagalaxies makes up universe."
-
-PRINT
-PRINT "Press Any key To Continue."
-a$ = INPUT$(1)
-
-startext
-
-SCREEN 7, , , 1
-
-maxmove = 50
-rndinit
-myspd = 1000000
-
-END SUB
-
-SUB startext
-
-DEF SEG = 0 ' read first from interrupt table
-
-extSEG = PEEK(&H79 * 4 + 3) * 256
-extSEG = extSEG + PEEK(&H79 * 4 + 2)
-
-PRINT "Segment is: " + HEX$(extSEG)
-
-extADDR = PEEK(&H79 * 4 + 1) * 256
-extADDR = extADDR + PEEK(&H79 * 4 + 0)
-
-PRINT "relative address is:"; extADDR
-
-DEF SEG = extSEG
-
-IF getword(0) <> 1983 THEN
- PRINT "FATAL ERROR: you must load"
- PRINT "QBasic extension TSR first!"
- SYSTEM
-END IF
-
-END SUB
-
-SUB timerAdd (element, time, value)
-
-FOR a = 0 TO 100
- IF (timerTime(element, a) = 0) AND (timerValue(element, a) = 0) THEN GOTO timer3
-NEXT a
-timer3:
-
-timerTime(element, a) = time
-timerValue(element, a) = value
-
-END SUB
-
-SUB timerdisp
-LOCATE 1, 1
-
-FOR a = 0 TO 10
- PRINT timerCplace(a), timerCtime(a), timerCvalue(a)
-NEXT a
-
-END SUB
-
-SUB timerinit
-timerLast = TIMER
-
-FOR a = 1 TO 50
- FOR b = 1 TO 100
- timerTime(a, b) = 0
- timerValue(a, b) = 0
- NEXT b
-NEXT a
-
-END SUB
-
-SUB timerprocess
-
-timerCurrent = TIMER
-timerDiff = timerCurrent - timerLast
-timerLast = timerCurrent
-
-FOR a = 0 TO 50
- ctim = timerCtime(a) + timerDiff
- Cplace = timerCplace(a)
-timer2:
- IF timerTime(a, Cplace + 1) = -1 THEN
- ctim = 0
- Cplace = 0
- END IF
- IF timerTime(a, Cplace + 1) < ctim THEN
- IF timerTime(a, Cplace + 1) = 0 THEN
- timerCvalue(a) = timerValue(a, Cplace)
- GOTO timer1:
- END IF
- Cplace = Cplace + 1
- GOTO timer2
- END IF
-
- v1 = timerValue(a, Cplace)
- t1 = timerTime(a, Cplace)
- v2 = timerValue(a, Cplace + 1)
- t2 = timerTime(a, Cplace + 1)
-
- IF v1 = v2 THEN
- timerCvalue(a) = v1
- ELSE
- Tdiff1 = t2 - t1
- Tdiff2 = ctim - t1
- Vdiff = v2 - v1
- timerCvalue(a) = Tdiff2 / Tdiff1 * Vdiff + v1
- END IF
-timer1:
- timerCplace(a) = Cplace
- timerCtime(a) = ctim
-NEXT a
-
-END SUB
--- /dev/null
+' Program to render flying and bouncing cubes on top of grid-like floor.\r
+'\r
+' By Svjatoslav Agejenko.\r
+' Email: svjatoslav@svjatoslav.eu\r
+' Homepage: http://www.svjatoslav.eu\r
+'\r
+' Changelog:\r
+' 2001, Initial version\r
+' 2024, Improved program readability using AI\r
+'\r
+'\r
+' Navigation:\r
+' arrow keys - move around\r
+' 2, 6, 4, 8 - look around\r
+' - - fly up\r
+' + - fly down\r
+\r
+DECLARE SUB mkkoll ()\r
+DECLARE SUB putkol ()\r
+DECLARE SUB rend ()\r
+DECLARE SUB env ()\r
+DECLARE SUB start ()\r
+DIM SHARED npo, nlo, np, nl\r
+DIM SHARED px(1 TO 1000)\r
+DIM SHARED py(1 TO 1000)\r
+DIM SHARED pz(1 TO 1000)\r
+DIM SHARED rpx(1 TO 1000)\r
+DIM SHARED rpy(1 TO 1000)\r
+DIM SHARED orpx(1 TO 1000)\r
+DIM SHARED orpy(1 TO 1000)\r
+DIM SHARED onp\r
+DIM SHARED lin1(1 TO 1000)\r
+DIM SHARED lin2(1 TO 1000)\r
+DIM SHARED linc(1 TO 1000)\r
+DIM SHARED olin1(1 TO 1000)\r
+DIM SHARED olin2(1 TO 1000)\r
+DIM SHARED onl\r
+DIM SHARED myx, myxs\r
+DIM SHARED myy, myys\r
+DIM SHARED myz, myzs\r
+DIM SHARED an1, an1s\r
+DIM SHARED an2, an2s\r
+DIM SHARED kolx(1 TO 10)\r
+DIM SHARED koly(1 TO 10)\r
+DIM SHARED kolz(1 TO 10)\r
+DIM SHARED kolxs(1 TO 10)\r
+DIM SHARED kolys(1 TO 10)\r
+DIM SHARED kolzs(1 TO 10)\r
+DIM SHARED kolm\r
+\r
+ON ERROR GOTO 2\r
+\r
+start\r
+env\r
+putkol\r
+\r
+' The main loop of the program\r
+1\r
+np = npo\r
+nl = nlo\r
+\r
+mkkoll\r
+rend\r
+\r
+' Update positions and angles\r
+myx = myx + myxs\r
+myy = myy + myys\r
+myz = myz + myzs\r
+an1 = an1 + an1s\r
+an2 = an2 + an2s\r
+\r
+a$ = INKEY$\r
+IF a$ <> "" THEN\r
+\r
+ ' Handle arrow keys for movement\r
+ IF a$ = CHR$(0) + "H" THEN\r
+ myzs = myzs - SIN(an1) / 100\r
+ myxs = myxs - COS(an1) / 100\r
+ END IF\r
+ IF a$ = CHR$(0) + "P" THEN\r
+ myzs = myzs + SIN(an1) / 100\r
+ myxs = myxs + COS(an1) / 100\r
+ END IF\r
+ IF a$ = CHR$(0) + "M" THEN\r
+ myzs = myzs + COS(an1) / 100\r
+ myxs = myxs - SIN(an1) / 100\r
+ END IF\r
+ IF a$ = CHR$(0) + "K" THEN\r
+ myzs = myzs - COS(an1) / 100\r
+ myxs = myxs + SIN(an1) / 100\r
+ END IF\r
+\r
+ ' Handle number keys for looking around\r
+ IF a$ = "6" THEN an1s = an1s - .01\r
+ IF a$ = "4" THEN an1s = an1s + .01\r
+ IF a$ = "8" THEN an2s = an2s - .01\r
+ IF a$ = "2" THEN an2s = an2s + .01\r
+\r
+ ' Handle plus and minus keys for flying up and down\r
+ IF a$ = "+" THEN myys = myys - .01\r
+ IF a$ = "-" THEN myys = myys + .01\r
+\r
+ ' Exit the program on pressing ESC\r
+ IF a$ = CHR$(27) THEN SYSTEM\r
+END IF\r
+' Go back to the main loop\r
+GOTO 1\r
+\r
+2\r
+END\r
+RESUME\r
+\r
+SUB env\r
+\r
+' This subroutine initializes environment points\r
+FOR z = -5 TO 5\r
+ FOR x = -5 TO 5\r
+ np = np + 1\r
+ px(np) = x\r
+ py(np) = 0\r
+ pz(np) = z\r
+\r
+ ' Add lines between points\r
+ IF x > -5 THEN\r
+ nl = nl + 1\r
+ lin1(nl) = np\r
+ lin2(nl) = np - 1\r
+ linc(nl) = 3\r
+ END IF\r
+ IF z > -5 THEN\r
+ nl = nl + 1\r
+ lin1(nl) = np\r
+ lin2(nl) = np - 11\r
+ linc(nl) = 3\r
+ END IF\r
+ NEXT x\r
+NEXT z\r
+\r
+' Store the number of points and lines\r
+npo = np\r
+nlo = nl\r
+\r
+END SUB\r
+\r
+SUB env1\r
+\r
+' This subroutine initializes a simple environment with two points\r
+np = 1\r
+px(np) = -2\r
+py(np) = 0\r
+pz(np) = 0\r
+\r
+np = np + 1\r
+px(np) = 2\r
+py(np) = 0\r
+pz(np) = 0\r
+\r
+' Add a line between the two points\r
+nl = 1\r
+lin1(nl) = 1\r
+lin2(nl) = 2\r
+linc(nl) = 14\r
+\r
+END SUB\r
+\r
+SUB mkkoll\r
+\r
+' This subroutine updates the positions and angles of colliders\r
+FOR a = 1 TO kolm\r
+ x = kolx(a)\r
+ y = koly(a)\r
+ z = kolz(a)\r
+ xs = kolxs(a)\r
+ ys = kolys(a)\r
+ zs = kolzs(a)\r
+\r
+ ' Update the Y-axis position\r
+ ys = ys - .01\r
+\r
+ ' Update the X and Z positions\r
+ x = x + xs\r
+ y = y + ys\r
+ z = z + zs\r
+\r
+ ' Bounce off walls\r
+ IF x > 5 THEN xs = -.1\r
+ IF z > 5 THEN zs = -.1\r
+ IF x < -5 THEN xs = .1\r
+ IF z < -5 THEN zs = .1\r
+\r
+ ' Reset Y position if it falls below a threshold\r
+ IF y < .5 THEN ys = RND * .2 + .1\r
+\r
+ ' Create lines for visualization\r
+ nl = nl + 1\r
+ lin1(nl) = np + 1\r
+ lin2(nl) = np + 2\r
+ linc(nl) = 14\r
+\r
+ nl = nl + 1\r
+ lin1(nl) = np + 3\r
+ lin2(nl) = np + 2\r
+ linc(nl) = 14\r
+\r
+ nl = nl + 1\r
+ lin1(nl) = np + 3\r
+ lin2(nl) = np + 4\r
+ linc(nl) = 14\r
+\r
+ nl = nl + 1\r
+ lin1(nl) = np + 1\r
+ lin2(nl) = np + 4\r
+ linc(nl) = 14\r
+\r
+ nl = nl + 1\r
+ lin1(nl) = np + 1\r
+ lin2(nl) = np + 5\r
+ linc(nl) = 14\r
+\r
+ nl = nl + 1\r
+ lin1(nl) = np + 2\r
+ lin2(nl) = np + 6\r
+ linc(nl) = 14\r
+\r
+ nl = nl + 1\r
+ lin1(nl) = np + 3\r
+ lin2(nl) = np + 7\r
+ linc(nl) = 14\r
+\r
+ nl = nl + 1\r
+ lin1(nl) = np + 4\r
+ lin2(nl) = np + 8\r
+ linc(nl) = 14\r
+\r
+ nl = nl + 1\r
+ lin1(nl) = np + 5\r
+ lin2(nl) = np + 6\r
+ linc(nl) = 14\r
+\r
+ nl = nl + 1\r
+ lin1(nl) = np + 7\r
+ lin2(nl) = np + 6\r
+ linc(nl) = 14\r
+\r
+ nl = nl + 1\r
+ lin1(nl) = np + 7\r
+ lin2(nl) = np + 8\r
+ linc(nl) = 14\r
+\r
+ nl = nl + 1\r
+ lin1(nl) = np + 5\r
+ lin2(nl) = np + 8\r
+ linc(nl) = 14\r
+\r
+ ' Update the array with new positions and speeds\r
+ np = np + 1\r
+ px(np) = x - .5\r
+ py(np) = y - .5\r
+ pz(np) = z - .5\r
+\r
+ np = np + 1\r
+ px(np) = x + .5\r
+ py(np) = y - .5\r
+ pz(np) = z - .5\r
+\r
+ np = np + 1\r
+ px(np) = x + .5\r
+ py(np) = y + .5\r
+ pz(np) = z - .5\r
+\r
+ np = np + 1\r
+ px(np) = x - .5\r
+ py(np) = y + .5\r
+ pz(np) = z - .5\r
+\r
+ np = np + 1\r
+ px(np) = x - .5\r
+ py(np) = y - .5\r
+ pz(np) = z + .5\r
+\r
+ np = np + 1\r
+ px(np) = x + .5\r
+ py(np) = y - .5\r
+ pz(np) = z + .5\r
+\r
+ np = np + 1\r
+ px(np) = x + .5\r
+ py(np) = y + .5\r
+ pz(np) = z + .5\r
+\r
+ np = np + 1\r
+ px(np) = x - .5\r
+ py(np) = y + .5\r
+ pz(np) = z + .5\r
+\r
+ ' Update the collider array with new positions and speeds\r
+ kolx(a) = x\r
+ koly(a) = y\r
+ kolz(a) = z\r
+ kolxs(a) = xs\r
+ kolys(a) = ys\r
+ kolzs(a) = zs\r
+NEXT a\r
+\r
+END SUB\r
+\r
+SUB putkol\r
+\r
+' This subroutine initializes colliders with random positions and speeds\r
+FOR a = 1 TO kolm\r
+ kolx(a) = RND * 10 - 5\r
+ koly(a) = 2\r
+ kolz(a) = RND * 10 - 5\r
+ kolxs(a) = RND * .5 - .25\r
+ kolys(a) = RND * .5 + .1\r
+ kolzs(a) = RND * .5 - .25\r
+NEXT a\r
+\r
+END SUB\r
+\r
+SUB rend\r
+\r
+' Calculate sine and cosine for angle rotation\r
+s1 = SIN(an1)\r
+c1 = COS(an1)\r
+s2 = SIN(an2)\r
+c2 = COS(an2)\r
+\r
+' Loop through all points to render them\r
+FOR a = 1 TO np\r
+ x = px(a) + myx\r
+ y = py(a) - myy\r
+ z = pz(a) + myz\r
+\r
+ ' Rotate the point\r
+ x1 = x * s1 - z * c1\r
+ z1 = x * c1 + z * s1\r
+ y1 = y * s2 - z1 * c2\r
+ z2 = y * c2 + z1 * s2\r
+\r
+ ' Project the 3D point to a 2D screen coordinate\r
+ IF z2 < .1 THEN\r
+ rpx(a) = -1\r
+ ELSE\r
+ rpx(a) = 320 + (x1 / z2 * 400)\r
+ rpy(a) = 240 - (y1 / z2 * 400)\r
+ END IF\r
+NEXT a\r
+\r
+' Render all lines\r
+FOR a = 1 TO nl\r
+ l1 = olin1(a)\r
+ l2 = olin2(a)\r
+ ' Skip rendering if either end of the line is out of view\r
+ IF orpx(l1) = -1 OR orpx(l2) = -1 THEN\r
+ ELSE\r
+ LINE (orpx(l1), orpy(l1))-(orpx(l2), orpy(l2)), 0\r
+ END IF\r
+\r
+ ' Update line indices for next frame\r
+ l1 = lin1(a)\r
+ l2 = lin2(a)\r
+ ' Skip rendering if either end of the line is out of view\r
+ IF rpx(l1) = -1 OR rpx(l2) = -1 THEN\r
+ ELSE\r
+ LINE (rpx(l1), rpy(l1))-(rpx(l2), rpy(l2)), linc(a)\r
+ END IF\r
+NEXT\r
+\r
+' Handle lines that were added during the frame\r
+IF nl < onl THEN\r
+ FOR a = nl + 1 TO onl\r
+ l1 = olin1(a)\r
+ l2 = olin2(a)\r
+ ' Skip rendering if either end of the line is out of view\r
+ IF orpx(l1) = -1 OR orpx(l2) = -1 THEN\r
+ ELSE\r
+ LINE (orpx(l1), orpy(l1))-(orpx(l2), orpy(l2)), 0\r
+ END IF\r
+ NEXT\r
+END IF\r
+\r
+' Save the current frame's points and lines for next frame\r
+FOR a = 1 TO np\r
+ orpx(a) = rpx(a)\r
+ orpy(a) = rpy(a)\r
+NEXT a\r
+onp = np\r
+\r
+FOR a = 1 TO nl\r
+ olin1(a) = lin1(a)\r
+ olin2(a) = lin2(a)\r
+NEXT a\r
+onl = nl\r
+\r
+END SUB\r
+\r
+SUB start\r
+\r
+' Initialize the screen and variables\r
+SCREEN 12\r
+npo = 0\r
+nlo = 0\r
+np = npo\r
+nl = nlo\r
+kolm = 9\r
+\r
+myx = 0\r
+myy = 4\r
+myz = 7\r
+an1 = 3.14 / 2\r
+an2 = an1 + .6\r
+\r
+' Initialize all lines to have a thickness of 4\r
+FOR a = 1 TO 1000\r
+ linc(a) = 4\r
+NEXT a\r
+\r
+' Store the initial state of all lines\r
+FOR a = 1 TO 1000\r
+ olin1(a) = 1\r
+ olin2(a) = 1\r
+NEXT a\r
+\r
+END SUB
\ No newline at end of file
projects / qbasicapps.git / commitdiff