fixed file permissions
[qbasicapps.git] / graphics / 3D / 04vann2.bas
1 DECLARE SUB ruut2 (x!, y!, z!, s!)\r
2 DECLARE SUB ruut (x!, y!, z!, s!)\r
3 DECLARE SUB kuus (x, y, z, s)\r
4 DECLARE SUB porand ()\r
5 DECLARE SUB addp (x, y, z)\r
6 ' kursor keys and to z, w - rotate\r
7 ' <SPACE> - speed down\r
8 ' q - quit\r
9 \r
10 DECLARE SUB start ()\r
11 DECLARE SUB addsq (x1%, y1%, z1%)\r
12 DECLARE SUB getcor ()\r
13 DECLARE SUB mulcor ()\r
14 DECLARE SUB nait3d ()\r
15 DECLARE SUB calcsin ()\r
16 DIM SHARED xn(4000), yn(4000), zn(4000)\r
17 DIM SHARED x(4000), y(4000), z(4000)\r
18 \r
19 DIM SHARED xo(4000), yo(4000), zo(4000)\r
20 DIM SHARED point1(4000), point2(4000)\r
21 DIM SHARED col(4000)\r
22 DIM SHARED nump, numl\r
23 DIM SHARED myx, myy, myz, mye, myk\r
24 \r
25 myx = 0\r
26 myy = 0\r
27 myz = -1000\r
28 \r
29 \r
30 \r
31 start\r
32 \r
33 nait3d\r
34 \r
35 SUB addp (x, y, z)\r
36 c = 1\r
37 \r
38 xn(nump + 1) = -100 + x\r
39 yn(nump + 1) = y\r
40 zn(nump + 1) = -100 + z\r
41 \r
42 xn(nump + 2) = 100 + x\r
43 yn(nump + 2) = y\r
44 zn(nump + 2) = -100 + z\r
45 \r
46 xn(nump + 3) = 100 + x\r
47 yn(nump + 3) = y\r
48 zn(nump + 3) = 100 + z\r
49 \r
50 xn(nump + 4) = -100 + x\r
51 yn(nump + 4) = y\r
52 zn(nump + 4) = 100 + z\r
53 \r
54 point1(numl + 1) = nump + 1\r
55 point2(numl + 1) = nump + 2\r
56 col(numl + 1) = c\r
57 \r
58 point1(numl + 2) = nump + 2\r
59 point2(numl + 2) = nump + 3\r
60 col(numl + 2) = c\r
61 \r
62 point1(numl + 3) = nump + 3\r
63 point2(numl + 3) = nump + 4\r
64 col(numl + 3) = c\r
65 \r
66 point1(numl + 4) = nump + 4\r
67 point2(numl + 4) = nump + 1\r
68 col(numl + 4) = c\r
69 \r
70 nump = nump + 4\r
71 numl = numl + 4\r
72 \r
73 END SUB\r
74 \r
75 SUB getcor\r
76 \r
77 xn(nump + 1) = -150\r
78 yn(nump + 1) = -125\r
79 zn(nump + 1) = -200\r
80 \r
81 xn(nump + 2) = 150\r
82 yn(nump + 2) = -125\r
83 zn(nump + 2) = -200\r
84 \r
85 xn(nump + 3) = 150\r
86 yn(nump + 3) = 125\r
87 zn(nump + 3) = -200\r
88 \r
89 xn(nump + 4) = -150\r
90 yn(nump + 4) = 125\r
91 zn(nump + 4) = -200\r
92 \r
93 \r
94 xn(nump + 5) = -150\r
95 yn(nump + 5) = -125\r
96 zn(nump + 5) = 200\r
97 \r
98 xn(nump + 6) = 150\r
99 yn(nump + 6) = -125\r
100 zn(nump + 6) = 200\r
101 \r
102 xn(nump + 7) = 150\r
103 yn(nump + 7) = 125\r
104 zn(nump + 7) = 200\r
105 \r
106 xn(nump + 8) = -150\r
107 yn(nump + 8) = 125\r
108 zn(nump + 8) = 200\r
109 \r
110 \r
111 point1(numl + 1) = nump + 1\r
112 point2(numl + 1) = nump + 2\r
113 \r
114 point1(numl + 2) = nump + 2\r
115 point2(numl + 2) = nump + 3\r
116 \r
117 point1(numl + 3) = nump + 3\r
118 point2(numl + 3) = nump + 4\r
119 \r
120 point1(numl + 4) = nump + 4\r
121 point2(numl + 4) = nump + 1\r
122 \r
123 point1(numl + 5) = nump + 5\r
124 point2(numl + 5) = nump + 6\r
125 \r
126 point1(numl + 6) = nump + 6\r
127 point2(numl + 6) = nump + 7\r
128 \r
129 point1(numl + 7) = nump + 7\r
130 point2(numl + 7) = nump + 8\r
131 \r
132 point1(numl + 8) = nump + 8\r
133 point2(numl + 8) = nump + 5\r
134 \r
135 point1(numl + 9) = nump + 5\r
136 point2(numl + 9) = nump + 1\r
137 \r
138 point1(numl + 10) = nump + 6\r
139 point2(numl + 10) = nump + 2\r
140 \r
141 point1(numl + 11) = nump + 7\r
142 point2(numl + 11) = nump + 3\r
143 \r
144 point1(numl + 12) = nump + 8\r
145 point2(numl + 12) = nump + 4\r
146 \r
147 nump = nump + 8\r
148 numl = numl + 12\r
149 \r
150 \r
151 \r
152 \r
153 xn(nump + 1) = -150\r
154 yn(nump + 1) = -125 + 201\r
155 zn(nump + 1) = 0\r
156 \r
157 xn(nump + 2) = -150\r
158 yn(nump + 2) = -125 + 201\r
159 zn(nump + 2) = 89\r
160 \r
161 xn(nump + 3) = -150\r
162 yn(nump + 3) = -125\r
163 zn(nump + 3) = 89\r
164 \r
165 xn(nump + 4) = -150\r
166 yn(nump + 4) = -125\r
167 zn(nump + 4) = 0\r
168 \r
169 point1(numl + 1) = nump + 1\r
170 point2(numl + 1) = nump + 2\r
171 \r
172 point1(numl + 2) = nump + 2\r
173 point2(numl + 2) = nump + 3\r
174 \r
175 point1(numl + 3) = nump + 3\r
176 point2(numl + 3) = nump + 4\r
177 \r
178 point1(numl + 4) = nump + 4\r
179 point2(numl + 4) = nump + 1\r
180 \r
181 nump = nump + 4\r
182 numl = numl + 4\r
183 \r
184 \r
185 FOR x = -1000 TO 1000 STEP 250\r
186 FOR z = -1000 TO 1000 STEP 250\r
187 'addp x, -200, z\r
188 'addp x, 200, z\r
189 NEXT z\r
190 NEXT x\r
191 porand\r
192 \r
193 END SUB\r
194 \r
195 SUB kuus (x, y, z, s)\r
196 \r
197 b = 0\r
198 f = .3925\r
199 FOR a = 0 + f TO 6 + f STEP 6.28 / 8\r
200 x1 = SIN(a) * s\r
201 y1 = COS(a) * s\r
202 b = b + 1\r
203 \r
204 xn(nump + b) = x1 + x\r
205 yn(nump + b) = y\r
206 zn(nump + b) = y1 + z\r
207 \r
208 NEXT a\r
209 \r
210 point1(numl + 1) = nump + 1\r
211 point2(numl + 1) = nump + 2\r
212 col(numl + 1) = 12\r
213 \r
214 point1(numl + 2) = nump + 2\r
215 point2(numl + 2) = nump + 3\r
216 col(numl + 2) = 12\r
217 \r
218 point1(numl + 3) = nump + 3\r
219 point2(numl + 3) = nump + 4\r
220 col(numl + 3) = 12\r
221 \r
222 point1(numl + 4) = nump + 4\r
223 point2(numl + 4) = nump + 5\r
224 col(numl + 4) = 12\r
225 \r
226 point1(numl + 5) = nump + 5\r
227 point2(numl + 5) = nump + 6\r
228 col(numl + 5) = 12\r
229 \r
230 \r
231 point1(numl + 6) = nump + 6\r
232 point2(numl + 6) = nump + 7\r
233 col(numl + 6) = 12\r
234 \r
235 point1(numl + 7) = nump + 7\r
236 point2(numl + 7) = nump + 8\r
237 col(numl + 7) = 12\r
238 \r
239 point1(numl + 8) = nump + 8\r
240 point2(numl + 8) = nump + 1\r
241 col(numl + 8) = 12\r
242 \r
243 nump = nump + b\r
244 numl = numl + 8\r
245 'LOCATE 1, 1\r
246 'PRINT b\r
247 \r
248 \r
249 \r
250 \r
251 END SUB\r
252 \r
253 SUB nait3d\r
254 \r
255 1\r
256 \r
257 myx = myx + SIN(deg1) * mye\r
258 myz = myz + COS(deg1) * mye\r
259    \r
260 myx = myx + COS(deg1) * myk\r
261 myz = myz - SIN(deg1) * myk\r
262 \r
263 deg1 = deg1 + d1\r
264 Deg2 = Deg2 + d2\r
265   \r
266 C1 = COS(deg1): S1 = SIN(deg1)\r
267 C2 = COS(Deg2): S2 = SIN(Deg2)\r
268  \r
269 FOR a = 1 TO nump\r
270 \r
271 xo = xn(a) - myx\r
272 yo = -yn(a) - myy\r
273 zo = zn(a) - myz\r
274       \r
275 x1 = (xo * C1 - zo * S1)\r
276 z1 = (xo * S1 + zo * C1)\r
277        \r
278 y1 = (yo * C2 - z1 * S2)\r
279 z2 = (yo * S2 + z1 * C2)\r
280        \r
281 \r
282 xo(a) = x(a)\r
283 yo(a) = y(a)\r
284 IF z2 < 20 THEN\r
285 x(a) = -1\r
286 ELSE\r
287 x(a) = 320 + (x1 / z2 * 500)\r
288 y(a) = 240 + (y1 / z2 * 500)\r
289 END IF\r
290 NEXT\r
291      \r
292 \r
293 FOR a = 1 TO numl\r
294 p1 = point1(a)\r
295 p2 = point2(a)\r
296 IF xo(p1) = -1 OR xo(p2) = -1 THEN  ELSE LINE (xo(p1), yo(p1))-(xo(p2), yo(p2)), 0\r
297 IF x(p1) = -1 OR x(p2) = -1 THEN  ELSE LINE (x(p1), y(p1))-(x(p2), y(p2)), col(a)\r
298 NEXT\r
299   \r
300 \r
301 K$ = INKEY$\r
302 IF K$ <> "" THEN\r
303 \r
304 SELECT CASE K$\r
305 \r
306 CASE CHR$(0) + "P"\r
307 mye = mye - 3\r
308 \r
309 CASE CHR$(0) + "H"\r
310 mye = mye + 3\r
311 \r
312 CASE CHR$(0) + "M"\r
313 myk = myk + 3\r
314 \r
315 CASE CHR$(0) + "K"\r
316 myk = myk - 3\r
317 \r
318 CASE "+"\r
319 myy = myy + 3\r
320 \r
321 CASE "-"\r
322 myy = myy - 3\r
323 \r
324 CASE "6"\r
325 d1 = d1 + .01\r
326 \r
327 CASE "4"\r
328 d1 = d1 - .01\r
329 \r
330 CASE "8"\r
331 d2 = d2 - .01\r
332 \r
333 CASE "2"\r
334 d2 = d2 + .01\r
335 \r
336 \r
337 CASE " "\r
338 d1 = d1 / 2\r
339 d2 = d2 / 2\r
340 d3 = d3 / 2\r
341 mye = mye / 2\r
342 myk = myk / 2\r
343 \r
344 CASE "q"\r
345 SYSTEM\r
346 \r
347 CASE CHR$(27)\r
348 SYSTEM\r
349 END SELECT\r
350 END IF\r
351 \r
352 GOTO 1\r
353 END SUB\r
354 \r
355 SUB porand\r
356 \r
357 FOR x = -100 TO 0 STEP 12.067 + .3\r
358 FOR z = -100 TO 0 STEP 12.067 + .3\r
359 kuus x, -125, z, 6.53\r
360 ruut x + 6.033 + .15, -125, z + 6.033 + .15, 3.111 + .3\r
361 NEXT z\r
362 NEXT x\r
363 \r
364 FOR y = -100 TO 0 STEP 20.3\r
365 FOR x = -100 TO 0 STEP 20.3\r
366 ruut2 x, y, 200, 10\r
367 NEXT x\r
368 NEXT y\r
369 \r
370 \r
371 END SUB\r
372 \r
373 SUB ruut (x, y, z, s)\r
374 xn(nump + 1) = x\r
375 yn(nump + 1) = y\r
376 zn(nump + 1) = z + s\r
377 \r
378 xn(nump + 2) = x + s\r
379 yn(nump + 2) = y\r
380 zn(nump + 2) = z\r
381 \r
382 xn(nump + 3) = x\r
383 yn(nump + 3) = y\r
384 zn(nump + 3) = z - s\r
385 \r
386 xn(nump + 4) = x - s\r
387 yn(nump + 4) = y\r
388 zn(nump + 4) = z\r
389 \r
390 point1(numl + 1) = nump + 1\r
391 point2(numl + 1) = nump + 2\r
392 col(numl + 1) = 10\r
393 \r
394 point1(numl + 2) = nump + 2\r
395 point2(numl + 2) = nump + 3\r
396 col(numl + 2) = 10\r
397 \r
398 point1(numl + 3) = nump + 3\r
399 point2(numl + 3) = nump + 4\r
400 col(numl + 3) = 10\r
401 \r
402 point1(numl + 4) = nump + 4\r
403 point2(numl + 4) = nump + 1\r
404 col(numl + 4) = 10\r
405 \r
406 nump = nump + 4\r
407 numl = numl + 4\r
408 END SUB\r
409 \r
410 SUB ruut2 (x, y, z, s)\r
411 xn(nump + 1) = x - s\r
412 yn(nump + 1) = y - s\r
413 zn(nump + 1) = z\r
414 \r
415 xn(nump + 2) = x + s\r
416 yn(nump + 2) = y - s\r
417 zn(nump + 2) = z\r
418 \r
419 xn(nump + 3) = x + s\r
420 yn(nump + 3) = y + s\r
421 zn(nump + 3) = z\r
422 \r
423 xn(nump + 4) = x - s\r
424 yn(nump + 4) = y + s\r
425 zn(nump + 4) = z\r
426 \r
427 point1(numl + 1) = nump + 1\r
428 point2(numl + 1) = nump + 2\r
429 col(numl + 1) = 14\r
430 \r
431 point1(numl + 2) = nump + 2\r
432 point2(numl + 2) = nump + 3\r
433 col(numl + 2) = 14\r
434 \r
435 point1(numl + 3) = nump + 3\r
436 point2(numl + 3) = nump + 4\r
437 col(numl + 3) = 14\r
438 \r
439 point1(numl + 4) = nump + 4\r
440 point2(numl + 4) = nump + 1\r
441 col(numl + 4) = 14\r
442 \r
443 nump = nump + 4\r
444 numl = numl + 4\r
445 \r
446 END SUB\r
447 \r
448 SUB start\r
449 SCREEN 12\r
450 CLS\r
451 \r
452 FOR a = 1 TO 4000\r
453 col(a) = 15\r
454 NEXT a\r
455 \r
456 nump = 0\r
457 numl = 0\r
458 \r
459 \r
460 getcor\r
461 \r
462 END SUB\r
463 \r