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%<LEN(A$) THEN 330
	GOTO 900
350 DRIVE%=ASC(left$(A$,1))-64:'PRINT "DRIVE=";DRIVE%
D%=DRIVE%:GOSUB 12700:GOSUB 20600
'       A$=mid$(A$,I%)
'FIND LAST BACKSLASH:
J%=0
FOR I%=1 TO LEN(A$)
	IF MID$(A$,I%,1)="\" THEN J%=I%:'PRINT J%
	NEXT I%
IF J%>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 (<cr> 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- <Q> 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"  <cr> 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 (<cr> 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%<SWL% THEN WL1%=SWL%
11850   IF PNT2%>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)<XMIN THEN XMIN = A%(I%,K%)-A%(I%,K%-1)
12030          NEXT I%
12040       XMIN=XMIN-DELTA
12050       FOR I%=1 TO NPOINTS%
12060         X=A%(I%,K%)-XMIN
		 IF X>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 "(<CR> 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% THEN LFIRST%=SWL%
IF LLAST%>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% THEN LFIRST%=NSWL%
IF LLAST%>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