{$A+,B-,D+,E-,F-,G+,I+,L+,N+,O+,P-,Q+,R+,S+,T+,V+,X+,Y+} {$M 16384,0,655360} { Please, Go through the code, and optimize. There is a frame counter so.. If something is wrong plase correct it. If you change something, please preserve the former code as a comment. Please Email me the changed code ASAP on: stratil@feniz.cz -you may add anything, you thing to be interresting Thanks, Pavel } { Below the code is an other file, you need for running this } type VirtualArray = array[1..64000] of byte; VPointer = ^VirtualArray; var define : array [ 1..255 ] of record {used by pallette setup} color:byte; shading:byte; end; base : array [ 1..500 ] of record {non rotated coords} x,y,z:integer; end; rpoint : array [ 1..500 ] of record {rotated/2d transformed coords} rx,ry,rz:single; px,py:integer; end; poly : array [ 1..500 ] of record {selection of points for triangle} p1,p2,p3:word; end; normal : array [ 1..500 ] of record { normalized normals non rotated} x,y,z:single; end; rnormal : array [ 1..500 ] of record { norm. normals rotated } x,y,z:single; end; rvertex : array [ 1..500 ] of record { rotated vertexes for points } x,y,z:single; end; vmul : array [ 1..500 ] of single; sinb : array [ 0..255 ] of single; cosb : array [ 0..255 ] of single; cbound : array [0..255] of record lower,mul:byte; end; lx,ly,lz:single; lalfa,lbeta,lgama:byte; polycount,pointcount:word; origox,origoy,dist:integer; singles : array [1..10] of single; function KeyPressed:boolean; begin asm mov ah,1 int 16h jnz @true mov [@result],false jmp @end @true: mov [@result],true @end: end; end; function ReadKey:char;assembler; asm mov ah,0h int 16h end; {virtual screen} function VSetup(VScreen:VPointer):word; begin new(Vscreen); VSetup:=seg(vscreen^); end; procedure VDispose(Va:word); var vscreen:pointer absolute va; begin dispose(Vscreen); end; {pregenerate} procedure psinb; var w:byte; begin for w:=0 to 255 do sinb[w]:=sin(w*pi/128); end; procedure pcosb; var w:byte; begin for w:=0 to 255 do cosb[w]:=cos(w*pi/128); end; procedure SetRGB(color,r,g,b:Byte);assembler; asm mov dx,3c8h mov al,[Color] out dx,al inc dx mov al,[r] out dx,al mov al,[g] out dx,al mov al,[b] out dx,al end; { load coords from file} procedure LoadCoords(filename:string); var s1,s2,s3:string; souradnice,i,i1,i2,i3,i4:integer; soubor:text; label MainLoop; begin assign(soubor,filename); reset(soubor); readln(soubor,pointcount); readln(soubor,polycount); MainLoop: readln(soubor,s1); readln(soubor,s1); i:=0; s2:=''; repeat inc(i); s3:=copy(s1,i,1); if s3=',' then s3:=''; s2:=s2+s3; until s3=''; val(s2,i1,i2); s2:=''; repeat inc(i); s3:=copy(s1,i,1); if s3='' then s3:=''; s2:=s2+s3; until s3=''; val(s2,i4,i2); i:=0; repeat inc(i); readln(soubor,s1); i2:=0; s2:=''; repeat inc(i2); s3:=copy(s1,i2,1); if s3='=' then s3:=''; s2:=s2+s3; until s3=''; val(s2,souradnice,i3); s2:=''; repeat inc(i2); s3:=copy(s1,i2,1); if s3=',' then s3:=''; s2:=s2+s3; until s3=''; val(s2,base[souradnice].x,i3); s2:=''; repeat inc(i2); s3:=copy(s1,i2,1); if s3=',' then s3:=''; s2:=s2+s3; until s3=''; val(s2,base[souradnice].y,i3); s2:=''; repeat inc(i2); s3:=copy(s1,i2,1); if s3='' then s3:=''; s2:=s2+s3; until s3=''; val(s2,base[souradnice].z,i3); until i=i1; readln(soubor,s1); i:=0; repeat inc(i); readln(soubor,s1); i2:=0; s2:=''; repeat inc(i2); s3:=copy(s1,i2,1); if s3='=' then s3:=''; s2:=s2+s3; until s3=''; val(s2,souradnice,i3); s2:=''; repeat inc(i2); s3:=copy(s1,i2,1); if s3=',' then s3:=''; s2:=s2+s3; until s3=''; val(s2,poly[souradnice].p1,i3); s2:=''; repeat inc(i2); s3:=copy(s1,i2,1); if s3=',' then s3:=''; s2:=s2+s3; until s3=''; val(s2,poly[souradnice].p2,i3); s2:=''; repeat inc(i2); s3:=copy(s1,i2,1); if s3='-' then s3:=''; s2:=s2+s3; until s3=''; val(s2,poly[souradnice].p3,i3); s2:=''; repeat inc(i2); s3:=copy(s1,i2,1); if s3='' then s3:=''; s2:=s2+s3; until s3=''; val(s2,define[souradnice].color,i3); until i=i4; readln(soubor,s1); if s1<>'' then goto MainLoop; close(soubor); end; procedure Flip(source,target:word);assembler; asm push ds mov ax,target mov es,ax mov ax,Source mov ds,ax xor si,si xor di,di mov cx,16000 db $f3,66h,$a5 pop ds end; procedure Cls(target:word);assembler; asm mov ax,[bp+offset target] mov es,ax xor di,di db 66h; xor ax,ax mov cx,16000 db 0f3h,66h,0abh end; procedure PPix(x,y: Integer;color:byte;target:word); assembler; asm mov ax,target mov es,ax mov ax,y mov di,ax shl ax,6 shl di,8 add di,ax add di,x mov al,color mov es:[di],al end; procedure xchgi(var x1,x2:integer); var z:integer; begin z:=x1; x1:=x2; x2:=z; end; procedure xchgb(var x1,x2:byte); var z:byte; begin z:=x1; x1:=x2; x2:=z; end; procedure Striangle(num,target:word); {simple - nonshaded triangle} var pcolor:byte; {visualization} x1,y1,x2,y2,x3,y3:integer; x,minY,mxaY,xa,xb,yy,p1,q1,p2,q2,p3,q3:integer; {triangle} begin if rnormal[num].z>0 then {is it visible?} begin begin pcolor:=define[num].color+cbound[define[num].color].lower; {choose the color} x1:=rpoint[poly[num].p1].px; {for simplicity} y1:=rpoint[poly[num].p1].py; x2:=rpoint[poly[num].p2].px; y2:=rpoint[poly[num].p2].py; x3:=rpoint[poly[num].p3].px; y3:=rpoint[poly[num].p3].py; end; {triangle} minY:=y1; mxaY:=y1; if y2mxaY then mxaY:=y2; if y3mxaY then mxaY:=y3; p1:=x1-x3; q1:=y1-y3; p2:=x2-x1; q2:=y2-y1; p3:=x3-x2; q3:=y3-y2; for yy:=minY to mxaY do begin xa:=320; xb:=-1; if (y3>=yy) or (y1>=yy) then if (y3<=yy) or (y1<=yy) then if not(y3=y1) then begin x:=(yy-y3)*p1 div q1+x3; if xxb then xb:=x; end; if (y1>=yy) or (y2>=yy) then if (y1<=yy) or (y2<=yy) then if not(y1=y2) then begin x:=(yy-y1)*p2 div q2+x1; if xxb then xb:=x; end; if (y2>=yy) or (y3>=yy) then if (y2<=yy) or (y3<=yy) then if not(y2=y3) then begin x:=(yy-y2)*p3 div q3+x2; if xxb then xb:=x; end; if xa<=xb then asm {horizontal line} mov ax,[target] mov es,ax mov ax,yy mov di,ax shl ax,8 shl di,6 add di,ax add di,xa mov al,pcolor mov ah,al mov cx,xb sub cx,xa inc cx shr cx,1 jnc @1 stosb @1: rep stosw end; end; end; end; procedure Ltriangle(num,target:word); { lambert - l. shaded triangle} var x1,y1,x2,y2,x3,y3:integer; {shading} pcolor:byte; dot:single; x,minY,mxaY,xa,xb,yy,p1,q1,p2,q2,p3,q3:integer; {triangle} begin if rnormal[num].z>0 then {visible?} begin begin {color} dot:=rnormal[num].x*lx+rnormal[num].y*ly+rnormal[num].z*lz; {normalized normal.light = nx*lx+xy*xy+xz*lz} dot:=dot*cbound[define[num].color].mul+cbound[define[num].color].lower; {choose color} pcolor:=round(dot); x1:=rpoint[poly[num].p1].px; {siplifying} y1:=rpoint[poly[num].p1].py; x2:=rpoint[poly[num].p2].px; y2:=rpoint[poly[num].p2].py; x3:=rpoint[poly[num].p3].px; y3:=rpoint[poly[num].p3].py; end; {triangle of color pcolor} minY:=y1; mxaY:=y1; if y2mxaY then mxaY:=y2; if y3mxaY then mxaY:=y3; p1:=x1-x3; q1:=y1-y3; p2:=x2-x1; q2:=y2-y1; p3:=x3-x2; q3:=y3-y2; for yy:=minY to mxaY do begin xa:=320; xb:=-1; if (y3>=yy) or (y1>=yy) then if (y3<=yy) or (y1<=yy) then if not(y3=y1) then begin x:=(yy-y3)*p1 div q1+x3; if xxb then xb:=x; end; if (y1>=yy) or (y2>=yy) then if (y1<=yy) or (y2<=yy) then if not(y1=y2) then begin x:=(yy-y1)*p2 div q2+x1; if xxb then xb:=x; end; if (y2>=yy) or (y3>=yy) then if (y2<=yy) or (y3<=yy) then if not(y2=y3) then begin x:=(yy-y2)*p3 div q3+x2; if xxb then xb:=x; end; if xa<=xb then {horiz. line} asm mov ax,[target] mov es,ax mov ax,yy mov di,ax shl ax,8 shl di,6 add di,ax add di,xa mov al,pcolor mov ah,al mov cx,xb sub cx,xa inc cx shr cx,1 jnc @1 stosb @1: rep stosw end; end; end; end; procedure GTriangle(num,target:word); {gouraud - gour. shaded triangle} var inc,i13,i12,i23,dot1,dot2,dot3,test,color,c1,c2:single; {shading} x1,x2,x3,y1,y2,y3:integer; col1,col2,col3:byte; ideal:boolean; x,ax,bx,yy,p1,q1,p2,q2,p3,q3:integer; {triangle} begin if rnormal[num].z>0 then {visible?} begin dot1:=(rvertex[poly[num].p1].x*lx+rvertex[poly[num].p1].y*ly+rvertex[poly[num].p1].z*lz); { normalized dot product for vertex 1 = light.vertex1} dot2:=(rvertex[poly[num].p2].x*lx+rvertex[poly[num].p2].y*ly+rvertex[poly[num].p2].z*lz); { normalized dot product for vertex 2 = light.vertex2} dot3:=(rvertex[poly[num].p3].x*lx+rvertex[poly[num].p3].y*ly+rvertex[poly[num].p3].z*lz); { normalized dot product for vertex 3 = light.vertex3} col1:=round((dot1*cbound[define[num].color].mul)+cbound[define[num].color].lower); { choose color for vertex1} col2:=round((dot2*cbound[define[num].color].mul)+cbound[define[num].color].lower); { choose color for vertex2} col3:=round((dot3*cbound[define[num].color].mul)+cbound[define[num].color].lower); { choose color for vertex3} x1:=rpoint[poly[num].p1].px; {symplifying} y1:=rpoint[poly[num].p1].py; x2:=rpoint[poly[num].p2].px; y2:=rpoint[poly[num].p2].py; x3:=rpoint[poly[num].p3].px; y3:=rpoint[poly[num].p3].py; if not (y1<=y2) then {sort = y10) then i13:=(col3-col1)/(y3-y1+1) else i13:=0; { itnterpolating the color between vertex 1 and 3} if (y3-y2+1<>0) then i23:=(col3-col2)/(y3-y2+1) else i23:=0; { itnterpolating the color between vertex 2 and 3} if (y2-y1+1<>0) then i12:=(col2-col1)/(y2-y1+1) else i12:=0; { itnterpolating the color between vertex 1 and 2} if (y3-y1)<>0 then test:=(x3-x1)/(y3-y1) else test:=0; test:=test*(y2-y1); test:=test+x1; if x2>=test then ideal:=true else ideal:=false; { the above is my speciality. I don't know any other way of solving this problem. If someone knows..: In the loop there are 2 colors defined: c1,c2: c1 for the left side of the line, c2 for the right side. There are two ways a triangle can look like, ideal: where on the left side the line between point 1 and 3, on the right side between point 1 and 2, 2 and three. I have 3 increments for y:=y+1 inc between 1..3,1..2,2..3 (inc12,inc13, inc23). By the thing above I decide to which color (left-c1 or right-c2) I should add which increment if ideal=false then the line between 1..3 is on the right side } c1:=col1; {left color} c2:=col1; {right color} {triangle} p1:=x1-x3; q1:=y1-y3; p2:=x2-x1; q2:=y2-y1; p3:=x3-x2; q3:=y3-y2; for yy:=y1-1 to y2 do begin ax:=320; bx:=-1; if (y3>=yy) or (y1>=yy) then if (y3<=yy) or (y1<=yy) then if not(y3=y1) then begin x:=(yy-y3)*p1 div q1+x3; if xbx then bx:=x; end; if (y1>=yy) or (y2>=yy) then if (y1<=yy) or (y2<=yy) then if not(y1=y2) then begin x:=(yy-y1)*p2 div q2+x1; if xbx then bx:=x; end; if (y2>=yy) or (y3>=yy) then if (y2<=yy) or (y3<=yy) then if not(y2=y3) then begin x:=(yy-y2)*p3 div q3+x2; if xbx then bx:=x; end; inc:=(c2-c1)/(bx-ax+1); {inc is the increment for every pixel} color:=c1; {we start with the left color - c1} for ax:=ax to bx do{for ax to bx draw point, add the pixel_color_inc to the color} begin ppix(ax,yy,round(color),target); color:=color+inc; end; if ax<=bx then begin if ideal=false then { add increment for y:=y+1 to the left and right color, depending on the 'ideality' of the triangle} begin {noideal} c1:=c1+i12; c2:=c2+i13; end else begin {ideal} c1:=c1+i13; c2:=c2+i12; end; end; end; {this was from y1..y2-1 (I don't like this wery much but..), the same as in the loop above is in the loop below, just the color increment for inc(y) is on one of the sides inc23 insted of inc12} for yy:=y2 to y3 do begin ax:=320; bx:=-1; if (y3>=yy) or (y1>=yy) then if (y3<=yy) or (y1<=yy) then if not(y3=y1) then begin x:=(yy-y3)*p1 div q1+x3; if xbx then bx:=x; end; if (y1>=yy) or (y2>=yy) then if (y1<=yy) or (y2<=yy) then if not(y1=y2) then begin x:=(yy-y1)*p2 div q2+x1; if xbx then bx:=x; end; if (y2>=yy) or (y3>=yy) then if (y2<=yy) or (y3<=yy) then if not(y2=y3) then begin x:=(yy-y2)*p3 div q3+x2; if xbx then bx:=x; end; if ax<=bx then begin inc:=(c2-c1)/(bx-ax+1); color:=c1; for ax:=ax to bx do begin ppix(ax,yy,round(color),target); color:=color+inc; end; if ideal=false then begin{noideal} c1:=c1+i23; c2:=c2+i13; end else begin{ideal} c1:=c1+i13; c2:=c2+i23; end; end; end; end; end; procedure GCoords(alfa,beta,gama:byte); var c:word; s:single; begin for c:=1 to pointcount do begin singles[1]:=cosb[alfa]*base[c].y-sinb[alfa]*base[c].z; singles[2]:=sinb[alfa]*base[c].y+cosb[alfa]*base[c].z; singles[3]:=cosb[beta]*base[c].x+sinb[beta]*singles[2]; rpoint[c].rx:=cosb[gama]*singles[3]-sinb[gama]*singles[1]; rpoint[c].ry:=sinb[gama]*singles[3]+cosb[gama]*singles[1]; rpoint[c].rz:=cosb[beta]*singles[2]-sinb[beta]*base[c].x; rvertex[c].x:=rpoint[c].rx*vmul[c]; rvertex[c].y:=rpoint[c].ry*vmul[c]; rvertex[c].z:=rpoint[c].rz*vmul[c]; s:=(dist+rpoint[c].rz)/dist; rpoint[c].px:=round(origoX+s*rpoint[c].rx); rpoint[c].py:=round(origoY+s*rpoint[c].ry); end; for c:=1 to polycount do begin singles[2]:=sinb[alfa]*normal[c].y+cosb[alfa]*normal[c].z; rnormal[c].z:=cosb[beta]*singles[2]-sinb[beta]*normal[c].x; if rnormal[c].z>=0 then begin singles[1]:=cosb[alfa]*normal[c].y-sinb[alfa]*normal[c].z; singles[3]:=cosb[beta]*normal[c].x+sinb[beta]*singles[2]; rnormal[c].x:=cosb[gama]*singles[3]-sinb[gama]*singles[1]; rnormal[c].y:=sinb[gama]*singles[3]+cosb[gama]*singles[1]; end; end; end; procedure rot(var a,b,c,inca,incb,incc:byte;target:word); var cnt:word; begin a:=byte(a+inca); b:=byte(b+incb); c:=byte(c+incc); GCoords(a,b,c); for cnt:=1 to polycount do case define[cnt].shading of 0:Gtriangle(cnt,target); 1:Ltriangle(cnt,target); 2:Striangle(cnt,target); end; flip(target,$0a000); cls(target); end; procedure prepare; var vl,light,z,x,y,norm:extended; c:word; begin for c:=1 to polycount do begin x:=(base[poly[c].p2].y-base[poly[c].p1].y)*(base[poly[c].p1].z-base[poly[c].p3].z)- (base[poly[c].p2].z-base[poly[c].p1].z)*(base[poly[c].p1].y-base[poly[c].p3].y); y:=(base[poly[c].p2].z-base[poly[c].p1].z)*(base[poly[c].p1].x-base[poly[c].p3].x)- (base[poly[c].p2].x-base[poly[c].p1].x)*(base[poly[c].p1].z-base[poly[c].p3].z); z:=(base[poly[c].p2].x-base[poly[c].p1].x)*(base[poly[c].p1].y-base[poly[c].p3].y)- (base[poly[c].p2].y-base[poly[c].p1].y)*(base[poly[c].p1].x-base[poly[c].p3].x); norm:=sqrt(sqr(x)+sqr(y)+sqr(z)); normal[c].x:=x/norm; normal[c].y:=y/norm; normal[c].z:=z/norm; end; for c:=1 to pointcount do begin vl:=sqrt(sqr(base[c].y)+sqr(base[c].z)+sqr(base[c].x)); vmul[c]:=1/vl; end; light:=sqrt(sqr(lx)+sqr(ly)+sqr(lz)); lx:=lx/light; ly:=ly/light; lz:=lz/light; end; procedure setshades(rh,gh,bh,rl,gl,bl,col1,col2,color:byte); var rr,gg,bb,r,g,b,incr,incg,incb:single; count,cto:byte; begin incr:=(rh-rl)/abs(col2-col1); incg:=(gh-gl)/abs(col2-col1); incb:=(bh-bl)/abs(col2-col1); if col1