0001 ! SWPDM Swap Disc Management
0002 ! Version 1.0 <871009.1200>
0003 ! Dennis R. Kolpanen \ Box 319 \ Allamuchy, NJ 07820 \ U.S.A.
0004 ! see SWPDMDES for information
0005 ! needs PILEXTLX,CUSTUTIL,STRINGLX,EDLEX
0020 CALL SWPDM @ PUT "#43" @ END @ SUB SWPDM
0030 DIM C$[96],B$[256],V$[6],S$[1],K$[4],C1$[16],D1$[16],M1$[12] @ S$=CHR$(96)
0040 DIM D$[60],F$[10],T$[9]
0050 INPUT "Directory file? ","DIRFL";D1$ @ D1$=UPRC$(TRIM$(D1$))
0060 IF D1$[1,2]='/E' THEN 'QUIT'
0070 ON ERROR GOTO 50 @ ASSIGN #1 TO D1$ @ R=0
0080 INPUT "Comment file? ","CMTFILE";C1$ @ C1$=UPRC$(TRIM$(C1$))
0090 IF C1$[1,2]="/E" THEN 'QUIT'
0100 ON ERROR GOTO 110 @ CREATE TEXT C1$
0110 OFF ERROR @ ASSIGN #2 TO C1$
0120 INPUT "Drive? ",":MASSMEM(1)";M1$ @ M1$=UPRC$(TRIM$(M1$))
0130 IF M1$[1,2]='/E' THEN 'QUIT'
0140 ON ERROR GOTO 120 @ V$=VOLUME$(M1$) @ OFF ERROR
0150 READ #1;B$ @ IF B$[10,15]#V$ THEN DISP "Volume missmatch" @ GOTO 'QUIT'
0160 X=0 @ ON ERROR GOTO 170 @ CREATE TEXT SWPDMDL @ X=1
0170 ASSIGN #4 TO SWPDMDL @ IF X THEN PRINT #4;V$ @ PRINT #4;STR$(R) @ RESTORE #4
0180 READ #4;B$ @ IF B$#V$ THEN X=1 @ GOTO 170
0190 READ #4;B$ @ R=VAL(B$)
0200 FOR C=1 TO INF @ GOSUB 'NEXTREC'
0210 IF E THEN 'QUIT'
0220 NEXT C
0230 'NEXTREC':
0240 E=0 @ ON ERROR GOSUB 'READERR'
0250 READ #1,R;D$ @ OFF ERROR @ REPLACE #4,1;STR$(R) @ R=R+1 @ IF E THEN 300
0260 ! ON ERROR GOTO 210 @ X=VAL(D$[1,4]) @ OFF ERROR
0270 IF NOT POS('0123456789',D$[1,1]) THEN 240
0280 F$=TRIM$(D$[6,15]) @ T$=TRIM$(D$[19,23])
0290 'CHOICE': DISP CHR$(10);F$;"  ";T$
0300 IF E THEN P=4 ELSE IF T$="TEXT" OR T$="BASIC" THEN P=1 ELSE P=3
0310 ! M$="Disp Prnt Cmnt Next Quit"
0320 E=0 @ DISP "Disp Prnt Cmnt Srch Quit <mv>"[(P-1)*5+1]
0330 K$=UPRC$(KEYWAIT$) @ K$=K$&"   "[1,3-LEN(K$)]
0340 Q=POS("D   P   C   S   Q   #50 #51 #162#163"[(P-1)*4+1],K$)
0350 IF Q>0 THEN Q=Q DIV 4+1+(P-1)*1
0360 ON Q+1 GOTO 320,'DISPLAY','PRINT','COMMENT','SRCH','DFRE','UONE',410,'UTOP','DBOT'
0370 'UONE': R=R-2 @ IF P=4 THEN R=R-1
0380 RETURN 
0390 'UTOP': R=0 @ RETURN 
0400 'DBOT': R=FILESZR(D1$)-1 @ RETURN 
0410 RETURN 
0420 'READERR': DISP ERRM$ @ E=1 @ RETURN 
0430 'DFRE': E=1 @ RETURN 
0440 'SRCH': INPUT "File name? ";B$ @ B$=UPRC$(TRIM$(B$)) @ R=R-1
0450 IF NOT LEN(B$) OR B$[1,2]="/E" THEN RETURN 
0460 X=SEARCH(CHR$(92)&"^"&"....."&B$,0,0,9999,1) @ IF X=0 THEN DISP "Not found" ELSE R=IP(X)
0470 RETURN 
0480 'DISPLAY': D=1 @ GOTO 490 @ 'PRINT': D=0
0490 IF T$[1,2]="BA" THEN 'BAFILE' ELSE 'LIFILE'
0500 'LIFILE': ASSIGN #3 TO F$&M1$ @ ON ERROR GOTO 570 @ GOSUB 760
0510 FOR X=1 TO INF @ READ #3;B$
0520 IF D THEN DISP B$ ELSE PRINT B$
0530 IF (NOT D OR MOD(X,22)#0) AND NOT KEYDOWN("Q") THEN 550
0540 DISP "More..." @ K$=UPRC$(KEYWAIT$) @ IF K$='Q' THEN 570
0550 NEXT X
0560 GOTO 520
0570 OFF ERROR @ ASSIGN #3 TO * @ 'CB': IF LEN(KEY$)>0 THEN 'CB'
0580 GOTO 'CHOICE'
0590 'BAFILE': DISP @ ON ERROR GOTO 'NR' @ COPY F$&M1$ TO :MAIN @ OFF ERROR
0600 DISP "List Purge Main" @ K$=UPRC$(KEYWAIT$)
0610 ON POS("LPM",K$)+1 GOTO 600,620,650,'CHOICE'
0620 GOSUB 760
0630 IF D THEN LIST F$ ELSE PLIST F$
0640 GOTO 600
0650 PURGE TRIM$(F$[1,8])&":main" @ GOTO 'CHOICE'
0660 ! GOTO 'CHOICE'
0670 'COMMENT': L9=FILESZR(C1$)
0680 L=SEARCH(CHR$(92)&"^"&V$&S$&F$,1,0,L9,2)
0690 IF L THEN L9=L ELSE RESTORE #2,FILESZR(C1$) @ PRINT #2;"temp"
0700 RESTORE #2,L9 @ C$="" @ IF NOT L THEN 730
0710 READ #2;B$ @ X=0 @ FOR X2=1 TO 3 @ X=POS(B$,S$,X+1) @ NEXT X2
0720 C$=B$[X+1] @ IF LEN(C$)>41 THEN GOSUB 'UNSPLIT'
0730 LINPUT "comment? ",C$;C$ @ IF LEN(C$)>40 THEN GOSUB 'SPLIT'
0740 REPLACE #2,L9;V$&S$&F$&S$&T$&S$&TRIM$(C$)
0750 GOTO 'CHOICE'
0760 B$="" @ B$[80]=" " @ B$=F$&"("&V$&")" @ B$[37]=DATE$ @ B$[73]=TIME$
0770 B$[81]=CHR$(10) @ IF D THEN DISP B$ ELSE PRINT B$
0780 RETURN 
0790 'NR': DISP ERRM$ @ GOTO 'CHOICE'
0800 'SPLIT': X=MEMBER(REV$(C$)," ,.:;)",LEN(C$)-40) @ IF NOT X THEN X=40
0810 X=LEN(C$)-X+2 @ C$=C$[1,X-1]&S$&C$[X] @ RETURN 
0820 'UNSPLIT': X=POS(C$,S$) @ IF X THEN C$=C$[1,X-1]&C$[X+1]
0830 RETURN 
0840 'QUIT': FOR X=1 TO 4 @ ASSIGN #X TO * @ NEXT X @ END SUB