§ Описание

Когда-то я очень хотел создать трехмерную графику на Бейсике, и вот спустя много лет, наконец-то, взялся за дело и сделал это. Но и не только. Помимо самой графики, также научился использовать буфер для того, чтобы рисовать сначала в нем, а потом показывать на экране. Это нерационально, но все-таки, это работает.

Скриншот экрана окна Бейсика. А также можно скачать CRAFT.BMP, для источника данных.

§ Код

Основная программа

1SCREEN 13
2
3CONST NEAR = 0.5
4
5TYPE vec2i
6  x AS INTEGER
7  y AS INTEGER
8END TYPE
9
10TYPE vec3
11  x AS SINGLE
12  y AS SINGLE
13  z AS SINGLE
14  u AS SINGLE
15  v AS SINGLE
16END TYPE
17
18TYPE trg
19  A1 AS SINGLE: A2 AS SINGLE: A3 AS SINGLE
20  B1 AS SINGLE: B2 AS SINGLE: B3 AS SINGLE
21  C1 AS SINGLE: C2 AS SINGLE: C3 AS SINGLE
22  D1 AS SINGLE: D2 AS SINGLE: D3 AS SINGLE
23END TYPE
24
25' Point list for triangle
26DIM SHARED vc(0 TO 7) AS vec3
27DIM SHARED tile(0 TO 15, 0 TO 15) AS INTEGER
28
29' Matrix operation (ma - camera, mb - operation)
30DIM SHARED ma(0 TO 3, 0 TO 3) AS SINGLE
31DIM SHARED mb(0 TO 3, 0 TO 3) AS SINGLE
32
33DIM SHARED cam AS vec3
34DIM SHARED rot AS vec3
35
36DIM wr(0 TO 3, 0 TO 3, 0 TO 3) AS INTEGER
37
38' Vertex (4 back, 4 front)
39DATA -1, 1, 1
40DATA  1, 1, 1
41DATA  1,-1, 1
42DATA -1,-1, 1
43DATA -1, 1,-1
44DATA  1, 1,-1
45DATA  1,-1,-1
46DATA -1,-1,-1
47
48FACES:
49
50' Quads faces a,b,c,d|tex
51DATA 0, 4, 7, 3
52DATA 0, 1, 5, 4
53DATA 4, 5, 6, 7
54DATA 1, 0, 3, 2
55DATA 2, 3, 7, 6
56DATA 5, 1, 2, 6
57
58' Read all vertexes
59FOR i = 0 TO 7: READ vc(i).x, vc(i).y, vc(i).z: NEXT
60
61' Sprites
62LOADPALETTE ' Loading Palette from CRAFT.BMP
63
64' Camera position
65cam.x = 1.5: cam.y = 3: cam.z = -4
66rot.x = 0: rot.y = 0: rot.z = 0
67
68' World definition
69wr(0,0,3)=1
70wr(0,0,2)=2
71wr(0,0,1)=3
72wr(0,0,0)=4
73
74wr(2,2,0)=1
75wr(2,1,2)=2
76
77CLEARBUF
78
79FOR k = 0 TO 3
80FOR i = 0 TO 3
81FOR j = 0 TO 3
82
83  t = wr(j, i, k)
84  IF t > 0 THEN
85
86    LOADTILE t MOD 16, t \ 16
87    DRAWCUBE 2*j, 2*i, 2*k
88
89  END IF
90NEXT
91NEXT
92NEXT
93
94RESTOREBUF

Основная процедура рисования треугольников.

1' Draw 1 or 2 Triangle
2SUB RENDER (p0 AS vec3, p1 AS vec3, p2 AS vec3)
3
4  DIM q(0 TO 2) AS vec3
5  DIM p(0 TO 3) AS vec3
6
7  q(0) = p0: q(1) = p1: q(2) = p2
8
9  DIM a AS vec3
10  DIM b AS vec3
11  DIM c AS vec3
12  DIM k AS INTEGER
13
14  k = 0
15
16  ' Apply camera transform
17  FOR i = 0 TO 2
18
19    ' Camera transform
20    qx = q(i).x * ma(0, 0) + q(i).y * ma(0, 1) + q(i).z * ma(0, 2) + ma(0, 3)
21    qy = q(i).x * ma(1, 0) + q(i).y * ma(1, 1) + q(i).z * ma(1, 2) + ma(1, 3)
22    qz = q(i).x * ma(2, 0) + q(i).y * ma(2, 1) + q(i).z * ma(2, 2) + ma(2, 3)
23
24    ' Copy new result
25    q(i).x = qx: q(i).y = qy: q(i).z = qz
26
27  NEXT
28
29  ' Search clipping
30  FOR i = 0 TO 2
31
32    a = q(i)
33    b = q((i + 1) MOD 3)
34
35    ' One point in front of NEAR
36    IF a.z >= NEAR OR b.z >= NEAR THEN
37
38      ' Add visible point
39      IF a.z >= NEAR THEN p(k) = a: k = k + 1
40
41      ' a.z must be >= b.z
42      IF (a.z < b.z) THEN SWAP a, b
43
44      ' Diffent sides, calc intermediate point
45      IF (a.z >= NEAR AND b.z < NEAR) THEN
46
47        t = (NEAR - b.z) / (a.z - b.z)
48
49        c.x = b.x + t * (a.x - b.x)
50        c.y = b.y + t * (a.y - b.y)
51        c.z = NEAR
52        c.u = b.u + t * (a.u - b.u)
53        c.v = b.v + t * (a.v - b.v)
54
55        p(k) = c: k = k + 1
56
57      END IF
58
59    END IF
60
61  NEXT
62
63  IF k = 3 OR k = 4 THEN DRAWTRI p(0), p(1), p(2)
64  IF k = 4 THEN DRAWTRI p(0), p(2), p(3)
65
66END SUB
67
68' Drawing triangle
69SUB DRAWTRI (a AS vec3, b AS vec3, c AS vec3)
70
71  ' Declare dimension
72  DIM p(0 TO 2) AS vec2i
73  DIM h(0 TO 2) AS vec3
74  DIM tri AS trg
75  DIM cb AS STRING * 320
76  DIM db(0 TO 319) AS SINGLE
77
78  ' Copy data
79  h(0) = a: h(1) = b: h(2) = c
80
81    ' Make UV-diff
82  FOR i = 1 TO 2
83    h(i).u = h(i).u - h(0).u
84    h(i).v = h(i).v - h(0).v
85  NEXT
86
87  ' Projection
88  FOR i = 0 TO 2
89    p(i).x = 160 + 100 * h(i).x / h(i).z
90    p(i).y = 100 - 100 * h(i).y / h(i).z
91  NEXT
92
93  ' Check front side
94  ABx = p(1).x - p(0).x: ABy = p(1).y - p(0).y
95  ACx = p(2).x - p(0).x: ACy = p(2).y - p(0).y
96
97  IF ABy * ACx - ABx * ACy > 0 THEN EXIT SUB
98
99  ' Sorting
100  FOR i = 0 TO 2
101    FOR j = i + 1 TO 2
102      IF p(i).y > p(j).y THEN SWAP p(i), p(j)
103    NEXT
104  NEXT
105
106  ' Get projection & calculate triangle
107  CALC h(0), h(1), h(2), tri
108
109  ' Top -> Bottom. Get diff (C.x - A.x) / (C.y - A.y)
110  Ax = p(0).x
111  ACy = (p(2).y - p(0).y): IF ACy = 0 THEN ACy = 1
112  AC = (p(2).x - p(0).x) / ACy
113  ABz = h(1).z - h(0).z
114  ACz = h(2).z - h(0).z
115
116  FOR i = 0 TO 1
117
118    ' Get diff (B/C.x - A/B.x) / (B/B.y - A/B.y)
119    Bx = p(i).x
120    By = p(i + 1).y
121    ABy = By - p(i).y: IF ABy = 0 THEN ABy = 1
122    AB = (p(i + 1).x - p(i).x) / ABy
123
124    ' Y0..Y1-1; Y1..Y2
125    IF i = 0 THEN By = By - 1
126
127    ' Drawing lines
128    FOR y = p(i).y TO By
129
130      IF y >= 0 AND y <= 199 THEN
131
132        ' Row has been opened
133        th = 0
134
135        x1 = INT(Ax)
136        x2 = INT(Bx)
137        IF x1 > x2 THEN SWAP x1, x2
138
139        ' Show Only visible area
140        IF x1 < 320 AND x2 >= 0 THEN
141
142          ' Corrections
143          x1 = x1 - 2
144          x2 = x2 + 2
145
146          IF x1 < 0 THEN x1 = 0
147          IF x2 > 319 THEN x2 = 319
148
149          ' Start position
150          dx = x1 - 160
151          dy = 100 - y
152          dz = 100
153
154          ' Coord calc
155          u = dx * tri.A1 + dy * tri.A2 + dz * tri.A3
156          v = dx * tri.B1 + dy * tri.B2 + dz * tri.B3
157          D = dx * tri.C1 + dy * tri.C2 + dz * tri.C3
158
159          FOR x = x1 TO x2
160
161            ' Triangle visible
162            IF D <> 0 AND u >= 0 AND v >= 0 AND u + v < D THEN
163
164              ux = u / D
165              vx = v / D
166              cz = h(0).z + ux * ABz + vx * ACz
167
168              ' Open Row
169              IF th = 0 THEN
170
171                th = 1
172                DEF SEG = VARSEG(cb):    BLOAD "TMP\CX" + STR$(y) + ".BIN", VARPTR(cb):    DEF SEG
173                DEF SEG = VARSEG(db(0)): BLOAD "TMP\DX" + STR$(y) + ".BIN", VARPTR(db(0)): DEF SEG
174
175              END IF
176
177              ' Check depth buffer
178              IF cz < db(x) THEN
179
180                ' Texture coord and zcoord
181                tx = INT(h(0).u + ux * h(1).u + vx * h(2).u)
182                ty = INT(h(0).v + ux * h(1).v + vx * h(2).v)
183
184                ' Clamp
185                IF tx < 0 THEN tx = 0 ELSE IF tx > 15 THEN tx = 15
186                IF ty < 0 THEN ty = 0 ELSE IF ty > 15 THEN ty = 15
187
188                cl% = tile(tx, ty)
189
190                IF cl% <> 0 THEN
191
192                  ' PSET (x, y), cl%
193                  MID$(cb, 1 + x, 1) = CHR$(cl%)
194                  db(x) = cz
195
196                END IF
197
198              END IF
199
200            END IF
201
202            u = u + tri.A1
203            v = v + tri.B1
204            D = D + tri.C1
205
206          NEXT
207
208        END IF
209
210        ' Save to temporary line
211        IF th > 0 THEN
212          DEF SEG = VARSEG(cb):    BSAVE "TMP\CX" + STR$(y) + ".BIN", VARPTR(cb), 320:     DEF SEG
213          DEF SEG = VARSEG(db(0)): BSAVE "TMP\DX" + STR$(y) + ".BIN", VARPTR(db(0)), 1280: DEF SEG
214        END IF
215
216      END IF
217
218      Ax = Ax + AC
219      Bx = Bx + AB
220
221    NEXT
222
223  NEXT
224
225END SUB
226
227' Draw cube for x,y,z
228SUB DRAWCUBE(x AS SINGLE, y AS SINGLE, z AS SINGLE)
229
230  DIM p(0 TO 2) AS vec3
231
232  ' Load camera and set cube position
233  MATIDENT 0
234
235  ' Camera rotation
236  CAMROT rot.z, 2
237  CAMROT rot.x, 0
238  CAMROT rot.y, 1
239
240  ' Set cube position
241  CAMTRAN x - cam.x, y - cam.y, z - cam.z
242
243  RESTORE FACES
244
245  ' 6 Faces (0..5)
246  FOR i = 0 TO 5
247
248    READ f0, f1, f2, f3
249
250    ' Triangle 1
251    p(0) = vc(f0): p(0).u = 0:  p(0).v = 0
252    p(1) = vc(f1): p(1).u = 16: p(1).v = 0
253    p(2) = vc(f2): p(2).u = 16: p(2).v = 16
254    RENDER p(0), p(1), p(2)
255
256    ' Triangle 2
257    p(0) = vc(f0): p(0).u = 0:  p(0).v = 0
258    p(1) = vc(f2): p(1).u = 16: p(1).v = 16
259    p(2) = vc(f3): p(2).u = 0:  p(2).v = 16
260    RENDER p(0), p(1), p(2)
261
262  NEXT
263
264END SUB

1' Calculate parameters => tri
2SUB CALC (p0 AS vec3, p1 AS vec3, p2 AS vec3, t AS trg)
3
4  ' Coord triangle
5  Ax = p0.x: Ay = p0.y: Az = p0.z
6  Bx = p1.x: By = p1.y: Bz = p1.z
7  Cx = p2.x: Cy = p2.y: Cz = p2.z
8
9  ' Diff
10  ABx = Bx - Ax: ACx = Cx - Ax
11  ABy = By - Ay: ACy = Cy - Ay
12  ABz = Bz - Az: ACz = Cz - Az
13
14  ' u
15  t.A1 = (Ay * ACz - Az * ACy)
16  t.A2 = (Az * ACx - Ax * ACz)
17  t.A3 = (Ax * ACy - Ay * ACx)
18
19  ' v
20  t.B1 = (Az * ABy - Ay * ABz)
21  t.B2 = (Ax * ABz - Az * ABx)
22  t.B3 = (Ay * ABx - Ax * ABy)
23
24  ' D
25  t.C1 = (ABz * ACy - ABy * ACz)
26  t.C2 = (ABx * ACz - ABz * ACx)
27  t.C3 = (ABy * ACx - ABx * ACy)
28
29END SUB

Работа с матрицами.

1' a - angle, axis - 0-X,1-Y,2-Z
2SUB CAMROT (a AS SINGLE, axis AS INTEGER)
3
4  sina = SIN(a)
5  cosa = COS(a)
6
7  MATIDENT 1
8
9  SELECT CASE axis
10
11  CASE 0: ' X Axis
12
13    mb(1, 1) = cosa: mb(1, 2) = -sina
14    mb(2, 1) = sina: mb(2, 2) = cosa
15
16  CASE 1: ' Y Axis
17
18    mb(0, 0) = cosa:  mb(0, 2) = sina
19    mb(2, 0) = -sina: mb(2, 2) = cosa
20
21  CASE 2: ' Z Axis
22
23    mb(0, 0) = cosa: mb(0, 1) = -sina
24    mb(1, 0) = sina: mb(1, 1) = cosa
25
26  END SELECT
27
28  MATMULT
29
30END SUB
31
32' B = <translate matrix>
33SUB CAMTRAN (x AS SINGLE, y AS SINGLE, z AS SINGLE)
34
35  MATIDENT 1
36
37  mb(0, 3) = x
38  mb(1, 3) = y
39  mb(2, 3) = z
40
41  MATMULT
42
43END SUB
44
45' A=1, B=1 OR C=1
46SUB MATIDENT (id AS INTEGER)
47
48  FOR i = 0 TO 3
49  FOR j = 0 TO 3
50
51    SELECT CASE id
52    CASE 0: IF i = j THEN ma(i, j) = 1 ELSE ma(i, j) = 0
53    CASE 1: IF i = j THEN mb(i, j) = 1 ELSE mb(i, j) = 0
54    END SELECT
55
56  NEXT
57  NEXT
58
59END SUB
60
61' A = A x B
62SUB MATMULT
63
64  DIM mt(0 TO 3, 0 TO 3) AS SINGLE
65
66  ' Mult
67  FOR i = 0 TO 3
68  FOR j = 0 TO 3
69
70    s = 0
71    FOR k = 0 TO 3: s = s + ma(i, k) * mb(k, j): NEXT
72    mt(i, j) = s
73
74  NEXT
75  NEXT
76
77  ' Copy result to A
78  FOR i = 0 TO 3
79  FOR j = 0 TO 3
80    ma(i, j) = mt(i, j)
81  NEXT
82  NEXT
83
84END SUB

Очистка буфера, загрузка и выгрузка.

1' Clear Color/ZBuf
2SUB CLEARBUF
3
4  DIM cb AS STRING * 320
5  DIM db(0 TO 319) AS SINGLE
6
7  FOR i = 0 TO 319
8
9    cb = cb + CHR$(0)
10    db(i) = 32767
11
12  NEXT
13
14  FOR i = 0 TO 199
15
16    DEF SEG = VARSEG(cb): BSAVE "TMP\CX" + STR$(i) + ".BIN", VARPTR(cb), 320: DEF SEG
17    DEF SEG = VARSEG(db(0)): BSAVE "TMP\DX" + STR$(i) + ".BIN", VARPTR(db(0)), 1280: DEF SEG
18
19  NEXT
20
21END SUB
22
23' Draw buffer on screen
24SUB RESTOREBUF
25
26  DIM cb AS STRING * 320
27  FOR y = 0 TO 199
28    DEF SEG = &HA000
29    BLOAD "TMP\CX" + STR$(y) + ".BIN", 320 * y
30    DEF SEG
31  NEXT
32
33END SUB

Загрузка тайлов Minecraft в память из BMP.

1' Read palette for DAC
2SUB LOADPALETTE
3
4DIM pal AS STRING * 3
5
6OPEN "CRAFT.BMP" FOR BINARY AS #1
7
8FOR i = 1 TO 255
9
10  GET #1, &H36 + 1 + i * 4, pal
11  OUT 968, i
12  OUT 969, ASC(MID$(pal, 3, 1)) \ 4
13  OUT 969, ASC(MID$(pal, 2, 1)) \ 4
14  OUT 969, ASC(MID$(pal, 1, 1)) \ 4
15
16NEXT i
17
18CLOSE #1
19
20END SUB
21
22' Load Tile 16x16 Into The DIM
23SUB LOADTILE (j AS INTEGER, i AS INTEGER)
24
25DIM dat AS STRING * 16
26
27OPEN "CRAFT.BMP" FOR BINARY AS #1
28FOR y = 0 TO 15
29
30  GET #1, &H437 + (255 - 16 * i - y) * 256 + 16 * j, dat
31  FOR x = 0 TO 15: tile(x, y) = ASC(MID$(dat, 1 + x, 1)): NEXT
32
33NEXT
34CLOSE #1
35
36END SUB