math/3D graph/3dgraph.bas

   1 CHDIR ".\qbasicapps\math\3D graph\"\r
   2 \r
   3 \r
   4 ' 3D formula explorer\r
   5 ' made by Svjatoslav Agejenko\r
   6 ' in 2002\r
   7 ' homepage: svjatoslav.eu\r
   8 ' email:        svjatoslav@svjatoslav.eu\r
   9  \r
  10 ' use:\r
  11 ' cursor keys - move around\r
  12 ' -           - fly up\r
  13 ' +           - fly down\r
  14 ' ESC         - exit program\r
  15 \r
  16 ' Type your formula to sub module "valem".\r
  17 ' X & Y are surface coordinates. Z must be formula\r
  18 ' result, indicating height. "tm" variable counts\r
  19 ' frames. Use it in your formula to make graph moving in time.\r
  20 \r
  21 \r
  22 DECLARE SUB valem (x!, y!, z!)\r
  23 DECLARE SUB graaf ()\r
  24 DECLARE SUB mkgr3 (x1!, y1!, z1!)\r
  25 DECLARE SUB mkgr2 (x1!, y1!, z1!)\r
  26 DECLARE SUB mkgr (x1!, y1!, z1!)\r
  27 DECLARE SUB ruut2 (x!, y!, z!, s!)\r
  28 DECLARE SUB ruut (x!, y!, z!, s!)\r
  29 DECLARE SUB kuus (x, y, z, s)\r
  30 DECLARE SUB porand ()\r
  31 DECLARE SUB addp (x, y, z)\r
  32 DECLARE SUB start ()\r
  33 DECLARE SUB addsq (x1%, y1%, z1%)\r
  34 DECLARE SUB getcor ()\r
  35 DECLARE SUB mulcor ()\r
  36 DECLARE SUB nait3d ()\r
  37 DECLARE SUB calcsin ()\r
  38 DIM SHARED xn(4000), yn(4000), zn(4000)\r
  39 DIM SHARED x(4000), y(4000), z(4000)\r
  40 \r
  41 DIM SHARED xo(4000), yo(4000), zo(4000)\r
  42 DIM SHARED point1(4000), point2(4000)\r
  43 DIM SHARED col(4000)\r
  44 DIM SHARED nump, numl\r
  45 DIM SHARED tmnump, tmnuml, tm\r
  46 DIM SHARED myx, myy, myz, mye, myk\r
  47 \r
  48 myx = 520\r
  49 myy = -250\r
  50 myz = -1000\r
  51 tm = 0\r
  52 \r
  53 ON ERROR GOTO 3\r
  54 start\r
  55 \r
  56 nait3d\r
  57 \r
  58 3\r
  59 PRINT "Kuskil programmis l�ks mingi arv �le lubatud piiride!!!"\r
  60 RESUME\r
  61 \r
  62 SUB getcor\r
  63 c = 12\r
  64 \r
  65 mkgr -500, 0, 0\r
  66 mkgr2 0, 0, 500\r
  67 mkgr3 0, -500, 0\r
  68 \r
  69 xn(nump + 1) = 0\r
  70 yn(nump + 1) = -500\r
  71 zn(nump + 1) = 0\r
  72 \r
  73 xn(nump + 2) = 0\r
  74 yn(nump + 2) = 500\r
  75 zn(nump + 2) = 0\r
  76 \r
  77 xn(nump + 3) = -500\r
  78 yn(nump + 3) = 0\r
  79 zn(nump + 3) = 0\r
  80 \r
  81 xn(nump + 4) = 500\r
  82 yn(nump + 4) = 0\r
  83 zn(nump + 4) = 0\r
  84 \r
  85 xn(nump + 5) = 0\r
  86 yn(nump + 5) = 0\r
  87 zn(nump + 5) = -500\r
  88 \r
  89 xn(nump + 6) = 0\r
  90 yn(nump + 6) = 0\r
  91 zn(nump + 6) = 500\r
  92 \r
  93 point1(numl + 1) = nump + 1\r
  94 point2(numl + 1) = nump + 2\r
  95 col(numl + 1) = c\r
  96 \r
  97 point1(numl + 2) = nump + 3\r
  98 point2(numl + 2) = nump + 4\r
  99 col(numl + 2) = c\r
 100 \r
 101 point1(numl + 3) = nump + 5\r
 102 point2(numl + 3) = nump + 6\r
 103 col(numl + 3) = c\r
 104 \r
 105 nump = nump + 6\r
 106 numl = numl + 3\r
 107 tmnump = nump\r
 108 tmnuml = numl\r
 109 END SUB\r
 110 \r
 111 SUB graaf\r
 112 \r
 113 c = 14\r
 114 \r
 115 d = 0\r
 116 e = 0\r
 117 FOR x = -500 TO 500 STEP 50\r
 118     FOR z = -500 TO 500 STEP 50\r
 119 \r
 120         d = d + 1\r
 121         xn(nump + d) = x\r
 122         valem x / 50, z / 50, y\r
 123         yn(nump + d) = y * 50\r
 124         zn(nump + d) = z\r
 125         IF z > -500 THEN\r
 126             e = e + 1\r
 127             point1(numl + e) = nump + d\r
 128             point2(numl + e) = nump + d - 1\r
 129             col(numl + e) = c\r
 130         END IF\r
 131 \r
 132         IF x > -500 THEN\r
 133             e = e + 1\r
 134             point1(numl + e) = nump + d\r
 135             point2(numl + e) = nump + d - 21\r
 136             col(numl + e) = c\r
 137         END IF\r
 138 \r
 139     NEXT z\r
 140 NEXT x\r
 141 nump = nump + d\r
 142 numl = numl + e\r
 143 \r
 144 END SUB\r
 145 \r
 146 SUB mkgr (x1, y1, z1)\r
 147 c = 3\r
 148 \r
 149 d = 0\r
 150 e = 0\r
 151 FOR z = -500 TO 500 STEP 100\r
 152     FOR y = -500 TO 500 STEP 100\r
 153 \r
 154         d = d + 1\r
 155         xn(nump + d) = x1\r
 156         yn(nump + d) = y1 + y\r
 157         zn(nump + d) = z1 + z\r
 158         IF y > -500 THEN\r
 159             e = e + 1\r
 160             point1(numl + e) = nump + d\r
 161             point2(numl + e) = nump + d - 1\r
 162             col(numl + e) = c\r
 163         END IF\r
 164 \r
 165         IF z > -500 THEN\r
 166             e = e + 1\r
 167             point1(numl + e) = nump + d\r
 168             point2(numl + e) = nump + d - 11\r
 169             col(numl + e) = c\r
 170         END IF\r
 171 \r
 172     NEXT y\r
 173 NEXT z\r
 174 nump = nump + d\r
 175 numl = numl + e\r
 176 \r
 177 END SUB\r
 178 \r
 179 SUB mkgr2 (x1, y1, z1)\r
 180 \r
 181 c = 3\r
 182 \r
 183 d = 0\r
 184 e = 0\r
 185 FOR x = -500 TO 500 STEP 100\r
 186     FOR y = -500 TO 500 STEP 100\r
 187 \r
 188         d = d + 1\r
 189         xn(nump + d) = x1 + x\r
 190         yn(nump + d) = y1 + y\r
 191         zn(nump + d) = z1\r
 192         IF y > -500 THEN\r
 193             e = e + 1\r
 194             point1(numl + e) = nump + d\r
 195             point2(numl + e) = nump + d - 1\r
 196             col(numl + e) = c\r
 197         END IF\r
 198 \r
 199         IF x > -500 THEN\r
 200             e = e + 1\r
 201             point1(numl + e) = nump + d\r
 202             point2(numl + e) = nump + d - 11\r
 203             col(numl + e) = c\r
 204         END IF\r
 205 \r
 206     NEXT y\r
 207 NEXT x\r
 208 nump = nump + d\r
 209 numl = numl + e\r
 210 \r
 211 \r
 212 END SUB\r
 213 \r
 214 SUB mkgr3 (x1, y1, z1)\r
 215 \r
 216 c = 3\r
 217 \r
 218 d = 0\r
 219 e = 0\r
 220 FOR x = -500 TO 500 STEP 100\r
 221     FOR z = -500 TO 500 STEP 100\r
 222 \r
 223         d = d + 1\r
 224         xn(nump + d) = x1 + x\r
 225         yn(nump + d) = y1 + y\r
 226         zn(nump + d) = z\r
 227         IF z > -500 THEN\r
 228             e = e + 1\r
 229             point1(numl + e) = nump + d\r
 230             point2(numl + e) = nump + d - 1\r
 231             col(numl + e) = c\r
 232         END IF\r
 233 \r
 234         IF x > -500 THEN\r
 235             e = e + 1\r
 236             point1(numl + e) = nump + d\r
 237             point2(numl + e) = nump + d - 11\r
 238             col(numl + e) = c\r
 239         END IF\r
 240 \r
 241     NEXT z\r
 242 NEXT x\r
 243 nump = nump + d\r
 244 numl = numl + e\r
 245 \r
 246 \r
 247 \r
 248 END SUB\r
 249 \r
 250 SUB nait3d\r
 251 \r
 252 1\r
 253 nump = tmnump\r
 254 numl = tmnuml\r
 255 tm = tm + 1\r
 256 graaf\r
 257 \r
 258 \r
 259 myx = myx + SIN(deg1) * mye\r
 260 myz = myz + COS(deg1) * mye\r
 261    \r
 262 myx = myx + COS(deg1) * myk\r
 263 myz = myz - SIN(deg1) * myk\r
 264 \r
 265 myy = myy + myyp\r
 266 \r
 267 deg1 = deg1 + d1\r
 268 Deg2 = Deg2 + d2\r
 269   \r
 270 C1 = COS(deg1): S1 = SIN(deg1)\r
 271 C2 = COS(Deg2): S2 = SIN(Deg2)\r
 272  \r
 273 FOR a = 1 TO nump\r
 274 \r
 275     xo = xn(a) - myx\r
 276     yo = -yn(a) - myy\r
 277     zo = zn(a) - myz\r
 278       \r
 279     x1 = (xo * C1 - zo * S1)\r
 280     z1 = (xo * S1 + zo * C1)\r
 281        \r
 282     y1 = (yo * C2 - z1 * S2)\r
 283     z2 = (yo * S2 + z1 * C2)\r
 284        \r
 285 \r
 286     xo(a) = x(a)\r
 287     yo(a) = y(a)\r
 288     IF z2 < 20 THEN\r
 289         x(a) = -1\r
 290     ELSE\r
 291         x(a) = 320 + (x1 / z2 * 500)\r
 292         y(a) = 240 + (y1 / z2 * 500)\r
 293     END IF\r
 294 NEXT\r
 295      \r
 296 \r
 297 FOR a = 1 TO numl\r
 298     p1 = point1(a)\r
 299     p2 = point2(a)\r
 300     IF xo(p1) = -1 OR xo(p2) = -1 THEN ELSE LINE (xo(p1), yo(p1))-(xo(p2), yo(p2)), 0\r
 301 \r
 302     IF x(p1) = -1 OR x(p2) = -1 THEN ELSE LINE (x(p1), y(p1))-(x(p2), y(p2)), col(a)\r
 303 NEXT\r
 304   \r
 305 \r
 306 K$ = INKEY$\r
 307 IF K$ <> "" THEN\r
 308 \r
 309     SELECT CASE K$\r
 310 \r
 311         CASE CHR$(0) + "P"\r
 312             mye = mye - 3\r
 313 \r
 314         CASE CHR$(0) + "H"\r
 315             mye = mye + 3\r
 316 \r
 317         CASE CHR$(0) + "M"\r
 318             myk = myk + 3\r
 319 \r
 320         CASE CHR$(0) + "K"\r
 321             myk = myk - 3\r
 322 \r
 323         CASE "+"\r
 324             myyp = myyp + 5\r
 325 \r
 326         CASE "-"\r
 327             myyp = myyp - 5\r
 328 \r
 329         CASE "6"\r
 330             d1 = d1 + .01\r
 331 \r
 332         CASE "4"\r
 333             d1 = d1 - .01\r
 334 \r
 335         CASE "8"\r
 336             d2 = d2 - .01\r
 337 \r
 338         CASE "2"\r
 339             d2 = d2 + .01\r
 340 \r
 341 \r
 342         CASE " "\r
 343             d1 = d1 / 2\r
 344             d2 = d2 / 2\r
 345             d3 = d3 / 2\r
 346             mye = mye / 2\r
 347             myk = myk / 2\r
 348             myyp = myyp / 2\r
 349         CASE "q"\r
 350             SYSTEM\r
 351 \r
 352         CASE CHR$(27)\r
 353             SYSTEM\r
 354 \r
 355     END SELECT\r
 356 END IF\r
 357 \r
 358 _LIMIT (30)\r
 359 \r
 360 GOTO 1\r
 361 END SUB\r
 362 \r
 363 SUB start\r
 364 SCREEN 12\r
 365 CLS\r
 366 \r
 367 FOR a = 1 TO 4000\r
 368     col(a) = 15\r
 369 NEXT a\r
 370 \r
 371 nump = 0\r
 372 numl = 0\r
 373 \r
 374 \r
 375 getcor\r
 376 \r
 377 END SUB\r
 378 \r
 379 SUB valem (x, y, z)\r
 380 z = 0\r
 381 v = SQR(x * x + y * y) ' v = distance from center, some formulas needs it.\r
 382 \r
 383 z = z + SIN(x + y) * SIN(tm / 10) ' diagonal lines\r
 384 z = z + (SQR((15 + v) * (15 - v)) - 10) ' top of the ball\r
 385 ' here I mixed 2 formulas.\r
 386 \r
 387 'z = z + RND * 1                                ' noise\r
 388 'z = z + SIN((y + tm) / 2)                      ' forward moving wave\r
 389 'z = z + SIN(v / 2) * 2                         ' circular waves\r
 390 'z = z - SQR(v * 6)                             ' sharp\r
 391 \r
 392 'z = z + SIN(y / 1.5) / 1.5 + COS(x / 1.5) / 1.5' custom 1\r
 393 'z = z + SIN(y / 1.5) * COS(x / 1.5) / 1.5      ' custom 2\r
 394 'z = z + INT(SIN(1.5 * x * SIN(tm / 10))) * 3   ' custom 3\r
 395 'z = z - INT(v / 5) * 3 + 3                     ' custom 4\r
 396 'z = z + 3 * ((-INT((x - .3) / 20) * INT((23 + x - ABS(y * 1.2)) / 15)) + -INT(-y / 20) * -INT(-x / 20) * INT(-((x - 2) * (x - 2) + (y * 1.2 - 4) * (y * 1.2 - 4)) / 2000 + 1.01) + -INT(y / 20) * -INT(-x / 20) * INT(-((x - 2) * (x - 2) + (y * 1.2 + 4) * (y * 1.2 + 4)) / 2000 + 1.01)) ' heart\r
 397 \r
 398 \r
 399 END SUB\r
 400 \r