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