{ ROTACIA_KOCKY.PAS } { Jednoducha 3D rotacia kocky s jednoduchym vyhladzovanim hran } { (antialiasingom) a tienovanim. Ovladanie pomocou klavesnice. } { } { Author: Unknown } { Datum: 23.02.2009 http://www.trsek.com } program ROTACIA_KOCKY; uses Crt; type bod = record x,y,z:real; end; stena = record a,b,c,d: integer; poradie: integer; max_y,min_y:real; privratena:boolean; end; TBitmap = array [0..199,0..319] of byte; var screen: TBitmap absolute $A000:0; { priamy pristup do pamate grafickej karty } pocetVrcholov, pocetHran, pocetStien: integer; vrcholy: array [1..100] of bod; steny: array [1..100] of stena; side: array[0..3] of integer; { pole, kde sa ukladaju pozicie bocnych stien } buf: array[0..3,0..1279] of byte; { jeden riadok obrazovky (320x1) ale 4x vacsi } y_pos: integer; { ktory riadok sa momentalne spracovava } { Nastavi farbu c na RGB hodnotu } procedure SET_COLOR(r,g,b,c:byte); begin port[$3C8]:=c; port[$3C9]:=r; port[$3C9]:=g; port[$3C9]:=b; end; { Vykresli riadok y na obrazovku tak, ze spriemeruje 4x4 pixely z pola buf } procedure VYKRESLI(y:integer); var x:integer; i,j:integer; s:integer; begin for x:=0 to 319 do begin s:=0; for i:=0 to 3 do for j:=0 to 3 do begin s:=s+buf[j,(x SHL 2)+i]; { x SHL 2 je vlastne x*4 ale rychlejsie } end; screen[y,x]:=s SHR 4; { s div 16 } end; end; procedure MODE(mode: byte); begin ASM mov ah,0 mov al,mode int $10 end; end; { procedure POINT(x,y:word; f:byte); begin inc(x,640); inc(y,400); if (x<0)or(y=1280)or(y>=y_pos+4) then exit; buf[(y-y_pos),x]:=f; end; } { Vzdy kreslime iba jeden riadok skutocnej obrazovky, to su 4 riadky virtualnej 4x vacsej. Preto pole side a aj pole buf ma vysku iba 4 } { Nastavi okrajovu tabulku na default hodnoty } procedure CLEAR_SIDE; begin side[0]:=-1; side[1]:=-1; side[2]:=-1; side[3]:=-1; end; { Vykresli okraj strany. Ak uz je to druha cast, tak ju spoji ciarou s predchadzajucou } procedure POINT2(x,y:word; f:byte); var x1,x2:integer; begin inc(x,640); inc(y,400); if (x<0)or(y=1280)or(y>y_pos+3) then exit; dec(y,y_pos); if(side[y]>=0) then begin x1:=x; x2:=side[y]; if(x2y_pos+3)and(y2+400>y_pos+3) then exit; vymena:=false; if abs(y2-y1) > abs(x2-x1) then begin vymena:=true; pom:=x1; x1:=y1; y1:=pom; pom:=x2; x2:=y2; y2:=pom; end; if x2 0 then begin p:= p + DP2; y1:= y1 + krok; end else p:= p + DP1; inc(x1); end; end; } procedure USECKA2(x1,y1,x2,y2:integer; f:byte); var dx, dy, P, DP1, DP2, krok, pom, x, y: integer; vymena: boolean; begin { Ak je usecka mimo momentalne vykreslovaneho riadku, tak ihned skonci } if(y1+400y_pos+3)and(y2+400>y_pos+3) then exit; vymena:=false; if abs(y2-y1) > abs(x2-x1) then begin vymena:=true; pom:=x1; x1:=y1; y1:=pom; pom:=x2; x2:=y2; y2:=pom; end; if x2 0 then begin p:= p + DP2; y1:= y1 + krok; end else p:= p + DP1; inc(x1); end; end; procedure NACITANIE; var f: text; i:integer; begin assign(f,'vstup.txt'); reset(f); readln(f,pocetVrcholov); for i:=1 to pocetVrcholov do begin read(f,vrcholy[i].x); read(f,vrcholy[i].y); readln(f,vrcholy[i].z); vrcholy[i].x:=vrcholy[i].x*6; vrcholy[i].y:=vrcholy[i].y*6; vrcholy[i].z:=vrcholy[i].z*6; end; readln(f,pocetStien); for i:= 1 to pocetStien do begin read(f,steny[i].a); read(f,steny[i].b); read(f,steny[i].c); readln(f,steny[i].d); steny[i].poradie:=i; end; close(f); end; procedure POSUNUTIE(posun: integer; smer: char); var i:integer; begin for i:=1 to pocetVrcholov do begin case smer of 'l': vrcholy[i].x:= vrcholy[i].x - posun; 'r': vrcholy[i].x:= vrcholy[i].x + posun; 'u': vrcholy[i].y:= vrcholy[i].y - posun; 'd': vrcholy[i].y:= vrcholy[i].y + posun; '+': begin vrcholy[i].x:= vrcholy[i].x * 1.01; vrcholy[i].y:= vrcholy[i].y * 1.01; vrcholy[i].z:= vrcholy[i].z * 1.01; end; '-': begin vrcholy[i].x:= vrcholy[i].x / 1.01; vrcholy[i].y:= vrcholy[i].y / 1.01; vrcholy[i].z:= vrcholy[i].z / 1.01; end; end; end; end; { procedure VYPLN(i: integer); var x: array[0..3] of integer; y: array[0..3] of integer; pom, k, kk: integer; k12, k32, k34, k14: real; xxx1,xxx2: real; begin x[0]:= round(vrcholy[steny[i].a].x); y[0]:= round(vrcholy[steny[i].a].y); x[1]:= round(vrcholy[steny[i].b].x); y[1]:= round(vrcholy[steny[i].b].y); x[2]:= round(vrcholy[steny[i].c].x); y[2]:= round(vrcholy[steny[i].c].y); x[3]:= round(vrcholy[steny[i].d].x); y[3]:= round(vrcholy[steny[i].d].y); maxY:= y[0]; kk:= 0; for k:= 1 to 3 do begin if y[k] > maxY then begin pom:= y[k]; y[k]:= maxY; maxY:= pom; kk:= k; end; end; if y[(kk+1) mod 4] > y[(kk-1) mod 4] then begin pom:= y[(kk+1) mod 4]; y[(kk+1) mod 4]:= y[(kk-1) mod 4]; y[(kk-1) mod 4]:= pom; pom:= x[(kk+1) mod 4]; x[(kk+1) mod 4]:= x[(kk-1) mod 4]; x[(kk-1) mod 4]:= pom; end; yy2:= y[kk]; xx2:= x[kk]; yy3:= y[(kk+1) mod 4]; xx3:= x[(kk+1) mod 4]; yy1:= y[(kk-1) mod 4]; xx1:= x[(kk-1) mod 4]; yy4:= y[(kk+2) mod 4]; xx4:= x[(kk+2) mod 4]; if (yy3 - yy2) = 0 then k32:= 0 else k32:= (xx3 - xx2) / (yy3 - yy2); if (yy1 - yy2) = 0 then k12:= 0 else k12:= (xx1 - xx2) / (yy1 - yy2); if (yy3 - yy4) = 0 then k34:= 0 else k34:= (xx3 - xx4) / (yy3 - yy4); if (yy1 - yy4) = 0 then k14:= 0 else k14:= (xx1 - xx4) / (yy1 - yy4); xxx1:= xx2; xxx2:= xx2; for y:= yy2 downto y3 do begin USECKA(round(xxx1),y,round(xxx2),y,7); xxx1:= xxx1 + k32; xxx2:= xxx2 + k12; end; end; } procedure ROTACIA(uhol: real; os: char); var v_x, v_y, v_z: real; {vrcholy} c,s:real; i:integer; begin uhol:= (uhol*Pi) / 180; c:=cos(uhol); s:=sin(uhol); for i:= 1 to pocetVrcholov do begin v_x:= vrcholy[i].x; v_y:= vrcholy[i].y; v_z:= vrcholy[i].z; case os of 'x': begin vrcholy[i].x:= v_x; vrcholy[i].y:= c*v_y - s*v_z; vrcholy[i].z:= s*v_y + c*v_z; end; 'y': begin vrcholy[i].x:= c*v_x + s*v_z; vrcholy[i].y:= v_y; vrcholy[i].z:= - s*v_x + c*v_z; end; 'z': begin vrcholy[i].x:= c*v_x - s*v_y; vrcholy[i].y:= s*v_x + c*v_y; vrcholy[i].z:= v_z; end; end; end; end; function NORMALA_Z(a,b,c:bod):real; var u,v,n: bod; begin u.x:= a.x - b.x; u.y:= a.y - b.y; u.z:= a.z - b.z; v.x:= b.x - c.x; v.y:= b.y - c.y; v.z:= b.z - c.z; n.x:= u.y * v.z - u.z * v.y; n.y:= u.z * v.x - u.x * v.z; NORMALA_Z:= u.x * v.y - u.y * v.x; end; { Vrati hodnotu normaly, ale normovanu, aby sa dala pouzit na farbu } function NORMALA_Z2(a,b,c:bod):real; var u,v,n: bod; begin u.x:= a.x - b.x; u.y:= a.y - b.y; u.z:= a.z - b.z; v.x:= b.x - c.x; v.y:= b.y - c.y; v.z:= b.z - c.z; n.x:= u.y * v.z - u.z * v.y; n.y:= u.z * v.x - u.x * v.z; n.z:= u.x * v.y - u.y * v.x; NORMALA_Z2:= n.z*23/sqrt(n.z*n.z+n.x*n.x+n.y*n.y); end; function PRIVRATENA(s:integer): boolean; begin if NORMALA_Z(vrcholy[steny[s].a], vrcholy[steny[s].b], vrcholy[steny[s].c]) > 0 then PRIVRATENA:= true else PRIVRATENA:= false; end; { Urci farbu steny podla hodnoty uhla normaly } function FARBA_STENY(s:integer):byte; var r:real; begin r:=NORMALA_Z2(vrcholy[steny[s].a],vrcholy[steny[s].b],vrcholy[steny[s].c]); FARBA_STENY:=trunc(r)+40; end; procedure VYKRESLI_STENY(i:integer); var farba:byte; begin farba:=FARBA_STENY(steny[i].poradie); { spocitanie farby } CLEAR_SIDE; USECKA2(round(vrcholy[steny[i].a].x), round(vrcholy[steny[i].a].y), round(vrcholy[steny[i].b].x), round(vrcholy[steny[i].b].y),farba); USECKA2(round(vrcholy[steny[i].b].x), round(vrcholy[steny[i].b].y), round(vrcholy[steny[i].c].x), round(vrcholy[steny[i].c].y),farba); USECKA2(round(vrcholy[steny[i].c].x), round(vrcholy[steny[i].c].y), round(vrcholy[steny[i].d].x), round(vrcholy[steny[i].d].y),farba); USECKA2(round(vrcholy[steny[i].d].x), round(vrcholy[steny[i].d].y), round(vrcholy[steny[i].a].x), round(vrcholy[steny[i].a].y),farba); end; { Postupne po jednom riadku kresli celu scenu. Je to sice trochu pomale, ale zato ovela jednoduchsie a efektivnejsie ako Jozove riesenie antialiasingu, kedze sa to cele vojde do zakladnej pamate a netreba ziadne strankovanie. Mal som v plane este trosku optimalizovat RENDERUJ, no uz som to nestihol :_( } procedure RENDERUJ; var y,i:integer; min,max:real; begin { Kontrolu privratenosti strany som premiestnil sem. Spolu s tym si pre kazdu stenu vypocitam jej maximalne a minimalne y } for i:=1 to pocetStien do begin if PRIVRATENA(steny[i].poradie) then begin steny[i].privratena:=true; min:=vrcholy[steny[i].a].y; max:=vrcholy[steny[i].a].y; if(min>vrcholy[steny[i].b].y) then min:=vrcholy[steny[i].b].y; if(min>vrcholy[steny[i].c].y) then min:=vrcholy[steny[i].c].y; if(min>vrcholy[steny[i].d].y) then min:=vrcholy[steny[i].d].y; if(max=y_pos) then VYKRESLI_STENY(i); end; { V skutocnosti si do pamate nekreslim jeden riadok, ale obrazok 4x vacsi. Procedure VYKRESLI teraz spracuje ten jeden 4x vacsi obrazok a zmensi ho tak, ze vzdy spriemeruje 4x4 pixely. Toto je vlastne antialiasing. } VYKRESLI(y); end; end; var i:integer; klav: char; {klavesa} begin NACITANIE; MODE($13); for i:=1 to 63 do begin SET_COLOR(i,i,i,i); end; RENDERUJ; klav:= readkey; while klav <> 'p' do begin case klav of 'a': begin ROTACIA(2,'x'); end; 's': begin ROTACIA(2,'y'); end; 'd': begin ROTACIA(2,'z'); end; 'q': begin ROTACIA(-2,'x'); end; 'w': begin ROTACIA(-2,'y'); end; 'e': begin ROTACIA(-2,'z'); end; 'j': begin POSUNUTIE(3,'l'); end; 'l': begin POSUNUTIE(3,'r'); end; 'i': begin POSUNUTIE(3,'u'); end; 'k': begin POSUNUTIE(3,'d'); end; 'm': begin POSUNUTIE(3,'+'); end; 'n': begin POSUNUTIE(3,'-'); end; end; RENDERUJ; klav:= readkey; end; MODE($03); end. { Prepac, viac som nestihol. Snad Ti aj toto trosku pomoze. }