graphics/3D/3dland.bas

   1 ' Svjatoslav Agejenko\r
   2 ' year 1999\r
   3 \r
   4 DECLARE SUB setpal ()\r
   5 DEFINT A-Y\r
   6 DECLARE SUB box (x1, y1, x2, y2, x3, y3, x4, y4, c) 'draw filled\r
   7                                                     'box using 4 cordinates\r
   8                                                  '(sometimes don't work\r
   9                                                  'correctly, but fast.\r
  10                                                  '(PAINT command used))\r
  11 DIM SHARED x1(1 TO 40, 1 TO 40)  ' X & Y  cordinates\r
  12 DIM SHARED y1(1 TO 40, 1 TO 40)  '\r
  13 \r
  14 SCREEN 12\r
  15 \r
  16 setpal\r
  17 zfa = 1.5\r
  18 1\r
  19 FOR b = 1 TO 40\r
  20 FOR a = 1 TO 40\r
  21 \r
  22 x = 120 + (a * 10)\r
  23 y = 200 + (b * 3)\r
  24 \r
  25 y = y - COS(SQR((a - 20) ^ 2 + (b - 20) ^ 2) / zfa) * 20\r
  26 \r
  27 x = (x - 320) * (b + 50) / 50 + 320\r
  28 y = (y - 240) * (b + 50) / 50 + 240\r
  29 \r
  30 x1(a, b) = x\r
  31 y1(a, b) = y\r
  32 \r
  33 NEXT a\r
  34 NEXT b\r
  35 \r
  36 \r
  37 \r
  38 FOR b = 1 TO 39\r
  39 FOR a = 1 TO 39\r
  40 IF (a + b) \ 2 = (a + b + 1) \ 2 THEN c = 0 ELSE c = 5\r
  41 kz = b + (a / 3)\r
  42 \r
  43 box x1(a, b), y1(a, b), x1(a + 1, b), y1(a + 1, b), x1(a, b + 1), y1(a, b + 1), x1(a + 1, b + 1), y1(a + 1, b + 1), c\r
  44 NEXT a\r
  45 NEXT b\r
  46 \r
  47 a$ = INPUT$(1)\r
  48 zfa = zfa * 1.9\r
  49 CLS\r
  50 IF zfa > 10 THEN SYSTEM\r
  51 GOTO 1\r
  52 \r
  53 SUB box (x1, y1, x2, y2, x3, y3, x4, y4, c1)\r
  54 \r
  55 c1 = c1 + (y2 - y1) / 3.5 + (kz / 8) + 4\r
  56 \r
  57 IF c1 < 0 THEN c1 = 0\r
  58 IF c1 > 15 THEN c1 = 15\r
  59 \r
  60 a = SQR((x1 - x2) ^ 2 + (y1 - y2) ^ 2)\r
  61 b = SQR((x3 - x4) ^ 2 + (y3 - y4) ^ 2)\r
  62 IF b < a THEN b = a\r
  63 FOR a = 1 TO b\r
  64 x5 = (x2 - x1) * a / b + x1\r
  65 y5 = (y2 - y1) * a / b + y1\r
  66 x6 = (x4 - x3) * a / b + x3\r
  67 y6 = (y4 - y3) * a / b + y3\r
  68 LINE (x5, y5)-(x6, y6), c1\r
  69 LINE (x5 + 1, y5)-(x6 + 1, y6), c1\r
  70 NEXT a\r
  71 END SUB\r
  72 \r
  73 SUB setpal\r
  74 FOR a = 0 TO 16\r
  75 OUT &H3C8, a\r
  76 OUT &H3C9, a * 4\r
  77 OUT &H3C9, a * 4\r
  78 OUT &H3C9, a * 3\r
  79 NEXT\r
  80 END SUB\r
  81 \r