home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / rot8.pas < prev    next >
Pascal/Delphi Source File  |  1994-06-22  |  3KB  |  123 lines
  1.  
  2. program Rotation;
  3. { Improved cube (rot2), using BGI and pageswapping, by Bas van Gaalen, Holland, PD }
  4. uses
  5.   crt,graph;
  6.  
  7. const
  8.   GraphPath = 'I:\BGI';
  9.  
  10.   Xc = 0;
  11.   Yc = 0;
  12.   Zc = 150;
  13.   Point : array[0..7,0..2] of integer = (
  14.     (-50,50,50),(50,50,50),(50,-50,50),(-50,-50,50),
  15.     (-50,50,-50),(50,50,-50),(50,-50,-50),(-50,-50,-50));
  16.   Lines : array[0..11,0..1] of byte = (
  17.     (0,1),(1,2),(2,3),(3,0),(0,4),(1,5),(2,6),(3,7),(4,5),(5,6),(6,7),(7,4));
  18.  
  19. type
  20.   TabType = array[0..255] of integer;
  21.  
  22. var
  23.   SinTab : TabType;
  24.  
  25. {----------------------------------------------------------------------------}
  26.  
  27. procedure Setvideo;
  28.  
  29. var
  30.   GrDr,GrMd,Err : integer;
  31.  
  32. begin
  33.   GrMd := 1; GrDr := 0;
  34.   initGraph(GrDr,GrMd,GraphPath);
  35.   Err := graphresult;
  36.   if Err <> 0 then begin
  37.     writeln('Graphics error: ',grapherrormsg(Err));
  38.     halt;
  39.   end;
  40.   setgraphmode(1);
  41. end;
  42.  
  43. {----------------------------------------------------------------------------}
  44.  
  45. procedure Calcsinus(var SinTab : TabType); var I : byte; begin
  46.   for I := 0 to 255 do SinTab[I] := round(sin(2*I*pi/255)*128); end;
  47.  
  48. {----------------------------------------------------------------------------}
  49.  
  50. function Sinus(Idx : byte) : integer; begin
  51.   Sinus := SinTab[Idx]; end;
  52.  
  53. {----------------------------------------------------------------------------}
  54.  
  55. function Cosinus(Idx : byte) : integer; begin
  56.   Cosinus := SinTab[(Idx+192) mod 255]; end;
  57.  
  58. {----------------------------------------------------------------------------}
  59.  
  60. procedure Rotate;
  61.  
  62. const
  63.   Xstep = 1;
  64.   Ystep = 1;
  65.   Zstep = -1;
  66.  
  67. var
  68.   Xp,Yp : array[0..7] of word;
  69.   Xp2,Yp2 : array[0..7] of word;
  70.   X,Y,Z,X1,Y1,Z1 : integer;
  71.   I,PhiX,PhiY,PhiZ,Page : byte;
  72.  
  73. begin
  74.   Page := 0; PhiX := 0; PhiY := 0; PhiZ := 0;
  75.   for I := 0 to 7 do begin
  76.     Xp[I] := 0; Yp[I] := 0; Xp2[I] := 0; Yp2[I] := 0; end;
  77.   repeat
  78.     Page := Page xor 1;
  79.     setvisualpage(Page);
  80.     setactivepage(Page xor 1);
  81.     setcolor(black);
  82.     for I := 0 to 11 do
  83.       line(Xp2[Lines[I,0]],Yp2[Lines[I,0]],Xp2[Lines[I,1]],Yp2[Lines[I,1]]);
  84.  
  85.     move(Xp,Xp2,sizeof(Xp));
  86.     move(Yp,Yp2,sizeof(Xp));
  87.  
  88.     for I := 0 to 7 do begin
  89.       X1 := (Cosinus(PhiY)*Point[I,0]-Sinus(PhiY)*Point[I,2]) div 128;
  90.       Y1 := (Cosinus(PhiZ)*Point[I,1]-Sinus(PhiZ)*X1) div 128;
  91.       Z1 := (Cosinus(PhiY)*Point[I,2]+Sinus(PhiY)*Point[I,0]) div 128;
  92.       X := (Cosinus(PhiZ)*X1+Sinus(PhiZ)*Point[I,1]) div 128;
  93.       Y := (Cosinus(PhiX)*Y1+Sinus(PhiX)*z1) div 128;
  94.       Z := (Cosinus(PhiX)*Z1-Sinus(PhiX)*Y1) div 128;
  95.       Xp[I] := 320+(Xc*Z-X*Zc) div (Z-Zc);
  96.       Yp[I] := 175+(Yc*Z-Y*Zc) div (Z-Zc);
  97.     end;
  98.  
  99.     inc(PhiX,Xstep);
  100.     inc(PhiY,Ystep);
  101.     inc(PhiZ,Zstep);
  102.  
  103.     setvisualpage(Page);
  104.     setactivepage(Page xor 1);
  105.  
  106.     setcolor(lightgreen);
  107.     for I := 0 to 11 do
  108.       line(Xp[Lines[I,0]],Yp[Lines[I,0]],Xp[Lines[I,1]],Yp[Lines[I,1]]);
  109.  
  110.     delay(15);
  111.  
  112.   until keypressed;
  113. end;
  114.  
  115. {----------------------------------------------------------------------------}
  116.  
  117. begin
  118.   Setvideo;
  119.   Calcsinus(SinTab);
  120.   Rotate;
  121.   textmode(lastmode);
  122. end.
  123.