Fixed broken links.
[qbasicapps.git] / graphics / 3D / !.bas
1 ' Svjatoslav Agejenko\r
2 ' Use keys:\r
3 ' Up, Down, Left, Right, w, z - rotate\r
4 ' <space> - speed down\r
5 ' q - quit\r
6 \r
7 DECLARE SUB getcor ()\r
8 DECLARE SUB mulcor ()\r
9 DECLARE SUB nait3d ()\r
10 DECLARE SUB calcsin ()\r
11 DEFINT A-Z\r
12 DIM SHARED Xn(100), Yn(100), Zn(100)\r
13 DIM SHARED Xs1(100), Ys1(100), Xe1(100), Ye1(100)\r
14 DIM SHARED x(100), y(100), z(100), pointers1(100), pointers2(100)\r
15 DIM SHARED Cosine&(360), Sine&(360)\r
16 DIM SHARED np, nl\r
17 DIM SHARED jrp, jrl\r
18 jrp = 0\r
19 jrl = 0\r
20 \r
21 \r
22 SCREEN 12\r
23 CLS\r
24 \r
25 \r
26 calcsin\r
27 getcor\r
28 mulcor\r
29 nait3d\r
30 \r
31 \r
32 \r
33 \r
34 DATA 5, -60,  -10\r
35 DATA 15,-50,  -10\r
36 DATA 15,  0,  -10\r
37 DATA 5,  10,  -10\r
38 DATA -5,  10,  -10\r
39 DATA -15, 0,  -10\r
40 DATA -15,-50,  -10\r
41 DATA -5,  -60,  -10\r
42 \r
43 DATA 5, -60,  10\r
44 DATA 15,-50,  10\r
45 DATA 15,  0,  10\r
46 DATA 5,  10,  10\r
47 DATA -5,  10,  10\r
48 DATA -15, 0,  10\r
49 DATA -15,-50,  10\r
50 DATA -5,  -60,  10\r
51 \r
52 DATA 5, 20,  10\r
53 DATA 15, 30,  10\r
54 DATA 15, 40,  10\r
55 DATA 5, 50,  10\r
56 DATA -5, 50,  10\r
57 DATA -15, 40,  10\r
58 DATA -15, 30,  10\r
59 DATA -5, 20,  10\r
60 \r
61 DATA 5, 20,  -10\r
62 DATA 15, 30, -10\r
63 DATA 15, 40,  -10\r
64 DATA 5, 50,  -10\r
65 DATA -5, 50, -10\r
66 DATA -15, 40,  -10\r
67 DATA -15, 30, -10\r
68 DATA -5, 20,  -10\r
69 \r
70 DATA 999,999,999\r
71 \r
72 DATA 0,1\r
73 DATA 1,2\r
74 DATA 2,3\r
75 DATA 3,4\r
76 DATA 4,5\r
77 DATA 5,6\r
78 DATA 6,7\r
79 DATA 7,0\r
80 \r
81 DATA 8,9\r
82 DATA 9,10\r
83 DATA 10,11\r
84 DATA 11,12\r
85 DATA 12,13\r
86 DATA 13,14\r
87 DATA 14,15\r
88 DATA 15,8\r
89 \r
90 \r
91 DATA 0,8\r
92 DATA 1,9\r
93 DATA 2,10\r
94 DATA 3,11\r
95 DATA 4,12\r
96 DATA 5,13\r
97 DATA 6,14\r
98 DATA 7,15\r
99 \r
100 DATA 16,17\r
101 DATA 17,18\r
102 DATA 18,19\r
103 DATA 19,20\r
104 DATA 20,21\r
105 DATA 21,22\r
106 DATA 22,23\r
107 DATA 23,16\r
108 \r
109 \r
110 DATA 24,25\r
111 DATA 25,26\r
112 DATA 26,27\r
113 DATA 27,28\r
114 DATA 28,29\r
115 DATA 29,30\r
116 DATA 30,31\r
117 DATA 31,24\r
118 \r
119 DATA 24,16\r
120 DATA 25,17\r
121 DATA 26,18\r
122 DATA 27,19\r
123 DATA 28,20\r
124 DATA 29,21\r
125 DATA 30,22\r
126 DATA 31,23\r
127 \r
128 DATA 999, 999\r
129 \r
130 SUB calcsin\r
131 FOR a! = 0 TO 359 / 57.29577951# STEP 1 / 57.29577951#\r
132     Cosine&(a) = INT(.5 + COS(a!) * 1024)\r
133     Sine&(a) = INT(.5 + SIN(a!) * 1024)\r
134     a = a + 1\r
135 NEXT\r
136 END SUB\r
137 \r
138 SUB getcor\r
139 FOR a = 0 TO 10000\r
140     READ x(a), y(a), z(a)\r
141     IF x(a) = 999 THEN x(a) = 0: y(a) = 0: z(a) = 0: GOTO 1\r
142 NEXT\r
143 1\r
144 np = a\r
145 \r
146 FOR a = 0 TO 10000\r
147     READ pointers1(a), pointers2(a)\r
148     IF pointers1(a) = 999 THEN GOTO 2\r
149 NEXT\r
150 2\r
151 nl = a\r
152 \r
153 END SUB\r
154 \r
155 SUB mulcor\r
156 suur = 0\r
157 FOR a = 0 TO np\r
158 IF ABS(x(a)) > suur THEN suur = ABS(x(a))\r
159 IF ABS(y(a)) > suur THEN suur = ABS(y(a))\r
160 IF ABS(z(a)) > suur THEN suur = ABS(z(a))\r
161 NEXT a\r
162 ksuur = 100 / suur\r
163 \r
164 FOR a = 0 TO np\r
165 x(a) = x(a) * ksuur\r
166 y(a) = y(a) * ksuur\r
167 z(a) = z(a) * ksuur\r
168 NEXT a\r
169 END SUB\r
170 \r
171 SUB nait3d\r
172 \r
173 DO\r
174 \r
175     Deg1 = Deg1 + d1\r
176     Deg2 = Deg2 + d2\r
177     Deg3 = Deg3 + d3\r
178    \r
179     IF Deg1 <= 0 THEN Deg1 = Deg1 + 360\r
180     IF Deg2 <= 0 THEN Deg2 = Deg2 + 360\r
181     IF Deg3 <= 0 THEN Deg3 = Deg3 + 360\r
182   \r
183     IF Deg1 >= 360 THEN Deg1 = Deg1 - 360\r
184     IF Deg2 >= 360 THEN Deg2 = Deg2 - 360\r
185     IF Deg3 >= 360 THEN Deg3 = Deg3 - 360\r
186   \r
187     C1& = Cosine&(Deg1): S1& = Sine&(Deg1)\r
188     C2& = Cosine&(Deg2): S2& = Sine&(Deg2)\r
189     C3& = Cosine&(Deg3): S3& = Sine&(Deg3)\r
190  \r
191 FOR a = 0 TO np - 1\r
192 R = a\r
193 Xo = x(R): Yo = y(R): Zo = z(R)\r
194        \r
195 X1 = (Xo * C1& - Yo * S1&) \ 1024\r
196 Y1 = (Xo * S1& + Yo * C1&) \ 1024\r
197       \r
198 X2& = (X1 * C2& - Zo * S2&) \ 1024\r
199 z1 = (X1 * S2& + Zo * C2&) \ 1024\r
200        \r
201 Y2& = (Y1 * C3& - z1 * S3&) \ 1024\r
202 z2 = (Y1 * S3& + z1 * C3&) \ 1024\r
203       \r
204 z2 = z2 + 300\r
205 Xn(R) = 320 + (X2& / z2 * 500)\r
206 Yn(R) = 240 + (Y2& / z2 * 500)\r
207 NEXT\r
208      \r
209 \r
210 FOR a1 = 0 TO nl - 1\r
211 F1 = pointers1(a1)\r
212 S1 = pointers2(a1)\r
213       \r
214 Xn = Xn(F1)\r
215 Yn = Yn(F1)\r
216           \r
217 X1 = Xn(S1)\r
218 Y1 = Yn(S1)\r
219           \r
220 LINE (Xs1(a1), Ys1(a1))-(Xe1(a1), Ye1(a1)), 0\r
221 LINE (X1, Y1)-(Xn, Yn), 15\r
222                   \r
223 \r
224 Xs1(a1) = X1: Ys1(a1) = Y1\r
225 Xe1(a1) = Xn: Ye1(a1) = Yn\r
226 NEXT\r
227   \r
228 \r
229 K$ = INKEY$\r
230 IF K$ <> "" THEN\r
231 \r
232 SELECT CASE K$\r
233 \r
234 CASE CHR$(0) + CHR$(72)\r
235 d1 = d1 + 1\r
236 \r
237 CASE CHR$(0) + CHR$(80)\r
238 d1 = d1 - 1\r
239 \r
240 CASE CHR$(0) + CHR$(75)\r
241 d2 = d2 - 1\r
242 \r
243 CASE CHR$(0) + CHR$(77)\r
244 d2 = d2 + 1\r
245 \r
246 CASE "w"\r
247 d3 = d3 - 1\r
248 \r
249 CASE "z"\r
250 d3 = d3 + 1\r
251 \r
252 CASE " "\r
253 d1 = d1 / 2\r
254 d2 = d2 / 2\r
255 d3 = d3 / 2\r
256 \r
257 CASE CHR$(27)\r
258 SYSTEM\r
259 \r
260 END SELECT\r
261 END IF\r
262 \r
263 LOOP\r
264 END SUB\r
265 \r