graphics/3D/swapping 3D engine/engine.bas

   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
   4 DECLARE SUB fill4 ()\r
   5 DECLARE SUB loadObject (name$, x!, y!, z!)\r
   6 DECLARE SUB putChar (a$, x!, y!, z!)\r
   7 ' 3D engine\r
   8 ' made by Svjatoslav Agejenko\r
   9 ' last edit 2004.1\r
  10 ' E-Mail: svjatoslavagejenko@gmail.com\r
  11 ' H-Page: svjatoslav.eu\r
  12  \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
  28 \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
  38 \r
  39 \r
  40 DIM SHARED an1, an2\r
  41 \r
  42 DIM SHARED extSEG, extADDR\r
  43 DIM SHARED buttL, buttR\r
  44 DIM SHARED maxmove\r
  45 \r
  46 DIM SHARED linAmo\r
  47 linAmo = 5000\r
  48 \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
  56 \r
  57 DIM SHARED myx, myy, myz\r
  58 DIM SHARED myxs, myys, myzs\r
  59 \r
  60 DIM SHARED curFreeLine\r
  61 DIM SHARED worldSize\r
  62 \r
  63 DIM SHARED usedLines\r
  64 DIM SHARED desMaxLines\r
  65 \r
  66 DIM SHARED visMaxX, visMaxY, visMaxZ\r
  67 DIM SHARED visMinX, visMinY, visMinZ\r
  68 \r
  69 DIM SHARED visDist\r
  70 DIM SHARED msgs$(1 TO 10)\r
  71 DIM SHARED frm\r
  72 \r
  73 \r
  74 'DIM SHARED blkData(1 TO 50) AS STRING * 512\r
  75 'DIM SHARED blkFrag(1 TO 50) AS STRING * 512\r
  76 \r
  77 \r
  78 \r
  79 \r
  80 nl = 0\r
  81 np = 0\r
  82 \r
  83 start\r
  84 \r
  85 \r
  86 cx = 0\r
  87 cy = 0\r
  88 cz = 0\r
  89 \r
  90 np = 1\r
  91 px(1) = 0\r
  92 py(1) = 0\r
  93 pz(1) = 0\r
  94 \r
  95 makeGrid -400, -400, -400, 400, 400, 400\r
  96 \r
  97 1\r
  98 frm = frm + 1\r
  99 \r
 100 'fill1\r
 101 fill2\r
 102 fill3\r
 103 fill4\r
 104 \r
 105 \r
 106 control\r
 107 \r
 108 render\r
 109 \r
 110 LOCATE 1, 1\r
 111 PRINT usedLines, visDist\r
 112 \r
 113 checkVisibility\r
 114 \r
 115 PCOPY 0, 1\r
 116 CLS\r
 117 GOTO 1\r
 118 \r
 119 SUB addMsg (a$)\r
 120 \r
 121 FOR a = 1 TO 9\r
 122   msgs$(a) = msgs$(a + 1)\r
 123 NEXT a\r
 124 \r
 125 msgs$(10) = a$\r
 126 END SUB\r
 127 \r
 128 SUB applyBounds\r
 129 \r
 130 FOR a = 0 TO linAmo\r
 131   IF linC(a) > 0 THEN\r
 132 \r
 133 \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
 137    \r
 138     clx = INT(cx / 100)\r
 139     cly = INT(cy / 100)\r
 140     clz = INT(cz / 100)\r
 141 \r
 142     IF clx > visMaxX THEN GOTO 8\r
 143     IF clx < visMinX THEN GOTO 8\r
 144    \r
 145     IF cly > visMaxY THEN GOTO 8\r
 146     IF cly < visMinY THEN GOTO 8\r
 147 \r
 148     IF clz > visMaxZ THEN GOTO 8\r
 149     IF clz < visMinZ THEN GOTO 8\r
 150 \r
 151     GOTO 7\r
 152 8   linC(a) = -1\r
 153     usedLines = usedLines - 1\r
 154   END IF\r
 155 7\r
 156 NEXT a\r
 157 \r
 158 END SUB\r
 159 \r
 160 SUB checkVisibility\r
 161 \r
 162 'DIM SHARED visMaxX, visMaxY, visMaxZ\r
 163 'DIM SHARED visMinX, visMinY, visMinZ\r
 164 \r
 165 \r
 166 mx = INT(myx / 100)\r
 167 my = INT(myy / 100)\r
 168 mz = INT(myz / 100)\r
 169 \r
 170 \r
 171 IF mx + visDist > visMaxX THEN\r
 172   newX = mx + visDist\r
 173   loadArea visMaxX + 1, visMinY, visMinZ, newX, visMaxY, visMaxZ\r
 174   visMaxX = newX\r
 175   LOCATE 1, 30\r
 176   PRINT "1"\r
 177 END IF\r
 178 IF mx - visDist < visMinX THEN\r
 179   newX = mx - visDist\r
 180   loadArea visMinX - 1, visMinY, visMinZ, newX, visMaxY, visMaxZ\r
 181   visMinX = newX\r
 182   LOCATE 1, 30\r
 183   PRINT "2"\r
 184 END IF\r
 185 \r
 186 \r
 187 IF my + visDist > visMaxY THEN\r
 188   newY = my + visDist\r
 189   loadArea visMinX, visMaxY + 1, visMinZ, visMaxX, newY, visMaxZ\r
 190   visMaxY = newY\r
 191   LOCATE 1, 30\r
 192   PRINT "3"\r
 193 END IF\r
 194 IF my - visDist < visMinY THEN\r
 195   newY = my - visDist\r
 196   loadArea visMinX, visMinY - 1, visMinZ, visMaxX, newY, visMaxZ\r
 197   visMinY = newY\r
 198   LOCATE 1, 30\r
 199   PRINT "4"\r
 200 END IF\r
 201 \r
 202 \r
 203 IF mz + visDist > visMaxZ THEN\r
 204   newZ = mz + visDist\r
 205   loadArea visMinX, visMinY, visMaxZ + 1, visMaxX, visMaxY, newZ\r
 206   visMaxZ = newZ\r
 207   LOCATE 1, 30\r
 208   PRINT "5"\r
 209 END IF\r
 210 IF mz - visDist < visMinZ THEN\r
 211   newZ = mz - visDist\r
 212   loadArea visMinX, visMinY, visMinZ - 1, visMaxX, visMaxY, newZ\r
 213   visMinZ = newZ\r
 214   LOCATE 1, 30\r
 215   PRINT "6"\r
 216 END IF\r
 217 \r
 218 \r
 219 IF usedLines > desMaxLines THEN decVisibility\r
 220 \r
 221 END SUB\r
 222 \r
 223 SUB clearWorld\r
 224 \r
 225 \r
 226 CHDIR "world"\r
 227 \r
 228 FOR x = -worldSize TO worldSize\r
 229 \r
 230   n$ = "X" + toStr$(x)\r
 231   CHDIR n$\r
 232 \r
 233   FOR y = -worldSize TO worldSize\r
 234 \r
 235     n2$ = "Y" + toStr$(y)\r
 236     CHDIR n2$\r
 237 \r
 238     PRINT x, y\r
 239     FOR z = -worldSize TO worldSize\r
 240 \r
 241       n3$ = "z" + toStr$(z) + ".dat"\r
 242       OPEN n3$ FOR OUTPUT AS #1\r
 243 '      PRINT #1, "0"\r
 244       CLOSE #1\r
 245     NEXT z\r
 246 \r
 247     CHDIR ".."\r
 248   NEXT y\r
 249 \r
 250   CHDIR ".."\r
 251 NEXT x\r
 252 \r
 253 CHDIR ".."\r
 254 \r
 255 END SUB\r
 256 \r
 257 SUB control\r
 258 \r
 259 \r
 260 IF getbyte(8) <> 0 THEN\r
 261   putbyte 8, 0\r
 262   xp = getword(2)\r
 263   putword 2, 0\r
 264   yp = getword(4)\r
 265   putword 4, 0\r
 266   butt = getword(6)\r
 267   putword 6, 0\r
 268   buttL = 0\r
 269   buttR = 0\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
 273 \r
 274 \r
 275   IF buttR = 1 THEN\r
 276     IF buttL = 1 THEN\r
 277       myxs = myxs + SIN(an1) * yp / 4\r
 278       myzs = myzs - COS(an1) * yp / 4\r
 279       GOTO 3\r
 280     END IF\r
 281     myys = myys + yp / 4\r
 282 3\r
 283     yp = 0\r
 284   END IF\r
 285 \r
 286 END IF\r
 287 \r
 288 \r
 289 \r
 290 \r
 291 IF xp < -maxmove THEN xp = -maxmove\r
 292 IF xp > maxmove THEN xp = maxmove\r
 293 an1 = an1 - xp / 150\r
 294 \r
 295 IF yp < -maxmove THEN yp = -maxmove\r
 296 IF yp > maxmove THEN yp = maxmove\r
 297 an2 = an2 - yp / 150\r
 298 \r
 299 \r
 300 \r
 301 a$ = INKEY$\r
 302 \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
 308 \r
 309 myxs = myxs / 1.1\r
 310 myys = myys / 1.1\r
 311 myzs = myzs / 1.1\r
 312 \r
 313 myx = myx + myxs\r
 314 myz = myz + myzs\r
 315 myy = myy + myys\r
 316 \r
 317 END SUB\r
 318 \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
 321 \r
 322 IF d < 100 THEN\r
 323   createNewLine x1, y1, z1, x2, y2, z2, c\r
 324 ELSE\r
 325   xp = (x1 + x2) / 2\r
 326   yp = (y1 + y2) / 2\r
 327   zp = (z1 + z2) / 2\r
 328   createLongLine x1, y1, z1, xp, yp, zp, c\r
 329   createLongLine xp, yp, zp, x2, y2, z2, c\r
 330 END IF\r
 331 END SUB\r
 332 \r
 333 SUB createNewLine (x1, y1, z1, x2, y2, z2, c)\r
 334 \r
 335 cx = (x1 + x2) / 2\r
 336 cy = (y1 + y2) / 2\r
 337 cz = (z1 + z2) / 2\r
 338 \r
 339 clx = INT(cx / 100)\r
 340 cly = INT(cy / 100)\r
 341 clz = INT(cz / 100)\r
 342 \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
 350           END IF\r
 351         END IF\r
 352       END IF\r
 353     END IF\r
 354   END IF\r
 355 END IF\r
 356 \r
 357 cln$ = getClustName(clx, cly, clz)\r
 358 \r
 359 OPEN cln$ FOR APPEND AS #1\r
 360   PRINT #1, x1; y1; z1; x2; y2; z2; c\r
 361 CLOSE #1\r
 362 \r
 363 END SUB\r
 364 \r
 365 SUB createWorld\r
 366 \r
 367 \r
 368 \r
 369 CHDIR "world"\r
 370 \r
 371 FOR x = -worldSize TO worldSize\r
 372  \r
 373   n$ = "X" + toStr$(x)\r
 374   MKDIR n$\r
 375   CHDIR n$\r
 376 \r
 377   FOR y = -worldSize TO worldSize\r
 378 \r
 379     n2$ = "Y" + toStr$(y)\r
 380     MKDIR n2$\r
 381     CHDIR n2$\r
 382 \r
 383     PRINT x, y\r
 384     FOR z = -worldSize TO worldSize\r
 385 \r
 386       n3$ = "z" + toStr$(z) + ".dat"\r
 387       OPEN n3$ FOR OUTPUT AS #1\r
 388 '      PRINT #1, "0"\r
 389       CLOSE #1\r
 390     NEXT z\r
 391 \r
 392     CHDIR ".."\r
 393   NEXT y\r
 394 \r
 395   CHDIR ".."\r
 396 NEXT x\r
 397 \r
 398 CHDIR ".."\r
 399 \r
 400 END SUB\r
 401 \r
 402 SUB decVisibility\r
 403 \r
 404 mx = INT(myx / 100)\r
 405 my = INT(myy / 100)\r
 406 mz = INT(myz / 100)\r
 407 \r
 408 6\r
 409 de = 0\r
 410 \r
 411 IF visMaxX > mx + visDist THEN\r
 412   visMaxX = mx + visDist\r
 413   de = 1\r
 414 END IF\r
 415 \r
 416 IF visMinX < mx - visDist THEN\r
 417   visMinX = mx - visDist\r
 418   de = 1\r
 419 END IF\r
 420 \r
 421 \r
 422 IF visMaxY > my + visDist THEN\r
 423   visMaxY = my + visDist\r
 424   de = 1\r
 425 END IF\r
 426 \r
 427 IF visMinY < my - visDist THEN\r
 428   visMinY = my - visDist\r
 429   de = 1\r
 430 END IF\r
 431 \r
 432 \r
 433 IF visMaxZ > mz + visDist THEN\r
 434   visMaxZ = mz + visDist\r
 435   de = 1\r
 436 END IF\r
 437 \r
 438 IF visMinZ < mz - visDist THEN\r
 439   visMinZ = mz - visDist\r
 440   de = 1\r
 441 END IF\r
 442 \r
 443 IF de = 0 THEN\r
 444   IF visDist > 3 THEN visDist = visDist - 1: GOTO 6\r
 445 ELSE\r
 446   addMsg "Visibility decareased"\r
 447 END IF\r
 448 \r
 449 \r
 450 applyBounds\r
 451 END SUB\r
 452 \r
 453 SUB dispmsg\r
 454 FOR a = 1 TO 10\r
 455   LOCATE a, 39 - LEN(msgs$(a))\r
 456   PRINT msgs$(a)\r
 457 NEXT a\r
 458 END SUB\r
 459 \r
 460 SUB fill1\r
 461 \r
 462 x1 = RND * 800 - 400\r
 463 y1 = RND * 800 - 400\r
 464 z1 = RND * 800 - 400\r
 465 \r
 466 x2 = x1 + RND * 20\r
 467 y2 = y1 + RND * 20\r
 468 z2 = z1 + RND * 20\r
 469 \r
 470 createNewLine x1, y1, z1, x2, y2, z2, INT(RND * 15) + 1\r
 471 \r
 472 END SUB\r
 473 \r
 474 SUB fill2\r
 475 \r
 476 \r
 477 frmt = frm * 15\r
 478 \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
 482 \r
 483 frmt = (frm - 1) * 15\r
 484 \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
 488 \r
 489 \r
 490 \r
 491 createNewLine x1, y1, z1, x2, y2, z2, INT(RND * 15) + 1\r
 492 \r
 493 END SUB\r
 494 \r
 495 SUB fill3\r
 496 \r
 497 IF frm / 10 = frm \ 10 THEN  ELSE GOTO fill31\r
 498 \r
 499 c = RND * 15 + 1\r
 500 \r
 501 x = RND * 800 - 400\r
 502 y = RND * 800 - 400\r
 503 z = RND * 800 - 400\r
 504 \r
 505 s = RND * 10 + 3\r
 506 \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
 511 \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
 516 \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
 521 \r
 522 xo = x\r
 523 yo = y\r
 524 zo = z\r
 525 \r
 526 \r
 527 x = x + RND * 80 - 40\r
 528 y = y + RND * 80 - 40\r
 529 z = z + RND * 80 - 40\r
 530 \r
 531 s = RND * 10 + 3\r
 532 \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
 537 \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
 542 \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
 547 \r
 548 \r
 549 createNewLine x, y, z, xo, yo, zo, c\r
 550 \r
 551 fill31:\r
 552 END SUB\r
 553 \r
 554 SUB fill4\r
 555 IF RND * 100 < 2 THEN\r
 556 \r
 557 b$ = ""\r
 558 FOR a = 1 TO RND * 3 + 1\r
 559 b$ = b$ + CHR$(48 + RND * 9)\r
 560 NEXT a\r
 561 \r
 562 'b$ = "Hello, world!"\r
 563 prn b$, RND * 800 - 400, RND * 800 - 400, RND * 800 - 400\r
 564 \r
 565 END IF\r
 566 END SUB\r
 567 \r
 568 FUNCTION getbyte (addr)\r
 569 getbyte = PEEK(extADDR + addr)\r
 570 END FUNCTION\r
 571 \r
 572 FUNCTION getClustName$ (a, b, c)\r
 573 \r
 574 getClustName$ = "WORLD\X" + toStr$(a) + "\Y" + toStr$(b) + "\Z" + toStr$(c) + ".DAT"\r
 575 \r
 576 END FUNCTION\r
 577 \r
 578 FUNCTION getword (addr)\r
 579 a = PEEK(extADDR + addr)\r
 580 b = PEEK(extADDR + addr + 1)\r
 581 \r
 582 \r
 583 c$ = HEX$(a)\r
 584 IF LEN(c$) = 1 THEN c$ = "0" + c$\r
 585 IF LEN(c$) = 0 THEN c$ = "00"\r
 586 \r
 587 \r
 588 c = VAL("&H" + HEX$(b) + c$)\r
 589 \r
 590 getword = c\r
 591 END FUNCTION\r
 592 \r
 593 SUB importCluster (x, y, z)\r
 594 \r
 595 cln$ = getClustName(x, y, z)\r
 596 '[PRINT cln$\r
 597 \r
 598 OPEN cln$ FOR INPUT AS #1\r
 599 5\r
 600 IF EOF(1) <> 0 THEN GOTO 4\r
 601  \r
 602 INPUT #1, x1, y1, z1, x2, y2, z2, c\r
 603 insertLine x1, y1, z1, x2, y2, z2, c\r
 604 \r
 605 GOTO 5\r
 606 4\r
 607 CLOSE #1\r
 608 \r
 609 \r
 610 END SUB\r
 611 \r
 612 SUB insertLine (x1, y1, z1, x2, y2, z2, c)\r
 613 \r
 614 insertLine1:\r
 615 IF linC(curFreeLine) = -1 THEN\r
 616   linX1(curFreeLine) = x1\r
 617   linY1(curFreeLine) = y1\r
 618   linZ1(curFreeLine) = z1\r
 619 \r
 620   linX2(curFreeLine) = x2\r
 621   linY2(curFreeLine) = y2\r
 622   linZ2(curFreeLine) = z2\r
 623  \r
 624   linC(curFreeLine) = c\r
 625   curFreeLine = curFreeLine + 1\r
 626   usedLines = usedLines + 1\r
 627   IF curFreeLine > linAmo THEN curFreeLine = 0\r
 628 ELSE\r
 629   curFreeLine = curFreeLine + 1\r
 630   IF curFreeLine > linAmo THEN curFreeLine = 0\r
 631   GOTO insertLine1\r
 632 END IF\r
 633 \r
 634 \r
 635 END SUB\r
 636 \r
 637 SUB loadArea (tx1, ty1, tz1, tx2, ty2, tz2)\r
 638 \r
 639 LOCATE 3, 1\r
 640 addMsg "Loading Area!"\r
 641 addMsg toStr$(tx1) + " " + toStr$(ty1) + " " + toStr$(tz1)\r
 642 addMsg toStr$(tx2) + " " + toStr$(ty2) + " " + toStr$(tz2)\r
 643 \r
 644 \r
 645 'PCOPY 0, 1\r
 646 'SLEEP\r
 647 \r
 648 x1 = tx1\r
 649 x2 = tx2\r
 650 \r
 651 y1 = ty1\r
 652 y2 = ty2\r
 653 \r
 654 z1 = tz1\r
 655 z2 = tz2\r
 656 \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
 660 \r
 661 FOR x = x1 TO x2\r
 662   FOR y = y1 TO y2\r
 663     FOR z = z1 TO z2\r
 664       loadCluster x, y, z\r
 665     NEXT z\r
 666   NEXT y\r
 667 NEXT x\r
 668 \r
 669 END SUB\r
 670 \r
 671 SUB loadCluster (x, y, z)\r
 672 \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
 676 \r
 677 cln$ = getClustName(x, y, z)\r
 678 \r
 679 OPEN cln$ FOR INPUT AS #1\r
 680 10\r
 681 IF EOF(1) <> 0 THEN GOTO 9\r
 682 \r
 683 INPUT #1, x1, y1, z1, x2, y2, z2, c\r
 684 insertLine x1, y1, z1, x2, y2, z2, c\r
 685 \r
 686 GOTO 10\r
 687 9\r
 688 CLOSE #1\r
 689 \r
 690 11\r
 691 \r
 692 END SUB\r
 693 \r
 694 SUB loadObject (name$, x, y, z)\r
 695 \r
 696 'SCREEN 13\r
 697 'PRINT "objects\" + name$ + ".3d"\r
 698 'END\r
 699 \r
 700 OPEN "OBJECTS\" + name$ + ".3d" FOR INPUT AS #2\r
 701 13\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
 705 GOTO 13\r
 706 12\r
 707 CLOSE #2\r
 708 \r
 709 END SUB\r
 710 \r
 711 SUB makeGrid (x1, y1, z1, x2, y2, z2)\r
 712 \r
 713 s = 100\r
 714 \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
 720   NEXT y\r
 721 NEXT x\r
 722 \r
 723 END SUB\r
 724 \r
 725 SUB mousedemo\r
 726 \r
 727 \r
 728 \r
 729 cx = 150\r
 730 cy = 100\r
 731 maxmove = 50\r
 732 100\r
 733 frm = frm + 1\r
 734 \r
 735 \r
 736 LOCATE 1, 1\r
 737 PRINT cx, cy\r
 738 PRINT frm\r
 739 \r
 740 CIRCLE (cx, cy), 10, 0\r
 741 xp = getword(2)\r
 742 putword 2, 0\r
 743 yp = getword(4)\r
 744 putword 4, 0\r
 745 \r
 746 \r
 747 IF xp < -maxmove THEN xp = -maxmove\r
 748 IF xp > maxmove THEN xp = maxmove\r
 749 cx = cx + xp\r
 750 \r
 751 IF yp < -maxmove THEN yp = -maxmove\r
 752 IF yp > maxmove THEN yp = maxmove\r
 753 cy = cy + yp\r
 754 \r
 755 \r
 756 CIRCLE (cx, cy), 10, 10\r
 757 \r
 758 \r
 759 \r
 760 SOUND 0, .05\r
 761 GOTO 100\r
 762 \r
 763 \r
 764 END SUB\r
 765 \r
 766 SUB prn (a$, x, y, z)\r
 767 \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
 771 NEXT a\r
 772 END SUB\r
 773 \r
 774 SUB putbyte (addr, dat)\r
 775 \r
 776 POKE (extADDR + addr), dat\r
 777 END SUB\r
 778 \r
 779 SUB putChar (a$, x, y, z)\r
 780 \r
 781 n$ = "FONT\LTR" + toStr(ASC(a$))\r
 782 loadObject n$, x, y, z\r
 783 \r
 784 END SUB\r
 785 \r
 786 SUB putword (addr, dat)\r
 787 \r
 788 b$ = HEX$(dat)\r
 789 \r
 790 2\r
 791 IF LEN(b$) < 4 THEN b$ = "0" + b$: GOTO 2\r
 792 \r
 793 n1 = VAL("&H" + LEFT$(b$, 2))\r
 794 n2 = VAL("&H" + RIGHT$(b$, 2))\r
 795 \r
 796 \r
 797 POKE (extADDR + addr), n2\r
 798 POKE (extADDR + addr + 1), n1\r
 799 \r
 800 END SUB\r
 801 \r
 802 SUB render\r
 803 \r
 804 s1 = SIN(an1)\r
 805 c1 = COS(an1)\r
 806 \r
 807 s2 = SIN(an2)\r
 808 c2 = COS(an2)\r
 809 \r
 810 \r
 811 FOR a = 0 TO linAmo\r
 812 \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
 817  \r
 818     x21 = linX2(a) - myx\r
 819     y21 = linY2(a) - myy\r
 820     z21 = linZ2(a) - myz\r
 821 \r
 822 \r
 823     x12 = x11 * c1 + z11 * s1\r
 824     z12 = z11 * c1 - x11 * s1\r
 825 \r
 826 \r
 827     y12 = y11 * c2 + z12 * s2\r
 828     z13 = z12 * c2 - y11 * s2\r
 829 \r
 830 \r
 831     IF z13 > 3 THEN\r
 832       x22 = x21 * c1 + z21 * s1\r
 833       z22 = z21 * c1 - x21 * s1\r
 834 \r
 835 \r
 836       y22 = y21 * c2 + z22 * s2\r
 837       z23 = z22 * c2 - y21 * s2\r
 838 \r
 839 \r
 840       IF z23 > 3 THEN\r
 841    \r
 842         rx1 = x12 / z13 * 130 + 160\r
 843         ry1 = y12 / z13 * 130 + 100\r
 844       \r
 845         rx2 = x22 / z23 * 130 + 160\r
 846         ry2 = y22 / z23 * 130 + 100\r
 847      \r
 848         LINE (rx1, ry1)-(rx2, ry2), linC(a)\r
 849       END IF\r
 850     END IF\r
 851   END IF\r
 852 NEXT a\r
 853 \r
 854 \r
 855 'dispmsg\r
 856 \r
 857 END SUB\r
 858 \r
 859 SUB start\r
 860 \r
 861 RANDOMIZE TIMER\r
 862 \r
 863 FOR a = 0 TO linAmo\r
 864   linC(a) = -1\r
 865 NEXT a\r
 866 \r
 867 \r
 868 startext\r
 869 \r
 870 maxmove = 50\r
 871 curFreeLine = 0\r
 872 worldSize = 5\r
 873 usedLines = 0\r
 874 desMaxLines = 2000\r
 875 \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
 882 \r
 883 visDist = worldSize\r
 884 \r
 885 'INPUT "create new world (y/n)", a$\r
 886 'IF a$ = "y" THEN\r
 887 '  createWorld\r
 888 'ELSE\r
 889 '  INPUT "clear existing world (y/n)", a$\r
 890 '  IF a$ = "y" THEN clearWorld\r
 891 'END IF\r
 892 \r
 893 clearWorld\r
 894 \r
 895 SCREEN 7, , , 1\r
 896 \r
 897 \r
 898 \r
 899 END SUB\r
 900 \r
 901 SUB startext\r
 902 \r
 903 DEF SEG = 0     ' read first from interrupt table\r
 904 \r
 905 extSEG = PEEK(&H79 * 4 + 3) * 256\r
 906 extSEG = extSEG + PEEK(&H79 * 4 + 2)\r
 907 \r
 908 PRINT "Segment is: " + HEX$(extSEG)\r
 909 \r
 910 extADDR = PEEK(&H79 * 4 + 1) * 256\r
 911 extADDR = extADDR + PEEK(&H79 * 4 + 0)\r
 912 \r
 913 PRINT "relative address is:"; extADDR\r
 914 \r
 915 DEF SEG = extSEG\r
 916 \r
 917 IF getword(0) <> 1983 THEN\r
 918   PRINT "FATAL ERROR:  you must load"\r
 919   PRINT "QBasic extension TSR first!"\r
 920   SYSTEM\r
 921 END IF\r
 922 \r
 923 END SUB\r
 924 \r
 925 FUNCTION toStr$ (a)\r
 926 \r
 927 b$ = STR$(a)\r
 928 IF LEFT$(b$, 1) = " " THEN b$ = RIGHT$(b$, LEN(b$) - 1)\r
 929 toStr$ = b$\r
 930 \r
 931 END FUNCTION\r
 932 \r