home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / 3dchkbrd.pas next >
Pascal/Delphi Source File  |  1994-06-22  |  3KB  |  104 lines
  1.  
  2. {$r-}
  3. program polygoned_and_shaded_modex_octagon; { inclusief clipping test! }
  4. { hline routine by Sean Palmer }
  5. uses
  6.   crt,x3dunit;
  7. const
  8.   point:array[0..35,0..2] of integer=(
  9.   (-50,-50,20),(-30,-50,20),(-10,-50,20),(10,-50,20),(30,-50,20),(50,-50,20),
  10.   (-50,-30,20),(-30,-30,20),(-10,-30,20),(10,-30,20),(30,-30,20),(50,-30,20),
  11.   (-50,-10,20),(-30,-10,20),(-10,-10,20),(10,-10,20),(30,-10,20),(50,-10,20),
  12.   (-50,10,20),(-30,10,20),(-10,10,20),(10,10,20),(30,10,20),(50,10,20),
  13.   (-50,30,20),(-30,30,20),(-10,30,20),(10,30,20),(30,30,20),(50,30,20),
  14.   (-50,50,20),(-30,50,20),(-10,50,20),(10,50,20),(30,50,20),(50,50,20));
  15.   planes:array[0..12,0..3] of byte=(
  16.   (0,1,7,6),(2,3,9,8),(4,5,11,10),(7,8,14,13),(9,10,16,15),
  17.   (12,13,19,18),(14,15,21,20),(16,17,23,22),(19,20,26,25),
  18.   (21,22,28,27),(24,25,31,30),(26,27,33,32),(28,29,35,34));
  19. var polyz:array[0..12] of integer; pind:array[0..12] of byte;
  20.  
  21. { -------------------------------------------------------------------------- }
  22.  
  23. procedure quicksort(lo,hi:integer);
  24.  
  25. procedure sort(l,r:integer);
  26. var i,j,x,y:integer;
  27. begin
  28.   i:=l; j:=r; x:=polyz[(l+r) div 2];
  29.   repeat
  30.     while polyz[i]<x do inc(i);
  31.     while x<polyz[j] do dec(j);
  32.     if i<=j then begin
  33.       y:=polyz[i]; polyz[i]:=polyz[j]; polyz[j]:=y;
  34.       y:=pind[i]; pind[i]:=pind[j]; pind[j]:=y;
  35.       inc(i); dec(j);
  36.     end;
  37.   until i>j;
  38.   if l<j then sort(l,j);
  39.   if i<r then sort(i,r);
  40. end;
  41.  
  42. begin
  43.   sort(lo,hi);
  44. end;
  45.  
  46. { -------------------------------------------------------------------------- }
  47.  
  48. procedure rotate_cube;
  49. const
  50.   xst=-1; yst=-1; zst=2;
  51. var
  52.   xp,yp,z:array[0..35] of integer;
  53.   x,y,i,j,k:integer;
  54.   n,Key,phix,phiy,phiz:byte;
  55. begin
  56.   address := 0;
  57.   phix:=50; phiy:=150; phiz:=20;
  58.   fillchar(xp,sizeof(xp),0);
  59.   fillchar(yp,sizeof(yp),0);
  60.   fillchar(z,sizeof(z),0);
  61.   repeat
  62.     retrace;
  63.     setborder(1);
  64.     for n:=0 to 35 do begin
  65.       i:=(cosinus(phiy)*point[n,0]-sinus(phiy)*point[n,2]) div divd;
  66.       j:=(cosinus(phiz)*point[n,1]-sinus(phiz)*i) div divd;
  67.       k:=(cosinus(phiy)*point[n,2]+sinus(phiy)*point[n,0]) div divd;
  68.       x:=(cosinus(phiz)*i+sinus(phiz)*point[n,1]) div divd;
  69.       y:=(cosinus(phix)*j+sinus(phix)*k) div divd;
  70.       z[n]:=(cosinus(phix)*k-sinus(phix)*j) div divd;
  71.       xp[n]:=160+(-x*dist) div (z[n]-dist);
  72.       yp[n]:=100+(-y*dist) div (z[n]-dist);
  73.     end;
  74.     for n:=0 to 12 do begin
  75.       polyz[n]:=(z[planes[n,0]]+z[planes[n,1]]+z[planes[n,2]]+z[planes[n,3]]) div 4;
  76.       pind[n]:=n;
  77.     end;
  78.     quicksort(0,12);
  79.     address:=16000-address;
  80.     setaddress(address);
  81.     cls;
  82.     for n:=0 to 12 do
  83.       polygon(xp[planes[pind[n],0]],yp[planes[pind[n],0]],
  84.               xp[planes[pind[n],1]],yp[planes[pind[n],1]],
  85.               xp[planes[pind[n],2]],yp[planes[pind[n],2]],
  86.               xp[planes[pind[n],3]],yp[planes[pind[n],3]],1);
  87.     inc(phix,xst); inc(phiy,yst); inc(phiz,zst);
  88.     setborder(0);
  89.   until keypressed;
  90. end;
  91.  
  92. { -------------------------------------------------------------------------- }
  93.  
  94. var i,j:byte;
  95. begin
  96.   setmodex;
  97.   border:=true;
  98.   setpal(1,20,30,40);
  99.   rotate_cube;
  100.   textmode(lastmode);
  101. end.
  102.  
  103. { Runs too slow on a 386, actualy needs a 486 or a major update in asm. ;-) }
  104.