Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/WILGRAPH.ZIP/WILGRAPH.PAS

Pascal/Delphi Source File | 1989-08-09 | 5.1 KB | 172 lines

{WILGRAPH }
{Tools for graphics use.  Authored by Jack M. Wilson for Project M.U.P.P.E.T.}
{                        University of Maryland                              }
{                      [phone] or 345-4200                            }
{                                                                            }
{Includes:   Reverse_Video; Blink_Video, Reg_Video                           }
{            Print (x,y,attribute: integer; FieldID: BigStr)                 }
{            ViewPort(VNum,VPX1,VPY1,VPX2,VPY2, VPcolor: integer)            }
{            Scale(Snum :integer; sXmin,sYmin,sXmax,sYmax :real)             }
{            PlotLine(Vnum,Snum:integer; Rx1,Ry1,Rx2,Ry2:real;pcolor:integer)}
{            PlotData(D:DataType; NumData,Vnum, Snum, pcolor:integer)        }
{            PlotDataPoints(D:DataType; NumData,Vnum, Snum, pcolor:integer)  }
{            Axis(Vnum,Snum:integer;Xint,Yint,TicX,TicY:real;Pcolor:integer) }

Const
     Pi = 3.14159265;
Type
     BigStr = String[80];
     DataType = Array[0..200,1..2] of Real;
     DataGrType = Array[0..200,1..2] of Integer;
     View = record
            Vx1,Vy1,Vx2,Vy2,Vcolor: Integer;
            end;
     GraphScale = record
            Xmin,Ymin,Xmax,Ymax: real;
            end;
Var
     Data        : DataType;
     Views       : Array[1..5] of View;
     GraphScales : Array[1..5] of GraphScale;

Procedure Reverse_Video;
    Begin
    TextColor(White); TextBackground(Black);
    end;
Procedure Blink_Video;
    Begin
    TextColor(Black+Blink); TextBackground(White);
    end;
Procedure Reg_Video;
    Begin
    TextColor(White); TextBackground(Blue);
    end;

Procedure Print (x,y,attribute: integer; FieldID: BigStr);
  {Attribute = 1 is reverse and 0 is regular}
  Begin
    If x<0 then x:=(80 - Length(FieldID)) div 2;
    If y<0 then y:= 12;
    If (x>80) or (y>25) then writeln('Error in Print format');
    If Attribute=1  then Reverse_Video;
    Gotoxy(x,y); Write(FieldID);
    Reg_Video;
    end;


 Procedure ViewPort(VNum,VPX1,VPY1,VPX2,VPY2, VPcolor: integer);

     begin
       with Views[Vnum] do begin
          Vx1:=VPX1;
          Vy1:=VPY1;
          Vx2:=VPX2;
          Vy2:=VPY2;
          Vcolor:=VPcolor;
          end;
     end;

Procedure Scale(Snum :integer; sXmin,sYmin,sXmax,sYmax :real);
     begin
        with GraphScales[Snum] do begin
          Xmin:=sXmin;
          Ymin:=sYmin;
          Xmax:=sXmax;
          Ymax:=sYmax;
          end;
     end;

Procedure PlotLine(Vnum,Snum:integer; Rx1,Ry1,Rx2,Ry2:real;pcolor:integer);
var
    Gx1, Gy1, Gx2, Gy2: integer;

    begin
      With Views[vnum] do begin
      With GraphScales[snum] do begin
        GraphWindow(Vx1,Vy1,Vx2,Vy2);
           Gx1:=Round((Vx2-Vx1)*(Rx1 -Xmin)/(xmax-xmin));
           Gy1:=Round((Vy2-Vy1)*(Ymax -Ry1)/(ymax-ymin));
           Gx2:=Round((Vx2-Vx1)*(Rx2 -Xmin)/(xmax-xmin));
           Gy2:=Round((Vy2-Vy1)*(Ymax -Ry2)/(ymax-ymin));
        Draw(Gx1,Gy1,Gx2,Gy2,pcolor);
      end;
      end;
    end;

Procedure PlotData(D:DataType; NumData,Vnum, Snum, pcolor:integer);

var
     Rx1,Ry1,Rx2,Ry2     : Real;
     DataGr              : DataGrType;
     I                   : Integer;
     begin
       With Views[vnum] do begin
       With GraphScales[snum] do begin
           GraphWindow(Vx1,Vy1,Vx2,Vy2);
           FillScreen(Vcolor);
              Rx1:=D[0,1];
              Ry1:=D[0,2];
           For I:=1 to NumData do begin
              Rx2:=D[I,1];
              Ry2:=D[I,2];
              PlotLine(Vnum,Snum,Rx1,Ry1,Rx2,Ry2,pcolor);
              Rx1:=Rx2;  Ry1:=Ry2;
              end;

        end;
        end;
     end;

Procedure PlotDataPoints(D:DataType; NumData,Vnum, Snum, pcolor:integer);

var
     I,Gx,Gy              : Integer;

     begin
       With Views[vnum] do begin
       With GraphScales[snum] do begin
           GraphWindow(Vx1,Vy1,Vx2,Vy2);
           FillScreen(Vcolor);
           For I:=1 to NumData do begin
              Gx:=Round((Vx2-Vx1)*(D[I,1] -Xmin)/(xmax-xmin));
              Gy:=Round((Vy2-Vy1)*(Ymax -D[I,2])/(ymax-ymin));
              Plot(Gx,Gy,pcolor);
              end;

        end;
        end;
     end;


Procedure Axis(Vnum,Snum:integer;Xint,Yint,TicX,TicY:real;Pcolor:integer);

var
  x,y:real;

     begin
       With Views[vnum] do begin
        With GraphScales[snum] do begin
          Plotline(Vnum,Snum,xmin,yint,xmax,yint,pcolor);
          Plotline(Vnum,Snum,xint,ymin,xint,ymax,pcolor);
          If TicX >0 then begin
            X:=Xmin;
            While X<Xmax do begin
               PlotLine(Vnum,Snum,X,Yint,X,Yint+0.01*(Ymax-Ymin),Pcolor);
               X:=X+TicX;
            end;
          end;
          If TicY >0 then begin
            Y:=Ymin;
            While Y<Ymax do begin
               PlotLine(Vnum,Snum,Xint,Y,Xint+0.01*(Xmax-Xmin),Y,Pcolor);
               Y:=Y+TicY;
            end;
          end;

        end;
       end;
     end;