home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / TPROUTN.ZIP / GRAPHSRC.LBR / CUBE.PAS next >
Encoding:
Pascal/Delphi Source File  |  1985-05-15  |  2.8 KB  |  82 lines
  1. program cube;      { Author: William P. Smith  }
  2.                    {         Mitchellville, Md }
  3.  
  4.                    { This is a real time graphics demo of a cube tumbling in }
  5.                    { 3-space.   The 8088 processor is just too slow to do    }
  6.                    { effectively demonstrate real time graphics, but this    }
  7.                    { program can be used as a bench mark for graphics        }
  8.                    { performance of future generation PCs.                   }
  9.  
  10. const color = 4;
  11.  
  12. var A,B,Ax,Bx,Ay,By,Az,Bz,TH,THx,THy,THz: real;
  13.     T:     array[1..3,1..3] of real;
  14.     Xp,Yp: array[1..3] of integer;
  15.     X,Y:   array[1..7] of integer;
  16.     j,offsetX,offsetY,incrX,incrY: integer;
  17.     Video: Byte absolute $B800:0000;
  18.  
  19. procedure DrawCube(THx,THy,THz: real);
  20. begin
  21.   Az:=cos(THz);   Ax:=cos(THx);  Ay:=cos(THy);
  22.   Bz:=sin(THz);   Bx:=sin(THx);  By:=sin(THy);
  23.   t[1,1]:=Az*Ay-Bx*By*Bz;  t[1,2]:=-Bz*Ax;  t[1,3]:=Az*By+Ay*Bz*Bx;
  24.   t[2,1]:=Bz*Ay+Az*Bx*By;  t[2,2]:=Az*Ax;   t[2,3]:=Bz*By-Az*Ay*Bx;
  25.   t[3,1]:=-Ax*By;          t[3,2]:=Bx;      t[3,3]:=Ax*Ay;
  26.   for j:=1 to 3 do begin
  27.     xp[j]:=round(60*(t[2,j]-t[1,j]*B));
  28.     yp[j]:=round(30*(t[3,j]-t[1,j]*A));
  29.   end;
  30.   X[1]:=offsetx+xp[1];               Y[1]:=offsety-yp[1];
  31.   X[2]:=X[1]+xp[2];                  Y[2]:=Y[1]-yp[2];
  32.   X[3]:=offsetx+xp[2];               Y[3]:=offsety-yp[2];
  33.   X[4]:=X[3]+xp[3];                  Y[4]:=Y[3]-yp[3];
  34.   X[5]:=offsetx+xp[3];               Y[5]:=offsety-yp[3];
  35.   X[6]:=X[1]+xp[3];                  Y[6]:=Y[1]-yp[3];
  36.   X[7]:=X[2]+xp[3];                  Y[7]:=Y[2]-yp[3];
  37.  
  38.  
  39.   fillchar(Video,$4000,$FF);
  40.  
  41.   draw(OffsetX,OffsetY,X[1],Y[1],0);
  42.   draw(X[1],Y[1],X[2],Y[2],0);
  43.   draw(X[2],Y[2],X[3],Y[3],0);
  44.   draw(X[3],Y[3],X[4],Y[4],0);
  45.   draw(X[4],Y[4],X[5],Y[5],0);
  46.   draw(X[5],Y[5],X[6],Y[6],0);
  47.   draw(X[6],Y[6],X[7],Y[7],0);
  48.   draw(X[7],Y[7],X[4],Y[4],0);
  49.   draw(X[3],Y[3],OffsetX,OffsetY,0);
  50.   draw(OffsetX,OffsetY,X[5],Y[5],0);
  51.   draw(X[6],Y[6],X[1],Y[1],0);
  52.   draw(X[7],Y[7],X[2],Y[2],0);
  53.  
  54. end;
  55. procedure beep;
  56. begin
  57.   sound(200);
  58.   delay(100);
  59.   Nosound;
  60. end;
  61. begin
  62.   TH:=pi/4;
  63.   A:=cos(TH); B:=sin(TH);
  64.   offsetX:=300; offsetY:=100;
  65.   incrX:=5; incrY:=3;
  66.   Hires; Hirescolor(color);
  67.   THx:=0.0; THy:=0.0; THz:=0.0;
  68.   drawCube(THx,THy,THz);
  69.   repeat
  70.     THz:=THz+0.1; THx:=THX-0.1; THy:=Thy+0.1;
  71.     drawCube(THx,THy,THz);
  72.     if (offsetX>=500) or (offsetX<=40) then begin
  73.       incrX:=-incrX;
  74.       beep;
  75.     end;
  76.     if (offsetY<=30) or (offsetY>=180) then begin
  77.       incrY:=-incrY;
  78.       beep;
  79.     end;
  80.     offsetX:=offsetX+incrX; offsetY:=offsetY+incrY;
  81.   until keypressed;
  82. end.