graphics/3D/!.bas

   1 ' Svjatoslav Agejenko\r
   2 ' Use keys:\r
   3 ' Up, Down, Left, Right, w, z - rotate\r
   4 ' <space> - speed down\r
   5 ' q - quit\r
   6 \r
   7 DECLARE SUB getcor ()\r
   8 DECLARE SUB mulcor ()\r
   9 DECLARE SUB nait3d ()\r
  10 DECLARE SUB calcsin ()\r
  11 DefInt A-Z\r
  12 Dim Shared Xn(100), Yn(100), Zn(100)\r
  13 Dim Shared Xs1(100), Ys1(100), Xe1(100), Ye1(100)\r
  14 Dim Shared x(100), y(100), z(100), pointers1(100), pointers2(100)\r
  15 Dim Shared Cosine&(360), Sine&(360)\r
  16 Dim Shared np, nl\r
  17 Dim Shared jrp, jrl\r
  18 jrp = 0\r
  19 jrl = 0\r
  20 \r
  21 \r
  22 Screen 12\r
  23 Cls\r
  24 \r
  25 \r
  26 calcsin\r
  27 getcor\r
  28 mulcor\r
  29 nait3d\r
  30 \r
  31 \r
  32 \r
  33 \r
  34 Data 5,-60,-10\r
  35 Data 15,-50,-10\r
  36 Data 15,0,-10\r
  37 Data 5,10,-10\r
  38 Data -5,10,-10\r
  39 Data -15,0,-10\r
  40 Data -15,-50,-10\r
  41 Data -5,-60,-10\r
  42 \r
  43 Data 5,-60,10\r
  44 Data 15,-50,10\r
  45 Data 15,0,10\r
  46 Data 5,10,10\r
  47 Data -5,10,10\r
  48 Data -15,0,10\r
  49 Data -15,-50,10\r
  50 Data -5,-60,10\r
  51 \r
  52 Data 5,20,10\r
  53 Data 15,30,10\r
  54 Data 15,40,10\r
  55 Data 5,50,10\r
  56 Data -5,50,10\r
  57 Data -15,40,10\r
  58 Data -15,30,10\r
  59 Data -5,20,10\r
  60 \r
  61 Data 5,20,-10\r
  62 Data 15,30,-10\r
  63 Data 15,40,-10\r
  64 Data 5,50,-10\r
  65 Data -5,50,-10\r
  66 Data -15,40,-10\r
  67 Data -15,30,-10\r
  68 Data -5,20,-10\r
  69 \r
  70 Data 999,999,999\r
  71 \r
  72 Data 0,1\r
  73 Data 1,2\r
  74 Data 2,3\r
  75 Data 3,4\r
  76 Data 4,5\r
  77 Data 5,6\r
  78 Data 6,7\r
  79 Data 7,0\r
  80 \r
  81 Data 8,9\r
  82 Data 9,10\r
  83 Data 10,11\r
  84 Data 11,12\r
  85 Data 12,13\r
  86 Data 13,14\r
  87 Data 14,15\r
  88 Data 15,8\r
  89 \r
  90 \r
  91 Data 0,8\r
  92 Data 1,9\r
  93 Data 2,10\r
  94 Data 3,11\r
  95 Data 4,12\r
  96 Data 5,13\r
  97 Data 6,14\r
  98 Data 7,15\r
  99 \r
 100 Data 16,17\r
 101 Data 17,18\r
 102 Data 18,19\r
 103 Data 19,20\r
 104 Data 20,21\r
 105 Data 21,22\r
 106 Data 22,23\r
 107 Data 23,16\r
 108 \r
 109 \r
 110 Data 24,25\r
 111 Data 25,26\r
 112 Data 26,27\r
 113 Data 27,28\r
 114 Data 28,29\r
 115 Data 29,30\r
 116 Data 30,31\r
 117 Data 31,24\r
 118 \r
 119 Data 24,16\r
 120 Data 25,17\r
 121 Data 26,18\r
 122 Data 27,19\r
 123 Data 28,20\r
 124 Data 29,21\r
 125 Data 30,22\r
 126 Data 31,23\r
 127 \r
 128 Data 999,999\r
 129 \r
 130 Sub calcsin\r
 131     For a! = 0 To 359 / 57.29577951# Step 1 / 57.29577951#\r
 132         Cosine&(a) = Int(.5 + Cos(a!) * 1024)\r
 133         Sine&(a) = Int(.5 + Sin(a!) * 1024)\r
 134         a = a + 1\r
 135     Next\r
 136 End Sub\r
 137 \r
 138 Sub getcor\r
 139     For a = 0 To 10000\r
 140         Read x(a), y(a), z(a)\r
 141         If x(a) = 999 Then x(a) = 0: y(a) = 0: z(a) = 0: GoTo 1\r
 142     Next\r
 143     1\r
 144     np = a\r
 145 \r
 146     For a = 0 To 10000\r
 147         Read pointers1(a), pointers2(a)\r
 148         If pointers1(a) = 999 Then GoTo 2\r
 149     Next\r
 150     2\r
 151     nl = a\r
 152 \r
 153 End Sub\r
 154 \r
 155 Sub mulcor\r
 156     suur = 0\r
 157     For a = 0 To np\r
 158         If Abs(x(a)) > suur Then suur = Abs(x(a))\r
 159         If Abs(y(a)) > suur Then suur = Abs(y(a))\r
 160         If Abs(z(a)) > suur Then suur = Abs(z(a))\r
 161     Next a\r
 162     ksuur = 100 / suur\r
 163 \r
 164     For a = 0 To np\r
 165         x(a) = x(a) * ksuur\r
 166         y(a) = y(a) * ksuur\r
 167         z(a) = z(a) * ksuur\r
 168     Next a\r
 169 End Sub\r
 170 \r
 171 Sub nait3d\r
 172 \r
 173     Do\r
 174 \r
 175         Deg1 = Deg1 + d1\r
 176         Deg2 = Deg2 + d2\r
 177         Deg3 = Deg3 + d3\r
 178 \r
 179         sound 0,1\r
 180 \r
 181         If Deg1 <= 0 Then Deg1 = Deg1 + 360\r
 182         If Deg2 <= 0 Then Deg2 = Deg2 + 360\r
 183         If Deg3 <= 0 Then Deg3 = Deg3 + 360\r
 184 \r
 185         If Deg1 >= 360 Then Deg1 = Deg1 - 360\r
 186         If Deg2 >= 360 Then Deg2 = Deg2 - 360\r
 187         If Deg3 >= 360 Then Deg3 = Deg3 - 360\r
 188 \r
 189         C1& = Cosine&(Deg1): S1& = Sine&(Deg1)\r
 190         C2& = Cosine&(Deg2): S2& = Sine&(Deg2)\r
 191         C3& = Cosine&(Deg3): S3& = Sine&(Deg3)\r
 192 \r
 193         For a = 0 To np - 1\r
 194             R = a\r
 195             Xo = x(R): Yo = y(R): Zo = z(R)\r
 196 \r
 197             X1 = (Xo * C1& - Yo * S1&) \ 1024\r
 198             Y1 = (Xo * S1& + Yo * C1&) \ 1024\r
 199 \r
 200             X2& = (X1 * C2& - Zo * S2&) \ 1024\r
 201             z1 = (X1 * S2& + Zo * C2&) \ 1024\r
 202 \r
 203             Y2& = (Y1 * C3& - z1 * S3&) \ 1024\r
 204             z2 = (Y1 * S3& + z1 * C3&) \ 1024\r
 205 \r
 206             z2 = z2 + 300\r
 207             Xn(R) = 320 + (X2& / z2 * 500)\r
 208             Yn(R) = 240 + (Y2& / z2 * 500)\r
 209         Next\r
 210      \r
 211 \r
 212         For a1 = 0 To nl - 1\r
 213             F1 = pointers1(a1)\r
 214             S1 = pointers2(a1)\r
 215 \r
 216             Xn = Xn(F1)\r
 217             Yn = Yn(F1)\r
 218 \r
 219             X1 = Xn(S1)\r
 220             Y1 = Yn(S1)\r
 221 \r
 222             Line (Xs1(a1), Ys1(a1))-(Xe1(a1), Ye1(a1)), 0\r
 223             Line (X1, Y1)-(Xn, Yn), 15\r
 224 \r
 225 \r
 226             Xs1(a1) = X1: Ys1(a1) = Y1\r
 227             Xe1(a1) = Xn: Ye1(a1) = Yn\r
 228         Next\r
 229 \r
 230 \r
 231         K$ = InKey$\r
 232         If K$ <> "" Then\r
 233 \r
 234             Select Case K$\r
 235 \r
 236                 Case Chr$(0) + Chr$(72)\r
 237                     d1 = d1 + 1\r
 238 \r
 239                 Case Chr$(0) + Chr$(80)\r
 240                     d1 = d1 - 1\r
 241 \r
 242                 Case Chr$(0) + Chr$(75)\r
 243                     d2 = d2 - 1\r
 244 \r
 245                 Case Chr$(0) + Chr$(77)\r
 246                     d2 = d2 + 1\r
 247 \r
 248                 Case "w"\r
 249                     d3 = d3 - 1\r
 250 \r
 251                 Case "z"\r
 252                     d3 = d3 + 1\r
 253 \r
 254                 Case " "\r
 255                     d1 = d1 / 2\r
 256                     d2 = d2 / 2\r
 257                     d3 = d3 / 2\r
 258 \r
 259                 Case Chr$(27)\r
 260                     System\r
 261 \r
 262             End Select\r
 263         End If\r
 264 \r
 265     Loop\r
 266 End Sub\r
 267 \r