home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / graphics.swg / 0168_Texture Vector.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-02-28  |  9.1 KB  |  210 lines
  1. {
  2. Here is a re-vamped version of my texture mapper. Code has been used from
  3. several sources. The texture mapper is mine. The rotation code is from
  4. Bas van Gaalan (look like anything from GFXFX? :). The whole thing was
  5. thrown together by Daniel Wakefield (including some conversion of my texture
  6. maper to ASM). I hope everyone finds this useful. The texture mapper it self
  7. isn't very good, but it gives you an idea of how it can be done (if you
  8. want source for a good texture mapper, register GFXFX2!!).
  9.  
  10. Without further delay.....
  11.  
  12. { -------------- Begin Code -----------------}
  13.  
  14. {$r-,g+}
  15. program texure_poly;
  16. uses crt;
  17.  
  18. Type TE = Record  X : Integer; px, py : Byte; End;
  19.   Table = Array[0..199] of TE; PTable = ^Table;
  20.  
  21. Var
  22.   Left, Right : Table;  stab:array[0..255] of integer;
  23.   polyz:array[0..7] of integer; pind:array[0..7] of byte;
  24.   page,virscr:pointer; pageseg,virseg:word; Frame, St, Et : Longint;
  25.   Time : Longint Absolute $0000:$046c; pxVal, pxStep : Integer;
  26.   pyVal, pyStep : Integer; Count, res : Integer; O1 : Word; b:byte;
  27.  
  28. Const
  29.   Bitmap :Array[0..16*16-1] of Byte = (
  30.   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,
  31.   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,
  32.   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,
  33.   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,
  34.   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,
  35.   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,
  36.   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,
  37.   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);
  38.   pointnum=11; planenum=7; border=false; vidseg:word=$a000;
  39.   divd=128; dist=200; points:array[0..pointnum,0..2] of integer=(
  40.     (-20,-20, 30),( 20,-20, 30),( 40,-40,  0),( 20,-20,-30),
  41.     (-20,-20,-30),(-40,-40,  0),(-20, 20, 30),( 20, 20, 30),
  42.     ( 40, 40,  0),( 20, 20,-30),(-20, 20,-30),(-40, 40,  0));
  43.   planes:array[0..planenum,0..3] of byte=(
  44.     (1,2,8,7),(9,8,2,3),(10,4,5,11),(6,11,5,0),
  45.     (0,1,2,5),(5,2,3,4),(6,7,8,11),(11,8,9,10));
  46. { -------------------------------------------------------------------------- }
  47. Procedure TextureHLine(X1, X2, px1, py1, px2, py2, Y : Integer; Dim : Word);
  48.  Begin pxStep := ((px2-px1) Shl 8) Div (x2-x1+1);
  49.   pyStep := ((py2-py1) Shl 8) Div (x2-x1+1);
  50.   asm
  51.    mov     bx, px1; shl bx, 8; mov pxval,bx;  {  pxVal := px1 Shl 8;}
  52.    mov     bx, py1; shl bx, 8; mov pyval,bx;  {  pyVal := py1 Shl 8;}
  53.    mov     ax,y; shl     ax,6; mov     di,ax; shl     ax,2
  54.    add     di,ax; add     di,x1; mov     o1, di; End;
  55.   For Count := X1 to X2 do
  56.     Begin
  57.      b:= Bitmap[Hi(pxVal)+(Hi(pyVal)) Shl 4];
  58.      Asm mov ax,virseg; mov es,ax; mov ax,o1; mov di,ax; mov al, b;
  59.       mov es:[di],al; mov ax, pxval; add ax, pxstep;mov pxval, ax;
  60.       mov ax, pyval; add ax, pystep; mov pyval, ax; inc o1; end;
  61.     End; ; End;
  62.  
  63. Procedure Swap(Var A, B : Integer);
  64. Var t : Integer; Begin t := a; a := b; b := t; End;
  65.  
  66. Procedure Texture4Poly(X1, Y1, X2, Y2, X3, Y3, X4, Y4 : Integer; Dim : Byte);
  67. Var yMin, yMax : Integer; xStart, xEnd : Integer; yStart, yEnd : Integer;
  68.   pxStart, pxEnd : Integer; pyStart,pyEnd  : Integer; XVal, XStep : Longint;
  69.   pxVal, pxStep : Integer; pyVal, pyStep : Integer; Count : Integer;
  70.   Side : PTable;
  71. Begin
  72.   yMin := Y1; yMax := Y1;
  73.   If Y2 > yMax Then yMax := Y2; If Y3 > yMax Then yMax := Y3;
  74.   If Y4 > yMax Then yMax := Y4; If Y2 < yMin Then yMin := Y2;
  75.   If Y3 < yMin Then yMin := Y3; If Y4 < yMin Then yMin := Y4;
  76.   xStart := X1; yStart := Y1; xEnd := X2; yEnd := Y2;
  77.   pxStart := 0; pyStart := 0; pxEnd := Dim-1; pyEnd := 0;
  78.   If yStart > yEnd Then Begin
  79.       Swap(xStart, xEnd); Swap(yStart, yEnd); Swap(pxStart, pxEnd);
  80.       Side := @Left; End Else Side := @Right;
  81.   XVal := Longint(xStart) Shl 8;
  82.   XStep := (Longint(xEnd-xStart) Shl 8) Div (yEnd-yStart+1);
  83.   pxVal := pxStart Shl 8;
  84.   pxStep := ((pxEnd-pxStart) Shl 8) Div (yEnd-yStart+1);
  85.   For Count := yStart to yEnd do
  86.     Begin Side^[Count].x := XVal Shr 8; Side^[Count].px := pxVal Shr 8;
  87.       Side^[Count].py := pyStart; XVal := XVal + XStep;
  88.       pxVal := pxVal + pxStep; End;
  89.   xStart := X2; yStart := Y2; xEnd := X3; yEnd := Y3;
  90.   pxStart := Dim-1; pyStart := 0; pxEnd := Dim-1; pyEnd := Dim-1;
  91.   If yStart > yEnd Then Begin Swap(xStart, xEnd); Swap(yStart, yEnd);
  92.       Swap(pyStart, pyEnd); Side := @Left; End Else Side := @Right;
  93.   XVal := Longint(xStart) Shl 8;
  94.   XStep := (Longint(xEnd-xStart) Shl 8) Div (yEnd-yStart+1);
  95.   pyVal := pyStart Shl 8;
  96.   pyStep := ((pyEnd-pyStart) Shl 8) Div (yEnd-yStart+1);
  97.   For Count := yStart to yEnd do
  98.     Begin Side^[Count].x := XVal Shr 8; Side^[Count].py := pyVal Shr 8;
  99.       Side^[Count].px := pxStart; XVal := XVal + XStep;
  100.       pyVal := pyVal + pyStep; End;
  101.   xStart := X3; yStart := Y3; xEnd := X4; yEnd := Y4;
  102.   pxStart := Dim-1; pyStart := Dim-1; pxEnd := 0; pyEnd := Dim-1;
  103.   If yStart > yEnd Then Begin Swap(xStart, xEnd); Swap(yStart, yEnd);
  104.       Swap(pxStart, pxEnd); Side := @Left; End Else Side := @Right;
  105.   XVal := Longint(xStart) Shl 8;
  106.   XStep := (Longint(xEnd-xStart) Shl 8) Div (yEnd-yStart+1);
  107.   pxVal := pxStart Shl 8;
  108.   pxStep := ((pxEnd-pxStart) Shl 8) Div (yEnd-yStart+1);
  109.   For Count := yStart to yEnd do
  110.     Begin Side^[Count].x := XVal Shr 8; Side^[Count].px := pxVal Shr 8;
  111.       Side^[Count].py := pyStart; XVal := XVal + XStep;
  112.       pxVal := pxVal + pxStep; End;
  113.   xStart := X4; yStart := Y4;xEnd := X1; yEnd := Y1;
  114.   pxStart := 0;  pyStart := Dim-1; pxEnd := 0; pyEnd := 0;
  115.   If yStart > yEnd
  116.     Then Begin Swap(xStart, xEnd); Swap(yStart, yEnd);
  117.       Swap(pyStart, pyEnd); Side := @Left; End
  118.     Else Side := @Right;
  119.   XVal := Longint(xStart) Shl 8;
  120.   XStep := (Longint(xEnd-xStart) Shl 8) Div (yEnd-yStart+1);
  121.   pyVal := pyStart Shl 8;
  122.   pyStep := ((pyEnd-pyStart) Shl 8) Div (yEnd-yStart+1);
  123.   For Count := yStart to yEnd do
  124.     Begin Side^[Count].x := XVal Shr 8; Side^[Count].py := pyVal Shr 8;
  125.       Side^[Count].px := pxStart; XVal := XVal + XStep;
  126.       pyVal := pyVal + pyStep; End;
  127.   For Count := yMin to yMax do
  128.     If Left[Count].x < Right[Count].x
  129.       Then TextureHLine(Left[Count].x, Right[Count].x, Left[Count].px, Left[Count].py,
  130.               Right[Count].px, Right[Count].py, Count, Dim)
  131.       Else TextureHLine(Right[Count].x, Left[Count].x, Right[Count].px, Right[Count].py,
  132.               Left[Count].px, Left[Count].py, Count, Dim);
  133. End;
  134.  
  135. procedure setpal(c,r,g,b:byte); assembler;
  136. asm; mov dx,3c8h; mov al,[c]; out dx,al; inc dx; mov al,[r]; out dx,al
  137.   mov al,[g]; out dx,al; mov al,[b]; out dx,al; end;
  138.  
  139. procedure flip(src,dst:word); assembler; asm
  140. push ds; mov es,[dst]; mov ds,[src]; xor si,si; xor di,di; mov cx,320*200/2
  141. rep movsw; pop ds; end;
  142.  
  143. procedure quicksort(lo,hi:integer);
  144.  
  145. procedure sort(l,r:integer);
  146. var i,j,x,y:integer;
  147. begin
  148.   i:=l; j:=r; x:=polyz[(l+r) div 2];
  149.   repeat
  150.     while polyz[i]<x do inc(i); while x<polyz[j] do dec(j);
  151.     if i<=j then begin y:=polyz[i]; polyz[i]:=polyz[j]; polyz[j]:=y;
  152.       y:=pind[i]; pind[i]:=pind[j]; pind[j]:=y; inc(i); dec(j); end;
  153.   until i>j; if l<j then sort(l,j); if i<r then sort(i,r);
  154. end;
  155. begin sort(lo,hi); end;
  156.  
  157. function sinus(i:byte):integer; begin sinus:=stab[i]; end;
  158. function cosinus(i:byte):integer; begin cosinus:=stab[(i+192) mod 255]; end;
  159.  
  160. procedure rotate_cube;
  161. const xst=2; yst=3; zst=-4;
  162. var
  163.   xp,yp,z:array[0..11] of integer;
  164.   x,y,i,j,k:integer;
  165.   n,Key,phix,phiy,phiz:byte;
  166. begin
  167.   phix:=0; phiy:=0; phiz:=40; fillchar(xp,sizeof(xp),0);
  168.   fillchar(yp,sizeof(yp),0); Frame := 0; St := Time;
  169.   repeat
  170.     flip(pageseg,virseg);
  171.     for n:=0 to pointnum do begin
  172.       i:=(cosinus(phiy)*points[n,0]-sinus(phiy)*points[n,2]) div divd;
  173.       j:=(cosinus(phiz)*points[n,1]-sinus(phiz)*i) div divd;
  174.       k:=(cosinus(phiy)*points[n,2]+sinus(phiy)*points[n,0]) div divd;
  175.       x:=(cosinus(phiz)*i+sinus(phiz)*points[n,1]) div divd;
  176.       y:=(cosinus(phix)*j+sinus(phix)*k) div divd;
  177.       z[n]:=(cosinus(phix)*k-sinus(phix)*j) div divd+cosinus(phix) div 3;
  178.       xp[n]:=160+sinus(phix) div 2+(-x*dist) div (z[n]-dist);
  179.       yp[n]:=100+(-y*dist) div (z[n]-dist);
  180.     end;
  181.     for n:=0 to planenum do begin
  182.       polyz[n]:=(z[planes[n,0]]+z[planes[n,2]]) div 2; pind[n]:=n; end;
  183.     quicksort(0,planenum);
  184.     for n:=0 to planenum do
  185.       texture4poly(xp[planes[pind[n],0]],yp[planes[pind[n],0]],
  186.                    xp[planes[pind[n],1]],yp[planes[pind[n],1]],
  187.                    xp[planes[pind[n],2]],yp[planes[pind[n],2]],
  188.                    xp[planes[pind[n],3]],yp[planes[pind[n],3]],16);
  189.     inc(phix,xst); inc(phiy,yst); inc(phiz,zst); flip(virseg,vidseg);
  190.     inc(frame); until keypressed; Et:=time; end;
  191.  
  192. var i,j:word;
  193. begin
  194.   asm mov ax,13h; int 10h; end;
  195.   getmem(virscr,64000);
  196.   virseg:=seg(virscr^);
  197.   getmem(page,64000);
  198.   pageseg:=seg(page^);
  199.   for i:=0 to 255 do stab[i]:=round(sin(i*pi/128)*divd);
  200.   for i:=1 to 104 do setpal(150+i,0,20+i div 4,30+i div 5);
  201.   for i:=0 to 319 do for j:=0 to 199 do mem[pageseg:j*320+i]:=151+(i*i+j*j) mod
  202. 104;
  203.   rotate_cube;
  204.   freemem(page,64000);
  205.   freemem(virscr,64000);
  206.   textmode(lastmode);
  207.   Writeln(Frame*18.2/(Et-St):5:2, ' fps');
  208. end.
  209.  
  210.