-' 3D Universe Explorer\r
-' made by Svjatoslav Agejenko\r
-' in 2003.12\r
-' H-Page: svjatoslav.eu\r
-' E-Mail: svjatoslav@svjatoslav.eu\r
- \r
-DECLARE SUB loadScript (a$)\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
-\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
-\r
-DIM SHARED zoom\r
-DIM SHARED rndval(0 TO 10000)\r
-DIM SHARED rndp\r
-\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
-\r
-DIM SHARED oftcloud(0 TO 3)\r
-\r
-\r
-DIM SHARED oftGalaX(0 TO 19)\r
-DIM SHARED oftGalaY(0 TO 19)\r
-DIM SHARED oftGalaZ(0 TO 19)\r
-\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
-\r
-start\r
-\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
-\r
-\r
-\r
-\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
-\r
-control\r
-disp\r
-\r
-timerprocess\r
-\r
-PCOPY 0, 1\r
-CLS\r
-GOTO 1\r
-\r
-SUB control\r
-\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
-\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
-\r
-\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
-\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
-\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
-\r
-IF ScriptRunning = 1 THEN\r
-'DIM SHARED timerCvalue(0 TO 50)\r
- myx = timerCvalue(1)\r
- myy = timerCvalue(2)\r
- myz = timerCvalue(3)\r
- an1 = timerCvalue(4)\r
- an2 = timerCvalue(5)\r
-\r
- LOCATE 20, 1\r
-' PRINT "demo"\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
-\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
-\r
- IF z2 > 3 THEN\r
- PSET (x1 / z2 * 130 + 160, y1 / z2 * 130 + 100), pc(a)\r
- END IF\r
-\r
-\r
-NEXT a\r
-\r
-vd = (vd * 5 + vdn) / 6\r
-\r
-\r
-LOCATE 1, 1\r
-'PRINT vdn\r
-LOCATE 1, 20\r
-'PRINT vd\r
-\r
-END SUB\r
-\r
-SUB galacloud (rx, ry, rz)\r
-\r
-\r
-a = INT(RND * 100)\r
-\r
-\r
-d = (a + 30) * 500\r
-\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
-\r
-s1 = SIN(a1)\r
-c1 = COS(a1)\r
-s2 = SIN(a2)\r
-c2 = COS(a2)\r
-\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
-\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
-\r
-d = a * 1000000\r
-\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
-\r
-s1 = SIN(a1)\r
-c1 = COS(a1)\r
-s2 = SIN(a2)\r
-c2 = COS(a2)\r
-\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
-\r
-END SUB\r
-\r
-FUNCTION getword (addr)\r
-a = PEEK(extADDR + addr)\r
-b = PEEK(extADDR + addr + 1)\r
-\r
-\r
-c$ = HEX$(a)\r
-IF LEN(c$) = 1 THEN c$ = "0" + c$\r
-IF LEN(c$) = 0 THEN c$ = "00"\r
-\r
-\r
-c = VAL("&H" + HEX$(b) + c$)\r
-\r
-getword = c\r
-END FUNCTION\r
-\r
-SUB loadScript (a$)\r
-ScriptRunning = 1\r
-rt = 2\r
-\r
-OPEN "script.dat" 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
-\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
-\r
-\r
-siz = rn * 50 + 75\r
-pi = 3.14\r
-sbm = INT(rn * 3) + 1\r
-\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
-\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
-\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
-\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
-\r
-4\r
-END SUB\r
-\r
-SUB mkworld\r
-\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
-\r
-IF vd < 4000000 THEN\r
- LOCATE 3\r
-' PRINT "galaxy cloud zoom";\r
-\r
- FOR b = 0 TO 3\r
- a = oftcloud(b)\r
-' PRINT a;\r
- getCloudXYZ a, x, y, z\r
- galacloud x, y, z\r
- NEXT b\r
-END IF\r
-\r
-IF vd < 10000 THEN\r
- LOCATE 4, 1\r
-' PRINT "Galaxy zoom"\r
- FOR b = 0 TO 19\r
- x = oftGalaX(b)\r
- y = oftGalaY(b)\r
- z = oftGalaZ(b)\r
-' PRINT x; y; z\r
- mkgalaxy x, y, z\r
- NEXT b\r
-ELSE\r
-' FOR b = 0 TO 3\r
-' oftGalaX(b) = 0\r
-' oftGalaY(b) = 0\r
-' oftGalaZ(b) = 0\r
-' NEXT b\r
-END IF\r
-\r
-\r
-END SUB\r
-\r
-SUB mousedemo\r
-\r
-\r
-\r
-cx = 150\r
-cy = 100\r
-maxmove = 50\r
-100\r
-frm = frm + 1\r
-\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
-\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
-\r
-CIRCLE (cx, cy), 10, 10\r
-\r
-\r
-\r
-SOUND 0, .05\r
-GOTO 100\r
-\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
-\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
-\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
-\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
-\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
-\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
+' 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
projects / qbasicapps.git / commitdiff