{*************************************************************************
 TITLE   : GRAFED
 VERSION : 2.1
 AUTHOR  : Roger Carlson (after GRAFED5, version 3.2 of M.Riebe and
           R.Carlson written for the IBM CS9000 computer) 5/29/90
 FUNCTION: This unit contains the GRAF routine for interactive display of
           xy data.
 INPUTS  : DATA - The xy data.  The first index identifies x(1) or y(2)
                  and the second index specifies the data point.
           FILENAME - Name of the data file.
           MINX   - Minimum x value.
           MAXX   - Maximum x value.
           LOY    - Smallest y value.
           HIY    - Largest y value.
           NUMPTS - Number of data points.
 NOTES   : 1. In Turbo Pascal the maximum size of any variable is 64KB.
              To use the largest possible data array sizes, I've used
              a single precision data array, which uses 23 bit (7-8digit)
              precision.
 CHANGES : 6/2/90 (1.1,RJC) - Added window selection.
           6/3/90 (1.2,RJC) - Modified to change passed parameters to
             include x max and min rather than first and last index.
           6/4/90 (1.3,RJC) - Added parameter window at bottom of screen.
           6/12/90 (1.4,RJC) -Added crosshair, ruler and several bells and
                              whistles.
           7/6/90 (1.5,RJC) - Started some bells and whistles.  Moved
             CLRBOX to AXISLBL.
           3/23/91 (1.6,RJC) -Increased the maximum data array size to
             7000 and changed data array type to single precision.  Also
             changed screen driver path to d:\tp to be consistent with
             lab computer setup.
           3/28/91 (1.7,RJC) -Added peak integration routine and completed
             the moving average option.
           5/2/91 (1.8,RJC) - Corrected text file dump procedure to include
             data filtering.
           5/3/91 (1.9,RJC) - Added linear transformation of axes,
             wavelength/wavenumber conversion of x axis, and change of
             axis labels.
           5/9/91 (2.0,RJC) - Added postscript print screen procedure,
             user defined window bounds, pan left, pan right, expand
             horizontally, dos shell command, and crosshair trace mode.
           5/23/91 (2.1,RJC) - Corrected an array range error when the
             newmode flag was set (eg for a linear transform of x).  Added
             min/max procedure and nonlinear transforms.
*************************************************************************}

UNIT GRAFED;

{$I-} {Disable IO checking.}

INTERFACE

  USES IOFUNCS;      {version 1.7}

  CONST MAXPTS=7000; {Maximum # of data points.}

  TYPE DARRAY=ARRAY[1..2,1..MAXPTS] OF SINGLE;

  PROCEDURE GRAF(VAR DATA:DARRAY; FILENAME:STR20; MINX,MAXX,LOY,HIY:REAL;
                 NUMPTS:INTEGER);

IMPLEMENTATION

USES CRT,GRAPH,DOS,
     MATH,        {VERSION 1.3}
     AXISLBL;     {VERSION 2.6}

PROCEDURE GRAF;

CONST
  DRIVERS='d:\tp';    {location of device drivers}
  SCRLEFT=100;        {plot starts SCRLEFT units from left edge}
  SCRBOTTOM=58;       {bottom of plot SCRBOTTOM units from screen bottom}
  SCRTOP=28;          {top of plot SCRTOP unit from screen top}
  LINE1=3;            {first line for window at top of screen}
  LINE2=13;           {second line for window at top of screen}

VAR
  ASCII       : INTEGER;  {ordinal value of a key pressed}
  BWBSC       : integer;  {bottom window boundary in screen coordinates}
  BWBUC       : REAL;     {bottom window bound in user coordinates}
  CHFLAG      : BOOLEAN;  {turns crosshair display on}
  CHSENS      : INTEGER;  {crosshair movement sensitivity}
  CHXUC,CHYUC : REAL;     {crosshair user coordinates}
  CHXSC,CHYSC : INTEGER;  {crosshair screen coordinates}
  DONEFLAG    : BOOLEAN;  {flag to bet out of program}
  ELIPSFLAG   : BOOLEAN;  {flags circling of each point}
  ERRCODE     : integer;  {error code}
  FILTYPE,
  FILDEGREE,
  FILDERIV,
  FILWIDTH    : INTEGER;  {filter parameters}
  FIRST       : INTEGER;  {index of current first displayed point}
  FRAME       : BOOLEAN;  {flags need to redraw frame}
  GRAPHDRIVER : integer;  {graphics device ID number}
  GRAPHMODE   : integer;  {mode for the graphics device}
  HIXUC       : REAL;     {highest x user coordinate}
  kbdbox      : viewporttype; {graphics window at bottom of screen}
  LAST        : INTEGER;  {index of last point currently displayed}
  LINEFLAG    : BOOLEAN;  {flags connecting of points with lines}
  LINFLAG     : BOOLEAN;  {flag to indicate choice of movable line}
  LINLEN      : INTEGER;  {length of line in number of pixels}
  LINXSC,LINYSC: INTEGER; {line screen coordinates}
  LINXUC,LINYUC: REAL;    {line user coordinates}
  LOXUC       : REAL;     {lowest x value in user coordinates}
  LWBIC       : INTEGER;  {lefg window boundary in index coordinates}
  LWBSC       : integer;  {left window boundary in screen coordinates}
  LWBUC       : REAL;     {left window boundary in user coordinate}
  NEWMODE     : BOOLEAN;  {flags choice of a new display mode}
  OLDBWBUC    : REAL;     {temporary bottom window bound in user coords}
  OLDLWBUC    : REAL;     {temporary left window bound in user coords}
  REDRAW      : BOOLEAN;  {flags need to redraw the screen plot}
  RWBIC       : INTEGER;  {rigth window boundary in index coordinates}
  RWBSC       : integer;  {right window boundary in screen coordinates}
  RWBUC       : REAL;     {right window boundary in user coordinate}
  SCANCODE    : INTEGER;  {extended code for a key pressed}
  STEPSIZE    : INTEGER;  {size of increments between points}
  THETA       : REAL;     {angle of live vs. horizontal (radians)}
  TRACE       : BOOLEAN;  {flags crosshair trace mode}
  TWBSC       : integer;  {top window boundary in screen coordinates}
  TWBUC       : REAL;     {top window boundary in user coordinates}
  titlebox    : viewporttype; {graphics window at top of screen}
  WINDSENS    : INTEGER;  {window movement sensitivity}
  XLABEL      : STR40;    {label for x axis}
  YLABEL      : STR40;    {label for y axis}

{************************ Coordinate Transformations ********************}
FUNCTION XCOORDSC(DATAPT:REAL):INTEGER; BEGIN
  {Returns x value in screen coordinates corresponding to the user
   value DATAPT by comparing it to the left and right window boundaries
   in user coordinates.}
  XCOORDSC:=ROUND((DATAPT-LWBUC)*((RWBSC-LWBSC)/(RWBUC-LWBUC))+LWBSC);
END; {XCOORDSC}

FUNCTION XDATAVAL(INDEX:INTEGER):REAL;
  {Returns x coordinate value in user specified units for a given index
   with user specified slope and intercept incorporated.}
BEGIN
  IF (INDEX>=1) AND (INDEX<=NUMPTS) THEN XDATAVAL:=DATA[1,INDEX]
  ELSE XDATAVAL:=(INDEX-1)*(DATA[1,NUMPTS]-DATA[1,1])/(NUMPTS-1)+DATA[1,1]
END; {XDATAVAL}

FUNCTION YCOORDSC(DATAPT:REAL):INTEGER; BEGIN
  {Returns y value in screen coordinates corresponding to the supplied
   user coordinate of the current point by comparing it to the top and
   bottom displayed user coordinates.}
  YCOORDSC:=ROUND((DATAPT-BWBUC)*((TWBSC-BWBSC)/(TWBUC-BWBUC))+BWBSC);
END; {YCOORDSC}

FUNCTION XCOORDUC(DATAPT:REAL):REAL; BEGIN
  {Returns the x value in user coordinates corresponding to the supplied
   screen coordinate of a point.}
  XCOORDUC:=(DATAPT-LWBSC)*(RWBUC-LWBUC)/(RWBSC-LWBSC)+LWBUC;
  END;

FUNCTION YCOORDUC(DATAPT:REAL):REAL; BEGIN
  {Returns the y value in user coordinates corresponding to the suppied
   screen coordinate of a point.}
  YCOORDUC:=(DATAPT-BWBSC)*(TWBUC-BWBUC)/(TWBSC-BWBSC)+BWBUC;
  END;

FUNCTION YDATAVAL(INDEX:INTEGER):REAL;
  {Returns y coordinate value in specified units for a given index to
   the data array.}
VAR TEMPINDEX:INTEGER;
BEGIN
  IF INDEX>LAST THEN TEMPINDEX:=LAST
  ELSE IF INDEX<FIRST THEN TEMPINDEX:=FIRST
  ELSE TEMPINDEX:=INDEX;
  IF TEMPINDEX<=1 THEN TEMPINDEX:=1;
  IF TEMPINDEX>=NUMPTS THEN TEMPINDEX:=NUMPTS;
  YDATAVAL:=DATA[2,TEMPINDEX];
END; {YDATAVAL}

{********************* FUNCTION FILTER **********************************}
FUNCTION filter(FILDERIV,INDEX:INTEGER):REAL;
  {This function applies either a moving average or Savitzky-Golay polynomial
   fit least squares filter to the data using the following parameters:
     FILTYPE  : INTEGER  0=moving average, 1=Savitzy-Golay
     FILDEGREE: INTEGER  Degree of polynomial fit (2,3,or 4)
     FILDERIV : INTEGER  Derivative desired (0,1,or 2)
     FILWIDTH : INTEGER  Width of filter in number of datapoints
     INDEX    : INTEGER  Index to central data value in data array.}
VAR YAVG : DOUBLE;
    I,M  : INTEGER;
BEGIN
 YAVG:=0.0; M:=FILWIDTH DIV 2;
 case FILTYPE of
   0: BEGIN
       for I:=(INDEX-M) to (INDEX+M) do YAVG:=YAVG+ydataval(I);
       FILTER := YAVG/(2*M + 1);
      END;
   1: BEGIN
       FILTER := YDATAVAL(I);
      END;
   END; {case}
END; {filter}
{************************** PROCEDURE SETCHY ******************************}
PROCEDURE SETCHY;
  {Sets crosshair y screen coordinate to a point on the displayed data.}
VAR I,Y,MAXY:INTEGER; DONE:BOOLEAN;
BEGIN
  I:=0; MAXY:=GETMAXY-SCRBOTTOM; DONE:=FALSE;
  REPEAT
    Y:=CHYSC+I;
    IF (Y<MAXY) AND (GETPIXEL(CHXSC,Y)<>0) THEN BEGIN
      DONE:=TRUE; CHYSC:=Y
      END
    ELSE BEGIN
      Y:=CHYSC-I;
      IF (Y>SCRTOP) AND (GETPIXEL(CHXSC,Y)<>0) THEN BEGIN
        DONE:=TRUE; CHYSC:=Y
        END;
      END;
    I:=I+1;
  UNTIL DONE OR (I=MAXY-SCRTOP+1);
END;

{************************** PROCEDURE DRAWCH ******************************}
PROCEDURE DRAWCH;
  {Draws or erases the crosshair at the coordinates CHXSC and CHYSC and
   lists or erases coordinates at the top of the screen.  The procedure
   returns CHXUC and CHYUC.}
CONST HEIGHT=21;
VAR CHXLO,CHXHI,CHYLO,CHYHI,CHXLEN,CHYLEN : INTEGER;
    ORXUC,ORYUC :REAL;
    X,Y:STR20;
BEGIN
  CHXLEN:=ROUND((GETMAXX-SCRLEFT)/25);
  CHYLEN:=ROUND((GETMAXY-SCRBOTTOM-SCRTOP)/20);
  IF ((CHXSC-CHXLEN)<LWBSC) THEN CHXLO:=LWBSC ELSE CHXLO:=CHXSC-CHXLEN;
  IF ((CHXSC+CHXLEN)>RWBSC) THEN CHXHI:=RWBSC ELSE CHXHI:=CHXSC+CHXLEN;
  IF ((CHYSC-CHYLEN)<TWBSC) THEN CHYLO:=TWBSC ELSE CHYLO:=CHYSC-CHYLEN;
  IF ((CHYSC+CHYLEN)>BWBSC) THEN CHYHI:=BWBSC ELSE CHYHI:=CHYSC+CHYLEN;
  {update crosshair user coordinates}
    CHXUC:=XCOORDUC(CHXSC); CHYUC:=YCOORDUC(CHYSC);
  LINE(CHXLO,CHYSC,CHXHI,CHYSC); LINE(CHXSC,CHYLO,CHXSC,CHYHI);
  IF CHFLAG THEN BEGIN {diplay coords at top}
    CLRBOX(0,0,GETMAXX,HEIGHT,FALSE);
    SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
    IF LINFLAG THEN BEGIN
      STR((CHXUC-LINXUC):10:4,X); STR((CHYUC-LINYUC):10:4,Y);
      OUTTEXTXY(3,4,CONCAT('Crosshair Relative Coordinates: ',
                           X,',',Y));
      STR(ABS(XCOORDUC(LINXSC+ROUND(LINLEN/2*COS(THETA)))-
              XCOORDUC(LINXSC-ROUND(LINLEN/2*COS(THETA)))):10:4,X);
      STR(ABS(YCOORDUC(LINYSC+ROUND(LINLEN/2*SIN(THETA)))-
              YCOORDUC(LINYSC-ROUND(LINLEN/2*SIN(THETA)))):10:4,Y);
      OUTTEXTXY(3,13,CONCAT('                   Line Length: ',X,',',Y));
      END
    ELSE BEGIN
      STR(CHXUC:10:4,X); STR(CHYUC:10:4,Y);
      OUTTEXTXY(3,4,CONCAT('Crosshair Absolute Coordinates: ',X,',',Y));
      END
    END
  ELSE BEGIN {erase the top box}
    SETVIEWPORT(0,0,GETMAXX,HEIGHT,CLIPON); CLEARVIEWPORT;
    SETVIEWPORT(0,0,GETMAXX,GETMAXY,CLIPON);
    END;
END; {DRAWCH}

{************************* PROCEDURE DRAWLN ********************************}
PROCEDURE DRAWLN;
  {This procedure draws a translatable, rotatable lin on the screen for use
   in conjunction with the crosshair in determining peak heights and widths.
   The position is determined by LINXSC and LINYSC and the procedure returns
   LINXUC and LINYUC.}

  PROCEDURE RANGE(VAR NUMBER:INTEGER; R1,R2:INTEGER);
  VAR MAX,MIN:INTEGER;
  BEGIN
    IF R1>R2 THEN BEGIN MAX:=R1; MIN:=R2; END
    ELSE BEGIN MAX:=R2; MIN:=R1; END;
    IF NUMBER<MIN THEN NUMBER:=MIN ELSE IF NUMBER>MAX THEN NUMBER:=MAX;
  END; {RANGE}

  PROCEDURE DOLINE(LINLEN:INTEGER; THETA:REAL);
  VAR LX,LY,RX,RY: INTEGER;
  BEGIN
    LX:=LINXSC-ROUND(LINLEN/2*COS(THETA));
    LY:=LINYSC-ROUND(LINLEN/2*SIN(THETA));
    RX:=LINXSC+ROUND(LINLEN/2*COS(THETA));
    RY:=LINYSC+ROUND(LINLEN/2*SIN(THETA));
    RANGE(LX,LWBSC,RWBSC); RANGE(RX,LWBSC,RWBSC);
    RANGE(LY,TWBSC,BWBSC); RANGE(RY,TWBSC,BWBSC);
    LINE(LX,LY,RX,RY);
  END; {DOLINE}

BEGIN
  DOLINE(LINLEN,THETA); DOLINE(4,THETA+PI/2);
  {update the line coordinates}
    LINXUC:=XCOORDUC(LINXSC); LINYUC:=YCOORDUC(LINYSC);
  IF CHFLAG THEN BEGIN {update the relative crosshair coords}
    DRAWCH; DRAWCH;
    END;
END; {DRAWLN}

{************************* PROCEDURE INTEGRATE *****************************}
PROCEDURE INTEGRATE;
VAR
    A               :DOUBLE;    {running total of areas}
    ANS             :CHAR;
    I               :INTEGER;   {data point index}
    LASTY           :DOUBLE;    {last y value}
    LX              :DOUBLE;    {screen coordinates of left end of ruler}
    N               :INTEGER;   {number of points}
    RX              :DOUBLE;    {screen coordinates of right end of ruler}
    S               :DOUBLE;    {std deviation}
    ST              :STRING[3]; {string for output message}
    SUMY            :DOUBLE;    {sum of y}
    SUMYY           :DOUBLE;    {sum of sqr(y)}
    XSC             :DOUBLE;    {x screen coord}
    Y               :DOUBLE;    {y value}
    YSC             :DOUBLE;    {y screen coord}
BEGIN
  SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  ANS:='A';
  REPEAT
    CLRBOX(0,0,GETMAXX,24,TRUE);
    OUTTEXTXY(3,LINE1,'Integration procedure: ');
    MOVETO(3,LINE2);
    OUTTEXT(CONCAT('Absolute Y values or Relative to the ruler (A or R) [',
                    ANS,']? '));
    GRDCHAR(ANS);
  UNTIL ANS IN ['A','a','r','R'];
  IF ANS='a' THEN ANS:='A'; IF ANS='r' THEN ANS:='R';
  CLRBOX(0,0,GETMAXX,24,TRUE);
  OUTTEXTXY(3,LINE1,'Integration in progress...');
  I:=FIRST; A:=0.0; LASTY:=0.0; N:=0; SUMY:=0.0; SUMYY:=0.0;
  LX:=LINXSC-ROUND(LINLEN/2*COS(THETA));
  RX:=LINXSC+ROUND(LINLEN/2*COS(THETA));
  REPEAT
    XSC:=XCOORDSC(DATA[1,I]);
    IF (XSC<=RX) AND (XSC>=LX) THEN BEGIN
      N:=N+1;
      IF ANS='R' THEN
        Y:=FILTER(FILDERIV,I)-YCOORDUC(LINYSC+(XSC-LINXSC)*TAN(THETA))
      ELSE Y:=FILTER(FILDERIV,I);
      IF LASTY<>0.0 THEN A:=A+(LASTY+Y)*(XDATAVAL(I)-XDATAVAL(I-1));
      SUMY:=SUMY+Y; SUMYY:=SUMYY+SQR(Y);
      LASTY:=Y;
      END; {IF}
    I:=I+1;
  UNTIL I>LAST;
  S:=SQRT( (SUMYY-SQR(SUMY)/N)/(N-1) );
  IF ANS='R' THEN ST:='Rel' ELSE ST:='Abs';
  CLRBOX(0,0,GETMAXX,24,TRUE);
  OUTTEXTXY(3,LINE1,CONCAT(ST,' Int=',RLTOSTR(A/2,12),' over: ',
            RLTOSTR(xcoorduc(lx),14),' to ',
            RLTOSTR(xcoorduc(rx),14) ));
  MOVETO(3,LINE2);
  OUTTEXT(CONCAT(ST,' <Y>=',RLTOSTR(sumy/n,12),'(',CHAR(241),
                 RLTOSTR(s*t(n-1)/sqrt(n),12),')      Std Dev =',
                 RLTOSTR(s,12)));
END; {PROCEDURE INTEGRATE}

{************************* PROCEDURE LIMITS ********************************}
PROCEDURE LIMITS(LOXUC,HIXUC:REAL; VAR FIRST,LAST,LWBIC,RWBIC:INTEGER);
  {This procedure calculates FIRST and LAST appropriate for the given user
   coordinate window boundaries.  It also returns new values of LWBIC and
   RWBIC.}
VAR
  X1,X2        : REAL;    {user coordinates of old first & last points}
  LEFT         : BOOLEAN; {T=first on left, F=first on right}
  F,L          : INTEGER; {temporary values of FIRST and LAST}
  OVERF,OVERL  : BOOLEAN; {flag for window boundaries outside of data extents}
BEGIN
  OVERF:=FALSE; OVERL:=FALSE; X1:=XDATAVAL(FIRST); X2:=XDATAVAL(LAST);
  LEFT:=(X2-X1)/(RWBUC-LWBUC)>0;
  {calculate approximate values by linear interpolation}
    IF LEFT THEN BEGIN
      F:=FIRST + ROUND((LWBUC-X1)/(X2-X1)*(LAST-FIRST)) - 1;
      L:=FIRST + ROUND((RWBUC-X1)/(X2-X1)*(LAST-FIRST)) + 1;
      END
    ELSE BEGIN
      F:=FIRST + ROUND((RWBUC-X1)/(X2-X1)*(LAST-FIRST)) - 1;
      L:=FIRST + ROUND((LWBUC-X1)/(X2-X1)*(LAST-FIRST)) + 1;
      END;
    IF F<1 THEN BEGIN FIRST:=1; OVERF:=TRUE; END;
    IF F>NUMPTS THEN BEGIN FIRST:=NUMPTS; OVERF:=TRUE; END;
    IF L>NUMPTS THEN BEGIN LAST:=NUMPTS;  OVERL:=TRUE; END;
    IF L<1 THEN BEGIN LAST:=1;  OVERL:=TRUE; END;
  {make sure values are not too far inside desired boundaries}
    IF NOT(OVERF) THEN WHILE (XDATAVAL(F)<HIXUC) AND (XDATAVAL(F)>LOXUC)
                             AND (L>F) AND (F>=2) DO F:=F-1;
    IF NOT(OVERL) THEN WHILE (XDATAVAL(L)<HIXUC) AND (XDATAVAL(L)>LOXUC)
                             AND (L>F) AND (L<=(NUMPTS-1)) DO L:=L+1;
   {now choose points just inside desired limits}
    IF NOT(OVERF) THEN BEGIN
      WHILE NOT((XDATAVAL(F)<=HIXUC)AND(XDATAVAL(F)>=LOXUC))AND(L>F) DO F:=F+1;
      FIRST:=F;
      IF LEFT THEN LWBIC:=F ELSE RWBIC:=F;
      END;
    IF NOT(OVERL) THEN BEGIN
      WHILE NOT((XDATAVAL(L)<=HIXUC)AND(XDATAVAL(L)>=LOXUC))AND(L>F) DO L:=L-1;
      LAST:=L;
      IF LEFT THEN RWBIC:=L ELSE LWBIC:=L;
      END;
    IF LEFT THEN BEGIN LWBIC:=F; RWBIC:=L; END
    ELSE BEGIN LWBIC:=L; RWBIC:=F END;
END; {PROCEDURE LIMITS}

{*********************** PROCEDURE LABELS **********************************}
PROCEDURE LABELS;
  {This procedure writes out the information at the bottom of the plot.}
VAR S:STR30; ST:STR80;

  FUNCTION RLTOST(RL:REAL):STR20;
  VAR S:STR20;
  BEGIN STR(RL:6:3,S); RLTOST:=S; END;

BEGIN
  CLRBOX(0,GETMAXY-24,GETMAXX,GETMAXY,TRUE);
  SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  STR(STEPSIZE,S); ST:=CONCAT('File: ',FILENAME,'  Stepsize:',S);
  IF FILWIDTH<>1 THEN BEGIN
    ST:=CONCAT(ST,'    Filter:');  STR(FILWIDTH,S);
    CASE FILTYPE OF
      0: ST:=CONCAT(ST,'MA  Width:',S);
      1: BEGIN
           ST:=CONCAT(ST,'SG  Width:',S);
           STR(FILDEGREE,S); ST:=CONCAT(ST,'  Degree:',S);
           IF FILDERIV<>0 THEN BEGIN
             STR(FILDERIV,S); ST:=CONCAT(ST,'  Derivative:',S);
             END;
         END; {1}
    END; {CASE}
    END; {IF}
  OUTTEXTXY(3,GETMAXY-21,ST);
  ST:=CONCAT('L:',RLTOST(LWBUC),' R:',RLTOST(RWBUC),' B:',RLTOST(BWBUC),
             ' T:',RLTOST(TWBUC));
  IF TRACE THEN ST:=CONCAT(ST,'      (x-hair trace mode)');
  OUTTEXTXY(3,GETMAXY-11,ST);
END; {PROCEDURE LABELS}

{************************ DUMP_TEXT **************************************}
PROCEDURE DUMP_TEXT;
VAR DUMPNAME         :STR20;
    LINE1,LINE2,ERR,I:INTEGER;
    ANS,C            :CHAR;
    OUTFILE          :TEXT;
BEGIN
  LINE1:=GETMAXY-21; LINE2:=GETMAXY-11; DUMPNAME:='QUIT';
  SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  REPEAT
    CLRBOX(0,GETMAXY-24,GETMAXX,GETMAXY,TRUE); ANS:='Y';
    OUTTEXTXY(3,LINE1,CONCAT('This procedure dumps the displayed data ',
                             'to a text file.'));
    MOVETO(3,LINE2);
    OUTTEXT(CONCAT('Name of the file (QUIT if none) [',DUMPNAME,']: '));
    GRDSTR20(DUMPNAME);
    FOR I:=1 TO LENGTH(DUMPNAME) DO DUMPNAME[I]:=UPCASE(DUMPNAME[I]);
    CLRBOX(0,GETMAXY-24,GETMAXX,GETMAXY,TRUE);
    IF EXISTS(DUMPNAME) AND (DUMPNAME <> 'QUIT') THEN BEGIN
      OUTTEXTXY(3,LINE1,CONCAT('File ',DUMPNAME,' already exists.'));
      REPEAT
        MOVETO(3,LINE2);
        OUTTEXT(CONCAT('Overwrite the existing file (Y or N) [',
                       ANS,']: '));
        GRDCHAR(ANS); CLRBOX(0,GETMAXY-24,GETMAXX,GETMAXY,TRUE);
      UNTIL ANS IN ['Y','N'];
      END; {IF}
    IF (DUMPNAME<>'QUIT') AND (ANS='Y') THEN BEGIN
      ASSIGN(OUTFILE,DUMPNAME); REWRITE(OUTFILE); ERR:=IORESULT;
      IF ERR<>0 THEN BEGIN
        OUTTEXTXY(3,LINE1,CONCAT('IO error ',INTTOSTR(ERR)));
        OUTTEXTXY(3,LINE2,'Hit any key to continue.');
        REPEAT UNTIL KEYPRESSED; C:=READKEY;
        IF C=#0 THEN C:=READKEY;
        END {IF}
      ELSE BEGIN
        OUTTEXTXY(3,LINE1,CONCAT('Data is being written to file ',
                                 DUMPNAME,'.'));
        I:=FIRST;
        REPEAT
          WRITELN(OUTFILE,XDATAVAL(I),' ',FILTER(FILDERIV,I));
          I:=I+STEPSIZE;
        UNTIL (I>LAST);
        END; {ELSE}
      CLOSE(OUTFILE);
      END; {IF}
  UNTIL ANS='Y';
END;

{**************************** SCRNDRAW *********************************}
PROCEDURE SCRNDRAW(ELIPSFLAG:BOOLEAN; STEPSIZE:INTEGER);
  {This procedure plots the data or a function on the screen.}
VAR I,XSC,YSC,START  :INTEGER;
    X          :DOUBLE;
    INRANGE    :BOOLEAN;
BEGIN
  SETWRITEMODE(COPYPUT); {overlap with existing stuff}
  START:=FIRST; I:=FIRST;
  REPEAT
    X:=XDATAVAL(I); XSC:=XCOORDSC(X); YSC:=YCOORDSC(FILTER(FILDERIV,I));
    IF (XSC>SCRLEFT)AND(XSC<GETMAXX)AND(YSC>SCRTOP)AND
       (YSC<(GETMAXY-SCRBOTTOM)) THEN INRANGE:=TRUE
    ELSE BEGIN INRANGE:=FALSE; START:=I+1; END;
    IF (I=START) OR NOT(INRANGE) THEN MOVETO(XSC,YSC);
    IF INRANGE THEN BEGIN
      IF (I<>START) AND LINEFLAG THEN LINETO(XSC,YSC);
      IF ELIPSFLAG THEN CIRCLE(XSC,YSC,1);
      END;
    I:=I+STEPSIZE;
  UNTIL I>LAST;
  SETWRITEMODE(XORPUT); {erase if overlap}
END; {SCRNDRAW}

{************************ PROCEDURE CHANGEFILTER ***********************}
PROCEDURE CHANGEFILTER;
BEGIN
  SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  CLRBOX(0,0,GETMAXX,24,TRUE);
  MOVETO(3,LINE1);
  OUTTEXT(CONCAT('Size of steps between displayed data points [',
          INTTOSTR(STEPSIZE),']: ')); GRDINT(STEPSIZE);
  REPEAT
    MOVETO(3,LINE2);
    OUTTEXT(CONCAT('Type of filter: 0-Moving Avg, 1-Savitzky Golay [',
            INTTOSTR(FILTYPE),']: '));  GRDINT(FILTYPE);
    CLRBOX(0,0,GETMAXX,24,TRUE);
  UNTIL FILTYPE=0;
  MOVETO(3,LINE1);
  OUTTEXT(CONCAT('Width of filter [',inttostr(filwidth),']: '));
  GRDINT(FILWIDTH);
  REDRAW:=TRUE;
END;

{************************ PROCEDURE TRANSX ***************************}
PROCEDURE TRANSX;
VAR
  ANS               : CHAR;
  I                 : INTEGER;
  SLOPE,INT         : REAL;
  OLDSLOPE,OLDINT   : REAL;
BEGIN
  SLOPE:=1; INT:=0; ANS:='N';
  SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  REPEAT
    CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1);
    OUTTEXT(CONCAT('Linear transform of x axis (Y or N) [',ans,']? '));
      GRDCHAR(ANS);
  UNTIL ANS IN ['Y','y', 'N','n'];
  IF ANS IN ['Y','y'] THEN BEGIN
    REPEAT
      OLDSLOPE:=SLOPE; OLDINT:=INT;
      CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1);
      OUTTEXT(CONCAT('Slope [',RLTOSTR(slope,15),']: ')); GRDREAL(SLOPE);
      MOVETO(3,LINE2);
      OUTTEXT(CONCAT('Intercept [',RLTOSTR(INT,15),']: ')); GRDREAL(INT);
    UNTIL ((OLDSLOPE=SLOPE) AND (INT=OLDINT));
    IF ((SLOPE<>1) OR (INT<>0)) THEN BEGIN
      FOR I:=1 TO NUMPTS DO DATA[1,I]:=SLOPE*DATA[1,I]+INT;
      MINX:=SLOPE*MINX+INT; MAXX:=SLOPE*MAXX+INT;
      IF CHFLAG THEN BEGIN
        CHXUC:=SLOPE*CHXUC+INT; CHXSC:=XCOORDSC(CHXUC);
        END;
      IF LINFLAG THEN BEGIN
        LINXUC:=SLOPE*CHXUC+INT; LINXSC:=XCOORDSC(LINXUC);
        END;
      END; {IF}
    END; {IF}
END; {PROCEDURE TRANSX}

{************************ PROCEDURE TRANSY ***************************}
PROCEDURE TRANSY;
VAR
  ANS               : CHAR;
  I                 : INTEGER;
  SLOPE,INT         : REAL;
  OLDSLOPE,OLDINT   : REAL;
BEGIN
  SLOPE:=1; INT:=0; ANS:='N';
  SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  REPEAT
    CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1);
    OUTTEXT(CONCAT('Linear transform of y axis (Y or N) [',ans,']? '));
      GRDCHAR(ANS);
  UNTIL ANS IN ['Y','y', 'N','n'];
  IF ANS IN ['Y','y'] THEN BEGIN
    REPEAT
      OLDSLOPE:=SLOPE; OLDINT:=INT;
      CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1);
      OUTTEXT(CONCAT('Slope [',RLTOSTR(slope,15),']: ')); GRDREAL(SLOPE);
      MOVETO(3,LINE2);
      OUTTEXT(CONCAT('Intercept [',RLTOSTR(INT,15),']: ')); GRDREAL(INT);
    UNTIL ((OLDSLOPE=SLOPE) AND (INT=OLDINT));
    IF ((SLOPE<>1) OR (INT<>0)) THEN BEGIN
      FOR I:=1 TO NUMPTS DO DATA[2,I]:=SLOPE*DATA[2,I]+INT;
      TWBUC:=TWBUC*SLOPE+INT; BWBUC:=BWBUC*SLOPE+INT;
      LOY:=SLOPE*LOY+INT;     HIY:=SLOPE*HIY+INT;
      IF CHFLAG THEN BEGIN
        CHYUC:=SLOPE*CHYUC+INT; CHYSC:=YCOORDSC(CHYUC);
        END;
      IF LINFLAG THEN BEGIN
        LINYUC:=SLOPE*LINYUC+INT; LINYSC:=YCOORDSC(LINYUC);
        END;
      END; {IF}
    END; {IF}
END; {PROCEDURE TRANSY}

{************************ PROCEDURE CONV *****************************}
PROCEDURE CONV(ANG:BOOLEAN);
VAR  ANS:CHAR;  I:INTEGER;
BEGIN
  ANS:='N';
  SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  REPEAT
    CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1);
    IF ANG THEN
      OUTTEXT(CONCAT('Angstrom to cm-1 conversion (Y or N) [',ans,']? '))
    ELSE OUTTEXT(CONCAT('cm-1 to Angstrom conversion (Y or N) [',ans,']? '));
    GRDCHAR(ANS);
  UNTIL ANS IN ['Y','y', 'N','n'];
  IF ANS IN ['Y','y'] THEN BEGIN
    IF ANG THEN BEGIN {Angstroms to cm-1}
      FOR I:=1 TO NUMPTS DO DATA[1,I]:=A_TO_CM(DATA[1,I]);
      XLABEL:='cm-1';
      IF CHFLAG THEN BEGIN
        CHXUC:=A_TO_CM(CHXUC); CHXSC:=XCOORDSC(CHXUC);
        END;
      IF LINFLAG THEN BEGIN
        LINXUC:=A_TO_CM(LINXUC); LINXSC:=XCOORDSC(LINXUC);
        END;
      MINX:=A_TO_CM(MINX); MAXX:=A_TO_CM(MAXX);
      END
    ELSE BEGIN {cm-1 to Angstroms}
      FOR I:=1 TO NUMPTS DO DATA[1,I]:=CM_TO_A(DATA[1,I]);
      XLABEL:='Angstroms';
      IF CHFLAG THEN BEGIN
        CHXUC:=CM_TO_A(CHXUC); CHXSC:=XCOORDSC(CHXUC);
        END;
      IF LINFLAG THEN BEGIN
        LINXUC:=CM_TO_A(LINXUC); LINXSC:=XCOORDSC(LINXUC);
        END;
      MINX:=CM_TO_A(MINX); MAXX:=CM_TO_A(MAXX);
      END; {ELSE}
    END; {IF}
END;

{************************ PROCEDURE CHNG_LABELS **********************}
PROCEDURE CHNG_LABELS;
BEGIN
  SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  CLRBOX(0,0,GETMAXX,24,TRUE);
  MOVETO(3,LINE1); OUTTEXT(CONCAT('X axis label [',XLABEL,']? '));
    GRDSTR40(XLABEL);
  MOVETO(3,LINE2); OUTTEXT(CONCAT('Y axis label [',YLABEL,']? '));
    GRDSTR40(YLABEL);
END;

{************************ PROCEDURE SETLIM ***************************}
PROCEDURE SETLIM; {Manual setting of window limits.}
BEGIN
  SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  CLRBOX(0,0,GETMAXX,24,TRUE);
  MOVETO(3,LINE1); OUTTEXT(CONCAT('Left [',RLTOSTR(LWBUC,15),']? '));
    GRDREAL(LWBUC);
  MOVETO(3,LINE2); OUTTEXT(CONCAT('Right [',RLTOSTR(RWBUC,15),']? '));
    GRDREAL(RWBUC);
  CLRBOX(0,0,GETMAXX,24,TRUE);
  MOVETO(3,LINE1); OUTTEXT(CONCAT('Bottom [',RLTOSTR(BWBUC,15),']? '));
    GRDREAL(BWBUC);
  MOVETO(3,LINE2); OUTTEXT(CONCAT('Top [',RLTOSTR(TWBUC,15),']? '));
    GRDREAL(TWBUC);
  REDRAW:=TRUE;
END;

{************************ PROCEDURE ZOOMOUT **************************}
PROCEDURE ZOOMOUT;
VAR AMOUNT:REAL;
BEGIN
  SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  CLRBOX(0,0,GETMAXX,24,TRUE);
  AMOUNT:=ABS(RWBUC-LWBUC)/2;  MOVETO(3,LINE1);
  OUTTEXT('Expand window horizontally by how many');
  MOVETO(3,LINE2);
  OUTTEXT(CONCAT('units on each side [',RLTOSTR(AMOUNT,15),']? '));
    GRDREAL(AMOUNT);
  IF RWBUC>LWBUC THEN AMOUNT:=ABS(AMOUNT) ELSE AMOUNT:=-ABS(AMOUNT);
  LWBUC:=LWBUC-AMOUNT; RWBUC:=RWBUC+AMOUNT;
  REDRAW:=TRUE;
END;

{*********************** PROCEDURE PAN ******************************}
PROCEDURE PAN(S:STR20);
VAR AMOUNT:REAL;
BEGIN
  SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  CLRBOX(0,0,GETMAXX,24,TRUE);
  AMOUNT:=ABS(RWBUC-LWBUC)/2;  MOVETO(3,LINE1);
  OUTTEXT(CONCAT('Pan ',S,' how many units [',RLTOSTR(AMOUNT,15),']? '));
    GRDREAL(AMOUNT);
  AMOUNT:=ABS(AMOUNT);
  IF (RWBUC>LWBUC) AND (S='left') THEN AMOUNT:=-AMOUNT;
  IF (RWBUC<LWBUC) AND (S='right') THEN AMOUNT:=-AMOUNT;
  LWBUC:=LWBUC+AMOUNT; RWBUC:=RWBUC+AMOUNT;
  REDRAW:=TRUE;
END;

{************************ PROCEDURE POST *****************************}
PROCEDURE POST;
VAR  ANS               :CHAR;
     I,J,ERR,MAXX,MAXY :INTEGER;
     DUMPNAME          :STR20;
     OUTFILE           :TEXT;
     INDEX,VALUE       :BYTE;
BEGIN
  ANS:='N'; MAXX:=GETMAXX; MAXY:=GETMAXY;
  DUMPNAME:=FILENAME; I:=POS('.',FILENAME);
  IF I<>0 THEN DELETE(DUMPNAME,I,LENGTH(DUMPNAME)-I+1);
  DUMPNAME:=CONCAT(DUMPNAME,'.EPS');
  SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  REPEAT
    CLRBOX(0,0,MAXX,24,TRUE); MOVETO(3,LINE1);
    OUTTEXT(CONCAT('Postscript screen dump (Y or N) [',ans,']? '));
    GRDCHAR(ANS);
  UNTIL ANS IN ['Y','y', 'N','n'];
  IF ANS IN ['Y','y'] THEN BEGIN
    MOVETO(3,LINE2);
    OUTTEXT(CONCAT('Name of the file (QUIT to abort) [',DUMPNAME,']: '));
    GRDSTR20(DUMPNAME);
    FOR I:=1 TO LENGTH(DUMPNAME) DO DUMPNAME[I]:=UPCASE(DUMPNAME[I]);
    CLRBOX(0,0,MAXX,24,TRUE);
    IF EXISTS(DUMPNAME) AND (DUMPNAME <> 'QUIT') THEN BEGIN
      OUTTEXTXY(3,LINE1,CONCAT('File ',DUMPNAME,' already exists.'));
      REPEAT
        MOVETO(3,LINE2);
        OUTTEXT(CONCAT('Overwrite the existing file (Y or N) [',ANS,']: '));
        GRDCHAR(ANS); CLRBOX(0,0,MAXX,24,TRUE);
      UNTIL ANS IN ['Y','y','N','n'];
      END; {IF}
    IF (DUMPNAME='QUIT') THEN ANS:='N';
    END; {IF}
  CLRBOX(0,0,MAXX,24,FALSE);
  IF ANS IN ['Y','y'] THEN BEGIN
    ASSIGN(OUTFILE,DUMPNAME); REWRITE(OUTFILE); ERR:=IORESULT;
    IF ERR<>0 THEN BEGIN
      CLRBOX(0,0,MAXX,24,TRUE);
      OUTTEXTXY(3,LINE1,CONCAT('IO error ',INTTOSTR(ERR)));
      OUTTEXTXY(3,LINE2,'Hit any key to continue.');
      REPEAT UNTIL KEYPRESSED; ANS:=READKEY;
      IF ANS=#0 THEN ANS:=READKEY;
      END
    ELSE BEGIN
      IF CHFLAG THEN BEGIN DRAWCH; DRAWCH; END;
      IF LINFLAG THEN BEGIN DRAWLN; DRAWLN; END;
      WRITELN(OUTFILE,'%!PS-ADOBE-2.0');
      WRITELN(OUTFILE,'gsave');
      WRITELN(OUTFILE,'/picstr 1 string def');
      WRITELN(OUTFILE,'27 756 moveto');
      WRITELN(OUTFILE,ROUND(7.5*72),' ',ROUND((MAXY+1)/(MAXX+1)*7.5*72),
                      ' scale');
      WRITELN(OUTFILE,'0 -1 rmoveto');
      WRITELN(OUTFILE,'currentpoint translate');
      WRITELN(OUTFILE,MAXX+1,' ',MAXY+1,' 1');
      WRITELN(OUTFILE,'[',MAXX+1,' 0 0 ',-MAXY-1,' 0 ',MAXY+1,']');
      WRITELN(OUTFILE,'{ currentfile picstr readhexstring pop }');
      WRITELN(OUTFILE,'image');
      INDEX:=8; VALUE:=0;
      FOR J:=0 TO MAXY DO FOR I:=0 TO MAXX DO BEGIN
        IF (J=LINE2+20) AND (I=0) THEN BEGIN
          CLRBOX(0,0,MAXX,24,TRUE);
          OUTTEXTXY(3,LINE1,CONCAT('Data is being written to file ',
                                    DUMPNAME,'.'));
          END;
        INDEX:=INDEX-1;
        IF GETPIXEL(I,J)<>0 THEN VALUE:=VALUE OR (1 SHL INDEX);
        IF INDEX=0 THEN BEGIN
          WRITE(OUTFILE,HEX(NOT VALUE)); INDEX:=8; VALUE:=0;
          END;
        END; {FOR}
      IF INDEX<>8 THEN WRITE(OUTFILE,HEX(NOT VALUE));
      WRITELN(OUTFILE); WRITELN(OUTFILE,'grestore showpage');
      BEEP(200);
      END; {ELSE}
    CLOSE(OUTFILE);
    END; {IF}
  CLRBOX(0,0,MAXX,24,FALSE);
  IF CHFLAG THEN BEGIN DRAWCH; DRAWCH; END;
  IF LINFLAG THEN BEGIN DRAWLN; DRAWLN; END; {crosshair must be drawn first}
END;

{************************ PROCEDURE MINMAX *******************************}
PROCEDURE MINMAX; {Displays min and max x and y values for displayed data.}
VAR I                   :INTEGER;
    X,Y                 :REAL;
    XMIN,XMAX,YMIN,YMAX :REAL;
    START               :BOOLEAN;
    CH                  :CHAR;
BEGIN
  I:=FIRST; START:=TRUE;
  REPEAT
    X:=XDATAVAL(I); Y:=FILTER(FILDERIV,I);
    IF (XCOORDSC(X)>SCRLEFT)AND(XCOORDSC(X)<GETMAXX) THEN
      IF START THEN BEGIN
        XMIN:=X; XMAX:=X; YMIN:=Y; YMAX:=Y; START:=FALSE;
        END
      ELSE BEGIN
        IF X>XMAX THEN XMAX:=X; IF X<XMIN THEN XMIN:=X;
        IF Y>YMAX THEN YMAX:=Y; IF Y<YMIN THEN YMIN:=Y;
        END;
    I:=I+STEPSIZE;
  UNTIL I>LAST;
  SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1);
  OUTTEXT(CONCAT('x: Min=',RLTOSTR(XMIN,15),'   Max=',RLTOSTR(XMAX,15)));
  MOVETO(3,LINE2);
  OUTTEXT(CONCAT('y: Min=',RLTOSTR(YMIN,15),'   Max=',RLTOSTR(YMAX,15),
                 '        <ENTER> to continue'));
  REPEAT CH:=READKEY UNTIL CH=CHAR(13);
  CLRBOX(0,0,GETMAXX,24,FALSE); MOVETO(3,LINE1);
  IF CHFLAG THEN BEGIN DRAWCH; DRAWCH; END;
  IF LINFLAG THEN BEGIN DRAWLN; DRAWLN; END; {crosshair must be drawn first}
END; {PROCEDURE MINMAX}

{************************** NONLINEAR ***********************************}
PROCEDURE NONLINEAR(XY:CHAR);
VAR ANS,I,WHICH : INTEGER;
    MAX,MIN,VAL : REAL;
  FUNCTION CONVERT(X:SINGLE):SINGLE;
  CONST XMIN=2.9E-39*100; XMAX=1.7E38/100;
  BEGIN
    CASE ANS OF
      1: IF X<SQRT(XMAX) THEN CONVERT:=SQR(X) ELSE CONVERT:=XMAX;
      2: IF ABS(X)>SQR(XMIN) THEN CONVERT:=SQRT(ABS(X)) ELSE CONVERT:=XMIN;
      3: IF ABS(X)>0 THEN CONVERT:=LN(ABS(X))  ELSE CONVERT:=-XMAX;
      4: IF ABS(X)>0 THEN CONVERT:=LOG(ABS(X)) ELSE CONVERT:=-XMAX;
      5: IF ABS(X)<LN(XMAX) THEN CONVERT:=EXP(X)
         ELSE IF X>0 THEN CONVERT:=XMAX
         ELSE IF X<0 THEN CONVERT:=0;
      6: IF ABS(X)<LOG(XMAX) THEN CONVERT:=EXP(X*LN(10))
         ELSE IF X>0 THEN CONVERT:=XMAX
         ELSE IF X<0 THEN CONVERT:=0;
      ELSE CONVERT:=X;
      END; {case}
    END; {FUNCTION CONVERT}
BEGIN
  RESTORECRTMODE;
  ANS:=0; WHICH:=ORD(XY='Y')+1;
  WRITELN('Nonlinear transformation of ',xy,' axis.'); WRITELN;
  WRITELN('The following transformations are available.');
  WRITELN('  0. None.');
  WRITELN('  1. Sqr(',xy,').');
  WRITELN('  2. Sqrt(|',XY,'|).');
  WRITELN('  3. Ln(|',XY,'|).');
  WRITELN('  4. Log(|',XY,'|).');
  WRITELN('  5. Exp(',XY,').');
  WRITELN('  6. 10^(',XY,').');
  WRITE('Select one [',ans,']: '); RDINTLN(OUTPUT,ANS);
  IF ANS IN [1..6] THEN BEGIN
    MAX:=CONVERT(DATA[WHICH,1]); MIN:=MAX;
    FOR I:=1 TO NUMPTS DO BEGIN
      VAL:=CONVERT(DATA[WHICH,I]);
      IF VAL<MIN THEN MIN:=VAL; IF VAL>MAX THEN MAX:=VAL;
      DATA[WHICH,I]:=VAL;
      END; {FOR}
    MAX:=MAX+ABS(MAX-MIN)/40; MIN:=MIN-ABS(MAX-MIN)/40;
    IF XY='X' THEN BEGIN
      RWBUC:=MAX; LWBUC:=MIN; MINX:=MIN;  MAXX:=MAX;
      END
    ELSE BEGIN
      TWBUC:=MAX; BWBUC:=MIN; LOY:=MIN; HIY:=MAX;
      END;
    IF CHFLAG THEN
      IF XY='X' THEN CHXUC:=CONVERT(CHXUC)
      ELSE CHYUC:=CONVERT(CHYUC);
    IF LINFLAG THEN
      IF XY='X' THEN LINXUC:=CONVERT(LINXUC)
      ELSE LINYUC:=CONVERT(LINYUC);
    NEWMODE:=TRUE;
    END; {IF ANS}
  SETGRAPHMODE(GETGRAPHMODE);
  REDRAW:=TRUE;
END; {PROCEDURE NONLINEAR}

{************************ PROCEDURE HELP *****************************}
PROCEDURE HELP; {Provides display of key assignments.}
VAR UD,LR:STRING[3];
BEGIN
  RESTORECRTMODE;
  LR:=CONCAT(CHAR(26),'/',CHAR(27)); UD:=CONCAT(CHAR(24),'/',CHAR(25));
  WRITELN('             F1: Crosshair               CTRL F1: Ruler');
  WRITELN('             F2: Circle points           CTRL F2: Connect-the-dots');
  WRITELN('             F3: Filter parameters       CTRL F3: Integrate');
  WRITELN('             F4: Crosshair trace         CTRL F4: Labels');
  WRITELN('             F5: Dump to file            CTRL F5: Postscript screen dump');
  WRITELN('             F6: X linear transform      CTRL F6: Y linear transform');
  WRITELN('             F7: Left/right invert       CTRL F7: Top/bottom inversion');
  WRITELN('             F8: Angstrom to cm-1        CTRL F8: cm-1 to Angstroms');
  WRITELN('              N: X nonlinear transform     ALT N: Y nonlinear transform');
  WRITELN('              M: Min/max');
  WRITELN('              D: DOS command                   H: Help');
  WRITELN('WINDOW CONTROL:');
  WRITELN('    PG UP/PG DN: Faster/slower               ',UD,': Expand/contract');
  WRITELN('            ',LR,': Horizontal             HOME/END: Vertical');
  WRITELN('                 expand/contract                  expand/contract');
  WRITELN('       CTRL ',LR,': Left/right             CTRL ',UD,': Up/down');
  WRITELN('  ENTER/+/SPACE: Zoom                 CTRL ENTER: Original plot');
  WRITELN('              L: Limits                        X: Expand horizontally');
  WRITELN('             F9: Pan left                    F10: Pan right');
  WRITELN('CROSSHAIR CONTROL:');
  WRITELN('  7/8: faster/slower    9/0: up/down         -/=: left/right');
  WRITELN('RULER CONTROL:');
  WRITELN('  3/4: up/down          5/6: Left/right      Q/W: Shorter/longer');
  WRITELN('  1/2: rotate             E: FWHM position     R: Horizontal/vertical');
  WRITE('                    <ENTER> to continue.'); READLN;
  SETGRAPHMODE(GETGRAPHMODE);
  REDRAW:=TRUE;
END;

{************************** MAIN PROGRAM *****************************}
BEGIN

{Set up the graphics window.}
  CLRSCR;          {clear the screen}
  GRAPHDRIVER:=0;  {autodetect graphics device}
  INITGRAPH(GRAPHDRIVER,GRAPHMODE,DRIVERS); ERRCODE:=GRAPHRESULT;
  IF ERRCODE<>0 THEN BEGIN
    BEEP(200);
    WRITELN('Graphics error: ',grapherrormsg(errcode));
    WRITE('Hit any key to continue. '); READLN;
    END;

IF ERRCODE=0 THEN BEGIN
  {Initialize}
    FIRST:=1; LAST:=NUMPTS;
    BWBUC:=LOY; TWBUC:=HIY; LWBUC:=MINX; RWBUC:=MAXX;
    LWBIC:=1; RWBIC:=NUMPTS;
    XLABEL:='X'; YLABEL:='Y';
    NEWMODE:=FALSE; DONEFLAG:=FALSE; ELIPSFLAG:=FALSE; FRAME:=FALSE;
    LINEFLAG:=TRUE; WINDSENS:=20;    LINFLAG:=FALSE;
    CHFLAG:=FALSE;  CHSENS:=20;      TRACE:=FALSE;
    FILTYPE:=0;     FILDEGREE:=2;    FILWIDTH:=1;      FILDERIV:=0;
    STEPSIZE:=1;
  {initialize crosshair and line to center of window}
    CHXSC:=ROUND((SCRLEFT+GETMAXX)/2);
    CHYSC:=ROUND((GETMAXY-SCRBOTTOM+SCRTOP)/2);
    LINXSC:=CHXSC; LINYSC:=CHYSC; LINLEN:=30; THETA:=0.0; TRACE:=FALSE;

  REPEAT {UNTIL DONEFLAG}
    REDRAW:=FALSE;
    {initialize window boundaries in screen coords}
      LWBSC:=SCRLEFT;           RWBSC:=GETMAXX;
      BWBSC:=GETMAXY-SCRBOTTOM; TWBSC:=SCRTOP;
    {clear window}
      CLEARDEVICE; SETWRITEMODE(XORPUT);

    IF NEWMODE THEN BEGIN {redefine bounds in new user coords}
      NEWMODE:=FALSE; LWBUC:=XDATAVAL(LWBIC); RWBUC:=XDATAVAL(RWBIC);
      END; {IF NEWMODE}
    {determine min and max x axis values}
      IF (RWBUC>LWBUC) THEN BEGIN LOXUC:=LWBUC; HIXUC:=RWBUC; END
      ELSE BEGIN LOXUC:=RWBUC; HIXUC:=LWBUC; END;
    {determine first and last points}
      LIMITS(LOXUC,HIXUC,FIRST,LAST,LWBIC,RWBIC);
    {determine screen positions of crosshair and line}
      IF (CHXUC>HIXUC) OR (CHXUC<LOXUC) THEN CHXSC:=ROUND((LWBSC+RWBSC)/2)
      ELSE CHXSC:=XCOORDSC(CHXUC);
      IF (LINXUC>HIXUC) OR (LINXUC<LOXUC) THEN LINXSC:=CHXSC
      ELSE LINXSC:=XCOORDSC(LINXUC);
      IF (TWBUC>BWBUC) THEN BEGIN
        IF (CHYUC>TWBUC) OR (CHYUC<BWBUC) THEN CHYSC:=ROUND((BWBSC+TWBSC)/2)
        ELSE CHYSC:=YCOORDSC(CHYUC);
        IF (LINYUC>TWBUC) OR (LINYUC<BWBUC) THEN LINYSC:=CHYSC
        ELSE LINYSC:=YCOORDSC(LINYUC);
        END
      ELSE BEGIN
        IF (CHYUC<TWBUC) OR (CHYUC>BWBUC) THEN CHYSC:=ROUND((BWBSC+TWBSC)/2)
        ELSE CHYSC:=YCOORDSC(CHYUC);
        IF (LINYUC<TWBUC) OR (LINYUC>BWBUC) THEN LINYSC:=CHYSC
        ELSE LINYSC:=YCOORDSC(LINYUC);
        END;
      IF TRACE THEN SETCHY;
    {plot the data}
      RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
      LABELS;
      AXIS(LWBUC,RWBUC,BWBUC,TWBUC,LWBSC,RWBSC,BWBSC,TWBSC,XLABEL,YLABEL);
      SCRNDRAW(ELIPSFLAG,STEPSIZE);
    {overlay the remaining stuff}
      IF CHFLAG THEN DRAWCH;
      IF LINFLAG THEN DRAWLN; {crosshair must be drawn first}

    REPEAT {UNTIL REDRAW OR DONEFLAG}
      REPEAT UNTIL KEYPRESSED;
      ASCII:=ORD(READKEY);
      CASE ASCII OF
        0 : BEGIN SCANCODE:=ORD(READKEY);
            CASE SCANCODE OF
{F1}          59: BEGIN                           {toggle crosshair display}
                    CHFLAG:=NOT CHFLAG;
                    IF (TRACE AND CHFLAG) THEN SETCHY;
                    DRAWCH;
                  END;
{CTRL F1}     94: BEGIN {toggle line on/off}
                    LINFLAG:=NOT LINFLAG; DRAWLN;
                  END;
{F2}          60: BEGIN                             {toggle ellipse display}
                    REDRAW:=TRUE;
                    IF ELIPSFLAG THEN ELIPSFLAG:=FALSE ELSE ELIPSFLAG:=TRUE;
                    IF NOT(ELIPSFLAG OR LINEFLAG) THEN LINEFLAG:=TRUE;
                  END;
{CTRL F2}     95: BEGIN                             {toggle connect the dots}
                    REDRAW:=TRUE;
                    IF LINEFLAG THEN LINEFLAG:=FALSE ELSE LINEFLAG:=TRUE;
                    IF NOT(LINEFLAG OR ELIPSFLAG) THEN ELIPSFLAG:=TRUE;
                  END;
{F3}          61: BEGIN                            {change filter parameters}
                    CHANGEFILTER; REDRAW:=TRUE;
                  END;
{CTRL F3}     96: BEGIN                                    {peak integration}
                    IF LINFLAG THEN INTEGRATE;
                  END;
{F4}          62: IF CHFLAG THEN BEGIN          {toggle crosshair trace mode}
                    DRAWCH; {erase existing ch}
                    TRACE:=NOT TRACE;
                    IF TRACE THEN SETCHY; DRAWCH; LABELS;
                  END;
{CTRL F4}     97: BEGIN                                  {change axis labels}
                    CHNG_LABELS; REDRAW:=TRUE;
                  END;
{F5}          63: BEGIN                       {dump displayed data to a file}
                    DUMP_TEXT; LABELS;
                  END;
{CTRL F5}     98: POST;                              {postscript screen dump}
{F6}          64: BEGIN                        {x axis linear transformation}
                    TRANSX; NEWMODE:=TRUE; REDRAW:=TRUE;
                  END;
{CTRL F6}     99: BEGIN                        {y axis linear transformation}
                    TRANSY; NEWMODE:=TRUE; REDRAW:=TRUE;
                  END;
{PG UP -                                increase window movement sensitivity}
              73,132: BEGIN
                  CASE WINDSENS OF
                     1: WINDSENS:=2;   2:WINDSENS:=5; 5:WINDSENS:=10;
                    10: WINDSENS:=20; 20:WINDSENS:=50;
                    END; {CASE}
                  BEEP(200*WINDSENS);
                  END;
{PG DN -                                decrease window movement sensitivity}
              81,118: BEGIN
                  CASE WINDSENS OF
                    50:WINDSENS:=20; 20:WINDSENS:=10; 10:WINDSENS:=5;
                     5:WINDSENS:=2;   2:WINDSENS:=1;
                    END; {CASE}
                  BEEP(200*WINDSENS);
                  END;
{CTRL HOME - translate window up}
              119:IF (TWBSC-WINDSENS)>=SCRTOP THEN BEGIN
                    RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
                    TWBSC:=TWBSC-WINDSENS; BWBSC:=BWBSC-WINDSENS;
                    FRAME:=TRUE;
                    END;
{CTRL END - translate window down}
              117:IF (BWBSC+WINDSENS)<=(GETMAXY-SCRBOTTOM) THEN BEGIN
                    RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
                    TWBSC:=TWBSC+WINDSENS; BWBSC:=BWBSC+WINDSENS;
                    FRAME:=TRUE;
                    END;
{CTRL LEFT ARROW - translate window left}
              115:IF (LWBSC-WINDSENS)>=SCRLEFT THEN BEGIN
                    RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
                    LWBSC:=LWBSC-WINDSENS; RWBSC:=RWBSC-WINDSENS;
                    FRAME:=TRUE;
                    END;
{CTRL RIGHT ARROW - translate window to right}
              116:IF (RWBSC+WINDSENS)<=GETMAXX THEN BEGIN
                    RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
                    RWBSC:=RWBSC+WINDSENS; LWBSC:=LWBSC+WINDSENS;
                    FRAME:=TRUE;
                    END;
{LEFT ARROW - contract window horizontally}
              75: IF (RWBSC-LWBSC)>(2*WINDSENS) THEN BEGIN
                    RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
                    RWBSC:=RWBSC-WINDSENS; LWBSC:=LWBSC+WINDSENS;
                    FRAME:=TRUE;
                    END;
{RIGHT ARROW - expand window horizontally}
              77: IF ((LWBSC-WINDSENS)>=SCRLEFT) AND
                     ((RWBSC+WINDSENS)<=GETMAXX) THEN BEGIN
                    RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
                    LWBSC:=LWBSC-WINDSENS; RWBSC:=RWBSC+WINDSENS;
                    FRAME:=TRUE;
                    END;
{END -contract window vertically}
              79: IF (BWBSC-TWBSC)>(2*WINDSENS) THEN BEGIN
                    RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
                    TWBSC:=TWBSC+WINDSENS; BWBSC:=BWBSC-WINDSENS;
                    FRAME:=TRUE;
                    END;
{HOME - expand window vertically}
              71: IF ((BWBSC+WINDSENS)<=GETMAXY) AND
                     ((TWBSC-WINDSENS)>=SCRTOP) THEN BEGIN
                    RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
                    BWBSC:=BWBSC+WINDSENS; TWBSC:=TWBSC-WINDSENS;
                    FRAME:=TRUE;
                    END;
{UP ARROW - expand window}
              72: IF ((BWBSC+WINDSENS)<=GETMAXY) AND
                     ((TWBSC-WINDSENS)>=SCRTOP) AND
                     ((LWBSC-WINDSENS)>=SCRLEFT) AND
                     ((RWBSC+WINDSENS)<=GETMAXX) THEN BEGIN
                    RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
                    BWBSC:=BWBSC+WINDSENS; TWBSC:=TWBSC-WINDSENS;
                    LWBSC:=LWBSC-WINDSENS; RWBSC:=RWBSC+WINDSENS;
                    FRAME:=TRUE;
                    END;
{DOWN ARROW - contract window}
              80:IF ((RWBSC-LWBSC)>(2*WINDSENS)) AND
                     ((BWBSC-TWBSC)>(2*WINDSENS)) THEN BEGIN
                    RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
                    RWBSC:=RWBSC-WINDSENS; LWBSC:=LWBSC+WINDSENS;
                    TWBSC:=TWBSC+WINDSENS; BWBSC:=BWBSC-WINDSENS;
                    FRAME:=TRUE;
                    END;
{F7}          65: BEGIN {left/right inversion}
                    OLDLWBUC:=LWBUC; LWBUC:=RWBUC; RWBUC:=OLDLWBUC;
                    REDRAW:=TRUE;
                  END;
{CTRL F7}     100:BEGIN {top/bottom inversion}
                    OLDBWBUC:=BWBUC; BWBUC:=TWBUC; TWBUC:=OLDBWBUC;
                    REDRAW:=TRUE;
                  END;
{F8}          66: BEGIN {Angstrom to cm-1 conversion}
                    CONV(TRUE); NEWMODE:=TRUE; REDRAW:=TRUE;
                  END;
{CTRL F8}     101:BEGIN {cm-1 to Angstrom conversion}
                    CONV(FALSE); NEWMODE:=TRUE; REDRAW:=TRUE;
                  END;
{F9}          67: PAN('left');
{F10}         68: PAN('right');
{ALT N}       49: NONLINEAR('Y');      {y axis nonlinear transformation}
              END; {CASE}
            END;
{ESC}   27: DONEFLAG:=TRUE;
{ENTER, +, or SPACE - zoom}
        13,43,32: BEGIN
            REDRAW:=TRUE;
            OLDLWBUC:=LWBUC; OLDBWBUC:=BWBUC;
            LWBUC:=OLDLWBUC+((RWBUC-OLDLWBUC)*((LWBSC-SCRLEFT)/
                   (GETMAXX-SCRLEFT)));
            RWBUC:=OLDLWBUC+((RWBUC-OLDLWBUC)*((RWBSC-SCRLEFT)/
                   (GETMAXX-SCRLEFT)));
            BWBUC:=OLDBWBUC+(TWBUC-OLDBWBUC)*(BWBSC-GETMAXY+SCRBOTTOM)/
                   (SCRTOP-GETMAXY+SCRBOTTOM);
            TWBUC:=OLDBWBUC+(TWBUC-OLDBWBUC)*(TWBSC-GETMAXY+SCRBOTTOM)/
                   (SCRTOP-GETMAXY+SCRBOTTOM);
            END;
{0}     48: {crosshair up}
            IF CHFLAG AND ((CHYSC-CHSENS)>=SCRTOP) THEN BEGIN
              DRAWCH; CHYSC:=CHYSC-CHSENS; DRAWCH;
            END;
{9}     57: {crosshair down}
            IF CHFLAG AND ((CHYSC+CHSENS)<=(GETMAXY-SCRBOTTOM)) THEN BEGIN
              DRAWCH; CHYSC:=CHYSC+CHSENS; DRAWCH;
            END;
{=}     61: {crosshair right}
            IF CHFLAG AND ((CHXSC+CHSENS)<=GETMAXX) THEN BEGIN
              DRAWCH; CHXSC:=CHXSC+CHSENS; IF TRACE THEN SETCHY; DRAWCH;
            END;
{-}     45: {crosshair left}
            IF CHFLAG AND ((CHXSC-CHSENS)>=SCRLEFT) THEN BEGIN
              DRAWCH; CHXSC:=CHXSC-CHSENS; IF TRACE THEN SETCHY; DRAWCH;
            END;
{8}     56: BEGIN {increase crosshair sensitivity}
              CASE CHSENS OF
                1 :CHSENS:=2;    2:CHSENS:=5;    5:CHSENS:=10;
                10:CHSENS:=20;  20:CHSENS:=50;
              END; {CASE}
              BEEP(200*CHSENS);
            END;
{7}     55: BEGIN {decrease crosshair sensitivity}
              CASE CHSENS OF
                50:CHSENS:=20;  20:CHSENS:=10;  10:CHSENS:=5;
                 5:CHSENS:=2;    2:CHSENS:=1;
              END; {CASE}
              BEEP(200*CHSENS);
            END;
{line}  49,50,51,52,53,54,81,87,82,69,113,119,101,114:
          IF LINFLAG THEN BEGIN
            DRAWLN;
            CASE ASCII OF
{1}           49:BEGIN {rotate counterclockwise}
                   THETA:=THETA+CHSENS/LINLEN*2;
                   THETA:=THETA-TRUNC(THETA/(2*PI))*2*PI;
                 END;
{2}           50:BEGIN {rotate line clockwise}
                   THETA:=THETA-CHSENS/LINLEN*2;
                   THETA:=THETA-TRUNC(THETA/(2*PI))*2*PI;
                 END;
{3}           51:LINYSC:=LINYSC+CHSENS; {translate line down}
{4}           52:LINYSC:=LINYSC-CHSENS; {translate line up}
{5}           53:LINXSC:=LINXSC-CHSENS; {translate line to left}
{6}           54:LINXSC:=LINXSC+CHSENS; {translate line to right}
{Q}           81,113:LINLEN:=ABS(LINLEN-CHSENS); {shorten line}
{W}           87,119:LINLEN:=ABS(LINLEN+CHSENS); {lengthen line}
{E}           69,101:IF CHFLAG THEN BEGIN {move line to FWHM position}
                 LINYSC:=ROUND((CHYSC+LINYSC+TAN(THETA)*(CHXSC-LINXSC))/2);
                 LINXSC:=CHXSC;
                 END;
{R}           82,114:IF THETA=0 THEN THETA:=PI/2       {vertical/horizontal}
                 ELSE THETA:=0;
            END; {CASE}
            DRAWLN;
            END; {IF LINFLAG}
{H}     72,104: HELP;
{L}     76,108: SETLIM;                        {user specified window bounds}
{M}     77,109: MINMAX;                       {max and min of displayed data}
{N}     78,110: NONLINEAR('X');                  {x axis nonlinear transform}
{X}     88,120: ZOOMOUT;                              {zoom out horizontally}
{D}     68,100: BEGIN                                 {execute a DOS command}
                  RESTORECRTMODE; DOS_CMD; SETGRAPHMODE(GETGRAPHMODE);
                  REDRAW:=TRUE;
                END;
{CTRL ENTER - return to original plot}
        10: BEGIN
            REDRAW:=TRUE;
            FIRST:=1; LAST:=NUMPTS;
            BWBUC:=LOY; TWBUC:=HIY; LWBUC:=MINX; RWBUC:=MAXX;
            END;
      END; {CASE}
      IF FRAME THEN BEGIN
        RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC); FRAME:=FALSE;
        END;
    UNTIL REDRAW OR DONEFLAG;

  UNTIL DONEFLAG;
END; {IF}

CLOSEGRAPH;
END; {GRAF}

END. {UNIT}