{************************************************************************* TITLE : GRAFED VERSION : 2.1 AUTHOR : Roger Carlson (after GRAFED5, version 3.2 of M.Riebe and R.Carlson written for the IBM CS9000 computer) 5/29/90 FUNCTION: This unit contains the GRAF routine for interactive display of xy data. INPUTS : DATA - The xy data. The first index identifies x(1) or y(2) and the second index specifies the data point. FILENAME - Name of the data file. MINX - Minimum x value. MAXX - Maximum x value. LOY - Smallest y value. HIY - Largest y value. NUMPTS - Number of data points. NOTES : 1. In Turbo Pascal the maximum size of any variable is 64KB. To use the largest possible data array sizes, I've used a single precision data array, which uses 23 bit (7-8digit) precision. CHANGES : 6/2/90 (1.1,RJC) - Added window selection. 6/3/90 (1.2,RJC) - Modified to change passed parameters to include x max and min rather than first and last index. 6/4/90 (1.3,RJC) - Added parameter window at bottom of screen. 6/12/90 (1.4,RJC) -Added crosshair, ruler and several bells and whistles. 7/6/90 (1.5,RJC) - Started some bells and whistles. Moved CLRBOX to AXISLBL. 3/23/91 (1.6,RJC) -Increased the maximum data array size to 7000 and changed data array type to single precision. Also changed screen driver path to d:\tp to be consistent with lab computer setup. 3/28/91 (1.7,RJC) -Added peak integration routine and completed the moving average option. 5/2/91 (1.8,RJC) - Corrected text file dump procedure to include data filtering. 5/3/91 (1.9,RJC) - Added linear transformation of axes, wavelength/wavenumber conversion of x axis, and change of axis labels. 5/9/91 (2.0,RJC) - Added postscript print screen procedure, user defined window bounds, pan left, pan right, expand horizontally, dos shell command, and crosshair trace mode. 5/23/91 (2.1,RJC) - Corrected an array range error when the newmode flag was set (eg for a linear transform of x). Added min/max procedure and nonlinear transforms. *************************************************************************} UNIT GRAFED; {$I-} {Disable IO checking.} INTERFACE USES IOFUNCS; {version 1.7} CONST MAXPTS=7000; {Maximum # of data points.} TYPE DARRAY=ARRAY[1..2,1..MAXPTS] OF SINGLE; PROCEDURE GRAF(VAR DATA:DARRAY; FILENAME:STR20; MINX,MAXX,LOY,HIY:REAL; NUMPTS:INTEGER); IMPLEMENTATION USES CRT,GRAPH,DOS, MATH, {VERSION 1.3} AXISLBL; {VERSION 2.6} PROCEDURE GRAF; CONST DRIVERS='d:\tp'; {location of device drivers} SCRLEFT=100; {plot starts SCRLEFT units from left edge} SCRBOTTOM=58; {bottom of plot SCRBOTTOM units from screen bottom} SCRTOP=28; {top of plot SCRTOP unit from screen top} LINE1=3; {first line for window at top of screen} LINE2=13; {second line for window at top of screen} VAR ASCII : INTEGER; {ordinal value of a key pressed} BWBSC : integer; {bottom window boundary in screen coordinates} BWBUC : REAL; {bottom window bound in user coordinates} CHFLAG : BOOLEAN; {turns crosshair display on} CHSENS : INTEGER; {crosshair movement sensitivity} CHXUC,CHYUC : REAL; {crosshair user coordinates} CHXSC,CHYSC : INTEGER; {crosshair screen coordinates} DONEFLAG : BOOLEAN; {flag to bet out of program} ELIPSFLAG : BOOLEAN; {flags circling of each point} ERRCODE : integer; {error code} FILTYPE, FILDEGREE, FILDERIV, FILWIDTH : INTEGER; {filter parameters} FIRST : INTEGER; {index of current first displayed point} FRAME : BOOLEAN; {flags need to redraw frame} GRAPHDRIVER : integer; {graphics device ID number} GRAPHMODE : integer; {mode for the graphics device} HIXUC : REAL; {highest x user coordinate} kbdbox : viewporttype; {graphics window at bottom of screen} LAST : INTEGER; {index of last point currently displayed} LINEFLAG : BOOLEAN; {flags connecting of points with lines} LINFLAG : BOOLEAN; {flag to indicate choice of movable line} LINLEN : INTEGER; {length of line in number of pixels} LINXSC,LINYSC: INTEGER; {line screen coordinates} LINXUC,LINYUC: REAL; {line user coordinates} LOXUC : REAL; {lowest x value in user coordinates} LWBIC : INTEGER; {lefg window boundary in index coordinates} LWBSC : integer; {left window boundary in screen coordinates} LWBUC : REAL; {left window boundary in user coordinate} NEWMODE : BOOLEAN; {flags choice of a new display mode} OLDBWBUC : REAL; {temporary bottom window bound in user coords} OLDLWBUC : REAL; {temporary left window bound in user coords} REDRAW : BOOLEAN; {flags need to redraw the screen plot} RWBIC : INTEGER; {rigth window boundary in index coordinates} RWBSC : integer; {right window boundary in screen coordinates} RWBUC : REAL; {right window boundary in user coordinate} SCANCODE : INTEGER; {extended code for a key pressed} STEPSIZE : INTEGER; {size of increments between points} THETA : REAL; {angle of live vs. horizontal (radians)} TRACE : BOOLEAN; {flags crosshair trace mode} TWBSC : integer; {top window boundary in screen coordinates} TWBUC : REAL; {top window boundary in user coordinates} titlebox : viewporttype; {graphics window at top of screen} WINDSENS : INTEGER; {window movement sensitivity} XLABEL : STR40; {label for x axis} YLABEL : STR40; {label for y axis} {************************ Coordinate Transformations ********************} FUNCTION XCOORDSC(DATAPT:REAL):INTEGER; BEGIN {Returns x value in screen coordinates corresponding to the user value DATAPT by comparing it to the left and right window boundaries in user coordinates.} XCOORDSC:=ROUND((DATAPT-LWBUC)*((RWBSC-LWBSC)/(RWBUC-LWBUC))+LWBSC); END; {XCOORDSC} FUNCTION XDATAVAL(INDEX:INTEGER):REAL; {Returns x coordinate value in user specified units for a given index with user specified slope and intercept incorporated.} BEGIN IF (INDEX>=1) AND (INDEX<=NUMPTS) THEN XDATAVAL:=DATA[1,INDEX] ELSE XDATAVAL:=(INDEX-1)*(DATA[1,NUMPTS]-DATA[1,1])/(NUMPTS-1)+DATA[1,1] END; {XDATAVAL} FUNCTION YCOORDSC(DATAPT:REAL):INTEGER; BEGIN {Returns y value in screen coordinates corresponding to the supplied user coordinate of the current point by comparing it to the top and bottom displayed user coordinates.} YCOORDSC:=ROUND((DATAPT-BWBUC)*((TWBSC-BWBSC)/(TWBUC-BWBUC))+BWBSC); END; {YCOORDSC} FUNCTION XCOORDUC(DATAPT:REAL):REAL; BEGIN {Returns the x value in user coordinates corresponding to the supplied screen coordinate of a point.} XCOORDUC:=(DATAPT-LWBSC)*(RWBUC-LWBUC)/(RWBSC-LWBSC)+LWBUC; END; FUNCTION YCOORDUC(DATAPT:REAL):REAL; BEGIN {Returns the y value in user coordinates corresponding to the suppied screen coordinate of a point.} YCOORDUC:=(DATAPT-BWBSC)*(TWBUC-BWBUC)/(TWBSC-BWBSC)+BWBUC; END; FUNCTION YDATAVAL(INDEX:INTEGER):REAL; {Returns y coordinate value in specified units for a given index to the data array.} VAR TEMPINDEX:INTEGER; BEGIN IF INDEX>LAST THEN TEMPINDEX:=LAST ELSE IF INDEX=NUMPTS THEN TEMPINDEX:=NUMPTS; YDATAVAL:=DATA[2,TEMPINDEX]; END; {YDATAVAL} {********************* FUNCTION FILTER **********************************} FUNCTION filter(FILDERIV,INDEX:INTEGER):REAL; {This function applies either a moving average or Savitzky-Golay polynomial fit least squares filter to the data using the following parameters: FILTYPE : INTEGER 0=moving average, 1=Savitzy-Golay FILDEGREE: INTEGER Degree of polynomial fit (2,3,or 4) FILDERIV : INTEGER Derivative desired (0,1,or 2) FILWIDTH : INTEGER Width of filter in number of datapoints INDEX : INTEGER Index to central data value in data array.} VAR YAVG : DOUBLE; I,M : INTEGER; BEGIN YAVG:=0.0; M:=FILWIDTH DIV 2; case FILTYPE of 0: BEGIN for I:=(INDEX-M) to (INDEX+M) do YAVG:=YAVG+ydataval(I); FILTER := YAVG/(2*M + 1); END; 1: BEGIN FILTER := YDATAVAL(I); END; END; {case} END; {filter} {************************** PROCEDURE SETCHY ******************************} PROCEDURE SETCHY; {Sets crosshair y screen coordinate to a point on the displayed data.} VAR I,Y,MAXY:INTEGER; DONE:BOOLEAN; BEGIN I:=0; MAXY:=GETMAXY-SCRBOTTOM; DONE:=FALSE; REPEAT Y:=CHYSC+I; IF (Y0) THEN BEGIN DONE:=TRUE; CHYSC:=Y END ELSE BEGIN Y:=CHYSC-I; IF (Y>SCRTOP) AND (GETPIXEL(CHXSC,Y)<>0) THEN BEGIN DONE:=TRUE; CHYSC:=Y END; END; I:=I+1; UNTIL DONE OR (I=MAXY-SCRTOP+1); END; {************************** PROCEDURE DRAWCH ******************************} PROCEDURE DRAWCH; {Draws or erases the crosshair at the coordinates CHXSC and CHYSC and lists or erases coordinates at the top of the screen. The procedure returns CHXUC and CHYUC.} CONST HEIGHT=21; VAR CHXLO,CHXHI,CHYLO,CHYHI,CHXLEN,CHYLEN : INTEGER; ORXUC,ORYUC :REAL; X,Y:STR20; BEGIN CHXLEN:=ROUND((GETMAXX-SCRLEFT)/25); CHYLEN:=ROUND((GETMAXY-SCRBOTTOM-SCRTOP)/20); IF ((CHXSC-CHXLEN)RWBSC) THEN CHXHI:=RWBSC ELSE CHXHI:=CHXSC+CHXLEN; IF ((CHYSC-CHYLEN)BWBSC) THEN CHYHI:=BWBSC ELSE CHYHI:=CHYSC+CHYLEN; {update crosshair user coordinates} CHXUC:=XCOORDUC(CHXSC); CHYUC:=YCOORDUC(CHYSC); LINE(CHXLO,CHYSC,CHXHI,CHYSC); LINE(CHXSC,CHYLO,CHXSC,CHYHI); IF CHFLAG THEN BEGIN {diplay coords at top} CLRBOX(0,0,GETMAXX,HEIGHT,FALSE); SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1); IF LINFLAG THEN BEGIN STR((CHXUC-LINXUC):10:4,X); STR((CHYUC-LINYUC):10:4,Y); OUTTEXTXY(3,4,CONCAT('Crosshair Relative Coordinates: ', X,',',Y)); STR(ABS(XCOORDUC(LINXSC+ROUND(LINLEN/2*COS(THETA)))- XCOORDUC(LINXSC-ROUND(LINLEN/2*COS(THETA)))):10:4,X); STR(ABS(YCOORDUC(LINYSC+ROUND(LINLEN/2*SIN(THETA)))- YCOORDUC(LINYSC-ROUND(LINLEN/2*SIN(THETA)))):10:4,Y); OUTTEXTXY(3,13,CONCAT(' Line Length: ',X,',',Y)); END ELSE BEGIN STR(CHXUC:10:4,X); STR(CHYUC:10:4,Y); OUTTEXTXY(3,4,CONCAT('Crosshair Absolute Coordinates: ',X,',',Y)); END END ELSE BEGIN {erase the top box} SETVIEWPORT(0,0,GETMAXX,HEIGHT,CLIPON); CLEARVIEWPORT; SETVIEWPORT(0,0,GETMAXX,GETMAXY,CLIPON); END; END; {DRAWCH} {************************* PROCEDURE DRAWLN ********************************} PROCEDURE DRAWLN; {This procedure draws a translatable, rotatable lin on the screen for use in conjunction with the crosshair in determining peak heights and widths. The position is determined by LINXSC and LINYSC and the procedure returns LINXUC and LINYUC.} PROCEDURE RANGE(VAR NUMBER:INTEGER; R1,R2:INTEGER); VAR MAX,MIN:INTEGER; BEGIN IF R1>R2 THEN BEGIN MAX:=R1; MIN:=R2; END ELSE BEGIN MAX:=R2; MIN:=R1; END; IF NUMBERMAX THEN NUMBER:=MAX; END; {RANGE} PROCEDURE DOLINE(LINLEN:INTEGER; THETA:REAL); VAR LX,LY,RX,RY: INTEGER; BEGIN LX:=LINXSC-ROUND(LINLEN/2*COS(THETA)); LY:=LINYSC-ROUND(LINLEN/2*SIN(THETA)); RX:=LINXSC+ROUND(LINLEN/2*COS(THETA)); RY:=LINYSC+ROUND(LINLEN/2*SIN(THETA)); RANGE(LX,LWBSC,RWBSC); RANGE(RX,LWBSC,RWBSC); RANGE(LY,TWBSC,BWBSC); RANGE(RY,TWBSC,BWBSC); LINE(LX,LY,RX,RY); END; {DOLINE} BEGIN DOLINE(LINLEN,THETA); DOLINE(4,THETA+PI/2); {update the line coordinates} LINXUC:=XCOORDUC(LINXSC); LINYUC:=YCOORDUC(LINYSC); IF CHFLAG THEN BEGIN {update the relative crosshair coords} DRAWCH; DRAWCH; END; END; {DRAWLN} {************************* PROCEDURE INTEGRATE *****************************} PROCEDURE INTEGRATE; VAR A :DOUBLE; {running total of areas} ANS :CHAR; I :INTEGER; {data point index} LASTY :DOUBLE; {last y value} LX :DOUBLE; {screen coordinates of left end of ruler} N :INTEGER; {number of points} RX :DOUBLE; {screen coordinates of right end of ruler} S :DOUBLE; {std deviation} ST :STRING[3]; {string for output message} SUMY :DOUBLE; {sum of y} SUMYY :DOUBLE; {sum of sqr(y)} XSC :DOUBLE; {x screen coord} Y :DOUBLE; {y value} YSC :DOUBLE; {y screen coord} BEGIN SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1); ANS:='A'; REPEAT CLRBOX(0,0,GETMAXX,24,TRUE); OUTTEXTXY(3,LINE1,'Integration procedure: '); MOVETO(3,LINE2); OUTTEXT(CONCAT('Absolute Y values or Relative to the ruler (A or R) [', ANS,']? ')); GRDCHAR(ANS); UNTIL ANS IN ['A','a','r','R']; IF ANS='a' THEN ANS:='A'; IF ANS='r' THEN ANS:='R'; CLRBOX(0,0,GETMAXX,24,TRUE); OUTTEXTXY(3,LINE1,'Integration in progress...'); I:=FIRST; A:=0.0; LASTY:=0.0; N:=0; SUMY:=0.0; SUMYY:=0.0; LX:=LINXSC-ROUND(LINLEN/2*COS(THETA)); RX:=LINXSC+ROUND(LINLEN/2*COS(THETA)); REPEAT XSC:=XCOORDSC(DATA[1,I]); IF (XSC<=RX) AND (XSC>=LX) THEN BEGIN N:=N+1; IF ANS='R' THEN Y:=FILTER(FILDERIV,I)-YCOORDUC(LINYSC+(XSC-LINXSC)*TAN(THETA)) ELSE Y:=FILTER(FILDERIV,I); IF LASTY<>0.0 THEN A:=A+(LASTY+Y)*(XDATAVAL(I)-XDATAVAL(I-1)); SUMY:=SUMY+Y; SUMYY:=SUMYY+SQR(Y); LASTY:=Y; END; {IF} I:=I+1; UNTIL I>LAST; S:=SQRT( (SUMYY-SQR(SUMY)/N)/(N-1) ); IF ANS='R' THEN ST:='Rel' ELSE ST:='Abs'; CLRBOX(0,0,GETMAXX,24,TRUE); OUTTEXTXY(3,LINE1,CONCAT(ST,' Int=',RLTOSTR(A/2,12),' over: ', RLTOSTR(xcoorduc(lx),14),' to ', RLTOSTR(xcoorduc(rx),14) )); MOVETO(3,LINE2); OUTTEXT(CONCAT(ST,' =',RLTOSTR(sumy/n,12),'(',CHAR(241), RLTOSTR(s*t(n-1)/sqrt(n),12),') Std Dev =', RLTOSTR(s,12))); END; {PROCEDURE INTEGRATE} {************************* PROCEDURE LIMITS ********************************} PROCEDURE LIMITS(LOXUC,HIXUC:REAL; VAR FIRST,LAST,LWBIC,RWBIC:INTEGER); {This procedure calculates FIRST and LAST appropriate for the given user coordinate window boundaries. It also returns new values of LWBIC and RWBIC.} VAR X1,X2 : REAL; {user coordinates of old first & last points} LEFT : BOOLEAN; {T=first on left, F=first on right} F,L : INTEGER; {temporary values of FIRST and LAST} OVERF,OVERL : BOOLEAN; {flag for window boundaries outside of data extents} BEGIN OVERF:=FALSE; OVERL:=FALSE; X1:=XDATAVAL(FIRST); X2:=XDATAVAL(LAST); LEFT:=(X2-X1)/(RWBUC-LWBUC)>0; {calculate approximate values by linear interpolation} IF LEFT THEN BEGIN F:=FIRST + ROUND((LWBUC-X1)/(X2-X1)*(LAST-FIRST)) - 1; L:=FIRST + ROUND((RWBUC-X1)/(X2-X1)*(LAST-FIRST)) + 1; END ELSE BEGIN F:=FIRST + ROUND((RWBUC-X1)/(X2-X1)*(LAST-FIRST)) - 1; L:=FIRST + ROUND((LWBUC-X1)/(X2-X1)*(LAST-FIRST)) + 1; END; IF F<1 THEN BEGIN FIRST:=1; OVERF:=TRUE; END; IF F>NUMPTS THEN BEGIN FIRST:=NUMPTS; OVERF:=TRUE; END; IF L>NUMPTS THEN BEGIN LAST:=NUMPTS; OVERL:=TRUE; END; IF L<1 THEN BEGIN LAST:=1; OVERL:=TRUE; END; {make sure values are not too far inside desired boundaries} IF NOT(OVERF) THEN WHILE (XDATAVAL(F)LOXUC) AND (L>F) AND (F>=2) DO F:=F-1; IF NOT(OVERL) THEN WHILE (XDATAVAL(L)LOXUC) AND (L>F) AND (L<=(NUMPTS-1)) DO L:=L+1; {now choose points just inside desired limits} IF NOT(OVERF) THEN BEGIN WHILE NOT((XDATAVAL(F)<=HIXUC)AND(XDATAVAL(F)>=LOXUC))AND(L>F) DO F:=F+1; FIRST:=F; IF LEFT THEN LWBIC:=F ELSE RWBIC:=F; END; IF NOT(OVERL) THEN BEGIN WHILE NOT((XDATAVAL(L)<=HIXUC)AND(XDATAVAL(L)>=LOXUC))AND(L>F) DO L:=L-1; LAST:=L; IF LEFT THEN RWBIC:=L ELSE LWBIC:=L; END; IF LEFT THEN BEGIN LWBIC:=F; RWBIC:=L; END ELSE BEGIN LWBIC:=L; RWBIC:=F END; END; {PROCEDURE LIMITS} {*********************** PROCEDURE LABELS **********************************} PROCEDURE LABELS; {This procedure writes out the information at the bottom of the plot.} VAR S:STR30; ST:STR80; FUNCTION RLTOST(RL:REAL):STR20; VAR S:STR20; BEGIN STR(RL:6:3,S); RLTOST:=S; END; BEGIN CLRBOX(0,GETMAXY-24,GETMAXX,GETMAXY,TRUE); SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1); STR(STEPSIZE,S); ST:=CONCAT('File: ',FILENAME,' Stepsize:',S); IF FILWIDTH<>1 THEN BEGIN ST:=CONCAT(ST,' Filter:'); STR(FILWIDTH,S); CASE FILTYPE OF 0: ST:=CONCAT(ST,'MA Width:',S); 1: BEGIN ST:=CONCAT(ST,'SG Width:',S); STR(FILDEGREE,S); ST:=CONCAT(ST,' Degree:',S); IF FILDERIV<>0 THEN BEGIN STR(FILDERIV,S); ST:=CONCAT(ST,' Derivative:',S); END; END; {1} END; {CASE} END; {IF} OUTTEXTXY(3,GETMAXY-21,ST); ST:=CONCAT('L:',RLTOST(LWBUC),' R:',RLTOST(RWBUC),' B:',RLTOST(BWBUC), ' T:',RLTOST(TWBUC)); IF TRACE THEN ST:=CONCAT(ST,' (x-hair trace mode)'); OUTTEXTXY(3,GETMAXY-11,ST); END; {PROCEDURE LABELS} {************************ DUMP_TEXT **************************************} PROCEDURE DUMP_TEXT; VAR DUMPNAME :STR20; LINE1,LINE2,ERR,I:INTEGER; ANS,C :CHAR; OUTFILE :TEXT; BEGIN LINE1:=GETMAXY-21; LINE2:=GETMAXY-11; DUMPNAME:='QUIT'; SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1); REPEAT CLRBOX(0,GETMAXY-24,GETMAXX,GETMAXY,TRUE); ANS:='Y'; OUTTEXTXY(3,LINE1,CONCAT('This procedure dumps the displayed data ', 'to a text file.')); MOVETO(3,LINE2); OUTTEXT(CONCAT('Name of the file (QUIT if none) [',DUMPNAME,']: ')); GRDSTR20(DUMPNAME); FOR I:=1 TO LENGTH(DUMPNAME) DO DUMPNAME[I]:=UPCASE(DUMPNAME[I]); CLRBOX(0,GETMAXY-24,GETMAXX,GETMAXY,TRUE); IF EXISTS(DUMPNAME) AND (DUMPNAME <> 'QUIT') THEN BEGIN OUTTEXTXY(3,LINE1,CONCAT('File ',DUMPNAME,' already exists.')); REPEAT MOVETO(3,LINE2); OUTTEXT(CONCAT('Overwrite the existing file (Y or N) [', ANS,']: ')); GRDCHAR(ANS); CLRBOX(0,GETMAXY-24,GETMAXX,GETMAXY,TRUE); UNTIL ANS IN ['Y','N']; END; {IF} IF (DUMPNAME<>'QUIT') AND (ANS='Y') THEN BEGIN ASSIGN(OUTFILE,DUMPNAME); REWRITE(OUTFILE); ERR:=IORESULT; IF ERR<>0 THEN BEGIN OUTTEXTXY(3,LINE1,CONCAT('IO error ',INTTOSTR(ERR))); OUTTEXTXY(3,LINE2,'Hit any key to continue.'); REPEAT UNTIL KEYPRESSED; C:=READKEY; IF C=#0 THEN C:=READKEY; END {IF} ELSE BEGIN OUTTEXTXY(3,LINE1,CONCAT('Data is being written to file ', DUMPNAME,'.')); I:=FIRST; REPEAT WRITELN(OUTFILE,XDATAVAL(I),' ',FILTER(FILDERIV,I)); I:=I+STEPSIZE; UNTIL (I>LAST); END; {ELSE} CLOSE(OUTFILE); END; {IF} UNTIL ANS='Y'; END; {**************************** SCRNDRAW *********************************} PROCEDURE SCRNDRAW(ELIPSFLAG:BOOLEAN; STEPSIZE:INTEGER); {This procedure plots the data or a function on the screen.} VAR I,XSC,YSC,START :INTEGER; X :DOUBLE; INRANGE :BOOLEAN; BEGIN SETWRITEMODE(COPYPUT); {overlap with existing stuff} START:=FIRST; I:=FIRST; REPEAT X:=XDATAVAL(I); XSC:=XCOORDSC(X); YSC:=YCOORDSC(FILTER(FILDERIV,I)); IF (XSC>SCRLEFT)AND(XSCSCRTOP)AND (YSC<(GETMAXY-SCRBOTTOM)) THEN INRANGE:=TRUE ELSE BEGIN INRANGE:=FALSE; START:=I+1; END; IF (I=START) OR NOT(INRANGE) THEN MOVETO(XSC,YSC); IF INRANGE THEN BEGIN IF (I<>START) AND LINEFLAG THEN LINETO(XSC,YSC); IF ELIPSFLAG THEN CIRCLE(XSC,YSC,1); END; I:=I+STEPSIZE; UNTIL I>LAST; SETWRITEMODE(XORPUT); {erase if overlap} END; {SCRNDRAW} {************************ PROCEDURE CHANGEFILTER ***********************} PROCEDURE CHANGEFILTER; BEGIN SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1); CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1); OUTTEXT(CONCAT('Size of steps between displayed data points [', INTTOSTR(STEPSIZE),']: ')); GRDINT(STEPSIZE); REPEAT MOVETO(3,LINE2); OUTTEXT(CONCAT('Type of filter: 0-Moving Avg, 1-Savitzky Golay [', INTTOSTR(FILTYPE),']: ')); GRDINT(FILTYPE); CLRBOX(0,0,GETMAXX,24,TRUE); UNTIL FILTYPE=0; MOVETO(3,LINE1); OUTTEXT(CONCAT('Width of filter [',inttostr(filwidth),']: ')); GRDINT(FILWIDTH); REDRAW:=TRUE; END; {************************ PROCEDURE TRANSX ***************************} PROCEDURE TRANSX; VAR ANS : CHAR; I : INTEGER; SLOPE,INT : REAL; OLDSLOPE,OLDINT : REAL; BEGIN SLOPE:=1; INT:=0; ANS:='N'; SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1); REPEAT CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1); OUTTEXT(CONCAT('Linear transform of x axis (Y or N) [',ans,']? ')); GRDCHAR(ANS); UNTIL ANS IN ['Y','y', 'N','n']; IF ANS IN ['Y','y'] THEN BEGIN REPEAT OLDSLOPE:=SLOPE; OLDINT:=INT; CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1); OUTTEXT(CONCAT('Slope [',RLTOSTR(slope,15),']: ')); GRDREAL(SLOPE); MOVETO(3,LINE2); OUTTEXT(CONCAT('Intercept [',RLTOSTR(INT,15),']: ')); GRDREAL(INT); UNTIL ((OLDSLOPE=SLOPE) AND (INT=OLDINT)); IF ((SLOPE<>1) OR (INT<>0)) THEN BEGIN FOR I:=1 TO NUMPTS DO DATA[1,I]:=SLOPE*DATA[1,I]+INT; MINX:=SLOPE*MINX+INT; MAXX:=SLOPE*MAXX+INT; IF CHFLAG THEN BEGIN CHXUC:=SLOPE*CHXUC+INT; CHXSC:=XCOORDSC(CHXUC); END; IF LINFLAG THEN BEGIN LINXUC:=SLOPE*CHXUC+INT; LINXSC:=XCOORDSC(LINXUC); END; END; {IF} END; {IF} END; {PROCEDURE TRANSX} {************************ PROCEDURE TRANSY ***************************} PROCEDURE TRANSY; VAR ANS : CHAR; I : INTEGER; SLOPE,INT : REAL; OLDSLOPE,OLDINT : REAL; BEGIN SLOPE:=1; INT:=0; ANS:='N'; SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1); REPEAT CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1); OUTTEXT(CONCAT('Linear transform of y axis (Y or N) [',ans,']? ')); GRDCHAR(ANS); UNTIL ANS IN ['Y','y', 'N','n']; IF ANS IN ['Y','y'] THEN BEGIN REPEAT OLDSLOPE:=SLOPE; OLDINT:=INT; CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1); OUTTEXT(CONCAT('Slope [',RLTOSTR(slope,15),']: ')); GRDREAL(SLOPE); MOVETO(3,LINE2); OUTTEXT(CONCAT('Intercept [',RLTOSTR(INT,15),']: ')); GRDREAL(INT); UNTIL ((OLDSLOPE=SLOPE) AND (INT=OLDINT)); IF ((SLOPE<>1) OR (INT<>0)) THEN BEGIN FOR I:=1 TO NUMPTS DO DATA[2,I]:=SLOPE*DATA[2,I]+INT; TWBUC:=TWBUC*SLOPE+INT; BWBUC:=BWBUC*SLOPE+INT; LOY:=SLOPE*LOY+INT; HIY:=SLOPE*HIY+INT; IF CHFLAG THEN BEGIN CHYUC:=SLOPE*CHYUC+INT; CHYSC:=YCOORDSC(CHYUC); END; IF LINFLAG THEN BEGIN LINYUC:=SLOPE*LINYUC+INT; LINYSC:=YCOORDSC(LINYUC); END; END; {IF} END; {IF} END; {PROCEDURE TRANSY} {************************ PROCEDURE CONV *****************************} PROCEDURE CONV(ANG:BOOLEAN); VAR ANS:CHAR; I:INTEGER; BEGIN ANS:='N'; SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1); REPEAT CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1); IF ANG THEN OUTTEXT(CONCAT('Angstrom to cm-1 conversion (Y or N) [',ans,']? ')) ELSE OUTTEXT(CONCAT('cm-1 to Angstrom conversion (Y or N) [',ans,']? ')); GRDCHAR(ANS); UNTIL ANS IN ['Y','y', 'N','n']; IF ANS IN ['Y','y'] THEN BEGIN IF ANG THEN BEGIN {Angstroms to cm-1} FOR I:=1 TO NUMPTS DO DATA[1,I]:=A_TO_CM(DATA[1,I]); XLABEL:='cm-1'; IF CHFLAG THEN BEGIN CHXUC:=A_TO_CM(CHXUC); CHXSC:=XCOORDSC(CHXUC); END; IF LINFLAG THEN BEGIN LINXUC:=A_TO_CM(LINXUC); LINXSC:=XCOORDSC(LINXUC); END; MINX:=A_TO_CM(MINX); MAXX:=A_TO_CM(MAXX); END ELSE BEGIN {cm-1 to Angstroms} FOR I:=1 TO NUMPTS DO DATA[1,I]:=CM_TO_A(DATA[1,I]); XLABEL:='Angstroms'; IF CHFLAG THEN BEGIN CHXUC:=CM_TO_A(CHXUC); CHXSC:=XCOORDSC(CHXUC); END; IF LINFLAG THEN BEGIN LINXUC:=CM_TO_A(LINXUC); LINXSC:=XCOORDSC(LINXUC); END; MINX:=CM_TO_A(MINX); MAXX:=CM_TO_A(MAXX); END; {ELSE} END; {IF} END; {************************ PROCEDURE CHNG_LABELS **********************} PROCEDURE CHNG_LABELS; BEGIN SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1); CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1); OUTTEXT(CONCAT('X axis label [',XLABEL,']? ')); GRDSTR40(XLABEL); MOVETO(3,LINE2); OUTTEXT(CONCAT('Y axis label [',YLABEL,']? ')); GRDSTR40(YLABEL); END; {************************ PROCEDURE SETLIM ***************************} PROCEDURE SETLIM; {Manual setting of window limits.} BEGIN SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1); CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1); OUTTEXT(CONCAT('Left [',RLTOSTR(LWBUC,15),']? ')); GRDREAL(LWBUC); MOVETO(3,LINE2); OUTTEXT(CONCAT('Right [',RLTOSTR(RWBUC,15),']? ')); GRDREAL(RWBUC); CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1); OUTTEXT(CONCAT('Bottom [',RLTOSTR(BWBUC,15),']? ')); GRDREAL(BWBUC); MOVETO(3,LINE2); OUTTEXT(CONCAT('Top [',RLTOSTR(TWBUC,15),']? ')); GRDREAL(TWBUC); REDRAW:=TRUE; END; {************************ PROCEDURE ZOOMOUT **************************} PROCEDURE ZOOMOUT; VAR AMOUNT:REAL; BEGIN SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1); CLRBOX(0,0,GETMAXX,24,TRUE); AMOUNT:=ABS(RWBUC-LWBUC)/2; MOVETO(3,LINE1); OUTTEXT('Expand window horizontally by how many'); MOVETO(3,LINE2); OUTTEXT(CONCAT('units on each side [',RLTOSTR(AMOUNT,15),']? ')); GRDREAL(AMOUNT); IF RWBUC>LWBUC THEN AMOUNT:=ABS(AMOUNT) ELSE AMOUNT:=-ABS(AMOUNT); LWBUC:=LWBUC-AMOUNT; RWBUC:=RWBUC+AMOUNT; REDRAW:=TRUE; END; {*********************** PROCEDURE PAN ******************************} PROCEDURE PAN(S:STR20); VAR AMOUNT:REAL; BEGIN SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1); CLRBOX(0,0,GETMAXX,24,TRUE); AMOUNT:=ABS(RWBUC-LWBUC)/2; MOVETO(3,LINE1); OUTTEXT(CONCAT('Pan ',S,' how many units [',RLTOSTR(AMOUNT,15),']? ')); GRDREAL(AMOUNT); AMOUNT:=ABS(AMOUNT); IF (RWBUC>LWBUC) AND (S='left') THEN AMOUNT:=-AMOUNT; IF (RWBUC0 THEN DELETE(DUMPNAME,I,LENGTH(DUMPNAME)-I+1); DUMPNAME:=CONCAT(DUMPNAME,'.EPS'); SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1); REPEAT CLRBOX(0,0,MAXX,24,TRUE); MOVETO(3,LINE1); OUTTEXT(CONCAT('Postscript screen dump (Y or N) [',ans,']? ')); GRDCHAR(ANS); UNTIL ANS IN ['Y','y', 'N','n']; IF ANS IN ['Y','y'] THEN BEGIN MOVETO(3,LINE2); OUTTEXT(CONCAT('Name of the file (QUIT to abort) [',DUMPNAME,']: ')); GRDSTR20(DUMPNAME); FOR I:=1 TO LENGTH(DUMPNAME) DO DUMPNAME[I]:=UPCASE(DUMPNAME[I]); CLRBOX(0,0,MAXX,24,TRUE); IF EXISTS(DUMPNAME) AND (DUMPNAME <> 'QUIT') THEN BEGIN OUTTEXTXY(3,LINE1,CONCAT('File ',DUMPNAME,' already exists.')); REPEAT MOVETO(3,LINE2); OUTTEXT(CONCAT('Overwrite the existing file (Y or N) [',ANS,']: ')); GRDCHAR(ANS); CLRBOX(0,0,MAXX,24,TRUE); UNTIL ANS IN ['Y','y','N','n']; END; {IF} IF (DUMPNAME='QUIT') THEN ANS:='N'; END; {IF} CLRBOX(0,0,MAXX,24,FALSE); IF ANS IN ['Y','y'] THEN BEGIN ASSIGN(OUTFILE,DUMPNAME); REWRITE(OUTFILE); ERR:=IORESULT; IF ERR<>0 THEN BEGIN CLRBOX(0,0,MAXX,24,TRUE); OUTTEXTXY(3,LINE1,CONCAT('IO error ',INTTOSTR(ERR))); OUTTEXTXY(3,LINE2,'Hit any key to continue.'); REPEAT UNTIL KEYPRESSED; ANS:=READKEY; IF ANS=#0 THEN ANS:=READKEY; END ELSE BEGIN IF CHFLAG THEN BEGIN DRAWCH; DRAWCH; END; IF LINFLAG THEN BEGIN DRAWLN; DRAWLN; END; WRITELN(OUTFILE,'%!PS-ADOBE-2.0'); WRITELN(OUTFILE,'gsave'); WRITELN(OUTFILE,'/picstr 1 string def'); WRITELN(OUTFILE,'27 756 moveto'); WRITELN(OUTFILE,ROUND(7.5*72),' ',ROUND((MAXY+1)/(MAXX+1)*7.5*72), ' scale'); WRITELN(OUTFILE,'0 -1 rmoveto'); WRITELN(OUTFILE,'currentpoint translate'); WRITELN(OUTFILE,MAXX+1,' ',MAXY+1,' 1'); WRITELN(OUTFILE,'[',MAXX+1,' 0 0 ',-MAXY-1,' 0 ',MAXY+1,']'); WRITELN(OUTFILE,'{ currentfile picstr readhexstring pop }'); WRITELN(OUTFILE,'image'); INDEX:=8; VALUE:=0; FOR J:=0 TO MAXY DO FOR I:=0 TO MAXX DO BEGIN IF (J=LINE2+20) AND (I=0) THEN BEGIN CLRBOX(0,0,MAXX,24,TRUE); OUTTEXTXY(3,LINE1,CONCAT('Data is being written to file ', DUMPNAME,'.')); END; INDEX:=INDEX-1; IF GETPIXEL(I,J)<>0 THEN VALUE:=VALUE OR (1 SHL INDEX); IF INDEX=0 THEN BEGIN WRITE(OUTFILE,HEX(NOT VALUE)); INDEX:=8; VALUE:=0; END; END; {FOR} IF INDEX<>8 THEN WRITE(OUTFILE,HEX(NOT VALUE)); WRITELN(OUTFILE); WRITELN(OUTFILE,'grestore showpage'); BEEP(200); END; {ELSE} CLOSE(OUTFILE); END; {IF} CLRBOX(0,0,MAXX,24,FALSE); IF CHFLAG THEN BEGIN DRAWCH; DRAWCH; END; IF LINFLAG THEN BEGIN DRAWLN; DRAWLN; END; {crosshair must be drawn first} END; {************************ PROCEDURE MINMAX *******************************} PROCEDURE MINMAX; {Displays min and max x and y values for displayed data.} VAR I :INTEGER; X,Y :REAL; XMIN,XMAX,YMIN,YMAX :REAL; START :BOOLEAN; CH :CHAR; BEGIN I:=FIRST; START:=TRUE; REPEAT X:=XDATAVAL(I); Y:=FILTER(FILDERIV,I); IF (XCOORDSC(X)>SCRLEFT)AND(XCOORDSC(X)XMAX THEN XMAX:=X; IF XYMAX THEN YMAX:=Y; IF YLAST; SETTEXTJUSTIFY(LEFTTEXT,TOPTEXT); SETTEXTSTYLE(DEFAULTFONT,HORIZDIR,1); CLRBOX(0,0,GETMAXX,24,TRUE); MOVETO(3,LINE1); OUTTEXT(CONCAT('x: Min=',RLTOSTR(XMIN,15),' Max=',RLTOSTR(XMAX,15))); MOVETO(3,LINE2); OUTTEXT(CONCAT('y: Min=',RLTOSTR(YMIN,15),' Max=',RLTOSTR(YMAX,15), ' to continue')); REPEAT CH:=READKEY UNTIL CH=CHAR(13); CLRBOX(0,0,GETMAXX,24,FALSE); MOVETO(3,LINE1); IF CHFLAG THEN BEGIN DRAWCH; DRAWCH; END; IF LINFLAG THEN BEGIN DRAWLN; DRAWLN; END; {crosshair must be drawn first} END; {PROCEDURE MINMAX} {************************** NONLINEAR ***********************************} PROCEDURE NONLINEAR(XY:CHAR); VAR ANS,I,WHICH : INTEGER; MAX,MIN,VAL : REAL; FUNCTION CONVERT(X:SINGLE):SINGLE; CONST XMIN=2.9E-39*100; XMAX=1.7E38/100; BEGIN CASE ANS OF 1: IF XSQR(XMIN) THEN CONVERT:=SQRT(ABS(X)) ELSE CONVERT:=XMIN; 3: IF ABS(X)>0 THEN CONVERT:=LN(ABS(X)) ELSE CONVERT:=-XMAX; 4: IF ABS(X)>0 THEN CONVERT:=LOG(ABS(X)) ELSE CONVERT:=-XMAX; 5: IF ABS(X)0 THEN CONVERT:=XMAX ELSE IF X<0 THEN CONVERT:=0; 6: IF ABS(X)0 THEN CONVERT:=XMAX ELSE IF X<0 THEN CONVERT:=0; ELSE CONVERT:=X; END; {case} END; {FUNCTION CONVERT} BEGIN RESTORECRTMODE; ANS:=0; WHICH:=ORD(XY='Y')+1; WRITELN('Nonlinear transformation of ',xy,' axis.'); WRITELN; WRITELN('The following transformations are available.'); WRITELN(' 0. None.'); WRITELN(' 1. Sqr(',xy,').'); WRITELN(' 2. Sqrt(|',XY,'|).'); WRITELN(' 3. Ln(|',XY,'|).'); WRITELN(' 4. Log(|',XY,'|).'); WRITELN(' 5. Exp(',XY,').'); WRITELN(' 6. 10^(',XY,').'); WRITE('Select one [',ans,']: '); RDINTLN(OUTPUT,ANS); IF ANS IN [1..6] THEN BEGIN MAX:=CONVERT(DATA[WHICH,1]); MIN:=MAX; FOR I:=1 TO NUMPTS DO BEGIN VAL:=CONVERT(DATA[WHICH,I]); IF VALMAX THEN MAX:=VAL; DATA[WHICH,I]:=VAL; END; {FOR} MAX:=MAX+ABS(MAX-MIN)/40; MIN:=MIN-ABS(MAX-MIN)/40; IF XY='X' THEN BEGIN RWBUC:=MAX; LWBUC:=MIN; MINX:=MIN; MAXX:=MAX; END ELSE BEGIN TWBUC:=MAX; BWBUC:=MIN; LOY:=MIN; HIY:=MAX; END; IF CHFLAG THEN IF XY='X' THEN CHXUC:=CONVERT(CHXUC) ELSE CHYUC:=CONVERT(CHYUC); IF LINFLAG THEN IF XY='X' THEN LINXUC:=CONVERT(LINXUC) ELSE LINYUC:=CONVERT(LINYUC); NEWMODE:=TRUE; END; {IF ANS} SETGRAPHMODE(GETGRAPHMODE); REDRAW:=TRUE; END; {PROCEDURE NONLINEAR} {************************ PROCEDURE HELP *****************************} PROCEDURE HELP; {Provides display of key assignments.} VAR UD,LR:STRING[3]; BEGIN RESTORECRTMODE; LR:=CONCAT(CHAR(26),'/',CHAR(27)); UD:=CONCAT(CHAR(24),'/',CHAR(25)); WRITELN(' F1: Crosshair CTRL F1: Ruler'); WRITELN(' F2: Circle points CTRL F2: Connect-the-dots'); WRITELN(' F3: Filter parameters CTRL F3: Integrate'); WRITELN(' F4: Crosshair trace CTRL F4: Labels'); WRITELN(' F5: Dump to file CTRL F5: Postscript screen dump'); WRITELN(' F6: X linear transform CTRL F6: Y linear transform'); WRITELN(' F7: Left/right invert CTRL F7: Top/bottom inversion'); WRITELN(' F8: Angstrom to cm-1 CTRL F8: cm-1 to Angstroms'); WRITELN(' N: X nonlinear transform ALT N: Y nonlinear transform'); WRITELN(' M: Min/max'); WRITELN(' D: DOS command H: Help'); WRITELN('WINDOW CONTROL:'); WRITELN(' PG UP/PG DN: Faster/slower ',UD,': Expand/contract'); WRITELN(' ',LR,': Horizontal HOME/END: Vertical'); WRITELN(' expand/contract expand/contract'); WRITELN(' CTRL ',LR,': Left/right CTRL ',UD,': Up/down'); WRITELN(' ENTER/+/SPACE: Zoom CTRL ENTER: Original plot'); WRITELN(' L: Limits X: Expand horizontally'); WRITELN(' F9: Pan left F10: Pan right'); WRITELN('CROSSHAIR CONTROL:'); WRITELN(' 7/8: faster/slower 9/0: up/down -/=: left/right'); WRITELN('RULER CONTROL:'); WRITELN(' 3/4: up/down 5/6: Left/right Q/W: Shorter/longer'); WRITELN(' 1/2: rotate E: FWHM position R: Horizontal/vertical'); WRITE(' to continue.'); READLN; SETGRAPHMODE(GETGRAPHMODE); REDRAW:=TRUE; END; {************************** MAIN PROGRAM *****************************} BEGIN {Set up the graphics window.} CLRSCR; {clear the screen} GRAPHDRIVER:=0; {autodetect graphics device} INITGRAPH(GRAPHDRIVER,GRAPHMODE,DRIVERS); ERRCODE:=GRAPHRESULT; IF ERRCODE<>0 THEN BEGIN BEEP(200); WRITELN('Graphics error: ',grapherrormsg(errcode)); WRITE('Hit any key to continue. '); READLN; END; IF ERRCODE=0 THEN BEGIN {Initialize} FIRST:=1; LAST:=NUMPTS; BWBUC:=LOY; TWBUC:=HIY; LWBUC:=MINX; RWBUC:=MAXX; LWBIC:=1; RWBIC:=NUMPTS; XLABEL:='X'; YLABEL:='Y'; NEWMODE:=FALSE; DONEFLAG:=FALSE; ELIPSFLAG:=FALSE; FRAME:=FALSE; LINEFLAG:=TRUE; WINDSENS:=20; LINFLAG:=FALSE; CHFLAG:=FALSE; CHSENS:=20; TRACE:=FALSE; FILTYPE:=0; FILDEGREE:=2; FILWIDTH:=1; FILDERIV:=0; STEPSIZE:=1; {initialize crosshair and line to center of window} CHXSC:=ROUND((SCRLEFT+GETMAXX)/2); CHYSC:=ROUND((GETMAXY-SCRBOTTOM+SCRTOP)/2); LINXSC:=CHXSC; LINYSC:=CHYSC; LINLEN:=30; THETA:=0.0; TRACE:=FALSE; REPEAT {UNTIL DONEFLAG} REDRAW:=FALSE; {initialize window boundaries in screen coords} LWBSC:=SCRLEFT; RWBSC:=GETMAXX; BWBSC:=GETMAXY-SCRBOTTOM; TWBSC:=SCRTOP; {clear window} CLEARDEVICE; SETWRITEMODE(XORPUT); IF NEWMODE THEN BEGIN {redefine bounds in new user coords} NEWMODE:=FALSE; LWBUC:=XDATAVAL(LWBIC); RWBUC:=XDATAVAL(RWBIC); END; {IF NEWMODE} {determine min and max x axis values} IF (RWBUC>LWBUC) THEN BEGIN LOXUC:=LWBUC; HIXUC:=RWBUC; END ELSE BEGIN LOXUC:=RWBUC; HIXUC:=LWBUC; END; {determine first and last points} LIMITS(LOXUC,HIXUC,FIRST,LAST,LWBIC,RWBIC); {determine screen positions of crosshair and line} IF (CHXUC>HIXUC) OR (CHXUCHIXUC) OR (LINXUCBWBUC) THEN BEGIN IF (CHYUC>TWBUC) OR (CHYUCTWBUC) OR (LINYUCBWBUC) THEN CHYSC:=ROUND((BWBSC+TWBSC)/2) ELSE CHYSC:=YCOORDSC(CHYUC); IF (LINYUCBWBUC) THEN LINYSC:=CHYSC ELSE LINYSC:=YCOORDSC(LINYUC); END; IF TRACE THEN SETCHY; {plot the data} RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC); LABELS; AXIS(LWBUC,RWBUC,BWBUC,TWBUC,LWBSC,RWBSC,BWBSC,TWBSC,XLABEL,YLABEL); SCRNDRAW(ELIPSFLAG,STEPSIZE); {overlay the remaining stuff} IF CHFLAG THEN DRAWCH; IF LINFLAG THEN DRAWLN; {crosshair must be drawn first} REPEAT {UNTIL REDRAW OR DONEFLAG} REPEAT UNTIL KEYPRESSED; ASCII:=ORD(READKEY); CASE ASCII OF 0 : BEGIN SCANCODE:=ORD(READKEY); CASE SCANCODE OF {F1} 59: BEGIN {toggle crosshair display} CHFLAG:=NOT CHFLAG; IF (TRACE AND CHFLAG) THEN SETCHY; DRAWCH; END; {CTRL F1} 94: BEGIN {toggle line on/off} LINFLAG:=NOT LINFLAG; DRAWLN; END; {F2} 60: BEGIN {toggle ellipse display} REDRAW:=TRUE; IF ELIPSFLAG THEN ELIPSFLAG:=FALSE ELSE ELIPSFLAG:=TRUE; IF NOT(ELIPSFLAG OR LINEFLAG) THEN LINEFLAG:=TRUE; END; {CTRL F2} 95: BEGIN {toggle connect the dots} REDRAW:=TRUE; IF LINEFLAG THEN LINEFLAG:=FALSE ELSE LINEFLAG:=TRUE; IF NOT(LINEFLAG OR ELIPSFLAG) THEN ELIPSFLAG:=TRUE; END; {F3} 61: BEGIN {change filter parameters} CHANGEFILTER; REDRAW:=TRUE; END; {CTRL F3} 96: BEGIN {peak integration} IF LINFLAG THEN INTEGRATE; END; {F4} 62: IF CHFLAG THEN BEGIN {toggle crosshair trace mode} DRAWCH; {erase existing ch} TRACE:=NOT TRACE; IF TRACE THEN SETCHY; DRAWCH; LABELS; END; {CTRL F4} 97: BEGIN {change axis labels} CHNG_LABELS; REDRAW:=TRUE; END; {F5} 63: BEGIN {dump displayed data to a file} DUMP_TEXT; LABELS; END; {CTRL F5} 98: POST; {postscript screen dump} {F6} 64: BEGIN {x axis linear transformation} TRANSX; NEWMODE:=TRUE; REDRAW:=TRUE; END; {CTRL F6} 99: BEGIN {y axis linear transformation} TRANSY; NEWMODE:=TRUE; REDRAW:=TRUE; END; {PG UP - increase window movement sensitivity} 73,132: BEGIN CASE WINDSENS OF 1: WINDSENS:=2; 2:WINDSENS:=5; 5:WINDSENS:=10; 10: WINDSENS:=20; 20:WINDSENS:=50; END; {CASE} BEEP(200*WINDSENS); END; {PG DN - decrease window movement sensitivity} 81,118: BEGIN CASE WINDSENS OF 50:WINDSENS:=20; 20:WINDSENS:=10; 10:WINDSENS:=5; 5:WINDSENS:=2; 2:WINDSENS:=1; END; {CASE} BEEP(200*WINDSENS); END; {CTRL HOME - translate window up} 119:IF (TWBSC-WINDSENS)>=SCRTOP THEN BEGIN RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC); TWBSC:=TWBSC-WINDSENS; BWBSC:=BWBSC-WINDSENS; FRAME:=TRUE; END; {CTRL END - translate window down} 117:IF (BWBSC+WINDSENS)<=(GETMAXY-SCRBOTTOM) THEN BEGIN RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC); TWBSC:=TWBSC+WINDSENS; BWBSC:=BWBSC+WINDSENS; FRAME:=TRUE; END; {CTRL LEFT ARROW - translate window left} 115:IF (LWBSC-WINDSENS)>=SCRLEFT THEN BEGIN RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC); LWBSC:=LWBSC-WINDSENS; RWBSC:=RWBSC-WINDSENS; FRAME:=TRUE; END; {CTRL RIGHT ARROW - translate window to right} 116:IF (RWBSC+WINDSENS)<=GETMAXX THEN BEGIN RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC); RWBSC:=RWBSC+WINDSENS; LWBSC:=LWBSC+WINDSENS; FRAME:=TRUE; END; {LEFT ARROW - contract window horizontally} 75: IF (RWBSC-LWBSC)>(2*WINDSENS) THEN BEGIN RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC); RWBSC:=RWBSC-WINDSENS; LWBSC:=LWBSC+WINDSENS; FRAME:=TRUE; END; {RIGHT ARROW - expand window horizontally} 77: IF ((LWBSC-WINDSENS)>=SCRLEFT) AND ((RWBSC+WINDSENS)<=GETMAXX) THEN BEGIN RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC); LWBSC:=LWBSC-WINDSENS; RWBSC:=RWBSC+WINDSENS; FRAME:=TRUE; END; {END -contract window vertically} 79: IF (BWBSC-TWBSC)>(2*WINDSENS) THEN BEGIN RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC); TWBSC:=TWBSC+WINDSENS; BWBSC:=BWBSC-WINDSENS; FRAME:=TRUE; END; {HOME - expand window vertically} 71: IF ((BWBSC+WINDSENS)<=GETMAXY) AND ((TWBSC-WINDSENS)>=SCRTOP) THEN BEGIN RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC); BWBSC:=BWBSC+WINDSENS; TWBSC:=TWBSC-WINDSENS; FRAME:=TRUE; END; {UP ARROW - expand window} 72: IF ((BWBSC+WINDSENS)<=GETMAXY) AND ((TWBSC-WINDSENS)>=SCRTOP) AND ((LWBSC-WINDSENS)>=SCRLEFT) AND ((RWBSC+WINDSENS)<=GETMAXX) THEN BEGIN RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC); BWBSC:=BWBSC+WINDSENS; TWBSC:=TWBSC-WINDSENS; LWBSC:=LWBSC-WINDSENS; RWBSC:=RWBSC+WINDSENS; FRAME:=TRUE; END; {DOWN ARROW - contract window} 80:IF ((RWBSC-LWBSC)>(2*WINDSENS)) AND ((BWBSC-TWBSC)>(2*WINDSENS)) THEN BEGIN RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC); RWBSC:=RWBSC-WINDSENS; LWBSC:=LWBSC+WINDSENS; TWBSC:=TWBSC+WINDSENS; BWBSC:=BWBSC-WINDSENS; FRAME:=TRUE; END; {F7} 65: BEGIN {left/right inversion} OLDLWBUC:=LWBUC; LWBUC:=RWBUC; RWBUC:=OLDLWBUC; REDRAW:=TRUE; END; {CTRL F7} 100:BEGIN {top/bottom inversion} OLDBWBUC:=BWBUC; BWBUC:=TWBUC; TWBUC:=OLDBWBUC; REDRAW:=TRUE; END; {F8} 66: BEGIN {Angstrom to cm-1 conversion} CONV(TRUE); NEWMODE:=TRUE; REDRAW:=TRUE; END; {CTRL F8} 101:BEGIN {cm-1 to Angstrom conversion} CONV(FALSE); NEWMODE:=TRUE; REDRAW:=TRUE; END; {F9} 67: PAN('left'); {F10} 68: PAN('right'); {ALT N} 49: NONLINEAR('Y'); {y axis nonlinear transformation} END; {CASE} END; {ESC} 27: DONEFLAG:=TRUE; {ENTER, +, or SPACE - zoom} 13,43,32: BEGIN REDRAW:=TRUE; OLDLWBUC:=LWBUC; OLDBWBUC:=BWBUC; LWBUC:=OLDLWBUC+((RWBUC-OLDLWBUC)*((LWBSC-SCRLEFT)/ (GETMAXX-SCRLEFT))); RWBUC:=OLDLWBUC+((RWBUC-OLDLWBUC)*((RWBSC-SCRLEFT)/ (GETMAXX-SCRLEFT))); BWBUC:=OLDBWBUC+(TWBUC-OLDBWBUC)*(BWBSC-GETMAXY+SCRBOTTOM)/ (SCRTOP-GETMAXY+SCRBOTTOM); TWBUC:=OLDBWBUC+(TWBUC-OLDBWBUC)*(TWBSC-GETMAXY+SCRBOTTOM)/ (SCRTOP-GETMAXY+SCRBOTTOM); END; {0} 48: {crosshair up} IF CHFLAG AND ((CHYSC-CHSENS)>=SCRTOP) THEN BEGIN DRAWCH; CHYSC:=CHYSC-CHSENS; DRAWCH; END; {9} 57: {crosshair down} IF CHFLAG AND ((CHYSC+CHSENS)<=(GETMAXY-SCRBOTTOM)) THEN BEGIN DRAWCH; CHYSC:=CHYSC+CHSENS; DRAWCH; END; {=} 61: {crosshair right} IF CHFLAG AND ((CHXSC+CHSENS)<=GETMAXX) THEN BEGIN DRAWCH; CHXSC:=CHXSC+CHSENS; IF TRACE THEN SETCHY; DRAWCH; END; {-} 45: {crosshair left} IF CHFLAG AND ((CHXSC-CHSENS)>=SCRLEFT) THEN BEGIN DRAWCH; CHXSC:=CHXSC-CHSENS; IF TRACE THEN SETCHY; DRAWCH; END; {8} 56: BEGIN {increase crosshair sensitivity} CASE CHSENS OF 1 :CHSENS:=2; 2:CHSENS:=5; 5:CHSENS:=10; 10:CHSENS:=20; 20:CHSENS:=50; END; {CASE} BEEP(200*CHSENS); END; {7} 55: BEGIN {decrease crosshair sensitivity} CASE CHSENS OF 50:CHSENS:=20; 20:CHSENS:=10; 10:CHSENS:=5; 5:CHSENS:=2; 2:CHSENS:=1; END; {CASE} BEEP(200*CHSENS); END; {line} 49,50,51,52,53,54,81,87,82,69,113,119,101,114: IF LINFLAG THEN BEGIN DRAWLN; CASE ASCII OF {1} 49:BEGIN {rotate counterclockwise} THETA:=THETA+CHSENS/LINLEN*2; THETA:=THETA-TRUNC(THETA/(2*PI))*2*PI; END; {2} 50:BEGIN {rotate line clockwise} THETA:=THETA-CHSENS/LINLEN*2; THETA:=THETA-TRUNC(THETA/(2*PI))*2*PI; END; {3} 51:LINYSC:=LINYSC+CHSENS; {translate line down} {4} 52:LINYSC:=LINYSC-CHSENS; {translate line up} {5} 53:LINXSC:=LINXSC-CHSENS; {translate line to left} {6} 54:LINXSC:=LINXSC+CHSENS; {translate line to right} {Q} 81,113:LINLEN:=ABS(LINLEN-CHSENS); {shorten line} {W} 87,119:LINLEN:=ABS(LINLEN+CHSENS); {lengthen line} {E} 69,101:IF CHFLAG THEN BEGIN {move line to FWHM position} LINYSC:=ROUND((CHYSC+LINYSC+TAN(THETA)*(CHXSC-LINXSC))/2); LINXSC:=CHXSC; END; {R} 82,114:IF THETA=0 THEN THETA:=PI/2 {vertical/horizontal} ELSE THETA:=0; END; {CASE} DRAWLN; END; {IF LINFLAG} {H} 72,104: HELP; {L} 76,108: SETLIM; {user specified window bounds} {M} 77,109: MINMAX; {max and min of displayed data} {N} 78,110: NONLINEAR('X'); {x axis nonlinear transform} {X} 88,120: ZOOMOUT; {zoom out horizontally} {D} 68,100: BEGIN {execute a DOS command} RESTORECRTMODE; DOS_CMD; SETGRAPHMODE(GETGRAPHMODE); REDRAW:=TRUE; END; {CTRL ENTER - return to original plot} 10: BEGIN REDRAW:=TRUE; FIRST:=1; LAST:=NUMPTS; BWBUC:=LOY; TWBUC:=HIY; LWBUC:=MINX; RWBUC:=MAXX; END; END; {CASE} IF FRAME THEN BEGIN RECTANGLE(LWBSC,TWBSC,RWBSC,BWBSC); FRAME:=FALSE; END; UNTIL REDRAW OR DONEFLAG; UNTIL DONEFLAG; END; {IF} CLOSEGRAPH; END; {GRAF} END. {UNIT}