0010 SUB COLRM(F1$,F2$,C1,C2) ! 
0020 ! REMOVE COLUMNS BETWEEN C1 & C2
0030 ! BY JIM WALTERS (404) 432-0776
0040 ASSIGN #1 TO F1$ @ CREATE TEXT F2$ @ ASSIGN #2 TO F2$
0050 C3=C1-1 @ C4=C2+1 @ L1=C2-C3 @ DIM A$[255]
0060 FOR I=1 TO INF @ ON ERROR GOTO 100 @ READ #1;A$ @ OFF ERROR @ L=LEN(A$)
0070 IF L<C4 THEN A$[C4]=' '
0080 PRINT #2;A$[0,C3]&A$[C4][0,L-L1]
0090 NEXT I
0100 OFF ERROR @ ASSIGN #1 TO * @ ASSIGN #2 TO *
0110 END 
0120 SUB EXPAND(F1$,F2$,C$,T) ! 
0130 ! EXPAND TAB CHAR TO SPACES
0140 ! BY JIM WALTERS (404) 432-0776
0150 ASSIGN #1 TO F1$ @ CREATE TEXT F2$ @ ASSIGN #2 TO F2$ @ DIM A$[255],B$[255]
0160 IF T=0 THEN T=8
0170 FOR I=1 TO INF @ ON ERROR GOTO 220 @ READ #1;A$ @ OFF ERROR @ L=LEN(A$) @ T1=T-1 @ B$=''
0180 FOR J=1 TO L @ IF LEN(B$)>T1 THEN T1=T1+T
0190 IF A$[J,J]#C$ THEN B$=B$&A$[J,J] @ GOTO 210
0200 FOR K=LEN(B$) TO T1 @ B$=B$&' ' @ NEXT K
0210 NEXT J @ PRINT #2;B$ @ NEXT I
0220 OFF ERROR @ ASSIGN #1 TO * @ ASSIGN #2 TO *
0230 END 
0240 SUB FOLD(F1$,F2$,C) ! 
0250 ! FOLD LINES TO FIXED LENGTH
0260 ! BY JIM WALTERS (404) 432-0776
0270 ASSIGN #1 TO F1$ @ CREATE TEXT F2$ @ ASSIGN #2 TO F2$ @ DIM A$[255]
0280 IF C=0 THEN C=80
0290 FOR I=1 TO INF @ ON ERROR GOTO 320 @ READ #1;A$ @ OFF ERROR
0300 IF LEN(A$)<=C THEN PRINT #2;A$ ELSE PRINT #2;A$[1,C] @ A$=A$[C+1] @ GOTO 300
0310 NEXT I
0320 OFF ERROR @ ASSIGN #1 TO * @ ASSIGN #2 TO *
0330 END 
0340 SUB REV(F1$,F2$) ! 
0350 ! REVERSES CHARACTERS IN EACH LINE OF FILE
0360 ! STRINGLX REQ'D
0370 ASSIGN #1 TO F1$ @ CREATE TEXT F2$ @ ASSIGN #2 TO F2$ @ DIM A$[255]
0380 FOR I=1 TO INF @ ON ERROR GOTO 390 @ READ #1;A$ @ OFF ERROR @ PRINT #2;REV$(A$) @ NEXT I
0390 OFF ERROR @ ASSIGN #1 TO * @ ASSIGN #2 TO *
0400 END 
0410 SUB UNEXPAND(F1$,F2$,C$,T) ! 
0420 ! COLAPSE SPACES TO TAB CHAR'S
0430 ! BY JIM WALTERS (404) 432-0776
0440 ASSIGN #1 TO F1$ @ CREATE TEXT F2$ @ ASSIGN #2 TO F2$ @ DIM A$[255],B$[255]
0450 IF T=0 THEN T=8
0460 FOR I=1 TO INF @ ON ERROR GOTO 500 @ READ #1;A$ @ OFF ERROR @ B$=''
0470 IF LEN(A$)<=T THEN B$=B$&C$&TRIM$(A$) @ GOTO 490
0480 B$=B$&C$&TRIM$(A$[1,T]) @ A$=A$[T+1] @ GOTO 470
0490 PRINT #2;B$[LEN(C$)+1] @ NEXT I
0500 OFF ERROR @ ASSIGN #1 TO * @ ASSIGN #2 TO *
0510 END 
0520 SUB UNIQ(F1$,F2$,C1,C2,N) ! 
0530 ! ELIMINATE CONSECUTIVE DUPLICATE LINES
0540 ! BY JIM WALTERS (404) 432-0776
0550 ASSIGN #1 TO F1$ @ CREATE TEXT F2$ @ ASSIGN #2 TO F2$
0560 N=0 @ DIM A$[255],B$[255]
0570 IF C1=0 THEN C1=1
0580 IF C2=0 THEN C2=95
0590 B$='' @ L2=LEN(B$) @ FOR I=1 TO INF @ A$=B$ @ L1=L2
0600 ON ERROR GOTO 650 @ READ #1;B$ @ OFF ERROR @ L2=LEN(B$)
0610 IF I=1 THEN 640
0620 IF L1<C1 OR L2<C1 THEN PRINT #2;A$ @ GOTO 640
0630 IF A$[C1,MIN(C2,L1)]#B$[C1,MIN(C2,L2)] THEN PRINT #2;A$ ELSE N=N+1
0640 NEXT I
0650 OFF ERROR @ PRINT #2;A$
0660 END 
0670 SUB WC(F$,L,W,C) ! 
0680 ! WORD COUNT - COUNTS LINES, WORDS, CHAR'S
0690 ! BY JIM WALTERS (404) 432-0776
0700 DIM R$[256]
0710 ASSIGN #1 TO F$
0720 L=0 @ W=0 @ C=0
0730 ON ERROR GOTO 780 @ READ #1;R$ @ OFF ERROR
0740 L=L+1 @ L1=LEN(R$) @ C=C+L1 @ W1=0 @ F=0
0750 FOR I=1 TO L1 @ IF R$[I,I]=' ' THEN F=0 @ GOTO 770
0760 IF F=0 THEN W1=W1+1 @ F=1
0770 NEXT I @ W=W+W1 @ GOTO 730
0780 ASSIGN #1 TO *
0790 END 
0800 SUB TR(F1$,F2$,S$,R$) ! 
0810 ! TRANSLATE CHAR'S
0820 ! by Jim Walters
0830 ASSIGN #1 TO F1$ @ CREATE TEXT F2$ @ ASSIGN #2 TO F2$
0840 DIM A$[255],B$[255],C$[1]
0850 R1=LEN(R$)
0860 FOR I=1 TO INF @ ON ERROR GOTO 920
0870 READ #1;A$ @ OFF ERROR @ B$=''
0880 FOR J=1 TO LEN(A$) @ C$=A$[J,J] @ P=POS(S$,C$)
0890 IF NOT P THEN B$=B$&C$ @ GOTO 910
0900 IF P>R1 THEN 910 ELSE B$=B$&R$[P,P]
0910 NEXT J @ PRINT #2;B$ @ NEXT I
0920 OFF ERROR @ ASSIGN #1 TO * @ ASSIGN #2 TO *
0930 END 
0940 SUB CRYPT(F$,K$) ! 
0950 ! EN/DECRYPTS A FILE
0960 ! by Jim Walters (404) 432-0776
0970 DIM R$[96] @ ASSIGN #1 TO F$
0980 S=0 @ FOR I=1 TO LEN(K$) @ S=ABS(LOG(NUM(K$[I,I])+1))+S/10 @ NEXT I @ RANDOMIZE FP(S)
0990 DESTROY K$
1000 FOR J=0 TO INF
1010 ON ERROR GOTO 1040 @ READ #1,J;R$ @ OFF ERROR
1020 FOR I=1 TO LEN(R$) @ R$[I,I]=CHR$(BINEOR(NUM(R$[I,I]),IP(RND*255+1))) @ NEXT I
1030 REPLACE #1,J;R$ @ NEXT J
1040 OFF ERROR @ DESTROY S @ ASSIGN #1 TO *
1050 END 
1060 SUB CLS ! 
1070 ! CLEARS SCREEN
1080 ! BY JIM WALTERS
1090 ON ERROR GOTO 1100 @ CLEAR :DISPLAY
1100 OFF ERROR
1110 END 
1120 SUB WIDEPRT(F$) ! 
1130 ! MULTI STRIP PRINT OF FILES
1140 ! BY JIM WALTERS (404) 432-0776
1150 ASSIGN #1 TO F$
1160 DIM A$[256]
1170 FOR I=1 TO 11
1180 C1=(I-1)*24+1
1190 C2=C1+23
1200 RESTORE #1
1210 M=0
1220 ON ERROR GOTO 1300
1230 READ #1;A$
1240 OFF ERROR
1250 M=MAX(M,LEN(A$))
1260 A$[97]=' '
1270 PRINT A$[C1,C2]
1280 GOTO 1220
1300 PRINT @ PRINT @ PRINT @ PRINT 
1310 IF M<=C2 THEN 1330
1320 NEXT I
1330 ASSIGN #1 TO *
1340 END 
1350 SUB DIR ! 
1360 ! FROM PPC V3N5P30
1370 DISP ':MAIN CATALOG ';DATE$ @ J=0
1380 FOR I=1 TO INF
1390 IF CAT$(I)='' THEN 1430
1400 DISP CAT$(I)[1,22]
1410 J=J+VAL(CAT$(I)[18,22])
1420 NEXT I
1430 DISP 'Files=';I-1;' Bytes=';J
1440 DISP 'Available Memory=';MEM
1450 END 
1460 SUB CAL(M,Y) ! 
1470 ! display a calendar
1480 ! by Jim Walters
1490 DIM D$[74],M$[36] @ IF M<0 OR M>12 THEN DISP 'Invalid date' @ GOTO 1660
1500 IF Y=0 THEN Y=VAL(DATE$[1,2])
1510 IF Y<100 THEN Y=Y+1900
1520 IF M=0 THEN M=VAL(DATE$[4,5])
1530 A$[12]=' ' @ D$=' 1 2 3 4 5 6 7 8 910111213141516171819202122232425262728293031'
1540 M$='JanFebMarAprMayJunJulAugSepOctNovDec'
1550 IF M=4 OR M=6 OR M=9 OR M=11 THEN D1=30 ELSE D1=31
1560 IF M#2 THEN 1590 ELSE D1=28
1570 IF MOD(Y,4)#0 THEN 1590
1580 IF MOD(Y,100)=0 AND MOD(Y,400)#0 THEN 1590 ELSE D1=29
1590 Z=Y+(M-2.85)/12
1600 D=MOD(INT(INT(INT(367*Z)-INT(Z)-.75*(INT(Z)+1)-.75*INT(Z/100))+1721110),7)
1610 DISP USING 1640;M$[3*M-2,3*M],Y @ D$=A$[0,2*D]&D$[1,2*D1]
1620 FOR I=1 TO 6 @ DISP USING 1650;D$[1,14] @ IF D$='' THEN 1660
1630 D$=D$[15] @ NEXT I
1640 IMAGE 6X,3A,2X,4D,/,'Su Mo Tu We Th Fr Sa'
1650 IMAGE AAXAAXAAXAAXAAXAAXAA 
1660 END 
1670 SUB SPLIT(F1$,F2$,N) ! 
1680 ! Splits a file into n-line pieces
1690 ASSIGN #1 TO F1$
1700 IF F2$='' THEN F2$=F1$
1710 DIM R$[256]
1720 FOR I=1 TO INF
1730 CREATE TEXT F2$&STR$(I) @ F=0
1740 ASSIGN #2 TO F2$&STR$(I)
1750 FOR J=1 TO N
1760 ON ERROR GOTO 1780 @ READ #1;R$ @ OFF ERROR
1770 PRINT #2;R$ @ F=1 @ NEXT J @ NEXT I
1780 OFF ERROR @ ASSIGN #1 TO * @ ASSIGN #2 TO * @ IF F=0 THEN PURGE F2$&STR$(I)
1790 END 
1800 SUB MORE(F$) ! 
1810 ! Browse a file by Jim Walters
1820 N=24 @ W=80 ! screen length,width
1830 DISP 'Working...'
1840 DIM R$[255] @ ASSIGN #1 TO F$ @ L=0 @ B=0 @ X=0 @ N1=N-1 @ E$=CHR$(27)&'A'&CHR$(27)&'J'
1850 CLEAR :DISPLAY
1860 FOR I=1 TO INF
1870 ON ERROR GOTO 2050 @ READ #1;R$ @ OFF ERROR
1880 IF L2=I THEN X=0 @ CLEAR :DISPLAY @ L=0
1890 IF X THEN 2040
1900 L1=LEN(R$) @ F=MOD(L1,W) @ L1=L1 DIV W
1910 IF F THEN L1=L1+1
1920 IF L+L1<N1 THEN DISP R$ @ L=L+L1 @ GOTO 2040
1930 ! wait for key
1940 DISP '­­ Íïòå ­­'
1950 K$=UPRC$(KEY$) @ IF K$='' THEN 1950
1960 IF K$='#38' THEN 2030
1970 ON POS('Q+= ',K$)+1 GOTO 1950,2050,1980,2010,2020
1980 DISP E$; @ INPUT '+';L2 @ DISP E$;
1990 X=1 @ IF L2<I THEN RESTORE #1 @ GOTO 1860 ELSE 2040
2000 GOTO 2040
2010 DISP E$;'Line: ';I; @ GOTO 1940
2020 DISP E$; @ L=L1 @ DISP R$ @ GOTO 2040
2030 DISP E$; @ L=N1 @ DISP R$
2040 NEXT I
2050 OFF ERROR @ ASSIGN #1 TO * @ PUT '#43'
2060 END 
2070 SUB BSPLIT(F1$,F2$) ! 
2080 ! Splits a BASIC program into subprograms
2090 ! by Jim Walters
2100 DIM R$[96]
2110 ASSIGN #99 TO F1$ @ IF F2$='' THEN F2$=F1$
2120 P=0 @ F=0 @ READ #99;R$ @ GOSUB 2230 @ RESTORE #99
2130 IF POS('0123456789',R$[1,1]) THEN N=1 ELSE N=0
2140 GOSUB 2210
2150 FOR I=1 TO INF
2160 ON ERROR GOTO 2240 @ READ #99;R$ @ OFF ERROR @ GOSUB 2230
2170 IF N THEN N$=R$[1,4]&' ' @ R$=R$[5] ELSE N$=''
2180 GOSUB 2230 @ IF LEN(R$)<4 THEN 2200
2190 IF UPRC$(R$[1,4])='SUB ' THEN GOSUB 2210
2200 PRINT #P;N$&R$ @ NEXT I
2210 IF F THEN P=P+1 @ CREATE TEXT F2$&STR$(P) @ ASSIGN #P TO F2$&STR$(P) @ RETURN 
2220 F=1 @ RETURN 
2230 IF R$[1,1]=' ' THEN R$=R$[2] @ GOTO 2230 ELSE RETURN 
2240 OFF ERROR @ ASSIGN #99 TO *
2250 END 
2251 ! 
2260 SUB HEAD(N,F$) ! 
2270 ! display 1st n lines of files
2280 ! by Jim Walters
2290 X=1 @ DIM R$[255] @ DISP 
2300 P=POS(F$,',') @ IF P THEN F1$=F$[1,P-1] @ F$=F$[P+1] ELSE F1$=F$ @ X=0
2310 ASSIGN #1 TO F1$ @ DISP '==> '&F1$&' <=='
2320 FOR I=1 TO N @ ON ERROR GOTO 2330 @ READ #1;R$ @ OFF ERROR @ DISP R$ @ NEXT I @ DISP 
2330 OFF ERROR @ IF X THEN 2300
2340 ASSIGN #1 TO *
2350 PUT '#43'
2360 END 
2370 SUB TAIL(N,F$) ! 
2380 ! display the last part of files
2390 ! by Jim Walters
2400 OPTION BASE 0
2410 IF N<0 THEN N=-N @ B=0 ELSE B=1
2420 DIM R$(N)[255]
2430 X=1
2440 P=POS(F$,',')
2450 IF P THEN F1$=F$[1,P-1] @ F$=F$[P+1] ELSE F1$=F$ @ X=0
2460 ASSIGN #1 TO F1$
2470 DISP '==> '&F1$&' <=='
2480 FOR I=1 TO INF
2490 ON ERROR GOTO 2520 @ READ #1;R$(MOD(I,N)) @ OFF ERROR
2500 IF B AND I>=N THEN DISP R$(MOD(I,N))
2510 NEXT I
2520 OFF ERROR @ IF B THEN 2550
2530 FOR J=0 TO N-1 @ IF R$(MOD(J+I,N))#'' THEN DISP R$(MOD(J+I,N))
2540 NEXT J
2550 DISP @ IF X THEN 2430
2560 ASSIGN #1 TO *
2570 PUT '#43'
2580 END 
2590 SUB PAIR(F$,C$) ! 
2600 ! check for balanced pairings of chars
2610 ! by Jim Walters
2620 L=LEN(C$) @ IF MOD(L,2) THEN BEEP @ DISP 'Odd pairings' @ END 
2630 L=L DIV 2 @ DIM Y(L),Z(L),R$[96]
2640 FOR J=1 TO L @ Y(J)=0 @ Z(J)=0 @ NEXT J
2650 ASSIGN #1 TO F$
2660 DISP 'Pairing check of '&F$
2670 FOR I=1 TO INF
2680 ON ERROR GOTO 2780 @ READ #1;R$ @ OFF ERROR
2685 K1=0 @ K2=0
2690 FOR J=1 TO LEN(R$)
2695 IF R$[J,J]="'" THEN K1=K1+1
2697 IF R$[J,J]='"' THEN K2=K2+1
2700 X=POS(C$,R$[J,J])
2710 IF NOT X THEN 2740
2720 X2=(X+1) DIV 2 @ IF MOD(X,2) THEN Y(X2)=Y(X2)+1 ELSE Y(X2)=Y(X2)-1
2730 IF Y(X2)<0 THEN Z(X2)=1
2740 NEXT J
2750 FOR J=1 TO L
2760 IF Z(J) OR Y(J) THEN DISP C$[2*J-1,2*J]&' line: ';I
2770 Z(J)=0 @ Y(J)=0 @ NEXT J
2772 IF MOD(K1,2) THEN DISP "'' line: ";I
2774 IF MOD(K2,2) THEN DISP '"" line: ';I
2776 NEXT I
2780 DISP @ ASSIGN #1 TO * @ PUT '#43'
2790 END 
2800 SUB CMP(F1$,F2$,P) ! 
2810 ! compare 2 files & ret. l.c of 1st diff.
2820 ! by Jim Walters
2830 DIM R1$[255],R2$[255]
2840 ASSIGN #1 TO F1$ @ ASSIGN #2 TO F2$
2850 P=0
2860 FOR I=1 TO INF
2870 ON ERROR GOTO 2920 @ READ #1;R1$
2880 ON ERROR GOTO 2930 @ READ #2;R2$ @ OFF ERROR
2890 FOR J=1 TO MAX(LEN(R1$),LEN(R2$))
2900 IF R1$[J,J]#R2$[J,J] THEN 2940
2910 NEXT J @ NEXT I
2920 ON ERROR GOTO 2950 @ READ #2;R2$
2930 OFF ERROR @ P=I @ GOTO 2950
2940 P=I+J/1000
2950 ASSIGN #1 TO * @ ASSIGN #2 TO *
2960 END 
2970 SUB DEROFF(F1$,F2$,C$) ! 
2980 ! removes text formatting commands beginning with char c$
2990 ! by Jim Walters
3000 ASSIGN #1 TO F1$
3010 CREATE TEXT F2$ @ ASSIGN #2 TO F2$
3020 DIM R$[255]
3030 FOR I=1 TO INF
3040 ON ERROR GOTO 3150 @ READ #1;R$ @ OFF ERROR
3050 IF R$[1,1]#C$ THEN 3130
3060 R$=R$[4] @ IF R$='' THEN 3140
3070 IF R$[1,1]=' ' THEN R$=R$[2] @ GOTO 3130
3080 IF R$[1,1]=C$ THEN 3060
3090 IF NOT POS('0123456789',R$[1,1]) THEN 3130
3100 R$=R$[2] @ IF R$='' THEN 3140
3110 IF POS('0123456789,',R$[1,1]) THEN 3100
3120 IF R$[1,1]=C$ THEN 3060
3130 PRINT #2;R$
3140 NEXT I
3150 OFF ERROR @ ASSIGN #1 TO * @ ASSIGN #2 TO *
3160 END 
3170 SUB PASTE(F1$,F2$,C$) ! 
3180 ! horizontally concatenate files
3190 ! by Jim Walters
3200 DIM R$[255],R1$[255]
3210 X=1 @ N=0
3220 N=N+1 @ P=POS(F1$,',')
3230 IF P THEN P1=P @ F$=F1$[1,P-1] @ F1$=F1$[P+1] ELSE F$=F1$ @ X=0
3240 ASSIGN #N TO F$
3250 IF X THEN 3220
3260 CREATE TEXT F2$
3270 ASSIGN #99 TO F2$
3280 R$='' @ F=0 @ C1$=C$
3290 FOR J=1 TO N
3300 P=POS(C1$,',') @ IF P THEN C=VAL(C1$[1,P-1]) @ C1$=C1$[P+1] ELSE C=VAL(C1$)
3310 ON ERROR GOTO 3340
3320 READ #J;R1$ @ F=1 @ OFF ERROR
3330 R$[C]=R1$
3340 OFF ERROR @ NEXT J
3350 PRINT #99;R$
3360 IF F THEN 3280
3370 ASSIGN #99 TO *
3380 END 
3390 SUB CONCAT(F1$,F2$,N) ! 
3400 ! concatenate files
3410 ! by Jim Walters
3420 X=1 @ J=0 @ N$='' @ DIM R$[255]
3430 IF F2$#'' THEN CREATE TEXT F2$ @ ASSIGN #2 TO F2$
3440 P=POS(F1$,',') @ IF P THEN F$=F1$[1,P-1] @ F1$=F1$[P+1] ELSE F$=F1$ @ X=0
3450 ASSIGN #1 TO F$
3460 FOR I=1 TO INF @ ON ERROR GOTO 3500 @ READ #1;R$ @ OFF ERROR
3470 J=J+1 @ IF N THEN N$='000'[0,4-LEN(STR$(J))]&STR$(J)
3480 IF F2$='' THEN DISP N$&' '&R$ ELSE PRINT #2;N$&' '&R$
3490 NEXT I
3500 OFF ERROR @ IF X THEN 3440
3510 ASSIGN #1 TO *
3520 IF F2$#'' THEN ASSIGN #2 TO *
3530 PUT '#43'
3540 END 
3550 SUB TEE(F1$,F2$,A)
3560 ! copy file to multiple files
3570 ! by Jim Walters
3580 DIM R$[255] @ N=0 @ X=1 @ ASSIGN #99 TO F1$
3590 N=N+1 @ P=POS(F2$,',')
3600 IF P THEN F$=F2$[1,P-1] @ F2$=F2$[P+1] ELSE F$=F2$ @ X=0
3610 ON ERROR GOTO 3620 @ CREATE TEXT F$
3620 OFF ERROR @ ASSIGN #N TO F$
3630 IF A THEN RESTORE #N,9999
3640 IF X THEN 3590
3650 FOR I=1 TO INF
3660 ON ERROR GOTO 3690 @ READ #99;R$ @ OFF ERROR
3670 FOR J=1 TO N @ PRINT #J;R$ @ NEXT J
3680 NEXT I
3690 OFF ERROR @ ASSIGN #99 TO *
3700 END