1000 ! FTCH04 -- FETCH OVERLAY #4 ! A RECORD-MARKING PROGRAM (ONLY) 1010 ! 01-JAN-74 J. WARDEN WABASH COLLEGE 1020 CHAIN "DK1:$FETCH" 1025 DIM A$(63),B$(63) 1030 S$=SYS(CHR$(7%)) 1040 K9%=CVT$%(MID(S$,33%,2%)) : K9$=CHR$(16%-K9%) 1050 F$=LEFT(S$,3%) : F1$=MID(S$,7%,INSTR(7%,S$," ")-7%) 1060 L0%=CVT$%(MID(S$,27%,2%)) : T1%=CVT$%(MID(S$,29%,2%)) 1070 G9%=CVT$%(MID(S$,35%,2%)) : L%=CVT$%(MID(S$,31%,2%)) 1080 O$=MID(S$,37%,INSTR(37%,S$,"*")-37%) 1090 C8$=CHR$(140%)+CHR$(29%)+CHR$(31%) : C8$=MID(C8$,K9%,K9%) 1100 IF K9%=2% THEN C7$=CHR$(31%) ELSE C7$=SPACE$(12%) 1110 IF K9% THEN C7$=FNV$(1%,3%)+C7$+CHR$(13%)+">" ELSE C7$="" 1120 DEF FNV$(X%,Y%) 1130 IF K9%=0% THEN FNV$="" : GO TO 1170 1140 Y%=13%+19%*K9%+3%*Y%-2%*Y%*K9% 1150 IF K9%=2% THEN X%=X%+32% ELSE X%=6%*((X%-1%)/10%)+X%-1% : IF X%=9% THEN X%=8% 1160 FNV$=K9$+CHR$(Y%)+CHR$(X%) 1170 FNEND 1180 OPEN "KB:" AS FILE 9% 1190 D%,D9%=0% : D8%=32767% 1200 N5%=1% : GOSUB 2320 1210 A9$="\\\"+LEFT(F$,3%)+SPACE$(N2%)+CHR$(13%)+CHR$(10%) 1220 ON ERROR GO TO 1226 : OPEN O$ FOR OUTPUT AS FILE 2% : ON ERROR GO TO 0 : GO TO 1230 1226 PRINT"** AUX LISTING DEVICE NOT AVAILABLE **" : PRINT"FILE ";F1$;" IS CLOSED" : GO TO 2510 1230 GOSUB 2230 1240 OPEN F1$ AS FILE 1% 1250 FIELD #1%,N1%*A% AS A$, N1% AS A$(A%) FOR A%=0% TO N6% 1260 ON ERROR GO TO 1530 : S$=SYS(CHR$(6%)+CHR$(-7%)) 1270 E%=0% : PRINT C8$;"ID:"; : INPUT LINE #9%,I$ 1280 A9%=0% : G9%=-1% 1290 I1%=ASCII(RIGHT(I$,LEN(I$))) : IF I1%*(I1%-10%)*(I1%-13%)=0% THEN IF LEN(I$) THEN I$=LEFT(I$,LEN(I$)-1%) : GO TO 1290 1300 IF ASCII(RIGHT(I$,LEN(I$)))=27% THEN I$=LEFT(I$,LEN(I$)-1%) : E%=2% 1310 IF I$="S" THEN CLOSE 1%,9% : PRINT : PRINT"FILE ";F1$;" IS CLOSED" : GO TO 2510 1320 IF E%<>2% THEN 1270 1322 IF LEN(I$)=8% THEN IF RIGHT(I$,7%)="/U" THEN G9%=0% : I$=LEFT(I$,6%) 1330 IF LEN(I$)<>6% THEN PRINT FNV$(5%,11%); CHR$(7%);"** ID MUST BE 6 CHARACTERS - RETYPE! **": SLEEP(2%) : GO TO 1260 1335 M9%=1% 1340 T%=L0%+1% : B%=1% : L1%=LOG(T%)/LOG(2)+4% 1350 FOR I%=1% TO L1% 1360 R%=(T%+B%)/2% 1370 R1%=(R%+N6%)/N% : A%=R%-1%-(R1%-1%)*N% : GET #1%, RECORD R1% 1380 I2$=LEFT(A$(A%),6%) : IF I2$<>" " THEN 1400 1390 R%=R%+(-1%)^I% : IF R%T% OR R%<=0% THEN 1430 ELSE 1370 1400 IF I2$=I$ THEN 1510 ELSE IF I2$>I$ THEN 1420 1410 B%=R% : GO TO 1430 1420 T%=R% 1430 NEXT I% 1440 ON ERROR GO TO 1540 1450 R1%=(L0%+N6%)/N% : A%=L0%-1%-(R1%-1%)*N% : IF R1%<1% THEN R1%=1% : A%=0% 1460 GET #1%, RECORD R1% : GO TO 1480 1470 IF A%ASCII(RIGHT(S$,4%)) THEN PRINT "** WRONG FILE TYPE **" : GO TO 2510 2390 N1%=510%/N% : N2%=N1%-8% : N3%=N%*N1% : N6%=N%-1% 2400 V2$(50%)="??" 2410 FOR V%=1% TO 50% 2420 V2$(V%)=MID(A$(A%),42%+(V%-1%)*4%,2%) : IF V2$(V%)=" " THEN 2460 2430 V5%=CVT$%(MID(A$(A%),44%+(V%-1%)*4%,2%)) 2440 V2%(1%,V%)=ASCII(CHR$(V5%)) : V2%(2%,V%)=ASCII(CHR$(SWAP%(V5%))) 2450 NEXT V% 2460 V2%(1%,0%)=V%-1% : IF N5% THEN 2470 ELSE PRINT"CODES: "; : PRINT V2$(I%)+" "; FOR I%=1% TO V%-1% : PRINT 2470 CLOSE 1% : ON ERROR GO TO 0 : RETURN 2480 IF ERR<>5% AND ERR<>21% THEN 2500 ELSE RESUME 2490 2490 IF V1$="" THEN V1$="DK1:" : GO TO 2340 2500 PRINT"THE FILE '$ATRIB' HAS BEEN DELETED;" : PRINT"IT MUST BE REPLACED TO PROCEED." 2510 END