home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol069 / make.pas < prev    next >
Pascal/Delphi Source File  |  1984-04-29  |  14KB  |  473 lines
  1. External GRAPHICS::MAKE(3);
  2. (*$E+ *)
  3.  
  4. procedure Start;
  5. { clear screen }
  6. var
  7.   I,J : counter;
  8. begin
  9.   for I := 0 to DotsAcross do
  10.     for J := 0 to DotsDown do
  11.       Screen[I,J] := false
  12. end;    { start }
  13.  
  14. (*$L+ *)
  15. procedure Finish;
  16. { display output for H-19 terminal }
  17. var
  18.   I,J : counter;
  19. begin
  20.   write(chr(escape),'E');    { clear screen & home cursor }
  21.   write(chr(escape),'F');    { put terminal into graphics mode }
  22.   write(chr(escape),'w');    { no wraparound at end of line }
  23.   J := DotsDown;
  24.   while J>0 do
  25.     begin
  26.       for I := 0 to DotsAcross do
  27.     if (Screen[I,J] and Screen[I,J-1])
  28.           then write('q')
  29.           else if Screen[I,J-1]
  30.                  then write('l')
  31.          else if Screen[I,J]
  32.                 then write('o')
  33.             else write(' ');
  34.          if J>1
  35.            then J:=J-2    { count down by two }
  36.        else J := 0;
  37.          if J>0
  38.            then writeln        { CR/LF unless last line }
  39.     end; { while }
  40.   write(chr(escape),'G');    { exit graphics mode }
  41.   write(chr(escape),'j');    { save cursor position }
  42.   write(chr(escape),'x','1');{ enable 25th line }
  43.   write(chr(escape),'Y','8',' ');{ put cursor at start of 25th }
  44.   with EyePt do write('eye:',X:4:1,Y:4:1,Z:4:1);
  45.   with CntrInt do write(' cent:',X:4:1,Y:4:1,Z:4:1);
  46.   readln(CmdChar);        { get <CR> before continuing }
  47.   write(chr(escape),'l');    { erase entire line }
  48.   write(chr(escape),'k');    { restore cursor position }
  49.   write(chr(escape),'v')    { permit wraparound }
  50. end;    { Finish }
  51.  
  52. (*$L+ *)
  53. procedure MoveTo( X,Y : real);
  54. begin
  55.   ScreenX := X;  ScreenY := Y;
  56. end; { MoveTo }
  57.  
  58. (*$L+ *)
  59. procedure DrawTo( X,Y : real);
  60. var
  61.   I : counter;
  62.   Dx,Dy,Length,StepX,StepY,Xpos,Ypos : real;
  63. begin
  64.   Dx := X - ScreenX;
  65.   Dy := Y - ScreenY;
  66.   if abs(Dx) > abs(Dy)
  67.     then Length := abs(Dx)
  68.     else Length := abs(Dy);
  69.   if Length < 1.0
  70.     then Length := 1.0; { catch zero length lines }
  71.   StepX := Dx/Length;
  72.   StepY := Dy/Length;
  73.   Xpos := ScreenX;
  74.   Ypos := ScreenY;
  75.   for I := 0 to trunc(Length) do
  76.     begin
  77.       Screen[round(Xpos),round(Ypos)] := true;
  78.       Xpos := Xpos + StepX;
  79.       Ypos := Ypos + StepY;
  80.     end; { for }
  81.   ScreenX := X;
  82.   ScreenY := Y;
  83. end;   { DrawTo }
  84.  
  85. (*$L+ *)
  86. procedure MakePicture;
  87.   { transform and clip, then display polygons }
  88. var
  89.   I,J,NumClp : counter;
  90.   TmpPoly : OnePoly;
  91.  
  92.   function DotProd( Pt1,Pt2 : Point) : real;
  93.     begin    { vector dot product }
  94.       DotProd := Pt1.X * Pt2.X + Pt1.Y * Pt2.Y + Pt1.Z * Pt2.Z;
  95.     end; { DotProd }
  96.  
  97.   procedure Ident(var Mtx : Matrix);
  98.     var
  99.       I,J : counter;
  100.   begin    { initialize matrix to identity matrix }
  101.     for I := 1 to 4 do
  102.       for j := 1 to 4 do
  103.         if I=J
  104.           then Mtx[I,J] := 1.0
  105.           else Mtx[I,J] := 0.0;
  106.   end; { Ident }
  107.  
  108.   procedure MatrixMult(Mt1,Mt2 : Matrix; var Result : Matrix);
  109.     var
  110.       I,J,K : counter;
  111.   begin    { multiply two 4 by 4 matrices }
  112.     for I := 1 to 4 do
  113.       for J := 1 to 4 do
  114.         begin
  115.           Result[I,J] := 0.0;
  116.             for K := 1 to 4 do
  117.               Result[I,J] := Result[I,J] + Mt1[K,J]*Mt2[I,K]
  118.         end
  119.   end;
  120.  
  121. (*$L+ *)
  122. { This procedure will transform the vertices of a polygon
  123.   using a four-by-four matrix. }
  124.   procedure Transform(Pt : Point; Mtx : Matrix; var NewPt : Point );
  125.   begin
  126.     NewPt.X := Pt.X*Mtx[1,1]+Pt.Y*Mtx[1,2]+Pt.Z*Mtx[1,3]+Mtx[1,4];
  127.     NewPt.Y := Pt.X*Mtx[2,1]+Pt.Y*Mtx[2,2]+Pt.Z*Mtx[2,3]+Mtx[2,4];
  128.     NewPt.Z := Pt.X*Mtx[3,1]+Pt.Y*Mtx[3,2]+Pt.Z*Mtx[3,3]+Mtx[3,4];
  129.   end; { Transform }
  130.  
  131. (*$L+ *)
  132. { Distance and veiwing angle transforms are determined by this
  133.   this procedure, which builds a transformation matrix based
  134.   on the relationship between the coordinates of the eyepoint
  135.   and those of the center of interest. }
  136.   procedure GetEyeSpace( EyePt,Cntrint : Point);
  137.     var
  138.       Mtx : Matrix;
  139.       C1,C2 : Point;
  140.       Hypotenuse,CosA,SinA : real;
  141.   begin
  142.     Ident(Eyespace);
  143.     with EyePt do    { load eyepoint translation }
  144.       begin
  145.         EyeSpace[1,4] := -X;
  146.         EyeSpace[2,4] := -Y;
  147.         EyeSpace[3,4] := -Z
  148.       end;
  149.     Transform(Cntrint,EyeSpace,C1); {translate center of interest }
  150.     Ident(Mtx);    {load rotation about Z-axis }
  151.     with C1 do
  152.       Hypotenuse := sqrt( X*X + Y*Y);
  153.     if Hypotenuse > 0.0 then
  154.       begin
  155.         CosA := C1.Y / Hypotenuse;
  156.         SinA := C1.X / Hypotenuse;
  157.         Mtx[1,1] := CosA;
  158.         Mtx[2,1] := SinA;
  159.         Mtx[1,2] := -SinA;
  160.         Mtx[2,2] := CosA;
  161.         MatrixMult(EyeSpace,Mtx,EyeSpace)
  162.       end;
  163.     Transform(CntrInt,EyeSpace,C2); {rotate center of interest }
  164.     Ident(Mtx);        {load rotation about X-axis }
  165.     with C2 do
  166.       Hypotenuse := sqrt(Y*Y + Z*Z);
  167.     if Hypotenuse > 0.0 then 
  168.       begin
  169.         CosA := C2.Y / Hypotenuse;
  170.         SinA := -C2.Z / Hypotenuse;
  171.         Mtx[2,2] := CosA;
  172.         Mtx[3,2] := SinA;
  173.         Mtx[2,3] := -SinA;
  174.         Mtx[3,3] := CosA;
  175.         MatrixMult(EyeSpace,Mtx,Eyespace)
  176.       end;
  177.     Ident(Mtx);    { load switch between Y and Z axes }
  178.     Mtx[2,2] := 0.0;
  179.     Mtx[3,3] := 0.0;
  180.     Mtx[2,3] := 1.0;
  181.     Mtx[3,2] := 1.0;
  182.     MatrixMult(EyeSpace,Mtx,EyeSpace)
  183.   end;    { GetEyeSpace }
  184.  
  185. (*$L+ *)
  186.   Procedure MakeDisplayable(Var Pt : Point);
  187. { This procedure achieves a perspective effect by dividing
  188.   the x and y coordinates of each vertex by the z coordinate. }
  189.   begin
  190.     Pt.X := ScreenScale.X * Pt.X / Pt.Z + ScreenCtr.X;
  191.     Pt.Y := ScreenScale.Y * Pt.Y / Pt.Z + ScreenCtr.Y;
  192.   end;    (* MakeDisplayable *)
  193.  
  194. (*$L+ *)
  195.   Function FacesEye( Poly : OnePoly ) : boolean;
  196. { This function determines whether or not a polygon will be
  197.   hidden by another part of the same surface in a three-
  198.   dimensional display. }
  199.   var
  200.     TmpPt : Point;
  201.     TmpPoly : OnePoly;
  202.   begin
  203.     with Poly[2] do    { make copy of second vertex }
  204.       begin
  205.         TmpPt.X:=X;
  206.         TmpPt.Y:=Y;
  207.         TmpPt.Z:=Z
  208.       end;
  209.     TmpPoly[1].X := Poly[1].X - Poly[2].X;    { directed vector }
  210.     TmpPoly[1].Y := Poly[1].Y - Poly[2].Y;    { from 2nd to 1st }
  211.     TmpPoly[1].Z := Poly[1].Z - Poly[2].Z;    { vertex }
  212.     TmpPoly[2].X := Poly[3].X - Poly[2].X;    { directed vector }
  213.     TmpPoly[2].Y := Poly[3].Y - Poly[2].Y;    { from 2nd to 3rd }
  214.     TmpPoly[2].Z := Poly[3].Z - Poly[2].Z;    { vertex }
  215.     GetPlanes( TmpPoly,2 );    { get plane coefficients }
  216.     if (DotProd( TmpPt,TmpPoly[1] ) <= 0.0 )
  217.       then FacesEye := false
  218.       else FacesEye := true
  219.   end;    (* FacesEye *)
  220.  
  221. (*$L+ *)
  222.   Procedure ClipIn(Var Poly : OnePoly; Var NumPts : counter);
  223. { Procedure to determine if any vertices of a polygon lie
  224.   outside previously defined clipping planes; if so the
  225.   polygon is modified accordingly. }
  226.   var
  227.     I,J,LstJ,TmpPts : counter;
  228.     D1,D2,A : Real;
  229.     TmpPoly : OnePoly;
  230.   begin
  231.     for I := 1 to WindowSize do    (* for each window edge *)
  232.       if NumPts > 0 then
  233.         begin
  234.       D1 := DotProd( Poly[NumPts],Window[I] );
  235.       LstJ := NumPts;
  236.       TmpPts := 0;
  237.       for J:= 1 to NumPts do    (* for each polygon edge *)
  238.         begin
  239.           if D1 > 0.0 then    (* is leading vertex inside? *)
  240.         begin
  241.           TmpPts := TmpPts +1;
  242.           with TmpPoly[TmpPts] do
  243.             begin    (* copy leading vertex *)
  244.               X:=Poly[LstJ].X;
  245.                      Y:=Poly[LstJ].Y;
  246.               Z:=Poly[LstJ].Z
  247.             end
  248.         end;    (* if leading vertex inside *)
  249.           D2:=DotProd(Poly[J],Window[I] );
  250.           if D1 * D2 < 0.0 then (* does edge straddle window? *)
  251.         begin
  252.           A := D1 / (D1 - D2);
  253.           TmpPts := TmpPts + 1;
  254.           with TmpPoly[TmpPts] do
  255.             begin
  256.               X:=A*Poly[J].X + (1.0-A)*Poly[LstJ].X;
  257.               Y:=A*Poly[J].Y + (1.0-A)*Poly[LstJ].Y;
  258.               Z:=A*Poly[J].Z + (1.0-A)*Poly[LstJ].Z
  259.             end
  260.         end;
  261.           LstJ := J;
  262.           D1 := D2
  263.         end;    (* NumPts loop *)
  264.       for J:=1 to TmpPts do    (* copy polygon back to input *)
  265.         with TmpPoly[J] do
  266.           begin
  267.             Poly[J].X:=X;
  268.             Poly[J].Y:=Y;
  269.             Poly[J].Z:=Z
  270.           end;
  271.       NumPts := TmpPts
  272.     end    (* WindowSize Loop *)
  273.   end;    (* ClipIn *)
  274.  
  275. (*$L+ *)
  276.   Procedure InsertSort(Poly : OnePoly ; NumPts : counter);
  277. { Based on the average value of their z coordinates,
  278.   polygons are sorted by their distance from the eyepoint
  279.   in this binary insertion sort procedure. }
  280.     var
  281.       I,J,K : counter;
  282.       AvDepth : real;
  283.   begin    (* binary insertion sort on average depth *)
  284.     AvDepth:= 0.0;
  285.     for I := 1 to NumPts do
  286.       with Poly[I] do    (* store vertices and find averge depth *)
  287.     begin
  288.       OutVtces[NumVtxOut + I + 1].X := X;
  289.       OutVtces[NumVtxOut + I + 1].Y := Y;
  290.       OutVtces[NumVtxOut + I + 1].Z := Z;
  291.       AvDepth := AvDepth + Z    { sum depths }
  292.     end;
  293.     AvDepth := AvDepth / NumPts;    { divide for average }
  294.     OutVtces[NumVtxOut + 1].Z := AvDepth; { store for later }
  295.     J:=0;    (* initialize for insertion search *)
  296.     I:=(NumDisplay + 1) div 2;
  297.     K:=NumDisplay;
  298.     while (J<>I) do    (* binary search for insertion point *)
  299.       if (AvDepth < OutVtces[OutPolys[I].Start ].Z) then
  300.     begin
  301.       K:=I;
  302.       I:=(I+J) div 2
  303.     end
  304.     else
  305.       begin
  306.         J:=I;
  307.         I:=(I+K+1) div 2
  308.       end;
  309.     for J:=NumDisplay downto I+1 do { found it, now insert }
  310.       begin
  311.     OutPolys[J+1].Start := OutPolys[J].Start;  { move everything above }
  312.     OutPolys[J+1].NumVtx := OutPolys[J].NumVtx { insertion point up one }
  313.       end;
  314.     OutPolys[I+1].Start := NumVtxOut + 1;    { store new entry }
  315.     OutPolys[I+1].NumVtx := NumPts;
  316.     NumVtxOut := NumVtxOut + NumPts + 1;    { vertex count }
  317.     NumDisPlay := NumDisplay + 1        { polygons stored }
  318.   end;    (* InsertSort *)
  319.  
  320. (*$L+ *)
  321.   procedure ClipOut(Poly : OnePoly; var NumPts : Vertex; Place : counter);
  322.  { Once sorted polygons are checked to determine if a polygon
  323.    closer to the eyepoint hides all or part of one that is
  324.    farther away. }
  325.   Var
  326.     I,LstI,NumDrawn : Counter;
  327.     Pt1,Pt2 : Point;
  328.     Drawn : boolean;
  329.     
  330.     procedure ClipAfter(Index : counter; Pt1,Pt2 : Point);
  331.       var
  332.     I : counter;
  333.     D1,D2,A : Real;
  334.     Out : boolean;
  335.     Pt3 : Point;
  336.       begin    (* recursively check polygons for oaverlap with input edge *)
  337.     if (Index < Place) then     (* is polygon closer than edge? *)
  338.       with OutPolys[Index] do
  339.         begin
  340.           I:=Start + NumVtx;
  341.           Out:=false;
  342.           repeat (* for each polygon edge *)
  343.         D1:=DotProd( Pt1,OutVtces[I]);
  344.         D2:=DotProd( Pt2,OutVtces[I]);
  345.         if ( (D1 <= 0.0) and (D2 <= 0.0) ) then
  346.           begin (* both points visible *)
  347.             Out := true;
  348.             ClipAfter(Index+1,Pt1,Pt2)
  349.           end
  350.           else if (D1 * D2 < 0.0) then
  351.              begin (* one point visible *)
  352.                A:=D1/(D1-D2);
  353.                Pt3.X:=A*Pt2.X+(1.0-A)*Pt1.X;
  354.                Pt3.Y:=A*Pt2.Y+(1.0-A)*Pt1.Y;
  355.                Pt3.Z:=A*Pt2.Z+(1.0-A)*Pt1.Z;
  356.                if (D1 < 0.0) then
  357.                  begin (* Pt1 visible *)
  358.                    ClipAfter(Index+1,Pt1,Pt3);
  359.                    with Pt3 do
  360.                  begin
  361.                    Pt1.X:=X;
  362.                    Pt1.Y:=Y;
  363.                    Pt1.Z:=Z
  364.                  end
  365.                  end
  366.                  else
  367.                    begin    (* Pt2 visible *)
  368.                  ClipAfter(Index+1,Pt3,Pt2);
  369.                  with Pt3 do
  370.                  begin
  371.                    Pt2.X:=X;
  372.                    Pt2.Y:=Y;
  373.                    Pt2.Z:=Z
  374.                  end
  375.                    end
  376.             end;    (* one point visible *)
  377.               I:=I-1;
  378.                until (Out or (I=Start)) { all visible of edges exhausted }
  379.           end
  380.         else
  381.           begin (* reached end of list of closer polygons *)
  382.             MakeDisplayable(Pt1);
  383.             MakeDisplayable(Pt2);
  384.             Moveto(Pt1.X,Pt1.Y);
  385.             Drawto(Pt2.X,Pt2.Y);
  386.             Drawn := true    (* as mark is displayed *)
  387.           end
  388.      end;    (* Clipafter *)
  389.  
  390. { Clipout procedure body }
  391.   begin (* clip each poly edge by all closer polys, draw what's left *)
  392.     NumDrawn := 0;
  393.     LstI := NumPts;
  394.     for I:= 1 to NumPts do
  395.       begin
  396.     with Poly[LstI] do
  397.       begin
  398.         Pt1.X:=X;
  399.         Pt1.Y:=Y;
  400.         Pt1.Z:=Z
  401.       end;
  402.     with Poly[I] do
  403.       begin
  404.         Pt2.X:=X;
  405.         Pt2.Y:=Y;
  406.         Pt2.Z:=Z
  407.       end;
  408.     Drawn := false;
  409.     ClipAfter(1,Pt1,Pt2);    (* check closer polys, then display *)
  410.     if Drawn then
  411.       NumDrawn := NumDrawn + 1;
  412.     LstI := I
  413.       end;    (* for loop *)
  414.     if NumDrawn = 0 then
  415.       NumPts := 0    (* mark as hidden *)
  416.   end;    (* ClipOut *)
  417.  
  418. (*$L+ *)
  419. begin  (* MakePicture procedure body *)
  420.   GetEyeSpace(EyePt,CntrInt );    (* get eyespace matrix *)
  421.   NumDisplay :=0;
  422.   NumVtxOut := 0;    (* set output counters *)
  423.   for I:=1 to NumPols do
  424.     with Polygons[I] do
  425.       begin
  426.     for J:=1 to NumVtx do (* get polygon *)
  427.       begin
  428.         with Points[Vertices[Start+J]] do
  429.           begin
  430.             TmpPoly[J].X:=X;
  431.             TmpPoly[J].Y:=Y;
  432.             TmpPoly[J].Z:=Z
  433.           end;
  434.         Transform(TmpPoly[J],EyeSpace,TmpPoly[J]); (* transform *)
  435.       end;
  436.     if FacesEye(TmpPoly) then
  437.       begin
  438.         NumClp:=NumVtx;    (* protect original data *)
  439.         ClipIn(TmpPoly,NumClp); (* clip to veiw window *)
  440.         if NumClp>0 then
  441.           InsertSort(TmpPoly,NumClp);
  442.                 (* store in sorted order for display *)
  443.       end
  444.     end;    (* loop for each polygon *)
  445. (* display surviving polygons, clipping each be closer polygons *)
  446.   Start;    (* initialize and clear display *)
  447.   for I:=1 to NumDisplay do
  448.     with OutPolys[I] do
  449.       begin
  450.     for J:=1 to NumVtx do
  451.       with OutVtces[Start+J] do
  452.         begin
  453.           TmpPoly[J].X:=X;
  454.           TmpPoly[J].Y:=Y;
  455.           TmpPoly[J].Z:=Z
  456.         end;
  457.     ClipOut(TmpPoly,NumVtx,I);  (* clip and display *)
  458.     if NumVtx > 0 then
  459.       begin
  460.         GetPlanes(TmpPoly,NumVtx);  (* convert to planes *)
  461.         for J:=1 to NumVtx do (* copy back for later clipping *)
  462.           with OutVtces[Start+J] do
  463.         begin
  464.           X:=TmpPoly[J].X;
  465.           Y:=TmpPoly[J].Y;
  466.           Z:=TmpPoly[J].Z
  467.         end
  468.        end
  469.     end;    (* for loop (1 to NumDisplay) *)
  470.   Finish    (* finalize picture *)
  471. end;    (* MakePicture *)
  472. .
  473.