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