``````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;
triangles:boolean;

Procedure setborder(col:byte);
Procedure setpal(c,r,g,b:byte);
Procedure retrace;
Procedure setmodex;
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;

asm
mov dx,3d4h
mov al,0ch
out dx,ax
mov al,0dh
out dx,ax
end;

Procedure cls; assembler;
asm
mov es,vidseg
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
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
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
call @HR                        { HorRangeChk(m div divi+x1) }

@RNext: mov ax,mult
add di,stb                      { Next xpos }
mov ax,y                        { inc(y,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 }

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.

``````