10 REM         Music database.
   20 REM        For Phil Arundel.
   30 REM        By C.J.Richardson.
   40 REM  For more information about PD
   50 REM    software send an SAE to:
   60 REM         C.J.Richardson.
   70 REM         8-Bit Software.
   80 REM
   90 REM
  100 REM V1a With OPENUP
  110 DEFFNS="RecDb1a"
  120 MODE7
  130 VDU23;8202;0;0;0;
  140 PROCd("Remove program disc,"):PROCd("insert data disc into drive 0.")
  150 PROCd("Then press a key")
  160 REPEATUNTILGET
  170 ONERROR VDU3,15:IF ERR=214 PROCopenfiles ELSE REPORT:PRINTERL:PRINT"PRESS A KEY":IFERR<>222 PROCclose:REPEATUNTILGET ELSE REPEATUNTILGET
  180 *INFO Records
  190 P%=0:PROCopen:PROCclose
  200 REPEAT:CLS:*FX21
  210 PROCd("Record database by C.J.Richardson")
  220 PROCd("Records:"+STR$X%)
  230 IFX%<6588 PROCd("1.(A)dd data") ELSE PROCd("Database full!")
  240 PROCd("2.(E)dit data")
  250 PROCd("3.(V)iew all data")
  260 PROCd("4.(T)itle/performer search")
  270 PROCd("5.(R)ecord company search")
  280 PROCd("6.(Y)ear of release search")
  290 PROCd("7.(S)ort by artist alphabetically")
  300 IFP%=0:PROCd("8.(P)rinter off") ELSE PROCd("8.(P)rinter on")
  310 REPEAT:A$=GET$:UNTILINSTR("AEVTRYSP12345678",A$):CLS:PROCopen
  320 IFX%<6588IFINSTR("A1",A$)PROCd("Add record "+STR$(X%+1)):PROCadd:PROCwrite1
  330 IFINSTR("E2",A$)P%=0:PROCedit
  340 IFINSTR("V3",A$)PROCviewall
  350 IFINSTR("TRY456",A$)PROCsearch
  360 IFINSTR("S7",A$)PROCsort
  370 IFINSTR("P8",A$)P%=P%EOR1
  380 PROCclose
  390 UNTILFALSE
  400 DEFPROCopen
  410 F%=OPENUP":0.Records"
  420 G%=OPENUP":2.Records"
  430 ENDPROC
  440 DEFPROCclose
  450 X%=(EXT#F%+EXT#G%)/62
  460 CLOSE#F%
  470 CLOSE#G%
  480 ENDPROC
  490 DEFPROCopenfiles
  500 PROCd("No datafile found on disc")
  510 PROCd("To set up datafiles press Y")
  520 PROCd("Pressing Y will destroy any")
  530 PROCd("file by the name of Record")
  540 PROCd("On side 0 and 2 of the disc")
  550 PROCd("in the drive.  Y/N")
  560 IFGET$<>"Y"ENDPROC
  570 F%=OPENOUT":0.Records"
  580 G%=OPENOUT":2.Records"
  590 CLS:PROCd("Enter the first record"):PROCadd:PROCwrite1
  600 PROCclose
  610 ENDPROC
  620 DEFPROCd(D$):PRINTTAB(16-LEN(D$)/2);"��";D$;TAB(16-LEN(D$)/2);"��";D$:ENDPROC
  630 DEFPROCadd
  640 REPEAT:PROCd("Enter performer/group name")
  650 INPUTT$:T%=ASC(LEFT$(T$,1)):UNTILT%>64ANDT%<91
  660 T$=T$+STRING$(26," ")
  670 T$=LEFT$(T$,26)
  680 PROCd("Enter A side title")
  690 PROCg
  700 PROCd("Enter B side title")
  710 PROCg
  720 CLS
  730 PROCi
  740 T$=T$+U$
  750 CLS
  760 PROCd("Enter year of release. Eg 93")
  770 REPEAT:INPUTU$
  780 UNTILLENU$=2
  790 T$=T$+U$
  800 FORL%=1TO56
  810 IFASC(MID$(T$,L%))>96 T$=LEFT$(T$,L%-1)+CHR$(ASC(MID$(T$,L%))-32)+MID$(T$,L%+1)
  820 NEXT
  830 ENDPROC
  840 DEFPROCi
  850 PROCd("Enter record company code:")
  860 RESTORE:L%=0:R%=0:REPEAT:READU$:IFU$<>""PRINTTAB(R%)STR$L%;". ";U$;:R%=R%+14:IFR%=42R%=0
  870 L%=L%+1
  880 UNTILU$=""
  890 PRINT
  900 REPEAT
  910 INPUTU$
  920 IFLENU$=1U$="0"+U$
  930 UNTILLENU$=2 AND VALU$<L%-1
  940 ENDPROC
  950 DEFPROCg
  960 INPUTU$
  970 U$=U$+STRING$(15," ")
  980 U$=LEFT$(U$,15)
  990 T$=T$+U$
 1000 ENDPROC
 1010 DATAOTHER,A+M,ASYLUM,BMG,EPIC,MUTE,POLYGRAM,REPRISE,""
 1020 DEFPROCwrite1
 1030 PTR#F%=EXT#F%
 1040 PTR#G%=EXT#G%
 1050 IFEXT#F%<&31DC4 PRINT#F%,T$ ELSE IF EXT#G%<&31DC4 PRINT#G%,T$ ELSE PROCd("DISC FULL!! Press a key"):REPEATUNTILGET:REM NOT NEEDED
 1060 ENDPROC
 1070 DEFPROCedit
 1080 PROCd("Enter item number to edit")
 1090 PROCh
 1100 INPUT#I%,T$:T%=T%+1:PROCpres
 1110 PTR#I%=PTR#I%-62
 1120 PROCd("Entry "+STR$T%)
 1130 PROCadd
 1140 PRINT#I%,T$
 1150 ENDPROC
 1160 DEFPROCh
 1170 PROCd("1 to "+STR$X%)
 1180 REPEAT:INPUT T%:UNTILT%>0AND T%<=X%
 1190 IFT%<3295 I%=F% ELSE I%=G%
 1200 T%=T%-1:IF T%<3294:PTR#I%=T%*62 ELSE PTR#I%=(T%-3294)*62
 1210 ENDPROC
 1220 DEFPROCviewall
 1230 PROCd("View all data")
 1240 PROCd("Enter start record")
 1250 PROCh
 1260 IFP%=1PROCd("Prepare printer, press a key"):REPEATUNTILGET:VDU2 ELSE PROCd("Press shift to scroll text"):VDU14
 1270 REPEAT
 1280 T%=T%+1
 1290 INPUT#I%,T$
 1300 PROCpres
 1310 IF PTR#I%=EXT#I% I%=G%
 1320 UNTILPTR#G%=EXT#G% AND I%=G%
 1330 VDU3,15
 1340 PROCd("Press a key")
 1350 REPEATUNTILGET
 1360 ENDPROC
 1370 DEFPROCpres
 1380 RESTORE
 1390 FORL%=0TOVAL(MID$(T$,57,2))
 1400 READU$
 1410 NEXT
 1420 PRINT"Record: ";STR$T%
 1430 PRINT"Performer: ";LEFT$(T$,26);" ";:IFP%=0PRINT
 1440 PRINT"Company: ";U$;" ";:IFP%=0PRINT
 1450 PRINT"Released: 19";RIGHT$(T$,2)
 1460 PRINT"A side: ";MID$(T$,27,15);" ";:IFP%=0PRINT
 1470 PRINT"B side: ";MID$(T$,42,15)
 1480 PRINT
 1490 ENDPROC
 1500 DEFPROCj
 1510 FORL%=1TOLENS$
 1520 IFASC(MID$(S$,L%))>96 S$=LEFT$(S$,L%-1)+CHR$(ASC(MID$(S$,L%))-32)+MID$(S$,L%+1)
 1530 NEXT
 1540 ENDPROC
 1550 DEFPROCsearch
 1560 PROCd("Search")
 1570 IFINSTR("T4",A$)PROCd("Please enter search name"):INPUTS$:PROCj
 1580 IFINSTR("R5",A$)PROCi:S$=U$
 1590 IFINSTR("Y6",A$)PROCd("Enter search year eg 93"):REPEAT:INPUTS$:UNTILLENS$=2
 1600 PROCd("Search to start from:")
 1610 PROCh
 1620 IFP%=1PROCd("Prepare printer. Press a key"):REPEATUNTILGET:VDU2 ELSE PROCd("Press shift to scroll"):VDU14
 1630 REPEAT
 1640 INPUT#I%,T$
 1650 T%=T%+1
 1660 IF INSTR("Y6",A$)=0 IFINSTR(T$,S$) PROCpres
 1670 IF INSTR("Y6",A$)IFRIGHT$(T$,2)=S$ PROCpres
 1680 IF PTR#I%=EXT#I% I%=G%
 1690 UNTILPTR#G%=EXT#G% AND I%=G%
 1700 VDU3,15
 1710 PROCd("Press a key")
 1720 REPEATUNTILGET
 1730 ENDPROC
 1740 DEFPROCsort
 1750 PROCd("Alphabetical sort by artist")
 1760 PROCd("Source drive 0")
 1770 PROCd("Destination drive 1")
 1780 PROCd("Ensure disc in drive 1 is BLANK!")
 1790 PROCd("Press C to confirm and start")
 1800 PROCd("Any other to abandon")
 1810 IFGET$<>"C" ENDPROC
 1820 H%=OPENOUT":1.Records"
 1830 I%=OPENOUT":3.Records"
 1840 U$="@":U%=0
 1850 REPEAT
 1860 K%=H%
 1870 U$=CHR$(ASC(U$)+1)
 1880 PTR#F%=0
 1890 PTR#G%=0
 1900 J%=F%
 1910 REPEAT
 1920 INPUT#J%,T$
 1930 IFLEFT$(T$,1)=U$:PRINT#K%,T$:PRINTTAB(0,12);:U%=U%+1:PROCd(STR$U%+" out of "+STR$X%+" sorted"):PROCd("Sorting "+U$)
 1940 IFPTR#J%=EXT#F% J%=G%
 1950 IFPTR#K%=&31DC4 K%=I%
 1960 UNTILPTR#G%=EXT#G% AND J%=G%
 1970 UNTILU$="Z" OR U%=X%
 1980 CLOSE#H%
 1990 CLOSE#I%
 2000 ENDPROC