ftp.barnyard.co.uk/2015.02.ftp.barnyard.co.uk.tar/ftp.barnyard.co.uk/cpm/walnut-creek-CDROM/CPM/LANGUAGS/PASCAL/XYPLOT.PAS

Pascal/Delphi Source File | 2000-06-30 | 5KB | 210 lines

module xyplot;

{

XYPLOT - Generate 2-D Plots of X,Y Data Pairs
    Derived from the FORTRAN IV Subroutine XYPLT in the Book
    "Digital Computations in Basic Circuit Theory" by L.P. Huelsman
    PASCAL/MT+ Coding and Algorithm Enhancements by Richard Conn

Calling Form --
    rcode = xyplot (device, ndata, nsx, nsy, nnp, x, y);

Passed Parameters --
    device    A String (STR) Specifying the Output Device/File; One of:
            CON:    = Console
            LST:    = Printer
            <File>    = Disk File, Like PLOT1.TXT or A:Plot
    ndata    Number of valid data points in the x,y rarrays
    nsx    Maximum Value of X Points
    nsy    Maximum Value of Y Points (Minimum Value = NSY - 100)
    nnp    Range of X Points (NSX - Minimum Value of X Points)
    x, y    rarrays of the X,Y input Point values

Result Codes (Type Integer) Returned --
    0    No Error
    1    Error in Opening Output File
    2    Error in Closing Output File

Special Types --
    See the following TYPE Definition for the types STR for the
    device name and RARRAY for the passed data.

}

const
    max_elt = 200; { Maximum Number of Array Elements Permitted }
    strl = 20; { Maximum Number of Characters in a String Vector STR }
type
    rarray = array [1..max_elt] of real;
    str = string[strl];

function xyplot (device : str; ndata, nsx, nsy, nnp : integer; x, y : rarray) :
    integer;

const
    jn = '-';
    jp = '+';
    ji = 'I';
    jb = ' ';
    jz = '$';
    jx = 'X';
var
    ofile : text;
    line : array [1..101] of char;
    i, j, l, np, dash, index : integer;
    nx, nx_next : integer;
    xns, yns, xnp : real;
    rcode : integer;

procedure clear (jint, jopen : char);
var
    i, j, idx : integer;
begin
    { Initialize Line Image to Dashes }
    idx := 0;
    for i:=1 to 10 do begin
        idx := idx + 1;
        line[idx] := jint;  { Intersect Char }
        for j:=1 to 9 do begin
            idx := idx + 1;
            line[idx] := jopen;  { Level Char }
        end;
    end;
    line[101] := jint;  { Last Intersect Char }
end;

procedure capitalize (var s : str);
var    i : integer;
begin
    for i:=1 to strl do
        if (s[i] > 'a') and (s[i] <= 'z') then
            s[i] := chr(ord(s[i]) - ord('a') + ord('A'));
end;

procedure clrblank;
begin
    { Initialize Line Image to Blanks }
    clear (ji, jb);
end;

procedure clrdash;
begin
    { Initialize Line Image to Dashes }
    clear (jp, jn);
end;

procedure xchg (var a,b : real);
var
    temp : real;
begin
    { Exchange real numbers A and B }
    temp := a;
    a := b;
    b := temp;
end;

procedure sety (idx : integer);
var
    ny : integer;
begin
    ny := trunc (y[idx] + 101.49999 - yns);
    if ny < 1 then line[1] := jz { Off Scale }
              else if ny > 101 then line[101] := jz
                               else line[ny] := jx;
end;

procedure setx (idx : integer);
begin
    { Scaled Value of Next X Element }
    nx_next := trunc (x[idx] * 0.6 - xns + xnp + 0.49999);
    if nx_next > np then nx_next := np; { Out of Range }
    if nx_next < 0 then nx_next := 0;   { Out of Range }
end;

procedure printline;
var
    i, nprint : integer;
begin
    if (dash mod 6) = 0 then begin
        nprint := ((dash * 10) div 6) + nsx - nnp;
        write(ofile, nprint:4); end
    else write(ofile, '    ');
    for i:=1 to 101 do write(ofile, line[i]); writeln(ofile);
    dash := dash + 1; { Increment Line Counter }
end;

begin { XYPLOT }

    { Set Result Code to OK }
    rcode := 0;  { No Error }

    { Assign Output Device }
    capitalize (device);  { Capitalize Output Device Name }
    assign (ofile, device);  { Assign Device to File Spec }
    rewrite (ofile);  { Rewind Device if Disk File }

    { Check for Successful Open of Output File and Perform XYPLOT if so }
    if ioresult = 255 then rcode := 1  { Error in Opening File }
    else begin { XYPLOT Function }

    { Arrange data in ascending order of X }
    for i:=1 to ndata-1 do
        for j:=i+1 to ndata do
            if x[i] > x[j] then begin { Exchange }
                xchg (x[i], x[j]);
                xchg (y[i], y[j]);
            end;

    { Print Ordinate Scale Figures }
    write(ofile, ' ');  { Leading Space }
    for i:=1 to 11 do begin
        l := 10 * i - 110 + nsy;  { Compute Values }
        write(ofile, l:4, '      ');  { Write Values }
    end;
    writeln(ofile);  { New Line after Ordinate Scale Values }

    { Initialize Key Values }
    dash := 0; { Initialize dash line indicator }
    np := (nnp div 10) * 6; xnp := np;
    xns := (nsx div 10) * 6; yns := nsy;
    index := 1;
    setx(index);  { Scaled Value of nx_next }

    repeat { Main Loop }
        { Set up current line }
        if (dash mod 6) = 0 then clrdash else clrblank;

        { Load Values into current line if X Coordinates Match }
        if dash >= nx_next then
           repeat { Plot all Y Values which belong to current X }
            nx := nx_next;  { Scaled Value of Current X }

            { Scaled Value of Current Y }
            sety(index);

            index := index + 1;  { Advance to next data elt }
            setx(index); { Compute Next X }
           until (nx_next <> nx) or (index = ndata);

        if (index = ndata) and (nx_next = nx) then sety(index);

        printline;  { Print Graph }
    until index = ndata;

    if nx_next <> nx then begin
        sety(index);
        printline;
    end;

    { Close Output File }
    close(ofile,i);
    if i=255 then rcode := 2;  { Error in Closing File }

    end; { XYPLOT Function }

    xyplot := rcode;  { Setup Return Code }

end; { XYPLOT }
modend.