graphics/3D/realtime anaglyph/stereo.BAS

   1 DECLARE SUB ling (x1%, y1%, x2%, y2%)\r
   2 ' Svjatoslav Agejenko, svjatoslav@svjatoslav.eu, svjatoslav.eu\r
   3 ' 2004.07\r
   4 \r
   5 ' Generate stereo image. Red & Green (blue) glasses necessary.\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 ' q, w       - change horisontal distance between left and right view\r
  12 \r
  13 \r
  14 DECLARE SUB mkkoll ()\r
  15 DECLARE SUB putkol ()\r
  16 DECLARE SUB rend ()\r
  17 DECLARE SUB env ()\r
  18 DECLARE SUB start ()\r
  19 DIM SHARED npo, nlo, np, nl\r
  20 DIM SHARED px(1 TO 1000)\r
  21 DIM SHARED py(1 TO 1000)\r
  22 DIM SHARED pz(1 TO 1000)\r
  23 \r
  24 DIM SHARED rpx(1 TO 1000)\r
  25 DIM SHARED rpx2(1 TO 1000)\r
  26 DIM SHARED rpy(1 TO 1000)\r
  27 \r
  28 DIM SHARED orpx(1 TO 1000)\r
  29 DIM SHARED orpx2(1 TO 1000)\r
  30 DIM SHARED orpy(1 TO 1000)\r
  31 DIM SHARED onp\r
  32 DIM SHARED lin1(1 TO 1000)\r
  33 DIM SHARED lin2(1 TO 1000)\r
  34 DIM SHARED linc(1 TO 1000)\r
  35 DIM SHARED olin1(1 TO 1000)\r
  36 DIM SHARED olin2(1 TO 1000)\r
  37 DIM SHARED onl\r
  38 DIM SHARED myx, myy, myz\r
  39 DIM SHARED myxs, myys, myzs\r
  40 DIM SHARED an1, an2\r
  41 DIM SHARED an1s, an2s\r
  42 DIM SHARED kolx(1 TO 10)\r
  43 DIM SHARED koly(1 TO 10)\r
  44 DIM SHARED kolz(1 TO 10)\r
  45 DIM SHARED kolxs(1 TO 10)\r
  46 DIM SHARED kolys(1 TO 10)\r
  47 DIM SHARED kolzs(1 TO 10)\r
  48 DIM SHARED kolm\r
  49 DIM SHARED difp\r
  50 \r
  51 DIM SHARED spee\r
  52 \r
  53 spee = 4\r
  54 'ON ERROR GOTO 2\r
  55 \r
  56 start\r
  57 env\r
  58 putkol\r
  59 difp = -.1\r
  60 1\r
  61 PCOPY 0, 1\r
  62 CLS\r
  63 \r
  64 np = npo\r
  65 nl = nlo\r
  66 \r
  67 mkkoll\r
  68 rend\r
  69 \r
  70 myx = myx + myxs\r
  71 myy = myy + myys\r
  72 myz = myz + myzs\r
  73 an1 = an1 + an1s\r
  74 an2 = an2 + an2s\r
  75 \r
  76 a$ = INKEY$\r
  77 IF a$ <> "" THEN\r
  78 IF a$ = CHR$(0) + "H" THEN\r
  79 myzs = myzs - SIN(an1) / 100\r
  80 myxs = myxs - COS(an1) / 100\r
  81 END IF\r
  82 IF a$ = CHR$(0) + "P" THEN\r
  83 myzs = myzs + SIN(an1) / 100\r
  84 myxs = myxs + COS(an1) / 100\r
  85 END IF\r
  86 IF a$ = CHR$(0) + "M" THEN\r
  87 myzs = myzs + COS(an1) / 100\r
  88 myxs = myxs - SIN(an1) / 100\r
  89 END IF\r
  90 IF a$ = CHR$(0) + "K" THEN\r
  91 myzs = myzs - COS(an1) / 100\r
  92 myxs = myxs + SIN(an1) / 100\r
  93 END IF\r
  94 \r
  95 IF a$ = "6" THEN an1s = an1s - .01\r
  96 IF a$ = "4" THEN an1s = an1s + .01\r
  97 IF a$ = "8" THEN an2s = an2s - .01\r
  98 IF a$ = "2" THEN an2s = an2s + .01\r
  99 IF a$ = "+" THEN myys = myys - .01\r
 100 IF a$ = "-" THEN myys = myys + .01\r
 101 IF a$ = "q" THEN difp = difp - .01\r
 102 IF a$ = "w" THEN difp = difp + .01\r
 103 IF a$ = " " THEN\r
 104   myxs = myxs / 2\r
 105   myys = myys / 2\r
 106   myzs = myzs / 2\r
 107 \r
 108   an1s = an1s / 2\r
 109   an2s = an2s / 2\r
 110   an3s = an3s / 2\r
 111 \r
 112 END IF\r
 113 IF a$ = CHR$(27) THEN SYSTEM\r
 114 END IF\r
 115 GOTO 1\r
 116 2\r
 117 END\r
 118 RESUME\r
 119 \r
 120 SUB env\r
 121 \r
 122 FOR z = -5 TO 5\r
 123 FOR x = -5 TO 5\r
 124 np = np + 1\r
 125 px(np) = x\r
 126 py(np) = SIN(SQR(x * x + z * z) / 2)\r
 127 pz(np) = z\r
 128 IF x > -5 THEN\r
 129 nl = nl + 1\r
 130 lin1(nl) = np\r
 131 lin2(nl) = np - 1\r
 132 linc(nl) = 3\r
 133 END IF\r
 134 IF z > -5 THEN\r
 135 nl = nl + 1\r
 136 lin1(nl) = np\r
 137 lin2(nl) = np - 11\r
 138 linc(nl) = 3\r
 139 END IF\r
 140 NEXT x\r
 141 NEXT z\r
 142 \r
 143 npo = np\r
 144 nlo = nl\r
 145 \r
 146 \r
 147 END SUB\r
 148 \r
 149 SUB env1\r
 150 \r
 151 np = 1\r
 152 px(np) = -2\r
 153 py(np) = 0\r
 154 pz(np) = 0\r
 155 np = np + 1\r
 156 px(np) = 2\r
 157 py(np) = 0\r
 158 pz(np) = 0\r
 159 \r
 160 nl = 1\r
 161 lin1(nl) = 1\r
 162 lin2(nl) = 2\r
 163 linc(nl) = 14\r
 164 \r
 165 END SUB\r
 166 \r
 167 SUB ling (x1%, y1%, x2%, y2%)\r
 168 \r
 169 s = ABS(x1% - x2%)\r
 170 s2 = ABS(y1% - y2%)\r
 171 IF s2 > s THEN s = s2\r
 172 IF s < 2 THEN GOTO 101\r
 173 xp = x2% - x1%\r
 174 yp = y2% - y1%\r
 175 \r
 176 FOR a% = 1 TO s\r
 177   rx% = xp * a% / s + x1%\r
 178   ry% = yp * a% / s + y1%\r
 179   c% = POINT(rx%, ry%)\r
 180   IF c% = 0 THEN PSET (rx%, ry%), 2\r
 181   IF c% = 1 THEN PSET (rx%, ry%), 3\r
 182 NEXT a%\r
 183 101\r
 184 END SUB\r
 185 \r
 186 SUB linr (x1, y1, x2, y2)\r
 187   LINE (x1, y1)-(x2, y2), 1\r
 188 END SUB\r
 189 \r
 190 SUB mkkoll\r
 191 \r
 192 FOR a = 1 TO kolm\r
 193 x = kolx(a)\r
 194 y = koly(a)\r
 195 z = kolz(a)\r
 196 \r
 197 xs = kolxs(a)\r
 198 ys = kolys(a)\r
 199 zs = kolzs(a)\r
 200 \r
 201 ys = ys - .01\r
 202 \r
 203 x = x + xs / spee\r
 204 y = y + ys / spee\r
 205 z = z + zs / spee\r
 206 \r
 207 IF x > 5 THEN xs = -.1\r
 208 IF z > 5 THEN zs = -.1\r
 209 IF x < -5 THEN xs = .1\r
 210 IF z < -5 THEN zs = .1\r
 211 IF y < .5 THEN ys = RND * .2 + .1\r
 212 \r
 213 nl = nl + 1\r
 214 lin1(nl) = np + 1\r
 215 lin2(nl) = np + 2\r
 216 linc(nl) = 14\r
 217 \r
 218 nl = nl + 1\r
 219 lin1(nl) = np + 3\r
 220 lin2(nl) = np + 2\r
 221 linc(nl) = 14\r
 222 \r
 223 nl = nl + 1\r
 224 lin1(nl) = np + 3\r
 225 lin2(nl) = np + 4\r
 226 linc(nl) = 14\r
 227 \r
 228 nl = nl + 1\r
 229 lin1(nl) = np + 1\r
 230 lin2(nl) = np + 4\r
 231 linc(nl) = 14\r
 232 \r
 233 \r
 234 nl = nl + 1\r
 235 lin1(nl) = np + 1\r
 236 lin2(nl) = np + 5\r
 237 linc(nl) = 14\r
 238 \r
 239 nl = nl + 1\r
 240 lin1(nl) = np + 2\r
 241 lin2(nl) = np + 6\r
 242 linc(nl) = 14\r
 243 \r
 244 nl = nl + 1\r
 245 lin1(nl) = np + 3\r
 246 lin2(nl) = np + 7\r
 247 linc(nl) = 14\r
 248 \r
 249 nl = nl + 1\r
 250 lin1(nl) = np + 4\r
 251 lin2(nl) = np + 8\r
 252 linc(nl) = 14\r
 253 \r
 254 \r
 255 \r
 256 nl = nl + 1\r
 257 lin1(nl) = np + 5\r
 258 lin2(nl) = np + 6\r
 259 linc(nl) = 14\r
 260 \r
 261 nl = nl + 1\r
 262 lin1(nl) = np + 7\r
 263 lin2(nl) = np + 6\r
 264 linc(nl) = 14\r
 265 \r
 266 nl = nl + 1\r
 267 lin1(nl) = np + 7\r
 268 lin2(nl) = np + 8\r
 269 linc(nl) = 14\r
 270 \r
 271 nl = nl + 1\r
 272 lin1(nl) = np + 5\r
 273 lin2(nl) = np + 8\r
 274 linc(nl) = 14\r
 275 \r
 276 \r
 277 \r
 278 \r
 279 np = np + 1\r
 280 px(np) = x - .5\r
 281 py(np) = y - .5\r
 282 pz(np) = z - .5\r
 283 \r
 284 np = np + 1\r
 285 px(np) = x + .5\r
 286 py(np) = y - .5\r
 287 pz(np) = z - .5\r
 288 \r
 289 np = np + 1\r
 290 px(np) = x + .5\r
 291 py(np) = y + .5\r
 292 pz(np) = z - .5\r
 293 \r
 294 np = np + 1\r
 295 px(np) = x - .5\r
 296 py(np) = y + .5\r
 297 pz(np) = z - .5\r
 298 \r
 299 np = np + 1\r
 300 px(np) = x - .5\r
 301 py(np) = y - .5\r
 302 pz(np) = z + .5\r
 303 \r
 304 np = np + 1\r
 305 px(np) = x + .5\r
 306 py(np) = y - .5\r
 307 pz(np) = z + .5\r
 308 \r
 309 np = np + 1\r
 310 px(np) = x + .5\r
 311 py(np) = y + .5\r
 312 pz(np) = z + .5\r
 313 \r
 314 np = np + 1\r
 315 px(np) = x - .5\r
 316 py(np) = y + .5\r
 317 pz(np) = z + .5\r
 318 \r
 319 \r
 320 \r
 321 \r
 322 kolx(a) = x\r
 323 koly(a) = y\r
 324 kolz(a) = z\r
 325 kolxs(a) = xs\r
 326 kolys(a) = ys\r
 327 kolzs(a) = zs\r
 328 NEXT a\r
 329 \r
 330 END SUB\r
 331 \r
 332 SUB putkol\r
 333 \r
 334 s = 1\r
 335 FOR a = 1 TO kolm\r
 336 kolx(a) = RND * 10 - 5\r
 337 koly(a) = 2\r
 338 kolz(a) = RND * 10 - 5\r
 339 kolxs(a) = (RND * .5 - .25) / s\r
 340 kolys(a) = (RND * .5 + .1) / s\r
 341 kolzs(a) = (RND * .5 - .25) / s\r
 342 NEXT a\r
 343 END SUB\r
 344 \r
 345 SUB rend\r
 346 'C3& = Cosine&(Deg3): S3& = Sine&(Deg3)\r
 347 \r
 348 s1 = SIN(an1)\r
 349 c1 = COS(an1)\r
 350 s2 = SIN(an2)\r
 351 c2 = COS(an2)\r
 352 \r
 353 FOR a = 1 TO np\r
 354 x = px(a) + myx\r
 355 y = py(a) - myy\r
 356 z = pz(a) + myz\r
 357       \r
 358 x1 = x * s1 - z * c1\r
 359 z1 = x * c1 + z * s1\r
 360 y1 = y * s2 - z1 * c2\r
 361 z2 = y * c2 + z1 * s2\r
 362     \r
 363 IF z2 < .1 THEN\r
 364 rpx(a) = -1\r
 365 ELSE\r
 366 rpx(a) = 160 + ((x1 + difp) / z2 * 200)\r
 367 rpx2(a) = 160 + ((x1 - difp) / z2 * 200)\r
 368 rpy(a) = 100 - (y1 / z2 * 200)\r
 369 \r
 370 END IF\r
 371 NEXT a\r
 372     \r
 373 \r
 374 FOR a = 1 TO nl\r
 375 l1 = lin1(a)\r
 376 l2 = lin2(a)\r
 377 IF rpx(l1) = -1 OR rpx(l2) = -1 THEN\r
 378   ELSE\r
 379   LINE (rpx(l1), rpy(l1))-(rpx(l2), rpy(l2)), 1\r
 380 END IF\r
 381 NEXT\r
 382 \r
 383 FOR a = 1 TO nl\r
 384 l1 = lin1(a)\r
 385 l2 = lin2(a)\r
 386 IF rpx(l1) = -1 OR rpx(l2) = -1 THEN\r
 387   ELSE\r
 388   ling INT(rpx2(l1)), INT(rpy(l1)), INT(rpx2(l2)), INT(rpy(l2))\r
 389 END IF\r
 390 NEXT\r
 391 \r
 392 \r
 393 END SUB\r
 394 \r
 395 SUB start\r
 396 SCREEN 7, , , 1\r
 397 \r
 398 OUT &H3C8, 0\r
 399 OUT &H3C9, 63\r
 400 OUT &H3C9, 63\r
 401 OUT &H3C9, 63\r
 402 \r
 403 \r
 404 OUT &H3C8, 1\r
 405 OUT &H3C9, 63\r
 406 OUT &H3C9, 0\r
 407 OUT &H3C9, 0\r
 408 \r
 409 OUT &H3C8, 2\r
 410 OUT &H3C9, 0\r
 411 OUT &H3C9, 63\r
 412 OUT &H3C9, 63\r
 413 \r
 414 OUT &H3C8, 3\r
 415 OUT &H3C9, 0\r
 416 OUT &H3C9, 0\r
 417 OUT &H3C9, 0\r
 418 \r
 419 \r
 420 npo = 0\r
 421 nlo = 0\r
 422 np = npo\r
 423 nl = nlo\r
 424 kolm = 9\r
 425 \r
 426 myx = 0\r
 427 myy = 4\r
 428 myz = 7\r
 429 an1 = 3.14 / 2\r
 430 an2 = an1 + .6\r
 431 \r
 432 FOR a = 1 TO 1000\r
 433 linc(a) = 4\r
 434 NEXT a\r
 435 \r
 436 FOR a = 1 TO 1000\r
 437 olin1(a) = 1\r
 438 olin2(a) = 1\r
 439 NEXT a\r
 440 \r
 441 \r
 442 \r
 443 END SUB\r
 444 \r