[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]
unit x3dunit2;
{ mode-x 3D unit - xhlin-procedure by Sean Palmer }
{ Optimized by Luis Mezquita Raya }
{$g+}
interface
const vidseg:word=$a000;
divd:word=128;
dist:word=200;
minx:word=0;
maxx:word=319;
border:boolean=false;
var ctab:array[byte] of integer;
stab:array[byte] of integer;
address:word;
triangles:boolean;
Procedure setborder(col:byte);
Procedure setpal(c,r,g,b:byte);
Procedure retrace;
Procedure setmodex;
Procedure setaddress(ad:word);
Procedure cls;
Procedure polygon(x1,y1,x2,y2,x3,y3,x4,y4:integer; c:byte);
Function cosinus(i:byte):integer;
Function sinus(i:byte):integer;
implementation
var xpos:array[0..199,0..1] of integer;
Procedure setborder(col:byte); assembler;
asm
xor ch,ch
mov cl,border
jcxz @out
mov dx,3dah
in al,dx
mov dx,3c0h
mov al,11h+32
out dx,al
mov al,col
out dx,al
@out:
end;
Procedure setpal(c,r,g,b:byte); assembler;
asm
mov dx,3c8h
mov al,[c]
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 retrace; assembler;
asm
mov dx,3dah;
@vert1: in al,dx
test al,8
jz @vert1
@vert2: in al,dx
test al,8
jnz @vert2
end;
Procedure setmodex; assembler;
asm
mov ax,13h
int 10h
mov dx,3c4h
mov ax,0604h
out dx,ax
mov ax,0f02h
out dx,ax
mov cx,320*200
mov es,vidseg
xor ax,ax
mov di,ax
rep stosw
mov dx,3d4h
mov ax,0014h
out dx,ax
mov ax,0e317h
out dx,ax
end;
Procedure setaddress(ad:word); assembler;
asm
mov dx,3d4h
mov al,0ch
mov ah,[byte(ad)+1]
out dx,ax
mov al,0dh
mov ah,[byte(ad)]
out dx,ax
end;
Procedure cls; assembler;
asm
mov es,vidseg
mov di,address
mov cx,8000
mov dx,3c4h
mov ax,0f02h
out dx,ax
xor ax,ax
rep stosw
end;
{$f-}
Procedure polygon(x1,y1,x2,y2,x3,y3,x4,y4:integer; c:byte); assembler;
var mny,mxy,y,m,mult,divi,top,s,
stb,px1,py1,px2,py2:integer;
dir:byte;
asm { Procedure Polygon }
mov ax,y1 { Determine lowest & highest points }
mov cx,ax
mov bx,y2
cmp ax,bx { if mny>y2 ==> mny:=y2 }
jl @p2
mov ax,bx
@p2: cmp cx,bx { if mxy<y2 ==> mxy:=y2 }
jg @p3
mov cx,bx
@p3: mov bx,y3
cmp ax,bx { if mny>y3 ==> mny:=y3 }
jl @p3M
mov ax,bx
@p3M: cmp cx,bx { if mxy<y3 ==> mxy:=y3 }
jg @p4
mov cx,bx
@p4: mov bx,y4
cmp ax,bx { if mny>y4 ==> mny:=y4 }
jl @p4M
mov ax,bx
@p4M: cmp cx,bx { if mxy<y4 ==> mxy:=y4 }
jg @vert
mov cx,bx
@vert: cmp ax,0 { Vertical range checking }
jge @minin { if mny<0 ==> mny:=0 }
xor ax,ax
@minin: cmp cx,200 { if mxy>199 ==> mxy:=199 }
jl @maxin
mov cx,199
@maxin: cmp cx,0 { if mxy<0 ==> Exit }
jl @pexit
cmp ax,199 { if mny>199 ==> Exit }
jg @pexit
mov mny,ax { ax=mny=lowest point }
mov mxy,cx { cx=mxy=highest point }
push x1 { RangeChk(x1,y1,x2,y2) }
push y1
push x2
push y2
call @Range
push x2 { RangeChk(x2,y2,x3,y3) }
push y2
push x3
push y3
call @Range
push x3 { RangeChk(x3,y3,x4,y4) }
push y3
cmp Triangles,0
jz @Poly4
push x1
push y1
jmp @Last
@Poly4: push x4
push y4
call @Range
push x4 { RangeChk(x4,y4,x1,y1) }
push y4
push x1
push y1
@Last: call @Range
mov ax,mny { Show a poly }
mov di,ax { y:=mny }
shl di,2
lea bx,xpos
add di,bx { di points to xpos[y,0] }
@Show: mov y,ax { repeat ... }
mov cx,[di]
mov dx,[di+2]
mov px1,cx
mov px2,dx
push ax
push di
call @xhlin { xhlin(px1,px2,y,c) }
pop di
pop ax
add di,4 { Next xpos }
inc ax { inc(y) }
cmp ax,mxy { ... until y>mxy; }
jle @Show
jmp @pexit
{ RangeChk }
@Range: pop di { Get return IP }
pop py2 { Get params }
pop px2
pop py1
pop px1
push di { Save return IP }
mov ax,py1 { dir:=byte(y1<y2) }
cmp ax,py2
mov ax,1
jl @Rdwn
dec al
@Rdwn: mov dir,al
shl al,1
push ax
shl al,2
sub ax,4
mov stb,ax { stb:=8*dir-4 }
pop ax
dec ax { s:=2*dir-1 }
mov s,ax { Check directions (-1= down, 1=up) }
test AH,10000000b { Calculate constants }
mov dx,0
jz @Rposi
dec dx
@Rposi: mov bx,px2
sub bx,px1
imul bx
mov mult,ax { mult:=s*(x2-x1) }
mov ax,py2
mov bx,py1
mov cx,ax
sub ax,bx
mov divi,ax { divi:=y2-y1 }
cmp bx,cx { ¨y1=y2? }
pushf { Calculate pointer to xpos[y,dir] }
mov y,bx { y:=y1 }
mov di,bx
shl di,2
lea bx,xpos
add di,bx
mov cl,dir
mov ch,0
shl cl,1
add di,cx { di points to xpos[y,dir] }
popf
je @Requ { if y1=y2 ==> @Requ }
mov m,0 { m:=0 }
mov ax,py2
add ax,s
mov top,ax { top:=y2+s }
@RLoop: mov ax,y { repeat ... }
cmp ax,mny { if y<mny ==> @RNext }
jl @RNext
cmp ax,mxy { if y>mxy ==> @RNext }
jg @RNext
mov ax,m { Calculate int(m/divi)+x1 }
test AH,10000000b
mov dx,0
jz @RLpos
dec dx
@RLpos: mov bx,divi
idiv bx
add ax,px1
call @HR { HorRangeChk(m div divi+x1) }
@RNext: mov ax,mult
add m,ax { inc(m,mult) }
add di,stb { Next xpos }
mov ax,y { inc(y,s) }
add ax,s
mov y,ax
cmp ax,top
jne @RLoop { ... until y=top }
jmp @Rexit
@Requ: mov ax,y
cmp ax,mny { if y<mny ==> Exit }
jl @Rexit
cmp ax,mxy { if y>mxy ==> Exit }
jg @Rexit
mov ax,px1
call @HR { HorRangeChk(px1) }
@Rexit: jmp @exit
{ HorRangeChk }
@HR: mov bx,minx { bx:=minx }
cmp ax,bx
jl @HRsav
mov bx,maxx { bx:=maxx }
cmp ax,bx
jg @HRsav
mov bx,ax
@HRsav: mov [di],bx { xpos[y,dir]:=bx }
jmp @exit
{ xhlin }
@xhlin: mov es,vidseg
cld
mov ax,80
mul y
mov di,ax { base of scan line }
add di,address
mov bx,px1 { px1 = x begin coord }
mov dx,px2 { px2 = x end coord }
cmp bx,dx
jb @skip
xchg bx,dx { switch coords if px1>px2 }
@skip: mov cl,bl
shr bx,2
mov ch,dl
shr dx,2
and cx,$0303
sub dx,bx { width in Bytes }
add di,bx { offset into video buffer }
mov ax,$ff02
shl ah,cl
and ah,1111b { left edge mask }
mov cl,ch
mov bh,$f1
rol bh,cl
and bh,1111b { right edge mask }
mov cx,dx
or cx,cx
jnz @left
and ah,bh { combine left & right bitmasks }
@left: mov dx,$03c4
out dx,ax
inc dx
mov al,c
stosb
jcxz @exit
dec cx
jcxz @right
mov al,1111b
out dx,al { skipped if cx=0,1 }
mov al,c
repz stosb { fill middle Bytes }
@right: mov al,bh
out dx,al { skipped if cx=0 }
mov al,c
stosb
@exit: pop ax
push cs
push ax
ret
@pexit:
end;
{$f+}
Function cosinus(i:byte):integer;
begin
cosinus:=ctab[i];
end;
Function sinus(i:byte):integer;
begin
sinus:=stab[i];
end;
Procedure Initialize;
var i:byte;
begin
triangles:=False;
for i:=0 to 255 do ctab[i]:=round(-cos(i*pi/128)*divd);
for i:=0 to 255 do stab[i]:=round(sin(i*pi/128)*divd);
end;
begin
Initialize;
end.
[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]