home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / 3dxhex.pas < prev    next >
Pascal/Delphi Source File  |  1994-06-22  |  3KB  |  102 lines
  1.  
  2. {$r-} { <--- Need, eh? ;-) }
  3. program polygoned_and_shaded_octagon; { inc. clipping }
  4. { mode-x version of polygoned objects, by Bas van Gaalen & Sven van Heel }
  5. uses crt,x3dunit;
  6. const
  7.   nofpolys=9; { number of polygons -1 }
  8.   nofpoints=11; { number of points -1 }
  9.   point:array[0..nofpoints,0..2] of integer=(
  10.     (-20,-20, 30),( 20,-20, 30),( 40,-40,  0),( 20,-20,-30),
  11.     (-20,-20,-30),(-40,-40,  0),(-20, 20, 30),( 20, 20, 30),
  12.     ( 40, 40,  0),( 20, 20,-30),(-20, 20,-30),(-40, 40,  0));
  13.   planes:array[0..nofpolys,0..3] of byte=(
  14.     (0,1,7,6),(1,2,8,7),(9,8,2,3),(10,9,3,4),(10,4,5,11),
  15.     (6,11,5,0),(0,1,2,5),(5,2,3,4),(6,7,8,11),(11,8,9,10));
  16. type polytype=array[0..nofpolys] of integer;
  17. var polyz,pind:polytype;
  18.  
  19. { -------------------------------------------------------------------------- }
  20.  
  21. procedure quicksort(lo,hi:integer);
  22.  
  23. procedure sort(l,r:integer);
  24. var i,j,x,y:integer;
  25. begin
  26.   i:=l; j:=r; x:=polyz[(l+r) div 2];
  27.   repeat
  28.     while polyz[i]<x do inc(i);
  29.     while x<polyz[j] do dec(j);
  30.     if i<=j then begin
  31.       y:=polyz[i]; polyz[i]:=polyz[j]; polyz[j]:=y;
  32.       y:=pind[i]; pind[i]:=pind[j]; pind[j]:=y;
  33.       inc(i); dec(j);
  34.     end;
  35.   until i>j;
  36.   if l<j then sort(l,j);
  37.   if i<r then sort(i,r);
  38. end;
  39.  
  40. begin
  41.   sort(lo,hi);
  42. end;
  43.  
  44. { -------------------------------------------------------------------------- }
  45.  
  46. procedure rotate_cube;
  47. const xst=1; yst=1; zst=-1;
  48. var
  49.   xp,yp,z:array[0..nofpoints] of integer;
  50.   x,y,i,j,k:integer;
  51.   n,key,phix,phiy,phiz:byte;
  52. begin
  53.   address := 0;
  54.   phix:=0; phiy:=0; phiz:=0;
  55.   fillchar(xp,sizeof(xp),0);
  56.   fillchar(yp,sizeof(yp),0);
  57.   fillchar(z,sizeof(z),0);
  58.   repeat
  59.     retrace;
  60.     setborder(60);
  61.     for n:=0 to nofpoints do begin
  62.       i:=(cosinus(phiy)*point[n,0]-sinus(phiy)*point[n,2]) div divd;
  63.       j:=(cosinus(phiz)*point[n,1]-sinus(phiz)*i) div divd;
  64.       k:=(cosinus(phiy)*point[n,2]+sinus(phiy)*point[n,0]) div divd;
  65.       x:=(cosinus(phiz)*i+sinus(phiz)*point[n,1]) div divd;
  66.       y:=(cosinus(phix)*j+sinus(phix)*k) div divd;
  67.       z[n]:=(cosinus(phix)*k-sinus(phix)*j) div divd;
  68.       xp[n]:=160+cosinus(phix)+(-x*dist) div (z[n]-dist);
  69.       yp[n]:=100-sinus(phiy) div 2+(-y*dist) div (z[n]-dist);
  70.     end;
  71.     for n:=0 to nofpolys do begin
  72.       polyz[n]:={(}z[planes[n,0]]+z[planes[n,1]]+z[planes[n,2]]+z[planes[n,3]]{) div 4};
  73.       pind[n]:=n;
  74.     end;
  75.     quicksort(0,nofpolys);
  76.     address:=16000-address;
  77.     setaddress(address);
  78.     cls;
  79.     for n:=5 to nofpolys do
  80.       polygon(xp[planes[pind[n],0]],yp[planes[pind[n],0]],
  81.               xp[planes[pind[n],1]],yp[planes[pind[n],1]],
  82.               xp[planes[pind[n],2]],yp[planes[pind[n],2]],
  83.               xp[planes[pind[n],3]],yp[planes[pind[n],3]],polyz[n]+64);
  84.     inc(phix,xst); inc(phiy,yst); inc(phiz,zst);
  85.     setborder(0);
  86.   until keypressed;
  87. end;
  88.  
  89. { -------------------------------------------------------------------------- }
  90.  
  91. var i:byte;
  92. begin
  93.   setmodex;
  94.   {border:=true;}
  95.   for i:=1 to 255 do setpal(i,i div 16,i div 8,i div 4);
  96.   rotate_cube;
  97.   textmode(lastmode);
  98. end.
  99.  
  100. { Mode-x version! Quite final, except for major asm updates.
  101.   Realy smooth and fast (relative to the 13h version)! }
  102.