1 DECLARE SUB createLongLine (x1!, y1!, z1!, x2!, y2!, z2!, c!)
\r
2 DECLARE SUB makeGrid (x1!, y1!, z1!, x2!, y2!, z2!)
\r
3 DECLARE SUB prn (a$, x!, y!, z!)
\r
5 DECLARE SUB loadObject (name$, x!, y!, z!)
\r
6 DECLARE SUB putChar (a$, x!, y!, z!)
\r
8 ' made by Svjatoslav Agejenko
\r
10 ' E-Mail: svjatoslav@svjatoslav.eu
\r
11 ' H-Page: svjatoslav.eu
\r
13 DECLARE SUB fill3 ()
\r
14 DECLARE SUB fill1 ()
\r
15 DECLARE SUB fill2 ()
\r
16 DECLARE SUB addMsg (a$)
\r
17 DECLARE SUB dispmsg ()
\r
18 DECLARE SUB loadArea (tx1!, ty1!, tz1!, tx2!, ty2!, tz2!)
\r
19 DECLARE SUB loadCluster (x!, y!, z!)
\r
20 DECLARE SUB checkVisibility ()
\r
21 DECLARE SUB decVisibility ()
\r
22 DECLARE SUB applyBounds ()
\r
23 DECLARE SUB clearWorld ()
\r
24 DECLARE SUB createNewLine (x1!, y1!, z1!, x2!, y2!, z2!, c!)
\r
25 DECLARE SUB createWorld ()
\r
26 DECLARE FUNCTION getClustName$ (a!, b!, c!)
\r
27 DECLARE FUNCTION toStr$ (a!)
\r
29 DECLARE SUB insertLine (x1!, y1!, z1!, x2!, y2!, z2!, c!)
\r
30 DECLARE SUB startext ()
\r
31 DECLARE SUB control ()
\r
32 DECLARE SUB putbyte (addr!, dat!)
\r
33 DECLARE SUB putword (addr!, dat!)
\r
34 DECLARE FUNCTION getword! (addr!)
\r
35 DECLARE FUNCTION getbyte! (addr!)
\r
36 DECLARE SUB start ()
\r
37 DECLARE SUB render ()
\r
42 DIM SHARED extSEG, extADDR
\r
43 DIM SHARED buttL, buttR
\r
49 DIM SHARED linX1(0 TO linAmo) AS INTEGER
\r
50 DIM SHARED linY1(0 TO linAmo) AS INTEGER
\r
51 DIM SHARED linZ1(0 TO linAmo) AS INTEGER
\r
52 DIM SHARED linX2(0 TO linAmo) AS INTEGER
\r
53 DIM SHARED linY2(0 TO linAmo) AS INTEGER
\r
54 DIM SHARED linZ2(0 TO linAmo) AS INTEGER
\r
55 DIM SHARED linC(0 TO linAmo) AS INTEGER
\r
57 DIM SHARED myx, myy, myz
\r
58 DIM SHARED myxs, myys, myzs
\r
60 DIM SHARED curFreeLine
\r
61 DIM SHARED worldSize
\r
63 DIM SHARED usedLines
\r
64 DIM SHARED desMaxLines
\r
66 DIM SHARED visMaxX, visMaxY, visMaxZ
\r
67 DIM SHARED visMinX, visMinY, visMinZ
\r
70 DIM SHARED msgs$(1 TO 10)
\r
74 'DIM SHARED blkData(1 TO 50) AS STRING * 512
\r
75 'DIM SHARED blkFrag(1 TO 50) AS STRING * 512
\r
95 makeGrid -400, -400, -400, 400, 400, 400
\r
111 PRINT usedLines, visDist
\r
122 msgs$(a) = msgs$(a + 1)
\r
130 FOR a = 0 TO linAmo
\r
131 IF linC(a) > 0 THEN
\r
134 cx = (linX1(a) + linX2(a)) / 2
\r
135 cy = (linY1(a) + linY2(a)) / 2
\r
136 cz = (linZ1(a) + linZ2(a)) / 2
\r
138 clx = INT(cx / 100)
\r
139 cly = INT(cy / 100)
\r
140 clz = INT(cz / 100)
\r
142 IF clx > visMaxX THEN GOTO 8
\r
143 IF clx < visMinX THEN GOTO 8
\r
145 IF cly > visMaxY THEN GOTO 8
\r
146 IF cly < visMinY THEN GOTO 8
\r
148 IF clz > visMaxZ THEN GOTO 8
\r
149 IF clz < visMinZ THEN GOTO 8
\r
153 usedLines = usedLines - 1
\r
160 SUB checkVisibility
\r
162 'DIM SHARED visMaxX, visMaxY, visMaxZ
\r
163 'DIM SHARED visMinX, visMinY, visMinZ
\r
166 mx = INT(myx / 100)
\r
167 my = INT(myy / 100)
\r
168 mz = INT(myz / 100)
\r
171 IF mx + visDist > visMaxX THEN
\r
172 newX = mx + visDist
\r
173 loadArea visMaxX + 1, visMinY, visMinZ, newX, visMaxY, visMaxZ
\r
178 IF mx - visDist < visMinX THEN
\r
179 newX = mx - visDist
\r
180 loadArea visMinX - 1, visMinY, visMinZ, newX, visMaxY, visMaxZ
\r
187 IF my + visDist > visMaxY THEN
\r
188 newY = my + visDist
\r
189 loadArea visMinX, visMaxY + 1, visMinZ, visMaxX, newY, visMaxZ
\r
194 IF my - visDist < visMinY THEN
\r
195 newY = my - visDist
\r
196 loadArea visMinX, visMinY - 1, visMinZ, visMaxX, newY, visMaxZ
\r
203 IF mz + visDist > visMaxZ THEN
\r
204 newZ = mz + visDist
\r
205 loadArea visMinX, visMinY, visMaxZ + 1, visMaxX, visMaxY, newZ
\r
210 IF mz - visDist < visMinZ THEN
\r
211 newZ = mz - visDist
\r
212 loadArea visMinX, visMinY, visMinZ - 1, visMaxX, visMaxY, newZ
\r
219 IF usedLines > desMaxLines THEN decVisibility
\r
228 FOR x = -worldSize TO worldSize
\r
230 n$ = "X" + toStr$(x)
\r
233 FOR y = -worldSize TO worldSize
\r
235 n2$ = "Y" + toStr$(y)
\r
239 FOR z = -worldSize TO worldSize
\r
241 n3$ = "z" + toStr$(z) + ".dat"
\r
242 OPEN n3$ FOR OUTPUT AS #1
\r
260 IF getbyte(8) <> 0 THEN
\r
270 IF butt = 1 THEN buttL = 1
\r
271 IF butt = 2 THEN buttR = 1
\r
272 IF butt = 3 THEN buttL = 1: buttR = 1
\r
277 myxs = myxs + SIN(an1) * yp / 4
\r
278 myzs = myzs - COS(an1) * yp / 4
\r
281 myys = myys + yp / 4
\r
291 IF xp < -maxmove THEN xp = -maxmove
\r
292 IF xp > maxmove THEN xp = maxmove
\r
293 an1 = an1 - xp / 150
\r
295 IF yp < -maxmove THEN yp = -maxmove
\r
296 IF yp > maxmove THEN yp = maxmove
\r
297 an2 = an2 - yp / 150
\r
303 IF a$ = "a" THEN myxs = myxs - COS(an1): myzs = myzs - SIN(an1)
\r
304 IF a$ = "d" THEN myxs = myxs + COS(an1): myzs = myzs + SIN(an1)
\r
305 IF a$ = "w" THEN myxs = myxs - SIN(an1): myzs = myzs + COS(an1)
\r
306 IF a$ = "s" THEN myxs = myxs + SIN(an1): myzs = myzs - COS(an1)
\r
307 IF a$ = "q" THEN SYSTEM
\r
319 SUB createLongLine (x1, y1, z1, x2, y2, z2, c)
\r
320 d = SQR((x1 - x2) ^ 2 + (y1 - y2) ^ 2 + (z1 - z2) ^ 2)
\r
323 createNewLine x1, y1, z1, x2, y2, z2, c
\r
328 createLongLine x1, y1, z1, xp, yp, zp, c
\r
329 createLongLine xp, yp, zp, x2, y2, z2, c
\r
333 SUB createNewLine (x1, y1, z1, x2, y2, z2, c)
\r
339 clx = INT(cx / 100)
\r
340 cly = INT(cy / 100)
\r
341 clz = INT(cz / 100)
\r
343 IF clx >= visMinX THEN
\r
344 IF clx <= visMaxX THEN
\r
345 IF cly >= visMinY THEN
\r
346 IF cly <= visMaxY THEN
\r
347 IF clz >= visMinZ THEN
\r
348 IF clz <= visMaxZ THEN
\r
349 insertLine x1, y1, z1, x2, y2, z2, c
\r
357 cln$ = getClustName(clx, cly, clz)
\r
359 OPEN cln$ FOR APPEND AS #1
\r
360 PRINT #1, x1; y1; z1; x2; y2; z2; c
\r
371 FOR x = -worldSize TO worldSize
\r
373 n$ = "X" + toStr$(x)
\r
377 FOR y = -worldSize TO worldSize
\r
379 n2$ = "Y" + toStr$(y)
\r
384 FOR z = -worldSize TO worldSize
\r
386 n3$ = "z" + toStr$(z) + ".dat"
\r
387 OPEN n3$ FOR OUTPUT AS #1
\r
404 mx = INT(myx / 100)
\r
405 my = INT(myy / 100)
\r
406 mz = INT(myz / 100)
\r
411 IF visMaxX > mx + visDist THEN
\r
412 visMaxX = mx + visDist
\r
416 IF visMinX < mx - visDist THEN
\r
417 visMinX = mx - visDist
\r
422 IF visMaxY > my + visDist THEN
\r
423 visMaxY = my + visDist
\r
427 IF visMinY < my - visDist THEN
\r
428 visMinY = my - visDist
\r
433 IF visMaxZ > mz + visDist THEN
\r
434 visMaxZ = mz + visDist
\r
438 IF visMinZ < mz - visDist THEN
\r
439 visMinZ = mz - visDist
\r
444 IF visDist > 3 THEN visDist = visDist - 1: GOTO 6
\r
446 addMsg "Visibility decareased"
\r
455 LOCATE a, 39 - LEN(msgs$(a))
\r
462 x1 = RND * 800 - 400
\r
463 y1 = RND * 800 - 400
\r
464 z1 = RND * 800 - 400
\r
470 createNewLine x1, y1, z1, x2, y2, z2, INT(RND * 15) + 1
\r
479 x1 = SIN(frmt / 533) * 300 + SIN(frmt / 53) * 50
\r
480 y1 = COS(frmt / 422) * 300 + SIN(frmt / 31) * 20
\r
481 z1 = SIN(frmt / 133) * 300 + SIN(frmt / 39) * 60
\r
483 frmt = (frm - 1) * 15
\r
485 x2 = SIN(frmt / 533) * 300 + SIN(frmt / 53) * 50
\r
486 y2 = COS(frmt / 422) * 300 + SIN(frmt / 31) * 20
\r
487 z2 = SIN(frmt / 133) * 300 + SIN(frmt / 39) * 60
\r
491 createNewLine x1, y1, z1, x2, y2, z2, INT(RND * 15) + 1
\r
497 IF frm / 10 = frm \ 10 THEN ELSE GOTO fill31
\r
501 x = RND * 800 - 400
\r
502 y = RND * 800 - 400
\r
503 z = RND * 800 - 400
\r
507 createNewLine x - s, y - s, z - s, x + s, y - s, z - s, c
\r
508 createNewLine x + s, y - s, z - s, x + s, y + s, z - s, c
\r
509 createNewLine x + s, y + s, z - s, x - s, y + s, z - s, c
\r
510 createNewLine x - s, y + s, z - s, x - s, y - s, z - s, c
\r
512 createNewLine x - s, y - s, z + s, x + s, y - s, z + s, c
\r
513 createNewLine x + s, y - s, z + s, x + s, y + s, z + s, c
\r
514 createNewLine x + s, y + s, z + s, x - s, y + s, z + s, c
\r
515 createNewLine x - s, y + s, z + s, x - s, y - s, z + s, c
\r
517 createNewLine x - s, y - s, z - s, x - s, y - s, z + s, c
\r
518 createNewLine x + s, y - s, z - s, x + s, y - s, z + s, c
\r
519 createNewLine x + s, y + s, z - s, x + s, y + s, z + s, c
\r
520 createNewLine x - s, y + s, z - s, x - s, y + s, z + s, c
\r
527 x = x + RND * 80 - 40
\r
528 y = y + RND * 80 - 40
\r
529 z = z + RND * 80 - 40
\r
533 createNewLine x - s, y - s, z - s, x + s, y - s, z - s, c
\r
534 createNewLine x + s, y - s, z - s, x + s, y + s, z - s, c
\r
535 createNewLine x + s, y + s, z - s, x - s, y + s, z - s, c
\r
536 createNewLine x - s, y + s, z - s, x - s, y - s, z - s, c
\r
538 createNewLine x - s, y - s, z + s, x + s, y - s, z + s, c
\r
539 createNewLine x + s, y - s, z + s, x + s, y + s, z + s, c
\r
540 createNewLine x + s, y + s, z + s, x - s, y + s, z + s, c
\r
541 createNewLine x - s, y + s, z + s, x - s, y - s, z + s, c
\r
543 createNewLine x - s, y - s, z - s, x - s, y - s, z + s, c
\r
544 createNewLine x + s, y - s, z - s, x + s, y - s, z + s, c
\r
545 createNewLine x + s, y + s, z - s, x + s, y + s, z + s, c
\r
546 createNewLine x - s, y + s, z - s, x - s, y + s, z + s, c
\r
549 createNewLine x, y, z, xo, yo, zo, c
\r
555 IF RND * 100 < 2 THEN
\r
558 FOR a = 1 TO RND * 3 + 1
\r
559 b$ = b$ + CHR$(48 + RND * 9)
\r
562 'b$ = "Hello, world!"
\r
563 prn b$, RND * 800 - 400, RND * 800 - 400, RND * 800 - 400
\r
568 FUNCTION getbyte (addr)
\r
569 getbyte = PEEK(extADDR + addr)
\r
572 FUNCTION getClustName$ (a, b, c)
\r
574 getClustName$ = "WORLD\X" + toStr$(a) + "\Y" + toStr$(b) + "\Z" + toStr$(c) + ".DAT"
\r
578 FUNCTION getword (addr)
\r
579 a = PEEK(extADDR + addr)
\r
580 b = PEEK(extADDR + addr + 1)
\r
584 IF LEN(c$) = 1 THEN c$ = "0" + c$
\r
585 IF LEN(c$) = 0 THEN c$ = "00"
\r
588 c = VAL("&H" + HEX$(b) + c$)
\r
593 SUB importCluster (x, y, z)
\r
595 cln$ = getClustName(x, y, z)
\r
598 OPEN cln$ FOR INPUT AS #1
\r
600 IF EOF(1) <> 0 THEN GOTO 4
\r
602 INPUT #1, x1, y1, z1, x2, y2, z2, c
\r
603 insertLine x1, y1, z1, x2, y2, z2, c
\r
612 SUB insertLine (x1, y1, z1, x2, y2, z2, c)
\r
615 IF linC(curFreeLine) = -1 THEN
\r
616 linX1(curFreeLine) = x1
\r
617 linY1(curFreeLine) = y1
\r
618 linZ1(curFreeLine) = z1
\r
620 linX2(curFreeLine) = x2
\r
621 linY2(curFreeLine) = y2
\r
622 linZ2(curFreeLine) = z2
\r
624 linC(curFreeLine) = c
\r
625 curFreeLine = curFreeLine + 1
\r
626 usedLines = usedLines + 1
\r
627 IF curFreeLine > linAmo THEN curFreeLine = 0
\r
629 curFreeLine = curFreeLine + 1
\r
630 IF curFreeLine > linAmo THEN curFreeLine = 0
\r
637 SUB loadArea (tx1, ty1, tz1, tx2, ty2, tz2)
\r
640 addMsg "Loading Area!"
\r
641 addMsg toStr$(tx1) + " " + toStr$(ty1) + " " + toStr$(tz1)
\r
642 addMsg toStr$(tx2) + " " + toStr$(ty2) + " " + toStr$(tz2)
\r
657 IF x1 > x2 THEN SWAP x1, x2
\r
658 IF y1 > y2 THEN SWAP y1, y2
\r
659 IF z1 > z2 THEN SWAP z1, z2
\r
664 loadCluster x, y, z
\r
671 SUB loadCluster (x, y, z)
\r
673 IF ABS(x) > worldSize THEN GOTO 11
\r
674 IF ABS(y) > worldSize THEN GOTO 11
\r
675 IF ABS(z) > worldSize THEN GOTO 11
\r
677 cln$ = getClustName(x, y, z)
\r
679 OPEN cln$ FOR INPUT AS #1
\r
681 IF EOF(1) <> 0 THEN GOTO 9
\r
683 INPUT #1, x1, y1, z1, x2, y2, z2, c
\r
684 insertLine x1, y1, z1, x2, y2, z2, c
\r
694 SUB loadObject (name$, x, y, z)
\r
697 'PRINT "objects\" + name$ + ".3d"
\r
700 OPEN "OBJECTS\" + name$ + ".3d" FOR INPUT AS #2
\r
702 IF EOF(2) <> 0 THEN GOTO 12
\r
703 INPUT #2, x1, y1, z1, x2, y2, z2, co
\r
704 createNewLine x1 + x, y1 + y, z1 + z, x2 + x, y2 + y, z2 + z, co
\r
711 SUB makeGrid (x1, y1, z1, x2, y2, z2)
\r
715 FOR x = x1 TO x2 STEP s
\r
716 FOR y = y1 TO y2 STEP s
\r
717 createLongLine x1, y, x, x2, y, x, 1
\r
718 createLongLine x, y1, y, x, y2, y, 1
\r
719 createLongLine x, y, z1, x, y, z2, 1
\r
740 CIRCLE (cx, cy), 10, 0
\r
747 IF xp < -maxmove THEN xp = -maxmove
\r
748 IF xp > maxmove THEN xp = maxmove
\r
751 IF yp < -maxmove THEN yp = -maxmove
\r
752 IF yp > maxmove THEN yp = maxmove
\r
756 CIRCLE (cx, cy), 10, 10
\r
766 SUB prn (a$, x, y, z)
\r
768 FOR a = 1 TO LEN(a$)
\r
769 b$ = RIGHT$(LEFT$(a$, a), 1)
\r
770 putChar b$, x + (a - 1) * 8, y, z
\r
774 SUB putbyte (addr, dat)
\r
776 POKE (extADDR + addr), dat
\r
779 SUB putChar (a$, x, y, z)
\r
781 n$ = "FONT\LTR" + toStr(ASC(a$))
\r
782 loadObject n$, x, y, z
\r
786 SUB putword (addr, dat)
\r
791 IF LEN(b$) < 4 THEN b$ = "0" + b$: GOTO 2
\r
793 n1 = VAL("&H" + LEFT$(b$, 2))
\r
794 n2 = VAL("&H" + RIGHT$(b$, 2))
\r
797 POKE (extADDR + addr), n2
\r
798 POKE (extADDR + addr + 1), n1
\r
811 FOR a = 0 TO linAmo
\r
813 IF linC(a) > 0 THEN
\r
814 x11 = linX1(a) - myx
\r
815 y11 = linY1(a) - myy
\r
816 z11 = linZ1(a) - myz
\r
818 x21 = linX2(a) - myx
\r
819 y21 = linY2(a) - myy
\r
820 z21 = linZ2(a) - myz
\r
823 x12 = x11 * c1 + z11 * s1
\r
824 z12 = z11 * c1 - x11 * s1
\r
827 y12 = y11 * c2 + z12 * s2
\r
828 z13 = z12 * c2 - y11 * s2
\r
832 x22 = x21 * c1 + z21 * s1
\r
833 z22 = z21 * c1 - x21 * s1
\r
836 y22 = y21 * c2 + z22 * s2
\r
837 z23 = z22 * c2 - y21 * s2
\r
842 rx1 = x12 / z13 * 130 + 160
\r
843 ry1 = y12 / z13 * 130 + 100
\r
845 rx2 = x22 / z23 * 130 + 160
\r
846 ry2 = y22 / z23 * 130 + 100
\r
848 LINE (rx1, ry1)-(rx2, ry2), linC(a)
\r
863 FOR a = 0 TO linAmo
\r
876 visMaxX = worldSize
\r
877 visMaxY = worldSize
\r
878 visMaxZ = worldSize
\r
879 visMinX = -worldSize
\r
880 visMinY = -worldSize
\r
881 visMinZ = -worldSize
\r
883 visDist = worldSize
\r
885 'INPUT "create new world (y/n)", a$
\r
889 ' INPUT "clear existing world (y/n)", a$
\r
890 ' IF a$ = "y" THEN clearWorld
\r
903 DEF SEG = 0 ' read first from interrupt table
\r
905 extSEG = PEEK(&H79 * 4 + 3) * 256
\r
906 extSEG = extSEG + PEEK(&H79 * 4 + 2)
\r
908 PRINT "Segment is: " + HEX$(extSEG)
\r
910 extADDR = PEEK(&H79 * 4 + 1) * 256
\r
911 extADDR = extADDR + PEEK(&H79 * 4 + 0)
\r
913 PRINT "relative address is:"; extADDR
\r
917 IF getword(0) <> 1983 THEN
\r
918 PRINT "FATAL ERROR: you must load"
\r
919 PRINT "QBasic extension TSR first!"
\r
925 FUNCTION toStr$ (a)
\r
928 IF LEFT$(b$, 1) = " " THEN b$ = RIGHT$(b$, LEN(b$) - 1)
\r