2 ' made by Svjatoslav Agejenko
\r
4 ' E-Mail: svjatoslav@svjatoslav.eu
\r
5 ' H-Page: svjatoslav.eu
\r
8 DECLARE SUB mkgalaxy (x!, y!, z!)
\r
9 DECLARE SUB rndinit ()
\r
10 DECLARE FUNCTION rn! ()
\r
12 DECLARE SUB startext ()
\r
13 DECLARE SUB control ()
\r
14 DECLARE SUB putbyte (addr!, dat!)
\r
15 DECLARE SUB putword (addr!, dat!)
\r
16 DECLARE FUNCTION getword! (addr!)
\r
17 DECLARE FUNCTION getbyte! (addr!)
\r
18 DECLARE SUB start ()
\r
19 DECLARE SUB animate ()
\r
22 DIM SHARED an1, an2, an3
\r
26 DIM SHARED extSEG, extADDR
\r
28 DIM SHARED myx, myy, myz
\r
29 DIM SHARED myxs, myys, myzs
\r
30 DIM SHARED buttL, buttR
\r
35 DIM SHARED rndval(0 TO 10000)
\r
39 DIM SHARED px(1 TO 12000)
\r
40 DIM SHARED py(1 TO 12000)
\r
41 DIM SHARED pz(1 TO 12000)
\r
42 DIM SHARED pc(1 TO 12000)
\r
45 DIM SHARED tempr(0 TO 10)
\r
71 cx = RND * 500 - 250
\r
75 cz = RND * 500 - 250
\r
89 IF getbyte(8) <> 0 THEN
\r
99 IF butt = 1 THEN buttL = 1
\r
100 IF butt = 2 THEN buttR = 1
\r
101 IF butt = 3 THEN buttL = 1: buttR = 1
\r
106 myxs = myxs + SIN(an1) * yp / 4
\r
107 myzs = myzs - COS(an1) * yp / 4
\r
110 myys = myys + yp / 4
\r
120 IF xp < -maxmove THEN xp = -maxmove
\r
121 IF xp > maxmove THEN xp = maxmove
\r
122 an1 = an1 - xp / 150
\r
124 IF yp < -maxmove THEN yp = -maxmove
\r
125 IF yp > maxmove THEN yp = maxmove
\r
126 an2 = an2 - yp / 150
\r
132 IF a$ = "a" THEN myxs = myxs - COS(an1): myzs = myzs - SIN(an1)
\r
133 IF a$ = "d" THEN myxs = myxs + COS(an1): myzs = myzs + SIN(an1)
\r
134 IF a$ = "w" THEN myxs = myxs - SIN(an1): myzs = myzs + COS(an1)
\r
135 IF a$ = "s" THEN myxs = myxs + SIN(an1): myzs = myzs - COS(an1)
\r
136 IF a$ = "q" THEN SYSTEM
\r
165 x1 = x * c1 + z * s1
\r
166 z1 = z * c1 - x * s1
\r
168 y1 = y * c2 + z1 * s2
\r
169 z2 = z1 * c2 - y * s2
\r
175 rpx = x1 / z2 * 130 + 160
\r
176 rpy = y1 / z2 * 130 + 100
\r
177 PSET (rpx, rpy), pc(a)
\r
185 FUNCTION getbyte (addr)
\r
186 getbyte = PEEK(extADDR + addr)
\r
189 FUNCTION getword (addr)
\r
190 a = PEEK(extADDR + addr)
\r
191 b = PEEK(extADDR + addr + 1)
\r
195 IF LEN(c$) = 1 THEN c$ = "0" + c$
\r
196 IF LEN(c$) = 0 THEN c$ = "00"
\r
199 c = VAL("&H" + HEX$(b) + c$)
\r
204 SUB mkgalaxy (lx, ly, lz)
\r
228 v1 = rn * (11.5 - b) / 3
\r
231 ane = rn * (s / 2) / sbm * 2
\r
232 sba = 2 * pi / sbm * INT(rn * sbm)
\r
234 x = (SIN(b - sba + ane) * s + rn * v1 - v1p) * siz
\r
235 z = (COS(b - sba + ane) * s + rn * v1 - v1p) * siz
\r
236 y = (rn * v1 - v1p) * siz
\r
239 x1 = x * gc1 + z * gs1
\r
240 z1 = z * gc1 - x * gs1
\r
242 y1 = y * gc2 + z1 * gs2
\r
243 z2 = z1 * gc2 - y * gs2
\r
251 pc(nump) = INT(RND * 15) + 1
\r
271 CIRCLE (cx, cy), 10, 0
\r
278 IF xp < -maxmove THEN xp = -maxmove
\r
279 IF xp > maxmove THEN xp = maxmove
\r
282 IF yp < -maxmove THEN yp = -maxmove
\r
283 IF yp > maxmove THEN yp = maxmove
\r
287 CIRCLE (cx, cy), 10, 10
\r
297 SUB putbyte (addr, dat)
\r
299 POKE (extADDR + addr), dat
\r
302 SUB putword (addr, dat)
\r
307 IF LEN(b$) < 4 THEN b$ = "0" + b$: GOTO 2
\r
309 n1 = VAL("&H" + LEFT$(b$, 2))
\r
310 n2 = VAL("&H" + RIGHT$(b$, 2))
\r
313 POKE (extADDR + addr), n2
\r
314 POKE (extADDR + addr + 1), n1
\r
321 IF rndp > 10000 THEN rndp = 0
\r
351 DEF SEG = 0 ' read first from interrupt table
\r
353 extSEG = PEEK(&H79 * 4 + 3) * 256
\r
354 extSEG = extSEG + PEEK(&H79 * 4 + 2)
\r
356 PRINT "Segment is: " + HEX$(extSEG)
\r
358 extADDR = PEEK(&H79 * 4 + 1) * 256
\r
359 extADDR = extADDR + PEEK(&H79 * 4 + 0)
\r
361 PRINT "relative address is:"; extADDR
\r
365 IF getword(0) <> 1983 THEN
\r
366 PRINT "FATAL ERROR: you must load"
\r
367 PRINT "QBasic extension TSR first!"
\r