graphics/3D/rocket.bas

   1 ' 3D rocket simulator\r
   2 ' made by Svjatoslav Agejenko\r
   3 ' in 2001\r
   4 ' H-Page: svjatoslav.eu\r
   5 ' E-Mail: svjatoslavagejenko@gmail.com\r
   6  \r
   7 ' arrow keys - move around\r
   8 ' 2, 6, 4, 8 - look around\r
   9 ' -          - fly up\r
  10 ' +          - fly down\r
  11 \r
  12 \r
  13 DECLARE SUB addp ()\r
  14 DECLARE SUB addl ()\r
  15 DEFDBL A-Z\r
  16 DECLARE SUB teerock ()\r
  17 DECLARE SUB teemaa ()\r
  18 DECLARE SUB start ()\r
  19 DECLARE SUB n3d ()\r
  20 \r
  21 DIM SHARED px(1 TO 1500)\r
  22 DIM SHARED py(1 TO 1500)\r
  23 DIM SHARED pz(1 TO 1500)\r
  24 \r
  25 DIM SHARED l1(1 TO 3000)\r
  26 DIM SHARED l2(1 TO 3000)\r
  27 DIM SHARED lc(1 TO 3000)\r
  28 \r
  29 DIM SHARED rpx(1 TO 1900)\r
  30 DIM SHARED rpy(1 TO 1900)\r
  31 \r
  32 DIM SHARED rkx(1 TO 200)\r
  33 DIM SHARED rky(1 TO 200)\r
  34 DIM SHARED rkz(1 TO 200)\r
  35 \r
  36 DIM SHARED mitp, mitl\r
  37 DIM SHARED myx, myy, myz\r
  38 DIM SHARED myxp, myyp, myzp\r
  39 DIM SHARED my1, my2\r
  40 \r
  41 \r
  42 DIM SHARED ox1(1 TO 2500)\r
  43 DIM SHARED oy1(1 TO 2500)\r
  44 DIM SHARED ox2(1 TO 2500)\r
  45 DIM SHARED oy2(1 TO 2500)\r
  46 DIM SHARED frm, frm2, frm3\r
  47 \r
  48 DIM SHARED mk, mks, rs, rst\r
  49 DIM SHARED pi\r
  50 DIM SHARED rkb, rke, rkm\r
  51 DIM SHARED rx, ry, rz, rxp, ryp, rzp\r
  52 \r
  53 DIM SHARED tmr$, ts\r
  54 DIM SHARED ale\r
  55 \r
  56 start\r
  57 my1 = -pi / 2\r
  58 \r
  59 rx = 0\r
  60 ry = mk / 2 + .009\r
  61 rz = 0\r
  62 \r
  63 myx = 0\r
  64 myy = mk / 2\r
  65 myz = -.05\r
  66 \r
  67 ts = 0\r
  68 frm2 = 999999\r
  69 tmr$ = TIME$\r
  70 1\r
  71 frm = frm + 1\r
  72 frm2 = frm2 + 1\r
  73 \r
  74 LOCATE 1, 1\r
  75 PRINT mitp, mitl, mk, mks\r
  76 LOCATE 2, 1\r
  77 PRINT rkb, rke, TIMER\r
  78 \r
  79 \r
  80 rx = rx + (rxp * ts)\r
  81 ry = ry + (ryp * ts)\r
  82 rz = rz + (rzp * ts)\r
  83 \r
  84 ryp = ryp + (.0098 * ts)\r
  85 rxp = SIN(frm / 20) / 50\r
  86 'ryp = .001\r
  87 \r
  88 FOR a = 1 TO rkm\r
  89 px(a + rkb - 1) = rkx(a) + rx\r
  90 py(a + rkb - 1) = rky(a) + ry\r
  91 pz(a + rkb - 1) = rkz(a) + rz\r
  92 NEXT a\r
  93 \r
  94 \r
  95 myx = myx + (myxp * ts)\r
  96 myy = myy + (myyp * ts)\r
  97 myz = myz + (myzp * ts)\r
  98 \r
  99 n3d\r
 100 \r
 101 \r
 102 \r
 103 a$ = INKEY$\r
 104 IF a$ <> "" THEN\r
 105 IF a$ = CHR$(0) + "H" THEN\r
 106 myzp = myzp - SIN(my1) / 100\r
 107 myxp = myxp + COS(my1) / 100\r
 108 END IF\r
 109 IF a$ = CHR$(0) + "P" THEN\r
 110 myzp = myzp + SIN(my1) / 100\r
 111 myxp = myxp - COS(my1) / 100\r
 112 END IF\r
 113 \r
 114 IF a$ = CHR$(0) + "M" THEN\r
 115 myzp = myzp + COS(my1) / 100\r
 116 myxp = myxp + SIN(my1) / 100\r
 117 END IF\r
 118 IF a$ = CHR$(0) + "K" THEN\r
 119 myzp = myzp - COS(my1) / 100\r
 120 myxp = myxp - SIN(my1) / 100\r
 121 END IF\r
 122 \r
 123 \r
 124 IF a$ = CHR$(27) THEN SYSTEM\r
 125 IF a$ = "4" THEN my1 = my1 + .1\r
 126 IF a$ = "6" THEN my1 = my1 - .1\r
 127 IF a$ = "2" THEN my2 = my2 + .1\r
 128 IF a$ = "8" THEN my2 = my2 - .1\r
 129 IF a$ = "-" THEN myyp = myyp + .01\r
 130 IF a$ = "+" THEN myyp = myyp - .01\r
 131 IF a$ = " " THEN myzp = myzp / 2: myxp = myxp / 2\r
 132 \r
 133 END IF\r
 134 \r
 135 v = SQR(rx * rx + ry * ry + rz * rz)\r
 136 s = SQR(rxp * rxp + ryp * ryp + rzp * rzp)\r
 137 \r
 138 \r
 139 IF tmr$ <> TIME$ THEN\r
 140 tmr$ = TIME$\r
 141 \r
 142 LOCATE 29, 1\r
 143 PRINT "speed"; INT(s * 1000)\r
 144 LOCATE 30, 1\r
 145 PRINT "fps"; frm3; "timeslice"; INT(ts * 1000); "distance"; v;\r
 146 frm3 = frm2\r
 147 ts = 1 / frm3\r
 148 frm2 = 0\r
 149 addp\r
 150 addl\r
 151 END IF\r
 152 GOTO 1\r
 153 \r
 154 SUB addl\r
 155 mitp = mitp + 1\r
 156 px(mitp) = rx\r
 157 py(mitp) = ry\r
 158 pz(mitp) = rz\r
 159 \r
 160 IF ale > 0 THEN\r
 161 mitl = mitl + 1\r
 162 l1(mitl) = ale\r
 163 l2(mitl) = mitp\r
 164 lc(mitl) = 13\r
 165 END IF\r
 166 \r
 167 ale = mitp\r
 168 END SUB\r
 169 \r
 170 SUB addp\r
 171 'DIM SHARED mitp, mitl\r
 172 mitp = mitp + 1\r
 173 px(mitp) = rx\r
 174 py(mitp) = ry\r
 175 pz(mitp) = rz\r
 176 \r
 177 mitp = mitp + 1\r
 178 px(mitp) = rx - .001\r
 179 py(mitp) = ry - .001\r
 180 pz(mitp) = rz\r
 181 \r
 182 mitp = mitp + 1\r
 183 px(mitp) = rx + .001\r
 184 py(mitp) = ry - .001\r
 185 pz(mitp) = rz\r
 186 \r
 187 mitl = mitl + 1\r
 188 l1(mitl) = mitp\r
 189 l2(mitl) = mitp - 1\r
 190 lc(mitl) = 14\r
 191 \r
 192 mitl = mitl + 1\r
 193 l1(mitl) = mitp - 2\r
 194 l2(mitl) = mitp - 1\r
 195 lc(mitl) = 14\r
 196 \r
 197 mitl = mitl + 1\r
 198 l1(mitl) = mitp\r
 199 l2(mitl) = mitp - 2\r
 200 lc(mitl) = 14\r
 201 \r
 202 \r
 203 \r
 204 END SUB\r
 205 \r
 206 SUB n3d\r
 207 s1 = SIN(my1)\r
 208 c1 = COS(my1)\r
 209 \r
 210 s2 = SIN(my2)\r
 211 c2 = COS(my2)\r
 212 \r
 213 \r
 214 FOR a = 1 TO mitp\r
 215 x = px(a) - myx\r
 216 y = py(a) - myy\r
 217 z = pz(a) - myz\r
 218 \r
 219 x1 = x * s1 + z * c1\r
 220 z1 = x * c1 - z * s1\r
 221 \r
 222 y1 = z1 * s2 + y * c2\r
 223 z2 = z1 * c2 - y * s2\r
 224 \r
 225 IF z2 < .00001 THEN\r
 226 rpx(a) = -1\r
 227 ELSE\r
 228 rpx(a) = x1 / z2 * 200 + 320\r
 229 rpy(a) = 240 - y1 / z2 * 200\r
 230 IF rpx(a) < -50 OR rpx(a) > 1000 OR rpy(a) < -50 OR rpy(a) > 1000 THEN rpx(a) = -1\r
 231 END IF\r
 232 NEXT a\r
 233 \r
 234 \r
 235 \r
 236 FOR a = 1 TO mitl\r
 237 p1 = l1(a)\r
 238 p2 = l2(a)\r
 239 x1 = rpx(p1)\r
 240 y1 = rpy(p1)\r
 241 x2 = rpx(p2)\r
 242 y2 = rpy(p2)\r
 243 IF ox1(a) = -1 OR ox2(a) = -1 THEN  ELSE LINE (ox1(a), oy1(a))-(ox2(a), oy2(a)), 0\r
 244 IF x1 = -1 OR x2 = -1 THEN GOTO 2\r
 245 LINE (x1, y1)-(x2, y2), lc(a)\r
 246 2\r
 247 ox1(a) = x1\r
 248 oy1(a) = y1\r
 249 ox2(a) = x2\r
 250 oy2(a) = y2\r
 251 \r
 252 NEXT a\r
 253 \r
 254 \r
 255 END SUB\r
 256 \r
 257 SUB start\r
 258 SCREEN 12\r
 259 VIEW PRINT 1 TO 30\r
 260 \r
 261 mk = 12714\r
 262 'mks = 250\r
 263 mks = 500\r
 264 rst = 4\r
 265 pi = 3.142657\r
 266 rs = .00002\r
 267 frm2 = 0\r
 268 \r
 269 ale = -1\r
 270 px(1) = -.001\r
 271 py(1) = mk / 2\r
 272 pz(1) = -.001\r
 273 \r
 274 px(2) = .001\r
 275 py(2) = mk / 2\r
 276 pz(2) = -.001\r
 277 \r
 278 px(3) = .001\r
 279 py(3) = mk / 2\r
 280 pz(3) = .001\r
 281 \r
 282 px(4) = -.001\r
 283 py(4) = mk / 2\r
 284 pz(4) = .001\r
 285 \r
 286 mitp = 4\r
 287 \r
 288 l1(1) = 1\r
 289 l2(1) = 2\r
 290 lc(1) = 14\r
 291 \r
 292 l1(2) = 2\r
 293 l2(2) = 3\r
 294 lc(2) = 14\r
 295 \r
 296 l1(3) = 3\r
 297 l2(3) = 4\r
 298 lc(3) = 14\r
 299 \r
 300 l1(4) = 4\r
 301 l2(4) = 1\r
 302 lc(4) = 14\r
 303 \r
 304 mitl = 4\r
 305 \r
 306 myx = 0\r
 307 myy = mk * 2\r
 308 myz = -35\r
 309 \r
 310 teemaa\r
 311 myxp = 0\r
 312 myyp = 0\r
 313 myzp = 0\r
 314 \r
 315 my1 = 0\r
 316 \r
 317 rkb = mitp + 1\r
 318 teerock\r
 319 rke = mitp\r
 320 \r
 321 rkm = rke - rkb + 1\r
 322 'DIM SHARED rkx(1 TO 1000)\r
 323 'DIM SHARED rky(1 TO 1000)\r
 324 'DIM SHARED rkz(1 TO 1000)\r
 325 \r
 326 FOR a = 1 TO rkm\r
 327 p = rkb + a - 1\r
 328 rkx(a) = px(p)\r
 329 rky(a) = py(p)\r
 330 rkz(a) = pz(p)\r
 331 NEXT a\r
 332 \r
 333 \r
 334 END SUB\r
 335 \r
 336 SUB teemaa\r
 337 tmpp = mitp\r
 338 le2 = 0\r
 339 \r
 340 FOR z = -(mk / 3) TO (mk / 3) STEP mks\r
 341 le = 0\r
 342 le2 = le2 + 1\r
 343 FOR x = -(mk / 3) TO (mk / 3) STEP mks\r
 344 \r
 345 \r
 346 IF SQR(x * x + z * z) > (mk / 2.5) THEN GOTO 4\r
 347 le = le + 1\r
 348 IF le = 1 THEN xs = (x / mks)\r
 349 mitp = mitp + 1\r
 350 px(mitp) = x\r
 351 v = SQR(x * x + z * z)\r
 352 py(mitp) = SQR((v + (mk / 2)) * ((mk / 2) - v))\r
 353 pz(mitp) = z\r
 354 IF le > 1 THEN\r
 355 mitl = mitl + 1\r
 356 l1(mitl) = mitp\r
 357 l2(mitl) = mitp - 1\r
 358 lc(mitl) = 3\r
 359 END IF\r
 360 \r
 361 IF le2 > 1 THEN\r
 362 IF xso > (x / mks) THEN GOTO 4\r
 363 IF xso + leo <= (x / mks) THEN GOTO 4\r
 364 \r
 365 mitl = mitl + 1\r
 366 l1(mitl) = mitp\r
 367 l2(mitl) = mitp - leo - xso + xs\r
 368 lc(mitl) = 3\r
 369 END IF\r
 370 4\r
 371 \r
 372 NEXT x\r
 373 leo = le\r
 374 xso = xs\r
 375 NEXT z\r
 376 \r
 377 END SUB\r
 378 \r
 379 SUB teerock\r
 380 \r
 381 \r
 382 s = 50\r
 383 FOR y = -9 TO 10 STEP rst\r
 384 st = pi * 2 / 6\r
 385 IF y > 5 THEN s = s - 3\r
 386 IF y > 8 THEN s = s - 6\r
 387 FOR a = 0 TO pi * 2 STEP st\r
 388 x1 = SIN(a) * s\r
 389 z1 = COS(a) * s\r
 390 'DIM SHARED mitp, mitl\r
 391 'DIM SHARED px(1 TO 4000)\r
 392 'DIM SHARED py(1 TO 4000)\r
 393 'DIM SHARED pz(1 TO 4000)\r
 394 'DIM SHARED l1(1 TO 7000)\r
 395 'DIM SHARED l2(1 TO 7000)\r
 396 'DIM SHARED lc(1 TO 7000)\r
 397 \r
 398 mitp = mitp + 1\r
 399 px(mitp) = x1 * rs\r
 400 py(mitp) = y * 50 * rs\r
 401 pz(mitp) = z1 * rs\r
 402 \r
 403 IF a > 0 THEN\r
 404 mitl = mitl + 1\r
 405 l1(mitl) = mitp\r
 406 l2(mitl) = mitp - 1\r
 407 lc(mitl) = 10\r
 408 END IF\r
 409 \r
 410 IF y > -9 THEN\r
 411 mitl = mitl + 1\r
 412 l1(mitl) = mitp\r
 413 l2(mitl) = mitp - 7\r
 414 lc(mitl) = 10\r
 415 END IF\r
 416 \r
 417 NEXT a\r
 418 NEXT y\r
 419 \r
 420 mitp = mitp + 1\r
 421 px(mitp) = 0\r
 422 py(mitp) = 11 * 50 * rs\r
 423 pz(mitp) = 0\r
 424 \r
 425 \r
 426 FOR a = 1 TO 6\r
 427 mitl = mitl + 1\r
 428 l1(mitl) = mitp\r
 429 l2(mitl) = mitp - a\r
 430 lc(mitl) = 10\r
 431 NEXT a\r
 432 \r
 433 mitp = mitp + 1\r
 434 px(mitp) = -100 * rs\r
 435 py(mitp) = -450 * rs\r
 436 pz(mitp) = 0\r
 437 \r
 438 mitp = mitp + 1\r
 439 px(mitp) = 100 * rs\r
 440 py(mitp) = -450 * rs\r
 441 pz(mitp) = 0\r
 442 \r
 443 mitp = mitp + 1\r
 444 px(mitp) = 0\r
 445 py(mitp) = -200 * rs\r
 446 pz(mitp) = 0\r
 447 \r
 448 mitl = mitl + 1\r
 449 l1(mitl) = mitp\r
 450 l2(mitl) = mitp - 1\r
 451 lc(mitl) = 12\r
 452 \r
 453 mitl = mitl + 1\r
 454 l1(mitl) = mitp - 2\r
 455 l2(mitl) = mitp - 1\r
 456 lc(mitl) = 12\r
 457 \r
 458 mitl = mitl + 1\r
 459 l1(mitl) = mitp\r
 460 l2(mitl) = mitp - 2\r
 461 lc(mitl) = 12\r
 462 \r
 463 \r
 464 \r
 465 mitp = mitp + 1\r
 466 px(mitp) = 0\r
 467 py(mitp) = -450 * rs\r
 468 pz(mitp) = -100 * rs\r
 469 \r
 470 mitp = mitp + 1\r
 471 px(mitp) = 0\r
 472 py(mitp) = -450 * rs\r
 473 pz(mitp) = 100 * rs\r
 474 \r
 475 \r
 476 mitl = mitl + 1\r
 477 l1(mitl) = mitp\r
 478 l2(mitl) = mitp - 1\r
 479 lc(mitl) = 12\r
 480 \r
 481 mitl = mitl + 1\r
 482 l1(mitl) = mitp - 2\r
 483 l2(mitl) = mitp - 1\r
 484 lc(mitl) = 12\r
 485 \r
 486 mitl = mitl + 1\r
 487 l1(mitl) = mitp\r
 488 l2(mitl) = mitp - 2\r
 489 lc(mitl) = 12\r
 490 \r
 491 \r
 492 END SUB\r
 493 \r