100 ! EDITA -- ATTRIBUTES FILE EDITOR ! FILE DESCRIPTIONS IN '$ATRIB' MAY BE EDITED IN PLACE; ! IF NEW TYPES ARE ADDED FILE SHOULD BE SORTED. 105 ! '$ATRIB' IS PACKED 2 R/B; TYPES MAY BE DELETED WITH ! 'EDITR' AND 'UPDATX'. 110 ! RECORD STRUCTURE: TYPE (3), R/B (2), CS (1), ! DATE,TIME (4), DESCRIPTION (30), BL (1), ! THEN MNE (2), LOC (1), LENGTH (1) FOR EACH FIELD. 120 ! 20-NOV-73 J. WARDEN WABASH COLLEGE 140 OPEN"KB:" FOR INPUT AS FILE 9% 160 DEF FNX$(X%) 180 X$=NUM$(X%) : X$=MID(X$,2%,LEN(X$)-2%) 200 IF X%<10% THEN X$="0"+X$ 220 FNX$=X$ 240 FNEND 260 DIM V2$(50),V2%(2,50),S$(256)=2% 280 H1$="TYPE R/B LAST EDIT" 300 H2$="TYPE R/B CS ----- LAST EDIT -----" 320 S$(I%)=" " FOR I%=7% TO 256% : S$(I%)="ID" FOR I%=1% TO 6% 340 I$="$ATRIB" 360 A0$="\\\\\\"+SPACE$(12%) 380 PRINT"FILE ATTRIBUTES EDITOR V01B" 400 PRINT"*"; : INPUT #9%,F$ : IF F$="" THEN 2800 420 D%=INSTR(1%,F$,"/DI") : IF D% THEN GOSUB 2398 : GO TO 400 430 IF F$="HELP" THEN GOSUB 2370 : GO TO 400 440 IF LEN(F$)<>3% THEN PRINT"RETYPE PLEASE (TYPE 'HELP' "; "FOR HELP)" : GO TO 400 460 OPEN I$ AS FILE 1% 480 R%=0% ! RECORD ## 500 FIELD #1%, 255%*A% AS Z$, 255% AS A$(A%) FOR A%=0% TO 1% 520 ON ERROR GO TO 2740 540 IF A%<1% THEN A%=A%+1% ELSE A%=0% : GET #1% : R%=R%+1% 560 IF LEFT(A$(A%),3%)="\\\" THEN PRINT"TYPE NOT IN FILE" : GO TO 840 580 IF LEFT(A$(A%),3%)<>F$ THEN 540 600 V2%(2%,0%),N%=VAL(MID(A$(A%),4%,2%)) 620 N9%=VAL(MID(A$(A%),6%,1%))*2% 640 N1%=510%/N% : A0%=0% 660 FOR V%=1% TO 50% 680 V2$(V%)=MID(A$(A%),42%+(V%-1%)*4%,2%) : IF V2$(V%)=" " THEN 760 700 V5%=CVT$%(MID(A$(A%),44%+(V%-1%)*4%,2%)) 720 V2%(1%,V%)=ASCII(CHR$(V5%)) : V2%(2%,V%)=ASCII(CHR$(SWAP%(V5%))) 740 NEXT V% 760 V2%(1%,0%)=V%-1% 780 D$=MID(A$(A%),11%,31%) : D0%=INSTR(1%,D$," ") : IF D0%=0% THEN D0%=31% ELSE D0%=D0%-1% 800 V%=V%-1% 820 GOSUB 1860 : GO TO 1040 840 INPUT"RECORDS/BLOCK";N% : IF N%<2% OR N%>85% THEN PRINT"BAD BLOCKING" : GO TO 840 860 INPUT"CLUSTERSIZE";N9% : IF N9%<1% OR N9%>8% THEN N9%=2% 880 N1%=510%/N% : GOSUB 1860 900 PRINT"FILE DESCRIPTION"; : INPUT LINE D$ : D$=LEFT(D$,LEN(D$)-2%) : D$=LEFT(D$+SPACE$(31%),31%) 920 D0%=INSTR(1%,D$," ") : IF D0%=0% THEN D0%=31% ELSE D0%=D0%-1% 940 A0%=1% : V%=0% : GOSUB 1860 960 PRINT"ENTER FIELDS:" : GO TO 980 980 PRINT">"; : INPUT #9%,C$ 1000 IF C$="SORT" THEN GOSUB 2020 : GO TO 980 1020 IF C$<>"L" THEN 1180 1040 PRINT"FILE: ";F$;" ";N%;"R/B (";LEFT(D$,D0%);")" 1060 PRINT"-- LAST ED: ";DATE$(CVT$%(MID(A$(A%),7%,2%))); " AT ";TIME$(CVT$%(MID(A$(A%),9%,2%)));" --" 1080 PRINT : PRINT"MNE START (END) LENGTH" 1100 FOR I%=1% TO V% 1120 PRINT USING"\\ #### (###) ####",V2$(I%), V2%(1%,I%),V2%(1%,I%)+V2%(2%,I%)-1%,V2%(2%,I%) 1140 NEXT I% 1160 S$=SYS(CHR$(0%)) : GO TO 980 1180 IF C$="OK" THEN 1500 1200 IF C$="EX" OR C$="OOPS" THEN CLOSE 1% : PRINT"WORK AREA CLEARED" : PRINT : GO TO 400 1220 C%=INSTR(1%,C$,"/") : IF C%=3% THEN 1240 ELSE PRINT"RETYPE PLEASE" : GO TO 980 1240 V2$(V%+1%)=LEFT(C$,2%) : C$=RIGHT(C$,4%) 1245 C2%=ASCII(RIGHT(V2$(V%+1%),2%))-35% : IF C2%*(C2%-2%) THEN 1260 1248 C%=INSTR(1%,C$,"/") : IF C% THEN PRINT "INVALID ENTRY FOR NUMERICAL FIELD" : GO TO 980 1250 IF C$="DE" THEN 1300 ELSE C$=C$+"/"+NUM$(4%-C2%) 1260 C%=INSTR(1%,C$,"/") : IF C% THEN 1340 1280 IF C$<>"DE" THEN PRINT"RETYPE PLEASE" : GO TO 980 1300 GOSUB 2240 : IF V3% THEN V3%=0% : PRINT V2$(V%+1%);" NOT FOUND" : GO TO 980 1320 GOSUB 1860 : GO TO 980 1340 IF LEFT(C$,C%-1%)="CC" THEN GOSUB 1720 : GO TO 980 1360 ON ERROR GO TO 1480 1380 FOR I%=1% TO V% 1400 IF V2$(I%)=V2$(V%+1%) THEN V2%(1%,I%)=VAL(LEFT(C$,C%-1%)) : V2%(2%,I%)=VAL(RIGHT(C$,C%+1%)) : GOSUB 1860 : GO TO 980 1420 NEXT I% 1440 V2%(1%,V%+1%)=VAL(LEFT(C$,C%-1%)) : V2%(2%,V%+1%)=VAL(RIGHT(C$,C%+1%)) 1460 V%=V%+1% : GOSUB 1860 : GO TO 980 1480 PRINT"PLEASE RETYPE" : RESUME 980 1500 ! WRITE RECORD 1520 R$=F$+FNX$(N%)+CHR$(48%+N9%/2%)+ CVT%$(PEEK(2048%))+CVT%$(PEEK(2050%))+D$ 1540 FOR I%=1% TO V% 1560 R$=R$+V2$(I%)+CVT%$(V2%(1%,I%)+SWAP%(V2%(2%,I%))) 1580 NEXT I% 1600 LSET A$(A%)=R$+SPACE$(6%) 1620 IF A0%=0% THEN PUT #1%, RECORD R% : GO TO 1680 1640 IF A%=0% THEN LSET A$(1%)=A0$ : PUT #1%, RECORD R% : GO TO 1680 1660 PUT #1%, RECORD R% : LSET A$(0%)=A0$ : PUT #1%, RECORD R%+1% 1680 PRINT"$ATRIB HAS BEEN UPDATED" 1700 CLOSE 1% : PRINT : GO TO 400 1720 ON ERROR GO TO 1480 1740 GOSUB 2240 : IF V3%=0% THEN GOSUB 1860 : V2$(V%+1%)=V2$(V%+2%) 1760 S0$="" : S0$=S0$+LEFT(S$(I%),1%) FOR I%=1% TO N1% 1780 V2%(2%,V%+1%)=VAL(RIGHT(C$,C%+1%)) 1800 S0%=INSTR(7%,S0$,SPACE$(V2%(2%,V%+1%))) 1820 IF S0% THEN V2%(1%,V%+1%)=S0% ELSE PRINT"SPACE NOT AVAILABLE" : RETURN 1840 V%=V%+1% : GOSUB 1860 : RETURN 1860 S$(I%)="ID" FOR I%=1% TO 6% : S$(I%)=" " FOR I%=7% TO 256% 1880 FOR I%=1% TO V% 1900 IF V2%(1%,I%)>N1% OR V2%(1%,I%)+V2%(2%,I%)>N1% THEN PRINT"OUT OF RANGE" : V%=V%-1% : RETURN 1920 FOR J%=V2%(1%,I%) TO V2%(1%,I%)+V2%(2%,I%)-1% 1940 IF S$(J%)=" " THEN S$(J%)=V2$(I%) ELSE PRINT"THE "S$(J%)" AND "V2$(I%)" FIELDS OVERLAP" : F%=1% : PRINT"PLEASE FIX!" : RETURN 1960 NEXT J% 1980 NEXT I% 2000 F%=0% : RETURN 2020 ! SORT IN FIELD LOC ORDER 2040 FORI%=1% TO V% 2060 K%=1% 2080 FOR J%=1% TO V%-1% 2100 IF V2%(1%,J%)<=V2%(1%,J%+1%) THEN 2200 2120 K%=0% 2140 T%=V2%(1%,J%) : V2%(1%,J%)=V2%(1%,J%+1%) : V2%(1%,J%+1%)=T% 2160 T%=V2%(2%,J%) : V2%(2%,J%)=V2%(2%,J%+1%) : V2%(2%,J%+1%)=T% 2180 T$=V2$(J%) : V2$(J%)=V2$(J%+1%) : V2$(J%+1%)=T$ 2200 NEXT J% : IF K% THEN RETURN 2220 NEXT I% : RETURN 2240 ! DELETE MNEMONIC 2260 V3%=0% 2280 FOR I%=1% TO V% 2300 IF V2$(I%)=V2$(V%+1%) THEN 2340 2320 NEXT I% : V3%=1% : RETURN 2340 V2$(I%)=V2$(V%) : V2%(J%,I%)=V2%(J%,V%) FOR J%=1% TO 2% 2360 V%=V%-1% : RETURN 2370 ! HELP NEEDED 2372 PRINT"AN ASTERISK (*) MEANS THAT EDITA WILL ACCEPT A COMMAND;" : PRINT"POSSIBLE COMMANDS ARE (BESIDES 'HELP'):" 2374 PRINT"(1) A THREE-BYTE CODE (ABC) WILL LOOK UP THE ATTRIBUTES": PRINT" OF THAT FILE IF IT IS DEFINED OR ALLOW THE USER TO": PRINT" DEFINE A NEW FILE. ATRIB IS PLACED IN EDIT MODE." 2376 PRINT"(2) DEV:/DI WILL PRINT A SHORT DIRECTORY OF THE " : PRINT" ATTRIBUTES FILE ON DEV: (DEFAULT IS KB:)." 2378 PRINT"(3) DEV:/DI:S WILL PROVIDE A MORE COMPLETE DIRECTORY." : PRINT 2380 PRINT"EDITA PRINTS '>' WHEN IN EDIT MODE. EDIT COMMANDS ARE:" 2382 PRINT"(A) TO ADD A FIELD TO A FILE WITH A CERTAIN STARTING POSITION": PRINT" AND A FIXED LENGTH, GIVE MNE/START/LEN (EX: NM/7/20)" 2383 PRINT" (EXCEPTION: FOR NUMERICAL MNEMONICS X# [F.P.] AND" : &" X% [INTEGER] GIVE ONLY STARTING COL: D#/33 .) 2384 PRINT"(B) TO ADD A FIELD ANYWHERE IT WILL FIT IN THE RECORD,": PRINT" GIVE MNE/CC/LEN (EX: A2/CC/30)" 2390 PRINT"(C) 'L' WILL LIST CURRENT FILE DESCRIPTION IN CORE." : PRINT"(D) 'OK' WILL COPY CURRENT FILE DESCRIPTION INTO" : PRINT" $ATRIB FILE." 2392 PRINT"(E) 'SORT' WILL SORT FIELD DESCRIPTIONS INTO ORDER OF" : PRINT" STARTING POSITION." 2394 PRINT"(F) 'EX' OR 'OOPS' WILL SCRATCH WORK AREA AND" : PRINT" RETURN TO COMMAND MODE." : PRINT 2396 RETURN 2398 ! LISTING OF FILE TYPES 2400 IF MID(F$,D%+3%,2%)=":S" THEN D9%=1% 2420 F$=LEFT(F$,D%-1%) : D%=INSTR(1%,F$,"<") : IF D%>0% AND LEFT(F$,3%)="LP:" THEN F$="LP:" ELSE F$="KB:" 2440 OPEN F$ FOR OUTPUT AS FILE 2% 2460 PRINT #2%,"DIRECTORY $ATRIB FILE ";DATE$(0%);CHR$(10%) 2480 IF D9% THEN PRINT #2%,H2$+CHR$(10%) ELSE PRINT #2%,H1$+CHR$(10%) 2500 OPEN I$ FOR INPUT AS FILE 1% 2520 FIELD #1%, 255%*A% AS Z$, 255% AS A$(A%) FOR A%=0% TO 1% 2540 ON ERROR GO TO 2700 2560 IF A%<1% THEN A%=A%+1% ELSE A%=0% : GET #1% 2580 IF LEFT(A$(A%),3%)="\\\" THEN 2720 2600 PRINT #2%,USING"\ \ ### ",LEFT(A$(A%),3%), VAL(MID(A$(A%),4%,2%)); 2620 IF D9% THEN PRINT #2%, USING"## ", VAL(MID(A$(A%),6%,1%))*2%; 2640 PRINT #2%, DATE$(CVT$%(MID(A$(A%),7%,2%))); 2660 IF D9% THEN PRINT #2%, " "+TIME$(CVT$%(MID(A$(A%),9%,2%))) ELSE PRINT #2% 2680 GO TO 2560 2700 RESUME 2720 2720 PRINT #2%,CHR$(10%) : S$=SYS(CHR$(0%)) : D9%=0% : CLOSE 1%,2% : RETURN 2740 IF ERR<>11% THEN ON ERROR GO TO 0 2760 IF ERL<>540% THEN ON ERROR GO TO 0 2780 PRINT"TYPE NOT IN FILE" : PRINT : RESUME 840 2800 END