graphics/3D/3dtest.bas

   1 ' 3D test\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 star (x!, y!, z!, an1!, an2!, an3!)\r
   8 DECLARE SUB gp (x!, y!, z!, x1!, y1!)\r
   9 DECLARE SUB stic (x!, y!, z!, an1!, an2!, an3!)\r
  10 DECLARE SUB gc (x!, y!, z!, x1!, y1!, z1!)\r
  11 DECLARE SUB gcp (x!, y!, z!, x1!, y1!)\r
  12 DECLARE SUB setan (alp!, bet!, gam!)\r
  13 DECLARE SUB start ()\r
  14 DECLARE SUB drawscr ()\r
  15 \r
  16 DIM SHARED mx1, my1, mz1\r
  17 DIM SHARED mx2, my2, mz2\r
  18 DIM SHARED mx3, my3, mz3\r
  19 \r
  20 DIM SHARED frm, pi\r
  21 \r
  22 start\r
  23 \r
  24 1\r
  25 \r
  26 drawscr\r
  27 frm = frm + 1\r
  28 GOTO 1\r
  29 \r
  30 SUB drawscr\r
  31 \r
  32 an1 = SIN(frm / 50) / 2\r
  33 an2 = SIN(frm / 23) / 2 - .5\r
  34 an3 = 0\r
  35 \r
  36 setan an1, an2, an3\r
  37 \r
  38 FOR x = -100 TO 100 STEP 10\r
  39   FOR z = 0 TO 200 STEP 10\r
  40     gcp x, -90, z, x1, y1\r
  41     PSET (x1, y1), 15\r
  42   NEXT z\r
  43 NEXT x\r
  44 \r
  45 gc -70, -90, 150, x1, y1, z1\r
  46 \r
  47 stic x1, y1, z1, an1, an2, an3\r
  48 \r
  49 \r
  50 PCOPY 0, 1\r
  51 CLS\r
  52 END SUB\r
  53 \r
  54 SUB gc (x, y, z, x1, y1, z1)\r
  55 x1 = x * mx1 + y * my1 + z * mz1\r
  56 y1 = x * mx2 + y * my2 + z * mz2\r
  57 z1 = x * mx3 + y * my3 + z * mz3\r
  58 END SUB\r
  59 \r
  60 SUB gcp (x, y, z, x1, y1)\r
  61 \r
  62 rx = x * mx1 + y * my1 + z * mz1        ' matrix transformation\r
  63 ry = x * mx2 + y * my2 + z * mz2\r
  64 rz = x * mx3 + y * my3 + z * mz3\r
  65 \r
  66 rz = rz + 100                           ' perspective calculation\r
  67 x1 = rx / rz * 120\r
  68 y1 = ry / rz * 120\r
  69 \r
  70 END SUB\r
  71 \r
  72 SUB gp (x, y, z, x1, y1)\r
  73 rz = z + 100                           ' perspective calculation\r
  74 x1 = x / rz * 120\r
  75 y1 = y / rz * 120\r
  76 END SUB\r
  77 \r
  78 SUB setan (alp, bet, gam)\r
  79 mx1 = SIN(gam) * SIN(bet) * SIN(alp) + COS(gam) * COS(alp)\r
  80 my1 = COS(bet) * SIN(alp)\r
  81 mz1 = SIN(gam) * COS(alp) - COS(gam) * SIN(bet) * SIN(alp)\r
  82 \r
  83 mx2 = SIN(gam) * SIN(bet) * COS(alp) - COS(gam) * SIN(alp)\r
  84 my2 = COS(bet) * COS(alp)\r
  85 mz2 = -COS(gam) * SIN(bet) * COS(alp) - SIN(gam) * SIN(alp)\r
  86 \r
  87 mx3 = -SIN(gam) * COS(bet)\r
  88 my3 = SIN(bet)\r
  89 mz3 = COS(gam) * COS(bet)\r
  90 END SUB\r
  91 \r
  92 SUB star (x, y, z, an1, an2, an3)\r
  93 \r
  94 nan1 = an1\r
  95 nan2 = an2\r
  96 nan3 = an3\r
  97 \r
  98 setan nan1, nan2, nan3\r
  99 gp x, y, z, rx1, ry1\r
 100 \r
 101 FOR n = 0 TO pi * 2 - .1 STEP pi / 5\r
 102   x1 = SIN(n) * 20\r
 103   y1 = COS(n) * 20\r
 104 \r
 105   gc x1, y1, 0, x2, y2, z2\r
 106   gp x2 + x, y2 + y, z2 + z, rx2, ry2\r
 107 CIRCLE (rx2, ry2), 1, 14\r
 108 LINE (rx2, ry2)-(rx1, ry1), 1\r
 109 NEXT n\r
 110 \r
 111 \r
 112 END SUB\r
 113 \r
 114 SUB start\r
 115 SCREEN 7, , , 1\r
 116 WINDOW (-160, -100)-(160, 100)\r
 117 \r
 118 pi = 3.141592\r
 119 \r
 120 END SUB\r
 121 \r
 122 SUB stic (x, y, z, an1, an2, an3)\r
 123 nan1 = an1\r
 124 nan2 = an2\r
 125 nan3 = an3 + frm / 50\r
 126 \r
 127 setan nan1, nan2, nan3\r
 128 gp x, y, z, rx1, ry1\r
 129 \r
 130 DIM tmpx(0 TO 5)\r
 131 DIM tmpy(0 TO 5)\r
 132 DIM tmpz(0 TO 5)\r
 133 \r
 134 DIM tmprx(0 TO 5)\r
 135 DIM tmpry(0 TO 5)\r
 136 p = 0\r
 137 \r
 138 FOR n = 0 TO pi * 2 - .5 STEP pi / 3\r
 139   x1 = SIN(n) * 100\r
 140   z1 = COS(n) * 100\r
 141 \r
 142   gc x1, 100, z1, x2, y2, z2\r
 143   tmpx(p) = x2 + x\r
 144   tmpy(p) = y2 + y\r
 145   tmpz(p) = z2 + z\r
 146   gp x2 + x, y2 + y, z2 + z, rx2, ry2\r
 147   tmprx(p) = rx2\r
 148   tmpry(p) = ry2\r
 149   LINE (rx1, ry1)-(rx2, ry2), 15\r
 150  \r
 151   p = p + 1\r
 152 NEXT n\r
 153 \r
 154 LINE (tmprx(0), tmpry(0))-(tmprx(2), tmpry(2)), 10\r
 155 LINE (tmprx(2), tmpry(2))-(tmprx(4), tmpry(4)), 10\r
 156 LINE (tmprx(4), tmpry(4))-(tmprx(0), tmpry(0)), 10\r
 157 \r
 158 LINE (tmprx(1), tmpry(1))-(tmprx(3), tmpry(3)), 12\r
 159 LINE (tmprx(3), tmpry(3))-(tmprx(5), tmpry(5)), 12\r
 160 LINE (tmprx(5), tmpry(5))-(tmprx(1), tmpry(1)), 12\r
 161 \r
 162 star tmpx(0), tmpy(0), tmpz(0), nan1, nan2, nan3\r
 163 \r
 164 END SUB\r
 165 \r