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: