1 ' 3D Universe Explorer
\r
2 ' made by Svjatoslav Agejenko
\r
4 ' H-Page: svjatoslav.eu
\r
5 ' E-Mail: svjatoslav@svjatoslav.eu
\r
7 DECLARE SUB loadScript (a$)
\r
9 DECLARE SUB timerAdd (element!, time!, value!)
\r
10 DECLARE SUB timerinit ()
\r
11 DECLARE SUB timerprocess ()
\r
13 DECLARE SUB getCloudXYZ (a!, x1!, y1!, z2!)
\r
14 DECLARE FUNCTION gdist! (x!, y!, z!)
\r
15 DECLARE SUB mkworld ()
\r
16 DECLARE SUB galacloud (rx!, ry!, rz!)
\r
18 DECLARE SUB mkgalaxy (x!, y!, z!)
\r
19 DECLARE SUB rndinit ()
\r
20 DECLARE FUNCTION rn! ()
\r
22 DECLARE SUB startext ()
\r
23 DECLARE SUB control ()
\r
24 DECLARE SUB putbyte (addr!, dat!)
\r
25 DECLARE SUB putword (addr!, dat!)
\r
26 DECLARE FUNCTION getword! (addr!)
\r
27 DECLARE FUNCTION getbyte! (addr!)
\r
28 DECLARE SUB start ()
\r
29 DECLARE SUB animate ()
\r
32 DIM SHARED an1, an2, an3
\r
36 DIM SHARED extSEG, extADDR
\r
38 DIM SHARED myx, myy, myz
\r
39 DIM SHARED myxs, myys, myzs
\r
40 DIM SHARED buttL, buttR
\r
45 DIM SHARED rndval(0 TO 10000)
\r
49 DIM SHARED px(1 TO 10000)
\r
50 DIM SHARED py(1 TO 10000)
\r
51 DIM SHARED pz(1 TO 10000)
\r
52 DIM SHARED pc(1 TO 10000)
\r
56 DIM SHARED tempr(0 TO 10)
\r
61 DIM SHARED oftcloud(0 TO 3)
\r
64 DIM SHARED oftGalaX(0 TO 19)
\r
65 DIM SHARED oftGalaY(0 TO 19)
\r
66 DIM SHARED oftGalaZ(0 TO 19)
\r
69 DIM SHARED timerTime(0 TO 50, 0 TO 100)
\r
70 DIM SHARED timerValue(0 TO 50, 0 TO 100)
\r
72 DIM SHARED timerCplace(0 TO 50)
\r
73 DIM SHARED timerCtime(0 TO 50)
\r
74 DIM SHARED timerCvalue(0 TO 50)
\r
75 DIM SHARED timerLast
\r
77 DIM SHARED timerStartScript
\r
78 DIM SHARED ScriptRunning
\r
105 cx = RND * 500 - 250
\r
107 cy = RND * 100 - 50
\r
109 cz = RND * 500 - 250
\r
125 IF getbyte(8) <> 0 THEN
\r
135 IF butt = 1 THEN buttL = 1
\r
136 IF butt = 2 THEN buttR = 1
\r
137 IF butt = 3 THEN buttL = 1: buttR = 1
\r
142 myxs = myxs + SIN(an1) * yp / 4
\r
143 myzs = myzs - COS(an1) * yp / 4
\r
146 myys = myys + yp / 4
\r
156 IF xp < -maxmove THEN xp = -maxmove
\r
157 IF xp > maxmove THEN xp = maxmove
\r
158 an1 = an1 - xp / 150
\r
160 IF yp < -maxmove THEN yp = -maxmove
\r
161 IF yp > maxmove THEN yp = maxmove
\r
162 an2 = an2 - yp / 150
\r
168 IF a$ = "a" THEN myxs = myxs - COS(an1): myzs = myzs - SIN(an1)
\r
169 IF a$ = "d" THEN myxs = myxs + COS(an1): myzs = myzs + SIN(an1)
\r
170 IF a$ = "w" THEN myxs = myxs - SIN(an1): myzs = myzs + COS(an1)
\r
171 IF a$ = "s" THEN myxs = myxs + SIN(an1): myzs = myzs - COS(an1)
\r
173 IF a$ = "1" THEN myspd = .1
\r
174 IF a$ = "2" THEN myspd = 1
\r
175 IF a$ = "3" THEN myspd = 10
\r
176 IF a$ = "4" THEN myspd = 100
\r
177 IF a$ = "5" THEN myspd = 1000
\r
178 IF a$ = "6" THEN myspd = 10000
\r
179 IF a$ = "7" THEN myspd = 100000
\r
180 IF a$ = "8" THEN myspd = 1000000
\r
182 IF a$ = "q" THEN SYSTEM
\r
185 IF timerStartScript = 0 THEN
\r
186 OPEN "script.dat" FOR OUTPUT AS #1
\r
187 timerStartScript = TIMER
\r
189 PRINT #1, TIMER - timerStartScript;
\r
190 PRINT #1, myx; myy; myz; an1; an2
\r
195 IF ScriptRunning = 0 THEN
\r
197 loadScript "script.dat"
\r
209 myx = myx + myxs * myspd
\r
210 myz = myz + myzs * myspd
\r
211 myy = myy + myys * myspd
\r
214 IF ScriptRunning = 1 THEN
\r
215 'DIM SHARED timerCvalue(0 TO 50)
\r
216 myx = timerCvalue(1)
\r
217 myy = timerCvalue(2)
\r
218 myz = timerCvalue(3)
\r
219 an1 = timerCvalue(4)
\r
220 an2 = timerCvalue(5)
\r
244 IF ABS(x) < vdn THEN
\r
245 IF ABS(y) < vdn THEN
\r
246 IF ABS(z) < vdn THEN vdn = SQR(x * x + y * y + z * z)
\r
250 x1 = x * c1 + z * s1
\r
251 z1 = z * c1 - x * s1
\r
253 y1 = y * c2 + z1 * s2
\r
254 z2 = z1 * c2 - y * s2
\r
258 PSET (x1 / z2 * 130 + 160, y1 / z2 * 130 + 100), pc(a)
\r
264 vd = (vd * 5 + vdn) / 6
\r
274 SUB galacloud (rx, ry, rz)
\r
287 a1 = SIN(a * (123.45 - (rx MOD 1235))) * 100
\r
288 a2 = SIN(a * 324 + (ry MOD 5431)) * 120
\r
297 x1 = x * c1 + z * s1
\r
298 z1 = z * c1 - x * s1
\r
300 y1 = y * c2 + z1 * s2
\r
301 z2 = z1 * c2 - y * s2
\r
307 dist = gdist(fx, fy, fz)
\r
309 IF dist < 20000 THEN
\r
314 mkgalaxy fx, fy, fz
\r
316 IF (RND * 100 < 10) OR (vd > 500000) THEN
\r
317 mkgalaxy fx, fy, fz
\r
324 FUNCTION gdist (x, y, z)
\r
325 gdist = SQR((x - myx) ^ 2 + (y - myy) ^ 2 + (z - myz) ^ 2)
\r
329 FUNCTION getbyte (addr)
\r
330 getbyte = PEEK(extADDR + addr)
\r
333 SUB getCloudXYZ (a, x1, y1, z2)
\r
343 a1 = SIN(a * 123) * 100
\r
344 a2 = SIN(a * 975) * 120
\r
353 x1 = x * c1 + z * s1
\r
354 z1 = z * c1 - x * s1
\r
356 y1 = y * c2 + z1 * s2
\r
357 z2 = z1 * c2 - y * s2
\r
362 FUNCTION getword (addr)
\r
363 a = PEEK(extADDR + addr)
\r
364 b = PEEK(extADDR + addr + 1)
\r
368 IF LEN(c$) = 1 THEN c$ = "0" + c$
\r
369 IF LEN(c$) = 0 THEN c$ = "00"
\r
372 c = VAL("&H" + HEX$(b) + c$)
\r
377 SUB loadScript (a$)
\r
381 OPEN "script.dat" FOR INPUT AS #2
\r
383 IF EOF(2) <> 0 THEN GOTO 6
\r
403 SUB mkgalaxy (lx, ly, lz)
\r
405 IF (lx = 0) AND (ly = 0) AND (lz = 0) THEN GOTO 4
\r
408 rndp = ABS(lx + ly + lz) MOD 9000
\r
424 sbm = INT(rn * 3) + 1
\r
427 dist = gdist(lx, ly, lz)
\r
429 IF dist < 20000 THEN amo = 1
\r
430 IF dist < 5000 THEN amo = 2
\r
431 IF dist < 1000 THEN amo = 10
\r
432 IF dist < 500 THEN amo = 50
\r
441 v1 = RND * (11.5 - b) / 3
\r
444 ane = RND * (s / 2) / sbm * 2
\r
445 sba = 2 * pi / sbm * INT(RND * sbm)
\r
447 x = (SIN(b - sba + ane) * s + RND * v1 - v1p) * siz
\r
448 z = (COS(b - sba + ane) * s + RND * v1 - v1p) * siz
\r
449 y = (RND * v1 - v1p) * siz
\r
452 x1 = x * gc1 + z * gs1
\r
453 z1 = z * gc1 - x * gs1
\r
455 y1 = y * gc2 + z1 * gs2
\r
456 z2 = z1 * gc2 - y * gs2
\r
458 y2 = y1 * gc3 + x1 * gs3
\r
459 x2 = x1 * gc3 - y1 * gs3
\r
462 pla = INT(RND * nump) + 1
\r
467 pc(pla) = INT(RND * 15) + 1
\r
479 getCloudXYZ a, x, y, z
\r
480 IF gdist(x, y, z) < vd * 3 THEN oftcloud(INT(RND * 4)) = a
\r
485 IF vd < 4000000 THEN
\r
487 ' PRINT "galaxy cloud zoom";
\r
492 getCloudXYZ a, x, y, z
\r
499 ' PRINT "Galaxy zoom"
\r
533 CIRCLE (cx, cy), 10, 0
\r
540 IF xp < -maxmove THEN xp = -maxmove
\r
541 IF xp > maxmove THEN xp = maxmove
\r
544 IF yp < -maxmove THEN yp = -maxmove
\r
545 IF yp > maxmove THEN yp = maxmove
\r
549 CIRCLE (cx, cy), 10, 10
\r
559 SUB putbyte (addr, dat)
\r
561 POKE (extADDR + addr), dat
\r
564 SUB putword (addr, dat)
\r
569 IF LEN(b$) < 4 THEN b$ = "0" + b$: GOTO 2
\r
571 n1 = VAL("&H" + LEFT$(b$, 2))
\r
572 n2 = VAL("&H" + RIGHT$(b$, 2))
\r
575 POKE (extADDR + addr), n2
\r
576 POKE (extADDR + addr + 1), n1
\r
583 IF rndp > 10000 THEN rndp = 0
\r
600 PRINT "Universe Explorer"
\r
601 PRINT "by Svjatoslav Agejenko, n0@hot.ee"
\r
604 PRINT "Use mouse to aim."
\r
605 PRINT "Use keys: a, s, d, w to move around,"
\r
606 PRINT "1 2 3 4 5 6 7 to change speed multiplier."
\r
607 PRINT "r - to start/stop demo."
\r
608 PRINT "q - to quit program."
\r
610 PRINT "right mouse button, to move UP <> DOWN."
\r
611 PRINT "both right & left mouse buttons pressed to move BACK <> FRONT."
\r
613 PRINT "At least P3 500 MHz, would be nice."
\r
614 PRINT "Better CPU, more details and higher framerate."
\r
615 PRINT "Requires mouse driver, and QBasic extension TSR"
\r
616 PRINT "to be loaded first."
\r
619 PRINT "In this program:"
\r
621 PRINT "Several stars, make up galaxy."
\r
622 PRINT "Several galaxies makes metagalaxy."
\r
623 PRINT "Several metagalaxies makes up universe."
\r
626 PRINT "Press Any key To Continue."
\r
642 DEF SEG = 0 ' read first from interrupt table
\r
644 extSEG = PEEK(&H79 * 4 + 3) * 256
\r
645 extSEG = extSEG + PEEK(&H79 * 4 + 2)
\r
647 PRINT "Segment is: " + HEX$(extSEG)
\r
649 extADDR = PEEK(&H79 * 4 + 1) * 256
\r
650 extADDR = extADDR + PEEK(&H79 * 4 + 0)
\r
652 PRINT "relative address is:"; extADDR
\r
656 IF getword(0) <> 1983 THEN
\r
657 PRINT "FATAL ERROR: you must load"
\r
658 PRINT "QBasic extension TSR first!"
\r
664 SUB timerAdd (element, time, value)
\r
667 IF (timerTime(element, a) = 0) AND (timerValue(element, a) = 0) THEN GOTO timer3
\r
671 timerTime(element, a) = time
\r
672 timerValue(element, a) = value
\r
680 PRINT timerCplace(a), timerCtime(a), timerCvalue(a)
\r
691 timerTime(a, b) = 0
\r
692 timerValue(a, b) = 0
\r
701 timerCurrent = TIMER
\r
702 timerDiff = timerCurrent - timerLast
\r
703 timerLast = timerCurrent
\r
706 ctim = timerCtime(a) + timerDiff
\r
707 Cplace = timerCplace(a)
\r
709 IF timerTime(a, Cplace + 1) = -1 THEN
\r
713 IF timerTime(a, Cplace + 1) < ctim THEN
\r
714 IF timerTime(a, Cplace + 1) = 0 THEN
\r
715 timerCvalue(a) = timerValue(a, Cplace)
\r
718 Cplace = Cplace + 1
\r
722 v1 = timerValue(a, Cplace)
\r
723 t1 = timerTime(a, Cplace)
\r
724 v2 = timerValue(a, Cplace + 1)
\r
725 t2 = timerTime(a, Cplace + 1)
\r
728 timerCvalue(a) = v1
\r
733 timerCvalue(a) = Tdiff2 / Tdiff1 * Vdiff + v1
\r
736 timerCplace(a) = Cplace
\r
737 timerCtime(a) = ctim
\r