' Universe is made of galaxy clusters.\r
' Galaxy cluster is made of galaxies.\r
' Galaxies are made of stars.\r
-'\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
+\r
' By Svjatoslav Agejenko.\r
' Email: svjatoslav@svjatoslav.eu\r
' Homepage: http://www.svjatoslav.eu\r
-'\r
+\r
' Changelog:\r
' 2003.12, Initial version\r
' 2024, Improved program readability using AI\r
\r
DIM SHARED extSEG, extADDR\r
\r
+' User position in the universe\r
DIM SHARED myx, myy, myz\r
+' User velocity in the universe\r
DIM SHARED myxs, myys, myzs\r
+' User pressed mouse buttons\r
DIM SHARED buttL, buttR\r
+' Maximum user movement speed\r
DIM SHARED maxmove\r
\r
+' Zoom level\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
+' Star positions and colors\r
+DIM SHARED px(1 TO 10000), py(1 TO 10000), pz(1 TO 10000)\r
DIM SHARED pc(1 TO 10000)\r
+' Total number of stars\r
DIM SHARED nump\r
+' User speed multiplier\r
DIM SHARED myspd\r
\r
DIM SHARED tempr(0 TO 10)\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
+' Galaxy positions\r
+DIM SHARED oftGalaX(0 TO 19), oftGalaY(0 TO 19), 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
nump = 9999\r
1\r
+' Initialize the universe\r
mkworld\r
\r
va = INT(RND * 3)\r
cz = RND * 500 - 250\r
END SELECT\r
\r
+' Handle user input and movement\r
control\r
+\r
+' Display the universe\r
disp\r
\r
+' Process timers for scripted movements\r
timerprocess\r
\r
+' Copy screen buffer to main screen\r
PCOPY 0, 1\r
+\r
+' Clear the screen\r
CLS\r
+\r
+' Loop back to start\r
GOTO 1\r
\r
SUB control\r
\r
+' Handle mouse input\r
IF getbyte(8) <> 0 THEN\r
putbyte 8, 0\r
xp = getword(2)\r
putword 4, 0\r
butt = getword(6)\r
putword 6, 0\r
+\r
+ ' Determine which mouse buttons are pressed\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
+ ' Handle right mouse button for up/down movement\r
IF buttR = 1 THEN\r
+ ' Handle both buttons pressed for back/front movement\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
+\r
+ ' Handle right button for up/down movement\r
myys = myys + yp / 4\r
3\r
yp = 0\r
\r
END IF\r
\r
+' Clamp user input to maximum movement speed\r
IF xp < -maxmove THEN xp = -maxmove\r
IF xp > maxmove THEN xp = maxmove\r
an1 = an1 - xp / 150\r
IF yp > maxmove THEN yp = maxmove\r
an2 = an2 - yp / 150\r
\r
+' Handle keyboard input for movement\r
a$ = INKEY$\r
\r
IF a$ = "a" 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
+' Handle keyboard input for speed multiplier\r
IF a$ = "1" THEN myspd = .1\r
IF a$ = "2" THEN myspd = 1\r
IF a$ = "3" THEN myspd = 10\r
IF a$ = "7" THEN myspd = 100000\r
IF a$ = "8" THEN myspd = 1000000\r
\r
+' Handle keyboard input for quitting the program\r
IF a$ = "q" THEN SYSTEM\r
\r
+' Handle keyboard input for recording script\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, TIMER - timerStartScript\r
PRINT #1, myx; myy; myz; an1; an2\r
SOUND 2000, .1\r
END IF\r
\r
+' Handle keyboard input for playing script\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
+' Friction to dampen movement speed over time\r
myxs = myxs / 1.1\r
myys = myys / 1.1\r
myzs = myzs / 1.1\r
\r
+' Update user position based on velocity and speed multiplier\r
myx = myx + myxs * myspd\r
myz = myz + myzs * myspd\r
myy = myy + myys * myspd\r
\r
+' Apply scripted movement if running\r
IF ScriptRunning = 1 THEN\r
myx = timerCvalue(1)\r
myy = timerCvalue(2)\r
\r
SUB disp\r
\r
+' Calculate sine and cosine for rotation\r
s1 = SIN(an1)\r
c1 = COS(an1)\r
s2 = SIN(an2)\r
c2 = COS(an2)\r
\r
+' Initialize view distance\r
vdn = 100000000\r
\r
+' Loop through all stars to calculate their positions\r
FOR a = 1 TO nump\r
\r
+ ' Calculate star position relative to user\r
x = px(a) - myx\r
y = py(a) - myy\r
z = pz(a) - myz\r
\r
+ ' Update view distance if star is closer\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
+ ' Rotate star position based on user orientation\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
+ ' Draw star if it is within view distance\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
+' Update average view distance\r
vd = (vd * 5 + vdn) / 6\r
\r
END SUB\r
\r
SUB galacloud (rx, ry, rz)\r
\r
+' Generate random cloud position\r
a = INT(RND * 100)\r
-\r
d = (a + 30) * 500\r
\r
x = d\r
y = 0\r
z = 0\r
\r
+' Calculate sine and cosine for rotation\r
a1 = SIN(a * (123.45 - (rx MOD 1235))) * 100\r
a2 = SIN(a * 324 + (ry MOD 5431)) * 120\r
\r
s2 = SIN(a2)\r
c2 = COS(a2)\r
\r
+' Rotate cloud position based on user orientation\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
+' Calculate distance from cloud to user\r
fx = x1 + rx\r
fy = y1 + ry\r
fz = z2 + rz\r
-\r
dist = gdist(fx, fy, fz)\r
\r
+' Add cloud to galaxy list if within view distance\r
IF dist < 20000 THEN\r
pl = INT(RND * 20)\r
oftGalaX(pl) = fx\r
oftGalaZ(pl) = fz\r
mkgalaxy fx, fy, fz\r
ELSE\r
+ ' Add cloud to galaxy list if random or view distance is high\r
IF (RND * 100 < 10) OR (vd > 500000) THEN\r
mkgalaxy fx, fy, fz\r
END IF\r
END SUB\r
\r
FUNCTION gdist (x, y, z)\r
+' Calculate distance from user to given coordinates\r
gdist = SQR((x - myx) ^ 2 + (y - myy) ^ 2 + (z - myz) ^ 2)\r
\r
END FUNCTION\r
\r
FUNCTION getbyte (addr)\r
+' Retrieve byte value at given RAM address\r
getbyte = PEEK(extADDR + addr)\r
+\r
END FUNCTION\r
\r
SUB getCloudXYZ (a, x1, y1, z2)\r
y = 0\r
z = 0\r
\r
+' Calculate sine and cosine for rotation\r
a1 = SIN(a * 123) * 100\r
a2 = SIN(a * 975) * 120\r
\r
s2 = SIN(a2)\r
c2 = COS(a2)\r
\r
+' Rotate cloud position based on user orientation\r
x1 = x * c1 + z * s1\r
z1 = z * c1 - x * s1\r
\r
END SUB\r
\r
FUNCTION getword (addr)\r
+' Retrieve word value at given RAM address\r
a = PEEK(extADDR + addr)\r
b = PEEK(extADDR + addr + 1)\r
\r
c = VAL("&H" + HEX$(b) + c$)\r
\r
getword = c\r
+\r
END FUNCTION\r
\r
SUB loadScript (scriptName$)\r
+' Load script from file and start playback\r
ScriptRunning = 1\r
rt = 2\r
\r
OPEN scriptName$ FOR INPUT AS #2\r
+\r
5\r
IF EOF(2) <> 0 THEN GOTO 6\r
\r
NEXT a\r
\r
GOTO 5\r
+\r
6\r
CLOSE #2\r
\r
+' Reset all timers to -1\r
FOR a = 1 TO 5\r
timerAdd a, -1, b\r
NEXT a\r
\r
SUB mkgalaxy (lx, ly, lz)\r
\r
+' Skip galaxy generation if position is zero\r
IF (lx = 0) AND (ly = 0) AND (lz = 0) THEN GOTO 4\r
\r
+' Generate random seed for galaxy\r
rndp = ABS(lx + ly + lz) MOD 9000\r
n1 = rn * 100\r
n2 = rn * 100\r
n3 = rn * 100\r
\r
+' Calculate sine and cosine for rotation\r
gs1 = SIN(n1)\r
gc1 = COS(n1)\r
gs2 = SIN(n2)\r
gs3 = SIN(n3)\r
gc3 = COS(n3)\r
\r
+' Calculate galaxy size and temperature\r
siz = rn * 50 + 75\r
pi = 3.14\r
sbm = INT(rn * 3) + 1\r
\r
+' Calculate distance from galaxy to user\r
dist = gdist(lx, ly, lz)\r
+\r
+' Determine number of stars based on distance\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
+' Generate stars in galaxy\r
FOR a = 1 TO amo\r
\r
+ ' Calculate random values for star position\r
b = RND * 10\r
s = b * b / 30\r
\r
z = (COS(b - sba + ane) * s + RND * v1 - v1p) * siz\r
y = (RND * v1 - v1p) * siz\r
\r
+ ' Rotate star position based on galaxy orientation\r
x1 = x * gc1 + z * gs1\r
z1 = z * gc1 - x * gs1\r
\r
y2 = y1 * gc3 + x1 * gs3\r
x2 = x1 * gc3 - y1 * gs3\r
\r
+ ' Add star to universe\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
+\r
NEXT a\r
\r
4\r
\r
SUB mkworld\r
\r
+' Generate initial galaxy clusters\r
FOR b = 1 TO 10\r
a = INT(RND * 100)\r
getCloudXYZ a, x, y, z\r
+\r
+ ' Add cloud to galaxy list if within view distance\r
IF gdist(x, y, z) < vd * 3 THEN oftcloud(INT(RND * 4)) = a\r
+\r
+ ' Generate galaxy cluster at cloud position\r
galacloud x, y, z\r
NEXT b\r
\r
+' Add additional galaxy clusters if view distance is high\r
IF vd < 4000000 THEN\r
FOR b = 0 TO 3\r
a = oftcloud(b)\r
getCloudXYZ a, x, y, z\r
+\r
+ ' Generate galaxy cluster at cloud position\r
galacloud x, y, z\r
NEXT b\r
END IF\r
\r
+' Add galaxies to universe if view distance is low\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
+\r
+ ' Generate galaxy at given position\r
mkgalaxy x, y, z\r
NEXT b\r
+\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
+' Store byte value at given RAM address\r
POKE (extADDR + addr), dat\r
+\r
END SUB\r
\r
SUB putword (addr, dat)\r
\r
+' Store word value at given RAM address\r
b$ = HEX$(dat)\r
\r
2\r
\r
FUNCTION rn\r
\r
+' Generate random number based on current index\r
rndp = rndp + 1\r
IF rndp > 10000 THEN rndp = 0\r
rn = rndval(rndp)\r
\r
SUB rndinit\r
\r
+' Initialize random number array\r
FOR a = 0 TO 10000\r
rndval(a) = RND\r
NEXT a\r
\r
rndp = 0\r
+\r
END SUB\r
\r
SUB start\r
PRINT "by Svjatoslav Agejenko, n0@hot.ee"\r
PRINT "2003.12"\r
PRINT\r
+\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
PRINT "to be loaded first."\r
\r
PRINT\r
+\r
PRINT "In this program:"\r
\r
PRINT "Several stars, make up galaxy."\r
PRINT "Several metagalaxies makes up universe."\r
\r
PRINT\r
+\r
PRINT "Press Any key To Continue."\r
a$ = INPUT$(1)\r
\r
\r
SUB startext\r
\r
-DEF SEG = 0 ' read first from interrupt table\r
+' Read interrupt table to find QBasic extension TSR\r
+DEF SEG = 0\r
\r
extSEG = PEEK(&H79 * 4 + 3) * 256\r
extSEG = extSEG + PEEK(&H79 * 4 + 2)\r
\r
DEF SEG = extSEG\r
\r
+' Check if QBasic extension TSR is loaded\r
IF getword(0) <> 1983 THEN\r
PRINT "FATAL ERROR: you must load"\r
PRINT "QBasic extension TSR first!"\r
\r
SUB timerAdd (element, time, value)\r
\r
+' Add timer event to list\r
FOR a = 0 TO 100\r
IF (timerTime(element, a) = 0) AND (timerValue(element, a) = 0) THEN GOTO timer3\r
NEXT a\r
SUB timerdisp\r
LOCATE 1, 1\r
\r
+' Display all active timers\r
FOR a = 0 TO 10\r
PRINT timerCplace(a), timerCtime(a), timerCvalue(a)\r
NEXT a\r
END SUB\r
\r
SUB timerinit\r
+\r
+' Initialize all timers to zero\r
timerLast = TIMER\r
\r
FOR a = 1 TO 50\r
\r
SUB timerprocess\r
\r
+' Process all active timers\r
timerCurrent = TIMER\r
timerDiff = timerCurrent - timerLast\r
timerLast = timerCurrent\r
v2 = timerValue(a, Cplace + 1)\r
t2 = timerTime(a, Cplace + 1)\r
\r
+ ' Interpolate between two timer values\r
IF v1 = v2 THEN\r
timerCvalue(a) = v1\r
ELSE\r
NEXT a\r
\r
END SUB\r
-\r
projects / qbasicapps.git / commitdiff