10 *FX220
   20 REMON ERROR PROCerror(ERR,""):CLOSE#0:CLEAR:RUN  
   30 MODE7:PROCcoff
   40 PROCinit:PROChead:PROCtop:PROCfoot 
   50 PROCinstall:PROCclear:PROCprocess(2)
   60 CHAIN"SERVER2" 
   70 :
   80 REM *** Module 1: Loads datafiles and sorts out essential ***
   90 REM ***           variables for transfer to main module 2 ***
  100 REM ***           If no datafile present then new one is  ***
  110 REM ***           offered for creation.                   ***
  120 :
  130 REM ********* PROCEDURES AND FUNCTIONS **************
  140 :
  150 DEF PROChead
  160 PRINTTAB(0,0)
  170 PRINT"‘¼¬è ´¼¬¨¼è¬¤¼¼´¼¬„                     ";
  180 PRINT"‘­ìª¬µ­ì µê¬ µ¥µ­ì†Program Copyrighted  ";
  190 PRINT"‘¬®¨¬¥¬® ¥ª¬¤¥ ¥¬®†Duncan Webster 1991  ";
  200 ENDPROC
  210 :
  220 DEF PROCfoot
  230 PRINTTAB(0,23);bar2$;
  240 ENDPROC
  250 :
  260 DEF PROCtop
  270 PRINTTAB(0,4);bar2$;
  280 ENDPROC
  290 :
  300 DEF PROCinstall
  310 PROCbar(12,10,"DATABASE")  
  320 PRINTTAB(10,13);CHR$Text%;"USERNAME"  
  330 PROCkdis:PROCcon:File$=FNenter(19,13,11):PROCcoff  
  340 IF File$="TFR5P" THEN PROCtransfer(1)
  350 IF File$="TFR4" THEN PROCtransfer(2)
  360 PROCprocess(2):PROCdelay(10)
  370 X=OPENIN (File$)
  380 IF X=0 THEN CLOSE#X:PROCnewfile:CLEAR:CHAIN"SERVER1"
  390 PTR#X=0:INPUT#X,Data$:PTR#X=50:INPUT#X,Notes$:PTR#X=100:INPUT#X,Dummy%:PTR#X=125:INPUT#X,Active%:PTR#X=150:INPUT#X,Delete%:CLOSE#X   
  400 $&C00=File$:$&C20=Data$:$&C40=Notes$:A%=Dummy%:B%=Active%:C%=Delete%:D%=-1
  410 PROCprocess(1):PROCprocess(0)
  420 ENDPROC
  430 :
  440 DEF FNenter(w1%,w2%,w4%)
  450 w3%=0
  460 IF w1%<>0 THEN w1%=w1%+1
  470 w4%=w4%-1
  480 w1$=""
  490 w2$=""
  500 IF w1%=0 AND w2%=0 THEN =w2$
  510 IF w1%>0 THEN PRINTTAB((w1%-1),w2%);CHR$Entry%;
  520 IF w1%<=0 THEN w1%=0:PRINTTAB(w1%,w2%);CHR$Entry%;   
  530 REPEAT
  540 w1$=GET$
  550  IF w1$=CHR$13 THEN GOTO 620
  560 IF w1$=CHR$127 AND w3%<1 THEN VDU7:GOTO 540
  570  IF w1$=CHR$127 THEN PRINT;CHR$127;:w2$=LEFT$(w2$,(LEN(w2$)-1)):w3%=w3%-1:GOTO 620
  580 IF w3%>=w4% THEN VDU7:GOTO 540
  590 w2$=w2$+w1$
  600 PRINT;w1$;
  610 w3%=w3%+1
  620 UNTIL w1$=CHR$13
  630 =w2$
  640 :
  650 DEF PROCprocess(m%)
  660 PRINTTAB(0,24);SPC(39);
  670 IF m%=1 THEN PRINTTAB(29,24);CHR$136;CHR$Text%;"ACCEPTED";:PROCdelay(100):ENDPROC   
  680 IF m%=2 THEN PRINTTAB(27,24);CHR$Text%;CHR$136;"PROCESSING";   
  690 IF m%=3 THEN PRINTTAB(29,24);CHR$136;CHR$Text%;"REJECTED";:VDU7:PROCdelay(200):ENDPROC  
  700 ENDPROC
  710 :
  720 DEF PROCnewfile
  730 PROCprocess(0)
  740 PROCclear:PROCbar(13,8,"NEW")  
  750 PROCmenuselect(2,10,10) 
  760 PRINTTAB(20,10);CHR$Entry%;File$ 
  770 PROCcon:Data$=FNenter(20,11,11)  
  780 Notes$=FNenter(20,12,11)  
  790 d$=FNenter(20,13,4):Dummy%=VAL(d$):IF Dummy%=0 THEN Dummy%=50  
  800 PRINTTAB(20,13);CHR$Entry%;Dummy%;SPC(10) 
  810 *FX15
  820 PRINTTAB(20,14);CHR$Entry%;  
  830 c$=FNenter(20,14,4):PROCcoff
  840 IF c$<>"YES" THEN CLOSE#0:CLEAR:RUN  
  850 PROCprocess(2):PROCdelay(50)
  860 IF Data$="" OR File$="" OR Notes$="" THEN PROCerror(0,"INACCURATE ENTRIES"):GOTO 730   
  870 PROCprocess(2)
  880 PRINTTAB(6,17);CHR$Text%;"CREATING USERNAME ";CHR$Entry%;File$  
  890 X=OPENOUT (File$)
  900 PTR#X=0:PRINT#X,Data$:PTR#X=50:PRINT#X,Notes$:PTR#X=100:PRINT#X,Dummy%:PTR#X=125:PRINT#X,0:PTR#X=150:PRINT#X,0:CLOSE#X   
  910 PROCprocess(1):PROCprocess(0)
  920 PRINTTAB(6,18);CHR$Text%;"CREATING DATABASE ";CHR$Entry%;Data$   
  930 PROCprocess(2)
  940 X=OPENIN (Data$)
  950 CLOSE#X:IF X<>0 THEN PROCexists(File$):CLEAR:RUN  
  960 X=OPENOUT (Data$)
  970 PROCprocess(1):PROCprocess(0):PROCprocess(2) 
  980 PRINTTAB(6,19);CHR$Text%;"RESERVING RECORD  ";CHR$Entry%  
  990 FOR c%=0 TO (Dummy%-1)  
 1000 PTR#X=(c%*Step%)
 1010 PRINT#X,STRING$(28,"#"),STRING$(15,"#"),STRING$(15,"#"),STRING$(15,"#"),STRING$(20,"#"),STRING$(10,"#"),"#",0,"#","#"
 1020 PRINTTAB(26,19);(c%+1)  
 1030 NEXT c%
 1040 CLOSE#X:PROCprocess(1):PROCprocess(0):PROCprocess(2) 
 1050 X=OPENIN (Notes$)
 1060 CLOSE#X:IF X<>0 THEN PROCexists2(File$,Data$):CLEAR:RUN
 1070 X=OPENOUT (Notes$)
 1080 PRINTTAB(6,20);CHR$Text%;"RESERVING NOTES   ";CHR$Entry%  
 1090 FOR c%=0 TO (Dummy%-1)
 1100 PTR#X=(c%*Step2%)
 1110 PRINT#X,STRING$(80,"#"),STRING$(40,"#"),STRING$(40,"#"),STRING$(40,"#"),0
 1120 PRINTTAB(26,20);(c%+1) 
 1130 NEXT c%
 1140 CLOSE#X:PROCprocess(1):PROCprocess(0):PROCdelay(50)
 1150 CLOSE#0:ENDPROC
 1160 :
 1170 DEF PROCexists(d$)
 1180 OSCLI("DELETE "+d$)
 1190 PROCerror(0,"DATABASE EXISTS") 
 1200 ENDPROC
 1210 :
 1220 DEF PROCexists2(d1$,d2$)
 1230 OSCLI("DELETE "+d1$) 
 1240 OSCLI("DELETE "+d2$) 
 1250 PROCerror(0,"NOTEFILE EXISTS")
 1260 ENDPROC
 1270 :
 1280 DEF PROCerror(Error%,Error$)
 1290 PROCcoff:IF Error%=0 THEN PROCusererr(Error$):ENDPROC   
 1300 PROCkdis
 1310 PROCclear:PROChead:PROCtop:PROCfoot:PROCprocess(0):PROCcoff:PROCkoff
 1320 IF Error%=&BF THEN PRINTTAB(11,8);CHR$Text%;"Disc Full"
 1330 IF Error%=&BD THEN PRINTTAB(11,8);CHR$Text%;"Access Violation"
 1340 IF Error%=&CC THEN PRINTTAB(11,8);CHR$Text%;"Bad Name"
 1350 IF Error%=&A8 THEN PRINTTAB(11,8);CHR$Text%;"Broken Dir"
 1360 IF Error%=&C7 THEN PRINTTAB(11,8);CHR$Text%;"Disc Error"
 1370 IF Error%=&C6 THEN PRINTTAB(11,8);CHR$Text%;"Disc Full"
 1380 IF Error%=&D6 THEN PRINTTAB(11,8);CHR$Text%;"Not Found"
 1390 IF Error%=&CE THEN PRINTTAB(11,8);CHR$Text%;"Bad Dir"
 1400 IF Error%=&FE THEN PRINTTAB(11,8);CHR$Text%;"Bad Command"
 1410 IF Error%=&A9 THEN PRINTTAB(11,8);CHR$Text%;"Bad FS Map"
 1420 IF Error%=&98 THEN PRINTTAB(11,8);CHR$Text%;"Compact Reqd"
 1430 IF Error%=&C3 THEN PRINTTAB(11,8);CHR$Text%;"File Locked"
 1440 IF Error%=&CD THEN PRINTTAB(11,8);CHR$Text%;"Bad Drive"
 1450 IF Error%=&C9 THEN PRINTTAB(11,8);CHR$Text%;"Disc Protected"
 1460 IF Error%=&C9 THEN PRINTTAB(11,8);CHR$Text%;"Disc Changed"
 1470 IF Error%=&C5 THEN PRINTTAB(11,8);CHR$Text%;"Drive Fault"
 1480 IF Error%=&C4 THEN PRINTTAB(11,8);CHR$Text%;"File Exists"
 1490 IF Error%=&C2 THEN PRINTTAB(11,8);CHR$Text%;"File Open"
 1500 IF Error%=&C0 THEN PRINTTAB(11,8);CHR$Text%;"Too Many Open"
 1510 IF Error%=&BF THEN PRINTTAB(11,8);CHR$Text%;"Can't Extend"
 1520 IF Error%=&BE THEN PRINTTAB(11,8);CHR$Text%;"Catalogue Full"
 1530 PRINTTAB(11,11);CHR$Text%;"SYSTEM ERROR"   
 1540 PRINTTAB(0,22);CHR$Text%;"REFERENCE ";ERL;"-";ERR;TAB(25,22);CHR$136;" REFER MANUAL"   
 1550 PRINTTAB(2,15);CHR$Text%;"RE BOOTING PROGRAM - PRESS RETURN"
 1560 *FX15
 1570 a=GET
 1580 CLOSE#0
 1590 ENDPROC
 1600 :
 1610 DEF PROCusererr(Error$)
 1620 PROCprocess(0):PROCcoff:PROCkoff:VDU7:VDU7:PROCdelay(150)
 1630 PRINTTAB(39-((LEN(Error$)+2)),24);CHR$136;CHR$Text%;Error$;
 1640 PROCdelay(300)
 1650 ENDPROC
 1660 :
 1670 DEF PROCinit
 1680 bar2$="”¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬"  
 1690 bar$="”¬¬¬¬¬¬¬¬¬®¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬"   
 1700 bar3$="”¬¬¬¬¬¬¬¬¬ì¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬¬,"
 1710 $&C00="XXXXXXXXXXXXXXXXXXXX":REM *** File$ Stored Here *** 
 1720 $&C20="XXXXXXXXXXXXXXXXXXXX":REM *** Data$ Stored Here *** 
 1730 $&C40="XXXXXXXXXXXXXXXXXXXX":REM *** Notes$ Stored Here ***  
 1740 T=OPENIN"SERVER9":IF T=0 THEN CLOSE#0:CLS:PRINT"User ID Invalid":END
 1750 PTR#T=12:INPUT#T,$&C60:PTR#T=4:INPUT#T,$&C62:PTR#T=70:INPUT#T,$&C64:CLOSE#T 
 1760 A%=0:REM *** Dummy% ***
 1770 B%=0:REM *** Active% ***
 1780 C%=0:REM *** Delete% ***
 1790 D%=-1:REM *** Menu Selection Choice ***
 1800 Text%=134:Entry%=135:Step%=130:Step2%=220  
 1810 *KEY12 1|M 
 1820 *KEY13 0|M 
 1830 *KEY14 1|M 
 1840 *KEY15 0|M
 1850 ENDPROC
 1860 :
 1870 DEF PROCclear
 1880 FOR c%=5 TO 22 STEP 1
 1890 PRINTTAB(0,c%);SPC(40);
 1900 NEXT c%
 1910 ENDPROC
 1920 :
 1930 DEF PROCkon
 1940 *FX4,2
 1950 ENDPROC
 1960 :
 1970 DEF PROCkoff
 1980 *FX4,0
 1990 ENDPROC
 2000 IF s%=8 THEN PROCadd:ENDPROC
 2010 ENDPROC
 2020 VDU23;8202;0;0;0;
 2030 ENDPROC
 2040 :
 2050 DEF PROCcon
 2060 VDU23,0,10,64;0;0;0; 
 2070 ENDPROC
 2080 :
 2090 DEF PROCcoff
 2100 VDU23;8202;0;0;0;
 2110 ENDPROC
 2120 :
 2130 DEF PROCkdis
 2140 *FX4,1
 2150 ENDPROC
 2160 :
 2170 DEF PROCdelay(time%)  
 2180 TIME=0
 2190 REPEAT UNTIL TIME>time%  
 2200 ENDPROC
 2210 :
 2220 DEF PROCmenuselect(select%,xpos%,ypos%)   
 2230 RESTORE 2330
 2240 REPEAT
 2250 READ menu$,group%,field$
 2260 IF group%=select% THEN PRINTTAB(xpos%,ypos%);CHR$Text%;menu$   
 2270 IF group%=select% THEN ypos%=ypos%+1    
 2280 UNTIL menu$="STOP"
 2290 ENDPROC
 2300 :
 2310 REM ************** DATA VARS FOR MENUSELECT ***************
 2320 :
 2330 DATA "USERNAME",2,"NA" 
 2340 DATA "FILENAME",2,"NA"   
 2350 DATA "NOTEFILE",2,"NA"  
 2360 DATA "RESERVE",2,"NA"
 2370 DATA "CONFIRM",2,"NA"
 2380 DATA "STOP",0,"STOP"
 2390 :
 2400 REM ****************** HIGHLIGHTED HEADINGS ****************************:
 2410 :
 2420 DEF PROCbar(xpos%,ypos%,text$) 
 2430 PRINTTAB(xpos%,ypos%);CHR$132;CHR$157;CHR$Text%;text$;TAB((xpos%+(LEN(text$)+5)),ypos%);CHR$156   
 2440 ENDPROC
 2450 :
 2460 DEF PROCtransfer(t%)
 2470 PROCclear
 2480 PROCbar(11,6,"TRANSFER")  
 2490 IF t%=1 THEN PRINTTAB(6,8);CHR$Text%;"VERSION No ";CHR$Entry%;"5a PILOT" ELSE PRINTTAB(6,8);CHR$Text%;"VERSION No ";CHR$Entry%;"4"  
 2500 PRINTTAB(6,9);CHR$Text%;"TRANSFER OF";CHR$Entry%;"<csd>.PROGFLE"
 2510 PRINTTAB(6,10);CHR$Text%;"6a USERNAME";CHR$Entry%
 2520 PRINTTAB(6,11);CHR$Text%;"6a FILENAME";CHR$Entry% 
 2530 PRINTTAB(6,12);CHR$Text%;"6a NOTEFILE";CHR$Entry% 
 2540 PRINTTAB(6,13);CHR$Text%;"No RECORDS ";CHR$Entry%  
 2550 PRINTTAB(6,14);CHR$Text%;"CONFIRMED  ";CHR$Entry% 
 2560 PROCcon:PROCkdis
 2570 File$=FNenter(18,10,11)
 2580 IF File$="" THEN GOTO 2570
 2590 Data$=FNenter(18,11,11) 
 2600 IF Data$="" THEN GOTO 2590
 2610 Notes$=FNenter(18,12,11) 
 2620 IF Notes$="" THEN GOTO 2610
 2630 rec%=VAL(FNenter(18,13,4)):IF rec%<1 THEN PRINTTAB(18,13);CHR$Entry%;"All"
 2640 c$=FNenter(18,14,4)
 2650 IF c$<>"YES" THEN CLEAR:RUN
 2660 PROCcoff
 2670 PROCprocess(2)
 2680 X=OPENIN (File$):Y=OPENIN (Data$):Z=OPENIN (Notes$)
 2690 IF X<>0 OR Y<>0 OR Z<>0 THEN VDU7:CLOSE#X:CLOSE#Y:CLOSE#Z:CLEAR:RUN
 2700 CLOSE#X:CLOSE#Y:CLOSE#Z
 2710 Q=OPENIN"PROGFLE":IF Q=0 THEN CLOSE#Q:VDU7:CLEAR:RUN
 2720 X=OPENOUT (File$)
 2730 Y=OPENOUT (Data$)
 2740 Z=OPENOUT (Notes$)
 2750 Q=OPENIN"PROGFLE"
 2760 PTR#X=0:PTR#Y=0:PTR#Z=0:PTR#Q=0
 2770 IF rec%>=(EXT#Q/220) THEN rec%=0:PRINTTAB(18,13);CHR$Entry%;"All" 
 2780 IF rec%=0 THEN rec%=(EXT#Q/220)
 2790 Active%=0:Dummy%=0:Delete%=0
 2800 FOR loop%=1 TO rec% STEP 1
 2810 PRINTTAB(6,16);CHR$Text%;"READING Rec";CHR$Entry%;loop%
 2820 PTR#Q=(220*(loop%-1)):PTR#Y=(Step%*(loop%-1)):PTR#Z=(Step2%*(loop%-1))
 2830 INPUT#Q,prog$,type$,opt$,surface$,disc$,owner$,filename$,dir$,ProNo%,notes1$,notes2$,Mfd%
 2840 IF type$="Utility" THEN type$="UTILITY"  
 2850 IF type$="Game" THEN type$="GAME"  
 2860 IF type$="Incomplete" THEN type$="MISCELLANEOUS"  
 2870 IF type$="ROM Image" THEN type$="ROM RAM IMAGE" 
 2880 IF type$="Datafile" THEN type$="DEDICATED FILE" 
 2890 IF type$="Text" THEN type$="ASCII TEXT"  
 2900 IF type$="Word Processor" THEN type$="WORD PROCESSOR"  
 2910 IF type$="Non BASIC" THEN type$="MISCELLANEOUS"   
 2920 IF type$="Other" THEN type$="MISCELLANEOUS"  
 2930 IF type$="Not Input" THEN type$=""  
 2940 IF opt$="MENU ONLY" THEN opt$="REFERENCE"   
 2950 IF surface$="A" THEN Da$="ADFS" ELSE Da$="DFS"   
 2960 PRINT#Y,LEFT$(prog$,28),type$,LEFT$(disc$,15),opt$,LEFT$(owner$,20),LEFT$(filename$,10),Da$,Mfd%,"",""  
 2970 PRINT#Z,LEFT$(dir$,80),LEFT$(notes1$,40),LEFT$(notes2$,40),"",Mfd%
 2980 PRINTTAB(6,17);CHR$Text%;"WRITING Rec";CHR$Entry%;loop%
 2990 Active%=Active%+1:Dummy%=Dummy%+1
 3000 IF Mfd%=9 THEN Delete%=Delete%+1
 3010 IF (loop%*220)>EXT#Q THEN loop%=rec%
 3020 NEXT loop%
 3030 PTR#X=0:PRINT#X,Data$:PTR#X=50:PRINT#X,Notes$:PTR#X=100:PRINT#X,Dummy%:PTR#X=125:PRINT#X,Active%:PTR#X=150:PRINT#X,Delete%
 3040 CLOSE#X
 3050 CLOSE#Y
 3060 CLOSE#Z
 3070 CLOSE#Q
 3080 PROCprocess(1):PROCprocess(0)
 3090 ENDPROC
 3100 :