1000 ! FETCH -- RANDOM-ACCESS FILE EDIT ROUTINE ! FOR STANDARD WCIS FILES. ENTRIES MAY BE ! ADDED, CHANGED, OR DELETED. 1010 ! TERMINAL CONFIG OF SYSTEM MUST BE DEFINED IN ! SECOND 'CHANGE' STATEMENT: 0=TTY, 1=ANN ARBOR, ! 2=VT05; POSITION = KB#. 1020 ! RESERVED MNEMONICS: X$ FOR F.P. AND X% FOR ! INTEGER FIELDS (X=ANY CHAR). 1030 ! 05-JAN-74 J. WARDEN WABASH COLLEGE 1040 DIM M%(30),A$(63),B$(63) 1050 CHANGE SYS(CHR$(6%)+CHR$(9%)) TO M% : K9%=M%(2%)/2% 1060 CHANGE"01001001020001200" TO M% : K9%=M%(K9%+1%)-48% : K9$=CHR$(16%-K9%) 1070 IF K9%=1% THEN C8$=CHR$(140%)+CHR$(140%) ELSE IF K9%=2% THEN C8$=CHR$(29%)+CHR$(31%) ELSE C8$="" 1080 OPEN "KB:" AS FILE 9% 1090 D%,D9%=0% : D8%=32767% 1100 PRINT C8$;"WCIS FILE EDIT V05A" 1110 INPUT"OPTIONS (DEV:/M)";O$ : G9%=INSTR(1%,O$,"/M") : IF G9% THEN O$=LEFT(O$,G9%-1%) : G9%=32767% 1113 G7%=INSTR(1%,O$,"/T") : IF G7% THEN O$=LEFT(O$,G7%-1%) : K9%=0% : K9$=CHR$(16%) : C8$="" : &"TELETYPE INPUT ASSUMED" 1115 G8%=INSTR(1%,O$,"/R") : IF G8% THEN O$=LEFT(O$,G8%-1%) : G8%=-1% 1120 IF ASCII(O$)=72% THEN GOSUB 1800 : GO TO 1110 1130 O$="KB:" IF O$="" : IF O$="KB:" OR O$="LP:" THEN 1170 ELSE IF LEFT(O$,2%)<>"KB" OR INSTR(1%,O$,":")=0% THEN 1160 1140 ON ERROR GO TO 1150 : OPEN O$ AS FILE 8% : CLOSE 8% : GO TO 1170 1150 RESUME 1160 1160 PRINT"** INVALID OPTION; TYPE 'HELP' FOR HELP **" : GO TO 1110 1170 N5%=1% : GOSUB 1570 1180 ON ERROR GO TO 1200 1190 GO TO 1230 1200 IF ERR=11% THEN IF L%=0% THEN RESUME 1300 ELSE ON ERROR GO TO 0 1210 IF ERR<>5% THEN ON ERROR GO TO 0 1220 RESUME 1450 1230 PRINT"FILE NAME"; : INPUT LINE F1$ 1240 F1%=ASCII(RIGHT(F1$,LEN(F1$))) : IF F1%=13% OR F1%=10% THEN F1$=LEFT(F1$,LEN(F1$)-1%) : GO TO 1240 1250 IF F1$="" THEN 1790 ELSE IF INSTR(1%,F1$,".")+INSTR(1%,"DT0:DT1:",LEFT(F1$,4%)) THEN &"** ILLEGAL FILE NAME **" : GO TO 1230 1260 IF LEN(F1$) > 20% THEN &"** RETYPE **" : GO TO 1230 1270 OPEN F1$ FOR INPUT AS FILE 1% 1280 FIELD #1%,N1%*A% AS A$, N1% AS A$(A%) FOR A%=0% TO N6% 1290 CHANGE SYS(CHR$(6%)+CHR$(-8%)+CHR$(1%)) TO M% : L%=M%(7%)+SWAP%(M%(8%)) 1300 IF L%=0% THEN 1450 ELSE T%=L% 1310 GET #1%, RECORD T% : A%=N6% 1320 IF C6%=0% THEN IF ASCII(A$(A%))=92% THEN C6%=1% : IF INSTR(1%,"\\\"+LEFT(F$,3%), MID(A$(A%),4%,3%))=0% THEN & CHR$(7%);"** WRONG FILE TYPE **" : & : GO TO 1170 1330 IF ASCII(A$(A%))=92% THEN T2%=1% ELSE 1370 1340 A%=A%-1% : IF A%>=0% THEN 1330 1350 T%=T%-1% : IF T%>0% THEN 1310 1360 IF T1%=0% THEN 1450 ELSE 1400 1370 IF T2%=0% THEN 1340 1380 IF ASCII(RIGHT(A$(A%),N1%-1%))=65% THEN T1%=T1%+1% : GO TO 1340 1390 L0%=(T%-1%)*N%+A%+1% 1400 PRINT"FILE CONTAINS";L0%;"RECORDS"; : IF T1%=1% THEN &" PLUS 1 CORRECTION" ELSE IF T1% THEN &" PLUS";T1%;"CORRECTIONS" ELSE PRINT 1410 S$=F$+LEFT(F1$+SPACE$(20%),20%)+CVT%$(L0%)+CVT%$(T1%) 1420 S$=S$+CVT%$(L%)+CVT%$(K9%)+CVT%$(G9%)+O$+"*****" 1430 S$=SYS(CHR$(8%)+S$) : CLOSE 1%,9% 1440 IF G8% THEN CHAIN"DK1:$FTCH04" 1025 ELSE CHAIN"DK1:$FTCH01" 1025 1450 PRINT "FILE '";F1$;"' DOES NOT EXIST" : IF G8% THEN 1480 1455 PRINT"DO YOU WISH TO CREATE A NEW FILE NAMED '";F1$;"' (Y/N)"; 1460 INPUT Y$ 1470 IF ASCII(Y$)=89% THEN 1500 1480 ON ERROR GO TO 1790 : KILL F1$ 1490 GO TO 1790 1500 ON ERROR GO TO 0 : CLOSE 1% 1510 OPEN F1$ FOR OUTPUT AS FILE 1% 1520 FIELD #1%, N1%*B% AS Z$, N1% AS B$(B%) FOR B%=0% TO N6% 1530 LSET B$(B%)="\\\"+LEFT(F$,3%)+SPACE$(N2%)+ CHR$(13%)+CHR$(10%) FOR B%=0% TO N6% 1540 PUT #1% : CLOSE 1% 1550 L0%,T1%=0% : L%=1% : GO TO 1410 1560 ! === FILE ATTRIBUTES SUBROUTINE === 1570 DIM V2$(50),V2%(2,50) 1580 ON ERROR GO TO 1760 : R%=0% 1590 INPUT"FILE TYPE";F$ : F$=LEFT(F$+" ",3%) : C6%=0% 1600 OPEN V1$+"$ATRIB" FOR INPUT AS FILE 1% 1610 FIELD #1%, 255%*A% AS Z$, 255% AS A$(A%) FOR A%=0% TO 1% 1620 IF A%<1% THEN A%=A%+1% ELSE A%=0% : GET #1% : R%=R%+1% 1630 IF LEFT(A$(A%),3%)="\\\" THEN PRINT"NO SUCH FILE TYPE" : GO TO 1790 1640 IF LEFT(A$(A%),3%)<>F$ THEN 1620 1650 V2%(2%,0%),N%=VAL(MID(A$(A%),4%,2%)) : N9%=VAL(MID(A$(A%),6%,1%))*2% 1660 N1%=510%/N% : N2%=N1%-8% : N3%=N%*N1% : N6%=N%-1% 1670 F$=F$+CHR$(N%)+CHR$(R%)+CHR$(A%) 1680 V2$(50%)="??" 1690 FOR V%=1% TO 50% 1700 V2$(V%)=MID(A$(A%),42%+(V%-1%)*4%,2%) : IF V2$(V%)=" " THEN 1740 1710 V5%=CVT$%(MID(A$(A%),44%+(V%-1%)*4%,2%)) 1720 V2%(1%,V%)=ASCII(CHR$(V5%)) : V2%(2%,V%)=ASCII(CHR$(SWAP%(V5%))) 1730 NEXT V% 1740 V2%(1%,0%)=V%-1% : IF N5% THEN 1750 ELSE PRINT"CODES: "; : PRINT V2$(I%)+" "; FOR I%=1% TO V%-1% : PRINT 1750 CLOSE 1% : ON ERROR GO TO 0 : RETURN 1760 IF ERR<>5% AND ERR<>21% THEN 1780 ELSE RESUME 1770 1770 IF V1$="" THEN V1$="DK1:" : GO TO 1600 1780 PRINT"THE FILE '$ATRIB' HAS BEEN DELETED;" : PRINT"IT MUST BE REPLACED TO PROCEED." 1790 GO TO 1880 1800 ! === 'HELP' SUBROUTINE === 1810 ON ERROR GO TO 1840 1820 OPEN"DK1:$FETCH.TXT" FOR INPUT AS FILE 3% 1830 INPUT LINE #3%,O$ : PRINT O$; : GO TO 1830 1840 IF ERR=11% AND ERL=1830% THEN CLOSE 3% : RESUME 1870 1850 RESUME 1860 1860 PRINT"** THE 'HELP' TEXT IS NOT AVAILABLE AT THIS TIME;" : PRINT" CALL THE COMPUTER CENTER FOR ASSISTANCE **" 1870 S0$=SYS(CHR$(0%)) : RETURN 1880 END