Compucolor.org – Virtual Media

Listing of file='INDEX.BAS;01' on disk='vmedia/catalog_32-sector.ccvf'

100 REM  INDEX FOR CATALOG 28/3/81
110 PLOT 12:CLEAR 200
120 PLOT 6,8,14,3,12,0:PRINT "   C A T A L O G   E D I T O R   ":PLOT 6,2,15:PRINT :PRINT
130 PRINT "SETTING UP ALL THE FILES.":PRINT
140 D= 0:D1= 0:D9= 0:DD= 0:DR= 0:DMY= 0:HZ= 0:I= 0:LZ= 0:M= 0:M1= 0:N= 0:N1= 0:N2= 0:NU= 0:PR= 0:RE= 0
150 S1= 0:S2= 0:SB= 0:SZ= 0:T2= 0:TM= 0:UP= 0:Y= 0:Y1= 0:Z= 0:Z1= 0:Z2= 0:Z3= 0:ZZ= 0
160 AL$= "":B$= "":DD$= "":DMY$= "":DN$= "":DR$= "":DS$= "":IN$= "":LA$= "":NN$= ""
170 S1$= "":S2$= "":S3$= "":SB$= "":ST$= "":SZ$= "":YN$= "":Z1$= "":ZZ$= ""
180 FOR I= 0TO 9:N$(I)= MID$ (STR$ (I),2):NEXT I
190 TM= PEEK (32940)+ PEEK (32941)* 256
200 Z= TM+ 3:GOSUB 1170:LA$= B$
210 ZZ= TM+ 5:LZ= ZZ+ 1:HZ= LZ+ 9:Z3= 33054
220 DR= PEEK (TM+ 1):DR$= MID$ (STR$ (DR),2)+ ":"
230 PR= PEEK (TM+ 2):FILE "T",1460
240 FILE "R",1,"INDEX.RND",1:FILE "R",2,"INDEX.INF",1:GET 1;ST$[1]
250 GET 2,1;DD,SB,N1,N2,DMY:M= INT (DMY/ 3200):D= INT ((DMY- M* 3200)/ 100):Y= DMY- (INT (DMY/ 100)* 100)
260 PRINT "INDEX LAST ACCESSED ON "D" /"M" /"Y"":PRINT
270 Z= SB:GOSUB 1170
280 PRINT "INDEX HOLDS "N1+ N2" RECORDS,":PRINT
290 PRINT ""N1" ON DATA DISK #1 AND "N2" ON DATA DISK #2":PRINT
300 PRINT "THE CURRENT START BLOCK IS "B$" ON DATA DISK #"DD"":PRINT
310 INPUT "WHAT IS TODAY'S DATE ?  D,M,Y  ";D,M,Y:GOSUB 1230:PRINT "":PRINT
320 PRINT "INPUT, AMEND, ERASE, DIRECTORIES IN INDEX; OR"
322 PRINT "PRINT A MENU, DIRECTORY; CHANGE A DIRECTORY NAME; OR"
324 PRINT "ADVISE CURRENT STARTING BLOCK, CHANGE TO DATA DISK #2"
326 INPUT IN$:PRINT
330 IF IN$= "I"THEN UP= 0:GOTO 410
340 IF IN$= "A"THEN UP= 1:GOTO 410
350 IF IN$= "D"THEN 660
360 IF IN$= "M"THEN 770
370 IF IN$= "C"THEN 930
372 IF IN$= "S"THEN 1290
374 IF IN$= "2"THEN 1300
376 IF IN$= "E"THEN 1360
380 IF IN$= ""OR IN$= "0"THEN 400
390 GOTO 320
400 PRINT :INPUT "RETURN PROGRAM DISC TO CD0:  ";YN$:PRINT :FILE "C",1,2:PLOT 1
410 GOSUB 1100
420 IF UP= 1THEN 460
430 DD$= CHR$ (48+ DD):GET 1,RE;ST$[1]:GET 2,1,5;SB
440 IF ASC (ST$)< > 0THEN PRINT "DATA ALREADY EXISTS FOR  "DN$"":GOTO 410
450 GOTO 480
460 GET 1,RE;ST$[1]:IF ASC (ST$)= 0THEN PRINT "NO RECORD EXISTS FOR "DN$:PRINT :GOTO 320
465 GET 1,RE,11;S1$[1],S2$[1],S3$[1]:DD$= MID$ (STR$ (1- (S1$> CHR$ (127))),2)
470 TZ= (ASC (S1$)AND 127):SB= ASC (S2$)+ ASC (S3$)* 256
480 IF DR= 1THEN 500
490 PRINT "PLACE DISK "DN$" IN CD0: ":INPUT "";YN$:GOTO 510
500 PRINT "PLACE DATA DISK #"DD$" IN CD1: AND DISK "DN$" IN CD0:":INPUT "";YN$
510 PLOT 27,4:PRINT "DIR0:":PRINT "REA 0: 0 "+ LA$+ " 500":PLOT 27,27
515 SZ= PEEK (Z3)+ 1:IF SZ> 10THEN PRINT :PRINT "DIRECTORY SIZE TOO LARGE - RECORD NOT ADDED.":PRINT :GOTO 320
520 Z= SB:GOSUB 1170:SB$= B$:Z= SZ* 128:GOSUB 1170:SZ$= B$
530 IF UP= 0AND SB+ SZ> 400THEN 1240
540 IF UP= 1AND SZ> TZTHEN PRINT "DIRECTORY SIZE LARGER! - RECORD NOT UPDATED.":PRINT :GOTO 320
550 IF DR= 0THEN PRINT "PLACE DATA DISK #"DD$" IN CD0: ":INPUT "";YN$
560 PLOT 27,4:PRINT "WRI"+ DR$+ " "+ SB$+ " "+ LA$+ " "+ SZ$:PLOT 27,27
570 Z1$= CHR$ (SZ- 128* (DD$> "1"))
580 S2= INT (SB/ 256):S1= SB- 256* S2:ZZ$= Z1$+ CHR$ (S1)+ CHR$ (S2)
590 NN$= "":FOR I= LZTO HZ:NN$= NN$+ CHR$ (PEEK (I)):NEXT
600 PUT 1,RE;NN$[10],ZZ$[3],DMY$[3]:PUT 2,1,17;DMY
610 IF UP= 1THEN GET 2,1,5;SB:PRINT :GOTO 320
620 SB= SB+ SZ:PUT 2,1,5;SB
630 IF DD= 1THEN N1= N1+ 1:PUT 2,1,9;N1:GOTO 650
640 IF DD= 2THEN N2= N2+ 1:PUT 2,1,13;N2
650 PRINT :GOTO 320
660 GOSUB 1100
670 GET 1,RE;ST$[1]:IF ASC (ST$)= 0THEN PRINT "NO RECORD EXISTS FOR "DN$:PRINT :GOTO 320
680 GET 1,RE,11;S1$[1],S2$[1],S3$[1]:SZ= (ASC (S1$)AND 127):SB= ASC (S2$)+ ASC (S3$)* 256
690 Z= SZ* 128:GOSUB 1170:SZ$= B$:Z= SB:GOSUB 1170:SB$= B$:DD$= MID$ (STR$ (1- (S1$> CHR$ (127))),2)
700 PRINT "INSERT DATA DISK #"DD$" IN CD"DR$"":INPUT "";YN$
710 PLOT 27,4:PRINT "REA"+ DR$+ " "+ SB$+ " "+ LA$+ " "+ SZ$:PRINT "WRI"+ DR$+ "0 "+ LA$+ " "+ SZ$
720 PRINT "DIR"+ DR$:PLOT 27,27
730 IF PR= 0THEN 760
740 INPUT "SEND IT TO THE PRINTER?   ";IN$
750 IF IN$= "Y"THEN PLOT 27,7:PRINT "DIR"+ DR$:PLOT 27,27
760 GET 2,1,5;SB:PRINT :GOTO 320
770 INPUT "WHICH MENU (A-J)? ";IN$:IF IN$< "A"OR IN$> "J"THEN PLOT 28,11:GOTO 770
780 PRINT :PRINT "MENU FOR "IN$"  SERIES":PRINT :PRINT "NO."TAB( 8)"NAME"TAB( 20)"SIZE"TAB( 26)"SBLK";
790 PRINT TAB( 34)"DATA DISK"TAB( 48)"DATE INPUT":PRINT
800 RE= (ASC (IN$)- 65)* 20+ 1
810 FOR I= 0TO 19:N= INT (I/ 2)
820 IF I- 2* N= 0THEN DS$= "F":GOTO 840
830 DS$= "B"
840 PRINT IN$N$(N)" "DS$;
850 GET 1,RE+ I;NN$[10],S1$[1],S2$[1],S3$[1],D$[1],M$[1],Y$[1]
860 IF ASC (LEFT$ (NN$,1))= 0THEN PRINT :GOTO 910
870 D9= 1- (ASC (S1$)> 127)
880 Z= (ASC (S1$)AND 127):GOSUB 1170:SZ$= B$:Z= ASC (S3$)* 256+ ASC (S2$):GOSUB 1170:SB$= B$
890 D1= ASC (D$):M1= ASC (M$):Y1= ASC (Y$)
900 PRINT TAB( 8)NN$TAB( 20)SZ$TAB( 26)SB$TAB( 37)D9TAB( 47)D1"/"M1"/"Y1
910 NEXT I
920 PRINT :GOTO 320
930 GOSUB 1100
940 GET 1,RE;ST$[1]:IF ASC (ST$)= 0THEN PRINT "NO RECORD!  ":PRINT :GOTO 320
950 GET 1,RE,11;S1$[1],S2$[1],S3$[1]:GET 2,1,5;SB
960 DD$= MID$ (STR$ (1- (S1$> CHR$ (127))),2)
970 Z= ASC (S2$)+ ASC (S3$)* 256:GOSUB 1170:SB$= B$
980 IF DR= 1THEN 1000
990 PRINT "PLACE DISK "DN$" IN CD0: ":INPUT "";YN$:GOTO 1010
1000 PRINT "PLACE DATA DISK #"DD$" IN CD1: AND DISK "DN$" IN CD0:  ":INPUT "";YN$
1010 PLOT 27,4:PRINT "DIR0:":PRINT "REA 0: 0 "+ LA$+ " 80":PLOT 27,27
1020 INPUT "NEW DIRECTORY NAME? ";IN$:IN$= LEFT$ (IN$+ "          ",10)
1030 FOR I= 1TO 10:POKE ZZ+ I,ASC (MID$ (IN$,I,1)):NEXT I
1040 PLOT 27,4:PRINT "WRI"+ DR$+ " "+ SB$+ " "+ LA$+ " 80":PLOT 27,27
1050 IF DR= 1THEN 1070
1060 PRINT "PLACE DATA DISK #"DD$" IN CD0: ":INPUT "";YN$
1070 PLOT 27,4:PRINT "WRI0: 0 "+ LA$+ " 80":PRINT "DIR 0:":PLOT 27,27
1080 PUT 1,RE;IN$[10]:PUT 1,RE,14;DMY$[3]
1090 PRINT :GOTO 320
1100 PRINT :INPUT "DISK NUMBER AND SIDE  E.G. C2F  ";DN$:PRINT
1110 IF LEN (DN$)< > 3THEN 1100
1120 DS$= RIGHT$ (DN$,1):IF DS$< > "F"AND DS$< > "B"THEN 1100
1130 AL$= LEFT$ (DN$,1):IF AL$< "A"OR AL$> "J"THEN 1100
1140 NU= VAL (MID$ (DN$,2,1)):IF NU< 0OR NU> 9THEN 1100
1150 RE= (ASC (AL$)- 65)* 20+ NU* 2+ 1- (DS$= "B")
1160 RETURN
1170 B$= "":Z2= Z
1180 Z1= Z2- INT (Z2/ 16)* 16:Z2= INT (Z2/ 16)
1190 IF Z1< 10THEN B$= CHR$ (48+ Z1)+ B$
1200 IF Z1> 9THEN B$= CHR$ (55+ Z1)+ B$
1210 IF Z2= 0THEN RETURN
1220 GOTO 1180
1230 Y= Y- (INT (Y/ 100)* 100):DMY= M* 3200+ D* 100+ Y:DMY$= CHR$ (D)+ CHR$ (M)+ CHR$ (Y):RETURN
1240 IF DD= 2THEN PRINT "BOTH DATA DISKS FULL - RECORD NOT ADDED":PRINT :GOTO 400
1250 PRINT "DATA DISK FULL - SETTING UP DATA DISK #2":PRINT
1260 DD= 2:SB= 10:Z= SB:GOSUB 1170:SB$= B$
1270 PUT 2,1;DD,SB,N1,N2,DMY:IF IN$= "2"THEN 320
1280 GOTO 550
1290 Z= SB:GOSUB 1170:PRINT "THE CURRENT START BLOCK IS "B$" ON DATA DISK #"DD"":PRINT :GOTO 320
1300 IF DD= 2THEN PRINT "CURRENT DATA DISK IS #2":PRINT :GOTO 320
1310 Z= 400- SB:PRINT "THIS MOVE WILL WASTE "Z" SECTORS OF DATA DISK #1"
1320 INPUT "DO YOU STILL WISH TO PROCEED  Y/N? ";YN$:PRINT
1330 IF YN$= "Y"THEN 1260
1340 IF YN$< > "N"THEN 1320
1350 GOTO 320
1360 GOSUB 1100:GET 1,RE;ST$[1]:IF ST$= CHR$ (0)THEN PRINT "NO RECORD EXISTS FOR "DN$:PRINT :GOTO 320
1370 GET 1,RE,11;S1$[1],S2$[1],S3$[1]:Z= (ASC (S1$)AND 127):GOSUB 1170:SZ$= B$
1380 DD$= MID$ (STR$ (1- (S1$> CHR$ (127))),2)
1390 PRINT "THIS ERASURE WASTES "SZ$" SECTORS OF DATA DISK #"DD$""
1400 INPUT "DO YOU STILL WISH TO PROCEED  Y/N? ";YN$:PRINT
1410 IF YN$= "N"THEN 320
1420 IF YN$< > "Y"THEN 1400
1430 PUT 1,RE;CHR$ (0)[1]:IF DD$= "1"THEN N1= N1- 1:GOTO 1450
1440 N2= N2- 1
1450 PUT 2,1,9;N1,N2,DMY:GOTO 320
1460 PRINT :PRINT "FILE ERROR!":PRINT :FILE "E",FL,ER,LN
1470 PRINT "A #"ER" ERROR OCCURRED IN FILE"FL" IN LINE NUMBER"LN"":PRINT
1480 INPUT "PRESS ENTER FOR FILE CLOSURE AND RETURN TO MENU. ";YN$:PRINT :GOTO 400