8-Bit Software Online Conversion

:0.$.SERVER2 - Listing

10ON ERROR PROCerror(ERR,""):D%=-1:CL EAR:RUN 20REM *** SYSTEMS server Module 2 (ma in Module) *** 30REM *** Displays full context menu - PROCs *** 40REM *** can just be *SPOOLed onto t he end of *** 50REM *** the program and called thus making *** 60REM *** enhancement easy. If PROC is not re- *** 70REM *** sident in this module then the appro- *** 80REM *** priate module is loaded and RUN. Menu *** 90REM *** choice is carried in variab le D% *** 100: 110REM ********* MODE SELECTION - CALL INITIALISATION - MAIN LOOP ************ 120PROCinit:PROCkon 130PROCprocess(1):PROCprocess(0) 140REPEAT 150IF D%=-1 THEN D%=FNmenu 160IF D%=7 THEN PROCadd 170IF D%=0 AND Active%>0 THEN PROCload 180IF D%=6 THEN PAGE=&1900:CHAIN"SERVE R1" 190IF D%=2 AND Active%>0 THEN PROCbrow se 200PROCclear 210IF D%=1 AND Active%>0 THEN PROCtran sfer:PAGE=&1900:CHAIN"SERVER3" 220IF D%=3 AND Active%>0 THEN PROCtran sfer:PAGE=&1900:CHAIN"SERVER3" 230IF D%=4 AND Active%>0 THEN PROCtran sfer:PAGE=&1900:CHAIN"SERVER3" 240IF D%=5 AND Active%>0 THEN PROCtran sfer:PAGE=&1900:CHAIN"SERVER3" 250IF D%=8 THEN PROCtransfer:PAGE=&190 0:CHAIN"SERVER3" 260IF D%=9 THEN PROCclose 270D%=-1:UNTIL FALSE 280: 290REM ***************** TELETEXT GRAP HICS LAYOUT PROCEDURES ***************** 300: 310DEF PROCaup 320FOR c%=12 TO 5 STEP -1 330IF c%=5 THEN PRINTTAB(0,c%);SPC(40) ;TAB(0,4);bar2$; 340IF c%>5 THEN PRINTTAB(0,c%);SPC(40) ;TAB(0,(c%-1));bar$; 350PROCdelay(1) 360NEXT 370ENDPROC 380: 390DEF PROCadn 400FOR c%=5 TO 12 STEP 1 410PROCdelay(1) 420IF c%=5 THEN PRINTTAB(0,c%);bar2$;T AB(0,(c%-1));bar3$ 430IF c%<12 THEN PRINTTAB(0,c%);SPC(40 ); 440IF c%<11 THEN PRINTTAB(0,(c%+1));ba r$; 450IF c%=5 THEN PRINTTAB(0,c%);" PROGR AM " 460IF c%=6 THEN PRINTTAB(0,c%);" CATEG ORY " 470IF c%=7 THEN PRINTTAB(0,c%);" DISC " 480IF c%=8 THEN PRINTTAB(0,c%);" OPTIO N " 490IF c%=9 THEN PRINTTAB(0,c%);" SOURC E " 500IF c%=10 THEN PRINTTAB(0,c%);" FILE NAME " 510IF c%=11 THEN PRINTTAB(0,c%);" DFS ADFS " 520NEXT 530PRINTTAB(0,12);bar$; 540ENDPROC 550: 560REM ******************* INITIAILISA TION PROCEDURE ************************* 570: 580DEF PROCinit 590bar2$="  ,,,,,,,,,,,," 600bar$="  ,,,,,,,,,,," 610bar3$="  ,,,,,,,,,,,," 620Text%=134:Entry%=135:Step%=130:Step 2%=220 630File$=$&C00:Data$=$&C20:Notes$=$&C4 0:Dummy%=A%:Active%=B%:Delete%=C% 640DIM Sent$(25):Choice%=D%:time%=0 650*KEY12 1|M 660*KEY13 0|M 670*KEY14 1|M 680*KEY15 0|M 690ENDPROC 700: 710REM ************** SCREEN CLEAR - H IGHLIGHT PROCEDURES ******************** 720: 730DEF PROCclear 740FOR c%=5 TO 22 STEP 1 750PRINTTAB(0,c%);SPC(40); 760NEXT c% 770ENDPROC 780: 790DEF PROCbclear 800FOR c%=13 TO 22 STEP 1 810PRINTTAB(0,c%);SPC(40); 820NEXT c% 830ENDPROC 840: 850DEF PROCwclear 860FOR c%=5 TO 11 STEP 1 870PRINTTAB(12,c%);SPC(27) 880NEXT c% 890ENDPROC 900: 910DEF FNhighlight(xpos%,ypos%,len%,ma x%,start%) 920o%=ypos% 930*FX4,2 940ypos%=ypos%+start% 950REPEAT 960PRINTTAB(xpos%,ypos%);CHR$132;CHR$1 57;CHR$Text%;TAB((xpos%+len%),ypos%);CHR $156 970*FX15 980select$=GET$:select%=VAL(select$) 990IF select$=CHR$13 THEN GOTO 1050 1000IF select%=0 THEN select%=-1 1010IF (ypos%+select%)>max% THEN PRINTT AB(xpos%,ypos%);SPC(2):ypos%=o%:GOTO 105 0 1020IF (ypos%+select%)<(o%) THEN PRINTT AB(xpos%,ypos%);SPC(2):ypos%=max%:GOTO 1 050 1030PRINTTAB(xpos%,ypos%);SPC(2) 1040ypos%=ypos%+select% 1050UNTIL select$=CHR$13 1060*FX4,0 1070=(ypos%-o%) 1080: 1090REM *************** CURSOR & fn KEY S CONTROL **************************** 1100: 1110DEF PROCkon 1120*FX4,2 1130ENDPROC 1140: 1150DEF PROCkoff 1160*FX4,0 1170ENDPROC 1180IF s%=8 THEN PROCadd:ENDPROC 1190ENDPROC 1200VDU23;8202;0;0;0; 1210ENDPROC 1220: 1230DEF PROCcon 1240VDU23,0,10,64;0;0;0; 1250ENDPROC 1260: 1270DEF PROCcoff 1280VDU23;8202;0;0;0; 1290ENDPROC 1300: 1310DEF PROCkdis 1320*FX4,1 1330ENDPROC 1340: 1350REM ********************* MENU PREP ARATION & DISPLAY ********************** 1360: 1370DEF PROCmenuselect(select%,xpos%,yp os%) 1380RESTORE 1550 1390REPEAT 1400READ menu$,group%,field$ 1410IF group%=select% THEN PRINTTAB(xpo s%,ypos%);CHR$Text%;menu$ 1420IF group%=select% THEN ypos%=ypos%+ 1 1430UNTIL menu$="STOP" 1440ENDPROC 1450: 1460REM *********************** TIME DE LAY PROCEDURE ************************* 1470: 1480DEF PROCdelay(time%) 1490TIME=0 1500REPEAT UNTIL TIME>time% 1510ENDPROC 1520: 1530REM ********************* DATA VARI ABLES USED BY MENUSELECT PROC ********* 1540: 1550DATA "FORWARDS",8,"NA" 1560DATA "BACKWARD",8,"NA" 1570DATA "MAINTAIN",8,"NA" 1580DATA "RECORD",8,"NA" 1590DATA "FINISH",8,"NA" 1600DATA "UPDATE",10,"NA" 1610DATA "DELETE",10,"NA" 1620DATA "DRPATH",10,"NA" 1630DATA "NOTES",10,"NA" 1640DATA "DONE",10,"NA" 1650DATA "Loading Gateway",1,"NA" 1660DATA "Browsing Facilities",1,"NA" 1670DATA "Revising Facilities",1,"NA" 1680DATA "Deleting Facilities",1,"NA" 1690DATA "Searching Facilities",1,"NA" 1700DATA "Compact Current Database",1," NA" 1710DATA "Install Program Database",1," NA" 1720DATA "Add New Program Record",1,"NA " 1730DATA "Extend ADFS Database",1,"NA" 1740DATA "Close Systems Server",1,"NA" 1750DATA "GAME",3,"NA" 1760DATA "UTILITY",3,"NA" 1770DATA "ASCII TEXT",3,"NA" 1780DATA "WORD PROCESSOR",3,"NA" 1790DATA "DEDICATED FILE",3,"NA" 1800DATA "ROM RAM IMAGE",3,"NA" 1810DATA "MISCELLANEOUS",3,"NA" 1820DATA "IGNORE FIELD",3,"NA" 1830DATA "CHAIN",4,"NA" 1840DATA "*RUN",4,"NA" 1850DATA "*EXEC",4,"NA" 1860DATA "*TYPE",4,"NA" 1870DATA "*LIST",4,"NA" 1880DATA "*LOAD",4,"NA" 1890DATA "LOAD",4,"NA" 1900DATA "REFERENCE",4,"NA" 1910DATA "DFS Disc",5,"NA" 1920DATA "ADFS Disc",5,"NA" 1930DATA "CONFIRM",6,"NA" 1940DATA "ABANDON",6,"NA" 1950DATA "REVISE",6,"NA" 1960DATA "ANOTHER",7,"NA" 1970DATA "FINISH",7,"NA" 1980DATA "PROCEED",9,"NA" 1990DATA "CHANGE",9,"NA" 2000DATA "PROCEED",11,"NA" 2010DATA "DRIVENO",11,"NA" 2020DATA "ABANDON",11,"NA" 2030DATA "DRIVE A",12,"NA" 2040DATA "DRIVE B",12,"NA" 2050DATA "DRIVE 0",13,"NA" 2060DATA "DRIVE 1",13,"NA" 2070DATA "DRIVE 2",13,"NA" 2080DATA "DRIVE 3",13,"NA" 2090DATA"STOP",0,"STOP" 2100: 2110REM ******************** FIELD ENTR Y FUNCTION *************************** 2120: 2130DEF FNenter(w1%,w2%,w4%) 2140w3%=0 2150IF w1%<>0 THEN w1%=w1%+1 2160w4%=w4%-1 2170: 2180w1$="" 2190w2$="" 2200IF w1%=0 AND w2%=0 THEN =w2$ 2210IF w1%>0 THEN PRINTTAB((w1%-1),w2%) ;CHR$Entry%; 2220IF w1%<=0 THEN w1%=0:PRINTTAB(w1%,w 2%);CHR$Entry%; 2230REPEAT 2240w1$=GET$ 2250 IF w1$=CHR$13 THEN GOTO 2320 2260IF w1$=CHR$127 AND w3%<1 THEN VDU7: GOTO 2240 2270 IF w1$=CHR$127 THEN PRINT;CHR$127; :w2$=LEFT$(w2$,(LEN(w2$)-1)):w3%=w3%-1:G OTO 2320 2280IF w3%>=w4% THEN VDU7:GOTO 2240 2290w2$=w2$+w1$ 2300PRINT;w1$; 2310w3%=w3%+1 2320UNTIL w1$=CHR$13 2330=w2$ 2340: 2350 REM ******************* COMPUTER P ROCESSING MESSAGES ******************** 2360: 2370DEF PROCprocess(m%) 2380PRINTTAB(0,24);SPC(39); 2390IF m%=1 THEN PRINTTAB(29,24);CHR$13 6;CHR$Text%;"ACCEPTED";:PROCdelay(100):E NDPROC 2400IF m%=2 THEN PRINTTAB(27,24);CHR$Te xt%;CHR$136;"PROCESSING"; 2410IF m%=3 THEN PRINTTAB(29,24);CHR$13 6;CHR$Text%;"REJECTED";:VDU7:PROCdelay(2 00):ENDPROC 2420ENDPROC 2430: 2440REM ***************** ERROR TRAPPIN G AND HANDELING PROCEDURES *********** 2450: 2460DEF PROCerror(Error%,Error$) 2470IF Error%=0 THEN PROCusererr(Error$ ):ENDPROC 2480PROCkdis 2490PROCclear:PROCprocess(0):PROCcoff:P ROCkoff 2500IF Error%=&BF THEN PRINTTAB(11,8);C HR$Text%;"Disc Full" 2510IF Error%=&BD THEN PRINTTAB(11,8);C HR$Text%;"Access Violation" 2520IF Error%=&CC THEN PRINTTAB(11,8);C HR$Text%;"Bad Name" 2530IF Error%=&A8 THEN PRINTTAB(11,8);C HR$Text%;"Broken Dir" 2540IF Error%=&C7 THEN PRINTTAB(11,8);C HR$Text%;"Disc Error" 2550IF Error%=&C6 THEN PRINTTAB(11,8);C HR$Text%;"Disc Full" 2560IF Error%=&D6 THEN PRINTTAB(11,8);C HR$Text%;"Not Found" 2570IF Error%=&CE THEN PRINTTAB(11,8);C HR$Text%;"Bad Dir" 2580IF Error%=&FE THEN PRINTTAB(11,8);C HR$Text%;"Bad Command" 2590IF Error%=&A9 THEN PRINTTAB(11,8);C HR$Text%;"Bad FS Map" 2600IF Error%=&98 THEN PRINTTAB(11,8);C HR$Text%;"Compact Reqd" 2610IF Error%=&C3 THEN PRINTTAB(11,8);C HR$Text%;"File Locked" 2620IF Error%=&CD THEN PRINTTAB(11,8);C HR$Text%;"Bad Drive" 2630IF Error%=&C9 THEN PRINTTAB(11,8);C HR$Text%;"Disc Protected" 2640IF Error%=&C9 THEN PRINTTAB(11,8);C HR$Text%;"Disc Changed" 2650IF Error%=&C5 THEN PRINTTAB(11,8);C HR$Text%;"Drive Fault" 2660IF Error%=&C4 THEN PRINTTAB(11,8);C HR$Text%;"File Exists" 2670IF Error%=&C2 THEN PRINTTAB(11,8);C HR$Text%;"File Open" 2680IF Error%=&C0 THEN PRINTTAB(11,8);C HR$Text%;"Too Many Open" 2690IF Error%=&BF THEN PRINTTAB(11,8);C HR$Text%;"Can't Extend" 2700IF Error%=&BE THEN PRINTTAB(11,8);C HR$Text%;"Catalogue Full" 2710PRINTTAB(11,11);CHR$Text%;"SYSTEM E RROR" 2720PRINTTAB(0,22);CHR$Text%;"REFERENCE ";ERL;"-";ERR;TAB(25,22);CHR$136;" REFE R MANUAL" 2730PRINTTAB(2,15);CHR$Text%;"RE BOOTIN G PROGRAM - PRESS RETURN" 2740*FX15 2750a=GET 2760PROCclear:PROCprocess(2):PROCdelay( 50) 2770CLOSE#0 2780ENDPROC 2790: 2800DEF PROCusererr(Error$) 2810PROCprocess(0):PROCcoff:PROCkoff:VD U7:VDU7:PROCdelay(150) 2820PRINTTAB(39-((LEN(Error$)+2)),24);C HR$136;CHR$Text%;Error$; 2830PROCdelay(100) 2840ENDPROC 2850: 2860REM ******************* MAIN CONTEX T MENU ******************************** 2870: 2880DEF FNmenu 2890PROCprocess(0) 2900PROCclear:PROCcoff 2910PROCmenuselect(1,8,6) 2920PRINTTAB(4,17);CHR$Text%;"No RECORD S";CHR$Entry%;Dummy% 2930PRINTTAB(4,18);CHR$Text%;"No ACTIVE ";CHR$Entry%;Active% 2940PRINTTAB(4,19);CHR$Text%;"No DELETE ";CHR$Entry%;Delete% 2950PRINTTAB(4,20);CHR$Text%;"No SPARE ";CHR$Entry%;(Dummy%-Active%) 2960PRINTTAB(20,17);CHR$Text%;"SERIAL N o";CHR$Entry%;$&C62;$&C60;$&C64 2970PRINTTAB(20,18);CHR$Text%;"DATABASE ";CHR$Entry%;File$ 2980PRINTTAB(20,19);CHR$Text%;"VERSION ";CHR$Entry%;"6a" 2990PRINTTAB(20,20);CHR$Text%;"SUBTYPE ";CHR$Entry%;"TST" 3000PROCkon:s%=FNhighlight(6,6,29,15,0) 3010=s% 3020: 3030REM *** This marks the end of essen tial PROCs and FNs that the *** 3040REM *** main program uses - all fol lowing PROCs and FNs are *** 3050REM *** self containing menu functi ons that can be added and *** 3060REM *** removed at will. 3070: 3080REM ************************* ADDIN G TO DATABASE ************************ 3090: 3100DEF PROCadd 3110PROCclear 3120IF FNchecks = 9 THEN PROCdelay(200) :ENDPROC:REM *** SEE DEF FNchecks *** 3130PRINTTAB(25,24);CHR$Text%;"RECORD N o";CHR$Entry%;(Active%+1); 3140PROCadn:PROCcon:PROCkdis 3150Program$=FNenter(11,5,28) 3160Cat$=FNcat:PRINTTAB(11,6);CHR$Entry %;Cat$:PROCbclear 3170PROCcon:PROCkdis:Disc$=FNenter(11,7 ,16) 3180Opt$=FNopt:PRINTTAB(11,8);CHR$Entry %;Opt$:PROCbclear 3190PROCcon:PROCkdis:Source$=FNenter(11 ,9,21) 3200Name$=FNenter(11,10,11) 3210Da$=FNda:PRINTTAB(11,11);CHR$Entry% ;Da$:PROCbclear 3220c%=FNconfirm(12,16):IF c%=1 THEN PR OCbclear:PROCcoff:PROCaup:ENDPROC 3230IF c%=2 THEN PROCcoff:PROCbclear:PR OCaup:GOTO 3110 3240IF Da$="DFS" THEN x%=FNdisc 3250IF Da$="ADFS" THEN x%=FNadfs: IF x% =9 THEN PROCbclear:PROCaup:ENDPROC 3260IF FNnotes=9 THEN PROCaup:ENDPROC 3270REM ********** THIS IS WHERE WE SAV E A COMPLETE RECORD TO DISC ********** 3280PROCbclear:PROCprocess(2) 3290X=OPENUP (Data$) 3300Y=OPENUP (Notes$) 3310Z=OPENUP (File$) 3320PTR#X=(Step%*Active%) 3330PRINT#X,Program$,Cat$,Disc$,Opt$,So urce$,Name$,Da$,0,"","" 3340PTR#Y=(Step2%*Active%) 3350PRINT#Y,Dir$,Notes1$,Notes2$,Notes3 $,0 3360PTR#Z=125:PRINT#Z,(Active%+1) 3370CLOSE#X 3380CLOSE#Y 3390CLOSE#Z 3400PROCprocess(1):PROCprocess(0):Activ e%=Active%+1 3410PROCbclear:PROCcoff:PROCmenuselect( 7,2,14):s%=FNhighlight(0,14,12,15,0):IF s%=0 THEN PROCbclear:PROCaup:GOTO 3110 3420PROCbclear:PROCaup:ENDPROC 3430: 3440REM *********************** CATEGOR Y SELECTION & CHECKS ***************** 3450: 3460DEF FNcat:PROCcoff 3470PROCmenuselect(3,12,14) 3480s%=FNhighlight(10,14,19,21,0) 3490IF s%=0 THEN ="GAME" 3500IF s%=1 THEN ="UTILITY" 3510IF s%=2 THEN ="ASCII TEXT" 3520IF s%=3 THEN ="WORD PROCESSOR" 3530IF s%=4 THEN ="DEDICATED FILE" 3540IF s%=5 THEN ="ROM IMAGE" 3550IF s%=6 THEN ="MISCELLANEOUS" 3560IF s%=7 THEN ="" 3570="" 3580: 3590REM ****************** LOAD OPTION SELECTION **************************** 3600: 3610DEF FNopt 3620PROCcoff 3630PROCmenuselect(4,14,14) 3640s%=FNhighlight(12,14,15,21,0) 3650IF s%=0 THEN ="CHAIN" 3660IF s%=1 THEN ="*RUN" 3670IF s%=2 THEN ="*EXEC" 3680IF s%=3 THEN ="*TYPE" 3690IF s%=4 THEN ="*LIST" 3700IF s%=5 THEN ="*LOAD" 3710IF s%=6 THEN ="LOAD" 3720IF s%=7 THEN ="REFERENCE" 3730="" 3740: 3750REM ******************* DFS ADFS SE LECTION ******************************* 3760: 3770DEF FNda 3780PROCcoff:PROCmenuselect(5,14,16) 3790s%=FNhighlight(12,16,15,17,0) 3800IF s%=0 THEN ="DFS" 3810IF s%=1 THEN ="ADFS" 3820="" 3830: 3840REM ************ CHECKING PROCEDURE S BEFORE PROCadd ********************* 3850: 3860DEF FNchecks 3870IF Active%>=Dummy% THEN PROCerror(0 ,"DATABASE FULL"):=9 3880=0 3890: 3900REM ************* CONFIRM FIELDS - Position determined by x% y% ********** 3910: 3920DEF FNconfirm(x%,y%) 3930PROCkon:PROCcoff:PROCmenuselect(6,( x%+2),y%) 3940s%=FNhighlight(x%,y%,12,(y%+2),0) 3950 =s% 3960: 3970REM ****************** HIGHLIGHTED HEADINGS ****************************: 3980: 3990DEF PROCbar(xpos%,ypos%,text$) 4000PRINTTAB(xpos%,ypos%);CHR$132;CHR$1 57;CHR$Text%;text$;TAB((xpos%+(LEN(text$ )+5)),ypos%);CHR$156 4010ENDPROC 4020: 4030REM ****************** ADFS DIRECTO RY ROUTE SPEC. ************************ 4040: 4050DEF FNadfs 4060PROCbclear:PROCbar(0,14,"DIRECTORY" ) 4070PROCkoff:PROCcon:PROCkdis:PROCwordw rap(1,1,38,16):PROCcoff 4080FOR x=19 TO 21 STEP 1:PRINTTAB(0,x) ;SPC(39);:NEXT x 4090c%=FNconfirm(0,19):IF c%=1 THEN PRO Cbclear:=9 4100IF c%=2 THEN GOTO 4060 4110Dir$=Sent$(16)+Sent$(17) 4120IF Dir$="" THEN =0 4130IF RIGHT$(Dir$,1)<>"." THEN Dir$=Di r$+"." 4140=0 4150: 4160REM ******************* DFS DIRECTO RY ROUTE SPEC. *********************** 4170: 4180DEF FNdisc 4190PROCbclear:PROCbar(12,14,"DIRECTORY ") 4200PROCkoff:PROCcon:PROCkdis:Dir$=FNen ter(16,16,5):PROCcoff 4210IF Dir$="" OR Dir$=CHR$13 THEN Dir$ ="$":PRINTTAB(16,16);CHR$Entry%;"Root":P ROCcoff:PROCdelay(100) 4220IF FNdfschk=9 THEN GOTO 4190 4230Dir$=Dir$+"." 4240=0 4250: 4260DEF FNdfschk 4270IF LEN(Dir$)=1 THEN =0 4280IF LEFT$(Dir$,3)=":0." THEN =0 4290IF LEFT$(Dir$,3)=":1." THEN =0 4300IF LEFT$(Dir$,3)=":2." THEN =0 4310IF LEFT$(Dir$,3)=":3." THEN =0 4320IF LEFT$(Dir$,3)=":4." THEN =0 4330=9 4340: 4350REM **** WORWRAP ROUTINES - MAX 20 LINES - Sent$ MUST BE DIMensioned **** 4360REM **** WHEN INITIALISING THE PROG RAM - Can only be DIMed ONCE ********* 4370REM ***** Sent$(xx) determines the Max No. of lines (as in first line) ** 4380: 4390DEF PROCwordwrap(NoLines%,xmargin%, length%,top%) 4400carry$="":text$="" 4410FOR line%=top% TO (top%+NoLines%) S TEP 1 4420b$="":a$="" 4430b$=carry$:PROCcoff:PRINTTAB(xmargin %,line%);b$; 4440count%=xmargin%+(LEN(carry$)) 4450REPEAT 4460PROCcon:a$=GET$ 4470IF a$=CHR$13 THEN GOTO 4530 4480IF a$=CHR$127 THEN PROCback:UNTIL F ALSE 4490IF line%>=(top%+NoLines%) AND (coun t%-xmargin%)+1>=length% THEN VDU7:GOTO44 60 4500PRINTTAB(count%,line%);a$; 4510b$=b$+a$ 4520count%=count%+1 4530UNTIL FNnextline(b$)=9 4540NEXT line% 4550ENDPROC 4560: 4570DEF FNnextline(text$) 4580IF a$=CHR$13 THEN carry$="":Sent$(l ine%)=text$:=9 4590IF (count%-xmargin%)<length% THEN = 0 4600FOR test%=1 TO LEN(text$) STEP 1 4610carry$=RIGHT$(text$,test%) 4620IF LEFT$(carry$,1)=" " THEN PROCsor t:=9 4630NEXT test%:carry$="":Sent$(line%)=t ext$:=9 4640: 4650DEF PROCsort 4660w1%=LEN(carry$) 4670w2%=LEN(text$) 4680new$=LEFT$(text$,(w2%-w1%)):Sent$(l ine%)=new$ 4690PROCcoff:PRINTTAB(xmargin%,line%);S PC(40);TAB(xmargin%,line%);new$ 4700carry$=RIGHT$(carry$,(w1%-1)) 4710ENDPROC 4720: 4730DEF PROCback 4740IF count%<=xmargin% THEN VDU7:ENDPR OC 4750PRINTTAB(count%,line%);CHR$127;:cou nt%=count%-1 4760w3%=LEN(b$) 4770b$=LEFT$(b$,(w3%-1)) 4780ENDPROC 4790: 4800REM ********************* PROGRAM N OTES ENTRY PROCEDURE ***************** 4810: 4820DEF FNnotes 4830PROCbclear 4840PROCbar(10,14,"PROGRAM NOTES") 4850PROCkoff:PROCcon:PROCkdis:PROCwordw rap(2,1,38,16):PROCcoff 4860FOR x%=20 TO 22 STEP 1:PRINTTAB(0,x %);SPC(39);:NEXT x% 4870c%=FNconfirm(12,20):IF c%=1 THEN PR OCbclear:=9 4880IF c%=2 THEN GOTO 4830 4890Notes1$=Sent$(16):Notes2$=Sent$(17) :Notes3$=Sent$(18) 4900=0 4910: 4920REM **************** PROGRAM BROWSI NG ********************************** 4930: 4940DEF PROCbrowse 4950PROCclear:PROCprocess(2) 4960X=OPENUP (File$) 4970Y=OPENUP (Data$) 4980Z=OPENUP (Notes$) 4990PTR#X=0:PTR#Y=0:PTR#Z=0 5000PROCprocess(1):PROCprocess(0):PROCa dn 5010PROCbar(10,14,"MAINTENANCE") 5020PRINTTAB(12,17);CHR$Text%;"RECORD N o";CHR$Entry% 5030PROCcon:PROCkdis:browse%=VAL(FNente r(22,17,5)):browse%=browse%-1 5040PROCcoff:PROCbclear:start%=0 5050REPEAT 5060IF browse%>=Active% THEN browse%=(A ctive%-1) 5070 IF browse%<0 THEN browse%=0 5080PTR#Y=(browse%*Step%) 5090PTR#Z=(browse%*Step2%) 5100INPUT#Y,Program$,Cat$,Disc$,Opt$,So urce$,Name$,Da$,Mfd%,s1$,s2$ 5110INPUT#Z,Dir$,Notes1$,Notes2$,Notes3 $,Nfd% 5120PROCwclear 5130PROCdisplay 5140PROCbclear 5150PROCmenuselect(8,2,14) 5160choice%=FNhighlight(0,14,13,18,star t%):start%=0 5170IF choice%=0 THEN browse%=browse%+1 5180IF choice%=1 THEN start%=1:browse%= browse%-1 5190IF choice%=2 THEN PROCoptions 5200UNTIL choice%=3 OR choice%=4 5210IF choice%=3 THEN PROCbclear:GOTO 5 010 5220PROCbclear:PROCprocess(2) 5230CLOSE#X 5240CLOSE#Y 5250CLOSE#Z 5260PROCprocess(1) 5270PROCprocess(0) 5280PROCbclear:PROCaup 5290ENDPROC 5300: 5310DEF PROCoptions 5320REPEAT 5330PROCwclear:PROCdisplay 5340PROCbclear:PROCmenuselect(10,2,14): opt%=FNhighlight(0,14,11,18,0) 5350IF opt%=0 THEN PROCamendrec 5360IF opt%=1 AND Mfd%=0 THEN PROCdelet eRec:GOTO 5380 5370IF opt%=1 AND Mfd%=9 THEN PROCundel eteRec 5380IF opt%=2 THEN PROCreadpath(0) 5390IF opt%=3 THEN PROCreadnotes 5400UNTIL opt%=4 5410ENDPROC 5420: 5430REM ************* RECORD DISPLAY (a s used by Proc Browse) ************ 5440: 5450DEF PROCdisplay 5460PRINTTAB(11,5);CHR$Entry%;Program$ 5470PRINTTAB(11,6);CHR$Entry%;Cat$ 5480PRINTTAB(11,7);CHR$Entry%;Disc$ 5490PRINTTAB(11,8);CHR$Entry%;Opt$ 5500PRINTTAB(11,9);CHR$Entry%;Source$ 5510PRINTTAB(11,10);CHR$Entry%;Name$ 5520PRINTTAB(11,11);CHR$Entry%;Da$ 5530PRINTTAB(25,24);CHR$Text%;"RECORD N o";CHR$Entry%;(browse%+1); 5540IF Mfd%=9 THEN PRINTTAB(21,11);CHR$ Text%;CHR$136;"Deletion Pending"; 5550ENDPROC 5560: 5570REM **************** READ NOTES *** ********************* 5580: 5590DEF PROCreadnotes 5600PROCbclear 5610PROCbar(0,14,"NOTES") 5620PRINTTAB(0,16);CHR$Entry%;Notes1$ 5630PRINTTAB(0,17);CHR$Entry%;Notes2$ 5640PRINTTAB(0,18);CHR$Entry%;Notes3$ 5650PROCmenuselect(9,2,20) 5660IF FNhighlight(0,20,12,21,0)=1 THEN PROCamendnotes 5670PROCbclear 5680ENDPROC 5690: 5700DEF PROCdeleteRec 5710PTR#Y=(browse%*Step%):PRINT#Y,Progr am$,Cat$,Disc$,Opt$,Source$,Name$,Da$,9, s1$,s2$ 5720PTR#Z=(browse%*Step2%):PRINT#Z,Dir$ ,Notes1$,Notes2$,Notes3$,9 5730PTR#X=150:Delete%=Delete%+1:PRINT#X ,Delete% 5740Mfd%=9:Nfd%=9 5750PROCdisplay 5760ENDPROC 5770: 5780DEF PROCundeleteRec 5790PTR#Y=(browse%*Step%):PRINT#Y,Progr am$,Cat$,Disc$,Opt$,Source$,Name$,Da$,0, s1$,s2$ 5800PTR#Z=(browse%*Step2%):PRINT#Z,Dir$ ,Notes1$,Notes2$,Notes3$,0 5810PTR#X=150:Delete%=Delete%-1:PRINT#X ,Delete% 5820Mfd%=0:Nfd%=0 5830PROCdisplay 5840ENDPROC 5850: 5860DEF PROCamendnotes 5870PROCbclear 5880IF FNnotes=9 THEN ENDPROC 5890PROCprocess(0):PROCbclear:PROCdelay (100):PROCprocess(2) 5900PTR#Z=(browse%*Step2%) 5910PRINT#Z,Dir$,Notes1$,Notes2$,Notes3 $,Nfd% 5920PROCprocess(1):PROCprocess(0) 5930ENDPROC 5940: 5950DEF PROCamendrec 5960PROCbclear:PROCcon:PROCkdis 5970a1$=Program$:a2$=Cat$:a3$=Disc$:a4$ =Opt$:a5$=Source$:a6$=Name$:a7$=Da$ 5980PRINTTAB(11,5);SPC(28):w1$=FNenter( 11,5,28):IF w1$="" OR w1$=CHR$13 THEN w1 $=Program$:PRINTTAB(12,5);w1$ 5990a1$=w1$ 6000a2$=FNcat:PRINTTAB(11,6);SPC(28);TA B(11,6);CHR$Entry%;a2$:PROCbclear 6010PROCcon:PROCkdis 6020PRINTTAB(11,7);SPC(28):w1$=FNenter( 11,7,16):IF w1$="" OR w1$=CHR$13 THEN w1 $=Disc$:PRINTTAB(12,7);w1$ 6030a3$=w1$ 6040a4$=FNopt:PRINTTAB(11,8);SPC(28);TA B(11,8);CHR$Entry%;a4$:PROCbclear 6050PROCcon:PROCkdis 6060PRINTTAB(11,9);SPC(28):w1$=FNenter( 11,9,21):IF w1$="" OR w1$=CHR$13 THEN w1 $=Source$:PRINTTAB(12,9);w1$ 6070a5$=w1$ 6080PRINTTAB(11,10);SPC(28):w1$=FNenter (11,10,11):IF w1$="" OR w1$=CHR$13 THEN w1$=Name$:PRINTTAB(12,10);w1$ 6090a6$=w1$ 6100s$=Da$:c%=0 6110a7$=FNda:PRINTTAB(11,11);SPC(28);TA B(11,11);CHR$Entry%;a7$:PROCbclear 6120PROCcoff:c%=FNconfirm(12,16) 6130IF c%=1 THEN PROCbclear:PROCwclear: PROCdisplay:ENDPROC 6140IF c%=2 THEN PROCwclear:PROCdisplay :GOTO 5960 6150PROCbclear 6160Program$=a1$:Cat$=a2$:Disc$=a3$:Opt $=a4$:Source$=a5$:Name$=a6$:Da$=a7$ 6170IF s$<>Da$ THEN PROCreadpath(9):IF c%=1 THEN GOTO 6100 6180PROCprocess(2) 6190PTR#Y=(browse%*Step%) 6200PRINT#Y,a1$,a2$,a3$,a4$,a5$,a6$,a7$ ,Mfd%,s1$,s2$ 6210PROCprocess(1):PROCprocess(0) 6220ENDPROC 6230: 6240DEF PROCreadpath(tag%) 6250PROCbclear 6260IF tag%<>9 THEN PROCshowpath 6270IF tag%<>9 THEN PROCmenuselect(9,2, 19) ELSE GOTO 6290 6280IF FNhighlight(0,19,12,20,0)=0 THEN ENDPROC 6290IF Da$="DFS" THEN z%=FNdisc 6300IF Da$="ADFS" THEN z%=FNadfs:IF z%= 9 AND tag%<>9 THEN ENDPROC 6310IF tag%<>9 AND z%<>9 THEN PROCdelay (50):PROCprocess(2) 6320PTR#Z=(Step2%*browse%) 6330PRINT#Z,Dir$,Notes1$,Notes2$,Notes3 $,Nfd% 6340IF tag%<>9 AND z%<>9 THEN PROCproce ss(1):PROCprocess(0) 6350ENDPROC 6360: 6370DEF PROCshowpath 6380PROCbar(0,14,"DIRECTORY"):dp2$="" 6390IF LEN(Dir$)<=38 THEN dp1$=Dir$:GOT O 6430 6400dp1$=LEFT$(Dir$,38) 6410w%=LEN(Dir$):w2%=w%-38 6420dp2$=RIGHT$(Dir$,w2%) 6430PRINTTAB(0,16);CHR$Entry%;dp1$ 6440PRINTTAB(0,17);CHR$Entry%;dp2$ 6450ENDPROC 6460: 6470DEF PROCload 6480PROCclear:PROCadn 6490PROCbar(13,14,"LOAD") 6500PROCcon:PROCkdis 6510PRINTTAB(9,16);CHR$Text%;"RECORD No ":load$=FNenter(19,16,4) 6520IF VAL(load$)>Active% OR VAL(load$) <1 THEN PROCbclear:PROCcoff:PROCaup:ENDP ROC 6530PROCcoff:PROCbclear:PROCdelay(20):P ROCprocess(2) 6540X=OPENIN (Data$) 6550Y=OPENIN (Notes$) 6560browse%=VAL(load$):browse%=browse%- 1 6570PTR#X=(Step%*browse%):PTR#Y=(Step2% *browse%) 6580INPUT#X,Program$,Cat$,Disc$,Opt$,So urce$,Name$,Da$,Mfd%,s1$,s2$ 6590INPUT#Y,Dir$,Notes1$,Notes2$,Notes3 $,Nfd% 6600CLOSE#X:CLOSE#Y 6610PROCprocess(1):PROCprocess(0) 6620IF Mfd%=9 THEN PROCerror(0,"DELETIO N PENDING"):PROCaup:PROCclear:ENDPROC 6630IF Opt$="REFERENCE" THEN PROCerror (0,"LOADING PROHIBITED"):PROCaup:PROCcle ar:ENDPROC 6640PROCdisplay 6650PROCbclear:PROCmenuselect(11,2,14) 6660load%=FNhighlight(0,14,12,16,0) 6670IF load%=2 THEN PROCbclear:PROCaup: ENDPROC 6680IF load%=1 THEN PROCdriveno 6690IF Da$="ADFS" THEN PROCdirsort 6700IF Da$="DFS" THEN PROCdfssort 6710IF Opt$="CHAIN" THEN PROCchain(Name $) 6720IF Opt$="LOAD" THEN PROCld(Name$) 6730IF Opt$="*TYPE" THEN PROCtp(Name$) 6740IF Opt$="*RUN" THEN PROCrun(Name$) 6750IF Opt$="*EXEC" THEN PROCexec(Name$ ) 6760IF Opt$="*LIST" THEN PROClist(Name$ ) 6770IF Opt$="*LOAD" THEN PROCsld(Name$) 6780PROCerror(0,"IRREGULAR OPTION"):PRO Caup:PROCclear:ENDPROC 6790: 6800DEF PROCdriveno 6810PROCbclear 6820IF Da$="ADFS" THEN PROCmenuselect(1 2,2,14):d%=FNhighlight(0,14,12,15,0):PRO Cbclear:PROCakick:ENDPROC 6830IF Da$="DFS" THEN PROCmenuselect(13 ,2,14):d%=FNhighlight(0,14,12,17,0):PROC bclear:PROCdkick:ENDPROC 6840ENDPROC 6850: 6860DEF PROCakick 6870OSCLI("FADFS") 6880OSCLI("DIR :"+STR$(d%)+".$") 6890ENDPROC 6900: 6910DEF PROCdkick 6920OSCLI("DISC") 6930OSCLI("DRIVE "+STR$(d%)) 6940ENDPROC 6950: 6960DEF PROCdirsort 6970PROCdelay(50):PROCprocess(2) 6980IF RIGHT$(Dir$,1)="." THEN Dir$=LEF T$(Dir$,(LEN(Dir$)-1)) 6990OSCLI("ADFS") 7000OSCLI("DIR "+Dir$) 7010PROCprocess(1):PROCprocess(0) 7020ENDPROC 7030: 7040DEF PROCdfssort 7050IF RIGHT$(Dir$,1)="." THEN Dir$=LEF T$(Dir$,(LEN(Dir$)-1)) 7060OSCLI("DIR "+Dir$) 7070ENDPROC 7080: 7090DEF PROCchain(obj$) 7100CLS 7110CHAIN obj$ 7120ENDPROC 7130DEF PROCld(obj$) 7140CLS:PROCbar(0,0,"LOADING") 7150PRINT 7160*KEY0 LOAD obj$|MVDU6|M 7170VDU21 7180*FX138,0,128 7190END 7200: 7210DEFPROCtp(obj$) 7220CLS 7230OSCLI("TYPE "+obj$) 7240END 7250: 7260DEF PROCrun(obj$) 7270CLS 7280OSCLI("RUN "+obj$) 7290END 7300: 7310DEF PROCexec(obj$) 7320CLS 7330OSCLI("EXEC "+obj$) 7340PRINT 7350END 7360: 7370DEF PROClist(obj$) 7380CLS 7390OSCLI("LIST "+obj$) 7400PRINT 7410END 7420: 7430DEF PROCsld(obj$) 7440CLS 7450OSCLI("LOAD "+obj$) 7460END 7470DEF PROCtransfer 7480A%=Dummy%:B%=Active%:C%=Delete% 7490PROCprocess(0):PROCprocess(2) 7500ENDPROC 7510: 7520DEF PROCclose 7530PROCclear:PROCprocess(2) 7540CLOSE#0 7550PROCdelay(30) 7560PROCprocess(1):PROCprocess(0) 7570PRINTTAB(10,13);CHR$Text%;"PRESS BR EAK NOW" 7580x=TRUE:REPEATUNTIL x=FALSE 7590ENDPROC 7600: