graphics/3D/3dtext.bas

   1 ' 3D text\r
   2 ' made by Svjatoslav Agejenko\r
   3 ' in 2003.12\r
   4 ' H-Page: svjatoslav.eu\r
   5 ' E-Mail: svjatoslav@svjatoslav.eu\r
   6  \r
   7 DECLARE SUB prn (x!, y!, a$)\r
   8 DECLARE SUB pch (x!, y!, a$)\r
   9 DECLARE SUB readfnt ()\r
  10 DECLARE SUB ruut2 (x!, y!, z!, s!)\r
  11 DECLARE SUB ruut (x!, y!, z!, s!)\r
  12 DECLARE SUB kuus (x, y, z, s)\r
  13 DECLARE SUB porand ()\r
  14 DECLARE SUB addp (x, y, z)\r
  15 ' kursor keys and to z, w - rotate\r
  16 ' <SPACE> - speed down\r
  17 ' q - quit\r
  18 \r
  19 DECLARE SUB start ()\r
  20 DECLARE SUB addsq (x1%, y1%, z1%)\r
  21 DECLARE SUB getcor ()\r
  22 DECLARE SUB mulcor ()\r
  23 DECLARE SUB nait3d ()\r
  24 DECLARE SUB calcsin ()\r
  25 DIM SHARED xn(4000), yn(4000), zn(4000)\r
  26 DIM SHARED x(4000), y(4000), z(4000)\r
  27 \r
  28 DIM SHARED xo(4000), yo(4000), zo(4000)\r
  29 DIM SHARED point1(4000), point2(4000)\r
  30 DIM SHARED col(4000)\r
  31 DIM SHARED nump, numl\r
  32 DIM SHARED myx, myy, myz, mye, myk\r
  33 DIM SHARED tpx(0 TO 10, 0 TO 255)\r
  34 DIM SHARED tpy(0 TO 10, 0 TO 255)\r
  35 DIM SHARED tl1(0 TO 10, 0 TO 255)\r
  36 DIM SHARED tl2(0 TO 10, 0 TO 255)\r
  37 \r
  38 myx = 0\r
  39 myy = 0\r
  40 myz = -100\r
  41 \r
  42 \r
  43 \r
  44 start\r
  45 \r
  46 nait3d\r
  47 \r
  48 SUB getcor\r
  49 \r
  50 xn(nump + 1) = -150\r
  51 yn(nump + 1) = -125\r
  52 zn(nump + 1) = -200\r
  53 \r
  54 xn(nump + 2) = 150\r
  55 yn(nump + 2) = -125\r
  56 zn(nump + 2) = -200\r
  57 \r
  58 xn(nump + 3) = 150\r
  59 yn(nump + 3) = 125\r
  60 zn(nump + 3) = -200\r
  61 \r
  62 xn(nump + 4) = -150\r
  63 yn(nump + 4) = 125\r
  64 zn(nump + 4) = -200\r
  65 \r
  66 \r
  67 xn(nump + 5) = -150\r
  68 yn(nump + 5) = -125\r
  69 zn(nump + 5) = 200\r
  70 \r
  71 xn(nump + 6) = 150\r
  72 yn(nump + 6) = -125\r
  73 zn(nump + 6) = 200\r
  74 \r
  75 xn(nump + 7) = 150\r
  76 yn(nump + 7) = 125\r
  77 zn(nump + 7) = 200\r
  78 \r
  79 xn(nump + 8) = -150\r
  80 yn(nump + 8) = 125\r
  81 zn(nump + 8) = 200\r
  82 \r
  83 \r
  84 point1(numl + 1) = nump + 1\r
  85 point2(numl + 1) = nump + 2\r
  86 \r
  87 point1(numl + 2) = nump + 2\r
  88 point2(numl + 2) = nump + 3\r
  89 \r
  90 point1(numl + 3) = nump + 3\r
  91 point2(numl + 3) = nump + 4\r
  92 \r
  93 point1(numl + 4) = nump + 4\r
  94 point2(numl + 4) = nump + 1\r
  95 \r
  96 point1(numl + 5) = nump + 5\r
  97 point2(numl + 5) = nump + 6\r
  98 \r
  99 point1(numl + 6) = nump + 6\r
 100 point2(numl + 6) = nump + 7\r
 101 \r
 102 point1(numl + 7) = nump + 7\r
 103 point2(numl + 7) = nump + 8\r
 104 \r
 105 point1(numl + 8) = nump + 8\r
 106 point2(numl + 8) = nump + 5\r
 107 \r
 108 point1(numl + 9) = nump + 5\r
 109 point2(numl + 9) = nump + 1\r
 110 \r
 111 point1(numl + 10) = nump + 6\r
 112 point2(numl + 10) = nump + 2\r
 113 \r
 114 point1(numl + 11) = nump + 7\r
 115 point2(numl + 11) = nump + 3\r
 116 \r
 117 point1(numl + 12) = nump + 8\r
 118 point2(numl + 12) = nump + 4\r
 119 \r
 120 nump = nump + 8\r
 121 numl = numl + 12\r
 122 \r
 123 \r
 124 \r
 125 \r
 126 xn(nump + 1) = -150\r
 127 yn(nump + 1) = -125 + 201\r
 128 zn(nump + 1) = 0\r
 129 \r
 130 xn(nump + 2) = -150\r
 131 yn(nump + 2) = -125 + 201\r
 132 zn(nump + 2) = 89\r
 133 \r
 134 xn(nump + 3) = -150\r
 135 yn(nump + 3) = -125\r
 136 zn(nump + 3) = 89\r
 137 \r
 138 xn(nump + 4) = -150\r
 139 yn(nump + 4) = -125\r
 140 zn(nump + 4) = 0\r
 141 \r
 142 point1(numl + 1) = nump + 1\r
 143 point2(numl + 1) = nump + 2\r
 144 \r
 145 point1(numl + 2) = nump + 2\r
 146 point2(numl + 2) = nump + 3\r
 147 \r
 148 point1(numl + 3) = nump + 3\r
 149 point2(numl + 3) = nump + 4\r
 150 \r
 151 point1(numl + 4) = nump + 4\r
 152 point2(numl + 4) = nump + 1\r
 153 \r
 154 nump = nump + 4\r
 155 numl = numl + 4\r
 156 \r
 157 \r
 158 \r
 159 prn 0, 0, "three dimensional "\r
 160 prn 0, -3, "text example"\r
 161 prn 0, -6, "etc etc etc"\r
 162 \r
 163 \r
 164 \r
 165 END SUB\r
 166 \r
 167 SUB kuus (x, y, z, s)\r
 168 \r
 169 b = 0\r
 170 f = .3925\r
 171 FOR a = 0 + f TO 6 + f STEP 6.28 / 8\r
 172 x1 = SIN(a) * s\r
 173 y1 = COS(a) * s\r
 174 b = b + 1\r
 175 \r
 176 xn(nump + b) = x1 + x\r
 177 yn(nump + b) = y\r
 178 zn(nump + b) = y1 + z\r
 179 \r
 180 NEXT a\r
 181 \r
 182 point1(numl + 1) = nump + 1\r
 183 point2(numl + 1) = nump + 2\r
 184 col(numl + 1) = 12\r
 185 \r
 186 point1(numl + 2) = nump + 2\r
 187 point2(numl + 2) = nump + 3\r
 188 col(numl + 2) = 12\r
 189 \r
 190 point1(numl + 3) = nump + 3\r
 191 point2(numl + 3) = nump + 4\r
 192 col(numl + 3) = 12\r
 193 \r
 194 point1(numl + 4) = nump + 4\r
 195 point2(numl + 4) = nump + 5\r
 196 col(numl + 4) = 12\r
 197 \r
 198 point1(numl + 5) = nump + 5\r
 199 point2(numl + 5) = nump + 6\r
 200 col(numl + 5) = 12\r
 201 \r
 202 \r
 203 point1(numl + 6) = nump + 6\r
 204 point2(numl + 6) = nump + 7\r
 205 col(numl + 6) = 12\r
 206 \r
 207 point1(numl + 7) = nump + 7\r
 208 point2(numl + 7) = nump + 8\r
 209 col(numl + 7) = 12\r
 210 \r
 211 point1(numl + 8) = nump + 8\r
 212 point2(numl + 8) = nump + 1\r
 213 col(numl + 8) = 12\r
 214 \r
 215 nump = nump + b\r
 216 numl = numl + 8\r
 217 'LOCATE 1, 1\r
 218 'PRINT b\r
 219 \r
 220 \r
 221 \r
 222 \r
 223 END SUB\r
 224 \r
 225 SUB nait3d\r
 226 \r
 227 1\r
 228 \r
 229 myx = myx + SIN(deg1) * mye\r
 230 myz = myz + COS(deg1) * mye\r
 231    \r
 232 myx = myx + COS(deg1) * myk\r
 233 myz = myz - SIN(deg1) * myk\r
 234 \r
 235 deg1 = deg1 + d1\r
 236 Deg2 = Deg2 + d2\r
 237   \r
 238 C1 = COS(deg1): S1 = SIN(deg1)\r
 239 C2 = COS(Deg2): S2 = SIN(Deg2)\r
 240  \r
 241 FOR a = 1 TO nump\r
 242 \r
 243 xo = xn(a) - myx\r
 244 yo = -yn(a) - myy\r
 245 zo = zn(a) - myz\r
 246       \r
 247 x1 = (xo * C1 - zo * S1)\r
 248 z1 = (xo * S1 + zo * C1)\r
 249        \r
 250 y1 = (yo * C2 - z1 * S2)\r
 251 z2 = (yo * S2 + z1 * C2)\r
 252        \r
 253 \r
 254 xo(a) = x(a)\r
 255 yo(a) = y(a)\r
 256 IF z2 < 20 THEN\r
 257 x(a) = -1\r
 258 ELSE\r
 259 x(a) = 320 + (x1 / z2 * 500)\r
 260 \r
 261 y(a) = 240 + (y1 / z2 * 500)\r
 262 END IF\r
 263 NEXT\r
 264      \r
 265 \r
 266 FOR a = 1 TO numl\r
 267 p1 = point1(a)\r
 268 p2 = point2(a)\r
 269 IF xo(p1) = -1 OR xo(p2) = -1 THEN  ELSE LINE (xo(p1), yo(p1))-(xo(p2), yo(p2)), 0\r
 270 IF x(p1) = -1 OR x(p2) = -1 THEN  ELSE LINE (x(p1), y(p1))-(x(p2), y(p2)), col(a)\r
 271 NEXT\r
 272   \r
 273 \r
 274 K$ = INKEY$\r
 275 IF K$ <> "" THEN\r
 276 \r
 277 SELECT CASE K$\r
 278 \r
 279 CASE CHR$(0) + "P"\r
 280 mye = mye - 1\r
 281 \r
 282 CASE CHR$(0) + "H"\r
 283 mye = mye + 1\r
 284 \r
 285 CASE CHR$(0) + "M"\r
 286 myk = myk + 1\r
 287 \r
 288 CASE CHR$(0) + "K"\r
 289 myk = myk - 1\r
 290 \r
 291 CASE "+"\r
 292 myy = myy + 3\r
 293 \r
 294 CASE "-"\r
 295 myy = myy - 3\r
 296 \r
 297 CASE "6"\r
 298 d1 = d1 + .01\r
 299 \r
 300 CASE "4"\r
 301 d1 = d1 - .01\r
 302 \r
 303 CASE "8"\r
 304 d2 = d2 - .01\r
 305 \r
 306 CASE "2"\r
 307 d2 = d2 + .01\r
 308 \r
 309 \r
 310 CASE " "\r
 311 d1 = d1 / 2\r
 312 d2 = d2 / 2\r
 313 d3 = d3 / 2\r
 314 mye = mye / 2\r
 315 myk = myk / 2\r
 316 \r
 317 CASE "q"\r
 318 SYSTEM\r
 319 \r
 320 CASE CHR$(27)\r
 321 SYSTEM\r
 322 \r
 323 END SELECT\r
 324 END IF\r
 325 \r
 326 GOTO 1\r
 327 END SUB\r
 328 \r
 329 SUB pch (x, y, a$)\r
 330 \r
 331 \r
 332 b = ASC(a$)\r
 333 up = 0\r
 334 ul = 0\r
 335 \r
 336 FOR c = 0 TO 100\r
 337 IF tpx(c, b) = 999 THEN GOTO 4\r
 338 up = up + 1\r
 339 xn(nump + up) = x + tpx(c, b)\r
 340 yn(nump + up) = y - tpy(c, b)\r
 341 zn(nump + up) = 0\r
 342 NEXT c\r
 343 4\r
 344 \r
 345 FOR c = 0 TO 100\r
 346 IF tl1(c, b) = 999 THEN GOTO 5\r
 347 ul = ul + 1\r
 348 point1(numl + ul) = tl1(c, b) + nump + 1\r
 349 point2(numl + ul) = tl2(c, b) + nump + 1\r
 350 col(numl + ul) = 4\r
 351 NEXT c\r
 352 5\r
 353 \r
 354 \r
 355 \r
 356 nump = nump + up\r
 357 numl = numl + ul\r
 358 \r
 359 \r
 360 END SUB\r
 361 \r
 362 SUB porand\r
 363 \r
 364 FOR x = -100 TO 0 STEP 12.067 + .3\r
 365 FOR z = -100 TO 0 STEP 12.067 + .3\r
 366 kuus x, -125, z, 6.53\r
 367 ruut x + 6.033 + .15, -125, z + 6.033 + .15, 3.111 + .3\r
 368 NEXT z\r
 369 NEXT x\r
 370 \r
 371 FOR y = -100 TO 0 STEP 20.3\r
 372 FOR x = -100 TO 0 STEP 20.3\r
 373 ruut2 x, y, 200, 10\r
 374 NEXT x\r
 375 NEXT y\r
 376 \r
 377 \r
 378 END SUB\r
 379 \r
 380 SUB prn (x, y, a$)\r
 381 \r
 382 FOR b = 1 TO LEN(a$)\r
 383 c$ = RIGHT$(LEFT$(a$, b), 1)\r
 384 pch x + b * 3, y, c$\r
 385 NEXT b\r
 386 END SUB\r
 387 \r
 388 SUB readfnt\r
 389 OPEN "font.dat" FOR INPUT AS #1\r
 390 3\r
 391 IF EOF(1) <> 0 THEN GOTO 2\r
 392 LINE INPUT #1, a$\r
 393 IF LEFT$(a$, 1) = "#" THEN\r
 394 chr = ASC(RIGHT$(LEFT$(a$, 3), 1))\r
 395 pp = 0\r
 396 lp = 0\r
 397 END IF\r
 398 IF LEFT$(a$, 1) = "p" THEN\r
 399 tpx(pp, chr) = VAL(RIGHT$(LEFT$(a$, 3), 1))\r
 400 tpy(pp, chr) = VAL(RIGHT$(LEFT$(a$, 5), 1))\r
 401 pp = pp + 1\r
 402 END IF\r
 403 IF LEFT$(a$, 1) = "l" THEN\r
 404 tl1(lp, chr) = VAL(RIGHT$(LEFT$(a$, 3), 1))\r
 405 tl2(lp, chr) = VAL(RIGHT$(LEFT$(a$, 5), 1))\r
 406 lp = lp + 1\r
 407 END IF\r
 408 \r
 409 GOTO 3\r
 410 2\r
 411 CLOSE #1\r
 412 \r
 413 \r
 414 END SUB\r
 415 \r
 416 SUB ruut (x, y, z, s)\r
 417 xn(nump + 1) = x\r
 418 yn(nump + 1) = y\r
 419 zn(nump + 1) = z + s\r
 420 \r
 421 xn(nump + 2) = x + s\r
 422 yn(nump + 2) = y\r
 423 zn(nump + 2) = z\r
 424 \r
 425 xn(nump + 3) = x\r
 426 yn(nump + 3) = y\r
 427 zn(nump + 3) = z - s\r
 428 \r
 429 xn(nump + 4) = x - s\r
 430 yn(nump + 4) = y\r
 431 zn(nump + 4) = z\r
 432 \r
 433 point1(numl + 1) = nump + 1\r
 434 point2(numl + 1) = nump + 2\r
 435 col(numl + 1) = 10\r
 436 \r
 437 point1(numl + 2) = nump + 2\r
 438 point2(numl + 2) = nump + 3\r
 439 col(numl + 2) = 10\r
 440 \r
 441 point1(numl + 3) = nump + 3\r
 442 point2(numl + 3) = nump + 4\r
 443 col(numl + 3) = 10\r
 444 \r
 445 point1(numl + 4) = nump + 4\r
 446 point2(numl + 4) = nump + 1\r
 447 col(numl + 4) = 10\r
 448 \r
 449 nump = nump + 4\r
 450 numl = numl + 4\r
 451 END SUB\r
 452 \r
 453 SUB ruut2 (x, y, z, s)\r
 454 xn(nump + 1) = x - s\r
 455 yn(nump + 1) = y - s\r
 456 zn(nump + 1) = z\r
 457 \r
 458 xn(nump + 2) = x + s\r
 459 yn(nump + 2) = y - s\r
 460 zn(nump + 2) = z\r
 461 \r
 462 xn(nump + 3) = x + s\r
 463 yn(nump + 3) = y + s\r
 464 zn(nump + 3) = z\r
 465 \r
 466 xn(nump + 4) = x - s\r
 467 yn(nump + 4) = y + s\r
 468 zn(nump + 4) = z\r
 469 \r
 470 point1(numl + 1) = nump + 1\r
 471 point2(numl + 1) = nump + 2\r
 472 col(numl + 1) = 14\r
 473 \r
 474 point1(numl + 2) = nump + 2\r
 475 point2(numl + 2) = nump + 3\r
 476 col(numl + 2) = 14\r
 477 \r
 478 point1(numl + 3) = nump + 3\r
 479 point2(numl + 3) = nump + 4\r
 480 col(numl + 3) = 14\r
 481 \r
 482 point1(numl + 4) = nump + 4\r
 483 point2(numl + 4) = nump + 1\r
 484 col(numl + 4) = 14\r
 485 \r
 486 nump = nump + 4\r
 487 numl = numl + 4\r
 488 \r
 489 END SUB\r
 490 \r
 491 SUB start\r
 492 SCREEN 12\r
 493 CLS\r
 494 \r
 495 FOR a = 1 TO 4000\r
 496 col(a) = 15\r
 497 NEXT a\r
 498 \r
 499 nump = 0\r
 500 numl = 0\r
 501 FOR a = 0 TO 255\r
 502 FOR b = 0 TO 10\r
 503 tpx(b, a) = 999\r
 504 tpy(b, a) = 999\r
 505 tl1(b, a) = 999\r
 506 tl2(b, a) = 999\r
 507 NEXT b\r
 508 NEXT a\r
 509 \r
 510 \r
 511 readfnt\r
 512 getcor\r
 513 \r
 514 END SUB\r
 515 \r