GRAPH3.I

[Table of Contents]

The GRAPH3.I include file resides on the Kyan Pascal 2.x Advanced Graphics Toolkit Disk.

• procedure viewplanexfm(var x,y,z:real);
• procedure NewXfm3;
• procedure Xlate3 (TX, TY, TZ:real);
• procedure RotX3 (S,C:real);
• procedure RotY3 (S,C:real);
• procedure RotZ3 (S,C:real);
• procedure SetViewReferencePoint (X,Y,Z:real);
• procedure SetViewDistance (D:real);
• procedure SetViewUp (DX,DY,DZ:real);
• procedure SetViewPlaneNormal (DX, DY, DZ:real);
• procedure SetProjection (B:boolean; X, Y, Z:real);
• procedure MakeViewPlaneXfm;
• procedure Initialize;
• procedure display(op:integer; x,y,z:real);
• procedure SetWindow(xl,xh,yl,yh:real);

Source Code

procedure viewplanexfm(var x,y,z:real);
    var
       T:array[1..3] of real;
       i:integer;
    begin
       For i:=1 to 3 do
           T[i]:=X*TMATRIX[1,i]+Y*TMATRIX[2,i]+Z*TMATRIX[3,i]+TMATRIX[4,i];
       X:=T[1];
       Y:=T[2];
       Z:=T[3];
end;

procedure NewXfm3;
Var i,j:integer;
        begin
 For i:= 1 to 4 do begin
  For j:= 1 to 4 do TMATRIX[i,j]:=0;
  if i<>4 then TMATRIX[i,i]:=1;
 end;
end;

procedure Xlate3 (TX, TY, TZ:real);
begin
 TMATRIX[4,1]:=TMATRIX[4,1]+TX;
 TMATRIX[4,2]:=TMATRIX[4,2]+TY;
 TMATRIX[4,3]:=TMATRIX[4,3]+TZ;
end;

procedure RotX3 (S,C:real);
Var i:integer;
    Temp:real;
begin
 For i:=1 to 4 do begin
  Temp:= TMATRIX[i,2]*C-TMATRIX[i,3]*S;
  TMATRIX[i,3]:=TMATRIX[i,2]*S+TMATRIX[i,3]*C;
  TMATRIX[i,2]:=Temp;
 end;
end;

procedure RotY3 (S,C:real);
Var i:integer;
    Temp:real;
begin
 For i:=1 to 4 do begin
  Temp:= TMATRIX[i,1]*C+TMATRIX[i,3]*S;
  TMATRIX[i,3]:=-TMATRIX[i,1]*S+TMATRIX[i,3]*C;
  TMATRIX[i,1]:=Temp;
 end;
end;

procedure RotZ3 (S,C:real);
Var i:integer;
    Temp:real;
begin
 For i:=1 to 4 do begin
  Temp:= TMATRIX[i,1]*C-TMATRIX[i,2]*S;
  TMATRIX[i,2]:=TMATRIX[i,1]*S+TMATRIX[i,2]*C;
  TMATRIX[i,1]:=Temp;
 end;
end;

procedure SetViewReferencePoint (X,Y,Z:real);
begin
 XR:=X;
 YR:=Y;
 ZR:=Z;
end;

procedure SetViewDistance (D:real);
begin
 ViewDistance:=D;
end;

procedure SetViewUp (DX,DY,DZ:real);
begin
 DXUP:=DX;
 DYUP:=DY;
 DZUP:=DZ;
end;

procedure SetViewPlaneNormal (DX, DY, DZ:real);
Var D:real;
begin
 D:=SQRT(DX*DX+DY*DY+DZ*DZ);
 DXN:=DX/D;
 DYN:=DY/D;
 DZN:=DZ/D;
end;

procedure SetProjection (B:boolean; X, Y, Z:real);
begin
 perspective_flag:=B;
 if B=FALSE then begin (*Parallel projection*)
  DXP:=X;
  DYP:=Y;
  DZP:=Z;
  end
 else begin            (*Perspective proj.*)
  XPCNTR:=X;
  YPCNTR:=Y;
  ZPCNTR:=Z;
 end;
end;

procedure MakeViewPlaneXfm;
Var V,XUPVP,YUPVP,RUP,VXP,VYP,VZP: real;
begin
 NewXfm3;
 Xlate3(-(XR+DXN*ViewDistance),-(YR+DYN*ViewDistance),-(ZR+DZN*ViewDistance));
 V:= SQRT(DYN*DYN+DZN*DZN);
 if v<>0 then
     RotX3(-DYN/V,-DZN/V);
 RotY3(DXN,V);
 XUPVP:=DXUP*TMATRIX[1,1]+DYUP*TMATRIX[2,1]+DZUP*TMATRIX[3,1];
 YUPVP:=DXUP*TMATRIX[1,2]+DYUP*TMATRIX[2,2]+DZUP*TMATRIX[3,2];
 RUP:=SQRT(XUPVP*XUPVP+YUPVP*YUPVP);
 RotZ3 (XUPVP/RUP,YUPVP/RUP);
 IF perspective_flag then
  begin
   XC:=XPCNTR;
   YC:=YPCNTR;
   ZC:=ZPCNTR;
   ViewPlaneXfm(XC,YC,ZC);
   end
  Else
   begin
    VXP:=DXP*TMATRIX[1,1]+DYP*TMATRIX[2,1]+DZP*TMATRIX[3,1];
    VYP:=DXP*TMATRIX[1,2]+DYP*TMATRIX[2,2]+DZP*TMATRIX[3,2];
    VZP:=DXP*TMATRIX[1,3]+DYP*TMATRIX[2,3]+DZP*TMATRIX[3,3];
    SXP:=VXP/VZP;
    SYP:=VYP/VZP;
   end;
end;

procedure Initialize;
begin
 (*Initial7;*)
 SetViewReferencePoint(0,0,0);
 SetViewPlaneNormal(0,0,-1);
 SetViewDistance(0);
 SetViewUp(0,1,0);
 SetProjection(Parallel,0,0,1);
 makeviewplanexfm;
end;

procedure display(op:integer; x,y,z:real);
    var
       xp,yp:real;
       x1,y1:integer;
    begin
       case op of
           0,1,2:begin
               dfpenx:=x;
               dfpeny:=y;
               dfpenz:=z;
             end;
           3,4,5:begin
               dfpenx:=dfpenx+x;
               x     :=dfpenx;
               dfpeny:=dfpeny+y;
               y     :=dfpeny;
               dfpenz:=dfpenz+z;
               z     :=dfpenz;
           end;
       end;
       viewplanexfm(x,y,z);
       if perspective_flag then begin
           x:=(x*zc-xc*z)/(zc-z);
           y:=(y*zc-yc*z)/(zc-z);
       end
       else begin
           x:=x-z*sxp;
           y:=y-z*syp;
       end;
       x1:=trunc((x-wxl)*wsx);
       y1:=trunc((y-wyl)*wsy);
       if plotter then begin
           xp:=(x-pxl)*psx+hlow;
           yp:=(y-pyl)*psy+vlow;
       end;
       (*WINDOW TO VIEWPORT*)
       case op of
          0,3:plot(x1,191-y1,color);
          1,4:begin
              lineto(x1,191-y1,color);
              if plotter then begin
                  clip(opx,opy,xp,yp);
                  opx:=xp;
                  opy:=yp;
              end;(*if*)
          end;
          2,5:begin
              MOVE(x1,191-y1);
              if plotter then begin
                  opx:=xp;
                  opy:=yp;
              end;(*if*)
          end;
       end; (*case*)
end;

procedure SetWindow(xl,xh,yl,yh:real);
    begin
       wsx:=319/(xh-xl);
       wsy:=191/(yh-yl);
       wyl:=yl;
       wxl:=xl;
end;