home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / TURBO9.ZIP / PLOT3D.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-06-12  |  7.2 KB  |  249 lines
  1. Program ThreeD;
  2.  
  3. {  This program displays and rotates three-dimensional images on     }
  4. {  the IBM PC's graphics display.  The program used three data files }
  5. {  on the default drive.  The data files have the extension '.3D'.   }
  6. {                                                                    }
  7. {  The program uses two External Procedures: Line.inv & Cls.inv.     }
  8. {  These procedures must be on the default drive when compiling.     }
  9. {                                                                    }
  10. {  Author - Jay Mallin                                               }
  11. {           PC Tech Journal, May 1984, pp. 44-48.                    }
  12. {           Typed & Translated into Pascal by Jeff Firestone.        }
  13.  
  14.  
  15. Type
  16.   Strng = String[200];
  17.  
  18. Var
  19.   Nam : Strng;
  20.   f : text;
  21.   exit : boolean;
  22.   i, j, Length, LineCount, pnt, pta, ptb, temp1, temp2 : integer;
  23.  
  24.   max, xmax, ymax, zmax, xmin, ymin, zmin : real;
  25.   Center, Xcenter, Ycenter, Zcenter : Real;
  26.   factor, temp, rcnt : real;
  27.  
  28.   Rot : Array [0..2, 0..2] of real;
  29.   Lines : Array [0..149, 0..1] of integer;
  30.   XYZ : Array [0..149, 0..2] of real;
  31.   XY : Array [0..149, 0..1] of integer;
  32.  
  33.  
  34. Procedure Line(x1,y1,x2,y2,color:integer);
  35.           External 'line.inv';
  36.  
  37. Procedure Cls; External 'Cls.inv';
  38.  
  39.  
  40. Procedure InitPrgm;  { Initialize the arrays & global variables }
  41. Begin
  42.   FillChar(Rot, SizeOf(Rot), 0);
  43.   FillChar(Lines, SizeOf(Lines), 0);
  44.   FillChar(XYZ, SizeOf(XYZ), 0);
  45.   FillChar(XY, SizeOf(XY), 0);
  46.   max:= 0; Center:= 0; Rcnt:= 0;
  47.   ClrScr;
  48. end;
  49.  
  50.  
  51. { Array XYZ contains the three coordinates for each data point, and  }
  52. { Array XY contains the x, y coordinates for drawing on the display. }
  53.  
  54. Procedure ReadFile;  { Read in the data from the '.3D' file }
  55. begin
  56.   assign(f, 'pyramid.3d');
  57.   reset(f);
  58.   readln(f, length);
  59.   for i:= 0 to length-1 do
  60.     read(f, xyz[i,0], xyz[i,1], xyz[i,2]);
  61.  
  62. { Now get the pairs of points to connect with lines and store in the   }
  63. { array LINES.                                                         }
  64.  
  65.   LineCount:= -1;
  66.   while (LineCount < 149) and not(EOF(f)) do
  67.   begin
  68.     LineCount:= LineCount + 1;
  69.     read(f, temp1, temp2);
  70.     Lines[LineCount, 0]:= Temp1-1;
  71.     Lines[LineCount, 1]:= Temp2-1;
  72.   end;
  73. end;
  74.  
  75.  
  76. { The figure is centered, then proportioned to fit on the screen.      }
  77. { The first step is to find the largest and smallest value of x,y & z. }
  78.  
  79. Procedure SetupVars;  { Initialize our Variables }
  80. begin
  81.   xmax:= xyz[0,0]; ymax:= xyz[0,1]; zmax:= xyz[0,2];
  82.   xmin:= xmax;     ymin:= ymax;     zmin:= zmax;
  83.   for i:= 1 to length do
  84.   begin
  85.     if xyz[i,0] > xmax then xmax:= xyz[i,0];
  86.     if xyz[i,1] > ymax then ymax:= xyz[i,1];
  87.     if xyz[i,2] > zmax then zmax:= xyz[i,2];
  88.     if xyz[i,0] < xmin then xmin:= xyz[i,0];
  89.     if xyz[i,1] < ymin then ymin:= xyz[i,1];
  90.     if xyz[i,2] < zmin then zmin:= xyz[i,2];
  91.   end;
  92.  
  93. { A center is found between the greatest and smallest values for each   }
  94. { of the three axis, and all the coordinate values are adjusted to move }
  95. { those centers to be at the center.                                    }
  96.  
  97.   Xcenter:= (xmax + xmin) / 2;
  98.   Ycenter:= (ymax + ymin) / 2;
  99.   Zcenter:= (zmax + zmin) / 2;
  100.   for i:= 0 to length do
  101.   begin
  102.     xyz[i,0]:= xyz[i,0] - Xcenter;
  103.     xyz[i,1]:= xyz[i,1] - Ycenter;
  104.     xyz[i,2]:= xyz[i,2] - Zcenter;
  105.   end;
  106.  
  107. { The largest value of all the newly adjusted coordinates is found, }
  108. { and that is used to scale the picture to stay within the screen.  }
  109.  
  110.   max:= Xmax - Xcenter;
  111.   writeln(max,' ',xmax,' ',ymax,' ',zmax);
  112.   writeln(xcenter,' ',ycenter,' ',zcenter);
  113.   if max < Ymax - Ycenter then max:= Ymax - Ycenter;
  114.   if max < Zmax - Zcenter then max:= Zmax - Zcenter;
  115.   Factor:= 90 / Max;
  116.   for i:= 0 to length do
  117.   begin
  118.     xyz[i,0]:= factor * xyz[i,0];
  119.     xyz[i,1]:= factor * xyz[i,1];
  120.     xyz[i,2]:= factor * xyz[i,2];
  121.   end;
  122. end;
  123.  
  124.  
  125. { Now we begin the section of Procedure which are run each time we }
  126. { wish to rotate the object in XYZ.                                }
  127.  
  128. Procedure DrawIt;
  129.  
  130. { First build the 2D data based upon the 3D data.                  }
  131.  
  132. begin
  133.   for pnt:= 0 to length do
  134.   begin
  135.     xy[pnt, 1]:= round(91 - (5*xyz[pnt,2]/12));
  136.     xy[pnt, 0]:= round(320 + xyz[pnt, 1]);
  137.   end;
  138.  
  139. { Clear the old screen and draw the 2D data by connecting the points. }
  140.  
  141.   cls;
  142.   for i:= 0 to LineCount do
  143.   begin
  144.     pta:= Lines[i,0];
  145.     ptb:= Lines[i,1];
  146.     Line(xy[pta,0],xy[pta,1],xy[ptb,0],xy[ptb,1],1);
  147.   end;
  148. end;
  149.  
  150.  
  151. { This procedure is not currently being used. }
  152. Procedure GetCoords;
  153.     begin
  154.       gotoXY(1,24);
  155.       writeln('Enter next rotation in degrees for each axis, or enter 361 to exit.');
  156.       Line(0,199,620,199,1);
  157.       gotoXY(1,25);
  158.       write('X: '); read(rot[0,0]);
  159.       if rot[0,0] = 361 then exit:= true;
  160.       gotoXY(14,25);
  161.       write('Y: '); read(rot[1,0]);
  162.       if rot[1,0] = 361 then exit:= true;
  163.       gotoXY(27,25);
  164.       write('Z: '); read(rot[2,0]);
  165.       if rot[2,0] = 361 then exit:= true;
  166.     end;  {Procedure GetCoords}
  167.  
  168.  
  169. { Convert the coordinates and rotates them about the x, y & Z axis. }
  170.  
  171. Procedure CalcCoords;
  172.     begin
  173.  
  174. { Convert the input to degrees; find SIN and COS of each.  All the }
  175. { results are stored in Rot.                                       }
  176.  
  177.       for i:= 0 to 2 do
  178.       begin
  179.         rot[i,0]:= pi*(round(rot[i,0]) mod 360)/180;
  180.         rot[i,1]:= sin(rot[i,0]);
  181.         rot[i,2]:= cos(rot[i,0]);
  182.       end;
  183.  
  184. { Compute the new coordinates in XYZ to rotate around the Z axis.  }
  185.  
  186.       if rot[2,2] <> 1 then
  187.         for pnt:= 0 to length do
  188.         begin
  189.           temp:= xyz[pnt,0];
  190.           xyz[pnt,0]:= (rot[2,2] * xyz[pnt,0]) - (rot[2,1] * xyz[pnt,1]);
  191.           xyz[pnt,1]:= (rot[2,1] * temp) + (rot[2,2] * xyz[pnt,1]);
  192.         end;
  193.  
  194. { Rotate around the Y axis if the rotation is not 0. }
  195.  
  196.       if rot[1,2] <> 1 then
  197.         for pnt:= 0 to length do
  198.         begin
  199.           temp:= xyz[pnt,0];
  200.           xyz[pnt,0]:= (temp * rot[1,2]) + (xyz[pnt,2] * rot[1,1]);
  201.           xyz[pnt,2]:= (xyz[pnt,2] * rot[1,2]) - (temp * rot[1,1]);
  202.         end;
  203.  
  204. { Rotate around the X axis. }
  205.  
  206.       if rot[0,2] <> 1 then
  207.          for pnt:= 0 to length do
  208.          begin
  209.            temp:= xyz[pnt,1];
  210.            xyz[pnt,1]:= (temp * rot[0,2]) - (xyz[pnt,2] * rot[0,1]);
  211.            xyz[pnt,2]:= (temp * rot[0,1]) + (xyz[pnt,2] * rot[0,2]);
  212.          end;
  213.     end; {Procedure CalcCoords}
  214.  
  215.  
  216. { Here we caculate the stepping of the rotation.  This sends the figure  }
  217. { spinning in space.                                                     }
  218.  
  219. Procedure ProcessCoords;
  220. begin
  221.   exit:= false;
  222.   while not(exit) do
  223.   begin
  224.     DrawIt;
  225. {    GetCoords;  }
  226.     rot[0,0]:= rot[0,0]+3;  { X axis rotation }
  227.     rot[1,0]:= rot[1,0]+1;  { Y axis rotation }
  228.     rot[2,0]:= rot[2,0]+6;  { Z axis rotation }
  229.     rcnt:=rcnt+1;if rcnt>40 then exit:= true;
  230.     CalcCoords;
  231.  
  232.     for i:= 0 to length do
  233.     begin
  234.       xyz[i,0]:= 0.98 * xyz[i,0];
  235.       xyz[i,1]:= 0.94 * xyz[i,1];
  236.       xyz[i,2]:= 0.9 * xyz[i,2];
  237.     end;
  238.   end; {while not(exit)}
  239. end; {Procedure ProcessCoords}
  240.  
  241.  
  242. begin
  243.   InitPrgm;
  244.   ReadFile;
  245.   SetupVars;
  246.   HiRes;  HiResColor(7);
  247.   ProcessCoords;
  248.   TextMode;
  249. end.