[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]
{
Here is a re-vamped version of my texture mapper. Code has been used from
several sources. The texture mapper is mine. The rotation code is from
Bas van Gaalan (look like anything from GFXFX? :). The whole thing was
thrown together by Daniel Wakefield (including some conversion of my texture
maper to ASM). I hope everyone finds this useful. The texture mapper it self
isn't very good, but it gives you an idea of how it can be done (if you
want source for a good texture mapper, register GFXFX2!!).
Without further delay.....
{ -------------- Begin Code -----------------}
{$r-,g+}
program texure_poly;
uses crt;
Type TE = Record X : Integer; px, py : Byte; End;
Table = Array[0..199] of TE; PTable = ^Table;
Var
Left, Right : Table; stab:array[0..255] of integer;
polyz:array[0..7] of integer; pind:array[0..7] of byte;
page,virscr:pointer; pageseg,virseg:word; Frame, St, Et : Longint;
Time : Longint Absolute $0000:$046c; pxVal, pxStep : Integer;
pyVal, pyStep : Integer; Count, res : Integer; O1 : Word; b:byte;
Const
Bitmap :Array[0..16*16-1] of Byte = (
2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,5,5,5,5,5,5,5,5,5,5,5,5,5,5,2,
2,5,5,1,1,1,1,1,1,1,1,1,1,5,5,2,2,5,1,5,1,1,1,1,1,1,1,1,5,1,5,2,
2,5,1,1,5,1,1,1,1,1,1,5,1,1,5,2,2,5,1,1,1,5,1,1,1,1,5,1,1,1,5,2,
2,5,1,1,1,1,5,1,1,5,1,1,1,1,5,2,2,5,1,1,1,1,1,5,5,1,1,1,1,1,5,2,
2,5,1,1,1,1,1,5,5,1,1,1,1,1,5,2,2,5,1,1,1,1,5,1,1,5,1,1,1,1,5,2,
2,5,1,1,1,5,1,1,1,1,5,1,1,1,5,2,2,5,1,1,5,1,1,1,1,1,1,5,1,1,5,2,
2,5,1,5,1,1,1,1,1,1,1,1,5,1,5,2,2,5,5,1,1,1,1,1,1,1,1,1,1,5,5,2,
2,5,5,5,5,5,5,5,5,5,5,5,5,5,5,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2);
pointnum=11; planenum=7; border=false; vidseg:word=$a000;
divd=128; dist=200; points:array[0..pointnum,0..2] of integer=(
(-20,-20, 30),( 20,-20, 30),( 40,-40, 0),( 20,-20,-30),
(-20,-20,-30),(-40,-40, 0),(-20, 20, 30),( 20, 20, 30),
( 40, 40, 0),( 20, 20,-30),(-20, 20,-30),(-40, 40, 0));
planes:array[0..planenum,0..3] of byte=(
(1,2,8,7),(9,8,2,3),(10,4,5,11),(6,11,5,0),
(0,1,2,5),(5,2,3,4),(6,7,8,11),(11,8,9,10));
{ -------------------------------------------------------------------------- }
Procedure TextureHLine(X1, X2, px1, py1, px2, py2, Y : Integer; Dim : Word);
Begin pxStep := ((px2-px1) Shl 8) Div (x2-x1+1);
pyStep := ((py2-py1) Shl 8) Div (x2-x1+1);
asm
mov bx, px1; shl bx, 8; mov pxval,bx; { pxVal := px1 Shl 8;}
mov bx, py1; shl bx, 8; mov pyval,bx; { pyVal := py1 Shl 8;}
mov ax,y; shl ax,6; mov di,ax; shl ax,2
add di,ax; add di,x1; mov o1, di; End;
For Count := X1 to X2 do
Begin
b:= Bitmap[Hi(pxVal)+(Hi(pyVal)) Shl 4];
Asm mov ax,virseg; mov es,ax; mov ax,o1; mov di,ax; mov al, b;
mov es:[di],al; mov ax, pxval; add ax, pxstep;mov pxval, ax;
mov ax, pyval; add ax, pystep; mov pyval, ax; inc o1; end;
End; ; End;
Procedure Swap(Var A, B : Integer);
Var t : Integer; Begin t := a; a := b; b := t; End;
Procedure Texture4Poly(X1, Y1, X2, Y2, X3, Y3, X4, Y4 : Integer; Dim : Byte);
Var yMin, yMax : Integer; xStart, xEnd : Integer; yStart, yEnd : Integer;
pxStart, pxEnd : Integer; pyStart,pyEnd : Integer; XVal, XStep : Longint;
pxVal, pxStep : Integer; pyVal, pyStep : Integer; Count : Integer;
Side : PTable;
Begin
yMin := Y1; yMax := Y1;
If Y2 > yMax Then yMax := Y2; If Y3 > yMax Then yMax := Y3;
If Y4 > yMax Then yMax := Y4; If Y2 < yMin Then yMin := Y2;
If Y3 < yMin Then yMin := Y3; If Y4 < yMin Then yMin := Y4;
xStart := X1; yStart := Y1; xEnd := X2; yEnd := Y2;
pxStart := 0; pyStart := 0; pxEnd := Dim-1; pyEnd := 0;
If yStart > yEnd Then Begin
Swap(xStart, xEnd); Swap(yStart, yEnd); Swap(pxStart, pxEnd);
Side := @Left; End Else Side := @Right;
XVal := Longint(xStart) Shl 8;
XStep := (Longint(xEnd-xStart) Shl 8) Div (yEnd-yStart+1);
pxVal := pxStart Shl 8;
pxStep := ((pxEnd-pxStart) Shl 8) Div (yEnd-yStart+1);
For Count := yStart to yEnd do
Begin Side^[Count].x := XVal Shr 8; Side^[Count].px := pxVal Shr 8;
Side^[Count].py := pyStart; XVal := XVal + XStep;
pxVal := pxVal + pxStep; End;
xStart := X2; yStart := Y2; xEnd := X3; yEnd := Y3;
pxStart := Dim-1; pyStart := 0; pxEnd := Dim-1; pyEnd := Dim-1;
If yStart > yEnd Then Begin Swap(xStart, xEnd); Swap(yStart, yEnd);
Swap(pyStart, pyEnd); Side := @Left; End Else Side := @Right;
XVal := Longint(xStart) Shl 8;
XStep := (Longint(xEnd-xStart) Shl 8) Div (yEnd-yStart+1);
pyVal := pyStart Shl 8;
pyStep := ((pyEnd-pyStart) Shl 8) Div (yEnd-yStart+1);
For Count := yStart to yEnd do
Begin Side^[Count].x := XVal Shr 8; Side^[Count].py := pyVal Shr 8;
Side^[Count].px := pxStart; XVal := XVal + XStep;
pyVal := pyVal + pyStep; End;
xStart := X3; yStart := Y3; xEnd := X4; yEnd := Y4;
pxStart := Dim-1; pyStart := Dim-1; pxEnd := 0; pyEnd := Dim-1;
If yStart > yEnd Then Begin Swap(xStart, xEnd); Swap(yStart, yEnd);
Swap(pxStart, pxEnd); Side := @Left; End Else Side := @Right;
XVal := Longint(xStart) Shl 8;
XStep := (Longint(xEnd-xStart) Shl 8) Div (yEnd-yStart+1);
pxVal := pxStart Shl 8;
pxStep := ((pxEnd-pxStart) Shl 8) Div (yEnd-yStart+1);
For Count := yStart to yEnd do
Begin Side^[Count].x := XVal Shr 8; Side^[Count].px := pxVal Shr 8;
Side^[Count].py := pyStart; XVal := XVal + XStep;
pxVal := pxVal + pxStep; End;
xStart := X4; yStart := Y4;xEnd := X1; yEnd := Y1;
pxStart := 0; pyStart := Dim-1; pxEnd := 0; pyEnd := 0;
If yStart > yEnd
Then Begin Swap(xStart, xEnd); Swap(yStart, yEnd);
Swap(pyStart, pyEnd); Side := @Left; End
Else Side := @Right;
XVal := Longint(xStart) Shl 8;
XStep := (Longint(xEnd-xStart) Shl 8) Div (yEnd-yStart+1);
pyVal := pyStart Shl 8;
pyStep := ((pyEnd-pyStart) Shl 8) Div (yEnd-yStart+1);
For Count := yStart to yEnd do
Begin Side^[Count].x := XVal Shr 8; Side^[Count].py := pyVal Shr 8;
Side^[Count].px := pxStart; XVal := XVal + XStep;
pyVal := pyVal + pyStep; End;
For Count := yMin to yMax do
If Left[Count].x < Right[Count].x
Then TextureHLine(Left[Count].x, Right[Count].x, Left[Count].px, Left[Count].py,
Right[Count].px, Right[Count].py, Count, Dim)
Else TextureHLine(Right[Count].x, Left[Count].x, Right[Count].px, Right[Count].py,
Left[Count].px, Left[Count].py, Count, Dim);
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 flip(src,dst:word); assembler; asm
push ds; mov es,[dst]; mov ds,[src]; xor si,si; xor di,di; mov cx,320*200/2
rep movsw; pop ds; end;
procedure quicksort(lo,hi:integer);
procedure sort(l,r:integer);
var i,j,x,y:integer;
begin
i:=l; j:=r; x:=polyz[(l+r) div 2];
repeat
while polyz[i]<x do inc(i); while x<polyz[j] do dec(j);
if i<=j then begin y:=polyz[i]; polyz[i]:=polyz[j]; polyz[j]:=y;
y:=pind[i]; pind[i]:=pind[j]; pind[j]:=y; inc(i); dec(j); end;
until i>j; if l<j then sort(l,j); if i<r then sort(i,r);
end;
begin sort(lo,hi); end;
function sinus(i:byte):integer; begin sinus:=stab[i]; end;
function cosinus(i:byte):integer; begin cosinus:=stab[(i+192) mod 255]; end;
procedure rotate_cube;
const xst=2; yst=3; zst=-4;
var
xp,yp,z:array[0..11] of integer;
x,y,i,j,k:integer;
n,Key,phix,phiy,phiz:byte;
begin
phix:=0; phiy:=0; phiz:=40; fillchar(xp,sizeof(xp),0);
fillchar(yp,sizeof(yp),0); Frame := 0; St := Time;
repeat
flip(pageseg,virseg);
for n:=0 to pointnum do begin
i:=(cosinus(phiy)*points[n,0]-sinus(phiy)*points[n,2]) div divd;
j:=(cosinus(phiz)*points[n,1]-sinus(phiz)*i) div divd;
k:=(cosinus(phiy)*points[n,2]+sinus(phiy)*points[n,0]) div divd;
x:=(cosinus(phiz)*i+sinus(phiz)*points[n,1]) div divd;
y:=(cosinus(phix)*j+sinus(phix)*k) div divd;
z[n]:=(cosinus(phix)*k-sinus(phix)*j) div divd+cosinus(phix) div 3;
xp[n]:=160+sinus(phix) div 2+(-x*dist) div (z[n]-dist);
yp[n]:=100+(-y*dist) div (z[n]-dist);
end;
for n:=0 to planenum do begin
polyz[n]:=(z[planes[n,0]]+z[planes[n,2]]) div 2; pind[n]:=n; end;
quicksort(0,planenum);
for n:=0 to planenum do
texture4poly(xp[planes[pind[n],0]],yp[planes[pind[n],0]],
xp[planes[pind[n],1]],yp[planes[pind[n],1]],
xp[planes[pind[n],2]],yp[planes[pind[n],2]],
xp[planes[pind[n],3]],yp[planes[pind[n],3]],16);
inc(phix,xst); inc(phiy,yst); inc(phiz,zst); flip(virseg,vidseg);
inc(frame); until keypressed; Et:=time; end;
var i,j:word;
begin
asm mov ax,13h; int 10h; end;
getmem(virscr,64000);
virseg:=seg(virscr^);
getmem(page,64000);
pageseg:=seg(page^);
for i:=0 to 255 do stab[i]:=round(sin(i*pi/128)*divd);
for i:=1 to 104 do setpal(150+i,0,20+i div 4,30+i div 5);
for i:=0 to 319 do for j:=0 to 199 do mem[pageseg:j*320+i]:=151+(i*i+j*j) mod
104;
rotate_cube;
freemem(page,64000);
freemem(virscr,64000);
textmode(lastmode);
Writeln(Frame*18.2/(Et-St):5:2, ' fps');
end.
[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]