0001 ! SWEEP for the HP-71
0002 ! December 28, 1986
0003 ! Maynard Riley [1442]
0004 ! use ? for help and see the listing for instruction
0005 !
0006 ! IMPORTANT: See the end of file subprogram, ABREV,
0007 !              for customizing device responses.
0009 !
0011 DIM D0$,D1$,K$[43],F$[32],D$
0012 INTEGER K,F,I,J
0018 D0$=":MAIN"
0019 CFLAG 0,2
0020 ON ERROR GOTO 'ERRORS'
0021 CFLAG 2
0025 GOSUB 'SETUP'
0030 DESTROY T @ INTEGER T(K)
0040 F=1
0050 IF FLAG(2) THEN GOSUB 'MASS1' ELSE F$=CAT$(F,D0$)[1,22]
0051 IF F$="" THEN K=K-1 @ GOTO 'K'
0060 D$=" "
0061 FOR I=1 TO T(0)
0062 IF F=T(I) THEN D$="*"
0063 NEXT I
0064 DISP F;D$;" ";F$
0065 F$=F$[1,POS(F$," ")-1]&D0$
0070 K$=UPRC$(KEYWAIT$) @ K1$=K$
0071 IF K$=" " THEN K$="K"
0072 IF NUM(K$)=35 THEN K$='K'&K$[2,4]
0073 IF K$='?' THEN K$='K168'
0074 IF K$='.' THEN INPUT "file # ";F @ GOTO 50
0080 GOSUB K$
0081 !
0087 'K158': POKE "2F443","0"
0088 'K51':
0089 'K38':
0090 'K': IF F>=K THEN 40 ELSE F=F+1 @ GOTO 50
0091 !
0092 'K163':
0093 F=K @ GOTO 50
0094 !
0095 'B':
0096 'K50': F=F-1
0097 IF F=0 THEN F=K
0098 GOTO 50
0099 !
0100 'K162': GOTO 40
0101 !
0200 'P':
0210 DISP "Purge "&F$&" ?"
0220 K$=UPRC$(KEYWAIT$)
0230 IF K$='Y' OR K$='#38' THEN PURGE F$ @ K=K-1
0240 RETURN
0241 !
0250 'D':
0260 DISP "Delete ";T(0);" tagged files" @ WAIT 1
0270 DISP "from ";D0$ @ WAIT 1
0280 DISP "continue ?";
0290 K$=UPRC$(KEYWAIT$)
0300 IF K$#'Y' THEN RETURN
0310 FOR I=1 TO T(0)
0320 D$=CAT$(T(I),D0$)[1,8]
0330 D$=RTRIM$(D$)
0340 PURGE D$&D0$
0350 DISP D$&D0$&" Purged"
0351 FOR J=1 TO T(0)
0352 IF T(J)>I THEN T(J)=T(J)-1
0353 NEXT J
0355 NEXT I
0360 K=K-T(0) @ GOTO 30
0399 !
0400 'C':
0410 DISP "Copy ";F$;" to";
0420 INPUT K$
0425 CALL ABREV(K$)
0426 I=POS(K$,':')
0428 IF I=0 THEN D$=K$&D0$ @ D1$=D0$
0430 IF I=1 THEN D$=F$[1,POS(F$,':')-1]&K$ @ D1$=K$
0432 IF I>1 THEN D$=K$ @ D1$=K$[I]
0434 IF D$=F$ THEN RETURN
0436 'C1':
0437 IF D1$=':PC' THEN REMOTE
0438 COPY F$ TO D$ @ LOCAL
0439 IF D1$=D0$ THEN K=K+1
0440 RETURN
0499 !
0500 'H':
0501 PLIST F$ @ RETURN
0502 'V':
0503 LIST F$ @ RETURN
0540 !
0600 'T':
0610 T(0)=T(0)+1 @ T(T(0))=F
0620 D$="*" @ PUT "#51" @ GOTO 64
0630 !
0640 'U':
0650 GOSUB 'FINDT'
0660 FOR J=I TO T(0) @ T(J)=T(J+1) @ NEXT J
0670 T(0)=T(0)-1
0680 D$=" " @ PUT "#51" @ GOTO 64
0690 !
0700 'M':
0710 DISP "Mass Copy to ? Device ";
0720 LINPUT D1$
0730 CALL ABREV(D1$)
0735 IF D1$[1,1]#':' THEN 'M'
0740 FOR I=1 TO T(0)
0750 D$=CAT$(T(I),D0$)[1,8]
0751 ! D$=D$[1,POS(D$," ")-1]
0752 D$=RTRIM$(D$)
0759 DISP "Copying "&D$&D0$&" to "&D1$
0762 IF D1$=':PC' THEN REMOTE
0765 COPY D$&D0$ TO D$&D1$
0767 LOCAL
0770 NEXT I
0780 RETURN
0829 !
0830 'S':
0840 FOR I=1 TO T(0)
0850 DISP T(I);"* ";CAT$(T(I),D0$)[1,8];" tagged"
0851 WAIT 1
0860 NEXT I
0870 DISP "in "&D0$
0871 WAIT 1
0880 RETURN
0889 !
0900 'FINDT':
0910 FOR I=1 TO T(0)
0920 IF T(I)=F THEN RETURN
0930 NEXT I
0940 DISP F,F$;" not tagged"
0950 RETURN
0990 !
1000 'L': ! Log New Device
1010 LINPUT "Log ? Device ";D0$
1015 CALL ABREV(D0$)
1016 IF DEVAID(D0$)#16 THEN 21
1020 SFLAG 2
1030 GOSUB 'MASS0' @ GOSUB 'EXIT1' @ GOTO 30
1999 !
2000 'ERRORS':
2001 IF ERRN=59 THEN 'ASKDEL'
2002 IF ERRN=30 THEN BEEP @ DISP "use '?' for help" @ WAIT 1 @ GOTO 50
2010 DISP ERRM$;ERRN;ERRL
2020 RETURN
2999 !
3000 'SETUP':
3010 FOR K=1 TO INF
3020 K$=CAT$(K,D0$)
3030 IF K$="" THEN K=K-1 @ GOTO 'EXIT1'
3040 NEXT K
3050 'EXIT1':
3070 DISP "There are ";K;" files"
3080 RETURN
3099 !
4000 'MASS0':
4001 DIM A$[256],B$[32]
4002 DEF FNH$(B1$)=DTH$(NUM(B1$))[4]
4003 DEF FNB$(N)='  ('&STR$(INT(N))&' Bytes)'
4004 SFLAG 2
4005 !
4006 D1=0
4007 D=DEVADDR(D0$)
4008 GOTO 4015
4009 'RSECT':
4010 N1=N DIV 256 @ N0=MOD(N,256)
4011 SEND UNT UNL MTA LISTEN D DDL 4 DATA N1,N0
4012 SEND UNL UNT MLA TALK D DDT 2
4013 ENTER :LOOP USING '#,256A';A$
4014 RETURN
4015 N=0 @ GOSUB 'RSECT'
4016 V$=A$[3,8] @ IF V$='      ' THEN V$='nolbl'
4017 S=0 @ FOR I=9 TO 12 @ S=S*256+NUM(A$[I]) @ NEXT I
4018 L=0 @ FOR I=17 TO 20 @ L=L*256+NUM(A$[I]) @ NEXT I
4019 K=0
4020 FOR I=S TO S+L-1
4030 N=I @ GOSUB 'RSECT'
4040 FOR J=1 TO 255 STEP 32
4050 IF NUM(A$[J,J])=255 THEN K=8*(I-S)+J DIV 32 @ J=256 @ I=S+L
4060 NEXT J
4070 NEXT I
4080 RETURN
4140 'MASS1':
4142 N=(F-1) DIV 8+S
4144 IF N=D1 THEN 4146
4145 D1=N @ GOSUB 'RSECT'
4146 D2=MOD(F-1,8)*32+1
4160 B$=A$[D2,D2+31]
4170 IF NUM(B$)=255 THEN K=F-1 @ GOTO 40
4172 F$=B$[1,10]
4174 L1=0
4178 T1=NUM(B$[11])*256+NUM(B$[12]) @ T1$=STR$(T1)
4179 IF T1=1 OR T1=57557 THEN T1$='TEXT   ' @ GOTO 4300
4180 IF T1=57408 THEN T1$='41-WALL' @ GOTO 4300
4185 IF T1=57424 THEN T1$='41-KEYS' @ GOTO 4300
4190 IF T1=57440 THEN T1$='41-STAT' @ GOTO 4300
4195 IF T1=57472 THEN T1$='41-PROG' @ GOTO 4300
4196 IF T1=57456 THEN T1$='41-MCOD' @ GOTO 4300
4200 IF T1=57584 OR T1=57585 THEN T1$='DATA  ' @ GOTO 4500
4205 IF T1>=57864 AND T1<=57867 THEN T1$='71-LEX ' @ GOTO 4600
4210 IF T1>=57876 AND T1<=57879 THEN T1$='71-BAS ' @ GOTO 4600
4215 IF T1=57552 THEN T1$='SDATA  ' @ GOTO 4400
4220 IF T1=57480 THEN T1$='75-BAS ' @ GOTO 4300
4225 IF T1=57481 THEN T1$='75-LEX ' @ GOTO 4300
4230 IF T1=57426 THEN T1$='75-TEX ' @ GOTO 4300
4231 IF T1=57427 THEN T1$='75-A?? ' @ GOTO 4300
4232 IF T1=57432 THEN T1$='75-G?? ' @ GOTO 4300
4233 IF T1=57482 THEN T1$='75-W?? ' @ GOTO 4300
4234 IF T1=57483 THEN T1$='75-R?? ' @ GOTO 4300
4235 IF T1>=57880 AND T1<=57883 THEN T1$='71-FTH ' @ GOTO 4600
4240 IF T1=57868 OR T1=57869 THEN T1$='71-KEY ' @ GOTO 4600
4245 IF T1>=57884 AND T1<=57887 THEN T1$='71-ROM ' @ GOTO 4600
4250 IF T1>=57860 AND T1<=57863 THEN T1$='71-BIN ' @ GOTO 4600
4251 IF T1>=57888 AND T1<=57891 THEN T1$='71-APT ' @ GOTO 4600
4252 IF T1>=57892 AND T1<=57895 THEN T1$='71-DEA ' @ GOTO 4600
4255 ! not a 71 file
4256 ! GOTO 5000
4300 FOR J=17 TO 20 @ L1=L1*256+NUM(B$[J]) @ NEXT J
4320 L1=L1*256
4390 GOTO 5000
4400 FOR J=29 TO 30 @ L1=L1*256+NUM(B$[J]) @ NEXT J
4410 L1=L1*8
4490 GOTO 5000
4500 FOR J=30 TO 29 STEP -1 @ L1=L1*256+NUM(B$[J]) @ NEXT J
4505 L2=0
4510 FOR J=32 TO 31 STEP -1 @ L2=L2*256+NUM(B$[J]) @ NEXT J
4520 L1=L1*L2
4590 GOTO 5000
4600 FOR J=31 TO 29 STEP -1 @ L1=L1*256+NUM(B$[J]) @ NEXT J
4620 L1=L1/2
4630 L1=IP(L1+.5)
4640 IF T1$='71-BAS' THEN L1=L1-6
4641 IF T1$='71-BIN' THEN L1=L1-6
5000 F$=F$&" "&T1$&"  "&STR$(L1)
5990 RETURN
9490 !
9492 !
9494 !
9500 'ASKDEL':
9501 IF FLAG(1) THEN PURGE D$ @ GOTO 'M1'
9510 DISP "Purge "&D$&" ?"
9520 K$=UPRC$(KEYWAIT$)
9530 IF K$='Y' OR K$='#38' THEN PURGE D$
9531 IF FLAG(0) THEN 792
9540 IF K$='Y' OR K$='#38' THEN 'C1' ELSE 'C'
9599 !
9601 !
9603 !
9700 'K168': !  '?'
9703 DISP "'P' : Purge"
9706 DISP "'C' : Copy"
9709 DISP "'T' : Tag the file"
9710 DISP "'U' : Untag the file"
9712 DISP "'D' : Purge tagged files"
9715 DISP "'M' : Mass Copy tagged files"
9721 DISP "'S' : Show tagged files"
9724 DISP "'V' : View file to display"
9727 DISP "'H' : Print file to printer"
9730 DISP "'L' : Log new device"
9731 DISP "'.' : will prompt for file #"
9733 DISP "'Q' : to Quit"
9740 RETURN
9890 'Q':
9891 CFLAG ALL
9892 PUT "#38"
9899 END
9900 SUB ABREV(X$)
9901 ! for abbreviating responses to Device? prompts
9902 ! You can always respond with ":n" for device #n
9903 X$=UPRC$(X$)
9904 IF X$='' THEN X$=':MAIN'
9906 IF X$[1,1]='(' THEN X$=':PORT'&X$
9909 IF X$='D' AND LEN(X$)=1 THEN X$=':HP9114A'
9912 IF X$='T' AND LEN(X$)=1 THEN GOSUB 9918 ! for Cassette Drive
9913 IF X$='L' THEN X$=':PC'
9915 GOTO 9936
9918 FOR I=1 TO INF
9921 X$=DEVID$(I)
9924 IF DEVAID(I)#16 OR LEN(X$)#0 THEN 9933
9927 X$=":"&STR$(I)
9930 RETURN
9933 NEXT I
9936 END SUB