[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]
{$A+,B-,D+,E-,F-,G+,I+,L+,N+,O+,P-,Q+,R-,S+,T+,V+,X+,Y+}
{$M 4096,0,655360}
{
Please,
Go through the code, and find the bugs. 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
}
{ check the info below the code. Something is explained there.
There is also another file, you need for running this}
type
VirtualArray = array[1..64000] of byte;
VPointer = ^VirtualArray;
var
define : array [ 1..255 ] of record
color:byte;
end;
base : array [ 1..1000 ] of record
x,y,z:integer;
end;
rpoint : array [ 1..1000 ] of record
rx,ry,rz:single;
px,py:integer;
end;
poly : array [ 1..1000 ] of record
p1,p2,p3:word;
end;
normal : array [ 1..1000 ] of record
x,y,z:single;
end;
rnormal : array [ 1..1000 ] of record
x,y,z:single;
end;
sinb : array [ 0..255 ] of single;
cosb : array [ 0..255 ] of single;
cbound : array [0..255] of record
llower,glower,lmul,gmul:byte;
end;
lx,ly,lz:single; {light x,y,z}
lalfa,lbeta,lgama:byte; {light alfa beta gama}
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;
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 WaitRet; assembler;
asm
mov dx,3dah
@1:
in al,dx
test al,08h
jnz @1
@2:
in al,dx
test al,08h
jz @2
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 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;
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 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;
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;
const map:array[0..11,0..20] of byte=(
(15,07,15,07,07,15,07,15,07,15,07,15,07,15,07,15,07,15,07,15,07),
(07,15,07,15,15,07,15,07,15,07,15,07,15,07,15,07,15,07,15,07,15),
(15,07,15,07,07,15,07,15,07,15,07,15,07,15,07,15,07,15,07,15,07),
(07,15,07,15,15,07,15,07,15,07,15,07,15,07,15,07,15,07,15,07,15),
(15,07,15,07,07,15,07,15,07,15,07,15,07,15,07,15,07,15,07,15,07),
(07,15,07,15,15,07,15,07,15,07,15,07,15,07,15,07,15,07,15,07,15),
(15,07,15,07,07,15,07,15,07,15,07,15,07,15,07,15,07,15,07,15,07),
(07,15,07,15,15,07,15,07,15,07,15,07,15,07,15,07,15,07,15,07,15),
(15,07,15,07,07,15,07,15,07,15,07,15,07,15,07,15,07,15,07,15,07),
(07,15,07,15,15,07,15,07,15,07,15,07,15,07,15,07,15,07,15,07,15),
(15,07,15,07,07,15,07,15,07,15,07,15,07,15,07,15,07,15,07,15,07),
(07,15,07,15,15,07,15,07,15,07,15,07,15,07,15,07,15,07,15,07,15));
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 Ttriangle(num,target:word);
var
u,v,incu,incv,test,u1,v1,u2,v2,inc12u,inc13u,inc23u,inc12v,inc13v,inc23v:single;
x1,y1,x2,y2,x3,y3:integer; {shading}
tx1,ty1,tx2,ty2,tx3,ty3:integer; {shading}
color:byte;
gu,gv,width:word;
cnt,x,minY,maxY,midY,xa,xb,yy,p1,q1,p2,q2,p3,q3:integer;
ideal:boolean;
begin
tx1:=0;
ty1:=0;
tx2:=20;
ty2:=0;
tx3:=20;
ty3:=11;
{width:=x2-x1+1;}
if rnormal[num].z>=0 then
begin
begin {color}
x1:=rpoint[poly[num].p1].px;
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;
if (y1>y2) then
begin
xchgi(y1,y2);
xchgi(x1,x2);
xchgi(ty1,ty2);
xchgi(tx1,tx2);
end;
if (y1>y3) then
begin
xchgi(y1,y3);
xchgi(x1,x3);
xchgi(ty1,ty3);
xchgi(tx1,tx3);
end;
if (y2>y3) then
begin
xchgi(y2,y3);
xchgi(x2,x3);
xchgi(ty2,ty3);
xchgi(tx2,tx3);
end;
if (y2-y1)<>0 then inc12u:=(tx2-tx1)/(y2-y1) else inc12u:=0;
if (y3-y2)<>0 then inc23u:=(tx3-tx2)/(y3-y2) else inc23u:=0;
if (y3-y1)<>0 then inc13u:=(tx3-tx1)/(y3-y1) else inc13u:=0;
if (y2-y1)<>0 then inc12v:=(ty2-ty1)/(y2-y1) else inc12v:=0;
if (y3-y2)<>0 then inc23v:=(ty3-ty2)/(y3-y2) else inc23v:=0;
if (y3-y1)<>0 then inc13v:=(ty3-ty1)/(y3-y1) else inc13v:=0;
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;
u1:=tx1;v1:=ty1;
if y1<>y2 then
begin
u2:=tx1;v2:=ty1;
end else begin
u2:=tx2;v2:=ty2;
end;
p1:=x1-x3; q1:=y1-y3;
p2:=x2-x1; q2:=y2-y1;
p3:=x3-x2; q3:=y3-y2;
for yy:=Y1 to (Y2-1) 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 x<xa then xa:=x;
if x>xb 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 x<xa then xa:=x;
if x>xb 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 x<xa then xa:=x;
if x>xb then xb:=x;
end;
if xa<=xb then
begin
incu:=(u2-u1)/(xb-xa+1);
incv:=(v2-v1)/(xb-xa+1);
u:=u1;
v:=v1;
for cnt:=xa to xb do
begin
{gv:=round(v);
gu:=round(u);}
color:=map[round(v),round(u)]; {*}
{asm
mov di,offset bitmap
mov ax,gv
mul width
add ax,gu
add di,ax
mov al,byte ptr ds:[di]
mov color,al
end;}
ppix(cnt,yy,color,target);
u:=u+incu;
v:=v+incv;
end;
if ideal=false then
begin
u1:=u1+inc12u;
u2:=u2+inc13u;
v1:=v1+inc12v;
v2:=v2+inc13v;
end else
begin
u1:=u1+inc13u;
u2:=u2+inc12u;
v1:=v1+inc13v;
v2:=v2+inc12v;
end;
end;
end;
for yy:=Y2 to Y3 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 x<xa then xa:=x;
if x>xb 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 x<xa then xa:=x;
if x>xb 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 x<xa then xa:=x;
if x>xb then xb:=x;
end;
if xa<=xb then
begin
incu:=(u2-u1)/(xb-xa+1);
incv:=(v2-v1)/(xb-xa+1);
u:=u1;
v:=v1;
for cnt:=xa to xb do
begin
{gv:=round(v);
gu:=round(u);}
color:=map[round(v),round(u)]; {*}
{asm
mov di,offset bitmap
mov ax,gv
mul width
add ax,gu
add di,ax
mov al,byte ptr ds:[di]
mov color,al
end;}
ppix(cnt,yy,color,target);
u:=u+incu;
v:=v+incv;
end;
if ideal=false then
begin
u1:=u1+inc23u;
u2:=u2+inc13u;
v1:=v1+inc23v;
v2:=v2+inc13v;
end else
begin
u1:=u1+inc13u;
u2:=u2+inc23u;
v1:=v1+inc13v;
v2:=v2+inc23v;
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;
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 Ttriangle(cnt,target);
flip(target,$0a000);
cls(target);
end;
procedure prepare;
var 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;
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<col2 then
begin
count:=col1;
cto:=col2;
end else
begin
count:=col2;
cto:=col1;
end;
r:=rl; g:=gl; b:=bl;
rr:=rl; gg:=gl; bb:=bl;
for count:=count to cto do
begin
setrgb(count,round(r),round(g),round(b));
rr:=rr+incr;
gg:=gg+incg;
bb:=bb+incb;
r:=rr; g:=gg; b:=bb;
end;
setrgb(count,round(r),round(g),round(b));
cbound[color].lmul:=abs(col2-col1);
cbound[color].llower:=col1-1;
end;
var
aa,bb,cc,incaa,incbb,inccc:byte;
rd:char;
vp:vpointer;
adr:word;
var Time : Longint ABSOLUTE $0:$046c;
frame,etime,stime:longint;
begin
asm mov ax,13h; int 10h end;
psinb;
pcosb;
LoadCoords('star2.x');
incaa:=0;
incbb:=0;
inccc:=0;
aa:=00;
bb:=00;
cc:=00;
lx:=0;
ly:=0;
lz:=1;
origox:=160;
origoy:=100;
dist:=32678;
adr:=vsetup(vp);
cls(adr);
prepare;
stime:=time;
repeat
inc(frame);
rot(aa,bb,cc,incaa,incbb,inccc,adr);
if keypressed then
begin rd:=readkey;
case rd of
'z':inc(incaa);
'x':dec(incaa);
'c':inc(incbb);
'v':dec(incbb);
'b':inc(inccc);
'n':dec(inccc);
't':begin
inc(lalfa);
singles[1]:=cosb[lalfa]*ly-sinb[lalfa]*lz;
singles[2]:=sinb[lalfa]*ly+cosb[lalfa]*lz;
singles[3]:=cosb[lbeta]*lx+sinb[lbeta]*singles[2];
lx:=cosb[lgama]*singles[3]-sinb[lgama]*singles[1];
ly:=sinb[lgama]*singles[3]+cosb[lgama]*singles[1];
lz:=cosb[lbeta]*singles[2]-sinb[lbeta]*lx;
end;
's':begin aa:=0;
bb:=0;
cc:=0;
incaa:=0;
incbb:=0;
inccc:=0;
end;
'a':begin
incaa:=0;
incbb:=0;
inccc:=0;
end;
end;
end;
until port[$60]=1;
etime:=time;
asm mov ax,3 ; int 10h end;
Writeln((Frame*18.2)/(ETime-STime):5:2, ' fps');
end.
{ The achievment:
1) Have a perspective not correct texturemapped
object rotating correctly -> see bug in textrot.pas
2) Turn on the range check in textrot without an error
3) Optimize it
4) Use any texture (see below)
5) Fix the bug in this file for y1=y2 somewhat intelligently
-for even better understanding, see how I made the gouraud
triangle, in 3dfi.pas }
{ANYTHING I'M REFERING TO CAN BE FOUND IN 3DFI.PAS}
procedure Ttriangle(x1,y1,x2,y2,x3,y3,tx1,ty1,tx2,ty2,tx3,ty3:integer;
var bitmap;target:word);
var
u,v,incu,incv,test,u1,v1,u2,v2,inc12u,inc13u,inc23u,inc12v,inc13v,inc23v:single;
color:byte;
gu,gv,width:word;
cnt,x,minY,maxY,midY,xa,xb,yy,p1,q1,p2,q2,p3,q3:integer;
ideal:boolean;
{the things in brackets shoud have been used, but.. se below at ASM}
begin
width:=x2-x1+1;
if (y1>y2) then {sort to have y1<=y2<=y3, implicitly x,tx,ty are chnged}
begin
xchgi(y1,y2);
xchgi(x1,x2);
xchgi(ty1,ty2);
xchgi(tx1,tx2);
end;
if (y1>y3) then
begin
xchgi(y1,y3);
xchgi(x1,x3);
xchgi(ty1,ty3);
xchgi(tx1,tx3);
end;
if (y2>y3) then
begin
xchgi(y2,y3);
xchgi(x2,x3);
xchgi(ty2,ty3);
xchgi(tx2,tx3);
end;
if (y2-y1)<>0 then inc12u:=(tx2-tx1)/(y2-y1) else inc12u:=0;
if (y3-y2)<>0 then inc23u:=(tx3-tx2)/(y3-y2) else inc23u:=0;
if (y3-y1)<>0 then inc13u:=(tx3-tx1)/(y3-y1) else inc13u:=0;
if (y2-y1)<>0 then inc12v:=(ty2-ty1)/(y2-y1) else inc12v:=0;
if (y3-y2)<>0 then inc23v:=(ty3-ty2)/(y3-y2) else inc23v:=0;
if (y3-y1)<>0 then inc13v:=(ty3-ty1)/(y3-y1) else inc13v:=0;
{get the increasing u,v along the inc(y) between points 1..2,1..3,2..3
(inc12,inc13,inc23)}
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 'u' and 'v' defined: u1,u2,v1,v2:
u1,v1 for the left side of the line, u2,v2 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). Using the thing above,I decide to which u,v
(left-u1,v1 or right-u2,v2) I should add which increment
if ideal=false then the line between 1..3 is on the right side }
u1:=tx1;v1:=ty1;u2:=tx1;v2:=ty1; {we're on the begining of the texture}
gu:=tx1;gv:=ty1;
p1:=x1-x3; q1:=y1-y3;
p2:=x2-x1; q2:=y2-y1;
p3:=x3-x2; q3:=y3-y2;
for yy:=Y1 to Y2-1 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 x<xa then xa:=x;
if x>xb 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 x<xa then xa:=x;
if x>xb 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 x<xa then xa:=x;
if x>xb then xb:=x;
end;
if xa<=xb then
begin
incu:=(u2-u1)/(xb-xa+1);
incv:=(v2-v1)/(xb-xa+1);{inc for u,v for evry pixel along the scanline}
u:=u1;
v:=v1;
for cnt:=xa to xb do
begin
{well here should heve been the things in brackets, but when I use
the assembly routine to get my color, it doesn't do well in the
2nd part. Please have a look at it. Just put away the brackets
round gv:=.. and asm..end in this, and the 2nd part otf the triangle
and you'll see what I mean (!) you have to put the color:=map[..
into brackets}
{gv:=round(v);
gu:=round(u);}
color:=map[round(v),round(u)]; {*} {choose the color of the pix}
{asm
mov di,offset bitmap
mov ax,gv
mul width
add ax,gu
add di,ax
mov al,byte ptr ds:[di]
mov color,al
end;}
ppix(cnt,yy,color,target);
u:=u+incu;
v:=v+incv; {putpixel and increment}
end;
if ideal=false then
begin
u1:=u1+inc12u; {inc along the y:=y+1}
u2:=u2+inc13u;
v1:=v1+inc12v;
v2:=v2+inc13v;
end else
begin
u1:=u1+inc13u;
u2:=u2+inc12u;
v1:=v1+inc13v;
v2:=v2+inc12v;
end;
end;
end;
{the same you saw above, is down here (below), only the inc(y) increments
are insted of inc12 changed to inc23 (more details in gouraud)}
for yy:=Y2 to Y3 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 x<xa then xa:=x;
if x>xb 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 x<xa then xa:=x;
if x>xb 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 x<xa then xa:=x;
if x>xb then xb:=x;
end;
if xa<=xb then
begin
incu:=(u2-u1)/(xb-xa+1);
incv:=(v2-v1)/(xb-xa+1);
u:=u1;
v:=v1;
for cnt:=xa to xb do
begin
{gv:=round(v);
gu:=round(u);}
color:=map[round(v),round(u)]; {*}
{asm
mov di,offset bitmap
mov ax,gv
mul width
add ax,gu
add di,ax
mov al,byte ptr ds:[di]
mov color,al
end;}
ppix(cnt,yy,color,target);
u:=u+incu;
v:=v+incv;
end;
if ideal=false then
begin
u1:=u1+inc23u;
u2:=u2+inc13u;
v1:=v1+inc23v;
v2:=v2+inc13v;
end else
begin
u1:=u1+inc13u;
u2:=u2+inc23u;
v1:=v1+inc13v;
v2:=v2+inc23v;
end;
end;
end;
end;
save this as star2.x
****************cut****************
12
20
;triangle
12,20
1=-20,-5,0
2=-50,0,0
3=-20,5,0
4=0,-5,0
5=0,5,0
6=30,0,0
7=22,0,-25
8=5,0,-40
9=-2,0,-70
10=-17,0,-70
11=-25,0,-40
12=-42,0,-25
;coords,done
1=2,3,1-1
2=1,3,4-1
3=4,3,5-1
4=4,5,6-1
5=7,4,6-1
6=8,4,7-1
7=9,4,8-1
8=9,1,4-1
9=10,1,9-1
10=10,11,1-1
11=12,1,11-1
12=12,2,1-1
13=8,7,5-1
14=5,7,6-1
15=12,3,2-1
16=12,11,3-1
17=9,8,5-1
18=10,3,11-1
19=10,9,3-1
20=9,5,3-1
[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]