2 ' made by Svjatoslav Agejenko
\r
4 ' H-Page: svjatoslav.eu
\r
5 ' E-Mail: svjatoslav@svjatoslav.eu
\r
7 DECLARE SUB startext ()
\r
8 DECLARE SUB control ()
\r
9 DECLARE SUB putbyte (addr!, dat!)
\r
10 DECLARE SUB putword (addr!, dat!)
\r
11 DECLARE FUNCTION getword! (addr!)
\r
12 DECLARE FUNCTION getbyte! (addr!)
\r
13 DECLARE SUB start ()
\r
14 DECLARE SUB animate ()
\r
16 DIM SHARED px(1 TO 5000)
\r
17 DIM SHARED py(1 TO 5000)
\r
18 DIM SHARED pz(1 TO 5000)
\r
19 DIM SHARED rpx(1 TO 5000)
\r
20 DIM SHARED rpy(1 TO 5000)
\r
21 DIM SHARED rpe(1 TO 5000)
\r
23 DIM SHARED l1(1 TO 5000)
\r
24 DIM SHARED l2(1 TO 5000)
\r
25 DIM SHARED lc(1 TO 5000)
\r
29 DIM SHARED an1, an2, an3
\r
33 DIM SHARED extSEG, extADDR
\r
35 DIM SHARED myx, myy, myz
\r
36 DIM SHARED myxs, myys, myzs
\r
37 DIM SHARED buttL, buttR
\r
70 lc(nl) = INT(RND * 15) + 1
\r
71 'lc(nl) = ABS(cx / 20)
\r
79 cx = RND * 500 - 250
\r
83 cz = RND * 500 - 250
\r
113 x1 = x * c1 + z * s1
\r
114 z1 = z * c1 - x * s1
\r
116 y1 = y * c2 + z1 * s2
\r
117 z2 = z1 * c2 - y * s2
\r
124 rpx(a) = x1 / z2 * 130 + 160
\r
125 rpy(a) = y1 / z2 * 130 + 100
\r
137 IF (rpe(p1) = 1) AND (rpe(p2) = 1) THEN LINE (rpx(p1), rpy(p1))-(rpx(p2), rpy(p2)), lc(a)
\r
147 IF getbyte(8) <> 0 THEN
\r
157 IF butt = 1 THEN buttL = 1
\r
158 IF butt = 2 THEN buttR = 1
\r
159 IF butt = 3 THEN buttL = 1: buttR = 1
\r
164 myxs = myxs + SIN(an1) * yp / 4
\r
165 myzs = myzs - COS(an1) * yp / 4
\r
168 myys = myys + yp / 4
\r
178 IF xp < -maxmove THEN xp = -maxmove
\r
179 IF xp > maxmove THEN xp = maxmove
\r
180 an1 = an1 - xp / 150
\r
182 IF yp < -maxmove THEN yp = -maxmove
\r
183 IF yp > maxmove THEN yp = maxmove
\r
184 an2 = an2 - yp / 150
\r
190 IF a$ = "a" THEN myxs = myxs - COS(an1): myzs = myzs - SIN(an1)
\r
191 IF a$ = "d" THEN myxs = myxs + COS(an1): myzs = myzs + SIN(an1)
\r
192 IF a$ = "w" THEN myxs = myxs - SIN(an1): myzs = myzs + COS(an1)
\r
193 IF a$ = "s" THEN myxs = myxs + SIN(an1): myzs = myzs - COS(an1)
\r
194 IF a$ = "q" THEN SYSTEM
\r
206 FUNCTION getbyte (addr)
\r
207 getbyte = PEEK(extADDR + addr)
\r
210 FUNCTION getword (addr)
\r
211 a = PEEK(extADDR + addr)
\r
212 b = PEEK(extADDR + addr + 1)
\r
216 IF LEN(c$) = 1 THEN c$ = "0" + c$
\r
217 IF LEN(c$) = 0 THEN c$ = "00"
\r
220 c = VAL("&H" + HEX$(b) + c$)
\r
240 CIRCLE (cx, cy), 10, 0
\r
247 IF xp < -maxmove THEN xp = -maxmove
\r
248 IF xp > maxmove THEN xp = maxmove
\r
251 IF yp < -maxmove THEN yp = -maxmove
\r
252 IF yp > maxmove THEN yp = maxmove
\r
256 CIRCLE (cx, cy), 10, 10
\r
266 SUB putbyte (addr, dat)
\r
268 POKE (extADDR + addr), dat
\r
271 SUB putword (addr, dat)
\r
276 IF LEN(b$) < 4 THEN b$ = "0" + b$: GOTO 2
\r
278 n1 = VAL("&H" + LEFT$(b$, 2))
\r
279 n2 = VAL("&H" + RIGHT$(b$, 2))
\r
282 POKE (extADDR + addr), n2
\r
283 POKE (extADDR + addr + 1), n1
\r
299 DEF SEG = 0 ' read first from interrupt table
\r
301 extSEG = PEEK(&H79 * 4 + 3) * 256
\r
302 extSEG = extSEG + PEEK(&H79 * 4 + 2)
\r
304 PRINT "Segment is: " + HEX$(extSEG)
\r
306 extADDR = PEEK(&H79 * 4 + 1) * 256
\r
307 extADDR = extADDR + PEEK(&H79 * 4 + 0)
\r
309 PRINT "relative address is:"; extADDR
\r
313 IF getword(0) <> 1983 THEN
\r
314 PRINT "FATAL ERROR: you must load"
\r
315 PRINT "QBasic extension TSR first!"
\r