100 ! POP -- A RECORD I/O VERSION OF PIP ! WHICH WILL TRANSFER FILES WITH A GIVEN BLOCKING ! OR WILL REBLOCK FILES. NUMBER OF RECORDS PER ! BLOCK MUST BE GIVEN IN THE COMMAND LINE. 120 ! 08-JAN-74 J. WARDEN WABASH COLLEGE 140 DIM A$(85%),B$(85%),M%(30%) 160 C9$=CHR$(13%)+CHR$(10%) 180 PRINT"POP V03E" 200 OPEN"KB:" FOR INPUT AS FILE 9 220 ! ACCEPT COMMAND LINE 240 IF E9% THEN CLOSE 9% : GO TO 1860 260 S$=SYS(CHR$(0%)) : ON ERROR GO TO 880 : PRINT"*"; : INPUT LINE #9%,C$ : C%=ASCII(C$)-10% : IF C%*(C%-3%)*(C%-17%)=0% THEN CLOSE 9% : GO TO 1860 280 L%,S1%=0% : L0=1. 300 A%=ASCII(RIGHT(C$,LEN(C$))) : IF A%=13% OR A%=10% THEN C$=LEFT(C$,LEN(C$)-1%) : GO TO 300 320 IF LEFT(C$,4%)="/CH:" THEN ON ERROR GO TO 880 : CHAIN RIGHT(C$,5%) 340 IF LEFT(C$,3%)="/EX" THEN CLOSE 9% : GO TO 1860 360 C%=INSTR(1%,C$,"/EX") : IF C% THEN E9%=1% : C$=LEFT(C$,C%-1%)+RIGHT(C$,C%+3%) 380 IF LEFT(C$,3%)="/HE" THEN GOSUB 1580 : GO TO 240 400 C%=INSTR(1%,C$,"/NL") : IF C% THEN L0=0.8 : C$=LEFT(C$,C%-1%)+RIGHT(C$,C%+3%) 420 C%=INSTR(1%,C$,"/LE") : IF C%=0% THEN 440 ELSE I$=LEFT(C$,C%-1%) : O$="" : GOSUB 1500 : PRINT"FILE '";I$;"' OCCUPIES"L%"BLOCKS" : GO TO 240 440 C%=INSTR(1%,C$,"/DE") : IF C%=0% THEN 540 460 ON ERROR GO TO 500 480 KILL LEFT(C$,C%-1%) : GO TO 220 500 PRINT"DELETION FAILURE ON "+LEFT(C$,C%-1%) 520 RESUME 220 540 C%=INSTR(1%,C$,"<") 560 IF C%=0% THEN O$="KB:" : I$=C$ : GO TO 620 580 O$=LEFT(C$,C%-1%) : I$=RIGHT(C$,C%+1%) 600 ! REC/BLOCK IN INPUT FILE STRING? 620 I%=INSTR(1%,I$,"/") 640 O%=INSTR(1%,O$,"/") 660 IF I%=0% THEN 760 680 R1%=VAL(RIGHT(I$,I%+1%))-1% 700 I$=LEFT(I$,I%-1%) 720 IF O% THEN 800 740 R0%=R1% : GO TO 980 760 ! REC/BLOCK IN OUTPUT FILE STRING? 780 IF O%=0% THEN PRINT"** PLEASE GIVE NO. REC/BLOCK **" : GO TO 220 800 R0%=VAL(RIGHT(O$,O%+1%))-1% 820 O$=LEFT(O$,O%-1%) 840 IF I%=0% THEN R1%=R0% 860 GO TO 980 880 IF ERR=11% THEN CLOSE 9% : GO TO 1860 900 IF ERR<>13% AND ERR<>14% THEN 940 920 IF I5%=82% THEN SLEEP 5% : RESUME 940 CLOSE 1%,2% 960 S$=SYS(CHR$(6%)+CHR$(9%)+CHR$(ERR)) : PRINT MID(S$,3%,INSTR(1%,S$,CHR$(0%))-3%);" ("; C$+")" : RESUME 240 980 I5%=512% 1000 IF INSTR(1%,I$,"DT1:") OR INSTR(1%,I$,"DT0:") THEN I5%=510% 1020 O5%=512% 1040 IF INSTR(1%,O$,"DT1:") OR INSTR(1%,O$,"DT0:") THEN O5%=510% 1060 IF INSTR(1%,O$,"CR:") THEN PRINT"** CAN'T OUTPUT TO CR: **" : GO TO 220 1080 IF INSTR(1%,I$,"CR:") THEN R1%=0% : I5%=82% 1100 GOSUB 1500 1120 OPEN I$ FOR INPUT AS FILE 1%,RECORDSIZE I5% 1140 OPEN O$ FOR OUTPUT AS FILE 2%,RECORDSIZE O5% 1160 L%=L0*L% : IF L% THEN PUT #2%, RECORD L% 1180 ON ERROR GO TO 1780 1200 N1%=510%/(R1%+1%) : M1%=510%/(R0%+1%) 1220 N3%=(R1%+1%)*N1% : M3%=(R0%+1%)*M1% 1240 M2%=M1%-8% 1260 IF I5%=82% THEN N1%=82% 1280 FIELD #1,N1%*A% AS Z$,N1% AS A$(A%) FOR A%=0% TO R1% 1300 FIELD #2%,M1%*S% AS Z$,M1% AS B$(S%) FOR S%=0% TO R0% 1320 S%=0% 1340 ! TRANSFER ALL RECORDS 1360 IF A%11% THEN 880 ELSE RESUME 1800 1800 LSET B$(H%)=B9$+SPACE$(M2%)+C9$ FOR H%=S% TO R0% 1820 IF L%=0% THEN PUT #2%, COUNT M3% ELSE S1%=S1%+1% : PUT #2%, RECORD S1%, COUNT M3% 1840 CLOSE 1%,2% : GO TO 240 1860 END