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
57 myx = SIN(frm / 30) * 100
\r
58 myz = COS(frm / 59) * 100
\r
59 myy = SIN(frm / 300)
\r
61 an2 = SIN(frm / 36) / 3
\r
74 lc(nl) = INT(RND * 15) + 1
\r
75 'lc(nl) = ABS(cx / 20)
\r
83 cx = RND * 500 - 250
\r
87 cz = RND * 500 - 250
\r
97 IF frm > 1200 THEN GOTO 200
\r
101 CHAIN "khkdemo6.bas"
\r
122 x1 = x * c1 + z * s1
\r
123 z1 = z * c1 - x * s1
\r
125 y1 = y * c2 + z1 * s2
\r
126 z2 = z1 * c2 - y * s2
\r
133 rpx(a) = x1 / z2 * 130 + 160
\r
134 rpy(a) = y1 / z2 * 130 + 100
\r
146 IF (rpe(p1) = 1) AND (rpe(p2) = 1) THEN LINE (rpx(p1), rpy(p1))-(rpx(p2), rpy(p2)), lc(a)
\r
156 IF getbyte(8) <> 0 THEN
\r
166 IF butt = 1 THEN buttL = 1
\r
167 IF butt = 2 THEN buttR = 1
\r
168 IF butt = 3 THEN buttL = 1: buttR = 1
\r
173 myxs = myxs + SIN(an1) * yp / 4
\r
174 myzs = myzs - COS(an1) * yp / 4
\r
177 myys = myys + yp / 4
\r
187 IF xp < -maxmove THEN xp = -maxmove
\r
188 IF xp > maxmove THEN xp = maxmove
\r
189 an1 = an1 - xp / 150
\r
191 IF yp < -maxmove THEN yp = -maxmove
\r
192 IF yp > maxmove THEN yp = maxmove
\r
193 an2 = an2 - yp / 150
\r
199 IF a$ = "a" THEN myxs = myxs - COS(an1): myzs = myzs - SIN(an1)
\r
200 IF a$ = "d" THEN myxs = myxs + COS(an1): myzs = myzs + SIN(an1)
\r
201 IF a$ = "w" THEN myxs = myxs - SIN(an1): myzs = myzs + COS(an1)
\r
202 IF a$ = "s" THEN myxs = myxs + SIN(an1): myzs = myzs - COS(an1)
\r
203 IF a$ = "q" THEN SYSTEM
\r
215 FUNCTION getbyte (addr)
\r
216 getbyte = PEEK(extADDR + addr)
\r
219 FUNCTION getword (addr)
\r
220 a = PEEK(extADDR + addr)
\r
221 b = PEEK(extADDR + addr + 1)
\r
225 IF LEN(c$) = 1 THEN c$ = "0" + c$
\r
226 IF LEN(c$) = 0 THEN c$ = "00"
\r
229 c = VAL("&H" + HEX$(b) + c$)
\r
249 CIRCLE (cx, cy), 10, 0
\r
256 IF xp < -maxmove THEN xp = -maxmove
\r
257 IF xp > maxmove THEN xp = maxmove
\r
260 IF yp < -maxmove THEN yp = -maxmove
\r
261 IF yp > maxmove THEN yp = maxmove
\r
265 CIRCLE (cx, cy), 10, 10
\r
275 SUB putbyte (addr, dat)
\r
277 POKE (extADDR + addr), dat
\r
280 SUB putword (addr, dat)
\r
285 IF LEN(b$) < 4 THEN b$ = "0" + b$: GOTO 2
\r
287 n1 = VAL("&H" + LEFT$(b$, 2))
\r
288 n2 = VAL("&H" + RIGHT$(b$, 2))
\r
291 POKE (extADDR + addr), n2
\r
292 POKE (extADDR + addr + 1), n1
\r
308 DEF SEG = 0 ' read first from interrupt table
\r
310 extSEG = PEEK(&H79 * 4 + 3) * 256
\r
311 extSEG = extSEG + PEEK(&H79 * 4 + 2)
\r
313 PRINT "Segment is: " + HEX$(extSEG)
\r
315 extADDR = PEEK(&H79 * 4 + 1) * 256
\r
316 extADDR = extADDR + PEEK(&H79 * 4 + 0)
\r
318 PRINT "relative address is:"; extADDR
\r
322 IF getword(0) <> 1983 THEN
\r
323 PRINT "FATAL ERROR: you must load"
\r
324 PRINT "QBasic extension TSR first!"
\r