1 '871129- PUT GRAPHICS PARAM FROM SCED_CGA IN MODIFIED Z-100 SCEDHP-10 2 '871129/30- CHANGED PPNM FOR 10 POINTS/NM, DIM FOR 2048 PTS. FACTOR=1/100 3 '890827- FIXED INTEGRATE, DIFFERENTIATE 10 CONST SMAX=30,PMAX=5501,FSMAX=0,FPMAX=0:'DIMENSION:NUMBER OF SPECTRA, 11 ' POINTS PER SPECTRUM; FOR TRACES AND FOR BASIS (FITTING) SPECTRA. 14 CONST DWL%=300:'DIMENSION OF VARIABLE 'WL' USED TO STORE OD READINGS. 15 'CONST FACTOR=2124/65536:'ABSORBANCE SCALE: mAU/LEAST SIGNIFICANT BIT 17 'CONST SCR%=8:TXCOL%=3:AXCOL%=6:BKCOL%=0 18 CONST BAUD=9600:'COM1 BAUD RATE 20 CONST PPNM%=10:'INTERNAL WL UNITS 1/10 NM 26 CONST CANC$="*" 27 NUL$=CHR$(0):LARROW$=NUL$+CHR$(75):RARROW$=NUL$+CHR$(77):BSP$=CHR$(8) 28 CR$=CHR$(13):SP1$=" ":'LINES 27,28 FOR EDIT LINE, LINE 20430. CR$ ALSO SCAN BSL 29 SP$=SPACE$(79) 30 DRIVE%=2:'DRIVE B DEFAULT FOR DATA. THIS SHOULD BE WITH DEFAULT PARAM! 31 ' 32 'SCREEN GRAPHICS FOR EGA SCREEN 9) ' SCR%= 8:LSTLINE%=25:PIXPLIN%=8:PXPC%=8:RE%=639 ' SCR%= 9:LSTLINE%=25:PIXPLIN%=14:PXPC%=8:RE%=639 SCR%=12:LSTLINE%=30:PIXPLIN%=16:PXPC%=8:RE%=639 TXCOL%=3:AXCOL%=6:BKCOL%=0 TLINE%=LSTLINE%-5:NLINE%=TLINE%-1 BE%=LSTLINE%*PIXPLIN%-1 TST%=1+BE%-(6*PIXPLIN%):TSB%=BE%-PIXPLIN%:' LM%=0:RM%=RE%:TM%=0:BM%=BE%-(7*PIXPLIN%):' LL%=LM%+5:RL%=RM%-5:TL%=TM%+5:BL%=BM%-5 '$DYNAMIC 100 DIM A%(PMAX,SMAX) 'DIM B%(5001,6)'30 ok FOR NT, WIN98 LIMIT 18X3101? 'B% USED FOR CONVERTING OLIS FILES. SHDZ ONLY USES ONE TRACE. '$STATIC 'SET UP FOR QB's INTERRUPT CALL TYPE REGTYPE AX AS INTEGER BX AS INTEGER CX AS INTEGER DX AS INTEGER BP AS INTEGER SI AS INTEGER DI AS INTEGER FLAGS AS INTEGER DS AS INTEGER ES AS INTEGER END TYPE dim inregs as regtype, outregs as regtype DIM CMMNT$(SMAX):REM DATA, COMMENTS 110 DIM WL(DWL%),AB%(30,2),T$(2),SYMBOL(10,10,2),DASH$(25),COLR$(8) 120 DIM C#(3,3),B(3),PEN$(3) 200 GOSUB 15000:'INITIALIZE 300 print command$ if command$="" then 900 A$=COMMAND$ ' even though routine for ascii files doesnt need it, get disk and path to set 'IF RIGHT$(A$,4)=".MAT" THEN N$=A$:F=1.:A$="Y":GOSUB 5050:GOSUB 4300:GOTO 1000 I%=0 330 I%=I%+1 IF MID$(A$,I%,1)=":" THEN 350 IF I%0 THEN PATH$=LEFT$(A$,J%-1):A$=MID$(A$,J%+1) IF RIGHT$(PATH$,1)=":" THEN PATH$=PATH$+"\" PRINT "J%=";J%,"PATH=";PATH$ PRINT "NAME=";A$ 'PATH$=PATH$+CHR$(0):'MAKE ROOM FOR ENDOFSTRING MARKER (ONLY FOR AL CHDIR?) CHDIR PATH$ IF RIGHT$(A$,4)=".MAT" THEN N$=COMMAND$:F=1.:A$="Y":GOSUB 5050:GOSUB 4300:GOTO 900 IF RIGHT$(A$,4)=".SPC" THEN 'FACTOR=6000!/65536! 'FACTOR=8000!/65536! X=FACTOR CALL READSHDZ(A%(),X,PPNM%,DRIVE%,A$):GOTO 12440 N$=COMMAND$:F=1.:A$="Y":GOSUB 5050:GOSUB 4300:GOTO 900 ENDIF 'FIND LAST HYPHEN 'REMOVE DOT FROM FILENAME J%=0 FOR I%=1 TO LEN(A$) IF MID$(A$,I%,1)="." THEN J%=I% NEXT I% IF J%>0 THEN A$=LEFT$(A$,J%-1)+MID$(A$,J%+1) PRINT A$ 352 J%=0 FOR I%=1 TO LEN(A$) IF MID$(A$,I%,1)="-" THEN J%=I% NEXT I% IF J%=0 THEN FLN$=A$:GOSUB 4590:GOTO 1000 '10770 INPUT"ENTER BASENAME, NUMBER FOR FIRST FILE: ",B$,N1% B$=LEFT$(A$,J%-1):N1%=VAL(MID$(A$,J%+1)) PRINT "B$=";B$,"N1%=",N1% 'INPUT A$ GOSUB 10775 'OPEN PRINT LOG (USED ONLY FOR PRINTING COMMENTS LISTS) 'THIS WAS ALREADY OPENED IN 15000 INITIALIZATION! 900 'OPEN "O",6,"SCANLOG.PRN" 'directory may be readonly- don't open unless needed, ask user for valid path. 1000 'KEYBOARD COMMAND MONITOR 1005 GOSUB 20140 :REM CLEAR TEXTSCREEN 1007 IF TCOUNT%=SMAX% THEN PRINT"*****/ ALL TRACES FULL /*****" 1010 PRINT"(1) LIST TO PRINTER","(4) SHIFT SPECTRA ", "(7) FILE SPECTRUM" 1015 PRINT"(2) SHOW/SET PARAMETERS","(5) SET FACTOR ", "(8) LOAD SPECTRUM" 1020 PRINT"(3) SMOOTH SPECTRA","(6) MANIPULATE SPEC", "(9) MORE MENU "; 1025 A$=INKEY$:IF A$=""THEN 1025 1030 IF A$="9"THEN LOCATE TLINE%,1:GOTO 1050 1035 GOSUB 20140:REM CLEAR TEXTSCREEN 1040 ON VAL(A$) GOSUB 2000,2200,2510,3300,1200,3600,4400,4550 1045 GOTO 1000 1050 PRINT"(1) CLEAR SCREEN","(4) SET VERT SCALE", "(7) CHANGE DATA DRIVE" 1055 PRINT"(2) PLOT on PAPER" ,"(5) LIST SPECTRA ", "(8) PRINT TABLE " 1060 PRINT"(3) FILE ASCII 2","(6) FILE ASCII ", "(9) MORE MENU "; 1065 A$=INKEY$:IF A$=""THEN 1065 1070 IF A$="9" THEN LOCATE TLINE%,1:GOTO 1090 1080 ON VAL(A$) GOSUB 20100,5400,8300,8800,9000,9200,10000,10100 1085 GOTO 1000 1090 PRINT"(1) LOAD/SAVE ALL","(4) SUBTRCT FROM ALL","(7) ORDER VDISP " 1095 PRINT"(2) LOAD BASELINE","(5) LOAD INTO TRACE ","(8) QUIT " 1100 PRINT"(3) AVERAGE II ","(6) CHANGE WL SCALE", "(9) MORE MENU "; 1105 A$=INKEY$:IF A$=""THEN 1105 1110 IF A$="9" THEN LOCATE TLINE%,1:GOTO 1125 1115 GOSUB 20140:REM CLEAR TEXTSCREEN 1120 ON VAL(A$) GOSUB 10700,4480,11100,11400,14550,11800,11900,12400 1122 GOTO 1000 1125 PRINT"(1) IMPORT SPECTR","(4) DIFFERENTIATE SPEC.","(7) MAKE DIRECTORY " 1130 PRINT"(2) CHANGE SCREEN","(5) SHELL ", "(8) CHANGE DIRECTORY " 1135 PRINT"(3) INTEGRATE SPECTRA","(6) DIRECTORY ","(9) FIRST MENU "; 1140 A$=INKEY$:IF A$=""THEN 1140 1145 IF A$="9" THEN 1000 1150 GOSUB 20140:REM CLEAR TEXTSCREEN 1155 ON VAL(A$) GOSUB IMPORT,22000,12500,2500,13100,13000,12800,12900 1160 GOTO 1000 1200 PRINT "SET INTEGER SCALE FACTOR: mAU/LSB PRINT "CURRENT SCALE FACTOR:";FACTOR*65536;" mAU/65536 LSB" PRINT "A: 2124 (OLD AMINCO SCALE)" PRINT "B: 4000 (PRACTICAL SCALE)" PRINT "C: 6000 (SHIMADZU)" PRINT "D: 8496 (Old Aminco scale with values already divided by 4)" PRINT "SELECT THE LETTER OR ENTER INTEGER #mAU /65536 LSB ( TO KEEP OLD):" INPUT A$ IF A$="" THEN RETURN IF VAL(A$)<>0 THEN FACTOR=VAL(A$)/65536!:GOTO 8890 IF UCASE$(A$)="A" THEN FACTOR=2124!/65536!:GOTO 8890 IF UCASE$(A$)="B" THEN FACTOR=4000!/65536!:GOTO 8890 IF UCASE$(A$)="C" THEN FACTOR=6000!/65536!:GOTO 8890 IF UCASE$(A$)="D" THEN FACTOR=8496!/65536!:GOTO 8890 RETURN 1998 ' 1999 ' 2000 REM LIST TRACES TO PRINTER 2010 INPUT"ENTER BASENAME, NUMBER FOR FIRST FILE: ",B$,N1% 2020 K%=TCOUNT%+1:IF K%>SMAX% THEN PRINT"NO ROOM!" :RETURN 2030 CMMNT$(K%)=SPACE$(64) GOTO 2130 :'PRINT TO LOGFILE INSTEAD LPRINT 2040 FLN$=B$+"-"+MID$(STR$(N1%),2) 2050 CALL DISKREAD (DRIVE%,FLN$,SEG A%(1,K%),NNPOINTS%,NSWL%,NINC%,CMMNT$(K%),ER%) 2060 IF ER%<>0 THEN RETURN 2070 LOCATE TLINE%+1,1:PRINT FLN$ 2080 LPRINT FLN$;"-",CMMNT$(K%) 2090 IF INTERACTIVE% THEN IF INKEY$="Q" THEN RETURN 2100 N1%=N1%+1 2110 GOTO 2040 :'KEEP READING UNTIL READ FAILS OR ALL TRACES FULL IMPORT: IF TCOUNT%<>0 THEN PRINT "TRACES IN MEMORY WILL BE LOST- TO CANCEL" INPUT"IMPORT WHAT FORMAT: (O)LIS, (S)HIMADZU, ETC";A$ A$= UCASE$(LEFT$(A$,1)) X=FACTOR:'PRINT"X=";X:'factor is a constant, so cant be passed this way. IF A$="O" THEN CALL READOLIS(A%(),X,PPNM%,DRIVE%):RETURN IF A$="S" THEN B$="":CALL READSHDZ(A%(),X,PPNM%,DRIVE%,B$):RETURN PRINT"CAN'T READ THAT FORMAT YET!":INPUT "OK";A$ RETURN 2130 REM LIST TRACES TO LOGFILE:'OR ASK USER FOR FILENAME. input "path/filename for list (comments.txt)";flname$ if flname$="" then flname$="comments.txt" OPEN "O",6,flname$ PRINT#6, 2140 FLN$=B$+"-"+MID$(STR$(N1%),2) CALL DISKREAD (DRIVE%,FLN$,SEG A%(1,K%),NNPOINTS%,NSWL%,NINC%,CMMNT$(K%),ER%) IF ER%<>0 THEN 2144 LOCATE TLINE%+1,1:PRINT FLN$ PRINT#6, FLN$;"-",CMMNT$(K%) IF INTERACTIVE% THEN IF INKEY$="Q" THEN 2144 N1%=N1%+1 GOTO 2140 :'KEEP READING UNTIL READ FAILS OR ALL TRACES FULL 2144 close #6 RETURN 2199 ' 2200 'SET PARAMETERS: IF TCOUNT%>0 THEN PRINT "Present traces will be forgotten if param changed!" PRINT "DIMENSIONED FOR";SMAX%;" SPECTRA OF";PMAX;" POINTS EACH". 2240 PRINT"PARAMETERS: OLD VALUE IN PARENTHESES. CR TO LEAVE, OR ENTER NEW VALUE:" 2250 EWL%=SWL%+INC%*(NPOINTS%-1) 2260 PRINT"STARTING WAVELENGTH(";SWL%/PPNM%;")";:INPUT A$ 2270 IF A$=";" THEN 2430 2280 IF A$ <>"" THEN SWL% = PPNM%*VAL(A$):tcount%=0:REM USE UNITS OF 1/PPNM% nM 2290 PRINT"ENDING WAVELENGTH(";EWL%/PPNM%;")";:INPUT A$ 2300 IF A$=";" THEN 2430 2310 IF A$ <>"" THEN EWL% = PPNM%*VAL(A$):tcount%=0 2320 PRINT "HOW MANY POINTS/NM (10,5,2,1 ETC.; DEFAULT";PPNM%/INC%;")";:INPUT A$ 2330 IF A$=";"THEN 2430 2340 IF A$<>""THEN INC%=PPNM%/VAL(A$):tcount%=0:REM MEASURE AT EVERY INC%'TH EIGHTH OF A NM if tcount%=0 then:'(re)calculate secondary parameters 2430 NPOINTS%=(EWL%-SWL%)/INC%+1 2440 PFLAG%=1:BFLAG%=0:REM MUST SCAN BASELINE PNT1%=1:PNT2%=NPOINTS% ' tcount%=0 endif IF NPOINTS%>PMAX% THEN PRINT"TOO MANY POINTS!":GOTO 2200 2450 WL1%=SWL%:WL2%=SWL%+INC%*(NPOINTS%-1):GOSUB 20100:'SET SCALE, CLEAR SCREEN 2470 RETURN 2498 ' 2499 ' 2500 'TAKE DERIVATIVES OF SPECTRUM 2502 PRINT"FOR EACH POINT OF THE SPECTRUM, AN INTERVAL ABOUT THAT POINT IS FIT WITH" 2503 PRINT"A CUBIC POLYNOMIAL. THE DERIVATIVES OF THE Pn AT THAT POINT ARE TAKEN AS" 2504 PRINT"THE DERIVATIVES OF THE SPECTRUM AT THAT POINT. 0'TH-3'D DERIVATIVES ARE PUT" 2505 'PRINT"IN THE NEXT AVAILABLE TRACES. 0'TH DERIVATIVE IS SMOOTHED SPECTRUM." 2506 NN%=SMAX%-(TCOUNT%+1):IF NN%<1 THEN LINE INPUT"TRACES NOT AVAILABLE! CR TO RETURN";A$:RETURN 2507 A$="P":GOTO 2515 2509 ' 2510 'SMOOTH SPECTRA, LEAVING OLD TRACE, RESULT IN NEXT AVAILABLE 2511 NN%=0 2512 INPUT "SMOOTH BY (G)EOMETRIC, OR (P)OLYNOMIAL ALGORITHM";A$ 2513 ' 2514 'COMBINED DIFFERENTIATE AND SMOOTH ROUTINES: 2515 INPUT"NUMBER OF TRACE TO SMOOTH OR DIFFERENTATE";K% 2516 IF NN%>0 THEN GOSUB 20140:PRINT"DIFFERENTIATE "; 2517 PRINT K%;CMMNT$(K%) 2520 INPUT"NUMBER OF POINTS ON EACH SIDE TO BE USED";N1% 2530 N2%=1+2*N1%:'NUMBER OF POINTS FROM -N1% TO N1% INCLUSIVE 2540 TCOUNT%=TCOUNT%+1:'PUT RESULT IN NEXT AVAILABLE TRACE. 2550 IF A$<>"P" THEN 2990:'GEOMETRIC SMOOTH ALGORITHM 2552 IF NN%>3 THEN NN%=3 2560 SUM2=0:SUM4=0:SUM6=0 2570 FOR J%=-N1% TO N1% 2580 SUM2=SUM2+J%^2 2590 SUM4=SUM4+J%^4 2600 SUM6=SUM6+J%^6 2610 NEXT J% ' C#() CONTAINS SUMS INVOLVING ONLY X VALUES AND N. =T[M][M] OF THE NORMAL EQUATIONS? 2620 C#(0,0)=1/N2%:C#(0,0)=SQR(C#(0,0)) 2630 C#(1,1)=1/SUM2:C#(1,1)=SQR(C#(1,1)) 2640 C#(2,2)=1/(SUM4-SUM2*SUM2/N2%):C#(2,2)=SQR(C#(2,2)):C#(2,0)=-C#(2,2)*SUM2/N2% 2650 C#(3,3)=1/(SUM6-SUM4*SUM4/SUM2):C#(3,3)=SQR(C#(3,3)):C#(3,1)=-C#(3,3)*SUM4/SUM2 2655 Z=PPNM%/INC%:Z2=Z*Z*2:Z3=Z2*Z*6 2656 'Z^N CONVERTS TO NM, 2657 '* 1, 2 OR 6 FOR (D/DX)^2(CX^2) = 2C; (D/DX)^3(DX^3) = 6D 2660 CMMNT$(TCOUNT%)=LEFT$(CMMNT$(K%),40)+" (SMTHD P"+STR$(2*N1%+1)+" POINTS)" 2668 IF NN%>0 THEN 2750:'FOR DERIVATIVES 2669 ' 2670 'SMOOTH: 2674 L%=N1%+1:GOSUB 2720 :'FIT FIRST N1%+1 POINTS TO PN EVALUATED FROM FIRST 1+2*N1 POINTS 2680 L%=NPOINTS%-N1%:GOSUB 2720:'FIT LAST N1%+1 PONTS TO PN EVAL FROM LAST 1+2*N1 POINTS 2690 FOR L%=N1%+2 TO NPOINTS%-(N1%+1):'REPLACE EVERY OTHER POINT WITH VALUE OF PN EVALUATED FROM SURROUNDING 1+2*N1 POINTS 2700 GOSUB 2826:'SUMYHALF 2701 A%(L%,TCOUNT%)=SUMY/N2%+C#(2,2)*C#(2,0)*SUMX2Y+C#(2,0)*C#(2,0)*SUMY 2705 NEXT L% 2710 RETURN 2712 ' 2720 'REPLACE SIDE POINTS WITH VALUE FROM FITTED PN 2728 GOSUB 2806:'SUMYFULL 2730 GOSUB 2850:'ALLB 2732 FOR J%=-N1% TO N1%:'NOTE THIS IS REDUNDANT FOR HALF THE POINTS 2740 A%(L%+J%,TCOUNT%) = B(0) + B(1)*J% + B(2)*J%^2 + B(3)*J%^3 2744 NEXT J% 2746 RETURN 2748' 2750' FOR DERIVATIVES: 2752 CMMNT$(TCOUNT%+1)=LEFT$(CMMNT$(K%),40)+" (1'ST DERIV"+STR$(2*N1%+1)+" POINTS)" 2754 IF NN%>1 THEN CMMNT$(TCOUNT%+2)=LEFT$(CMMNT$(K%),40)+" (2'ND DERIV"+STR$(2*N1%+1)+" POINTS)" 2756 IF NN%>2 THEN CMMNT$(TCOUNT%+3)=LEFT$(CMMNT$(K%),40)+" (3'D DERIV"+STR$(2*N1%+1)+" POINTS)" 2758 L%=N1%+1:GOSUB 2780 :'FIT FIRST N1%+1 POINTS TO PN EVALUATED FROM FIRST 1+2*N1 POINTS 2760 L%=NPOINTS%-N1%:GOSUB 2780:'FIT LAST N1%+1 PONTS TO PN EVAL FROM LAST 1+2*N1 POINTS 2762 FOR L%=N1%+2 TO NPOINTS%-(N1%+1):'REPLACE EVERY OTHER POINT WITH VALUE OF PN EVALUATED FROM SURROUNDING 1+2*N1 POINTS 2764 GOSUB 2806:'SUMYFULL 2766 A%(L%,TCOUNT%)=SUMY/N2%+C#(2,2)*C#(2,0)*SUMX2Y+C#(2,0)*C#(2,0)*SUMY 2768 A%(L%,TCOUNT%+1)=Z*(C#(1,1)*C#(1,1)*SUMXY+C#(3,3)*C#(3,1)*SUMX3Y+C#(3,1)*C#(3,1)*SUMXY) 2770 IF NN%>1 THEN A%(L%,TCOUNT%+2)=Z2*(C#(2,2)*C#(2,2)*SUMX2Y+C#(2,2)*C#(2,0)*SUMY) 2772 IF NN%>2 THEN A%(L%,TCOUNT%+3)=Z3*(C#(3,3)*C#(3,3)*SUMX3Y+C#(3,3)*C#(3,1)*SUMXY) 2774 NEXT L% 2776 TCOUNT%=TCOUNT%+NN%:'RESERVE DERIVATIVE TRACES 2778 RETURN 2779 ' 2780 ' REPLACE SIDE POINTS WITH DERIVATIVES OF FITTED PN 2784 GOSUB 2806:'SUMYFULL 2786 GOSUB 2850:'ALLB 2788 FOR J%=-N1% TO N1%:'NOTE THIS IS REDUNDANT FOR HALF THE POINTS 2790 X=J%:X2=X*J%:X3=X2*J%:'X, X^2, X^3 2794 A%(L%+J%,TCOUNT%) = B(0) + B(1)*X + B(2)*X2 + B(3)*X3:' 0'TH DERIV 2796 A%(L%+J%,TCOUNT%+1) = B(1) + 2*B(2)*X + 3*B(3)*X2:' 1'ST 2798 A%(L%+J%,TCOUNT%+2) = 2*B(2) + 6*B(3)*X :' 2'ND 2800 A%(L%+J%,TCOUNT%+3) = 6*B(3) :' 3'D 2802 NEXT J% 2804 RETURN 2805 ' 2806 'SUMYFULL: SUMS INVOLVING Y: Y, X*Y, X^2*Y, X^3*Y 2808 SUMY=0:SUMXY=0:SUMX2Y=0:SUMX3Y=0 2810 FOR J%=-N1% TO N1% 2812 Y=A%(L%+J%,K%) 2814 SUMY=SUMY+Y 2816 SUMX2Y=SUMX2Y+Y*J%*J% 2818 SUMXY=SUMXY+Y*J% :' ONLY FOR DERIV 2820 SUMX3Y=SUMX3Y+Y*J%^3:' 2822 NEXT J% 2824 RETURN 2825 ' 2826 'SUMYHALF: SUMS INVOLVING Y: Y, X^2*Y ONLY 2828 SUMY=0:SUMX2Y=0 2830 FOR J%=-N1% TO N1% 2832 Y=A%(L%+J%,K%) 2834 SUMY=SUMY+Y 2836 SUMX2Y=SUMX2Y+Y*J%*J% 2840 NEXT J% 2842 RETURN 2844 ' 2850 'ALLB: CALCULATE COEEFICIENTS OF B F PN. 2852 B(0)=SUMY/N2%+C#(2,2)*C#(2,0)*SUMX2Y+C#(2,0)*C#(2,0)*SUMY 2854 B(1)=C#(1,1)*C#(1,1)*SUMXY+C#(3,3)*C#(3,1)*SUMX3Y+C#(3,1)*C#(3,1)*SUMXY 2856 B(2)=C#(2,2)*C#(2,2)*SUMX2Y+C#(2,2)*C#(2,0)*SUMY 2958 B(3)=C#(3,3)*C#(3,3)*SUMX3Y+C#(3,3)*C#(3,1)*SUMXY 2960 RETURN 2990 REM GEOMETRIC SMOOTHING 3000 IF N1%>16 THEN PRINT"USE 33 PTS ONLY":N1%=16:N2%=33 3010 CMMNT$(TCOUNT%)=LEFT$(CMMNT$(K%),40)+" (SMTHD G"+STR$(N2%)+" POINTS)" 3020 X=2*N1%:GOSUB 3210:'CALC N FACTORIAL 3030 Y=X/(2^(2*N1%)) 3040 FOR I%=1 TO N1%+1 3050 X=I%-1:GOSUB 3210 3060 WL(I%)=Y/X :'CALCULATE BINOMIAL COEFFICIENTS AND PUT IN WL(I%) 3070 X=N2%-I%:GOSUB 3210 3080 WL(I%)=WL(I%)/X:'N!/(X!(N-X)!2^2*N1%) 3090 NEXT I% 3100 FOR I%=N1%+2 TO N2% 3110 WL(I%)=WL(1+N2%-I%) 3120 NEXT I% 3130 FOR L%=0 TO NPOINTS%-N2% 3140 X=0 3150 FOR J%= 1 TO N2% 3160 X=X+WL(J%)*A%(L%+J%,K%) 3170 NEXT J% 3180 A%(L%+N1%+1,TCOUNT%)=X 3190 NEXT L% 3200 RETURN 3210 'CALCULATE X!, RETURN IN X 3220 XX=1 3230 IF X<2 THEN 3270 3240 XX=XX*X 3250 X=X-1 3260 GOTO 3230 3270 X=XX 3280 RETURN 3298 ' 3299 ' 3300 'SHIFT SPECTRA 3310 INPUT"ENTER NUMBERS OF FIRST AND LAST SPECTRA TO BE SHIFTED";N1%,N2% 3320 INPUT " SHIFT HOW FAR? (nm; + FOR RED, - FOR BLUE) ",X 3330 N3%=PPNM%*X/INC%:'NUMBER OF POINTS TO SHIFT 3340 IF N3%<0 THEN 3430 3350 FOR I%=N1% TO N2% 3360 FOR J%= NPOINTS%-N3% TO 1 STEP -1 3370 A%(J%+N3%,I%)=A%(J%,I%) 3380 NEXT J% 3390 FOR J%=1 TO N3%:A%(J%,I%)=0:NEXT J% 3400 CMMNT$(I%)=LEFT$(CMMNT$(I%),40)+"SHIFTED"+STR$(X) 3410 NEXT I% 3420 RETURN 3430 FOR I%=N1% TO N2% 3440 FOR J%= 1-N3% TO NPOINTS% 3450 A%(J%+N3%,I%)=A%(J%,I%) 3460 NEXT J% 3470 FOR J%=1+N3%+NPOINTS% TO NPOINTS%:A%(J%,I%)=0:NEXT J% 3480 CMMNT$(I%)=LEFT$(CMMNT$(I%),40)+"SHIFTED"+STR$(X) 3490 NEXT I% 3492 RETURN 3495 ' 3599 ' 3600 REM: ADD, SUBTRACT, MULTIPLY, AND PLOT SPECTRA 3608 IF TCOUNT%>=SMAX% THEN PRINT "NO TRACE AVAILABLE":GOTO 3620 3610 PRINT"NEXT TRACE # IS";TCOUNT%+1 3620 PRINT"ENTER nP TO PLOT, nU TO UNPLOT, nD TO DELETE TRACE n; (E)DIT COMMENT, OR" 3630 INPUT"(1)ADD OR SUBTRACT SPECTRA, (2)ADD, SUBTRACT, OR MULTIPLY BY A CONSTANT";A$ 3635 IF A$="" THEN RETURN 3640 X%=VAL(A$):IF LEN(A$)>1 THEN 3700:REM USE THIS AS INPUT 3645 IF A$="E" THEN 4250:'EDIT COMMENTS. 3650 GOSUB 20140 3660 IF X%=1 THEN PRINT"FORMAT: N1=N2+N3,N1=N2-N3":GOTO 3690 3670 IF X%=2 THEN PRINT"FORMAT: N1=N2*CONST, N1=N2+CONST, N1=N2-CONST":GOTO 3690 3680 PRINT"TRY AGAIN:":GOTO 3600 3690 INPUT A$:A$=A$+" " 3700 IF A$="PA" THEN 4300:'PLOT ALL 3705 I%=1:GOSUB 20320 3710 N1%=X:IF N1%>SMAX% THEN PRINT"THAT TRACE NOT AVAILABLE.";:GOTO 3680 3720 IF MID$(A$,I%,1)="P"THEN 4100 3730 IF MID$(A$,I%,1)="D"THEN 4120 3740 IF MID$(A$,I%,1)="U"THEN 4210 3750 GOSUB 20320:N2%=X 3760 IF I%>LEN(A$) THEN 3680 3770 OP$=MID$(A$,I%,1):I%=I%+1 3780 IF OP$=" " THEN 3760 3790 GOSUB 20320:N3%=X 3800 IF X%=2 THEN 3900:'X IS CONSTANT TO ADD OR MULTIPLY 3810 IF OP$="+"THEN 3860 3820 FOR I%=1 TO NPOINTS% : REM SUBTRACT SPECTRA 3830 A%(I%,N1%)=A%(I%,N2%)- A%(I%,N3%) 3840 NEXT I% 3850 GOTO 4060 3860 FOR I%=1 TO NPOINTS% : REM ADD SPECTRA 3870 A%(I%,N1%)=A%(I%,N2%)+A%(I%,N3%) 3880 NEXT I% 3890 GOTO 4060 3900 KONST=X:IF OP$<>"*" THEN 3980:REM ADD OR SUBTRACT 3910 FOR I%=1 TO NPOINTS% : REM MULTIPLY 3920 X=KONST*A%(I%,N2%) 3930 IF X>32767 THEN X=32767:'DON'T CRASH ON OVERFLOW 3940 IF X<-32768! THEN X=-32768! 3950 A%(I%,N1%)=X 3960 NEXT I% 3970 GOTO 4060 3980 IF OP$="-" THEN KONST=-KONST 3990 KONST=KONST/FACTOR:REM LSB FROM mAU 4000 FOR I%=1 TO NPOINTS% 4010 X=A%(I%,N2%)+KONST 4020 IF X>32767 THEN X=32767:'DON'T CRASH ON OVERFLOW 4030 IF X<-32768! THEN X=-32768! 4040 A%(I%,N1%)=X 4050 NEXT I% 4060 GOSUB 20140 4070 PRINT"COMMENTS FOR TRACE #";N1%;"('S' TO RETAIN OLD COMMENT):" 4080 LINE INPUT A$ 4082 IF A$<>"S" THEN CMMNT$(N1%)=A$:GOTO 4090 4084 CMMNT$(N1%)=CMMNT$(N2%) 4090 IF N1%>TCOUNT% THEN TCOUNT%=N1% 4100 K%=N1%:GOTO 20000 4110 ' 4120 REM DELETE SPECTRUM 4124 IF N1%>TCOUNT% THEN INPUT"That trace not filled! CR to continue:";A$:RETURN 4126 IF N1%=0 THEN INPUT"Do not delete trace zero! CR to continue:";A$:RETURN 4130 FOR K%=N1% TO TCOUNT%-1 4140 FOR I%=1 TO NPOINTS% 4150 A%(I%,K%)=A%(I%,K%+1):'COPY DOWN TRACES ABOVE THE ONE TO DELETE 4160 NEXT I% 4170 CMMNT$(K%)=CMMNT$(K%+1) :'COPY DOWN THE COMMENT 4180 NEXT K% 4190 TCOUNT%=TCOUNT%-1 4200 RETURN 4210 'UNPLOT SPECTRUM 4220 K%=N1%:COL%=0 4230 GOTO 20020 4249 ' 4250 'EDIT COMMENTS 4251 GOSUB 20140 4255 N= TLINE%+3-TCOUNT%:IF N<1 THEN N=1 4258 LOCATE N,1 4260 FOR I%=1 TO TCOUNT%:PRINT I%;CMMNT$(I%):NEXT I% 4264 PRINT SP$;:LOCATE ,1 4265 INPUT"EDIT WHICH COMMENT(CR TO RETURN)";A$ 4266 IF A$="" THEN RETURN 4267 N%=VAL(A$) 4270 LOCATE TLINE%+3,1:PRINT SP$; 4275 LOCATE ,1:A$=CMMNT$(N%):GOSUB 20430:'EDIT A$ 4276 CMMNT$(N%)=A$:A$="":X=FRE(A$) 4280 GOTO 4255 4299 ' 4300 'PLOT ALL FILLED TRACES 4305 FOR K%=1 TO TCOUNT% 4310 GOSUB 20000 4312 IF INTERACTIVE% THEN IF INKEY$="Q" THEN K%=TCOUNT% 4315 NEXT K% 4320 RETURN 4398 ' 4399 ' 4400 REM SAVE SPECTRUM TO DISK 4410 INPUT"TRACE NUMBER";K% 4420 PRINT CMMNT$(K%) 4430 INPUT "FILENAME(*)";FLN$:IF FLN$=CANC$ THEN RETURN 4440 CALL DISKWRIT (DRIVE%,FLN$,SEG A%(1,K%),NPOINTS%,SWL%,INC%,CMMNT$(K%),ER%) 4450 IF ER%<>0 THEN PRINT"SAVE FAILED. ERCODE =";ER%;"TRY AGAIN":GOTO 4430 4460 RETURN 4470 ' 4480 REM LOAD BASELINE 4490 INPUT"FILENAME(*)";FLN$: IF FLN$=CANC$ THEN RETURN 4500 GOSUB 20500: 'SET V DISP SCALE TO FULLSCALE 4510 BFLAG%=1: 'VALID BASELINE PRESENT 4520 K%=0 4530 GOTO 4600 4540 ' 4550 REM LOAD SPECTRUM FROM DISK 4560 IF TCOUNT%=SMAX% THEN PRINT"TRACES FULL":RETURN 4570 INPUT"FILENAME(*)";FLN$: IF FLN$=CANC$ THEN RETURN 4580 IF FLN$="ASC" THEN 5000 4590 K%=TCOUNT%+1 4600 CMMNT$(K%)=SPACE$(64):REM SRN CAN'T CHANGE LENGTH OF STRING 4610 CALL DISKREAD (DRIVE%,FLN$,SEG A%(1,K%),NNPOINTS%,NSWL%,NINC%,CMMNT$(K%),ER%) 4620 IF ER%=0 THEN 4640 '4630 PRINT"READ FAILED. ERCODE =";ER%; HI%=INT(ER%/256):LO%=ER%-256*HI% 4630 PRINT"READ FAILED. ERCODE MAJ =";HI%;" MIN =";LO%; PRINT "TRY AGAIN":K%=K%-1:GOTO 4570 '4640 PRINT "NNPOINTS%,NSWL,NINC,CMMT:";NNPOINTS%;NSWL%;NINC%;CMMNT$(K%) 'INPUT A$ 4640 IF NNPOINTS% <> NPOINTS% THEN 4690 4650 IF NSWL% <> SWL% THEN 4690 4660 IF NINC% <> INC% THEN 4690 4670 IF K%=0 THEN 4930:'DON'T CHANGE TCOUNT% WHEN LOADING BSLN 4680 GOTO 4920 4690 IF TCOUNT%=0 THEN 4770 4700 GOSUB 20140 4710 PRINT"*******SCAN RANGE OF NEW SPECTRUM DOES NOT MATCH*******" 4720 PRINT"(1) ABANDON NEW SPECTRUM (and stop loading series)" 4730 PRINT"(2) CHANGE SCAN RANGE TO MATCH NEW SPECTRUM" 4735 PRINT"TO LOAD SPECTRA WITH DIFFERENT SPECTRAL RANGE, USE OPTION 9-5" 4740 PRINT"NEW SWL:";NSWL%/PPNM%;" EWL:";(NSWL%+INC%*(NNPOINTS%-1))/PPNM%;" POINTS/nm:";PPNM%/NINC% 4750 INPUT A$ 4760 IF VAL(A$)<>2 THEN stopflag%=1 :RETURN 4770 REM ABANDON ALL PREVIOUS SPECTRA 4780 NPOINTS%=NNPOINTS% :REM USE NEW PARAMETERS 4790 SWL%=NSWL% 4800 INC%=NINC% 4810' WL1%=SWL%:WL2%=SWL%+INC%*(NPOINTS%-1) PNT1%=1:PNT2%=NPOINTS% 4820 IF K%=0 THEN 4890 ' IF K%=1 THEN 4880:'NO NEED TO COPY TO TRACE 1 4830 PRINT "K%,NPOINTS%";K%,NPOINTS% FOR I%=1 TO NPOINTS% ' PRINT "I%,K%",I%,K% 4840 A%(I%,1)=A%(I%,K%):REM COPY TO TRACE 1 4850 NEXT I% 4860 CMMNT$(1)=CMMNT$(K%) 4870 K%=1 4880 BFLAG%=0:'OLD BASELINE INVALID 4890 PFLAG%=1:'PARAMETERS SET FROM DISK 4900 GOSUB 20100:REM CLS AND WRITE PARAM 4910 LOCATE TLINE%+3,1 4920 TCOUNT%=K% 4930 PRINT K%;": ";CMMNT$(K%); 4940 GOTO 20000: 'PLOT IT AND RETURN TO MONITOR 4999 ' 5000 INPUT"FILENAME OF ASCII SPECTR(A) (*)";N$ 5010 IF N$=CANC$ THEN RETURN 5020 INPUT"FACTOR TO MULTIPLY DATA BY (CR FOR 1)";A$ 5030 F=1:IF A$<>"" THEN F=VAL(A$) 5040 M1%=1:INPUT"DOES FILE HAVE SWL,INC (Y OR CR/N)";A$ 5050 OPEN"I",2,N$ 5060 INPUT#2, D: IF D=2 THEN INPUT#2, M1% 5070 INPUT#2,N1% 5080 FOR K%=TCOUNT%+1 TO TCOUNT%+M1% 5090 FOR I%=1 TO N1% 5100 INPUT#2, X: ' PRINT "f,I%,K%,X=" f,I%,K%,X:'DEBUG OVERFLOW A%(I%,K%)=F*X 5110 NEXT I%:NEXT K% 5120 NPOINTS%=N1%:IF A$="N" THEN 5170 5130 INPUT#2,X:SWL%=CINT(X*PPNM%) 5140 INPUT#2,X:INC%=CINT(X*PPNM%) 5150 FOR K%=1 TO M1% 5160 LINE INPUT#2,CMMNT$(TCOUNT%+K%):NEXT K% 5170 TCOUNT%=TCOUNT%+M1% 5180 CLOSE #2 '5190 WL1%=SWL%:WL2%=SWL%+INC%*(NPOINTS%-1) 5190 PNT1%=1:PNT2%=NPOINTS% 5200 GOSUB 20100 5210 RETURN 5398 ' 5399 ' 5400 ' PLOT SPECTRA ON PAPER 5410 GOSUB 20140 5420 ' GET TRACE NUMBERS 5435 PRINT"SELECT THE TRACES TO PLOT:" 5440 PRINT"On each line, enter a trace number, or a range of traces. " 5450 PRINT"When all have been selected, hit CR once more to proceed." 5460 PRINT"To cancel, enter 'Q' at beginning of any line" 5470 J%=0 5480 PRINT MID$(STR$(J%+1),2,2);"-? ";:LINE INPUT A$:IF A$="" THEN 5560 5490 I%=1:GOSUB 20320:N1%=X:IF ER%<>0 THEN 5560 5500 GOSUB 20320:IF ER%<>0 THEN J%=J%+1:AB%(J%,0)=N1%:GOTO 5550 5510 N2%=X 5520 FOR I%=N1% TO N2% 5530 J%=J%+1:AB%(J%,0)=I% 5535 IF J%=30 THEN I%=N2% 5540 NEXT I% 5550 IF J%<30 THEN GOTO 5480:'REM DIM AB%(30,1) 5555 PRINT"ONLY 30 TRACES AS DIMENSIONED NOW" 5560 N%=J%:IF J%=0 THEN RETURN 5570 IF LEFT$(A$,1)="Q" THEN RETURN '5580 GET COLORS IN AB%(,2) 5580 PRINT "WHICH COLORS?- ENTER 'S' TO SELECT EACH ONE, ENTER NUMBER OF FIRST" 5582 PRINT"COLOR FOR SEQUENTIAL THEREAFTER, OR CR FOR ALL IN BLACK" 5583 print "0-black 1-blue 2-green 3-cyan 4-red 5-mage 6-yelw 7-orange 8-brwn 9-olive" 5584 INPUT A$:IF A$<>"" THEN 5588 5586 FOR J%=1 TO N%:AB%(J%,2)=0:NEXT J%:GOTO 5600 5588 IF LEFT$(A$,1)="S" THEN 5594 5590 N1%=VAL(A$) 5592 FOR J%=1 TO N%:AB%(J%,2)=(N1%+J%-1)MOD 10:NEXT J%:GOTO 5600 5594 FOR J%= 1 TO N% 5596 PRINT J%;AB%(J%,0); CMMNT$(AB%(J%,0));:INPUT AB%(J%,2) 5598 NEXT J% 5600 ' 5610 'GET SYMBOLS 5620 PRINT "WHICH DASH PATTERN?- ENTER 'S' TO SELECT EACH ONE, ENTER NUMBER OF" 5630 PRINT"FIRST FOR SEQUENTIAL THEREAFTER, OR CR FOR ALL SOLID" 5640 INPUT A$:IF A$<>"" THEN 5660 5650 FOR J%=1 TO N%:AB%(J%,1)=1:NEXT J%:GOTO 5730 5660 IF LEFT$(A$,1)="S" THEN 5690 5670 N1%=VAL(A$)+4:'=> -2 AFTER MOD 6. -1 FOR 1ST IS 1 NOT 0, -1 FOR +1 AFTER MOD 5680 FOR J%=1 TO N%:AB%(J%,1)=1+(N1%+J%)MOD 6:NEXT J%:GOTO 5730 5690 FOR J%= 1 TO N% 5700 PRINT J%;AB%(J%,0);CMMNT$(AB%(J%,0));:INPUT AB%(J%,1) 5710 NEXT J% 5720 ' 5730 INPUT"PLOT FULL SPECTRUM? (NO TO LIMIT WL RANGE)",A$ 5740 IF LEFT$(A$,1)="N" THEN 5770 5750 N1%=1:N2%=NPOINTS% 5760 XMIN=SWL%/PPNM%:XMAX=XMIN+ INC%*(NPOINTS%-1)/PPNM%:GOTO 5800 5770 INPUT"WAVELENGTH RANGE? (SWL,EWL) ",XMIN,XMAX 5780 N1%=1+CINT((PPNM%*XMIN-SWL%)/INC%):N2%=1+CINT((PPNM%*XMAX-SWL%)/INC%) 5790 IF N1%<1 THEN N1%=1:IF N2%>NPOINTS% THEN N2%=NPOINTS% 5800 LINE INPUT"LABEL FOR ABSORBANCE SCALE (CR FOR DEFAULT)";T$(1) 5810 IF T$(1)="" THEN T$(1)="Absorbance x 1000" 5820 LINE INPUT"LABEL FOR WAVELENGTH SCALE (CR FOR DEFAULT)";T$(2) 5830 IF T$(2)="" THEN T$(2)="Wavelength, nm" 5840 ' 5850 ROT%=0:INPUT"ROTATE PLOT";A$:IF LEFT$(A$,1)="Y" THEN ROT%=1 5860 ' INPUT"(CR) AUTOSCALE, (2) USE PREVIOUS SCALE, (3) USER SPECIFIED SCALE";A$ 5870 GOTO 5910 5880 'IF A$="" THEN 5910 5890 'ON VAL (A$) GOTO 5910,6200,5890 5900 ' 5910 X=.05*(XMAX-XMIN):'SOME WHITE SPACE 5920 XMIN=XMIN-X 5930 XMAX=XMAX+X 5940 X=(XMAX-XMIN)/10:REM AT LEAST 10 TICS, AT MOST 20 5950 XD=10^INT(LOG(X)/LOG(10)) 5960 X=X/XD 5970 IF X>5 THEN XD=5*XD:GOTO 5990 5980 IF X>2 THEN XD=2*XD 5990 YMAX=-1E+30:YMIN=1E+30 6000 FOR J%=1 TO N% : K%=AB%(J%,0) 6020 FOR I%=N1% TO N2% 6025 IF A%(I%,K%)> YMAX THEN YMAX=A%(I%,K%) 6030 IF A%(I%,K%)< YMIN THEN YMIN=A%(I%,K%) 6040 NEXT I%:NEXT J% 6050 YMAX= YMAX * FACTOR: YMIN= YMIN * FACTOR : 'mAU UNITS 6060 IF YMAX-YMIN<5 THEN YMIN=YMIN-2:YMAX=YMAX+2 6070 X=.05*(YMAX-YMIN) 6080 YMIN=YMIN-X:'A LITTLE WHITE SPACE 6082 YMAX=YMAX+X 6084 INPUT"SET SCALE LIMITS";A$:IF LEFT$(A$,1)<>"Y" THEN 6100 6086 PRINT"TO USE THE DEFAULT LIMIT, CR. OTHERWISE ENTER DESIRED LIMIT" 6088 PRINT"MINIMUM X:";XMIN;:INPUT A$ 6090 IF A$<>"" THEN XMIN=VAL(A$) 6092 PRINT"MAXIMUM X:";XMAX;:INPUT A$ 6094 IF A$<>"" THEN XMAX=VAL(A$) 6095 PRINT"MINIMUM Y:";YMIN;:INPUT A$ 6096 IF A$<>"" THEN YMIN=VAL(A$) 6097 PRINT"MAXIMUM Y:";YMAX;:INPUT A$ 6098 IF A$<>"" THEN YMAX=VAL(A$) 6100 X=(YMAX-YMIN)/8 :REM AT LEAST 8 TIC MARKS, AT MOST 16 6110 YD=10^INT(LOG(X)/LOG(10)):'LARGEST POWER OF 10 SMALLER THAN X 6120 X=X/YD 6130 IF X>5 THEN YD=5*YD:GOTO 6200 6140 IF X>2 THEN YD = 2*YD 6150 ' 6200 REM PLOT ON PLOTTER 6210 'INPUT"PLOT SCALE (DEFAULT=1 FILLS 8 X 11 SHEET)";PSCALE:IF PSCALE <= 0 THEN PSCALE=1 PSCALE=1 6220 CHRSPACE=PSCALE*11 6230 PRINT"CHARACTER SIZE? (CR FOR DEFAULT =";CHRSPACE;") ";:INPUT X:IF X>0 THEN CHRSPACE=X 6240 LINESPACE=CHRSPACE*88/56 6250 BMH%=49+2*LINESPACE:TMH%=PSCALE*540:LMH%=3*LINESPACE:RMH%=PSCALE*720 6260 MARG=PSCALE*10 6270 IF ROT%=1 THEN I%=TMH%:TMH%=RMH%:RMH%=I% 6280 BLH%=BMH%+MARG:TLH%=TMH%-MARG:LLH%=LMH%+MARG:RLH%=RMH%-MARG 6290 XLINE1=LMH%-3:XLINE2=XLINE1-LINESPACE 6300 YLINE1=BMH%-LINESPACE:YLINE2=YLINE1-LINESPACE 6310 SCLE=50 :REM SIZE OF SYMBOLS 6320 ' 6330 'INPUT"DRAW AND LABEL AXES?";A$ 6340 GOSUB 8000 :REM INITIALIZE PLOTTER 6370 ' 6380 YSCALEH=(TLH%-BLH%)/(YMAX-YMIN) 6390 XSCALEH=(RLH%-LLH%)/(XMAX-XMIN) 6400 YOFF =BLH%/YSCALEH-YMIN 6410 XOFF =LLH%/XSCALEH-XMIN 6420 ' 6430 'IF LEFT$(A$,1)="N" THEN 6700:REM SKIP AXES AND LABELS 6440 'A$="DI1,0":IF ROT%=1 THEN A$="DI0,-1" 6450 'PRINT#5,A$;:OLDPLT%=2:REM SET 0 DEGREES 6460 X=(LMH%+RMH%)/2:Y=YLINE2:PLT%=0:GOSUB 8100 6470 PRINT#5,"(";T$(2);")" 6472 PRINT#5,"dup stringwidth":PRINT#5,"2 div neg exch 2 div neg exch rmoveto show" 6480 ' 6490 X=LMH%:Y=BMH%:PLT%=0:GOSUB 8100:'DRAW OUTLINE 6500 Y=TMH%:PLT%=1:GOSUB 8100 6510 X=RMH%:GOSUB 8100 6520 Y=BMH%:GOSUB 8100 6530 X=LMH%:GOSUB 8100 6532 PRINT#5,"closepath" 6534 PRINT#5,"2 setlinewidth stroke newpath" 6540 ' 6550 FTX%=INT((LLH%/XSCALEH-XOFF)/XD)+1 :REM FIRST TICK MARK 6560 LTX%=INT((RLH%/XSCALEH-XOFF)/XD) 6570 FTY%=INT((BLH%/YSCALEH-YOFF)/YD)+1 :REM FIRST TICK MARK 6580 LTY%=INT((TLH%/YSCALEH-YOFF)/YD) 6590 N3%=BLH%:N4%=(BLH%+BMH%)/2:N5%=BMH%:GOSUB 7000 6600 N3%=RLH%:N4%=(RLH%+RMH%)/2:N5%=RMH%:GOSUB 7300 6610 'A$="DI0,1":IF ROT%=1 THEN A$="DI1,0" 6620 'PRINT#5,A$ :OLDPLT%=2:REM SET 90 DEGREES 6630 Y=(BMH%+TMH%)/2:X=XLINE2:PLT%=0:GOSUB 8100 6640 PRINT#5,"gsave currentpoint translate 90 rotate" 6642 PRINT#5,"(";T$(1);") dup stringwidth" 6644 PRINT#5,"2 div neg exch 2 div neg exch rmoveto show" 6646 PRINT#5,"grestore" 6650 N3%=LLH%:N4%=(LLH%+LMH%)/2:N5%=LMH%:GOSUB 7300 6660 N3%=TLH%:N4%=(TLH%+TMH%)/2:N5%=TMH%:GOSUB 7000 2163 PRINT#5,"1 setlinewidth stroke newpath" 6670 ' 6700 'PLOT THE CURVES 6705 PRINT#5,"1 setlinewidth" REM PRINT"IF YOU ANSWER X FOR NEXT QUESTION, FULL WL RANGE" PRINT" AND 470 nm GainChange WILL BE USED FOR ALL SPECTRA" PRINT" 'Y' change this one, ask about next" PRINT" same WL Range for this, ask about GCPoint" PRINT" 'X' same WL Range & GCPoint for the rest of the traces" REM - set default gain-change point- used if user enters X for first question. GCPOINT%=1+CINT((PPNM%*470-SWL%)/INC%) 'gcpoint%=0:'disable pen lift for single-scale plots. REM N1%=1:N2%=NPOINTS% 'ALREADY SET BY INITIAL QUERY ROUTINE ANS$="" ANS$="X"'pre-answer to disable 6710 FOR J% = 1 TO N% 6720 PRINT J%;AB%(J%,0);AB%(J%,1);CMMNT$(AB%(J%,0)) IF LEFT$(ANS$,1)="X" THEN 6760 6722 INPUT"CHANGE SPECTRAL RANGE (Y/N/X=default/same as prev, don't ask again)",ANS$ 6723 IF LEFT$(ANS$,1)="X" THEN 6760 6724 IF LEFT$(ANS$,1)<>"Y" THEN 6750 6726 INPUT"WAVELENGTH RANGE? (SWL,EWL) ",XMIN,XMAX 6728 N1%=1+CINT((PPNM%*XMIN-SWL%)/INC%):N2%=1+CINT((PPNM%*XMAX-SWL%)/INC%) 6730 IF N1%<1 THEN N1%=1:IF N2%>NPOINTS% THEN N2%=NPOINTS% 6750 INPUT"POINT BEFORE WHICH TO RAISE PEN FOR GAIN CHANGE";X 6752 GCPOINT%=1+CINT((PPNM%*X-SWL%)/INC%) 6760 K%=AB%(J%,0):IPLOT%=0:' AB%(J%,1) 6770 PLT%=0:'PRINT#5,PEN$(PLT%);";";:'NO LINE TO FIRST 6780 PRINT#5, DASH$(AB%(J%,1))+" 0 setdash" 6781 PRINT#5, COLR$(AB%(J%,2))+" setrgbcolor" 6782 MXPTS=600:NPTH=INT((N2%-N1%)/MXPTS) 6784 FOR II%=0 TO NPTH-1 6786 N3%=N1%+II%*MXPTS:PLT%=0 6790 FOR I% = N3% TO N3%+MXPTS 6800 NEWY=(A%(I%,K%)*FACTOR+YOFF)*YSCALEH:NEWX=(((I%-1)*INC%+SWL%)/PPNM% +XOFF)*XSCALEH 6805 IF I%=GCPOINT% THEN PLT%=0:PRINT"//";:'NO LINE WHERE GAIN CHANGE OCCURS 6810 X=NEWX:Y=NEWY:GOSUB 8100:REM LINE TO CENTER OF NEW POINT 6820 PLT%=1 6830 NEXT I%:PRINT#5,"stroke newpath":PRINT"++++";:NEXT II% 6835 ' 6840 N3%=N1%+NPTH*MXPTS:PLT%=0 6842 FOR I% = N3% TO N2% 6846 NEWY=(A%(I%,K%)*FACTOR+YOFF)*YSCALEH:NEWX=(((I%-1)*INC%+SWL%)/PPNM% +XOFF)*XSCALEH 6848 IF I%=GCPOINT% THEN PLT%=0:'NO LINE WHERE GAIN CHANGE OCCURS 6850 X=NEWX:Y=NEWY:GOSUB 8100:REM LINE TO CENTER OF NEW POINT 6852 PLT%=1 6854 NEXT I% 6885 PRINT#5,"stroke newpath":PRINT "++++" 6889 ' 6890 NEXT J% 6895 PRINT#5,"[] 0 setdash 0 0 0 setrgbcolor" 6900 INPUT"DRAW ARROW";A$:IF LEFT$(A$,1)<>"Y" THEN 6980 6901 INPUT"ENTER X AND Y COORD FOR TIP OF ARROW:",X,Y:',ANGLE 6902 X=(X+XOFF)*XSCALEH 6903 Y=(Y+YOFF)*YSCALEH 6905 INPUT"ENTER TEXT TO PRINT WITH ARROW:",LABEL$ 6910 PLT%=0:IFILL=1:GOSUB 8100 6920 PRINT#5,"gsave" 6925 PRINT#5,"currentpoint translate":PRINT#5,"90 rotate" 6930 SCLE=15:IPLOT%=8:XX=0:YY=0:GOSUB 8200 6935 X=SCLE*2:Y=-.35*LINESPACE:PLT%=0:GOSUB 8100:'MOVE TO END OF ARROW SHAFT FOR LABEL 6955 PRINT#5,"( ";LABEL$;")" 6960 PRINT#5," show" 6965 PRINT#5,"grestore" 6970 GOTO 6900 6980 PRINT#5,"showpage" 6982 CLOSE#5: Print "Wait while the file is sent to the printer:" 'shell "PRINTCOL" 'shell "LPT3-OFF" P$=ENVIRON$("PRINTER"):IF P$="" THEN P$="LPT2" C$= "copy TEMP.PS "+P$ :PRINT C$ shell C$ '****INPUT RT MODULE PATH, AND NOTHING WORKS! input "Filename for saving postscript ( to not save)";fln$ if fln$<>"" then shell "ren temp.ps "+fln$ 6985 GOSUB 20100:'TCOUNT%=0:'WHY? ARE SCAN PARAM CORRUPTED? RETURN 6995 ' 7000 'DRAW HORIZONTAL AXIS 7020 FOR I%=FTX% TO LTX% 7030 X=XSCALEH*(XD*I%+XOFF):X1%=X 7040 IF I%=2*INT(I%/2) THEN 7090:'LABEL EVERY OTHER TICMARK 7050 Y=N5%:PLT%=0:GOSUB 8100:'HALFSIZED TICK, NO LABEL 7060 Y=N4%:PLT%=1:GOSUB 8100:'NOTE 7200 MUST PRESERVE X! 7080 GOTO 7180 7090 'FULL SIZED TICK 7100 Y=N3%:PLT%=0:GOSUB 8100 7110 Y=N5%:PLT%=1:GOSUB 8100 7120 IF N3%=TLH% THEN 7180:'NO LABEL ON TOP 7130 XX=I%*XD:GOSUB 7600: 'MAKE DIV LABEL (XX$) 7140 Y=YLINE1:PLT%=0:GOSUB 8100 7150 PRINT#5,"(";XX$;") dup stringwidth " 7160 PRINT#5,"2 div neg exch 2 div neg exch rmoveto show" 7180 NEXT I% 7190 RETURN 7200 ' 7300 'DRAW VERT AXIS 7320 FOR I%=FTY% TO LTY% 7330 Y=YSCALEH*(YD*I%+YOFF):X1%=Y 7340 IF I%=5*INT(I%/5) THEN 7390 'EVERY OTHER TICK 7350 'HALF SIZED TICK, NO LABEL 7360 X=N4%:PLT%=0:GOSUB 8100 7370 X=N5%:PLT%=1:GOSUB 8100 7380 GOTO 7480 7390 'FULL TICK 7400 X=N3%:PLT%=0:GOSUB 8100 7410 X=N5%:PLT%=1:GOSUB 8100 7420 IF N3%=RLH% THEN 7480:'NO LABEL ON RIGHT 7430 XX=I%*YD:GOSUB 7600: 'MAKE DIV LABEL (XX$) 7440 X=XLINE1:PLT%=0:GOSUB 8100 7450 PRINT#5,"gsave currentpoint translate 90 rotate" 7460 PRINT#5,"(";XX$;") dup stringwidth" 7470 PRINT#5,"2 div neg exch 2 div neg exch rmoveto show grestore" 7480 NEXT I% 7490 RETURN 7500 ' 7600 'MAKE LABEL FOR SCALE DIVISIONS INTO STRING 7610 A$=STR$(XX):XX$="" 7620 A$=MID$(A$,2):'DELETE LEADING SPACE 7630 IF LEFT$(A$,1)="." THEN A$="0"+A$ 7640 IF XX<0 THEN A$="-"+A$ 7650 LLG=LEN(A$):XX$=A$ 7700 RETURN 7710 ' 8000 REM PLOT INITIALIZATION: 8002 IF GS$<>""THEN 8046 8004 PEN$(0)="moveto":PEN$(1)="lineto" 8006 'GOTO 7095:REM ELSE "SYNTAX ERROR" BEFORE 7027, EVEN WITHOUT LINES 4-14 8008 ' FOR I = 1 TO 7 8010 'PRINT I 8012 ' READ N 8014 'PRINT"N=";N 8016 ' FOR J = 0 TO N - 1 8018 'PRINT J 8020 ' FOR K = 0 TO 2 8022 'PRINT I,J,K 8024 ' READ SYMBOL(I,J,K) 8026 ' NEXT : NEXT 8028 'SYMBOL(I,N,0) = 1E+07 8030 ' NEXT 8032 DATA 4,-.866,-.5,0,0,.866,1,.866,-.5,1,-.866,-.5,1 8034 DATA 5,-.707,-.707,0,-.707,.707,1,.707,.707,1,.707,-.707,1,-.707,-.707,1 8036 DATA 9,1,0,0,.707,.707,1,0,1,1,-.707,.707,1,-1,0,1,-.707,-.707,1,0,-1,1,.707,-.707,1,1,0,1 8038 DATA 4,-.866,.5,0,0,-.866,1,.866,.5,1,-.866,.5,1 8040 DATA 5,-1,0,0,0,1,1,1,0,1,0,-1,1,-1,0,1:'DIAMOND 8042 DATA 4,-1,0,0,1,0,1,0,1,0,0,-1,1:'CROSS 8043 DATA 4,-.7,-.7,0,.7,.7,1,-.7,.7,0,.7,-.7,1:'X 8044 DATA 8, 0,0,0, .866,.5,1, .866,.2,1, 2,.2,1, 2,-.2,1, .866,-.2,1, .866,-.5, 1, 0,0,1:REM ARROW. 8045 DATA [],[4 2],[6 2],[8 2],[2 2 8 2],[2 2 2 2 6 2]:',[2 2 4 2] DATA 0 0 0, 0 0 1, 0 1 0, 0 .8 .8, 1 0 0, .9 0 .9, .7 .7 0, 1 .5 0, 1 .5 .5, .5 1 0 '8046 INPUT"FILENAME FOR POSTSCRIPT FILE";FLN$ 8046 FLN$="TEMP.PS" 8050 OPEN "O",5,FLN$:PRINT#5,"%!PS-Adobe-" 8055 IF ROT%=0 THEN PRINT#5,"0 792 translate":PRINT#5,"-90 rotate" 8060 PRINT#5,"newpath" 8065 PRINT#5,"/hfont /Helvetica findfont 18 scalefont def" 8070 PRINT#5,"/sfont /Symbol findfont 18 scalefont def" 8072 PRINT#5,"/xfont /Helvetica findfont 14 scalefont def" 8075 PRINT#5,"/shfont {hfont setfont} def" 8080 PRINT#5,"/ssfont {sfont setfont} def" 8081 PRINT#5,"/sxfont {xfont setfont} def" 8083 PRINT#5,"/fhlf {0 -7 rmoveto} def" 8084 PRINT#5,"/rhlf {0 7 rmoveto} def" 8085 PRINT#5,"shfont" 8090 P$="######.## " 8095 RETURN 8099 ' 8100 REM SUBROUTINE: MOVE TO X,Y WITH PEN UP OR DOWN 8108 PRINT#5, USING P$;X;Y;:PRINT#5,PEN$(PLT%) 8112 RETURN 8199 ' 8200 REM SUBROUTINE: DRAW SYMBOL AT XX,YY 8202 IF IPLOT%=0 THEN RETURN: ' ZERO'TH SYMBOL IS NO SYMBOL 8204 IPLOT%=IPLOT% MOD 9 8206 JPLOT% = 0 8208 X = SYMBOL(IPLOT%,JPLOT%,0):Y = SYMBOL(IPLOT%,JPLOT%,1): PLT% = SYMBOL(IPLOT%,JPLOT%,2) 8210 IF X > 1000000! THEN 8220 8212 X =.5+ XX + SCLE * X:Y = .5 + YY + SCLE * Y: GOSUB 8100 8214 JPLOT% = JPLOT% + 1: GOTO 8208 8220 IF IFILL=0 THEN PRINT#5,"closepath stroke fill" 8221 IF IFILL>0 THEN PRINT#5,"closepath gsave 1 setgray fill grestore stroke newpath" 8223 IF IFILL<0 THEN PRINT#5,"closepath stroke newpath" 8290 RETURN 8298 ' 8299 ' 8300 'SAVE SPECTRA IN ASCII FORMAT, WITH SPECTRA AS ROWS OR COLUMNS 8305 GOSUB 20140:'CLEAR TEXTSCREEN 8310 N1%=1:N2%=TCOUNT%:'LATER ALLOW PARTIAL SAVE 8320 INPUT"FORMAT:(1)EVEN WL INCREMENTS, OR (2) SELECTED WL";X 8330 IF X=2 THEN 8300 8340 PRINT "WL INCREMENTS (CR FOR EVERY POINT, N FOR EVERY N/";PPNM%;:INPUT"NM)";A$ 8350 IF A$="" THEN C%=1:GOTO 8370 8360 X=VAL(A$)/INC%:C%=INT(X):IF C%<>X THEN 8340 8370 INPUT"FIRST WL TO FILE? (CR FOR FIRST IN SPECTRUM) ",A$ 8380 IF A$="" THEN B%=0:GOTO 8400 8390 B%=(PPNM%*VAL(A$)-SWL%)/INC%:IF B%<0 THEN 8370 8400 INPUT "LAST WL TO FILE? (CR FOR LAST IN SPECTRUM) ",A$ 8410 IF A$="" THEN A$=STR$((SWL%+INC%*(NPOINTS%-1))/PPNM%) 8420 NNPOINTS%=1+((PPNM%*VAL(A$)-SWL%)/INC%-B%)/C% 8430 INPUT"FILENAME TO SAVE UNDER?",N$ 8440 INPUT"SAVE WITH SPECTRA AS (R)OWS, OR AS (C)OLLUMNS";A$ 8450 OPEN "O",3,N$ 8460 PRINT#3, "2" 8470 IF LEFT$(A$,1)<>"C" THEN 8590 8480 'SAVE TRANSPOSED MATRIX 8490 PRINT#3, NNPOINTS% 8500 PRINT#3, 1+N2%-N1% 8510 FOR I%=0 TO NNPOINTS%-1 8520 II%=1+B%+C%*I% 8530 FOR J%=N1% TO N2% 8540 PRINT#3, A%(II%,J%):'UNITS OF FACTOR * 1 mAU 8550 NEXT J% 8560 NEXT I% 8570 GOTO 8670 8580 'SAVE MATRIX 8590 PRINT#3, 1+N2%-N1% 8600 PRINT#3, NNPOINTS% 8610 FOR J%=N1% TO N2% 8620 FOR I%=0 TO NNPOINTS%-1 8630 II%=1+B%+C%*I% 8640 PRINT#3, A%(II%,J%):'UNITS OF FACTOR * 1 mAU 8650 NEXT I% 8660 NEXT J% 8670 PRINT#3, (SWL%+B%*INC%)/PPNM% 8680 PRINT#3, C%*INC%/PPNM% 8690 FOR I%=N1% TO N2% 8700 PRINT#3, CMMNT$(I%) 8710 NEXT I% 8720 CLOSE #3 8730 GOTO 20100:'CLEAR SCREEN AND RETURN 8798 ' 8799 ' 8800 REM CHANGE DISPLAY VERTICAL SCALE 8810 GOSUB 20140:'CLEAR TEXTSCREEN 8820 INPUT"ENTER DESIRED FULL-SCALE ABSORBANCE (mAU) FOR SCREEN DISPLAY: ",MAUFS 8830 IF MAUFS=0 THEN 20500:'CR FOR FULL-SCALE CENTERED 8840 PRINT"ENTER ABSORBANCE VALUE FOR MIDSCALE 8850 INPUT" (CR FOR 0 AT MIDSCALE, B FOR 0 AT BOTTOM)";A$ 8860 IF A$="" THEN OFFSET=0:GOTO 8890 8870 IF A$="B" THEN OFFSET= MAUFS/2:GOTO 8890 8880 OFFSET=VAL(A$) 8890 IF MAUFS=0 THEN MAUFS=2 8900 YSCALE= FACTOR*(BL%-TL%)/MAUFS:'PIXELS/LSB 8910 ZRO%=(TL%+BL%)/2+YSCALE*OFFSET/FACTOR 8920 GOSUB 20100 :REM CLEAR SCREEN AND WRITE PARAMETERS 8930 RETURN 8998 ' 8999 ' 9000 REM LIST TRACES FILLED SO FAR VIEW PRINT TLINE% TO TLINE%+4 CLS 2 9010' GOSUB 20140:'CLEAR TEXTSCREEN 9020 IF TCOUNT%=0 THEN 9120 9030 I%=1 9040 PRINT I%;"-",CMMNT$(I%); 9050 IF I%=TCOUNT% THEN 9120 9060 IF I%<>5*INT(I%/5) THEN 9100 9070 A$=INKEY$:IF A$=""THEN 9070 9080 IF A$<>" "THEN 9124:REM SCROLL ON SPACE,RET ON ANYTHING ELSE 9090 ' GOSUB 20140:GOTO 9110 ' CLS:GOTO 9110 9100 PRINT 9110 I%=I%+1:GOTO 9040 9120 A$=INKEY$:IF A$="" THEN 9120 9124 VIEW PRINT 1 TO TLINE%+4 9130 RETURN 9198 ' 9199 ' 9200 GOSUB 20140 9210 PRINT "ENTER TRACE NUMBER OF EACH CURVE TO BE FILED" 9220 PRINT"ENTER 0 AFTER LAST CURVE. (TO CANCEL, ENTER 0 ONLY)" 9230 I%=1 9240 PRINT I%;". "; 9250 INPUT AB%(I%,0) 9260 IF AB%(I%,0)<>0 THEN I%= I%+1:GOTO 9240 9270 N% = I% - 1:IF N%=0 THEN RETURN 9280 INPUT"FORMAT:(1)EVEN WL INCREMENTS, OR (2) SELECTED WL";X 9290 IF X=2 THEN 9570 9300 PRINT "WL INCREMENTS (CR FOR EVERY POINT, N FOR EVERY N/";PPNM%;:INPUT"NM)";A$ 9310 IF A$="" THEN C%=1:GOTO 9330 9320 X=VAL(A$)/INC%:C%=INT(X):IF C%<>X THEN 9300 9330 INPUT"FIRST WL TO FILE? (CR FOR FIRST IN SPECTRUM) ",A$ 9340 IF A$="" THEN B%=0:GOTO 9360 9350 B%=(PPNM%*VAL(A$)-SWL%)/INC%:IF B%<0 THEN 9330 9360 INPUT "LAST WL TO FILE? (CR FOR LAST IN SPECTRUM) ",A$ 9370 IF A$="" THEN A$=STR$((SWL%+INC%*(NPOINTS%-1))/PPNM%) 9380 NNPOINTS%=1+INT(((PPNM%*VAL(A$)-SWL%)/INC%-B%)/C%) 9382 PRINT "WILL SAVE ";(SWL%+B%*INC%)/PPNM%; " TO " (SWL%+(B%+C%*(NNPOINTS%-1))*INC%)/PPNM;" IN STEPS OF ";C%*INC%/PPNM% 'SWL IS IN UNITS OF POINTS/NM. B%=DATA INDEX IN UNITS OF PPNM/INC. NNPOINTS=NEW DTA INDEX IN UNITS OF PPNM/(INC%*C%) 'IF DIVISION BY C% IN 9380 ROUNDS UP, LAST POINT MAY BE PAST END. ' THE FOLLOWING SHOULD NOT BE NECESSARY WITH INT() IN 9380 '9385 II%=1+B%+C%*(NNPOINTS%-1): IF II%>NPOINTS% THEN NNPOINTS%=NNPOINTS%-1:GOTO 9385 9390 INPUT"FILENAME TO SAVE UNDER?",N$ 9400 OPEN "O",3,N$ 9410 PRINT#3, "2" 9420 PRINT#3, N% 9430 PRINT#3, NNPOINTS% 9440 FOR J%=1 TO N% 9450 FOR I%=0 TO NNPOINTS%-1 9460 II%=1+B%+C%*I% 9470 PRINT#3, A%(II%,AB%(J%,0)):'UNITS OF FACTOR * 1 mAU 9480 NEXT I% 9490 NEXT J% 9500 PRINT#3, (SWL%+B%*INC%)/PPNM% 9510 PRINT#3, C%*INC%/PPNM% 9520 FOR I%=1 TO N% 9530 PRINT#3, CMMNT$(AB%(I%,0)) 9540 NEXT I% 9550 CLOSE #3 9560 GOTO 20100:'CLEAR SCREEN AND RETURN 9570 'TYPE 2 ASCII FILE 9575 PRINT"NO MORE THAN";DWL%;"WAVELENGTHS" 9580 INPUT"FNAME OF WL FILE (CR TO ENTER WL)";N$ 9590 IF N$="" THEN 9700 9600 OPEN"I",2,N$ 9610 INPUT#2, D 9620 IF D=2 THEN INPUT#2, X 9630 INPUT#2, NWL%:IF NWL%>DWL% THEN PRINT"TOO MANY WAVELENGTHS":NWL%=DWL% 9640 FOR J%=1 TO NWL% 9650 INPUT#2, X 9660 WL(J%)=1+CINT((PPNM%*X-SWL%)/INC%):'CALCULATE INDEX CORRESP TO WL 9670 NEXT J% 9680 CLOSE #2 9690 GOTO 9780 9700 PRINT"ENTER WAVELENGTHS, SEPARATED BY CR'S. END WITH 0" 9710 J%=0 9720 J%=J%+1:IF J%>DWL% THEN PRINT"NO MORE WAVELENGTHS":GOTO 9770 9730 PRINT J%;":"; 9740 INPUT X 9750 WL(J%)=1+CINT((PPNM%*X-SWL%)/INC%):'CALCULATE INDEX CORRESP TO WL 9760 IF X<>0 THEN 9720 9770 NWL%=J%-1 9780 INPUT"FNAME TO FILE SPECTRA";N$ 9790 OPEN "O",3,N$ 9800 PRINT#3,"2" 9810 PRINT#3, N%+1 9820 PRINT#3, NWL% 9830 FOR J%=1 TO NWL% 9840 PRINT#3, (SWL%+INC%*(WL(J%)-1))/PPNM% 9850 NEXT J% 9860 FOR I%=1 TO N% 9870 FOR J%=1 TO NWL% 9880 PRINT#3, CINT(10*FACTOR*A%(WL(J%),AB%(I%,0)))/10 9890 NEXT J% 9900 NEXT I% 9910 FOR I%=1 TO N% 9920 PRINT#3, CMMNT$(AB%(I%,0)) 9930 NEXT I% 9940 CLOSE #3 9950 RETURN 9998 ' 9999 ' '================================================= 10000 'CHANGE DEFAULT DATA DRIVE 10010 GOSUB 20140 10020 INPUT"USE WHICH DRIVE FOR DATA";A$ 10030 DRIVE%=ASC(LEFT$(A$,1))-64:'@ = 0 DEFAULT, A=1, B=2, ETC 10040 LOCATE LSTLINE%,68:PRINT"DATADRIVE:";CHR$(DRIVE%+64); 10050 RETURN 10098 ' 10099 ' 10100 REM PRINT ABS AT LIST OF WAVELENGTHS 10110 GOSUB 20140 10120 PRINT"ENTER THE WAVELENGTH PAIRS DESIRED. END WITH '0'." 10130 PRINT"FOR SINGLE WAVELENGTH, ENTER 0 AS REFERENCE" 10140 I%=0 10150 I%=I%+1 10160 PRINT I%;":"; 10170 INPUT X,Y 10180 IF X=0 THEN 10220 10190 AB%(I%,0)=1+CINT((PPNM%*X-SWL%)/INC%):AB%(I%,1)=0 10192 IF AB%(I%,0)<1 OR AB%(I%,0)>NPOINTS% THEN PRINT "WAVELENGTH";X;"NOT AVAILABLE":GOTO 10170 10200 IF Y<>0 THEN AB%(I%,1)=1+CINT((PPNM%*Y-SWL%)/INC%):REM CALCULATE INDEX 10202 IF AB%(I%,1)<0 OR AB%(I%,1)>NPOINTS% THEN PRINT "WAVELENGTH";Y;"NOT AVAILABLE":GOTO 10170 10210 GOTO 10150 10220 NWL%=I%-1 10230 INPUT"PRINT TABLE TO (P)RINTER OR (D)ISK, OR FILE AS (M)ATRIX";A$ 10240 IF A$="D" THEN INPUT"FILENAME FOR TABLE";N$:OPEN "O",4,N$:GOTO 10260 10250 IF A$="P" THEN OPEN "LPT1:" AS #4 ELSE OPEN "SCRN:" AS #4 10260 IF A$<>"M" THEN 10300 10270 INPUT"FILENAME FOR MATRIX";N$ 10280 OPEN "O",3,N$ 10290 PRINT#3,"2":PRINT#3,TCOUNT%:PRINT#3,NWL% 10300 GOSUB 20140 10310 PRINT#4,:PRINT#4, LEFT$("WAVELENGTHS:"+SPACE$(20),20); 10320 FOR J%= 1 TO NWL% 10330 PRINT#4, USING "####.#";(SWL%+(AB%(J%,0)-1)*INC%)/PPNM%; 10340 NEXT 10350 PRINT#4,:PRINT#4, LEFT$("REFERENCE:"+SPACE$(20),20); 10360 FOR J%= 1 TO NWL% 10370 IF AB%(J%,1)=0 THEN PRINT#4," -- ";:GOTO 10390 10380 PRINT#4, USING "####.#";(SWL%+(AB%(J%,1)-1)*INC%)/PPNM%; 10390 NEXT 10400 PRINT#4,:PRINT#4,"ABSORBANCE, mAU:"; 10410 FOR I%=1 TO TCOUNT% 10420 B$=LEFT$(CMMNT$(I%)+SPACE$(20),20) 10430 PRINT#4,:PRINT#4, B$; 10440 FOR J%=1 TO NWL% 10450 X=A%(AB%(J%,0),I%) 10460 IF AB%(J%,1)<>0 THEN X=X-A%(AB%(J%,1),I%) 10470 PRINT#4, USING "####.#"; FACTOR*X; 10480 IF A$="M" THEN PRINT#3,X 10490 NEXT J%:NEXT I% 10500 PRINT#4,:CLOSE #4 10510 IF A$<>"M" THEN 10580 10520 FOR J%=1 TO NWL% 10530 PRINT#3,(SWL%+(AB%(J%,0)-1)*INC%)/PPNM%; 10540 IF AB%(J%,1)<>0 THEN PRINT#3,"-";(SWL%+(AB%(J%,1)-1)*INC%)/PPNM%; 10550 PRINT#3, 10560 NEXT J% 10570 CLOSE#3 10580 PRINT:PRINT "ANY KEY TO CONTINUE"; 10590 A$=INKEY$:IF A$="" THEN 10590 10600 GOSUB 20100 10610 RETURN 10698 ' 10699 ' 10700 INPUT"(L)OAD, (S)AVE, OR (D)ELETE ALL FILES";A$ 10710 IF A$="L" THEN 10760 10720 IF A$="S" THEN 10890 10725 IF A$<>"D" THEN RETURN 10730 INPUT"ARE YOU SURE";A$ 10740 IF LEFT$(A$,1)="Y" THEN TCOUNT%=0 10750 RETURN 10760 'LOAD MULTIPLE FILES 'PRINT "SMAX=";SMAX%; 10770 INPUT"ENTER BASENAME, NUMBER FOR FIRST FILE: ",B$,N1% 10775 J%=N1% stopflag%=0 10780 'PRINT: PRINT "TCOUNT%=",TCOUNT%;"SMAX=";SMAX%;:INPUT "OK";A$ IF TCOUNT%=SMAX% THEN RETURN 10790 FLN$=B$+"-"+MID$(STR$(J%),2) 10800 K%=TCOUNT%+1 10810 CMMNT$(K%)=SPACE$(64) 'PRINT "FLN$=";FLN$;"CMMNT$=";CMMNT$(K%);:INPUT "OK";A$ 10820 CALL DISKREAD (DRIVE%,FLN$,SEG A%(1,K%),NNPOINTS%,NSWL%,NINC%,CMMNT$(K%),ER%) 10830 IF ER%<>0 THEN HI%=INT(ER%/256):LO%=ER%-256*HI% IF J%=N1% THEN PRINT"READ FAILED. ERCODE MAJ =";HI%;" MIN =";LO%; :INPUT ". CR TO CONTINUE";A$ RETURN END IF 10840 LOCATE TLINE%+3,1:PRINT FLN$;" LOADED INTO"; 10850 GOSUB 4640 if stopflag%=1 then return 10860 IF INTERACTIVE% THEN IF INKEY$="Q" THEN RETURN 10870 J%=J%+1 10880 GOTO 10780 :'KEEP READING UNTIL READ FAILS OR ALL TRACES FULL 10890 'SAVE MULTIPLE FILES 10900 INPUT"ENTER BASENAME, NUMBER FOR FIRST FILE: ",B$,N1% 10910 FOR K%=1 TO TCOUNT% 10920 FLN$=B$+"-"+MID$(STR$(N1%),2) 10930 CALL DISKWRIT (DRIVE%,FLN$,SEG A%(1,K%),NPOINTS%,SWL%,INC%,CMMNT$(K%),ER%) 10940 IF ER%=0 THEN 10980 10950 PRINT"SAVE FAILED WITH TRACE";K%;". (CR) AFTER CHANGING DISK TO TRY AGAIN, OR (A) TO ABORT";:INPUT A$ 10960 IF A$="A" THEN I%=TCOUNT%:GOTO 11010 10970 GOTO 10930 10980 LOCATE TLINE%+3,1:PRINT"TRACE";K% "SAVED AS ";FLN$ 10990 IF INTERACTIVE% THEN IF INKEY$="Q" THEN K%=TCOUNT% 11000 N1%=N1%+1 11010 NEXT K% 11020 RETURN 11098 ' 11099 ' 11100 'AVERAGE SELECTED TRACES 11105 PRINT"ENTER NUMBER OF EACH TRACE TO BE AVERAGED, SEP BY CR, FOLLOWED BY 0" 11110 PRINT "(RESULT WILL BE PUT IN FIRST OF THESE)" 11120 I%=1 11130 INPUT AB%(I%,0) 11140 IF AB%(I%,0)<>0 THEN I%=I%+1:GOTO 11130 11150 N%=I%-1:IF N%<2 THEN RETURN 11160 FOR I%=1 TO NPOINTS% 11170 X=0 11180 FOR J%=1 TO N% 11190 X=X + A%(I%,AB%(J%,0)) 11200 NEXT J% 11210 A%(I%,AB%(1,0))=CINT(X/N%) 11220 NEXT I% 11230 RETURN 11240 'AVERAGE CONSEC TRACES 11250 GOSUB 11260:GOTO 20000:'AVERAGE, PLOT, AND RETURN 11260 PRINT"ENTER NUMBER OF FIRST TRACE TO BE AVERAGED. ALL FOLLOWING TRACES WILL BE INCLUDED." 11270 INPUT FT% 11280 N1%=TCOUNT%-FT%+1 11290 IF N1%<2 THEN RETURN 11300 FOR I%=1 TO NPOINTS% 11310 X=0 11320 FOR K%=FT% TO TCOUNT% 11330 X=X+A%(I%,K%) 11340 NEXT K% 11350 A%(I%,FT%)=CINT(X/N1%) 11360 NEXT I% 11370 TCOUNT%=FT% 11380 K%=FT%:'SET UP FOR PLOT OR SAVE 11390 RETURN 11398 ' 11399 ' 11400 ' SUBTRACT ONE SPECTRUM FROM ALL OTHERS AND OPTIONALLY, ADD TO BASELELINE 11410 INPUT"NUMBER OF TRACE TO SUBTRACT";N1% 11420 PRINT N1%, CMMNT$(N1%) IF BFLAG%=0 THEN 11490 11430 ' IF N1%=0 THEN 11490 11440 ' INPUT "ADD TO BASELINE SO FUTURE SPECTRA WILL BE CORRECTED";A$ 11450 ' IF LEFT$(A$,1)<>"Y" THEN 11490 11460 ' FOR I%=1 TO NPOINTS% 11470 ' A%(I%,0)=A%(I%,0)+A%(I%,N1%):'ADD TO BASELINE 11480 ' NEXT I% 11490 FOR K%=1 TO TCOUNT% 11500 IF K%=N1% THEN 11540 ' PRINT "SUBTRACTING FROM ";K%;"TH SPECTRUM" 11510 FOR I%=1 TO NPOINTS% :'SUBTRACT N1'TH SPECTRUM FROM K'TH 11520 A%(I%,K%)=A%(I%,K%)-A%(I%,N1%) 11530 NEXT I% 11540 NEXT K% 11550 FOR I%=1 TO NPOINTS% 11560 A%(I%,N1%)=0:' SUBTRACT N1'TH FROM N1'TH SPECTRUM 11570 NEXT I% 11580 GOSUB 20100:'CLEAR SCREEN 11590 RETURN 11598 ' 11798 ' 11799 ' 11800 'CHANGE DISPLAY WL SCALE ' this has been changed from wl1%,wl2%-centric to pnt1%,pnt2%-centric 11810 INPUT"WL RANGE FOR DISPLAY (WL1,WL2; OR 0,0 FOR FULL RANGE)";X,Y '11820 IF y=0 THEN WL1%=SWL%:WL2%=SWL%+INC%*(NPOINTS%-1):GOTO 11860 11820 IF y=0 THEN PNT1%=1:PNT2%=NPOINTS%:GOTO 11860 11821 'WL1%=SWL%:WL2%=SWL%+INC%*(NPOINTS%-1):GOTO 11860 11830 PNT1%=1+(INT(PPNM%*X)-SWL%)/INC%:PNT2%=1+(INT(PPNM%*Y)-SWL%)/INC% 11831 'WL1%=INT(PPNM%*X):WL2%=INT(PPNM%*Y) 11840 IF PNT1%<1 THEN PNT1%=1:'WL1%NPOINTS% THEN PNT2%=NPOINTS%:'WL2%>SWL%+INC%*(NPOINTS%-1) THEN WL2%=SWL%+INC%*(NPOINTS%-1) 11860 GOSUB 20100 11870 RETURN 11898 ' 11899 ' 11900 'ORDER TRACES. VERTICALLY DISPLACE ALL BUT TRACE 1 TO AVOID OVERLAP 11905 INPUT"SPACING BETWEEN TRACES (mAU)";DELTA 11910 DELTA=DELTA/FACTOR 11920 INPUT"NO OVERLAP OVER FULL SPECTRUM? (NO TO LIMIT WL RANGE)",A$ 11930 IF LEFT$(A$,1)<>"N" THEN N1%=1:N2%=NPOINTS%:GOTO 11970 11940 INPUT"WAVELENGTH RANGE? (SWL,EWL) ",X,Y 11950 N1%=1+CINT((PPNM%*X-SWL%)/INC%):N2%=1+CINT((PPNM%*Y-SWL%)/INC%) 11960 IF N1%<1 THEN N1%=1:IF N2%>NPOINTS% THEN N2%=NPOINTS% 11970 INPUT"ORDER (U)PWARDS OR (D)OWNWARDS";A$ 11980 IF LEFT$(A$,1)="D" THEN 12100 11990 FOR K%=2 TO TCOUNT% 12000 XMIN=32767 12010 FOR I%=N1% TO N2% 12020 IF A%(I%,K%)-A%(I%,K%-1)32767 THEN X=X-65536!:'DON'T CRASH ON OVERFLOW IF X<-32768! THEN X=X+65536!:'ROLL OVER TO OPPOS SIGN. A%(I%,K%)=X 12070 NEXT I% 12080 NEXT K% 12090 RETURN 12100 FOR K%=2 TO TCOUNT% 12110 XMAX=-32768! 12120 FOR I%=N1% TO N2% 12130 IF A%(I%,K%)-A%(I%,K%-1)>XMAX THEN XMAX = A%(I%,K%)-A%(I%,K%-1) 12140 NEXT I% 12150 XMAX=XMAX+DELTA 12160 FOR I%=1 TO NPOINTS% 12170 A%(I%,K%)=A%(I%,K%)-XMAX 12180 NEXT I% 12190 NEXT K% 12200 RETURN 12398 ' 12399 ' 12400 'TERMINATE PROGRAM 12405 IF TCOUNT%=0 THEN 12440 12410 IF BFLAG%=0 THEN 12440 12420 INPUT"TRACES IN MEMORY WILL BE LOST. OK TO TERMINATE(Y/N)";A$ 12430 IF LEFT$(A$,1)<>"Y" THEN RETURN 12440 CLOSE#6 END 12498 ' 12499 ' 12500 'INTEGRATE SPECTRA. FIXED 890827. 12510 TCOUNT%=TCOUNT%+1 12520 INPUT"NUMBER OF TRACE TO INTEGRATE";N1% 12530 INPUT"SUBTRTACT OUT MEAN VALUE BEFORE INTEGRATING";A$ 12540 INPUT"SCALE FACTOR TO MULTIPLY RESULT BY (CR FOR 1)";OSCALE 12545 IF OSCALE=0 THEN OSCALE=1 12550 IF LEFT$(A$,1)<>"Y" THEN Y=0:GOTO 12610 12560 Y=0 12570 FOR I%=1 TO NPOINTS% 12580 Y=Y+A%(I%,N1%) 12590 NEXT I% 12600 Y=Y/NPOINTS% 12610 X=0 12615 FOR I%=1 TO NPOINTS% 12620 X=X+(A%(I%,N1%)-Y)*OSCALE*INC%/PPNM%:IF X>32767 THEN X=0 12630 A%(I%,TCOUNT%)=CINT(X) 12640 NEXT I% 12650 GOSUB 20000 12660 RETURN 12698 ' 12700 ' SET DEFAULT DRIVE FOR DOS: A:=1, C:=3 etc. inregs.ax=&H0E00:'0E hex- set default drive inregs.dx=D%-1:'drive NUMBER, C=2 etc, UNLIKE DRIVE% CONVENTION: call interrupt(&H21, inregs, outregs) RETURN 12799 ' 12800 'MAKE DIRECTORY 12805 INPUT"ENTER PATH (D:\NAME\NAME. . .)";A$ 12810 A$=A$+CHR$(0) :' MAKE ROOM FOR ENDOFSTRING MARKER 12815 MKDIR A$ 12820 'CALL MKDIR (A$,ER%) 12825 'IF ER%=0 THEN 9430 12830 'LOCATE LSTLINE%-1,1:PRINT"FAILED TO MAKE ";A$;" ERCODE=";ER%; 12835 'INPUT"CR TO CONTINUE";A$ 12840 RETURN 12845 ' 12900 'CHANGE DIRECTORY 12905 INPUT"ENTER PATH (D:\NAME\NAME. . .)";A$ 12910 A$=A$+CHR$(0) :' MAKE ROOM FOR ENDOFSTRING MARKER 12915 CHDIR A$ 12920 'CALL CHDIR (A$,ER%) 12925 'IF ER%=0 THEN 9430 12930 'LOCATE LSTLINE%-1,1:PRINT"FAILED TO FIND ";A$;" ERCODE=";ER%; 12935 'INPUT"CR TO CONTINUE";A$ 12940 RETURN 12945 ' 13000 'DIRECTORY 13005 GOSUB 20140 13010 PRINT"BE SURE AT LEAST 1 FILE MATCHES, OR CRASH! " 13015 INPUT"ENTER PATH TO DIRECTORY (D:\NAME\NAME. . .)";A$ 13020 FILES A$ 13025 INPUT"CR TO CONTINUE";A$ 13030 RETURN 13035 ' 13100 ' SHELL COMMAND 13105 PRINT"THIS OPTION ALLOWS YOU TO LEAVE THE PROGRAM TEMPORARILY TO RUN ANOTHER" 13110 PRINT"SMALL PROGRAM OR PERFORM DOS FUNCTIONS. TO EXECUTE A SINGLE COMMAND OR" 13115 PRINT"PROGRAM, ENTER THE COMMAND OR PROGRAM NAME, AND SCANEDIT WILL RESUME" 13120 PRINT"WHEN THE PROCESS HAS FINISHED. TO USE DOS TEMPORARILY, ENTER CR ONLY" 13125 PRINT"WHEN READY TO RETURN, TYPE 'EXIT'. IF YOU DON'T WANT TO LEAVE, PUSH" 13130 PRINT"THE ASTERISK KEY AND CR." 13135 INPUT A$ 13140 IF A$=CANC$ THEN RETURN 13145 SHELL A$ 13150 INPUT"CR TO CONTINUE";A$ 13155 RETURN 13999 ' 14000 'TRAP FOR ROUTINES NOT USED 14100 PRINT"ROUTINE NOT WRITTEN- TOUCH ANY KEY TO RETURN." 14110 A$=INKEY$:IF A$="" THEN 14110 14200 RETURN 14540 ' '######################################################################################## 14550 REM LOAD SPECTRUM FROM DISK PRINT "This is for piecing together spectra at different ranges to make a" PRINT "Full spectrum, or for comparing spectra that have different ranges." PRINT "To make a new spectrum, first set wavelength range with (2)." PRINT "Then use this function to load the Various fragments. PRINT "Load into new trace, it will be zeroed first If fragments" PRINT "overlap, choose starting and ending wavelength so desired values" PRINT "go into overlapped region." IF TCOUNT%+1>SMAX% THEN INPUT "NEED EMPTY TRACE TO WORK IN!",A$:RETURN INPUT "NAME OF BINARY SPECTRUM TO PASTE";FLN$ 14560 INPUT"TRACE INTO WHICH NEW DATA WILL BE PASTED (CR FOR NEW TRACE)";KMAKE% 14570 IF KMAKE%=0 THEN KMAKE%=TCOUNT%+1 IF KMAKE%>TCOUNT% THEN:'REGISTER THE NEW TRACE AND ZERO IT TCOUNT%=KMAKE% FOR II%=1 TO NPOINTS%:A%(II%,KMAKE%)=0:NEXT II% ENDIF K%=TCOUNT%+1 IF K%>SMAX%THEN INPUT "ALL TRACES FULL-CR TO RETURN";A$:RETURN INPUT "First and Last wavelengths to include (<,> for ALL present)";X,Y print "Wavelength shift (nm) to be applied to new spectrum before inserting" input "( for no shift) :",SHIFT ' LFIRST%=PPNM%*X/INC%: LLAST%=PPNM%*Y/INC% LFIRST%=PPNM%*X: LLAST%=PPNM%*Y PRINT "DRIVE%,FLN$=";DRIVE%,FLN$ 14600 CMMNT$(K%)=SPACE$(64):REM SRN CAN'T CHANGE LENGTH OF STRING 14610 CALL DISKREAD (DRIVE%,FLN$,SEG A%(1,K%),NNPOINTS%,NSWL%,NINC%,CMMNT$(K%),ER%) 14620 IF ER%=0 THEN 14640 14630 PRINT"READ FAILED. ERCODE =";ER%;:INPUT"TRY AGAIN";A$:K%=K%-1:GOTO 14550 14640 IF NINC%<>INC% THEN INPUT "WRONG POINT DENSITY- CAN'T DO IT YET!";A$:RETURN 'MAKE SURE REQUESTED RANGE WITHIN FULL RANGE, IF 0,0 SET TO FULL RANGE: IF LFIRST%SWL%+INC%*(NPOINTS%-1) THEN LLAST%=SWL%+INC%*(NPOINTS%-1) IF LLAST%=0 THEN LLAST%=SWL%+INC%*(NPOINTS%-1) 'MAKE SURE REQUESTED RANGE WITHIN RANGE AVAILABLE FROM NEW SPECTRUM: nswl%=nswl%+ppnm%*SHIFT:'apply shift to new spectrum IF LFIRST%NSWL%+INC%*(NNPOINTS%-1) THEN LLAST%=NSWL%+INC%*(NNPOINTS%-1) IOLD%=1+(LFIRST%-SWL%)/INC% INEW%=1+(LFIRST%-NSWL%)/INC% FOR I%=0 TO (LLAST%-LFIRST%)/INC% A%(IOLD%+I%,KMAKE%)=A%(INEW%+I%,K%) NEXT I% CMMNT$(KMAKE%)=CMMNT$(K%) 14910 LOCATE TLINE%+3,1 14930 K%=KMAKE%:PRINT K%;": ";CMMNT$(K%); 14940 GOTO 20000: 'PLOT IT AND RETURN TO MONITOR '######################################################################################## '14999 ' 14999 ' 15000 'INITIALIZE 15020 SCREEN SCR% width 80,30 15030 COLOR TXCOL%'CANNOT SET BACKCOLOR IN SCREEN 12- ILLEGAL FUNCTION CALL! 'FACTOR=2124!/65536!:'ABSORBANCE SCALE: mAU/LEAST SIGNIFICANT BIT FACTOR=8496!/65536!:'ABSORBANCE SCALE: mAU/LEAST SIGNIFICANT BIT 15040 FOR I = 1 TO 8:'CHANGE TO 8 FOR ARROW IN PLOTPS 15050 READ N 15060 FOR J = 0 TO N - 1 15070 FOR K = 0 TO 2 15080 READ SYMBOL(I,J,K) 15090 NEXT : NEXT 15100 SYMBOL(I,N,0) = 1E+07 15110 NEXT 15160 CALL INT24 15165 FOR I%=1 TO 6:READ DASH$(I%):PRINT DASH$(I%) 15166 NEXT I% 15167 FOR I%=0 TO 9:READ colr$(I%):PRINT colr$(I%) 15168 NEXT I% 15170 TCOUNT%=0:REM NO TRACES YET 15180 FCOUNT%=0:REM NO FILES YET 15190 'DRIVE%=6:'DEFAULT DRIVE F: a$=ENVIRON$("DRIVE")+"J" IF A$<"A" THEN A$="Z" PRINT "USING DRIVE:";a$ DRIVE%=ASC(LEFT$(A$,1))-64:'@ = 0 DEFAULT, A=1, B=2, ETC 15200 ' 15260 REM DEFAULT PLOT PARAMETERS: 15270 RATE%=1000/25:REM 25 nm/sec 15280 GAIN%=0: REM 2 AUFS A/D RANGE 15290 SWL%=400*PPNM%:EWL%=650*PPNM% 15300 INC%=2:NPOINTS%=1+(EWL%-SWL%)/INC%: REM MEASURE EVERY 1/4 nm 15310 PNT1%=1:PNT2%=NPOINTS% '15310 WL1%=SWL%:WL2%=SWL%+INC%*(NPOINTS%-1) 15320 GOSUB 20500 :REM SET DISPLAY SCALE TO A/D RANGE 15322 A$=COMMAND$ 15324 IF RIGHT$(A$,1)=" " THEN A$=LEFT$(A$,LEN(A$)-1):GOTO 15324 15326 INTERACTIVE%=(A$<>"NI") IF INTERACTIVE% THEN PRINT"INTERACTIVE MODE" ELSE PRINT "NONINTERACTIVE MODE" PRINT"LEN(A$)=";LEN(A$) 'FOR I=1 TO LEN(A$) ' X$=MID$(A$,I,1):PRINT ASC(X$);X$ ' NEXT I 'FOR I=1 TO 1E3:NEXT I 'OPEN PRINT LOG (USED ONLY FOR PRINTING COMMENTS LISTS) 15328 'OPEN "O",6,"SCANLOG.PRN" 15330 RETURN 19998 ' 19999 ' 20000 REM PLOT SPECTRUM ON SCREEN 20010 COL%=1+(K%+7)MOD 15:'1 OF 15 COLORS 20020 FOR I%=PNT1% TO PNT2% 20030 PSET (LL%+(I%-PNT1%)*XSCALE,ZRO%-A%(I%,K%)*YSCALE),COL% 20040 NEXT I% 20050 RETURN 20098 ' 20099 ' 20100 CLS: REM CLEAR SCREEN AND WRITE PARAM ON LINE 25 20110 GOSUB 20600 :REM REWRITE PARAMETERS ON LINE 25 20120 RETURN 20130 ' 20140 REM CLEAR LOWER 5 LINES OF SCREEN AND LOCATE CURSOR AT TOP OF THIS AREA 20150 LINE (0,TST%)-(RE%,TSB%),0,BF:LOCATE TLINE%,1:RETURN 20298 ' 20299 ' 20300 'PARSE NUMBERS OUT OF A$. NO NEGATIVE NUMBERS! 20310 I%=I%+1 20320 IF I%>LEN(A$) THEN ER%=1:RETURN:'NO NUMBER FOUND 20330 C$=MID$(A$,I%,1):REM GET NEXT NUMERIC FROM A$ 20340 IF (C$<"0"OR C$>"9")AND C$<>"."THEN 20310 20350 I1%=I%:'FIRST NUMERIC 20360 I%=I%+1 20370 IF I%>LEN(A$)THEN 20400 20380 C$=MID$(A$,I%,1) 20390 IF (C$>="0" AND C$<="9")OR C$="." THEN 20360 20400 L%=I%-I1%:'LENGTH, NOT INCLUDING I%'TH 20410 X=VAL(MID$(A$,I1%,L%)) 20420 ER%=0:RETURN:'VALUE OF NUMBER IS IN X, I% POINTS AT FIRST NON-NUMERIC AFTER. 20429' 20430 B$=A$:A$="":CV%=CSRLIN:CH%=POS(0):'EDIT B$ AT CURRENT POS'N 20431 B$=B$+SP1$ 20432 PRINT LEFT$(B$,80-CH%); 20434 C$=LEFT$(B$,1):IF C$=SP1$ THEN C$="_" 20435 LOCATE CV%,CH%,1,7:COLOR 4:PRINT C$;:COLOR TXCOL% 20436 I$=INKEY$:IF I$="" THEN 20436 20437 LOCATE CV%,CH%:PRINT LEFT$(B$,1);:LOCATE CV%,CH%,1,7 20439 ' 20440 IF I$<>BSP$ THEN 20450 20442 IF A$="" THEN 20435 20444 A$=LEFT$(A$,LEN(A$)-1) 20446 CH%=CH%-1 20447 LOCATE ,CH%,0:PRINT LEFT$(B$,80-CH%); 20448 GOTO 20434 20449 ' 20450 IF I$<>LARROW$ THEN 20460 20452 IF A$="" THEN 20435 20453 B$=RIGHT$(A$,1)+B$ 20454 A$=LEFT$(A$,LEN(A$)-1) 20456 CH%=CH%-1 20458 GOTO 20434 20459 ' 20460 IF I$<>RARROW$ THEN 20470 20462 IF B$="" THEN 20435 20463 A$=A$+LEFT$(B$,1) 20464 B$=MID$(B$,2,LEN(B$)-1) 20466 CH%=CH%+1 20468 GOTO 20434 20469 ' 20470 IF I$<>CR$ THEN 20480 20472 A$=A$+B$:I%=LEN(A$) 20474 IF MID$(A$,I%,1)=SP1$ THEN I%=I%-1:GOTO 20474 20476 A$=LEFT$(A$,I%) 20478 RETURN 20479 ' 20480 A$=A$+I$:CH%=CH%+1 20482 PRINT I$;LEFT$(B$,80-CH%); 20484 GOTO 20434 20499 ' 20500 REM SET VERT DISP SCALE TO FULLSCALE, CENTERED 20510 MAUFS=2000:OFFSET =1000:GOTO 8890 20600 REM WRITE PARAMETERS ON LINE 25 20610 COLOR AXCOL% 20620 LOCATE LSTLINE%,1 20630 PRINT"PLOT SCALE, mAU:";MAUFS;"FULL SCALE;"; 20640 PRINT OFFSET;"AT CENTER", 20641 PRINT" 'SCANEDPS' "; 20650 LOCATE LSTLINE%,68:PRINT"DATADRIVE:";CHR$(DRIVE%+64); 20660 ' 20670 REM DRAW AXES ' this has been changed from wl1%,wl2%-centric to pnt1%,pnt2%-centric 'This has gone through some changes and currently set wl scale 0,0 ' for swl-last, doesn't work. That routine at 11800 sets wl1%, wl2% ' and calls here. But here now needs pnt1%, pnt2% set. ' Oct2006 Change 11800 to set pnt1%=1,pnt2%=npoints. PRINT "SWL, PPNM, NPOINTS, INC";SWL%;PPNM%;NPOINTS%;INC% 20680 'XMIN=SWL%/PPNM%:XMAX=XMIN+(NPOINTS%-1)*INC%/PPNM% 20690 'PNT1%=1+(WL1%-SWL%)/INC%:PNT2%=1+(WL2%-SWL%)/INC% 20700 XMIN=(SWL%+(PNT1%-1)*INC%)/PPNM%:XMAX=(SWL%+CSNG(PNT2%-1)*INC%)/PPNM% 20710 XLBL%=5:'LABEL EVERY 5'TH TIC 20720 XSCALE=(RL%-LL%)/(PNT2%-PNT1%) 20730 X=(XMAX-XMIN)/(10) :'DIVISION SIZE FOR 10 TICKS 'ILLEGAL FUNCTION CALL IN 20740 ON LOADING SCOPE? files if x <= 0 then print "XMIN, XMAX, PNT1%,PNT2%;WL1%,WL2%;NPOINTS%":PRINT XMIN; XMAX; PNT1%;PNT2%;WL1%;WL2%;NPOINTS% 20740 XDIV=10^INT(LOG(X)/LOG(10)):'LARGEST SMALLER POWER OF 10 20750 X=X/XDIV :IF X > 5 THEN XDIV=XDIV*5:XLBL%=2:GOTO 20770 20760 IF X > 2 THEN XDIV=XDIV*2 20770 FSTTIC%=INT(.999+XMIN/XDIV) 20780 LSTTIC%=INT(XMAX/XDIV) 20790 FOR I%=FSTTIC% TO LSTTIC% 20800 ' X%=CINT(LL%+(XSCALE*(I%*XDIV*PPNM%-SWL%)/INC%))************ 20810 X%=CINT(LL%+(XSCALE*(I%*XDIV-XMIN)*PPNM%/INC%)) 20820 LINE (X%,BL%)-(X%,BM%) 20830 LINE (X%,TM%)-(X%,TL%) 20840 IF I%<>XLBL%*INT(I%/XLBL%) THEN 20890 :'LABEL EVERY XLBL'TH TICK ONLY 20850 WL=XDIV*I% 20860 X%=INT((X%-2)/8):IF X%<1 THEN X%=1:'8 PIXELS/COL; 1ST COL IS 1. 20870 IF X%>77 THEN X%=77 20880 LOCATE NLINE%,X%:PRINT MID$(STR$(WL),2);:'SKIP LEADING SPACE 20890 NEXT I% 20900 LINE (LM%,BM%)-(RM%,BM%) 20910 LINE (LM%,TM%)-(RM%,TM%) 20920 FOR I%=0 TO 10 20930 Y%= TL%+I%*(BL%-TL%)/10 20940 LINE (LM%,Y%)-(LL%,Y%) 20950 LINE (RL%,Y%)-(RM%,Y%) 20960 NEXT I% 20970 LINE (LM%,TM%)-(LM%,BM%) 20980 LINE (RM%,TM%)-(RM%,BM%) 20990 Y%=TL%+(BL%-TL%)/2 21000 LINE (LM%,Y%)-(LM%+10,Y%):LINE (RM%,Y%)-(RM%-10,Y%) 21010 LOCATE TLINE%,1:COLOR TXCOL% 21020 RETURN 22000 print"SELECT GRAPHICS SCREEN:" print " # pixels char pix/char" print " 8 640x200 80x25 8x8" print " 9 640x350 80x25 8x14" print "10 640x350 80x43 8x8" print "12 640x480 80x30 8x16" print "13 640x480 80x60 8x8" INPUT"USE SCREEN #(8,9,10,12 OR 13)?",N IF N<8 OR N>13 THEN GOTO SX ON N-7 GOSUB S8,S9,S9x,SX,S12,S12x TXCOL%=3:AXCOL%=6:BKCOL%=0 TLINE%=LSTLINE%-5:NLINE%=TLINE%-1 BE%=LSTLINE%*PIXPLIN%-1 TST%=1+BE%-(6*PIXPLIN%):TSB%=BE%-PIXPLIN%:' LM%=0:RM%=RE%:TM%=0:BM%=BE%-(7*PIXPLIN%):' LL%=LM%+5:RL%=RM%-5:TL%=TM%+5:BL%=BM%-5 SCREEN SCR%:width 80,lstline%:GOTO 8900 SX:PRINT"CHOOSE SCREEN 8, 9, OR 12:":GOTO 22000 S8: SCR%=8:LSTLINE%=25:PIXPLIN%=8:PXPC%=8:RE%=639 RETURN S9: SCR%=9:LSTLINE%=25:PIXPLIN%=14:PXPC%=8:RE%=639 RETURN S9x: SCR%=9:LSTLINE%=43:PIXPLIN%=8:PXPC%=8:RE%=639 RETURN S12: SCR%=12:LSTLINE%=30:PIXPLIN%=16:PXPC%=8:RE%=639 RETURN S12x: SCR%=12:LSTLINE%=60:PIXPLIN%=8:PXPC%=8:RE%=639 RETURN