200	! DIREX2 -- PRINTS DIRECTORY OF FILE STORED ON
	! DECTAPE (USE DIREX FOR DISK - RANDOM ACCESS)
210	! FOR COMPLETE DIRECTORY OUTPUT TO LP: OR DTN:FILE
220	! FOR PARTIAL DIRECTORY OUTPUT TO KB:
230	! REVISED FOR NEW LOOKUP SUBROUTINE
	! 30-JUL-73	J. WARDEN	WABASH COLLEGE
240 PRINT"FILE DIRECTORY (FROM DECTAPE)"
250 DIM A$(85%),N$(120%),I$(120%)
260 S9$=""
270 M2$="NM"
280 INPUT" PRINT 'NM' FIELD (Y/N)";Y$
290 IF Y$<>"N" THEN N5%=1% : GO TO 300
300 Y%=55% : Y2%=2%*Y%	! LENGTH OF DIRECTORY PAGE
310 GOSUB 4000
320 IF N5%=1% THEN 350
330 INPUT" WHICH FIELD TO PRINT";M2$
340 M2$=LEFT(M2$,2%)
350 FOR Z%=1% TO V2%(1,0)
360 IF V2$(Z%)=M2$ THEN 390
370 NEXT Z%
380 GO TO 9999
390 INPUT"OUTPUT TO ([R] FOR KB:)";O$
400 IF LEN(O$)<1% THEN O$="KB:"
410 S6$=SPACE$(6%)
420 S2$=SPACE$(V2%(2%,Z%))
430 V1%=V2%(1%,Z%) : V2%=V2%(2%,Z%)
440 IF V2%>28% THEN V2%=28% ELSE S9$=SPACE$(28%-V2%)
450 PRINT"FILE NAME"; : INPUT LINE F1$ :
	F1$=LEFT(F1$,LEN(F1$)-2%)
460 IF O$="KB:" THEN 900
470 OPEN F1$ FOR INPUT AS FILE 1%
480 OPEN O$ FOR OUTPUT AS FILE 2%
490 FIELD #1,N1%*R% AS Z$,N1% AS A$(R%) FOR R%=0% TO N6%
500 T%=INSTR(1%,F1$,":") : IF T%=0% THEN 530
510 F1$=RIGHT(F1$,T%+1%)
520 GOSUB 1220
530 GOSUB 1070
540 ON ERROR GO TO 620
550 FOR I%=1% TO Y%
560 IF R%<N6% THEN R%=R%+1% ELSE R%=0% : GET #1%
570 IF LEFT(A$(R%),1%)="\" THEN 650
580 I$(I%)=LEFT(A$(R%),6%)
590 N$(I%)=MID(A$(R%),V1%,V2%)+S9$
600 NEXT I%
610 GOSUB 760 : GO TO 800
620 IF ERR<>11% THEN ON ERROR GO TO 0
630 PRINT"** END-OF-FILE MARKS LEFT OFF FILE **"
640 IF Q% THEN RESUME 710 ELSE RESUME 650
650	! END OF DIRECTORY WHEN READING FIRST COLUMN
660 GOSUB 760
670 FOR J%=1% TO I%-1%
680	PRINT #2%,I$(J%)+"  "+N$(J%)
690 NEXT J%
700 GO TO 880
710	! END OF DIRECTORY WHEN PRINTING DIRECTORY
720 FOR J%=I% TO Y%
730	PRINT #2%,I$(J%)+"  "+N$(J%)
740 NEXT J%
750 GO TO 880
760 P%=P%+1% : Q%=1%
770 PRINT #2,"DIRECTORY OF FILE "+F$+S6$+DATE$(0)+S6$+"PAGE";P%
780 PRINT #2:PRINT #2
790 RETURN
800 FOR I%=1% TO Y%
810	IF R%<N6% THEN R%=R%+1% ELSE R%=0% : GET #1%
820	IF LEFT(A$(R%),1%)="\" THEN 710
830	PRINT #2%,I$(I%)+"  "+N$(I%)+"    "+LEFT(A$(R%),6%)+"  "+
	MID(A$(R%),V1%,V2%)
840 NEXT I%
850 IF J%>0% THEN 880
860 PRINT #2,CHR$(12%)
870 Q%=0% : GO TO 550
880 PRINT #2%,CHR$(26%) : CLOSE 1%,2%
890 GO TO 9999
900	! SHORT DIRECTORY SUBROUTINE
910 OPEN F1$ FOR INPUT AS FILE 1%
920 FIELD #1,N1%*R% AS Z$,N1% AS A$(R%) FOR R%=0% TO N6%
930 INPUT"START AT (1ST 3 CHAR OF ID)";S$
940 S$=LEFT(S$,3%)
950 INPUT"END AT";W$
960 W$=LEFT(W$,3%)
970 OPEN "KB:" FOR OUTPUT AS FILE 2%
980 IF R%<N6% THEN R%=R%+1% ELSE R%=0% : GET #1%
990 IF LEFT(A$(R%),3%) < S$ THEN 980
1000 N$=MID(A$(R%),V1%,V2%) : Q%=INSTR(1%,N$,"   ")
1010 IF Z%=0% THEN 1030
1020 N$=LEFT(N$,Q%)
1030 PRINT #2,LEFT(A$(R%),6%)+"  "+N$
1040 IF R%<N6% THEN R%=R%+1% ELSE R%=0% : GET #1%
1050 IF LEFT(A$(R%),3%) < W$ THEN 1000
1060 GO TO  880
1070 	! HEADER SUBROUTINE
1080 G%=15%
1090 G$=SPACE$(G%)
1100 PRINT #2%,CHR$(10%)+CHR$(10%)
1110 PRINT #2%,G$; : PRINT#2%,"====="; FOR I%=1% TO 10% :
	PRINT #2%
1120 G9$="  " : GOSUB 1280	: GOSUB 1280
1130 G9$="      DIRECTORY"	: GOSUB 1280
1140 G9$="  "			: GOSUB 1280
1150 G9$="FILE: "+F1$		: GOSUB 1280
1155 G9$="TYPE: "+F$		: GOSUB 1280
1160 G9$="DSCR: "+V2$(0%)	: GOSUB 1280
1168 G9$="R/BL:"+NUM$(N%)	: GOSUB 1280
1170 G9$="DATE: "+DATE$(0%)	: GOSUB 1280
1180 G9$="  " : GOSUB 1280	: GOSUB 1280
1190 PRINT #2,G$;:PRINT#2,"="; FOR I=1 TO 50
1200 PRINT#2,CHR$(12%)
1210 RETURN
1220 PRINT"SKIP PAST ID#"; : INPUT LINE G1$
1230 G1$=LEFT(G1$,LEN(G1$)-2%)
1240 IF LEN(G1$)<>6% THEN RETURN
1250 IF R%<N6% THEN R%=R%+1% ELSE R%=0% : GET#1%
1260 IF LEFT(A$(R%),6%)<G1$ THEN 1250
1270 RETURN
1280 PRINT #2%,SPACE$(G%-1%)+"!!";
	LEFT(SPACE$(13%)+G9$+SPACE$(40%),48%)+"!!"
1290 RETURN
4000 DIM V2$(50),V2%(2,50)
4020 ON ERROR GO TO 4320
4030 INPUT"FILE TYPE";F$ : F$=LEFT(F$,3%)
4040 OPEN V1$+"$ATRIB" FOR INPUT AS FILE 1%
4060 FIELD #1%, 255%*A% AS Z$, 255% AS A$(A%) FOR A%=0% TO 1%
4080 IF A%<1% THEN A%=A%+1% ELSE A%=0% : GET #1% : R%=R%+1%
4100	IF LEFT(A$(A%),3%)="\\\" THEN
	PRINT"NO SUCH FILE TYPE" : GO TO 9999
4120 IF LEFT(A$(A%),3%)<>F$ THEN 4080
4140 V2%(2%,0%),N%=VAL(MID(A$(A%),4%,2%)) :
	N9%=VAL(MID(A$(A%),6%,1%))*2%
4160 N1%=510%/N% : N2%=N1%-8% : N3%=N%*N1% : N6%=N%-1%
4170 V2$(0%)=MID(A$(A%),11%,30%)
4180 FOR V%=1% TO 50%
4200 V2$(V%)=MID(A$(A%),42%+(V%-1%)*4%,2%) : IF V2$(V%)="  " THEN 4280
4220 V5%=CVT$%(MID(A$(A%),44%+(V%-1%)*4%,2%))
4240	V2%(1%,V%)=ASCII(CHR$(V5%)) :
	V2%(2%,V%)=ASCII(CHR$(SWAP%(V5%)))
4260 NEXT V%
4280 V2%(1%,0%)=V%-1% : IF N5% THEN 4300 ELSE
	PRINT"CODES: "; :
	PRINT V2$(I%)+" "; FOR I%=1% TO V%-1% : PRINT
4300 CLOSE 1% : ON ERROR GO TO 0 : RETURN
4320 IF ERR<>5% AND ERR<>21% THEN 4380 ELSE RESUME 4340
4340 READ V1$ : GO TO 4040
4360 DATA DK2:,DK1:,DK0:,DK3:
4380 PRINT"THE FILE '$ATRIB' HAS BEEN DELETED;" :
	PRINT"IT MUST BE REPLACED TO PROCEED."
9999 END