home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / math / rcdsplay / grafed.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-04-30  |  50.4 KB  |  1,235 lines
  1. {$A+,B-,D+,E+,F-,G-,I+,L+,N+,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
  2. {$M 16384,0,655360}
  3. {*************************************************************************
  4.  TITLE   : GRAFED
  5.  VERSION : 2.1
  6.  AUTHOR  : Roger Carlson (after GRAFED5, version 3.2 of M.Riebe and
  7.            R.Carlson written for the IBM CS9000 computer) 5/29/90
  8.  FUNCTION: This unit contains the GRAF routine for interactive display of
  9.            xy data.
  10.  INPUTS  : DATA - The xy data.  The first index identifies x(1) or y(2)
  11.                   and the second index specifies the data point.
  12.            FILENAME - Name of the data file.
  13.            MINX   - Minimum x value.
  14.            MAXX   - Maximum x value.
  15.            LOY    - Smallest y value.
  16.            HIY    - Largest y value.
  17.            NUMPTS - Number of data points.
  18.  NOTES   : 1. In Turbo Pascal the maximum size of any variable is 64KB.
  19.               To use the largest possible data array sizes, I've used
  20.               a single precision data array, which uses 23 bit (7-8digit)
  21.               precision.
  22.  CHANGES : 6/2/90 (1.1,RJC) - Added window selection.
  23.            6/3/90 (1.2,RJC) - Modified to change passed parameters to
  24.              include x max and min rather than first and last index.
  25.            6/4/90 (1.3,RJC) - Added parameter window at bottom of screen.
  26.            6/12/90 (1.4,RJC) -Added crosshair, ruler and several bells and
  27.                               whistles.
  28.            7/6/90 (1.5,RJC) - Started some bells and whistles.  Moved
  29.              CLRBOX to AXISLBL.
  30.            3/23/91 (1.6,RJC) -Increased the maximum data array size to
  31.              7000 and changed data array type to single precision.  Also
  32.              changed screen driver path to d:\tp to be consistent with
  33.              lab computer setup.
  34.            3/28/91 (1.7,RJC) -Added peak integration routine and completed
  35.              the moving average option.
  36.            5/2/91 (1.8,RJC) - Corrected text file dump procedure to include
  37.              data filtering.
  38.            5/3/91 (1.9,RJC) - Added linear transformation of axes,
  39.              wavelength/wavenumber conversion of x axis, and change of
  40.              axis labels.
  41.            5/9/91 (2.0,RJC) - Added postscript print screen procedure,
  42.              user defined window bounds, pan left, pan right, expand
  43.              horizontally, dos shell command, and crosshair trace mode.
  44.            5/23/91 (2.1,RJC) - Corrected an array range error when the
  45.              newmode flag was set (eg for a linear transform of x).  Added
  46.              min/max procedure and nonlinear transforms.
  47. *************************************************************************}
  48.  
  49. UNIT GRAFED;
  50.  
  51. {$I-} {Disable IO checking.}
  52.  
  53. INTERFACE
  54.  
  55.   USES IOFUNCS;      {version 1.7}
  56.  
  57.   CONST MAXPTS=7000; {Maximum # of data points.}
  58.  
  59.   TYPE DARRAY=ARRAY[1..2,1..MAXPTS] OF SINGLE;
  60.  
  61.   PROCEDURE GRAF(VAR DATA:DARRAY; FILENAME:STR20; MINX,MAXX,LOY,HIY:REAL;
  62.                  NUMPTS:INTEGER);
  63.  
  64. IMPLEMENTATION
  65.  
  66. USES CRT,GRAPH,DOS,
  67.      MATH,        {VERSION 1.3}
  68.      AXISLBL;     {VERSION 2.6}
  69.  
  70. PROCEDURE GRAF;
  71.  
  72. CONST
  73.   DRIVERS='d:\tp';    {location of device drivers}
  74.   SCRLEFT=100;        {plot starts SCRLEFT units from left edge}
  75.   SCRBOTTOM=58;       {bottom of plot SCRBOTTOM units from screen bottom}
  76.   SCRTOP=28;          {top of plot SCRTOP unit from screen top}
  77.   LINE1=3;            {first line for window at top of screen}
  78.   LINE2=13;           {second line for window at top of screen}
  79.  
  80. VAR
  81.   ASCII       : INTEGER;  {ordinal value of a key pressed}
  82.   BWBSC       : integer;  {bottom window boundary in screen coordinates}
  83.   BWBUC       : REAL;     {bottom window bound in user coordinates}
  84.   CHFLAG      : BOOLEAN;  {turns crosshair display on}
  85.   CHSENS      : INTEGER;  {crosshair movement sensitivity}
  86.   CHXUC,CHYUC : REAL;     {crosshair user coordinates}
  87.   CHXSC,CHYSC : INTEGER;  {crosshair screen coordinates}
  88.   DONEFLAG    : BOOLEAN;  {flag to bet out of program}
  89.   ELIPSFLAG   : BOOLEAN;  {flags circling of each point}
  90.   ERRCODE     : integer;  {error code}
  91.   FILTYPE,
  92.   FILDEGREE,
  93.   FILDERIV,
  94.   FILWIDTH    : INTEGER;  {filter parameters}
  95.   FIRST       : INTEGER;  {index of current first displayed point}
  96.   FRAME       : BOOLEAN;  {flags need to redraw frame}
  97.   GRAPHDRIVER : integer;  {graphics device ID number}
  98.   GRAPHMODE   : integer;  {mode for the graphics device}
  99.   HIXUC       : REAL;     {highest x user coordinate}
  100.   kbdbox      : viewporttype; {graphics window at bottom of screen}
  101.   LAST        : INTEGER;  {index of last point currently displayed}
  102.   LINEFLAG    : BOOLEAN;  {flags connecting of points with lines}
  103.   LINFLAG     : BOOLEAN;  {flag to indicate choice of movable line}
  104.   LINLEN      : INTEGER;  {length of line in number of pixels}
  105.   LINXSC,LINYSC: INTEGER; {line screen coordinates}
  106.   LINXUC,LINYUC: REAL;    {line user coordinates}
  107.   LOXUC       : REAL;     {lowest x value in user coordinates}
  108.   LWBIC       : INTEGER;  {lefg window boundary in index coordinates}
  109.   LWBSC       : integer;  {left window boundary in screen coordinates}
  110.   LWBUC       : REAL;     {left window boundary in user coordinate}
  111.   NEWMODE     : BOOLEAN;  {flags choice of a new display mode}
  112.   OLDBWBUC    : REAL;     {temporary bottom window bound in user coords}
  113.   OLDLWBUC    : REAL;     {temporary left window bound in user coords}
  114.   REDRAW      : BOOLEAN;  {flags need to redraw the screen plot}
  115.   RWBIC       : INTEGER;  {rigth window boundary in index coordinates}
  116.   RWBSC       : integer;  {right window boundary in screen coordinates}
  117.   RWBUC       : REAL;     {right window boundary in user coordinate}
  118.   SCANCODE    : INTEGER;  {extended code for a key pressed}
  119.   STEPSIZE    : INTEGER;  {size of increments between points}
  120.   THETA       : REAL;     {angle of live vs. horizontal (radians)}
  121.   TRACE       : BOOLEAN;  {flags crosshair trace mode}
  122.   TWBSC       : integer;  {top window boundary in screen coordinates}
  123.   TWBUC       : REAL;     {top window boundary in user coordinates}
  124.   titlebox    : viewporttype; {graphics window at top of screen}
  125.   WINDSENS    : INTEGER;  {window movement sensitivity}
  126.   XLABEL      : STR40;    {label for x axis}
  127.   YLABEL      : STR40;    {label for y axis}
  128.  
  129. {************************ Coordinate Transformations ********************}
  130. FUNCTION XCOORDSC(DATAPT:REAL):INTEGER; BEGIN
  131.   {Returns x value in screen coordinates corresponding to the user
  132.    value DATAPT by comparing it to the left and right window boundaries
  133.    in user coordinates.}
  134.   XCOORDSC:=ROUND((DATAPT-LWBUC)*((RWBSC-LWBSC)/(RWBUC-LWBUC))+LWBSC);
  135. END; {XCOORDSC}
  136.  
  137. FUNCTION XDATAVAL(INDEX:INTEGER):REAL;
  138.   {Returns x coordinate value in user specified units for a given index
  139.    with user specified slope and intercept incorporated.}
  140. BEGIN
  141.   IF (INDEX>=1) AND (INDEX<=NUMPTS) THEN XDATAVAL:=DATA[1,INDEX]
  142.   ELSE XDATAVAL:=(INDEX-1)*(DATA[1,NUMPTS]-DATA[1,1])/(NUMPTS-1)+DATA[1,1]
  143. END; {XDATAVAL}
  144.  
  145. FUNCTION YCOORDSC(DATAPT:REAL):INTEGER; BEGIN
  146.   {Returns y value in screen coordinates corresponding to the supplied
  147.    user coordinate of the current point by comparing it to the top and
  148.    bottom displayed user coordinates.}
  149.   YCOORDSC:=ROUND((DATAPT-BWBUC)*((TWBSC-BWBSC)/(TWBUC-BWBUC))+BWBSC);
  150. END; {YCOORDSC}
  151.  
  152. FUNCTION XCOORDUC(DATAPT:REAL):REAL; BEGIN
  153.   {Returns the x value in user coordinates corresponding to the supplied
  154.    screen coordinate of a point.}
  155.   XCOORDUC:=(DATAPT-LWBSC)*(RWBUC-LWBUC)/(RWBSC-LWBSC)+LWBUC;
  156.   END;
  157.  
  158. FUNCTION YCOORDUC(DATAPT:REAL):REAL; BEGIN
  159.   {Returns the y value in user coordinates corresponding to the suppied
  160.    screen coordinate of a point.}
  161.   YCOORDUC:=(DATAPT-BWBSC)*(TWBUC-BWBUC)/(TWBSC-BWBSC)+BWBUC;
  162.   END;
  163.  
  164. FUNCTION YDATAVAL(INDEX:INTEGER):REAL;
  165.   {Returns y coordinate value in specified units for a given index to
  166.    the data array.}
  167. VAR TEMPINDEX:INTEGER;
  168. BEGIN
  169.   IF INDEX>LAST THEN TEMPINDEX:=LAST
  170.   ELSE IF INDEX<FIRST THEN TEMPINDEX:=FIRST
  171.   ELSE TEMPINDEX:=INDEX;
  172.   IF TEMPINDEX<=1 THEN TEMPINDEX:=1;
  173.   IF TEMPINDEX>=NUMPTS THEN TEMPINDEX:=NUMPTS;
  174.   YDATAVAL:=DATA[2,TEMPINDEX];
  175. END; {YDATAVAL}
  176.  
  177. {********************* FUNCTION FILTER **********************************}
  178. FUNCTION filter(FILDERIV,INDEX:INTEGER):REAL;
  179.   {This function applies either a moving average or Savitzky-Golay polynomial
  180.    fit least squares filter to the data using the following parameters:
  181.      FILTYPE  : INTEGER  0=moving average, 1=Savitzy-Golay
  182.      FILDEGREE: INTEGER  Degree of polynomial fit (2,3,or 4)
  183.      FILDERIV : INTEGER  Derivative desired (0,1,or 2)
  184.      FILWIDTH : INTEGER  Width of filter in number of datapoints
  185.      INDEX    : INTEGER  Index to central data value in data array.}
  186. VAR YAVG : DOUBLE;
  187.     I,M  : INTEGER;
  188. BEGIN
  189.  YAVG:=0.0; M:=FILWIDTH DIV 2;
  190.  case FILTYPE of
  191.    0: BEGIN
  192.        for I:=(INDEX-M) to (INDEX+M) do YAVG:=YAVG+ydataval(I);
  193.        FILTER := YAVG/(2*M + 1);
  194.       END;
  195.    1: BEGIN
  196.        FILTER := YDATAVAL(I);
  197.       END;
  198.    END; {case}
  199. END; {filter}
  200. {************************** PROCEDURE SETCHY ******************************}
  201. PROCEDURE SETCHY;
  202.   {Sets crosshair y screen coordinate to a point on the displayed data.}
  203. VAR I,Y,MAXY:INTEGER; DONE:BOOLEAN;
  204. BEGIN
  205.   I:=0; MAXY:=GETMAXY-SCRBOTTOM; DONE:=FALSE;
  206.   REPEAT
  207.     Y:=CHYSC+I;
  208.     IF (Y<MAXY) AND (GETPIXEL(CHXSC,Y)<>0) THEN BEGIN
  209.       DONE:=TRUE; CHYSC:=Y
  210.       END
  211.     ELSE BEGIN
  212.       Y:=CHYSC-I;
  213.       IF (Y>SCRTOP) AND (GETPIXEL(CHXSC,Y)<>0) THEN BEGIN
  214.         DONE:=TRUE; CHYSC:=Y
  215.         END;
  216.       END;
  217.     I:=I+1;
  218.   UNTIL DONE OR (I=MAXY-SCRTOP+1);
  219. END;
  220.  
  221. {************************** PROCEDURE DRAWCH ******************************}
  222. PROCEDURE DRAWCH;
  223.   {Draws or erases the crosshair at the coordinates CHXSC and CHYSC and
  224.    lists or erases coordinates at the top of the screen.  The procedure
  225.    returns CHXUC and CHYUC.}
  226. CONST HEIGHT=21;
  227. VAR CHXLO,CHXHI,CHYLO,CHYHI,CHXLEN,CHYLEN : INTEGER;
  228.     ORXUC,ORYUC :REAL;
  229.     X,Y:STR20;
  230. BEGIN
  231.   CHXLEN:=ROUND((GETMAXX-SCRLEFT)/25);
  232.   CHYLEN:=ROUND((GETMAXY-SCRBOTTOM-SCRTOP)/20);
  233.   IF ((CHXSC-CHXLEN)<LWBSC) THEN CHXLO:=LWBSC ELSE CHXLO:=CHXSC-CHXLEN;
  234.   IF ((CHXSC+CHXLEN)>RWBSC) THEN CHXHI:=RWBSC ELSE CHXHI:=CHXSC+CHXLEN;
  235.   IF ((CHYSC-CHYLEN)<TWBSC) THEN CHYLO:=TWBSC ELSE CHYLO:=CHYSC-CHYLEN;
  236.   IF ((CHYSC+CHYLEN)>BWBSC) THEN CHYHI:=BWBSC ELSE CHYHI:=CHYSC+CHYLEN;
  237.   {update crosshair user coordinates}
  238.     CHXUC:=XCOORDUC(CHXSC); CHYUC:=YCOORDUC(CHYSC);
  239.   LINE(CHXLO,CHYSC,CHXHI,CHYSC); LINE(CHXSC,CHYLO,CHXSC,CHYHI);
  240.   IF CHFLAG THEN BEGIN {diplay coords at top}
  241.     CLRBOX(0,0,GETMAXX,HEIGHT,FALSE);
  242.     SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  243.     IF LINFLAG THEN BEGIN
  244.       STR((CHXUC-LINXUC):10:4,X); STR((CHYUC-LINYUC):10:4,Y);
  245.       OUTTEXTXY(3,4,CONCAT('Crosshair Relative Coordinates: ',
  246.                            X,',',Y));
  247.       STR(ABS(XCOORDUC(LINXSC+ROUND(LINLEN/2*COS(THETA)))-
  248.               XCOORDUC(LINXSC-ROUND(LINLEN/2*COS(THETA)))):10:4,X);
  249.       STR(ABS(YCOORDUC(LINYSC+ROUND(LINLEN/2*SIN(THETA)))-
  250.               YCOORDUC(LINYSC-ROUND(LINLEN/2*SIN(THETA)))):10:4,Y);
  251.       OUTTEXTXY(3,13,CONCAT('                   Line Length: ',X,',',Y));
  252.       END
  253.     ELSE BEGIN
  254.       STR(CHXUC:10:4,X); STR(CHYUC:10:4,Y);
  255.       OUTTEXTXY(3,4,CONCAT('Crosshair Absolute Coordinates: ',X,',',Y));
  256.       END
  257.     END
  258.   ELSE BEGIN {erase the top box}
  259.     SETVIEWPORT(0,0,GETMAXX,HEIGHT,CLIPON); CLEARVIEWPORT;
  260.     SETVIEWPORT(0,0,GETMAXX,GETMAXY,CLIPON);
  261.     END;
  262. END; {DRAWCH}
  263.  
  264. {************************* PROCEDURE DRAWLN ********************************}
  265. PROCEDURE DRAWLN;
  266.   {This procedure draws a translatable, rotatable lin on the screen for use
  267.    in conjunction with the crosshair in determining peak heights and widths.
  268.    The position is determined by LINXSC and LINYSC and the procedure returns
  269.    LINXUC and LINYUC.}
  270.  
  271.   PROCEDURE RANGE(VAR NUMBER:INTEGER; R1,R2:INTEGER);
  272.   VAR MAX,MIN:INTEGER;
  273.   BEGIN
  274.     IF R1>R2 THEN BEGIN MAX:=R1; MIN:=R2; END
  275.     ELSE BEGIN MAX:=R2; MIN:=R1; END;
  276.     IF NUMBER<MIN THEN NUMBER:=MIN ELSE IF NUMBER>MAX THEN NUMBER:=MAX;
  277.   END; {RANGE}
  278.  
  279.   PROCEDURE DOLINE(LINLEN:INTEGER; THETA:REAL);
  280.   VAR LX,LY,RX,RY: INTEGER;
  281.   BEGIN
  282.     LX:=LINXSC-ROUND(LINLEN/2*COS(THETA));
  283.     LY:=LINYSC-ROUND(LINLEN/2*SIN(THETA));
  284.     RX:=LINXSC+ROUND(LINLEN/2*COS(THETA));
  285.     RY:=LINYSC+ROUND(LINLEN/2*SIN(THETA));
  286.     RANGE(LX,LWBSC,RWBSC); RANGE(RX,LWBSC,RWBSC);
  287.     RANGE(LY,TWBSC,BWBSC); RANGE(RY,TWBSC,BWBSC);
  288.     LINE(LX,LY,RX,RY);
  289.   END; {DOLINE}
  290.  
  291. BEGIN
  292.   DOLINE(LINLEN,THETA); DOLINE(4,THETA+PI/2);
  293.   {update the line coordinates}
  294.     LINXUC:=XCOORDUC(LINXSC); LINYUC:=YCOORDUC(LINYSC);
  295.   IF CHFLAG THEN BEGIN {update the relative crosshair coords}
  296.     DRAWCH; DRAWCH;
  297.     END;
  298. END; {DRAWLN}
  299.  
  300. {************************* PROCEDURE INTEGRATE *****************************}
  301. PROCEDURE INTEGRATE;
  302. VAR
  303.     A               :DOUBLE;    {running total of areas}
  304.     ANS             :CHAR;
  305.     I               :INTEGER;   {data point index}
  306.     LASTY           :DOUBLE;    {last y value}
  307.     LX              :DOUBLE;    {screen coordinates of left end of ruler}
  308.     N               :INTEGER;   {number of points}
  309.     RX              :DOUBLE;    {screen coordinates of right end of ruler}
  310.     S               :DOUBLE;    {std deviation}
  311.     ST              :STRING[3]; {string for output message}
  312.     SUMY            :DOUBLE;    {sum of y}
  313.     SUMYY           :DOUBLE;    {sum of sqr(y)}
  314.     XSC             :DOUBLE;    {x screen coord}
  315.     Y               :DOUBLE;    {y value}
  316.     YSC             :DOUBLE;    {y screen coord}
  317. BEGIN
  318.   SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  319.   ANS:='A';
  320.   REPEAT
  321.     CLRBOX(0,0,GETMAXX,24,TRUE);
  322.     OUTTEXTXY(3,LINE1,'Integration procedure: ');
  323.     MOVETO(3,LINE2);
  324.     OUTTEXT(CONCAT('Absolute Y values or Relative to the ruler (A or R) [',
  325.                     ANS,']? '));
  326.     GRDCHAR(ANS);
  327.   UNTIL ANS IN ['A','a','r','R'];
  328.   IF ANS='a' THEN ANS:='A'; IF ANS='r' THEN ANS:='R';
  329.   CLRBOX(0,0,GETMAXX,24,TRUE);
  330.   OUTTEXTXY(3,LINE1,'Integration in progress...');
  331.   I:=FIRST; A:=0.0; LASTY:=0.0; N:=0; SUMY:=0.0; SUMYY:=0.0;
  332.   LX:=LINXSC-ROUND(LINLEN/2*COS(THETA));
  333.   RX:=LINXSC+ROUND(LINLEN/2*COS(THETA));
  334.   REPEAT
  335.     XSC:=XCOORDSC(DATA[1,I]);
  336.     IF (XSC<=RX) AND (XSC>=LX) THEN BEGIN
  337.       N:=N+1;
  338.       IF ANS='R' THEN
  339.         Y:=FILTER(FILDERIV,I)-YCOORDUC(LINYSC+(XSC-LINXSC)*TAN(THETA))
  340.       ELSE Y:=FILTER(FILDERIV,I);
  341.       IF LASTY<>0.0 THEN A:=A+(LASTY+Y)*(XDATAVAL(I)-XDATAVAL(I-1));
  342.       SUMY:=SUMY+Y; SUMYY:=SUMYY+SQR(Y);
  343.       LASTY:=Y;
  344.       END; {IF}
  345.     I:=I+1;
  346.   UNTIL I>LAST;
  347.   S:=SQRT( (SUMYY-SQR(SUMY)/N)/(N-1) );
  348.   IF ANS='R' THEN ST:='Rel' ELSE ST:='Abs';
  349.   CLRBOX(0,0,GETMAXX,24,TRUE);
  350.   OUTTEXTXY(3,LINE1,CONCAT(ST,' Int=',RLTOSTR(A/2,12),' over: ',
  351.             RLTOSTR(xcoorduc(lx),14),' to ',
  352.             RLTOSTR(xcoorduc(rx),14) ));
  353.   MOVETO(3,LINE2);
  354.   OUTTEXT(CONCAT(ST,' <Y>=',RLTOSTR(sumy/n,12),'(',CHAR(241),
  355.                  RLTOSTR(s*t(n-1)/sqrt(n),12),')      Std Dev =',
  356.                  RLTOSTR(s,12)));
  357. END; {PROCEDURE INTEGRATE}
  358.  
  359. {************************* PROCEDURE LIMITS ********************************}
  360. PROCEDURE LIMITS(LOXUC,HIXUC:REAL; VAR FIRST,LAST,LWBIC,RWBIC:INTEGER);
  361.   {This procedure calculates FIRST and LAST appropriate for the given user
  362.    coordinate window boundaries.  It also returns new values of LWBIC and
  363.    RWBIC.}
  364. VAR
  365.   X1,X2        : REAL;    {user coordinates of old first & last points}
  366.   LEFT         : BOOLEAN; {T=first on left, F=first on right}
  367.   F,L          : INTEGER; {temporary values of FIRST and LAST}
  368.   OVERF,OVERL  : BOOLEAN; {flag for window boundaries outside of data extents}
  369. BEGIN
  370.   OVERF:=FALSE; OVERL:=FALSE; X1:=XDATAVAL(FIRST); X2:=XDATAVAL(LAST);
  371.   LEFT:=(X2-X1)/(RWBUC-LWBUC)>0;
  372.   {calculate approximate values by linear interpolation}
  373.     IF LEFT THEN BEGIN
  374.       F:=FIRST + ROUND((LWBUC-X1)/(X2-X1)*(LAST-FIRST)) - 1;
  375.       L:=FIRST + ROUND((RWBUC-X1)/(X2-X1)*(LAST-FIRST)) + 1;
  376.       END
  377.     ELSE BEGIN
  378.       F:=FIRST + ROUND((RWBUC-X1)/(X2-X1)*(LAST-FIRST)) - 1;
  379.       L:=FIRST + ROUND((LWBUC-X1)/(X2-X1)*(LAST-FIRST)) + 1;
  380.       END;
  381.     IF F<1 THEN BEGIN FIRST:=1; OVERF:=TRUE; END;
  382.     IF F>NUMPTS THEN BEGIN FIRST:=NUMPTS; OVERF:=TRUE; END;
  383.     IF L>NUMPTS THEN BEGIN LAST:=NUMPTS;  OVERL:=TRUE; END;
  384.     IF L<1 THEN BEGIN LAST:=1;  OVERL:=TRUE; END;
  385.   {make sure values are not too far inside desired boundaries}
  386.     IF NOT(OVERF) THEN WHILE (XDATAVAL(F)<HIXUC) AND (XDATAVAL(F)>LOXUC)
  387.                              AND (L>F) AND (F>=2) DO F:=F-1;
  388.     IF NOT(OVERL) THEN WHILE (XDATAVAL(L)<HIXUC) AND (XDATAVAL(L)>LOXUC)
  389.                              AND (L>F) AND (L<=(NUMPTS-1)) DO L:=L+1;
  390.    {now choose points just inside desired limits}
  391.     IF NOT(OVERF) THEN BEGIN
  392.       WHILE NOT((XDATAVAL(F)<=HIXUC)AND(XDATAVAL(F)>=LOXUC))AND(L>F) DO F:=F+1;
  393.       FIRST:=F;
  394.       IF LEFT THEN LWBIC:=F ELSE RWBIC:=F;
  395.       END;
  396.     IF NOT(OVERL) THEN BEGIN
  397.       WHILE NOT((XDATAVAL(L)<=HIXUC)AND(XDATAVAL(L)>=LOXUC))AND(L>F) DO L:=L-1;
  398.       LAST:=L;
  399.       IF LEFT THEN RWBIC:=L ELSE LWBIC:=L;
  400.       END;
  401.     IF LEFT THEN BEGIN LWBIC:=F; RWBIC:=L; END
  402.     ELSE BEGIN LWBIC:=L; RWBIC:=F END;
  403. END; {PROCEDURE LIMITS}
  404.  
  405. {*********************** PROCEDURE LABELS **********************************}
  406. PROCEDURE LABELS;
  407.   {This procedure writes out the information at the bottom of the plot.}
  408. VAR S:STR30; ST:STR80;
  409.  
  410.   FUNCTION RLTOST(RL:REAL):STR20;
  411.   VAR S:STR20;
  412.   BEGIN STR(RL:6:3,S); RLTOST:=S; END;
  413.  
  414. BEGIN
  415.   CLRBOX(0,GETMAXY-24,GETMAXX,GETMAXY,TRUE);
  416.   SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  417.   STR(STEPSIZE,S); ST:=CONCAT('File: ',FILENAME,'  Stepsize:',S);
  418.   IF FILWIDTH<>1 THEN BEGIN
  419.     ST:=CONCAT(ST,'    Filter:');  STR(FILWIDTH,S);
  420.     CASE FILTYPE OF
  421.       0: ST:=CONCAT(ST,'MA  Width:',S);
  422.       1: BEGIN
  423.            ST:=CONCAT(ST,'SG  Width:',S);
  424.            STR(FILDEGREE,S); ST:=CONCAT(ST,'  Degree:',S);
  425.            IF FILDERIV<>0 THEN BEGIN
  426.              STR(FILDERIV,S); ST:=CONCAT(ST,'  Derivative:',S);
  427.              END;
  428.          END; {1}
  429.     END; {CASE}
  430.     END; {IF}
  431.   OUTTEXTXY(3,GETMAXY-21,ST);
  432.   ST:=CONCAT('L:',RLTOST(LWBUC),' R:',RLTOST(RWBUC),' B:',RLTOST(BWBUC),
  433.              ' T:',RLTOST(TWBUC));
  434.   IF TRACE THEN ST:=CONCAT(ST,'      (x-hair trace mode)');
  435.   OUTTEXTXY(3,GETMAXY-11,ST);
  436. END; {PROCEDURE LABELS}
  437.  
  438. {************************ DUMP_TEXT **************************************}
  439. PROCEDURE DUMP_TEXT;
  440. VAR DUMPNAME         :STR20;
  441.     LINE1,LINE2,ERR,I:INTEGER;
  442.     ANS,C            :CHAR;
  443.     OUTFILE          :TEXT;
  444. BEGIN
  445.   LINE1:=GETMAXY-21; LINE2:=GETMAXY-11; DUMPNAME:='QUIT';
  446.   SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  447.   REPEAT
  448.     CLRBOX(0,GETMAXY-24,GETMAXX,GETMAXY,TRUE); ANS:='Y';
  449.     OUTTEXTXY(3,LINE1,CONCAT('This procedure dumps the displayed data ',
  450.                              'to a text file.'));
  451.     MOVETO(3,LINE2);
  452.     OUTTEXT(CONCAT('Name of the file (QUIT if none) [',DUMPNAME,']: '));
  453.     GRDSTR20(DUMPNAME);
  454.     FOR I:=1 TO LENGTH(DUMPNAME) DO DUMPNAME[I]:=UPCASE(DUMPNAME[I]);
  455.     CLRBOX(0,GETMAXY-24,GETMAXX,GETMAXY,TRUE);
  456.     IF EXISTS(DUMPNAME) AND (DUMPNAME <> 'QUIT') THEN BEGIN
  457.       OUTTEXTXY(3,LINE1,CONCAT('File ',DUMPNAME,' already exists.'));
  458.       REPEAT
  459.         MOVETO(3,LINE2);
  460.         OUTTEXT(CONCAT('Overwrite the existing file (Y or N) [',
  461.                        ANS,']: '));
  462.         GRDCHAR(ANS); CLRBOX(0,GETMAXY-24,GETMAXX,GETMAXY,TRUE);
  463.       UNTIL ANS IN ['Y','N'];
  464.       END; {IF}
  465.     IF (DUMPNAME<>'QUIT') AND (ANS='Y') THEN BEGIN
  466.       ASSIGN(OUTFILE,DUMPNAME); REWRITE(OUTFILE); ERR:=IORESULT;
  467.       IF ERR<>0 THEN BEGIN
  468.         OUTTEXTXY(3,LINE1,CONCAT('IO error ',INTTOSTR(ERR)));
  469.         OUTTEXTXY(3,LINE2,'Hit any key to continue.');
  470.         REPEAT UNTIL KEYPRESSED; C:=READKEY;
  471.         IF C=#0 THEN C:=READKEY;
  472.         END {IF}
  473.       ELSE BEGIN
  474.         OUTTEXTXY(3,LINE1,CONCAT('Data is being written to file ',
  475.                                  DUMPNAME,'.'));
  476.         I:=FIRST;
  477.         REPEAT
  478.           WRITELN(OUTFILE,XDATAVAL(I),' ',FILTER(FILDERIV,I));
  479.           I:=I+STEPSIZE;
  480.         UNTIL (I>LAST);
  481.         END; {ELSE}
  482.       CLOSE(OUTFILE);
  483.       END; {IF}
  484.   UNTIL ANS='Y';
  485. END;
  486.  
  487. {**************************** SCRNDRAW *********************************}
  488. PROCEDURE SCRNDRAW(ELIPSFLAG:BOOLEAN; STEPSIZE:INTEGER);
  489.   {This procedure plots the data or a function on the screen.}
  490. VAR I,XSC,YSC,START  :INTEGER;
  491.     X          :DOUBLE;
  492.     INRANGE    :BOOLEAN;
  493. BEGIN
  494.   SETWRITEMODE(COPYPUT); {overlap with existing stuff}
  495.   START:=FIRST; I:=FIRST;
  496.   REPEAT
  497.     X:=XDATAVAL(I); XSC:=XCOORDSC(X); YSC:=YCOORDSC(FILTER(FILDERIV,I));
  498.     IF (XSC>SCRLEFT)AND(XSC<GETMAXX)AND(YSC>SCRTOP)AND
  499.        (YSC<(GETMAXY-SCRBOTTOM)) THEN INRANGE:=TRUE
  500.     ELSE BEGIN INRANGE:=FALSE; START:=I+1; END;
  501.     IF (I=START) OR NOT(INRANGE) THEN MOVETO(XSC,YSC);
  502.     IF INRANGE THEN BEGIN
  503.       IF (I<>START) AND LINEFLAG THEN LINETO(XSC,YSC);
  504.       IF ELIPSFLAG THEN CIRCLE(XSC,YSC,1);
  505.       END;
  506.     I:=I+STEPSIZE;
  507.   UNTIL I>LAST;
  508.   SETWRITEMODE(XORPUT); {erase if overlap}
  509. END; {SCRNDRAW}
  510.  
  511. {************************ PROCEDURE CHANGEFILTER ***********************}
  512. PROCEDURE CHANGEFILTER;
  513. BEGIN
  514.   SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  515.   CLRBOX(0,0,GETMAXX,24,TRUE);
  516.   MOVETO(3,LINE1);
  517.   OUTTEXT(CONCAT('Size of steps between displayed data points [',
  518.           INTTOSTR(STEPSIZE),']: ')); GRDINT(STEPSIZE);
  519.   REPEAT
  520.     MOVETO(3,LINE2);
  521.     OUTTEXT(CONCAT('Type of filter: 0-Moving Avg, 1-Savitzky Golay [',
  522.             INTTOSTR(FILTYPE),']: '));  GRDINT(FILTYPE);
  523.     CLRBOX(0,0,GETMAXX,24,TRUE);
  524.   UNTIL FILTYPE=0;
  525.   MOVETO(3,LINE1);
  526.   OUTTEXT(CONCAT('Width of filter [',inttostr(filwidth),']: '));
  527.   GRDINT(FILWIDTH);
  528.   REDRAW:=TRUE;
  529. END;
  530.  
  531. {************************ PROCEDURE TRANSX ***************************}
  532. PROCEDURE TRANSX;
  533. VAR
  534.   ANS               : CHAR;
  535.   I                 : INTEGER;
  536.   SLOPE,INT         : REAL;
  537.   OLDSLOPE,OLDINT   : REAL;
  538. BEGIN
  539.   SLOPE:=1; INT:=0; ANS:='N';
  540.   SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  541.   REPEAT
  542.     CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1);
  543.     OUTTEXT(CONCAT('Linear transform of x axis (Y or N) [',ans,']? '));
  544.       GRDCHAR(ANS);
  545.   UNTIL ANS IN ['Y','y', 'N','n'];
  546.   IF ANS IN ['Y','y'] THEN BEGIN
  547.     REPEAT
  548.       OLDSLOPE:=SLOPE; OLDINT:=INT;
  549.       CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1);
  550.       OUTTEXT(CONCAT('Slope [',RLTOSTR(slope,15),']: ')); GRDREAL(SLOPE);
  551.       MOVETO(3,LINE2);
  552.       OUTTEXT(CONCAT('Intercept [',RLTOSTR(INT,15),']: ')); GRDREAL(INT);
  553.     UNTIL ((OLDSLOPE=SLOPE) AND (INT=OLDINT));
  554.     IF ((SLOPE<>1) OR (INT<>0)) THEN BEGIN
  555.       FOR I:=1 TO NUMPTS DO DATA[1,I]:=SLOPE*DATA[1,I]+INT;
  556.       MINX:=SLOPE*MINX+INT; MAXX:=SLOPE*MAXX+INT;
  557.       IF CHFLAG THEN BEGIN
  558.         CHXUC:=SLOPE*CHXUC+INT; CHXSC:=XCOORDSC(CHXUC);
  559.         END;
  560.       IF LINFLAG THEN BEGIN
  561.         LINXUC:=SLOPE*CHXUC+INT; LINXSC:=XCOORDSC(LINXUC);
  562.         END;
  563.       END; {IF}
  564.     END; {IF}
  565. END; {PROCEDURE TRANSX}
  566.  
  567. {************************ PROCEDURE TRANSY ***************************}
  568. PROCEDURE TRANSY;
  569. VAR
  570.   ANS               : CHAR;
  571.   I                 : INTEGER;
  572.   SLOPE,INT         : REAL;
  573.   OLDSLOPE,OLDINT   : REAL;
  574. BEGIN
  575.   SLOPE:=1; INT:=0; ANS:='N';
  576.   SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  577.   REPEAT
  578.     CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1);
  579.     OUTTEXT(CONCAT('Linear transform of y axis (Y or N) [',ans,']? '));
  580.       GRDCHAR(ANS);
  581.   UNTIL ANS IN ['Y','y', 'N','n'];
  582.   IF ANS IN ['Y','y'] THEN BEGIN
  583.     REPEAT
  584.       OLDSLOPE:=SLOPE; OLDINT:=INT;
  585.       CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1);
  586.       OUTTEXT(CONCAT('Slope [',RLTOSTR(slope,15),']: ')); GRDREAL(SLOPE);
  587.       MOVETO(3,LINE2);
  588.       OUTTEXT(CONCAT('Intercept [',RLTOSTR(INT,15),']: ')); GRDREAL(INT);
  589.     UNTIL ((OLDSLOPE=SLOPE) AND (INT=OLDINT));
  590.     IF ((SLOPE<>1) OR (INT<>0)) THEN BEGIN
  591.       FOR I:=1 TO NUMPTS DO DATA[2,I]:=SLOPE*DATA[2,I]+INT;
  592.       TWBUC:=TWBUC*SLOPE+INT; BWBUC:=BWBUC*SLOPE+INT;
  593.       LOY:=SLOPE*LOY+INT;     HIY:=SLOPE*HIY+INT;
  594.       IF CHFLAG THEN BEGIN
  595.         CHYUC:=SLOPE*CHYUC+INT; CHYSC:=YCOORDSC(CHYUC);
  596.         END;
  597.       IF LINFLAG THEN BEGIN
  598.         LINYUC:=SLOPE*LINYUC+INT; LINYSC:=YCOORDSC(LINYUC);
  599.         END;
  600.       END; {IF}
  601.     END; {IF}
  602. END; {PROCEDURE TRANSY}
  603.  
  604. {************************ PROCEDURE CONV *****************************}
  605. PROCEDURE CONV(ANG:BOOLEAN);
  606. VAR  ANS:CHAR;  I:INTEGER;
  607. BEGIN
  608.   ANS:='N';
  609.   SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  610.   REPEAT
  611.     CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1);
  612.     IF ANG THEN
  613.       OUTTEXT(CONCAT('Angstrom to cm-1 conversion (Y or N) [',ans,']? '))
  614.     ELSE OUTTEXT(CONCAT('cm-1 to Angstrom conversion (Y or N) [',ans,']? '));
  615.     GRDCHAR(ANS);
  616.   UNTIL ANS IN ['Y','y', 'N','n'];
  617.   IF ANS IN ['Y','y'] THEN BEGIN
  618.     IF ANG THEN BEGIN {Angstroms to cm-1}
  619.       FOR I:=1 TO NUMPTS DO DATA[1,I]:=A_TO_CM(DATA[1,I]);
  620.       XLABEL:='cm-1';
  621.       IF CHFLAG THEN BEGIN
  622.         CHXUC:=A_TO_CM(CHXUC); CHXSC:=XCOORDSC(CHXUC);
  623.         END;
  624.       IF LINFLAG THEN BEGIN
  625.         LINXUC:=A_TO_CM(LINXUC); LINXSC:=XCOORDSC(LINXUC);
  626.         END;
  627.       MINX:=A_TO_CM(MINX); MAXX:=A_TO_CM(MAXX);
  628.       END
  629.     ELSE BEGIN {cm-1 to Angstroms}
  630.       FOR I:=1 TO NUMPTS DO DATA[1,I]:=CM_TO_A(DATA[1,I]);
  631.       XLABEL:='Angstroms';
  632.       IF CHFLAG THEN BEGIN
  633.         CHXUC:=CM_TO_A(CHXUC); CHXSC:=XCOORDSC(CHXUC);
  634.         END;
  635.       IF LINFLAG THEN BEGIN
  636.         LINXUC:=CM_TO_A(LINXUC); LINXSC:=XCOORDSC(LINXUC);
  637.         END;
  638.       MINX:=CM_TO_A(MINX); MAXX:=CM_TO_A(MAXX);
  639.       END; {ELSE}
  640.     END; {IF}
  641. END;
  642.  
  643. {************************ PROCEDURE CHNG_LABELS **********************}
  644. PROCEDURE CHNG_LABELS;
  645. BEGIN
  646.   SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  647.   CLRBOX(0,0,GETMAXX,24,TRUE);
  648.   MOVETO(3,LINE1); OUTTEXT(CONCAT('X axis label [',XLABEL,']? '));
  649.     GRDSTR40(XLABEL);
  650.   MOVETO(3,LINE2); OUTTEXT(CONCAT('Y axis label [',YLABEL,']? '));
  651.     GRDSTR40(YLABEL);
  652. END;
  653.  
  654. {************************ PROCEDURE SETLIM ***************************}
  655. PROCEDURE SETLIM; {Manual setting of window limits.}
  656. BEGIN
  657.   SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  658.   CLRBOX(0,0,GETMAXX,24,TRUE);
  659.   MOVETO(3,LINE1); OUTTEXT(CONCAT('Left [',RLTOSTR(LWBUC,15),']? '));
  660.     GRDREAL(LWBUC);
  661.   MOVETO(3,LINE2); OUTTEXT(CONCAT('Right [',RLTOSTR(RWBUC,15),']? '));
  662.     GRDREAL(RWBUC);
  663.   CLRBOX(0,0,GETMAXX,24,TRUE);
  664.   MOVETO(3,LINE1); OUTTEXT(CONCAT('Bottom [',RLTOSTR(BWBUC,15),']? '));
  665.     GRDREAL(BWBUC);
  666.   MOVETO(3,LINE2); OUTTEXT(CONCAT('Top [',RLTOSTR(TWBUC,15),']? '));
  667.     GRDREAL(TWBUC);
  668.   REDRAW:=TRUE;
  669. END;
  670.  
  671. {************************ PROCEDURE ZOOMOUT **************************}
  672. PROCEDURE ZOOMOUT;
  673. VAR AMOUNT:REAL;
  674. BEGIN
  675.   SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  676.   CLRBOX(0,0,GETMAXX,24,TRUE);
  677.   AMOUNT:=ABS(RWBUC-LWBUC)/2;  MOVETO(3,LINE1);
  678.   OUTTEXT('Expand window horizontally by how many');
  679.   MOVETO(3,LINE2);
  680.   OUTTEXT(CONCAT('units on each side [',RLTOSTR(AMOUNT,15),']? '));
  681.     GRDREAL(AMOUNT);
  682.   IF RWBUC>LWBUC THEN AMOUNT:=ABS(AMOUNT) ELSE AMOUNT:=-ABS(AMOUNT);
  683.   LWBUC:=LWBUC-AMOUNT; RWBUC:=RWBUC+AMOUNT;
  684.   REDRAW:=TRUE;
  685. END;
  686.  
  687. {*********************** PROCEDURE PAN ******************************}
  688. PROCEDURE PAN(S:STR20);
  689. VAR AMOUNT:REAL;
  690. BEGIN
  691.   SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  692.   CLRBOX(0,0,GETMAXX,24,TRUE);
  693.   AMOUNT:=ABS(RWBUC-LWBUC)/2;  MOVETO(3,LINE1);
  694.   OUTTEXT(CONCAT('Pan ',S,' how many units [',RLTOSTR(AMOUNT,15),']? '));
  695.     GRDREAL(AMOUNT);
  696.   AMOUNT:=ABS(AMOUNT);
  697.   IF (RWBUC>LWBUC) AND (S='left') THEN AMOUNT:=-AMOUNT;
  698.   IF (RWBUC<LWBUC) AND (S='right') THEN AMOUNT:=-AMOUNT;
  699.   LWBUC:=LWBUC+AMOUNT; RWBUC:=RWBUC+AMOUNT;
  700.   REDRAW:=TRUE;
  701. END;
  702.  
  703. {************************ PROCEDURE POST *****************************}
  704. PROCEDURE POST;
  705. VAR  ANS               :CHAR;
  706.      I,J,ERR,MAXX,MAXY :INTEGER;
  707.      DUMPNAME          :STR20;
  708.      OUTFILE           :TEXT;
  709.      INDEX,VALUE       :BYTE;
  710. BEGIN
  711.   ANS:='N'; MAXX:=GETMAXX; MAXY:=GETMAXY;
  712.   DUMPNAME:=FILENAME; I:=POS('.',FILENAME);
  713.   IF I<>0 THEN DELETE(DUMPNAME,I,LENGTH(DUMPNAME)-I+1);
  714.   DUMPNAME:=CONCAT(DUMPNAME,'.EPS');
  715.   SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  716.   REPEAT
  717.     CLRBOX(0,0,MAXX,24,TRUE); MOVETO(3,LINE1);
  718.     OUTTEXT(CONCAT('Postscript screen dump (Y or N) [',ans,']? '));
  719.     GRDCHAR(ANS);
  720.   UNTIL ANS IN ['Y','y', 'N','n'];
  721.   IF ANS IN ['Y','y'] THEN BEGIN
  722.     MOVETO(3,LINE2);
  723.     OUTTEXT(CONCAT('Name of the file (QUIT to abort) [',DUMPNAME,']: '));
  724.     GRDSTR20(DUMPNAME);
  725.     FOR I:=1 TO LENGTH(DUMPNAME) DO DUMPNAME[I]:=UPCASE(DUMPNAME[I]);
  726.     CLRBOX(0,0,MAXX,24,TRUE);
  727.     IF EXISTS(DUMPNAME) AND (DUMPNAME <> 'QUIT') THEN BEGIN
  728.       OUTTEXTXY(3,LINE1,CONCAT('File ',DUMPNAME,' already exists.'));
  729.       REPEAT
  730.         MOVETO(3,LINE2);
  731.         OUTTEXT(CONCAT('Overwrite the existing file (Y or N) [',ANS,']: '));
  732.         GRDCHAR(ANS); CLRBOX(0,0,MAXX,24,TRUE);
  733.       UNTIL ANS IN ['Y','y','N','n'];
  734.       END; {IF}
  735.     IF (DUMPNAME='QUIT') THEN ANS:='N';
  736.     END; {IF}
  737.   CLRBOX(0,0,MAXX,24,FALSE);
  738.   IF ANS IN ['Y','y'] THEN BEGIN
  739.     ASSIGN(OUTFILE,DUMPNAME); REWRITE(OUTFILE); ERR:=IORESULT;
  740.     IF ERR<>0 THEN BEGIN
  741.       CLRBOX(0,0,MAXX,24,TRUE);
  742.       OUTTEXTXY(3,LINE1,CONCAT('IO error ',INTTOSTR(ERR)));
  743.       OUTTEXTXY(3,LINE2,'Hit any key to continue.');
  744.       REPEAT UNTIL KEYPRESSED; ANS:=READKEY;
  745.       IF ANS=#0 THEN ANS:=READKEY;
  746.       END
  747.     ELSE BEGIN
  748.       IF CHFLAG THEN BEGIN DRAWCH; DRAWCH; END;
  749.       IF LINFLAG THEN BEGIN DRAWLN; DRAWLN; END;
  750.       WRITELN(OUTFILE,'%!PS-ADOBE-2.0');
  751.       WRITELN(OUTFILE,'gsave');
  752.       WRITELN(OUTFILE,'/picstr 1 string def');
  753.       WRITELN(OUTFILE,'27 756 moveto');
  754.       WRITELN(OUTFILE,ROUND(7.5*72),' ',ROUND((MAXY+1)/(MAXX+1)*7.5*72),
  755.                       ' scale');
  756.       WRITELN(OUTFILE,'0 -1 rmoveto');
  757.       WRITELN(OUTFILE,'currentpoint translate');
  758.       WRITELN(OUTFILE,MAXX+1,' ',MAXY+1,' 1');
  759.       WRITELN(OUTFILE,'[',MAXX+1,' 0 0 ',-MAXY-1,' 0 ',MAXY+1,']');
  760.       WRITELN(OUTFILE,'{ currentfile picstr readhexstring pop }');
  761.       WRITELN(OUTFILE,'image');
  762.       INDEX:=8; VALUE:=0;
  763.       FOR J:=0 TO MAXY DO FOR I:=0 TO MAXX DO BEGIN
  764.         IF (J=LINE2+20) AND (I=0) THEN BEGIN
  765.           CLRBOX(0,0,MAXX,24,TRUE);
  766.           OUTTEXTXY(3,LINE1,CONCAT('Data is being written to file ',
  767.                                     DUMPNAME,'.'));
  768.           END;
  769.         INDEX:=INDEX-1;
  770.         IF GETPIXEL(I,J)<>0 THEN VALUE:=VALUE OR (1 SHL INDEX);
  771.         IF INDEX=0 THEN BEGIN
  772.           WRITE(OUTFILE,HEX(NOT VALUE)); INDEX:=8; VALUE:=0;
  773.           END;
  774.         END; {FOR}
  775.       IF INDEX<>8 THEN WRITE(OUTFILE,HEX(NOT VALUE));
  776.       WRITELN(OUTFILE); WRITELN(OUTFILE,'grestore showpage');
  777.       BEEP(200);
  778.       END; {ELSE}
  779.     CLOSE(OUTFILE);
  780.     END; {IF}
  781.   CLRBOX(0,0,MAXX,24,FALSE);
  782.   IF CHFLAG THEN BEGIN DRAWCH; DRAWCH; END;
  783.   IF LINFLAG THEN BEGIN DRAWLN; DRAWLN; END; {crosshair must be drawn first}
  784. END;
  785.  
  786. {************************ PROCEDURE MINMAX *******************************}
  787. PROCEDURE MINMAX; {Displays min and max x and y values for displayed data.}
  788. VAR I                   :INTEGER;
  789.     X,Y                 :REAL;
  790.     XMIN,XMAX,YMIN,YMAX :REAL;
  791.     START               :BOOLEAN;
  792.     CH                  :CHAR;
  793. BEGIN
  794.   I:=FIRST; START:=TRUE;
  795.   REPEAT
  796.     X:=XDATAVAL(I); Y:=FILTER(FILDERIV,I);
  797.     IF (XCOORDSC(X)>SCRLEFT)AND(XCOORDSC(X)<GETMAXX) THEN
  798.       IF START THEN BEGIN
  799.         XMIN:=X; XMAX:=X; YMIN:=Y; YMAX:=Y; START:=FALSE;
  800.         END
  801.       ELSE BEGIN
  802.         IF X>XMAX THEN XMAX:=X; IF X<XMIN THEN XMIN:=X;
  803.         IF Y>YMAX THEN YMAX:=Y; IF Y<YMIN THEN YMIN:=Y;
  804.         END;
  805.     I:=I+STEPSIZE;
  806.   UNTIL I>LAST;
  807.   SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1);
  808.   CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1);
  809.   OUTTEXT(CONCAT('x: Min=',RLTOSTR(XMIN,15),'   Max=',RLTOSTR(XMAX,15)));
  810.   MOVETO(3,LINE2);
  811.   OUTTEXT(CONCAT('y: Min=',RLTOSTR(YMIN,15),'   Max=',RLTOSTR(YMAX,15),
  812.                  '        <ENTER> to continue'));
  813.   REPEAT CH:=READKEY UNTIL CH=CHAR(13);
  814.   CLRBOX(0,0,GETMAXX,24,FALSE); MOVETO(3,LINE1);
  815.   IF CHFLAG THEN BEGIN DRAWCH; DRAWCH; END;
  816.   IF LINFLAG THEN BEGIN DRAWLN; DRAWLN; END; {crosshair must be drawn first}
  817. END; {PROCEDURE MINMAX}
  818.  
  819. {************************** NONLINEAR ***********************************}
  820. PROCEDURE NONLINEAR(XY:CHAR);
  821. VAR ANS,I,WHICH : INTEGER;
  822.     MAX,MIN,VAL : REAL;
  823.   FUNCTION CONVERT(X:SINGLE):SINGLE;
  824.   CONST XMIN=2.9E-39*100; XMAX=1.7E38/100;
  825.   BEGIN
  826.     CASE ANS OF
  827.       1: IF X<SQRT(XMAX) THEN CONVERT:=SQR(X) ELSE CONVERT:=XMAX;
  828.       2: IF ABS(X)>SQR(XMIN) THEN CONVERT:=SQRT(ABS(X)) ELSE CONVERT:=XMIN;
  829.       3: IF ABS(X)>0 THEN CONVERT:=LN(ABS(X))  ELSE CONVERT:=-XMAX;
  830.       4: IF ABS(X)>0 THEN CONVERT:=LOG(ABS(X)) ELSE CONVERT:=-XMAX;
  831.       5: IF ABS(X)<LN(XMAX) THEN CONVERT:=EXP(X)
  832.          ELSE IF X>0 THEN CONVERT:=XMAX
  833.          ELSE IF X<0 THEN CONVERT:=0;
  834.       6: IF ABS(X)<LOG(XMAX) THEN CONVERT:=EXP(X*LN(10))
  835.          ELSE IF X>0 THEN CONVERT:=XMAX
  836.          ELSE IF X<0 THEN CONVERT:=0;
  837.       ELSE CONVERT:=X;
  838.       END; {case}
  839.     END; {FUNCTION CONVERT}
  840. BEGIN
  841.   RESTORECRTMODE;
  842.   ANS:=0; WHICH:=ORD(XY='Y')+1;
  843.   WRITELN('Nonlinear transformation of ',xy,' axis.'); WRITELN;
  844.   WRITELN('The following transformations are available.');
  845.   WRITELN('  0. None.');
  846.   WRITELN('  1. Sqr(',xy,').');
  847.   WRITELN('  2. Sqrt(|',XY,'|).');
  848.   WRITELN('  3. Ln(|',XY,'|).');
  849.   WRITELN('  4. Log(|',XY,'|).');
  850.   WRITELN('  5. Exp(',XY,').');
  851.   WRITELN('  6. 10^(',XY,').');
  852.   WRITE('Select one [',ans,']: '); RDINTLN(OUTPUT,ANS);
  853.   IF ANS IN [1..6] THEN BEGIN
  854.     MAX:=CONVERT(DATA[WHICH,1]); MIN:=MAX;
  855.     FOR I:=1 TO NUMPTS DO BEGIN
  856.       VAL:=CONVERT(DATA[WHICH,I]);
  857.       IF VAL<MIN THEN MIN:=VAL; IF VAL>MAX THEN MAX:=VAL;
  858.       DATA[WHICH,I]:=VAL;
  859.       END; {FOR}
  860.     MAX:=MAX+ABS(MAX-MIN)/40; MIN:=MIN-ABS(MAX-MIN)/40;
  861.     IF XY='X' THEN BEGIN
  862.       RWBUC:=MAX; LWBUC:=MIN; MINX:=MIN;  MAXX:=MAX;
  863.       END
  864.     ELSE BEGIN
  865.       TWBUC:=MAX; BWBUC:=MIN; LOY:=MIN; HIY:=MAX;
  866.       END;
  867.     IF CHFLAG THEN
  868.       IF XY='X' THEN CHXUC:=CONVERT(CHXUC)
  869.       ELSE CHYUC:=CONVERT(CHYUC);
  870.     IF LINFLAG THEN
  871.       IF XY='X' THEN LINXUC:=CONVERT(LINXUC)
  872.       ELSE LINYUC:=CONVERT(LINYUC);
  873.     NEWMODE:=TRUE;
  874.     END; {IF ANS}
  875.   SETGRAPHMODE(GETGRAPHMODE);
  876.   REDRAW:=TRUE;
  877. END; {PROCEDURE NONLINEAR}
  878.  
  879. {************************ PROCEDURE HELP *****************************}
  880. PROCEDURE HELP; {Provides display of key assignments.}
  881. VAR UD,LR:STRING[3];
  882. BEGIN
  883.   RESTORECRTMODE;
  884.   LR:=CONCAT(CHAR(26),'/',CHAR(27)); UD:=CONCAT(CHAR(24),'/',CHAR(25));
  885.   WRITELN('             F1: Crosshair               CTRL F1: Ruler');
  886.   WRITELN('             F2: Circle points           CTRL F2: Connect-the-dots');
  887.   WRITELN('             F3: Filter parameters       CTRL F3: Integrate');
  888.   WRITELN('             F4: Crosshair trace         CTRL F4: Labels');
  889.   WRITELN('             F5: Dump to file            CTRL F5: Postscript screen dump');
  890.   WRITELN('             F6: X linear transform      CTRL F6: Y linear transform');
  891.   WRITELN('             F7: Left/right invert       CTRL F7: Top/bottom inversion');
  892.   WRITELN('             F8: Angstrom to cm-1        CTRL F8: cm-1 to Angstroms');
  893.   WRITELN('              N: X nonlinear transform     ALT N: Y nonlinear transform');
  894.   WRITELN('              M: Min/max');
  895.   WRITELN('              D: DOS command                   H: Help');
  896.   WRITELN('WINDOW CONTROL:');
  897.   WRITELN('    PG UP/PG DN: Faster/slower               ',UD,': Expand/contract');
  898.   WRITELN('            ',LR,': Horizontal             HOME/END: Vertical');
  899.   WRITELN('                 expand/contract                  expand/contract');
  900.   WRITELN('       CTRL ',LR,': Left/right             CTRL ',UD,': Up/down');
  901.   WRITELN('  ENTER/+/SPACE: Zoom                 CTRL ENTER: Original plot');
  902.   WRITELN('              L: Limits                        X: Expand horizontally');
  903.   WRITELN('             F9: Pan left                    F10: Pan right');
  904.   WRITELN('CROSSHAIR CONTROL:');
  905.   WRITELN('  7/8: faster/slower    9/0: up/down         -/=: left/right');
  906.   WRITELN('RULER CONTROL:');
  907.   WRITELN('  3/4: up/down          5/6: Left/right      Q/W: Shorter/longer');
  908.   WRITELN('  1/2: rotate             E: FWHM position     R: Horizontal/vertical');
  909.   WRITE('                    <ENTER> to continue.'); READLN;
  910.   SETGRAPHMODE(GETGRAPHMODE);
  911.   REDRAW:=TRUE;
  912. END;
  913.  
  914. {************************** MAIN PROGRAM *****************************}
  915. BEGIN
  916.  
  917. {Set up the graphics window.}
  918.   CLRSCR;          {clear the screen}
  919.   GRAPHDRIVER:=0;  {autodetect graphics device}
  920.   INITGRAPH(GRAPHDRIVER,GRAPHMODE,DRIVERS); ERRCODE:=GRAPHRESULT;
  921.   IF ERRCODE<>0 THEN BEGIN
  922.     BEEP(200);
  923.     WRITELN('Graphics error: ',grapherrormsg(errcode));
  924.     WRITE('Hit any key to continue. '); READLN;
  925.     END;
  926.  
  927. IF ERRCODE=0 THEN BEGIN
  928.   {Initialize}
  929.     FIRST:=1; LAST:=NUMPTS;
  930.     BWBUC:=LOY; TWBUC:=HIY; LWBUC:=MINX; RWBUC:=MAXX;
  931.     LWBIC:=1; RWBIC:=NUMPTS;
  932.     XLABEL:='X'; YLABEL:='Y';
  933.     NEWMODE:=FALSE; DONEFLAG:=FALSE; ELIPSFLAG:=FALSE; FRAME:=FALSE;
  934.     LINEFLAG:=TRUE; WINDSENS:=20;    LINFLAG:=FALSE;
  935.     CHFLAG:=FALSE;  CHSENS:=20;      TRACE:=FALSE;
  936.     FILTYPE:=0;     FILDEGREE:=2;    FILWIDTH:=1;      FILDERIV:=0;
  937.     STEPSIZE:=1;
  938.   {initialize crosshair and line to center of window}
  939.     CHXSC:=ROUND((SCRLEFT+GETMAXX)/2);
  940.     CHYSC:=ROUND((GETMAXY-SCRBOTTOM+SCRTOP)/2);
  941.     LINXSC:=CHXSC; LINYSC:=CHYSC; LINLEN:=30; THETA:=0.0; TRACE:=FALSE;
  942.  
  943.   REPEAT {UNTIL DONEFLAG}
  944.     REDRAW:=FALSE;
  945.     {initialize window boundaries in screen coords}
  946.       LWBSC:=SCRLEFT;           RWBSC:=GETMAXX;
  947.       BWBSC:=GETMAXY-SCRBOTTOM; TWBSC:=SCRTOP;
  948.     {clear window}
  949.       CLEARDEVICE; SETWRITEMODE(XORPUT);
  950.  
  951.     IF NEWMODE THEN BEGIN {redefine bounds in new user coords}
  952.       NEWMODE:=FALSE; LWBUC:=XDATAVAL(LWBIC); RWBUC:=XDATAVAL(RWBIC);
  953.       END; {IF NEWMODE}
  954.     {determine min and max x axis values}
  955.       IF (RWBUC>LWBUC) THEN BEGIN LOXUC:=LWBUC; HIXUC:=RWBUC; END
  956.       ELSE BEGIN LOXUC:=RWBUC; HIXUC:=LWBUC; END;
  957.     {determine first and last points}
  958.       LIMITS(LOXUC,HIXUC,FIRST,LAST,LWBIC,RWBIC);
  959.     {determine screen positions of crosshair and line}
  960.       IF (CHXUC>HIXUC) OR (CHXUC<LOXUC) THEN CHXSC:=ROUND((LWBSC+RWBSC)/2)
  961.       ELSE CHXSC:=XCOORDSC(CHXUC);
  962.       IF (LINXUC>HIXUC) OR (LINXUC<LOXUC) THEN LINXSC:=CHXSC
  963.       ELSE LINXSC:=XCOORDSC(LINXUC);
  964.       IF (TWBUC>BWBUC) THEN BEGIN
  965.         IF (CHYUC>TWBUC) OR (CHYUC<BWBUC) THEN CHYSC:=ROUND((BWBSC+TWBSC)/2)
  966.         ELSE CHYSC:=YCOORDSC(CHYUC);
  967.         IF (LINYUC>TWBUC) OR (LINYUC<BWBUC) THEN LINYSC:=CHYSC
  968.         ELSE LINYSC:=YCOORDSC(LINYUC);
  969.         END
  970.       ELSE BEGIN
  971.         IF (CHYUC<TWBUC) OR (CHYUC>BWBUC) THEN CHYSC:=ROUND((BWBSC+TWBSC)/2)
  972.         ELSE CHYSC:=YCOORDSC(CHYUC);
  973.         IF (LINYUC<TWBUC) OR (LINYUC>BWBUC) THEN LINYSC:=CHYSC
  974.         ELSE LINYSC:=YCOORDSC(LINYUC);
  975.         END;
  976.       IF TRACE THEN SETCHY;
  977.     {plot the data}
  978.       RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
  979.       LABELS;
  980.       AXIS(LWBUC,RWBUC,BWBUC,TWBUC,LWBSC,RWBSC,BWBSC,TWBSC,XLABEL,YLABEL);
  981.       SCRNDRAW(ELIPSFLAG,STEPSIZE);
  982.     {overlay the remaining stuff}
  983.       IF CHFLAG THEN DRAWCH;
  984.       IF LINFLAG THEN DRAWLN; {crosshair must be drawn first}
  985.  
  986.     REPEAT {UNTIL REDRAW OR DONEFLAG}
  987.       REPEAT UNTIL KEYPRESSED;
  988.       ASCII:=ORD(READKEY);
  989.       CASE ASCII OF
  990.         0 : BEGIN SCANCODE:=ORD(READKEY);
  991.             CASE SCANCODE OF
  992. {F1}          59: BEGIN                           {toggle crosshair display}
  993.                     CHFLAG:=NOT CHFLAG;
  994.                     IF (TRACE AND CHFLAG) THEN SETCHY;
  995.                     DRAWCH;
  996.                   END;
  997. {CTRL F1}     94: BEGIN {toggle line on/off}
  998.                     LINFLAG:=NOT LINFLAG; DRAWLN;
  999.                   END;
  1000. {F2}          60: BEGIN                             {toggle ellipse display}
  1001.                     REDRAW:=TRUE;
  1002.                     IF ELIPSFLAG THEN ELIPSFLAG:=FALSE ELSE ELIPSFLAG:=TRUE;
  1003.                     IF NOT(ELIPSFLAG OR LINEFLAG) THEN LINEFLAG:=TRUE;
  1004.                   END;
  1005. {CTRL F2}     95: BEGIN                             {toggle connect the dots}
  1006.                     REDRAW:=TRUE;
  1007.                     IF LINEFLAG THEN LINEFLAG:=FALSE ELSE LINEFLAG:=TRUE;
  1008.                     IF NOT(LINEFLAG OR ELIPSFLAG) THEN ELIPSFLAG:=TRUE;
  1009.                   END;
  1010. {F3}          61: BEGIN                            {change filter parameters}
  1011.                     CHANGEFILTER; REDRAW:=TRUE;
  1012.                   END;
  1013. {CTRL F3}     96: BEGIN                                    {peak integration}
  1014.                     IF LINFLAG THEN INTEGRATE;
  1015.                   END;
  1016. {F4}          62: IF CHFLAG THEN BEGIN          {toggle crosshair trace mode}
  1017.                     DRAWCH; {erase existing ch}
  1018.                     TRACE:=NOT TRACE;
  1019.                     IF TRACE THEN SETCHY; DRAWCH; LABELS;
  1020.                   END;
  1021. {CTRL F4}     97: BEGIN                                  {change axis labels}
  1022.                     CHNG_LABELS; REDRAW:=TRUE;
  1023.                   END;
  1024. {F5}          63: BEGIN                       {dump displayed data to a file}
  1025.                     DUMP_TEXT; LABELS;
  1026.                   END;
  1027. {CTRL F5}     98: POST;                              {postscript screen dump}
  1028. {F6}          64: BEGIN                        {x axis linear transformation}
  1029.                     TRANSX; NEWMODE:=TRUE; REDRAW:=TRUE;
  1030.                   END;
  1031. {CTRL F6}     99: BEGIN                        {y axis linear transformation}
  1032.                     TRANSY; NEWMODE:=TRUE; REDRAW:=TRUE;
  1033.                   END;
  1034. {PG UP -                                increase window movement sensitivity}
  1035.               73,132: BEGIN
  1036.                   CASE WINDSENS OF
  1037.                      1: WINDSENS:=2;   2:WINDSENS:=5; 5:WINDSENS:=10;
  1038.                     10: WINDSENS:=20; 20:WINDSENS:=50;
  1039.                     END; {CASE}
  1040.                   BEEP(200*WINDSENS);
  1041.                   END;
  1042. {PG DN -                                decrease window movement sensitivity}
  1043.               81,118: BEGIN
  1044.                   CASE WINDSENS OF
  1045.                     50:WINDSENS:=20; 20:WINDSENS:=10; 10:WINDSENS:=5;
  1046.                      5:WINDSENS:=2;   2:WINDSENS:=1;
  1047.                     END; {CASE}
  1048.                   BEEP(200*WINDSENS);
  1049.                   END;
  1050. {CTRL HOME - translate window up}
  1051.               119:IF (TWBSC-WINDSENS)>=SCRTOP THEN BEGIN
  1052.                     RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
  1053.                     TWBSC:=TWBSC-WINDSENS; BWBSC:=BWBSC-WINDSENS;
  1054.                     FRAME:=TRUE;
  1055.                     END;
  1056. {CTRL END - translate window down}
  1057.               117:IF (BWBSC+WINDSENS)<=(GETMAXY-SCRBOTTOM) THEN BEGIN
  1058.                     RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
  1059.                     TWBSC:=TWBSC+WINDSENS; BWBSC:=BWBSC+WINDSENS;
  1060.                     FRAME:=TRUE;
  1061.                     END;
  1062. {CTRL LEFT ARROW - translate window left}
  1063.               115:IF (LWBSC-WINDSENS)>=SCRLEFT THEN BEGIN
  1064.                     RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
  1065.                     LWBSC:=LWBSC-WINDSENS; RWBSC:=RWBSC-WINDSENS;
  1066.                     FRAME:=TRUE;
  1067.                     END;
  1068. {CTRL RIGHT ARROW - translate window to right}
  1069.               116:IF (RWBSC+WINDSENS)<=GETMAXX THEN BEGIN
  1070.                     RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
  1071.                     RWBSC:=RWBSC+WINDSENS; LWBSC:=LWBSC+WINDSENS;
  1072.                     FRAME:=TRUE;
  1073.                     END;
  1074. {LEFT ARROW - contract window horizontally}
  1075.               75: IF (RWBSC-LWBSC)>(2*WINDSENS) THEN BEGIN
  1076.                     RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
  1077.                     RWBSC:=RWBSC-WINDSENS; LWBSC:=LWBSC+WINDSENS;
  1078.                     FRAME:=TRUE;
  1079.                     END;
  1080. {RIGHT ARROW - expand window horizontally}
  1081.               77: IF ((LWBSC-WINDSENS)>=SCRLEFT) AND
  1082.                      ((RWBSC+WINDSENS)<=GETMAXX) THEN BEGIN
  1083.                     RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
  1084.                     LWBSC:=LWBSC-WINDSENS; RWBSC:=RWBSC+WINDSENS;
  1085.                     FRAME:=TRUE;
  1086.                     END;
  1087. {END -contract window vertically}
  1088.               79: IF (BWBSC-TWBSC)>(2*WINDSENS) THEN BEGIN
  1089.                     RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
  1090.                     TWBSC:=TWBSC+WINDSENS; BWBSC:=BWBSC-WINDSENS;
  1091.                     FRAME:=TRUE;
  1092.                     END;
  1093. {HOME - expand window vertically}
  1094.               71: IF ((BWBSC+WINDSENS)<=GETMAXY) AND
  1095.                      ((TWBSC-WINDSENS)>=SCRTOP) THEN BEGIN
  1096.                     RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
  1097.                     BWBSC:=BWBSC+WINDSENS; TWBSC:=TWBSC-WINDSENS;
  1098.                     FRAME:=TRUE;
  1099.                     END;
  1100. {UP ARROW - expand window}
  1101.               72: IF ((BWBSC+WINDSENS)<=GETMAXY) AND
  1102.                      ((TWBSC-WINDSENS)>=SCRTOP) AND
  1103.                      ((LWBSC-WINDSENS)>=SCRLEFT) AND
  1104.                      ((RWBSC+WINDSENS)<=GETMAXX) THEN BEGIN
  1105.                     RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
  1106.                     BWBSC:=BWBSC+WINDSENS; TWBSC:=TWBSC-WINDSENS;
  1107.                     LWBSC:=LWBSC-WINDSENS; RWBSC:=RWBSC+WINDSENS;
  1108.                     FRAME:=TRUE;
  1109.                     END;
  1110. {DOWN ARROW - contract window}
  1111.               80:IF ((RWBSC-LWBSC)>(2*WINDSENS)) AND
  1112.                      ((BWBSC-TWBSC)>(2*WINDSENS)) THEN BEGIN
  1113.                     RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC);
  1114.                     RWBSC:=RWBSC-WINDSENS; LWBSC:=LWBSC+WINDSENS;
  1115.                     TWBSC:=TWBSC+WINDSENS; BWBSC:=BWBSC-WINDSENS;
  1116.                     FRAME:=TRUE;
  1117.                     END;
  1118. {F7}          65: BEGIN {left/right inversion}
  1119.                     OLDLWBUC:=LWBUC; LWBUC:=RWBUC; RWBUC:=OLDLWBUC;
  1120.                     REDRAW:=TRUE;
  1121.                   END;
  1122. {CTRL F7}     100:BEGIN {top/bottom inversion}
  1123.                     OLDBWBUC:=BWBUC; BWBUC:=TWBUC; TWBUC:=OLDBWBUC;
  1124.                     REDRAW:=TRUE;
  1125.                   END;
  1126. {F8}          66: BEGIN {Angstrom to cm-1 conversion}
  1127.                     CONV(TRUE); NEWMODE:=TRUE; REDRAW:=TRUE;
  1128.                   END;
  1129. {CTRL F8}     101:BEGIN {cm-1 to Angstrom conversion}
  1130.                     CONV(FALSE); NEWMODE:=TRUE; REDRAW:=TRUE;
  1131.                   END;
  1132. {F9}          67: PAN('left');
  1133. {F10}         68: PAN('right');
  1134. {ALT N}       49: NONLINEAR('Y');      {y axis nonlinear transformation}
  1135.               END; {CASE}
  1136.             END;
  1137. {ESC}   27: DONEFLAG:=TRUE;
  1138. {ENTER, +, or SPACE - zoom}
  1139.         13,43,32: BEGIN
  1140.             REDRAW:=TRUE;
  1141.             OLDLWBUC:=LWBUC; OLDBWBUC:=BWBUC;
  1142.             LWBUC:=OLDLWBUC+((RWBUC-OLDLWBUC)*((LWBSC-SCRLEFT)/
  1143.                    (GETMAXX-SCRLEFT)));
  1144.             RWBUC:=OLDLWBUC+((RWBUC-OLDLWBUC)*((RWBSC-SCRLEFT)/
  1145.                    (GETMAXX-SCRLEFT)));
  1146.             BWBUC:=OLDBWBUC+(TWBUC-OLDBWBUC)*(BWBSC-GETMAXY+SCRBOTTOM)/
  1147.                    (SCRTOP-GETMAXY+SCRBOTTOM);
  1148.             TWBUC:=OLDBWBUC+(TWBUC-OLDBWBUC)*(TWBSC-GETMAXY+SCRBOTTOM)/
  1149.                    (SCRTOP-GETMAXY+SCRBOTTOM);
  1150.             END;
  1151. {0}     48: {crosshair up}
  1152.             IF CHFLAG AND ((CHYSC-CHSENS)>=SCRTOP) THEN BEGIN
  1153.               DRAWCH; CHYSC:=CHYSC-CHSENS; DRAWCH;
  1154.             END;
  1155. {9}     57: {crosshair down}
  1156.             IF CHFLAG AND ((CHYSC+CHSENS)<=(GETMAXY-SCRBOTTOM)) THEN BEGIN
  1157.               DRAWCH; CHYSC:=CHYSC+CHSENS; DRAWCH;
  1158.             END;
  1159. {=}     61: {crosshair right}
  1160.             IF CHFLAG AND ((CHXSC+CHSENS)<=GETMAXX) THEN BEGIN
  1161.               DRAWCH; CHXSC:=CHXSC+CHSENS; IF TRACE THEN SETCHY; DRAWCH;
  1162.             END;
  1163. {-}     45: {crosshair left}
  1164.             IF CHFLAG AND ((CHXSC-CHSENS)>=SCRLEFT) THEN BEGIN
  1165.               DRAWCH; CHXSC:=CHXSC-CHSENS; IF TRACE THEN SETCHY; DRAWCH;
  1166.             END;
  1167. {8}     56: BEGIN {increase crosshair sensitivity}
  1168.               CASE CHSENS OF
  1169.                 1 :CHSENS:=2;    2:CHSENS:=5;    5:CHSENS:=10;
  1170.                 10:CHSENS:=20;  20:CHSENS:=50;
  1171.               END; {CASE}
  1172.               BEEP(200*CHSENS);
  1173.             END;
  1174. {7}     55: BEGIN {decrease crosshair sensitivity}
  1175.               CASE CHSENS OF
  1176.                 50:CHSENS:=20;  20:CHSENS:=10;  10:CHSENS:=5;
  1177.                  5:CHSENS:=2;    2:CHSENS:=1;
  1178.               END; {CASE}
  1179.               BEEP(200*CHSENS);
  1180.             END;
  1181. {line}  49,50,51,52,53,54,81,87,82,69,113,119,101,114:
  1182.           IF LINFLAG THEN BEGIN
  1183.             DRAWLN;
  1184.             CASE ASCII OF
  1185. {1}           49:BEGIN {rotate counterclockwise}
  1186.                    THETA:=THETA+CHSENS/LINLEN*2;
  1187.                    THETA:=THETA-TRUNC(THETA/(2*PI))*2*PI;
  1188.                  END;
  1189. {2}           50:BEGIN {rotate line clockwise}
  1190.                    THETA:=THETA-CHSENS/LINLEN*2;
  1191.                    THETA:=THETA-TRUNC(THETA/(2*PI))*2*PI;
  1192.                  END;
  1193. {3}           51:LINYSC:=LINYSC+CHSENS; {translate line down}
  1194. {4}           52:LINYSC:=LINYSC-CHSENS; {translate line up}
  1195. {5}           53:LINXSC:=LINXSC-CHSENS; {translate line to left}
  1196. {6}           54:LINXSC:=LINXSC+CHSENS; {translate line to right}
  1197. {Q}           81,113:LINLEN:=ABS(LINLEN-CHSENS); {shorten line}
  1198. {W}           87,119:LINLEN:=ABS(LINLEN+CHSENS); {lengthen line}
  1199. {E}           69,101:IF CHFLAG THEN BEGIN {move line to FWHM position}
  1200.                  LINYSC:=ROUND((CHYSC+LINYSC+TAN(THETA)*(CHXSC-LINXSC))/2);
  1201.                  LINXSC:=CHXSC;
  1202.                  END;
  1203. {R}           82,114:IF THETA=0 THEN THETA:=PI/2       {vertical/horizontal}
  1204.                  ELSE THETA:=0;
  1205.             END; {CASE}
  1206.             DRAWLN;
  1207.             END; {IF LINFLAG}
  1208. {H}     72,104: HELP;
  1209. {L}     76,108: SETLIM;                        {user specified window bounds}
  1210. {M}     77,109: MINMAX;                       {max and min of displayed data}
  1211. {N}     78,110: NONLINEAR('X');                  {x axis nonlinear transform}
  1212. {X}     88,120: ZOOMOUT;                              {zoom out horizontally}
  1213. {D}     68,100: BEGIN                                 {execute a DOS command}
  1214.                   RESTORECRTMODE; DOS_CMD; SETGRAPHMODE(GETGRAPHMODE);
  1215.                   REDRAW:=TRUE;
  1216.                 END;
  1217. {CTRL ENTER - return to original plot}
  1218.         10: BEGIN
  1219.             REDRAW:=TRUE;
  1220.             FIRST:=1; LAST:=NUMPTS;
  1221.             BWBUC:=LOY; TWBUC:=HIY; LWBUC:=MINX; RWBUC:=MAXX;
  1222.             END;
  1223.       END; {CASE}
  1224.       IF FRAME THEN BEGIN
  1225.         RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC); FRAME:=FALSE;
  1226.         END;
  1227.     UNTIL REDRAW OR DONEFLAG;
  1228.  
  1229.   UNTIL DONEFLAG;
  1230. END; {IF}
  1231.  
  1232. CLOSEGRAPH;
  1233. END; {GRAF}
  1234.  
  1235. END. {UNIT}