Оглавление
- Описание
- Основная программа
- Основная процедура рисования треугольников
- Калькулятор параметров
- Работа с матрицами
- Очистка буфера, загрузка и выгрузка
- Загрузка тайлов Minecraft в память из BMP
§ Описание
Когда-то я очень хотел создать трехмерную графику на Бейсике, и вот спустя много лет, наконец-то, взялся за дело и сделал это. Но и не только. Помимо самой графики, также научился использовать буфер для того, чтобы рисовать сначала в нем, а потом показывать на экране. Это нерационально, но все-таки, это работает.
Скриншот экрана окна Бейсика. А также можно скачать CRAFT.BMP, для источника данных.
§ Основная программа
SCREEN 13 CONST NEAR = 0.5 TYPE vec2i x AS INTEGER y AS INTEGER END TYPE TYPE vec3 x AS SINGLE y AS SINGLE z AS SINGLE u AS SINGLE v AS SINGLE END TYPE TYPE trg A1 AS SINGLE: A2 AS SINGLE: A3 AS SINGLE B1 AS SINGLE: B2 AS SINGLE: B3 AS SINGLE C1 AS SINGLE: C2 AS SINGLE: C3 AS SINGLE D1 AS SINGLE: D2 AS SINGLE: D3 AS SINGLE END TYPE ' Point list for triangle DIM SHARED vc(0 TO 7) AS vec3 DIM SHARED tile(0 TO 15, 0 TO 15) AS INTEGER ' Matrix operation (ma - camera, mb - operation) DIM SHARED ma(0 TO 3, 0 TO 3) AS SINGLE DIM SHARED mb(0 TO 3, 0 TO 3) AS SINGLE DIM SHARED cam AS vec3 DIM SHARED rot AS vec3 DIM wr(0 TO 3, 0 TO 3, 0 TO 3) AS INTEGER ' Vertex (4 back, 4 front) DATA -1, 1, 1 DATA 1, 1, 1 DATA 1,-1, 1 DATA -1,-1, 1 DATA -1, 1,-1 DATA 1, 1,-1 DATA 1,-1,-1 DATA -1,-1,-1 FACES: ' Quads faces a,b,c,d|tex DATA 0, 4, 7, 3 DATA 0, 1, 5, 4 DATA 4, 5, 6, 7 DATA 1, 0, 3, 2 DATA 2, 3, 7, 6 DATA 5, 1, 2, 6 ' Read all vertexes FOR i = 0 TO 7: READ vc(i).x, vc(i).y, vc(i).z: NEXT ' Sprites LOADPALETTE ' Loading Palette from CRAFT.BMP ' Camera position cam.x = 1.5: cam.y = 3: cam.z = -4 rot.x = 0: rot.y = 0: rot.z = 0 ' World definition wr(0,0,3)=1 wr(0,0,2)=2 wr(0,0,1)=3 wr(0,0,0)=4 wr(2,2,0)=1 wr(2,1,2)=2 CLEARBUF FOR k = 0 TO 3 FOR i = 0 TO 3 FOR j = 0 TO 3 t = wr(j, i, k) IF t > 0 THEN LOADTILE t MOD 16, t \ 16 DRAWCUBE 2*j, 2*i, 2*k END IF NEXT NEXT NEXT RESTOREBUF
§ Основная процедура рисования треугольников
' Draw 1 or 2 Triangle SUB RENDER (p0 AS vec3, p1 AS vec3, p2 AS vec3) DIM q(0 TO 2) AS vec3 DIM p(0 TO 3) AS vec3 q(0) = p0: q(1) = p1: q(2) = p2 DIM a AS vec3 DIM b AS vec3 DIM c AS vec3 DIM k AS INTEGER k = 0 ' Apply camera transform FOR i = 0 TO 2 ' Camera transform qx = q(i).x * ma(0, 0) + q(i).y * ma(0, 1) + q(i).z * ma(0, 2) + ma(0, 3) qy = q(i).x * ma(1, 0) + q(i).y * ma(1, 1) + q(i).z * ma(1, 2) + ma(1, 3) qz = q(i).x * ma(2, 0) + q(i).y * ma(2, 1) + q(i).z * ma(2, 2) + ma(2, 3) ' Copy new result q(i).x = qx: q(i).y = qy: q(i).z = qz NEXT ' Search clipping FOR i = 0 TO 2 a = q(i) b = q((i + 1) MOD 3) ' One point in front of NEAR IF a.z >= NEAR OR b.z >= NEAR THEN ' Add visible point IF a.z >= NEAR THEN p(k) = a: k = k + 1 ' a.z must be >= b.z IF (a.z < b.z) THEN SWAP a, b ' Different sides, calc intermediate point IF (a.z >= NEAR AND b.z < NEAR) THEN t = (NEAR - b.z) / (a.z - b.z) c.x = b.x + t * (a.x - b.x) c.y = b.y + t * (a.y - b.y) c.z = NEAR c.u = b.u + t * (a.u - b.u) c.v = b.v + t * (a.v - b.v) p(k) = c: k = k + 1 END IF END IF NEXT IF k = 3 OR k = 4 THEN DRAWTRI p(0), p(1), p(2) IF k = 4 THEN DRAWTRI p(0), p(2), p(3) END SUB ' Drawing triangle SUB DRAWTRI (a AS vec3, b AS vec3, c AS vec3) ' Declare dimension DIM p(0 TO 2) AS vec2i DIM h(0 TO 2) AS vec3 DIM tri AS trg DIM cb AS STRING * 320 DIM db(0 TO 319) AS SINGLE ' Copy data h(0) = a: h(1) = b: h(2) = c ' Make UV-diff FOR i = 1 TO 2 h(i).u = h(i).u - h(0).u h(i).v = h(i).v - h(0).v NEXT ' Projection FOR i = 0 TO 2 p(i).x = 160 + 100 * h(i).x / h(i).z p(i).y = 100 - 100 * h(i).y / h(i).z NEXT ' Check front side ABx = p(1).x - p(0).x: ABy = p(1).y - p(0).y ACx = p(2).x - p(0).x: ACy = p(2).y - p(0).y IF ABy * ACx - ABx * ACy > 0 THEN EXIT SUB ' Sorting FOR i = 0 TO 2 FOR j = i + 1 TO 2 IF p(i).y > p(j).y THEN SWAP p(i), p(j) NEXT NEXT ' Get projection & calculate triangle CALC h(0), h(1), h(2), tri ' Top -> Bottom. Get diff (C.x - A.x) / (C.y - A.y) Ax = p(0).x ACy = (p(2).y - p(0).y): IF ACy = 0 THEN ACy = 1 AC = (p(2).x - p(0).x) / ACy ABz = h(1).z - h(0).z ACz = h(2).z - h(0).z FOR i = 0 TO 1 ' Get diff (B/C.x - A/B.x) / (B/B.y - A/B.y) Bx = p(i).x By = p(i + 1).y ABy = By - p(i).y: IF ABy = 0 THEN ABy = 1 AB = (p(i + 1).x - p(i).x) / ABy ' Y0..Y1-1; Y1..Y2 IF i = 0 THEN By = By - 1 ' Drawing lines FOR y = p(i).y TO By IF y >= 0 AND y <= 199 THEN ' Row has been opened th = 0 x1 = INT(Ax) x2 = INT(Bx) IF x1 > x2 THEN SWAP x1, x2 ' Show Only visible area IF x1 < 320 AND x2 >= 0 THEN ' Corrections x1 = x1 - 2 x2 = x2 + 2 IF x1 < 0 THEN x1 = 0 IF x2 > 319 THEN x2 = 319 ' Start position dx = x1 - 160 dy = 100 - y dz = 100 ' Coord calc u = dx * tri.A1 + dy * tri.A2 + dz * tri.A3 v = dx * tri.B1 + dy * tri.B2 + dz * tri.B3 D = dx * tri.C1 + dy * tri.C2 + dz * tri.C3 FOR x = x1 TO x2 ' Triangle visible IF D <> 0 AND u >= 0 AND v >= 0 AND u + v < D THEN ux = u / D vx = v / D cz = h(0).z + ux * ABz + vx * ACz ' Open Row IF th = 0 THEN th = 1 DEF SEG = VARSEG(cb): BLOAD "TMP\CX" + STR$(y) + ".BIN", VARPTR(cb): DEF SEG DEF SEG = VARSEG(db(0)): BLOAD "TMP\DX" + STR$(y) + ".BIN", VARPTR(db(0)): DEF SEG END IF ' Check depth buffer IF cz < db(x) THEN ' Texture coord and zcoord tx = INT(h(0).u + ux * h(1).u + vx * h(2).u) ty = INT(h(0).v + ux * h(1).v + vx * h(2).v) ' Clamp IF tx < 0 THEN tx = 0 ELSE IF tx > 15 THEN tx = 15 IF ty < 0 THEN ty = 0 ELSE IF ty > 15 THEN ty = 15 cl% = tile(tx, ty) IF cl% <> 0 THEN ' PSET (x, y), cl% MID$(cb, 1 + x, 1) = CHR$(cl%) db(x) = cz END IF END IF END IF u = u + tri.A1 v = v + tri.B1 D = D + tri.C1 NEXT END IF ' Save to temporary line IF th > 0 THEN DEF SEG = VARSEG(cb): BSAVE "TMP\CX" + STR$(y) + ".BIN", VARPTR(cb), 320: DEF SEG DEF SEG = VARSEG(db(0)): BSAVE "TMP\DX" + STR$(y) + ".BIN", VARPTR(db(0)), 1280: DEF SEG END IF END IF Ax = Ax + AC Bx = Bx + AB NEXT NEXT END SUB ' Draw cube for x,y,z SUB DRAWCUBE(x AS SINGLE, y AS SINGLE, z AS SINGLE) DIM p(0 TO 2) AS vec3 ' Load camera and set cube position MATIDENT 0 ' Camera rotation CAMROT rot.z, 2 CAMROT rot.x, 0 CAMROT rot.y, 1 ' Set cube position CAMTRAN x - cam.x, y - cam.y, z - cam.z RESTORE FACES ' 6 Faces (0..5) FOR i = 0 TO 5 READ f0, f1, f2, f3 ' Triangle 1 p(0) = vc(f0): p(0).u = 0: p(0).v = 0 p(1) = vc(f1): p(1).u = 16: p(1).v = 0 p(2) = vc(f2): p(2).u = 16: p(2).v = 16 RENDER p(0), p(1), p(2) ' Triangle 2 p(0) = vc(f0): p(0).u = 0: p(0).v = 0 p(1) = vc(f2): p(1).u = 16: p(1).v = 16 p(2) = vc(f3): p(2).u = 0: p(2).v = 16 RENDER p(0), p(1), p(2) NEXT END SUB
§ Калькулятор параметров
' Calculate parameters => tri SUB CALC (p0 AS vec3, p1 AS vec3, p2 AS vec3, t AS trg) ' Coord triangle Ax = p0.x: Ay = p0.y: Az = p0.z Bx = p1.x: By = p1.y: Bz = p1.z Cx = p2.x: Cy = p2.y: Cz = p2.z ' Diff ABx = Bx - Ax: ACx = Cx - Ax ABy = By - Ay: ACy = Cy - Ay ABz = Bz - Az: ACz = Cz - Az ' u t.A1 = (Ay * ACz - Az * ACy) t.A2 = (Az * ACx - Ax * ACz) t.A3 = (Ax * ACy - Ay * ACx) ' v t.B1 = (Az * ABy - Ay * ABz) t.B2 = (Ax * ABz - Az * ABx) t.B3 = (Ay * ABx - Ax * ABy) ' D t.C1 = (ABz * ACy - ABy * ACz) t.C2 = (ABx * ACz - ABz * ACx) t.C3 = (ABy * ACx - ABx * ACy) END SUB
§ Работа с матрицами
' a - angle, axis - 0-X,1-Y,2-Z SUB CAMROT (a AS SINGLE, axis AS INTEGER) sina = SIN(a) cosa = COS(a) MATIDENT 1 SELECT CASE axis CASE 0: ' X Axis mb(1, 1) = cosa: mb(1, 2) = -sina mb(2, 1) = sina: mb(2, 2) = cosa CASE 1: ' Y Axis mb(0, 0) = cosa: mb(0, 2) = sina mb(2, 0) = -sina: mb(2, 2) = cosa CASE 2: ' Z Axis mb(0, 0) = cosa: mb(0, 1) = -sina mb(1, 0) = sina: mb(1, 1) = cosa END SELECT MATMULT END SUB ' B = <translate matrix> SUB CAMTRAN (x AS SINGLE, y AS SINGLE, z AS SINGLE) MATIDENT 1 mb(0, 3) = x mb(1, 3) = y mb(2, 3) = z MATMULT END SUB ' A=1, B=1 OR C=1 SUB MATIDENT (id AS INTEGER) FOR i = 0 TO 3 FOR j = 0 TO 3 SELECT CASE id CASE 0: IF i = j THEN ma(i, j) = 1 ELSE ma(i, j) = 0 CASE 1: IF i = j THEN mb(i, j) = 1 ELSE mb(i, j) = 0 END SELECT NEXT NEXT END SUB ' A = A x B SUB MATMULT DIM mt(0 TO 3, 0 TO 3) AS SINGLE ' Mult FOR i = 0 TO 3 FOR j = 0 TO 3 s = 0 FOR k = 0 TO 3: s = s + ma(i, k) * mb(k, j): NEXT mt(i, j) = s NEXT NEXT ' Copy result to A FOR i = 0 TO 3: FOR j = 0 TO 3: ma(i, j) = mt(i, j): NEXT: NEXT END SUB
§ Очистка буфера, загрузка и выгрузка
' Clear Color/ZBuf SUB CLEARBUF DIM cb AS STRING * 320 DIM db(0 TO 319) AS SINGLE FOR i = 0 TO 319 cb = cb + CHR$(0) db(i) = 32767 NEXT FOR i = 0 TO 199 DEF SEG = VARSEG(cb): BSAVE "TMP\CX" + STR$(i) + ".BIN", VARPTR(cb), 320: DEF SEG DEF SEG = VARSEG(db(0)): BSAVE "TMP\DX" + STR$(i) + ".BIN", VARPTR(db(0)), 1280: DEF SEG NEXT END SUB ' Draw buffer on screen SUB RESTOREBUF DIM cb AS STRING * 320 FOR y = 0 TO 199 DEF SEG = &HA000 BLOAD "TMP\CX" + STR$(y) + ".BIN", 320 * y DEF SEG NEXT END SUB
§ Загрузка тайлов Minecraft в память из BMP
' Read palette for DAC SUB LOADPALETTE DIM pal AS STRING * 3 OPEN "CRAFT.BMP" FOR BINARY AS #1 FOR i = 1 TO 255 GET #1, &H36 + 1 + i * 4, pal OUT 968, i OUT 969, ASC(MID$(pal, 3, 1)) \ 4 OUT 969, ASC(MID$(pal, 2, 1)) \ 4 OUT 969, ASC(MID$(pal, 1, 1)) \ 4 NEXT i CLOSE #1 END SUB ' Load Tile 16x16 Into The DIM SUB LOADTILE (j AS INTEGER, i AS INTEGER) DIM dat AS STRING * 16 OPEN "CRAFT.BMP" FOR BINARY AS #1 FOR y = 0 TO 15 GET #1, &H437 + (255 - 16 * i - y) * 256 + 16 * j, dat FOR x = 0 TO 15: tile(x, y) = ASC(MID$(dat, 1 + x, 1)): NEXT NEXT CLOSE #1 END SUB