' Texture mapping and different interpolation methods, ' by Timo Laidla & Svjatoslav Agejenko ' 2003.07 ' Use keys: ' 0 - no interpolation ' 1 - linear interpolation ' 2 - cosinus interpolation ' 3 - quadric interpolation ' 4 - double texture, main with linear interpolation + mikro texture, ' for very close up look. ' 5 - smart interpolation. Rounds up sharp edges, good for drawings. ' ESC - exit program DECLARE SUB initsmart () DECLARE FUNCTION intsmart! (bx1!, by1!, sx!, sy!) DECLARE FUNCTION getmappix! (x!, y!, s!) DECLARE SUB initmap () DECLARE FUNCTION intmap! (bx1!, by1!, sx!, sy!) DECLARE SUB demo () DECLARE FUNCTION intcos! (bx1!, by1!, sx!, sy!) DECLARE FUNCTION intlin! (bx1!, by1!, sx!, sy!) DECLARE FUNCTION intcub! (bx1!, by1!, sx!, sy!) DECLARE FUNCTION Cub! (n0!, n1!, n2!, n3!, x!) DECLARE SUB hline (x1!, x2!, y!, u1!, v1!, u2!, v2!) DECLARE SUB lin (x1!, y1!, x2!, y2!, u1!, v1!, u2!, v2!) DECLARE SUB poly (x1!, y1!, x2!, y2!, x3!, y3!, u1!, v1!, u2!, v2!, u3!, v3!) DECLARE SUB start () DIM SHARED buf(0 TO 99, 0 TO 99) DIM SHARED xbuf(0 TO 199) DIM SHARED ubuf(0 TO 199) DIM SHARED vbuf(0 TO 199) DIM SHARED pi DIM SHARED su DIM SHARED mode DIM SHARED map1(0 TO 63, 0 TO 63) DIM SHARED map2(0 TO 31, 0 TO 31) DIM SHARED map3(0 TO 15, 0 TO 15) DIM SHARED map4(0 TO 7, 0 TO 7) DIM SHARED map5(0 TO 3, 0 TO 3) DIM SHARED map6(0 TO 1, 0 TO 1) DIM SHARED map7 DIM SHARED pixs DIM SHARED smart(0 TO 31, 0 TO 31) su = 9 start demo 3 a$ = INKEY$ IF a$ = CHR$(27) THEN SYSTEM IF a$ = "0" THEN mode = 0 IF a$ = "1" THEN mode = 1 IF a$ = "2" THEN mode = 2 IF a$ = "3" THEN mode = 3 IF a$ = "4" THEN mode = 4 IF a$ = "5" THEN mode = 5 poly RND * 319, RND * 199, RND * 319, RND * 199, RND * 319, RND * 199, 3, 3, su, 3, 3, su GOTO 3 FUNCTION Cub (v0, v1, v2, v3, x) p = (v3 - v2) - (v0 - v1) q = (v0 - v1) - p r = v2 - v0 s = v1 Cub = (p * (x * x * x)) + (q * (x * x)) + (r * x) + s END FUNCTION SUB demo 'GOTO 6 mode = 0 poly 0, 0, 159, 0, 0, 99, 10, 10, 20, 10, 10, 20 poly 159, 0, 159, 99, 0, 99, 20, 10, 20, 20, 10, 20 mode = 1 poly 160, 0, 319, 0, 160, 99, 10, 10, 20, 10, 10, 20 poly 319, 0, 319, 99, 160, 99, 20, 10, 20, 20, 10, 20 mode = 2 poly 0, 100, 159, 100, 0, 199, 10, 10, 20, 10, 10, 20 poly 159, 100, 159, 199, 0, 199, 20, 10, 20, 20, 10, 20 mode = 3 poly 160, 100, 319, 100, 160, 199, 10, 10, 20, 10, 10, 20 poly 319, 100, 319, 199, 160, 199, 20, 10, 20, 20, 10, 20 LOCATE 1, 1 PRINT "original" LOCATE 1, 21 PRINT "linear" LOCATE 14, 1 PRINT "cosinus" LOCATE 14, 21 PRINT "quadric" a$ = INPUT$(1) 4 mode = 4 s = 1 poly 0, 0, 159 * s, 0, 0, 99 * s, 10, 10, 20, 10, 10, 20 poly 159 * s, 0, 159 * s, 99 * s, 0, 99 * s, 20, 10, 20, 20, 10, 20 s = .5 y = 100 poly 0, 0 + y, 159 * s, 0 + y, 0, 99 * s + y, 10, 10, 20, 10, 10, 20 poly 159 * s, 0 + y, 159 * s, 99 * s + y, 0, 99 * s + y, 20, 10, 20, 20, 10, 20 s = .25 y = 150 poly 0, 0 + y, 159 * s, 0 + y, 0, 99 * s + y, 10, 10, 20, 10, 10, 20 poly 159 * s, 0 + y, 159 * s, 99 * s + y, 0, 99 * s + y, 20, 10, 20, 20, 10, 20 s = .125 y = 175 poly 0, 0 + y, 159 * s, 0 + y, 0, 99 * s + y, 10, 10, 20, 10, 10, 20 poly 159 * s, 0 + y, 159 * s, 99 * s + y, 0, 99 * s + y, 20, 10, 20, 20, 10, 20 6 mode = 5 poly 160, 0, 319, 0, 160, 99, 10, 10, 20, 10, 10, 20 poly 319, 0, 319, 99, 160, 99, 20, 10, 20, 20, 10, 20 LOCATE 1, 1 PRINT "double" LOCATE 1, 21 PRINT "smart" a$ = INPUT$(1) END SUB FUNCTION getmappix (x, y, s) IF s <= 1 THEN getmappix = map7 GOTO 5 END IF IF s <= 2 THEN getmappix = map6(x * 1, y * 1) GOTO 5 END IF IF s <= 4 THEN getmappix = map5(x * 3, y * 3) GOTO 5 END IF IF s <= 8 THEN getmappix = map4(x * 7, y * 7) GOTO 5 END IF IF s <= 16 THEN getmappix = map3(x * 15, y * 15) GOTO 5 END IF IF s <= 32 THEN getmappix = map2(x * 31, y * 31) GOTO 5 END IF getmappix = map1(x * 63, y * 63) 5 END FUNCTION SUB hline (ox1, ox2, y, ou1, ov1, ou2, ov2) IF ox1 = ox2 THEN GOTO 1 IF ox1 < ox2 THEN x1 = ox1 x2 = ox2 u1 = ou1 v1 = ov1 u2 = ou2 v2 = ov2 ELSE x1 = ox2 x2 = ox1 u1 = ou2 v1 = ov2 u2 = ou1 v2 = ov1 END IF ass = x2 - x1 ' amount of steps uv = u2 - u1 vv = v2 - v1 FOR a = 0 TO ass rx = x1 + a ru = uv * a / ass + u1 rv = vv * a / ass + v1 bx1 = INT(ru) ' interpolatsioon by1 = INT(rv) sx = ru - bx1 sy = rv - by1 SELECT CASE mode CASE 0 PSET (rx, y), buf(bx1, by1) CASE 1 PSET (rx, y), intlin(bx1, by1, sx, sy) CASE 2 PSET (rx, y), intcos(bx1, by1, sx, sy) CASE 3 PSET (rx, y), intcub(bx1, by1, sx, sy) CASE 4 PSET (rx, y), intmap(bx1, by1, sx, sy) CASE 5 PSET (rx, y), intsmart(bx1, by1, sx, sy) END SELECT NEXT a 1 END SUB SUB initmap DIM byte AS STRING * 1 OPEN "polymap.dat" FOR BINARY AS #1 FOR y = 0 TO 63 FOR x = 0 TO 63 GET #1, , byte c = ASC(byte) map1(x, y) = c PSET (x, y), c PSET (x + 64, y), c PSET (x, y + 64), c PSET (x + 64, y + 64), c NEXT x NEXT y CLOSE #1 FOR y = 0 TO 31 FOR x = 0 TO 31 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 PSET (x + 150, y), map2(x, y) NEXT x NEXT y FOR y = 0 TO 15 FOR x = 0 TO 15 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 PSET (x + 200, y), map3(x, y) NEXT x NEXT y FOR y = 0 TO 7 FOR x = 0 TO 7 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 PSET (x + 220, y), map4(x, y) NEXT x NEXT y FOR y = 0 TO 3 FOR x = 0 TO 3 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 PSET (x + 250, y), map5(x, y) NEXT x NEXT y a = 0 FOR y = 0 TO 1 FOR x = 0 TO 1 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 a = a + map6(x, y) PSET (x + 260, y), map6(x, y) NEXT x NEXT y LOCATE 19 map7 = a / 4 PRINT "Average:", map7 END SUB SUB initsmart LINE (0, 0)-(15, 15), 1, BF LINE (16, 0)-(31, 15), 2, BF LINE (0, 16)-(15, 31), 3, BF LINE (16, 16)-(31, 31), 4, BF CIRCLE (0, 0), 15, 5, , , 1 PAINT (0, 0), 5 CIRCLE (31, 0), 15, 6, , , 1 PAINT (31, 0), 6 CIRCLE (0, 31), 15, 7, , , 1 PAINT (0, 31), 7 CIRCLE (31, 31), 15, 8, , , 1 PAINT (31, 31), 8 FOR y = 0 TO 31 FOR x = 0 TO 31 smart(x, y) = POINT(x, y) NEXT x NEXT y 'a$ = INPUT$(1) END SUB FUNCTION intcos (bx1, by1, sx, sy) c1 = buf(bx1, by1) c2 = buf(bx1 + 1, by1) c3 = buf(bx1 + 1, by1 + 1) c4 = buf(bx1, by1 + 1) f = (1 - COS(sy * pi)) * .5 tonel = c1 * (1 - f) + c4 * f toner = c2 * (1 - f) + c3 * f f2 = (1 - COS(sx * pi)) * .5 intcos = tonel * (1 - f2) + toner * f2 END FUNCTION FUNCTION intcub (bx1, by1, sx, sy) c11 = buf(bx1 - 1, by1 - 1) c21 = buf(bx1 - 0, by1 - 1) c31 = buf(bx1 + 1, by1 - 1) c41 = buf(bx1 + 2, by1 - 1) c12 = buf(bx1 - 1, by1 - 0) c22 = buf(bx1 - 0, by1 - 0) c32 = buf(bx1 + 1, by1 - 0) c42 = buf(bx1 + 2, by1 - 0) c13 = buf(bx1 - 1, by1 + 1) c23 = buf(bx1 - 0, by1 + 1) c33 = buf(bx1 + 1, by1 + 1) c43 = buf(bx1 + 2, by1 + 1) c14 = buf(bx1 - 1, by1 + 2) c24 = buf(bx1 - 0, by1 + 2) c34 = buf(bx1 + 1, by1 + 2) c44 = buf(bx1 + 2, by1 + 2) tone1 = Cub(c11, c12, c13, c14, sy) tone2 = Cub(c21, c22, c23, c24, sy) tone3 = Cub(c31, c32, c33, c34, sy) tone4 = Cub(c41, c42, c43, c44, sy) tone = Cub(tone1, tone2, tone3, tone4, sx) IF tone < 0 THEN tone = 0 IF tone > 255 THEN tone = 255 intcub = tone END FUNCTION FUNCTION intlin (bx1, by1, sx, sy) c1 = buf(bx1, by1) c2 = buf(bx1 + 1, by1) c3 = buf(bx1 + 1, by1 + 1) c4 = buf(bx1, by1 + 1) tonel = (c4 - c1) * sy + c1 toner = (c3 - c2) * sy + c2 intlin = (toner - tonel) * sx + tonel END FUNCTION FUNCTION intmap (bx1, by1, sx, sy) c1 = buf(bx1, by1) c2 = buf(bx1 + 1, by1) c3 = buf(bx1 + 1, by1 + 1) c4 = buf(bx1, by1 + 1) tonel = (c4 - c1) * sy + c1 toner = (c3 - c2) * sy + c2 f = (toner - tonel) * sx + tonel nsx = sx / 4 + (bx1 MOD 4) / 4 nsy = sy / 4 + (by1 MOD 4) / 4 intmap = getmappix(nsx, nsy, pixs) / 255 * f END FUNCTION FUNCTION intsmart (bx1, by1, sx, sy) p = smart(sx * 31, sy * 31) SELECT CASE p CASE 1 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) CASE 2 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) CASE 3 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) CASE 4 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) CASE 5 r = buf(bx1, by1) CASE 6 r = buf(bx1 + 1, by1) CASE 7 r = buf(bx1, by1 + 1) CASE 8 r = buf(bx1 + 1, by1 + 1) END SELECT intsmart = r END FUNCTION SUB lin (x1, y1, x2, y2, u1, v1, u2, v2) IF y1 = y2 THEN hline x1, x2, y1, u1, v1, u2, v2 GOTO 2 END IF IF y1 < y2 THEN rx1 = INT(x1): ry1 = INT(y1): rx2 = INT(x2): ry2 = INT(y2) ru1 = INT(u1): rv1 = INT(v1): ru2 = INT(u2): rv2 = INT(v2) ELSE rx1 = INT(x2): ry1 = INT(y2): rx2 = INT(x1): ry2 = INT(y1) ru1 = INT(u2): rv1 = INT(v2): ru2 = INT(u1): rv2 = INT(v1) END IF ass = ry2 - ry1 xv = rx2 - rx1 uv = ru2 - ru1 vv = rv2 - rv1 FOR a = 0 TO ass - 1 y = ry1 + a x = xv * a / ass + rx1 u = uv * a / ass + ru1 v = vv * a / ass + rv1 IF xbuf(y) = -1 THEN xbuf(y) = INT(x) ubuf(y) = u vbuf(y) = v ELSE hline INT(x), xbuf(y), y, u, v, ubuf(y), vbuf(y) END IF NEXT a 2 END SUB SUB poly (x1, y1, x2, y2, x3, y3, u1, v1, u2, v2, u3, v3) p = SQR((x1 - x2) ^ 2 + (y1 - y2) ^ 2) p = p + SQR((x3 - x2) ^ 2 + (y3 - y2) ^ 2) p = p + SQR((x3 - x1) ^ 2 + (y3 - y1) ^ 2) p1 = SQR((u1 - u2) ^ 2 + (v1 - v2) ^ 2) p1 = p1 + SQR((u3 - u2) ^ 2 + (v3 - v2) ^ 2) p1 = p1 + SQR((u3 - u1) ^ 2 + (v3 - v1) ^ 2) pixs = p / p1 * 4 'LOCATE 20, 1 'PRINT "pixel size", pixs 'LOCATE 21 'PRINT p, p1 FOR a = 0 TO 199 xbuf(a) = -1 ubuf(a) = -1 vbuf(a) = -1 NEXT a lin x1, y1, x2, y2, u1, v1, u2, v2 lin x2, y2, x3, y3, u2, v2, u3, v3 lin x3, y3, x1, y1, u3, v3, u1, v1 END SUB SUB start SCREEN 13 initsmart RANDOMIZE 20 pi = 3.141592 FOR a = 0 TO 255 OUT &H3C8, a OUT &H3C9, a \ 4 OUT &H3C9, a \ 4 OUT &H3C9, a \ 4 NEXT a FOR x = 0 TO 255 LINE (x, 100)-(x, 199), x NEXT x 'PAINT (0, 0), 200 'FOR a = 0 TO 255 ' LINE (a, 0)-(a, 200), a 'NEXT a 'SLEEP FOR a = 1 TO 5000 c = RND * 255 x = RND * 100 y = RND * 100 CIRCLE (x, y), RND * su / 10, c PAINT (x, y), c NEXT a LOCATE 2, 2 COLOR 200 PRINT "Test!" FOR y = 0 TO 99 FOR x = 0 TO 99 buf(x, y) = POINT(x, y) PSET (x, y), 1 NEXT x NEXT y initmap END SUB