1000 ! FTCH01 -- FETCH OVERLAY #1 ! CONTAINS SEARCH, EDIT, & CLEANUP ROUTINES. 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%) 1045 IF K9%=2% THEN K8%=19% ELSE K8%=16% 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% 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% : PRINT 1310 IF I$="S" THEN 1720 1320 IF I$="?" THEN PRINT "PLEASE USE 'QUERY' FOR FILE SEARCHES" : SLEEP 2% : GO TO 1260 1322 IF I$<>"M" THEN 1330 ELSE IF M9% THEN PRINT"** MERGE MUST BE THE FIRST OPERATION **" : GO TO 1720 1324 IF T1%=0% THEN PRINT "** NO CORRECTIONS TO MERGE **" : SLEEP 2% : GO TO 1260 1328 PRINT"MERGE "; : CHAIN "DK1:$FTCH02" 1080 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%" 1520 GOSUB 1550 IF K9%>0% OR E%=0% : GOSUB 1940 : GO TO 1260 1530 IF ERR=28% THEN S$=SYS(CHR$(0%)) : &CHR$(7%);"** TYPE 'S' TO STOP THE PROGRAM **" : SLEEP 2% : RESUME 1260 1540 IF ERR=11% AND ERL=1470% THEN RESUME 1500 ELSE ON ERROR GO TO 0 1550 ! ===== LISTING SUBROUTINE ===== 1560 IF D%=2% OR K9%=0% THEN 1620 1570 FOR I%=1% TO V0% 1580 E1$=MID(A0$,V2%(1%,I%),V2%(2%,I%)) 1590 GOSUB 1712 1600 PRINT #D%,V1$(I%);V2$(I%);" ";E1$ 1610 NEXT I% : Z0%=0% : GO TO 1690 1620 FOR I%=1% TO V0% 1630 E1$=MID(A0$,V2%(1%,I%),V2%(2%,I%)) : IF E1$=SPACE$(V2%(2%,I%)) THEN 1660 1640 GOSUB 1712 1650 PRINT #D%,V2$(I%);" ";E1$ 1660 NEXT I% : Z0%=0% 1670 IF D%<>2% THEN PRINT : RETURN 1680 PRINT #D%,"--"; FOR I%=1% TO 15% : PRINT #D% 1690 D%=9% 1700 IF E% THEN RETURN 1710 PRINT FNV$(1%,3%);"#"; : INPUT #9%,E1$ : RETURN 1712 ! === F.P. & INTEGER CONVERSION === 1714 X%=ASCII(RIGHT(V2$(I%),2%))-35% : IF X%*(X%-2%) THEN RETURN 1716 IF X% THEN E1$=NUM$(CVT$%(E1$)) ELSE E1$=NUM$(CVT$F(E1$)) 1717 IF Z0%=0% THEN RETURN ELSE E1$="0 " 1718 IF X% THEN Z0$=CVT%$(0%) ELSE Z0$=CVTF$(0.) 1719 A0$=LEFT(A0$,V2%(1%,I%)-1%)+Z0$+RIGHT(A0$,V2%(1%,I%)+V2%(2%,I%)) : RETURN 1720 ! ===== CLEANUP & CLOSE ===== 1730 ON ERROR GO TO 1880 : S$=SYS(CHR$(6%)+CHR$(-7%)) 1740 IF D9%=0% THEN 1930 1800 PRINT"** NOW CLEANING FILE - WAIT PLEASE **" 1810 OPEN F1$ FOR INPUT AS FILE 3% 1820 FIELD #3%,N1%*B% AS Z$, N1% AS B$(B%) FOR B%=0% TO N6% 1830 B1%,B0%=D8%-1% : A%=0% 1840 IF B%11% THEN ON ERROR GO TO 0 1890 LSET A$(A1%)=A9$ FOR A1%=A% TO N6% 1900 B0%=B0%+1% : PUT #1%, RECORD B0% : IF B0%"/DE" THEN 2050 ELSE IF A9% THEN RETURN 2040 A0$=SPACE$(N1%-1%)+CHR$(13%) : D9%=D9%+1% : D8%=R1% IF R1%14% THEN ON ERROR GO TO 0 2124 IF ERL=1600% OR ERL=1650% OR ERL=1680% THEN PRINT CHR$(7%);"** AUX LISTING DEV: IS HUNG;"; " PLEASE FIX !! **" : SLEEP 2% : RESUME 1690 2130 E1$=LEFT(E1$+SPACE$(V2%(2%,J%)),V2%(2%,J%)) 2140 A0$=LEFT(A0$,V2%(1%,J%)-1%)+E1$+ RIGHT(A0$,V2%(1%,J%)+V2%(2%,J%)) 2150 IF K9%=0% THEN 1960 ELSE PRINT V1$(J%);V2$(J%); 2160 IF X%=35% THEN PRINT CVT$F(E1$);" " ELSE IF X%=37% THEN PRINT CVT$%(E1$);" " ELSE PRINT " ";E1$ 2170 GO TO 1960 2180 IF G9% THEN LSET A$(A%)=LEFT(A0$,N1%-1%)+CHR$(13%) ELSE LSET A$(A%)=A0$ 2190 IF A9% THEN LSET A$(A1%)=A9$ FOR A1%=A%+1% TO N6% 2200 PUT #1%, RECORD R1% 2210 IF A9% THEN T1%=T1%+1% : IF A%>=N6% THEN LSET A$(A1%)=A9$ FOR A1%=0% TO N6% : PUT #1%, RECORD R1%+1% : L%=L%+1% 2220 RETURN 2230 ! === SET UP CRT POINTERS === 2240 DIM V1$(50%) 2250 V0%=V2%(1%,0%) : V1%=V0%-(V0%/2%)*2% 2260 IF V0%<=8% THEN V1$(I%)=FNV$(1%,16%-I%) FOR I%=1% TO V0% : RETURN 2270 V2%=V0%/2% : IF V1% THEN V2%=V2%+1% 2280 V1$(I%)=FNV$(1%,K8%-I%) FOR I%=1% TO V2% 2290 V1$(I%)=FNV$(34%,K8%-I%+V2%) FOR I%=V2%+1% TO V0% 2300 RETURN 2310 ! === FILE ATTRIBUTES LOOKUP === 2320 DIM V2$(50),V2%(2,50) 2330 ON ERROR GO TO 2480 2340 OPEN V1$+"$ATRIB" FOR INPUT AS FILE 1% 2350 FIELD #1%, 255%*A% AS Z$, 255% AS A$(A%) FOR A%=0% TO 1% 2360 R%=ASCII(RIGHT(S$,5%)) : A%=ASCII(RIGHT(S$,6%)) 2370 GET #1%, RECORD R% 2380 V2%(2%,0%),N%=VAL(MID(A$(A%),4%,2%)) : N9%=VAL(MID(A$(A%),6%,1%))*2% 2385 IF N%<>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