Fixed broken links.
[qbasicapps.git] / graphics / polymap.bas
1 ' Texture mapping and different interpolation methods,\r
2 ' by Timo Laidla & Svjatoslav Agejenko\r
3 ' 2003.07\r
4 \r
5 ' Use keys:\r
6 ' 0 - no interpolation\r
7 ' 1 - linear interpolation\r
8 ' 2 - cosinus interpolation\r
9 ' 3 - quadric interpolation\r
10 ' 4 - double texture, main with linear interpolation + mikro texture,\r
11 '     for very close up look.\r
12 ' 5 - smart interpolation. Rounds up sharp edges, good for drawings.\r
13 ' ESC - exit program\r
14 \r
15 \r
16 DECLARE SUB initsmart ()\r
17 DECLARE FUNCTION intsmart! (bx1!, by1!, sx!, sy!)\r
18 DECLARE FUNCTION getmappix! (x!, y!, s!)\r
19 DECLARE SUB initmap ()\r
20 DECLARE FUNCTION intmap! (bx1!, by1!, sx!, sy!)\r
21 DECLARE SUB demo ()\r
22 DECLARE FUNCTION intcos! (bx1!, by1!, sx!, sy!)\r
23 DECLARE FUNCTION intlin! (bx1!, by1!, sx!, sy!)\r
24 DECLARE FUNCTION intcub! (bx1!, by1!, sx!, sy!)\r
25 DECLARE FUNCTION Cub! (n0!, n1!, n2!, n3!, x!)\r
26 DECLARE SUB hline (x1!, x2!, y!, u1!, v1!, u2!, v2!)\r
27 DECLARE SUB lin (x1!, y1!, x2!, y2!, u1!, v1!, u2!, v2!)\r
28 DECLARE SUB poly (x1!, y1!, x2!, y2!, x3!, y3!, u1!, v1!, u2!, v2!, u3!, v3!)\r
29 DECLARE SUB start ()\r
30 \r
31 DIM SHARED buf(0 TO 99, 0 TO 99)\r
32 \r
33 DIM SHARED xbuf(0 TO 199)\r
34 DIM SHARED ubuf(0 TO 199)\r
35 DIM SHARED vbuf(0 TO 199)\r
36 DIM SHARED pi\r
37 DIM SHARED su\r
38 DIM SHARED mode\r
39 \r
40 DIM SHARED map1(0 TO 63, 0 TO 63)\r
41 DIM SHARED map2(0 TO 31, 0 TO 31)\r
42 DIM SHARED map3(0 TO 15, 0 TO 15)\r
43 DIM SHARED map4(0 TO 7, 0 TO 7)\r
44 DIM SHARED map5(0 TO 3, 0 TO 3)\r
45 DIM SHARED map6(0 TO 1, 0 TO 1)\r
46 DIM SHARED map7\r
47 DIM SHARED pixs\r
48 \r
49 DIM SHARED smart(0 TO 31, 0 TO 31)\r
50 \r
51 \r
52 su = 9\r
53 \r
54 start\r
55 \r
56 demo\r
57 \r
58 3\r
59 a$ = INKEY$\r
60 IF a$ = CHR$(27) THEN SYSTEM\r
61 IF a$ = "0" THEN mode = 0\r
62 IF a$ = "1" THEN mode = 1\r
63 IF a$ = "2" THEN mode = 2\r
64 IF a$ = "3" THEN mode = 3\r
65 IF a$ = "4" THEN mode = 4\r
66 IF a$ = "5" THEN mode = 5\r
67 poly RND * 319, RND * 199, RND * 319, RND * 199, RND * 319, RND * 199, 3, 3, su, 3, 3, su\r
68 GOTO 3\r
69 \r
70 FUNCTION Cub (v0, v1, v2, v3, x)\r
71 \r
72   p = (v3 - v2) - (v0 - v1)\r
73   q = (v0 - v1) - p\r
74   r = v2 - v0\r
75   s = v1\r
76 \r
77   Cub = (p * (x * x * x)) + (q * (x * x)) + (r * x) + s\r
78 \r
79 END FUNCTION\r
80 \r
81 SUB demo\r
82 'GOTO 6\r
83 \r
84 mode = 0\r
85 poly 0, 0, 159, 0, 0, 99, 10, 10, 20, 10, 10, 20\r
86 poly 159, 0, 159, 99, 0, 99, 20, 10, 20, 20, 10, 20\r
87 \r
88 mode = 1\r
89 poly 160, 0, 319, 0, 160, 99, 10, 10, 20, 10, 10, 20\r
90 poly 319, 0, 319, 99, 160, 99, 20, 10, 20, 20, 10, 20\r
91 \r
92 mode = 2\r
93 poly 0, 100, 159, 100, 0, 199, 10, 10, 20, 10, 10, 20\r
94 poly 159, 100, 159, 199, 0, 199, 20, 10, 20, 20, 10, 20\r
95 \r
96 mode = 3\r
97 poly 160, 100, 319, 100, 160, 199, 10, 10, 20, 10, 10, 20\r
98 poly 319, 100, 319, 199, 160, 199, 20, 10, 20, 20, 10, 20\r
99 \r
100 LOCATE 1, 1\r
101 PRINT "original"\r
102 LOCATE 1, 21\r
103 PRINT "linear"\r
104 LOCATE 14, 1\r
105 PRINT "cosinus"\r
106 LOCATE 14, 21\r
107 PRINT "quadric"\r
108 \r
109 \r
110 a$ = INPUT$(1)\r
111 4\r
112 mode = 4\r
113 \r
114 s = 1\r
115 poly 0, 0, 159 * s, 0, 0, 99 * s, 10, 10, 20, 10, 10, 20\r
116 poly 159 * s, 0, 159 * s, 99 * s, 0, 99 * s, 20, 10, 20, 20, 10, 20\r
117 \r
118 s = .5\r
119 y = 100\r
120 poly 0, 0 + y, 159 * s, 0 + y, 0, 99 * s + y, 10, 10, 20, 10, 10, 20\r
121 poly 159 * s, 0 + y, 159 * s, 99 * s + y, 0, 99 * s + y, 20, 10, 20, 20, 10, 20\r
122 \r
123 s = .25\r
124 y = 150\r
125 poly 0, 0 + y, 159 * s, 0 + y, 0, 99 * s + y, 10, 10, 20, 10, 10, 20\r
126 poly 159 * s, 0 + y, 159 * s, 99 * s + y, 0, 99 * s + y, 20, 10, 20, 20, 10, 20\r
127 \r
128 s = .125\r
129 y = 175\r
130 poly 0, 0 + y, 159 * s, 0 + y, 0, 99 * s + y, 10, 10, 20, 10, 10, 20\r
131 poly 159 * s, 0 + y, 159 * s, 99 * s + y, 0, 99 * s + y, 20, 10, 20, 20, 10, 20\r
132 6\r
133 \r
134 mode = 5\r
135 poly 160, 0, 319, 0, 160, 99, 10, 10, 20, 10, 10, 20\r
136 poly 319, 0, 319, 99, 160, 99, 20, 10, 20, 20, 10, 20\r
137 \r
138 LOCATE 1, 1\r
139 PRINT "double"\r
140 \r
141 LOCATE 1, 21\r
142 PRINT "smart"\r
143 a$ = INPUT$(1)\r
144 \r
145 \r
146 END SUB\r
147 \r
148 FUNCTION getmappix (x, y, s)\r
149 \r
150 IF s <= 1 THEN\r
151   getmappix = map7\r
152   GOTO 5\r
153 END IF\r
154 \r
155 IF s <= 2 THEN\r
156   getmappix = map6(x * 1, y * 1)\r
157   GOTO 5\r
158 END IF\r
159 \r
160 IF s <= 4 THEN\r
161   getmappix = map5(x * 3, y * 3)\r
162   GOTO 5\r
163 END IF\r
164 \r
165 IF s <= 8 THEN\r
166   getmappix = map4(x * 7, y * 7)\r
167   GOTO 5\r
168 END IF\r
169 \r
170 IF s <= 16 THEN\r
171   getmappix = map3(x * 15, y * 15)\r
172   GOTO 5\r
173 END IF\r
174 \r
175 IF s <= 32 THEN\r
176   getmappix = map2(x * 31, y * 31)\r
177   GOTO 5\r
178 END IF\r
179 \r
180 getmappix = map1(x * 63, y * 63)\r
181 \r
182 5\r
183 END FUNCTION\r
184 \r
185 SUB hline (ox1, ox2, y, ou1, ov1, ou2, ov2)\r
186 IF ox1 = ox2 THEN GOTO 1\r
187 \r
188 IF ox1 < ox2 THEN\r
189   x1 = ox1\r
190   x2 = ox2\r
191   u1 = ou1\r
192   v1 = ov1\r
193   u2 = ou2\r
194   v2 = ov2\r
195 ELSE\r
196   x1 = ox2\r
197   x2 = ox1\r
198   u1 = ou2\r
199   v1 = ov2\r
200   u2 = ou1\r
201   v2 = ov1\r
202 END IF\r
203 \r
204 ass = x2 - x1            ' amount of steps\r
205 uv = u2 - u1\r
206 vv = v2 - v1\r
207 \r
208 FOR a = 0 TO ass\r
209   rx = x1 + a\r
210   ru = uv * a / ass + u1\r
211   rv = vv * a / ass + v1\r
212 \r
213   bx1 = INT(ru)                 ' interpolatsioon\r
214   by1 = INT(rv)\r
215   sx = ru - bx1\r
216   sy = rv - by1\r
217 \r
218 SELECT CASE mode\r
219 CASE 0\r
220   PSET (rx, y), buf(bx1, by1)\r
221 CASE 1\r
222   PSET (rx, y), intlin(bx1, by1, sx, sy)\r
223 CASE 2\r
224   PSET (rx, y), intcos(bx1, by1, sx, sy)\r
225 CASE 3\r
226   PSET (rx, y), intcub(bx1, by1, sx, sy)\r
227 CASE 4\r
228   PSET (rx, y), intmap(bx1, by1, sx, sy)\r
229 CASE 5\r
230   PSET (rx, y), intsmart(bx1, by1, sx, sy)\r
231 END SELECT\r
232 \r
233 NEXT a\r
234 1\r
235 \r
236 END SUB\r
237 \r
238 SUB initmap\r
239 \r
240 DIM byte AS STRING * 1\r
241 \r
242 OPEN "polymap.dat" FOR BINARY AS #1\r
243 FOR y = 0 TO 63\r
244   FOR x = 0 TO 63\r
245     GET #1, , byte\r
246     c = ASC(byte)\r
247     map1(x, y) = c\r
248     PSET (x, y), c\r
249     PSET (x + 64, y), c\r
250     PSET (x, y + 64), c\r
251     PSET (x + 64, y + 64), c\r
252   NEXT x\r
253 NEXT y\r
254 CLOSE #1\r
255 \r
256 FOR y = 0 TO 31\r
257   FOR x = 0 TO 31\r
258     map2(x, y) = (map1(x * 2, y * 2) + map1(x * 2 + 1, y * 2) + map1(x * 2, y * 2 + 1) + map1(x * 2 + 1, y * 2 + 1)) / 4\r
259     PSET (x + 150, y), map2(x, y)\r
260   NEXT x\r
261 NEXT y\r
262 \r
263 FOR y = 0 TO 15\r
264   FOR x = 0 TO 15\r
265     map3(x, y) = (map2(x * 2, y * 2) + map2(x * 2 + 1, y * 2) + map2(x * 2, y * 2 + 1) + map2(x * 2 + 1, y * 2 + 1)) / 4\r
266     PSET (x + 200, y), map3(x, y)\r
267   NEXT x\r
268 NEXT y\r
269 \r
270 FOR y = 0 TO 7\r
271   FOR x = 0 TO 7\r
272     map4(x, y) = (map3(x * 2, y * 2) + map3(x * 2 + 1, y * 2) + map3(x * 2, y * 2 + 1) + map3(x * 2 + 1, y * 2 + 1)) / 4\r
273     PSET (x + 220, y), map4(x, y)\r
274   NEXT x\r
275 NEXT y\r
276 \r
277 FOR y = 0 TO 3\r
278   FOR x = 0 TO 3\r
279     map5(x, y) = (map4(x * 2, y * 2) + map4(x * 2 + 1, y * 2) + map4(x * 2, y * 2 + 1) + map4(x * 2 + 1, y * 2 + 1)) / 4\r
280     PSET (x + 250, y), map5(x, y)\r
281   NEXT x\r
282 NEXT y\r
283 \r
284 a = 0\r
285 FOR y = 0 TO 1\r
286   FOR x = 0 TO 1\r
287     map6(x, y) = (map5(x * 2, y * 2) + map5(x * 2 + 1, y * 2) + map5(x * 2, y * 2 + 1) + map5(x * 2 + 1, y * 2 + 1)) / 4\r
288     a = a + map6(x, y)\r
289     PSET (x + 260, y), map6(x, y)\r
290   NEXT x\r
291 NEXT y\r
292 \r
293 LOCATE 19\r
294 map7 = a / 4\r
295 PRINT "Average:", map7\r
296 \r
297 END SUB\r
298 \r
299 SUB initsmart\r
300 LINE (0, 0)-(15, 15), 1, BF\r
301 LINE (16, 0)-(31, 15), 2, BF\r
302 LINE (0, 16)-(15, 31), 3, BF\r
303 LINE (16, 16)-(31, 31), 4, BF\r
304 \r
305 CIRCLE (0, 0), 15, 5, , , 1\r
306 PAINT (0, 0), 5\r
307 CIRCLE (31, 0), 15, 6, , , 1\r
308 PAINT (31, 0), 6\r
309 CIRCLE (0, 31), 15, 7, , , 1\r
310 PAINT (0, 31), 7\r
311 CIRCLE (31, 31), 15, 8, , , 1\r
312 PAINT (31, 31), 8\r
313 \r
314 FOR y = 0 TO 31\r
315   FOR x = 0 TO 31\r
316     smart(x, y) = POINT(x, y)\r
317   NEXT x\r
318 NEXT y\r
319 \r
320 'a$ = INPUT$(1)\r
321 END SUB\r
322 \r
323 FUNCTION intcos (bx1, by1, sx, sy)\r
324 \r
325   c1 = buf(bx1, by1)\r
326   c2 = buf(bx1 + 1, by1)\r
327   c3 = buf(bx1 + 1, by1 + 1)\r
328   c4 = buf(bx1, by1 + 1)\r
329   f = (1 - COS(sy * pi)) * .5\r
330   tonel = c1 * (1 - f) + c4 * f\r
331   toner = c2 * (1 - f) + c3 * f\r
332   f2 = (1 - COS(sx * pi)) * .5\r
333   intcos = tonel * (1 - f2) + toner * f2\r
334 \r
335 \r
336 END FUNCTION\r
337 \r
338 FUNCTION intcub (bx1, by1, sx, sy)\r
339 \r
340   c11 = buf(bx1 - 1, by1 - 1)\r
341   c21 = buf(bx1 - 0, by1 - 1)\r
342   c31 = buf(bx1 + 1, by1 - 1)\r
343   c41 = buf(bx1 + 2, by1 - 1)\r
344 \r
345   c12 = buf(bx1 - 1, by1 - 0)\r
346   c22 = buf(bx1 - 0, by1 - 0)\r
347   c32 = buf(bx1 + 1, by1 - 0)\r
348   c42 = buf(bx1 + 2, by1 - 0)\r
349 \r
350   c13 = buf(bx1 - 1, by1 + 1)\r
351   c23 = buf(bx1 - 0, by1 + 1)\r
352   c33 = buf(bx1 + 1, by1 + 1)\r
353   c43 = buf(bx1 + 2, by1 + 1)\r
354 \r
355   c14 = buf(bx1 - 1, by1 + 2)\r
356   c24 = buf(bx1 - 0, by1 + 2)\r
357   c34 = buf(bx1 + 1, by1 + 2)\r
358   c44 = buf(bx1 + 2, by1 + 2)\r
359 \r
360   tone1 = Cub(c11, c12, c13, c14, sy)\r
361   tone2 = Cub(c21, c22, c23, c24, sy)\r
362   tone3 = Cub(c31, c32, c33, c34, sy)\r
363   tone4 = Cub(c41, c42, c43, c44, sy)\r
364 \r
365   tone = Cub(tone1, tone2, tone3, tone4, sx)\r
366   IF tone < 0 THEN tone = 0\r
367   IF tone > 255 THEN tone = 255\r
368 \r
369   intcub = tone\r
370 \r
371 END FUNCTION\r
372 \r
373 FUNCTION intlin (bx1, by1, sx, sy)\r
374  \r
375   c1 = buf(bx1, by1)\r
376   c2 = buf(bx1 + 1, by1)\r
377   c3 = buf(bx1 + 1, by1 + 1)\r
378   c4 = buf(bx1, by1 + 1)\r
379   tonel = (c4 - c1) * sy + c1\r
380   toner = (c3 - c2) * sy + c2\r
381   intlin = (toner - tonel) * sx + tonel\r
382 \r
383 END FUNCTION\r
384 \r
385 FUNCTION intmap (bx1, by1, sx, sy)\r
386 \r
387   c1 = buf(bx1, by1)\r
388   c2 = buf(bx1 + 1, by1)\r
389   c3 = buf(bx1 + 1, by1 + 1)\r
390   c4 = buf(bx1, by1 + 1)\r
391   tonel = (c4 - c1) * sy + c1\r
392   toner = (c3 - c2) * sy + c2\r
393   f = (toner - tonel) * sx + tonel\r
394 \r
395   nsx = sx / 4 + (bx1 MOD 4) / 4\r
396   nsy = sy / 4 + (by1 MOD 4) / 4\r
397 \r
398   intmap = getmappix(nsx, nsy, pixs) / 255 * f\r
399 \r
400 END FUNCTION\r
401 \r
402 FUNCTION intsmart (bx1, by1, sx, sy)\r
403 \r
404 p = smart(sx * 31, sy * 31)\r
405 SELECT CASE p\r
406 CASE 1\r
407   IF (buf(bx1 + 1, by1) = buf(bx1 + 1, by1 + 1)) AND (buf(bx1, by1 + 1) = buf(bx1 + 1, by1 + 1)) THEN r = buf(bx1 + 1, by1) ELSE r = buf(bx1, by1)\r
408 CASE 2\r
409   IF (buf(bx1, by1) = buf(bx1, by1 + 1)) AND (buf(bx1, by1 + 1) = buf(bx1 + 1, by1 + 1)) THEN r = buf(bx1, by1) ELSE r = buf(bx1 + 1, by1)\r
410 CASE 3\r
411   IF (buf(bx1, by1) = buf(bx1 + 1, by1)) AND (buf(bx1 + 1, by1) = buf(bx1 + 1, by1 + 1)) THEN r = buf(bx1, by1) ELSE r = buf(bx1, by1 + 1)\r
412 CASE 4\r
413   IF (buf(bx1, by1) = buf(bx1, by1 + 1)) AND (buf(bx1, by1) = buf(bx1 + 1, by1)) THEN r = buf(bx1, by1) ELSE r = buf(bx1 + 1, by1 + 1)\r
414 CASE 5\r
415   r = buf(bx1, by1)\r
416 CASE 6\r
417   r = buf(bx1 + 1, by1)\r
418 CASE 7\r
419   r = buf(bx1, by1 + 1)\r
420 CASE 8\r
421   r = buf(bx1 + 1, by1 + 1)\r
422 END SELECT\r
423 \r
424 intsmart = r\r
425 END FUNCTION\r
426 \r
427 SUB lin (x1, y1, x2, y2, u1, v1, u2, v2)\r
428 \r
429 IF y1 = y2 THEN\r
430   hline x1, x2, y1, u1, v1, u2, v2\r
431   GOTO 2\r
432 END IF\r
433 \r
434 IF y1 < y2 THEN\r
435   rx1 = INT(x1): ry1 = INT(y1): rx2 = INT(x2): ry2 = INT(y2)\r
436   ru1 = INT(u1): rv1 = INT(v1): ru2 = INT(u2): rv2 = INT(v2)\r
437 ELSE\r
438   rx1 = INT(x2): ry1 = INT(y2): rx2 = INT(x1): ry2 = INT(y1)\r
439   ru1 = INT(u2): rv1 = INT(v2): ru2 = INT(u1): rv2 = INT(v1)\r
440 END IF\r
441 \r
442 ass = ry2 - ry1\r
443 \r
444 xv = rx2 - rx1\r
445 uv = ru2 - ru1\r
446 vv = rv2 - rv1\r
447 \r
448 FOR a = 0 TO ass - 1\r
449   y = ry1 + a\r
450 \r
451   x = xv * a / ass + rx1\r
452   u = uv * a / ass + ru1\r
453   v = vv * a / ass + rv1\r
454 \r
455   IF xbuf(y) = -1 THEN\r
456     xbuf(y) = INT(x)\r
457     ubuf(y) = u\r
458     vbuf(y) = v\r
459   ELSE\r
460     hline INT(x), xbuf(y), y, u, v, ubuf(y), vbuf(y)\r
461   END IF\r
462 NEXT a\r
463 2\r
464 END SUB\r
465 \r
466 SUB poly (x1, y1, x2, y2, x3, y3, u1, v1, u2, v2, u3, v3)\r
467 \r
468 p = SQR((x1 - x2) ^ 2 + (y1 - y2) ^ 2)\r
469 p = p + SQR((x3 - x2) ^ 2 + (y3 - y2) ^ 2)\r
470 p = p + SQR((x3 - x1) ^ 2 + (y3 - y1) ^ 2)\r
471 \r
472 p1 = SQR((u1 - u2) ^ 2 + (v1 - v2) ^ 2)\r
473 p1 = p1 + SQR((u3 - u2) ^ 2 + (v3 - v2) ^ 2)\r
474 p1 = p1 + SQR((u3 - u1) ^ 2 + (v3 - v1) ^ 2)\r
475 pixs = p / p1 * 4\r
476 \r
477 'LOCATE 20, 1\r
478 'PRINT "pixel size", pixs\r
479 'LOCATE 21\r
480 'PRINT p, p1\r
481 \r
482 \r
483 \r
484 FOR a = 0 TO 199\r
485   xbuf(a) = -1\r
486   ubuf(a) = -1\r
487   vbuf(a) = -1\r
488 NEXT a\r
489 \r
490 lin x1, y1, x2, y2, u1, v1, u2, v2\r
491 lin x2, y2, x3, y3, u2, v2, u3, v3\r
492 lin x3, y3, x1, y1, u3, v3, u1, v1\r
493 \r
494 \r
495 END SUB\r
496 \r
497 SUB start\r
498 SCREEN 13\r
499 initsmart\r
500 RANDOMIZE 20\r
501 \r
502 pi = 3.141592\r
503 \r
504 FOR a = 0 TO 255\r
505   OUT &H3C8, a\r
506   OUT &H3C9, a \ 4\r
507   OUT &H3C9, a \ 4\r
508   OUT &H3C9, a \ 4\r
509 NEXT a\r
510 \r
511 FOR x = 0 TO 255\r
512   LINE (x, 100)-(x, 199), x\r
513 NEXT x\r
514 \r
515 'PAINT (0, 0), 200\r
516 'FOR a = 0 TO 255\r
517 '  LINE (a, 0)-(a, 200), a\r
518 'NEXT a\r
519 'SLEEP\r
520 \r
521 \r
522 FOR a = 1 TO 5000\r
523   c = RND * 255\r
524   x = RND * 100\r
525   y = RND * 100\r
526   CIRCLE (x, y), RND * su / 10, c\r
527   PAINT (x, y), c\r
528 NEXT a\r
529 \r
530 LOCATE 2, 2\r
531 COLOR 200\r
532 PRINT "Test!"\r
533 \r
534 FOR y = 0 TO 99\r
535   FOR x = 0 TO 99\r
536     buf(x, y) = POINT(x, y)\r
537     PSET (x, y), 1\r
538   NEXT x\r
539 NEXT y\r
540 \r
541 initmap\r
542 \r
543 END SUB\r
544 \r