Fixed link URLs
[qbasicapps.git] / graphics / texture.bas
1 ' Texture mapping\r
2 ' by Svjatoslav Agejenko\r
3 ' 04.2003\r
4 \r
5 DECLARE SUB demo3 ()\r
6 DECLARE SUB demo2 ()\r
7 DECLARE SUB demo1 ()\r
8 DECLARE SUB hline (x1!, y!, x2!, tx1!, ty1!, tx2!, ty2!)\r
9 DECLARE SUB polygon (x1!, y1!, x2!, y2!, x3!, y3!, tx1!, ty1!, tx2!, ty2!, tx3!, ty3!)\r
10 DECLARE SUB pline (x1!, y1!, x2!, y2!, tx1!, ty1!, tx2!, ty2!)\r
11 DECLARE SUB start ()\r
12 DIM SHARED img(0 TO 100, 0 TO 100)\r
13 \r
14 DIM SHARED bufx(0 TO 199)\r
15 DIM SHARED buftx(0 TO 199)\r
16 DIM SHARED bufty(0 TO 199)\r
17 \r
18 start\r
19 demo1\r
20 demo2\r
21 demo3\r
22 SYSTEM\r
23 \r
24 SUB demo1\r
25 polygon 10, 10, 300, 80, 100, 180, 1, 1, 99, 1, 30, 99\r
26 \r
27 a$ = INPUT$(1)\r
28 3\r
29 x1 = RND * 300 + 10\r
30 x2 = RND * 300 + 10\r
31 x3 = RND * 300 + 10\r
32 y1 = RND * 180 + 10\r
33 y2 = RND * 180 + 10\r
34 y3 = RND * 180 + 10\r
35 polygon x1, y1, x2, y2, x3, y3, 1, 1, 99, 1, 30, 99\r
36 IF INKEY$ = "" THEN GOTO 3\r
37 CLS\r
38 END SUB\r
39 \r
40 SUB demo2\r
41 \r
42 n = 0\r
43 4\r
44 x1 = SIN(n) * 80 + 160\r
45 y1 = COS(n) * 80 + 100\r
46 x2 = SIN(n + 2) * 80 + 160\r
47 y2 = COS(n + 2) * 80 + 100\r
48 x3 = SIN(n + 4) * 90 + 160\r
49 y3 = COS(n + 4) * 90 + 100\r
50 polygon x1, y1, x2, y2, x3, y3, 1, 1, 99, 1, 30, 99\r
51 n = n + .1\r
52 IF INKEY$ = "" THEN GOTO 4\r
53 CLS\r
54 END SUB\r
55 \r
56 SUB demo3\r
57 \r
58 n = 0\r
59 5\r
60 x1 = SIN(n) * 40 + 50\r
61 y1 = COS(n) * 40 + 50\r
62 x2 = SIN(n + 2) * 40 + 50\r
63 y2 = COS(n + 2) * 40 + 50\r
64 x3 = SIN(n + 4) * 40 + 50\r
65 y3 = COS(n + 4) * 40 + 50\r
66 polygon 1, 50, 300, 1, 100, 180, x1, y1, x2, y2, x3, y3\r
67 n = n + .1\r
68 IF INKEY$ = "" THEN GOTO 5\r
69 CLS\r
70 \r
71 END SUB\r
72 \r
73 SUB hline (x1, y, x2, tx1, ty1, tx2, ty2)\r
74 \r
75 IF INT(x2) = INT(x1) THEN GOTO 2\r
76 IF x2 > x1 THEN\r
77   nx1 = INT(x1)\r
78   nx2 = INT(x2)\r
79   ntx1 = tx1\r
80   nty1 = ty1\r
81   ntx2 = tx2\r
82   nty2 = ty2\r
83 ELSE\r
84   nx1 = INT(x2)\r
85   nx2 = INT(x1)\r
86   ntx1 = tx2\r
87   nty1 = ty2\r
88   ntx2 = tx1\r
89   nty2 = ty1\r
90 END IF\r
91 \r
92 v = nx2 - nx1\r
93 tvx = ntx2 - ntx1\r
94 tvy = nty2 - nty1\r
95 \r
96 FOR a = 0 TO v\r
97   rtx = tvx * a / v + ntx1\r
98   rty = tvy * a / v + nty1\r
99   PSET (a + nx1, y), img(rtx, rty)\r
100 NEXT a\r
101 \r
102 2\r
103 END SUB\r
104 \r
105 SUB pline (x1, y1, x2, y2, tx1, ty1, tx2, ty2)\r
106 m = ABS(y2 - y1)\r
107 IF m = 0 THEN GOTO 1\r
108 \r
109 vy = y2 - y1\r
110 vx = x2 - x1\r
111 \r
112 tvy = ty2 - ty1\r
113 tvx = tx2 - tx1\r
114 \r
115 FOR a = 0 TO m\r
116   rx = vx * a / m + x1\r
117   ry = vy * a / m + y1\r
118   trx = tvx * a / m + tx1\r
119   try = tvy * a / m + ty1\r
120 ' PSET (rx, ry), 14\r
121   IF bufx(ry) = -1 THEN\r
122     bufx(ry) = rx\r
123     buftx(ry) = trx\r
124     bufty(ry) = try\r
125   ELSE\r
126     hline bufx(ry), ry, rx, buftx(ry), bufty(ry), trx, try\r
127   END IF\r
128 NEXT a\r
129 \r
130 1\r
131 END SUB\r
132 \r
133 SUB polygon (x1, y1, x2, y2, x3, y3, tx1, ty1, tx2, ty2, tx3, ty3)\r
134 \r
135 FOR a = 0 TO 199\r
136   bufx(a) = -1\r
137 NEXT a\r
138 \r
139 pline x1, y1, x2, y2, tx1, ty1, tx2, ty2\r
140 pline x1, y1, x3, y3, tx1, ty1, tx3, ty3\r
141 pline x3, y3, x2, y2, tx3, ty3, tx2, ty2\r
142 \r
143 END SUB\r
144 \r
145 SUB start\r
146 \r
147 SCREEN 13\r
148 \r
149 FOR a = 1 TO 100\r
150   x = RND * 150\r
151   y = RND * 150\r
152   c = RND * 255\r
153   CIRCLE (x, y), RND * 20 + 3, c\r
154   PAINT (x, y), c\r
155 NEXT a\r
156 \r
157 LOCATE 8, 8\r
158 PRINT "Test!"\r
159 a$ = INPUT$(1)\r
160 \r
161 FOR y = 0 TO 100\r
162   FOR x = 0 TO 100\r
163     img(x, y) = POINT(x + 20, y + 20)\r
164     PSET (x + 20, y + 20), 0\r
165   NEXT x\r
166 NEXT y\r
167 CLS\r
168 \r
169 END SUB\r
170 \r