initial cammit
[qbasicapps.git] / graphics / 3D / gravi.bas
1 ' 3D gravitation model\r
2 ' made by Svjatoslav Agejenko\r
3 ' in 2003.12\r
4 ' H-Page: svjatoslav.eu\r
5 ' E-Mail: svjatoslavagejenko@gmail.com\r
6  \r
7 DECLARE SUB gravi ()\r
8 DECLARE SUB adda (x!, y!, z!, s!)\r
9 DECLARE SUB display ()\r
10 DIM SHARED atx(1 TO 100)\r
11 DIM SHARED aty(1 TO 100)\r
12 DIM SHARED atz(1 TO 100)\r
13 DIM SHARED atxs(1 TO 100)\r
14 DIM SHARED atys(1 TO 100)\r
15 DIM SHARED atzs(1 TO 100)\r
16 DIM SHARED ats(1 TO 100)\r
17 DIM SHARED mitu\r
18 DIM SHARED myx, myy, myz\r
19 DIM SHARED oax(1 TO 100)\r
20 DIM SHARED oay(1 TO 100)\r
21 DIM SHARED oas(1 TO 100)\r
22 \r
23 \r
24 myx = 0\r
25 myy = 0\r
26 myz = -5\r
27 mitu = 0\r
28 \r
29 SCREEN 13\r
30 \r
31 FOR a = 1 TO 30\r
32 adda RND * 6 - 3, RND * 6 - 3, RND * 4, 50\r
33 NEXT a\r
34 \r
35 1\r
36 display\r
37 gravi\r
38 IF INKEY$ <> "" THEN SYSTEM\r
39 GOTO 1\r
40 \r
41 SUB adda (x, y, z, s)\r
42 \r
43 mitu = mitu + 1\r
44 atx(mitu) = x\r
45 aty(mitu) = y\r
46 atz(mitu) = z\r
47 ats(mitu) = s\r
48 \r
49 atxs(mitu) = 0\r
50 atys(mitu) = 0\r
51 atzs(mitu) = 0\r
52 \r
53 END SUB\r
54 \r
55 SUB display\r
56 \r
57 FOR a = 1 TO mitu\r
58 x = atx(a) - myx\r
59 y = aty(a) - myy\r
60 z = atz(a) - myz\r
61 \r
62 x1 = x / z * 100 + 160\r
63 y1 = y / z * 100 + 100\r
64 \r
65 CIRCLE (oax(a), oay(a)), oas(a), 0\r
66 CIRCLE (x1, y1), ats(a) / z, 15\r
67 oax(a) = x1\r
68 oay(a) = y1\r
69 oas(a) = ats(a) / z\r
70 \r
71 NEXT a\r
72 \r
73 \r
74 END SUB\r
75 \r
76 SUB gravi\r
77 FOR a = 1 TO mitu\r
78 x = atx(a)\r
79 y = aty(a)\r
80 z = atz(a)\r
81 pxs = 0\r
82 pys = 0\r
83 pzs = 0\r
84 \r
85 \r
86 FOR b = 1 TO mitu\r
87 IF b = a THEN GOTO 2\r
88 v = SQR((atx(b) - x) ^ 2 + (aty(b) - y) ^ 2 + (atz(b) - z) ^ 2)\r
89 v2 = 1 / (v - 1)\r
90 \r
91 pxs = pxs + (atx(b) - x) / v2 / 10000\r
92 pys = pys + (aty(b) - y) / v2 / 10000\r
93 pzs = pzs + (atz(b) - z) / v2 / 10000\r
94 \r
95 2\r
96 NEXT b\r
97 \r
98 atxs(a) = atxs(a) / 1.01 + pxs\r
99 atys(a) = atys(a) / 1.01 + pys\r
100 atzs(a) = atzs(a) / 1.01 + pzs\r
101 NEXT a\r
102 \r
103 FOR a = 1 TO mitu\r
104 \r
105 atx(a) = atx(a) + atxs(a)\r
106 aty(a) = aty(a) + atys(a)\r
107 atz(a) = atz(a) + atzs(a)\r
108 NEXT a\r
109 \r
110 \r
111 \r
112 END SUB\r
113 \r