1 REM  ****************************************************************
2 REM  *	 Module name  :	index.bas                             *
3 REM  *	 Purpose      :	Disc Library Index                    *
4 REM  *	 Created      :	??-??-88			      * 
5 REM  *         Last edited  : 17-11-89	    Version 1.0       *
6 REM  *         Copyright    :	G R Buckeridge			      *
7 REM  ****************************************************************
50 REM
60 DEFINT a-z:GOSUB 1100
70 imax=750:DIM f$(imax),loc$(imax),ind(imax)
80 e$=CHR$(27):con$=e$+"e":cof$=e$+"f":bel$=CHR$(7):file1$="m:index.dat":dma=&HF528
90 filfcb=&HF500:setdma=&HF50D:find1=&HF516:find2=&HF522:qtr=&HF527
100 IF FIND$(file1$)="" THEN OPEN "o",1,file1$:CLOSE #1:GOTO 130
110 REM 
120 REM displays heading
130 PRINT CHR$(27)+"E"+CHR$(27)+"H"
140 PRINT TAB(30);"DISC LIBRARY INDEX"
150 PRINT TAB(30);"------------------":PRINT:PRINT:PRINT
160 PRINT "Which Disc Drive (A/B)        ";con$;
170 dr$=UPPER$(INPUT$(1)):IF INSTR("AB",dr$)=0 THEN PRINT bel$;:GOTO 170
180 PRINT cof$;dr$:flag=0
190 REM 
200 REM fills fcb with '?'s and sets up dma address
210 OPTION FILES dr$
220 CALL filfcb
230 REM 
240 REM finds disc label
250 PRINT:PRINT"Searching for Disc Label  ";
260 POKE qtr,0:WHILE PEEK(qtr)<>255 AND user <>32
270 IF flag=0 THEN CALL find1 :flag=1 ELSE CALL find2
280 den=dma+(PEEK(qtr)*32):user=PEEK(den)
290 WEND
300 f$="":dn$="No Disc Name"+bel$
310 IF user =32 THEN FOR k = 1 TO 11:f$=f$+CHR$(PEEK(den+k )):NEXT:dn$=RIGHT$(f$,3) ELSE PRINT dn$:GOTO 520
320 flag=0:PRINT f$:GOSUB 810
330 last=last+1:f$(last)=" "+RIGHT$(f$,2)+MID$(f$,9,1)+LEFT$(f$,8):loc$(last)=RIGHT$(f$,3)+"   "
340 ind(last)=last
350 CALL setdma
360 REM 
370 REM reads directory
380 PRINT:PRINT"Adding New Directory      ";
390 POKE qtr,0:WHILE PEEK(qtr)<>255 AND i<=imax-1
400 IF flag=0 THEN CALL find1 :flag=1 ELSE CALL find2
410 f$="":den=dma+(PEEK(qtr)*32)
420 FOR k=1 TO 11:f$=f$+CHR$(PEEK(den+k )):NEXT
430 user =PEEK(den):ext =PEEK(den+12)
440 IF user >15 OR ext >0 THEN 480
450 last=last+1
460 user$=STR$(user ):loc$(last)=dn$+"-"+RIGHT$("0"+RIGHT$(user$,LEN(user$)-1),2)
470 f$(last)=f$:ind(last)=last:i=last:GOSUB 1060
480 WEND:PRINT
490 IF last>=imax THEN PRINT:PRINT con$;"TOO MANY FILES - Try again with an already indexed disc, but sort this time.";bel$:GOTO 780
500 REM 
510 REM loopback option
520 PRINT:PRINT"Another Disc (Y/N) ";con$;
530 a$=UPPER$(INPUT$(1)):IF INSTR("YN",a$)=0 THEN PRINT bel$;:GOTO 530
540 PRINT e$;"A";cof$;:IF a$="Y" THEN GOSUB 960:GOTO 130
550 REM 
560 REM does shell sort
570 PRINT:PRINT"Sorting Index File        ";
580 arr(1)=5:arr(2)=3:arr(3)=1
590 FOR incr=1 TO 3
600 span=arr(incr)
610 FOR j=span+1 TO last:i=j+((3-incr)*1000):GOSUB 1060
620 y$=f$(ind(j)):y=ind(j):k=j-span:found=0
630 WHILE k>=1 AND NOT found
640 IF y$<f$(ind(k)) THEN ind(k+span)=ind(k):k=k-span ELSE found=-1
650 WEND:ind(k+span)=y
660 NEXT j,incr
670 PRINT :GOSUB 960
680 REM 
690 REM produces xref index
700 PRINT:PRINT"Printer or Screen (P/S) ";con$;
710 a$=UPPER$(INPUT$(1)):ptr=INSTR("PS",a$):IF ptr=0 THEN PRINT bel$;:GOTO 710
720 PRINT:PRINT:IF ptr=1 THEN POKE 18527,90
730 FOR i=1 TO last
740 IF LEFT$(f$(ind(i)),1)=" " THEN PRINT "    ";RIGHT$(f$(ind(i)),8),loc$(ind(i)):GOTO 760
750 IF f$(ind(i-1))=f$(ind(i)) THEN PRINT",";loc$(ind(i));ELSE PRINT:PRINT LEFT$(f$(ind(i)),8);".";RIGHT$(f$(ind(i)),3),loc$(ind(i));
760 NEXT:POKE 18527,100
770 PRINT:PRINT:PRINT STRING$(74,"*"):PRINT bel$"* WARNING !!! INDEX.DAT must be copied from M drive before switching off *";bel$:PRINT STRING$(74,"*")
780 OPTION FILES "0A":PRINT:END
790 REM 
800 REM read index subroutine
810 PRINT:PRINT"Loading Index File        ";
820 OPEN "i",1,file1$
830 i=1
840 WHILE NOT EOF(1)
850 LINE INPUT #1,f$(i):LINE INPUT #1,loc$(i)
860 j=INSTR(loc$(i),RIGHT$(dn$,3)):k=LEN(loc$(i)):IF j=0 THEN 900
870 IF j=1 AND k=6 THEN i=i-1:GOTO 900
880 IF j=1 THEN loc$(i)=RIGHT$(loc$(i),k-j-6):GOTO 860
890 loc$(i)=LEFT$(loc$(i),j-2)+RIGHT$(loc$(i),LEN(loc$(i))-j-5):GOTO 860
900 ind(i)=i:GOSUB 1060:i=i+1
910 WEND
920 CLOSE #1:PRINT:last=i-1
930 RETURN
940 REM 
950 REM write index subroutine
960 PRINT:PRINT"Storing Index File        ";
970 OPEN "o",1,file1$
980 FOR i=1 TO last
990 IF i=1 THEN PRINT #1 f$(ind(1)):PRINT #1 loc$(ind(1));:GOTO 1010
1000 IF f$(ind(i-1))=f$(ind(i)) THEN PRINT #1",";loc$(ind(i)); ELSE PRINT #1:PRINT #1 f$(ind(i)):PRINT #1 loc$(ind(i));
1010 GOSUB 1060
1020 NEXT
1030 CLOSE #1:PRINT:RETURN
1040 REM 
1050 REM gp indicator subroutine
1060 PRINT USING "#####";i;:PRINT STRING$(5,8);
1070 RETURN
1080 REM 
1090 REM load machine code subroutine
1100 MEMORY &HF4FF
1110 DATA 3E,3F,21,5C,00,06,0C,77,23,05,C2,07,F5,0E,1A,11
1120 DATA 28,F5,CD,05,00,C9,0E,11,11,5C,00,CD,05,00,32,27
1130 DATA F5,C9,0E,12,C3,18,F5
1140 FOR i= 0 TO 38 :READ a$:POKE &HF500+i,VAL("&H"+a$):NEXT
1150 RETURN
,00,CD,05,00,32,27
1130 DATA F5,C