Fixed broken links.
[qbasicapps.git] / graphics / 3D / 3ds2.bas
1 ' Svjatoslav Agejenko\r
2 ' year 2001\r
3 \r
4 ' arrow keys - move around\r
5 ' 2, 6, 4, 8 - look around\r
6 ' -          - fly up\r
7 ' +          - fly down\r
8 \r
9 \r
10 \r
11 DECLARE SUB mkkoll ()\r
12 DECLARE SUB putkol ()\r
13 DECLARE SUB rend ()\r
14 DECLARE SUB env ()\r
15 DECLARE SUB start ()\r
16 DIM SHARED npo, nlo, np, nl\r
17 DIM SHARED px(1 TO 1000)\r
18 DIM SHARED py(1 TO 1000)\r
19 DIM SHARED pz(1 TO 1000)\r
20 DIM SHARED rpx(1 TO 1000)\r
21 DIM SHARED rpy(1 TO 1000)\r
22 DIM SHARED orpx(1 TO 1000)\r
23 DIM SHARED orpy(1 TO 1000)\r
24 DIM SHARED onp\r
25 DIM SHARED lin1(1 TO 1000)\r
26 DIM SHARED lin2(1 TO 1000)\r
27 DIM SHARED linc(1 TO 1000)\r
28 DIM SHARED olin1(1 TO 1000)\r
29 DIM SHARED olin2(1 TO 1000)\r
30 DIM SHARED onl\r
31 DIM SHARED myx, myy, myz\r
32 DIM SHARED myxs, myys, myzs\r
33 DIM SHARED an1, an2\r
34 DIM SHARED an1s, an2s\r
35 DIM SHARED kolx(1 TO 10)\r
36 DIM SHARED koly(1 TO 10)\r
37 DIM SHARED kolz(1 TO 10)\r
38 DIM SHARED kolxs(1 TO 10)\r
39 DIM SHARED kolys(1 TO 10)\r
40 DIM SHARED kolzs(1 TO 10)\r
41 DIM SHARED kolm\r
42 \r
43 ON ERROR GOTO 2\r
44 \r
45 start\r
46 env\r
47 putkol\r
48 \r
49 1\r
50 np = npo\r
51 nl = nlo\r
52 \r
53 mkkoll\r
54 rend\r
55 \r
56 myx = myx + myxs\r
57 myy = myy + myys\r
58 myz = myz + myzs\r
59 an1 = an1 + an1s\r
60 an2 = an2 + an2s\r
61 \r
62 a$ = INKEY$\r
63 IF a$ <> "" THEN\r
64 IF a$ = CHR$(0) + "H" THEN\r
65 myzs = myzs - SIN(an1) / 100\r
66 myxs = myxs - COS(an1) / 100\r
67 END IF\r
68 IF a$ = CHR$(0) + "P" THEN\r
69 myzs = myzs + SIN(an1) / 100\r
70 myxs = myxs + COS(an1) / 100\r
71 END IF\r
72 IF a$ = CHR$(0) + "M" THEN\r
73 myzs = myzs + COS(an1) / 100\r
74 myxs = myxs - SIN(an1) / 100\r
75 END IF\r
76 IF a$ = CHR$(0) + "K" THEN\r
77 myzs = myzs - COS(an1) / 100\r
78 myxs = myxs + SIN(an1) / 100\r
79 END IF\r
80 \r
81 IF a$ = "6" THEN an1s = an1s - .01\r
82 IF a$ = "4" THEN an1s = an1s + .01\r
83 IF a$ = "8" THEN an2s = an2s - .01\r
84 IF a$ = "2" THEN an2s = an2s + .01\r
85 IF a$ = "+" THEN myys = myys - .01\r
86 IF a$ = "-" THEN myys = myys + .01\r
87 IF a$ = CHR$(27) THEN SYSTEM\r
88 END IF\r
89 GOTO 1\r
90 \r
91 2\r
92 END\r
93 RESUME\r
94 \r
95 SUB env\r
96 \r
97 FOR z = -5 TO 5\r
98 FOR x = -5 TO 5\r
99 np = np + 1\r
100 px(np) = x\r
101 py(np) = 0\r
102 pz(np) = z\r
103 IF x > -5 THEN\r
104 nl = nl + 1\r
105 lin1(nl) = np\r
106 lin2(nl) = np - 1\r
107 linc(nl) = 3\r
108 END IF\r
109 IF z > -5 THEN\r
110 nl = nl + 1\r
111 lin1(nl) = np\r
112 lin2(nl) = np - 11\r
113 linc(nl) = 3\r
114 END IF\r
115 NEXT x\r
116 NEXT z\r
117 \r
118 npo = np\r
119 nlo = nl\r
120 \r
121 \r
122 END SUB\r
123 \r
124 SUB env1\r
125 \r
126 np = 1\r
127 px(np) = -2\r
128 py(np) = 0\r
129 pz(np) = 0\r
130 np = np + 1\r
131 px(np) = 2\r
132 py(np) = 0\r
133 pz(np) = 0\r
134 \r
135 nl = 1\r
136 lin1(nl) = 1\r
137 lin2(nl) = 2\r
138 linc(nl) = 14\r
139 \r
140 END SUB\r
141 \r
142 SUB mkkoll\r
143 \r
144 FOR a = 1 TO kolm\r
145 x = kolx(a)\r
146 y = koly(a)\r
147 z = kolz(a)\r
148 xs = kolxs(a)\r
149 ys = kolys(a)\r
150 zs = kolzs(a)\r
151 \r
152 ys = ys - .01\r
153 x = x + xs\r
154 y = y + ys\r
155 z = z + zs\r
156 \r
157 IF x > 5 THEN xs = -.1\r
158 IF z > 5 THEN zs = -.1\r
159 IF x < -5 THEN xs = .1\r
160 IF z < -5 THEN zs = .1\r
161 IF y < .5 THEN ys = RND * .2 + .1\r
162 \r
163 nl = nl + 1\r
164 lin1(nl) = np + 1\r
165 lin2(nl) = np + 2\r
166 linc(nl) = 14\r
167 \r
168 nl = nl + 1\r
169 lin1(nl) = np + 3\r
170 lin2(nl) = np + 2\r
171 linc(nl) = 14\r
172 \r
173 nl = nl + 1\r
174 lin1(nl) = np + 3\r
175 lin2(nl) = np + 4\r
176 linc(nl) = 14\r
177 \r
178 nl = nl + 1\r
179 lin1(nl) = np + 1\r
180 lin2(nl) = np + 4\r
181 linc(nl) = 14\r
182 \r
183 \r
184 nl = nl + 1\r
185 lin1(nl) = np + 1\r
186 lin2(nl) = np + 5\r
187 linc(nl) = 14\r
188 \r
189 nl = nl + 1\r
190 lin1(nl) = np + 2\r
191 lin2(nl) = np + 6\r
192 linc(nl) = 14\r
193 \r
194 nl = nl + 1\r
195 lin1(nl) = np + 3\r
196 lin2(nl) = np + 7\r
197 linc(nl) = 14\r
198 \r
199 nl = nl + 1\r
200 lin1(nl) = np + 4\r
201 lin2(nl) = np + 8\r
202 linc(nl) = 14\r
203 \r
204 \r
205 \r
206 nl = nl + 1\r
207 lin1(nl) = np + 5\r
208 lin2(nl) = np + 6\r
209 linc(nl) = 14\r
210 \r
211 nl = nl + 1\r
212 lin1(nl) = np + 7\r
213 lin2(nl) = np + 6\r
214 linc(nl) = 14\r
215 \r
216 nl = nl + 1\r
217 lin1(nl) = np + 7\r
218 lin2(nl) = np + 8\r
219 linc(nl) = 14\r
220 \r
221 nl = nl + 1\r
222 lin1(nl) = np + 5\r
223 lin2(nl) = np + 8\r
224 linc(nl) = 14\r
225 \r
226 \r
227 \r
228 \r
229 np = np + 1\r
230 px(np) = x - .5\r
231 py(np) = y - .5\r
232 pz(np) = z - .5\r
233 \r
234 np = np + 1\r
235 px(np) = x + .5\r
236 py(np) = y - .5\r
237 pz(np) = z - .5\r
238 \r
239 np = np + 1\r
240 px(np) = x + .5\r
241 py(np) = y + .5\r
242 pz(np) = z - .5\r
243 \r
244 np = np + 1\r
245 px(np) = x - .5\r
246 py(np) = y + .5\r
247 pz(np) = z - .5\r
248 \r
249 np = np + 1\r
250 px(np) = x - .5\r
251 py(np) = y - .5\r
252 pz(np) = z + .5\r
253 \r
254 np = np + 1\r
255 px(np) = x + .5\r
256 py(np) = y - .5\r
257 pz(np) = z + .5\r
258 \r
259 np = np + 1\r
260 px(np) = x + .5\r
261 py(np) = y + .5\r
262 pz(np) = z + .5\r
263 \r
264 np = np + 1\r
265 px(np) = x - .5\r
266 py(np) = y + .5\r
267 pz(np) = z + .5\r
268 \r
269 \r
270 \r
271 \r
272 kolx(a) = x\r
273 koly(a) = y\r
274 kolz(a) = z\r
275 kolxs(a) = xs\r
276 kolys(a) = ys\r
277 kolzs(a) = zs\r
278 NEXT a\r
279 \r
280 END SUB\r
281 \r
282 SUB putkol\r
283 FOR a = 1 TO kolm\r
284 kolx(a) = RND * 10 - 5\r
285 koly(a) = 2\r
286 kolz(a) = RND * 10 - 5\r
287 kolxs(a) = RND * .5 - .25\r
288 kolys(a) = RND * .5 + .1\r
289 kolzs(a) = RND * .5 - .25\r
290 NEXT a\r
291 END SUB\r
292 \r
293 SUB rend\r
294 'C3& = Cosine&(Deg3): S3& = Sine&(Deg3)\r
295 \r
296 \r
297 s1 = SIN(an1)\r
298 c1 = COS(an1)\r
299 s2 = SIN(an2)\r
300 c2 = COS(an2)\r
301 \r
302 FOR a = 1 TO np\r
303 x = px(a) + myx\r
304 y = py(a) - myy\r
305 z = pz(a) + myz\r
306       \r
307 x1 = x * s1 - z * c1\r
308 z1 = x * c1 + z * s1\r
309 y1 = y * s2 - z1 * c2\r
310 z2 = y * c2 + z1 * s2\r
311     \r
312 IF z2 < .1 THEN\r
313 rpx(a) = -1\r
314 ELSE\r
315 rpx(a) = 320 + (x1 / z2 * 400)\r
316 rpy(a) = 240 - (y1 / z2 * 400)\r
317 END IF\r
318 NEXT a\r
319     \r
320 \r
321 FOR a = 1 TO nl\r
322 l1 = olin1(a)\r
323 l2 = olin2(a)\r
324 IF orpx(l1) = -1 OR orpx(l2) = -1 THEN  ELSE LINE (orpx(l1), orpy(l1))-(orpx(l2), orpy(l2)), 0\r
325 l1 = lin1(a)\r
326 l2 = lin2(a)\r
327 IF rpx(l1) = -1 OR rpx(l2) = -1 THEN  ELSE LINE (rpx(l1), rpy(l1))-(rpx(l2), rpy(l2)), linc(a)\r
328 NEXT\r
329 \r
330 IF nl < onl THEN\r
331 FOR a = nl + 1 TO onl\r
332 l1 = olin1(a)\r
333 l2 = olin2(a)\r
334 IF orpx(l1) = -1 OR orpx(l2) = -1 THEN  ELSE LINE (orpx(l1), orpy(l1))-(orpx(l2), orpy(l2)), 0\r
335 NEXT\r
336 END IF\r
337 \r
338 FOR a = 1 TO np\r
339 orpx(a) = rpx(a)\r
340 orpy(a) = rpy(a)\r
341 NEXT a\r
342 onp = np\r
343 \r
344 FOR a = 1 TO nl\r
345 olin1(a) = lin1(a)\r
346 olin2(a) = lin2(a)\r
347 NEXT a\r
348 onl = nl\r
349 \r
350 END SUB\r
351 \r
352 SUB start\r
353 SCREEN 12\r
354 npo = 0\r
355 nlo = 0\r
356 np = npo\r
357 nl = nlo\r
358 kolm = 9\r
359 \r
360 myx = 0\r
361 myy = 4\r
362 myz = 7\r
363 an1 = 3.14 / 2\r
364 an2 = an1 + .6\r
365 \r
366 FOR a = 1 TO 1000\r
367 linc(a) = 4\r
368 NEXT a\r
369 \r
370 FOR a = 1 TO 1000\r
371 olin1(a) = 1\r
372 olin2(a) = 1\r
373 NEXT a\r
374 \r
375 \r
376 \r
377 END SUB\r
378 \r