Listing of file='TBO.SDC1' on disk='vmedia/toolbox.wvd.zip'
# Sector 351, program filename = 'TBO.SDC1' 0010 %TBO.SDC1 04/26/91 SORT CATALOG 2 of 2 T.Olsen 0020 COM U1$(20)45,U$(20),U,T2$(T9,255)2,T$(T9,255)16 : INIT(20)U$() : U=1 : SELECT PRINT 005(80) 0025 IF D1$(10)=" "THEN LOAD T#0,"TBODISKS"8000,8800BEG 30 0030 DIM T1$(T9,255)4,T2$(T9,255)2,C$(T9,255)8,T$(T9,255)16 0040 DIM N$64,C1$,Z$(16)16,L$(4)64,K$1,C0$16,C2$6,L0$1,L$1,Z3$2,Z2$2,S2$2,D8$1 0,C9$45,M$2,P$80,F8$8,H$1,I$8 0042 GOTO 720 0045 REM %.Scan Cat. area 0050 INIT(FF)C$() : FOR S1=S2TO (E-1) : Z1=1 : IF S1>0THEN 60 : Z1=2 : PRINT "SEARCHING FOR ";Z2$ : C1$=Z2$ : STR(C1$,4)="ITEMS FOUND" : GOTO 70 0060 DATA LOAD BA T#1,(S,S)Z$() 0070 PRINT "CAT. SECTOR=";S;HEX(0C) : FOR Z=Z1TO 16 : Z2$=STR(Z$(Z),1,2) : IF Z2$=S2$THEN 120 : IF Z2$=HEX(0000)THEN Z=16 : IF S2$=HEX(1080)AND Z2$=HEX(1040)THEN 120 0080 NEXT Z : NEXT S1 0100 RETURN 0110 REM %.Record found items 0120 C0$=STR(Z$(Z),9,8) : ON P2GOSUB 2300 : IF I$=" "THEN 130 : IF POS(I$="/")=0THEN 125 : IF LEN(I$)=1THEN 130 0122 FOR C=1TO LEN(I$) : IF STR(I$,C,1)<>"/"THEN IF STR(I$,C,1)<>STR(C0$,C,1)THEN 80 : NEXT C : GOTO 130 0125 IF STR(I$,1,LEN(I$))<>STR(C0$,1,LEN(I$))THEN 80 0130 Z$=Z$(Z) : IF N>0THEN C0$=STR(Z$,,8) : IF E8>32768THEN 140 : AND (STR(Z$,3,1),7F) : AND (STR(Z$,V9,1),7F) 0140 C$(T1,T)=C0$ : F8$=STR(Z$,9,8) : T$(T1,T)=Z$ : PRINT "CAT. SECTOR=";S;" FOUND ITEM = ";T0;STR(F8$,,8);HEX(0C) : T0=T0+1 : T=T+1 : IF T<256THEN 80 0150 T1=T1+1 : T=1 : IF T1<=T9THEN 80 : PRINT "---PARTIAL SORT" : Z=16 : S1=E-1 : GOTO 80 0160 REM %.Show catalog details 0170 % ITEM NAME TYPE START END USED FREE +USED 0180 % #### # ######## ### ######### ######### ######### ######### #### ##### 0190 % ##############= ##### 0200 T0,T=1 : INIT(20)T$() : GOSUB 50 : REM /Scan catalog 0210 PRINT HEX(07) : MAT SORTC$()TO T1$(),T2$() 0215 DEFFN'35 0220 SELECT PRINT 005 : IF H=0THEN 240 : ON HSELECT PRINT 215;PRINT 204;PRINT 216 : ON UGOTO 230 : ON D1GOTO 230 : PRINT " " : L=L+3 : GOTO 240 0230 GOSUB 690 : PRINT 0240 PRINT : PRINTUSING 190,C1$,T0-1 : ON T0GOTO 350 : PRINTUSING 170 : PRINT " " : Z2$=S2$ : I1=0 : T,Z,T1=1 0250 DEFFN'8 : IF N<>2THEN 260 : T1=INT((T0-1)/255)+1 : T=MOD(T0-1,255) 0260 S$=T$(VAL(T2$(T1,T)),VAL(STR(T2$(T1,T),2,1))) 0265 IF I9$=" "THEN 270 : IF STR(S$,7,LEN(I9$))<I9$THEN 300 : I9$=" " 0270 GOSUB '36 : N$=" " : IF F=0THEN 290 : REM /.jump to skip REMark 0280 IF STR(S$,1,2)=HEX(1080)THEN 422 : REM /.Get program REMark 0285 IF STR(S$,1,2)<>HEX(1000)THEN 290 : GOSUB 610 : REM /.Get DATA REMark 0290 F8$=STR(S$,9,8) : $TRAN(F8$,"................") 0292 PRINTUSING 180,I1,L0$,F8$,D$,S8,S9,S3,S6,S0 0295 IF N$=" "THEN 300 : PRINT TAB(12);N$; : L=L+2 : PRINT " " : PRINT " " 0300 IF H>0THEN 310 : KEYIN K$,390,410 0310 L=L+1 : IF L>53THEN GOSUB 370 0320 Z=Z+1 : IF N=2THEN 330 : T=T+1 : IF T<256THEN 340 : T=1 : T1=T1+1 : GOTO 340 0330 T=T-1 : IF T>0THEN 340 : T=255 : T1=T1-1 0340 IF Z<T0THEN 260 : ON P2GOSUB 2400 0350 U=U+1 : IF U<U9THEN 990 : IF H=0THEN 360 : U=1 : C9=C9-1 : IF C9>0THEN 990 : PRINT S4;"=FREE SECTORS" : ON HSELECT PRINT 215;PRINT 204;PRINT 216 : PRINT HEX(0C); : FOR Z=1TO 36 : PRINT HEX(0A); : NEXT Z : PRINT 0360 H=0 : GOSUB 1090 : END 0370 L=4 : IF H=0THEN RETURN : P1=P1+1 : PRINT " " : PRINT HEX(0C030E);C9$;" PAGE ";P1 : PRINTUSING 170 : PRINT " " : RETURN 0380 REM %.lower pad key PAUSE 0390 PRINTUSING 170 : GOSUB 1100 : PRINT S4;"=FREE SECTORS KEY (EXEC) TO CONTINUE" 0400 KEYIN K$,310,410 : GOTO 400 0410 IF K$>HEX(02)THEN 420 : F=VAL(K$)-1 : GOTO 310 0420 IF K$=HEX(10)THEN 680 : IF K$=HEX(0F)THEN 2250 : IF K$<>HEX(07)THEN 390 0421 S0,H=0 : GOSUB 690 : GOTO 220 0422 GOSUB '37 : IF POS(I$="/")=0THEN 290 : IF N$=" "THEN 320 : GOSUB 2110 : IF N$="N"THEN 320 : GOTO 290 0430 REM %.'36 Get catalog line display data 0440 DEFFN'36 : D$=" " : IF STR(S$,1,1)=HEX(10)THEN 460 0450 D$="S" : IF STR(S$,1,1)=HEX(11)THEN 460 : RETURN 0460 STR(D$,2)="P" : IF STR(S$,2,1)=HEX(80)THEN 480 : IF STR(S$,2,1)=HEX(40)THEN 475 0470 STR(D$,2)="D" : IF STR(S$,2,1)=HEX(00)THEN 480 : RETURN 0475 STR(D$,3)="'" 0480 I1=I1+1 : S8=VAL(STR(S$,3),V) : S9=VAL(STR(S$,V9),V) : DATA LOAD BA T#1,(S9,M)L$() : ERRORIF S9>65025THEN STOP "Specify SELECT 3 ON " 0485 S3=VAL(STR(L$(),2),2) : IF S9-S8>65023THEN S3=65535*VAL(STR(L$(),4))+S3 : L0$=STR(L$(),,1) : $TRAN(L0$,HEX(20A020A121A1))R : IF S3-1>S9-S8THEN L0$="." 0490 IF L0$<>HEX(20)THEN GOSUB 3010 0495 S6=S9-S8-S3+1 : IF STR(D$,1,1)="S"THEN S0=S0+S6 0500 S0=S0+S3 : S4=S4+S6 : RETURN 0510 REM %.'37 Get 1st REM statement 0520 DEFFN'37 0530 DATA LOAD BA T#1,(S8+1,M)L$() 0540 M=4 : C=1 0550 M=M+1 : IF M>64THEN 100 : L$=STR(L$(1),M,1) : IF L$=HEX(A2)OR L$=HEX(D8)THEN 560 : IF L$=" "THEN 550 : RETURN 0560 M=M+1 : IF M>64THEN 100 : L$=STR(L$(1),M,1) : IF L$=":"THEN 100 : IF L$=HEX(0D)THEN 100 : STR(N$,C,1)=L$ : C=C+1 : GOTO 560 0600 REM %.Display DATA file descriptions 0610 RESTORE 0620 READ N$ : IF N$<>" "THEN 620 0630 READ N$ : IF N$=" "THEN 100 : IF STR(N$,1,8)=STR(S$,7,8)THEN 100 : GOTO 630 0640 REM %.S.F. Entry 0650 DEFFN'1 : F=0 : GOTO 670 0660 DEFFN'2 : F=1 0670 DEFFN'07 : S0,H=0 : GOSUB 690 : PRINT : GOTO 220 0680 DEFFN'16 : S0=0 : H=1 : LINPUT "TITLE",C9$ : PRINT : GOTO 220 0690 PRINT HEX(0D0C030E);C9$ : PRINT "DISK CATALOGUE ";D1$(D9);" SORTED BY ";C2$; : IF I$<>" "THEN PRINT " I.D.=";I$; 0700 PRINT : PRINTUSING 190,"INDEX SECTORS",E; : PRINT H$ : PRINTUSING 190,"END CAT. AREA",E8 : PRINTUSING 190,"CURRENT END",E9 : RETURN 0710 REM %.SET-UP 0720 DEFFN'10 : SELECT PRINT 005 : PRINT HEX(03);"REQUEST NUMBER=";U,"SORT DISK FILE CATALOGUE NAMES" : F$="(DEFAULT)=" 0730 GOSUB '98 0750 K$="0" : PRINT "Sort by 0=Name 1=Sector 2=-Sector";TAB(45);F$; : LINPUT -K$ : N=POS("012"=K$)-1 : IF N<0THEN 750 0760 I$=" " : IF N=0THEN 770 : IF N=2THEN 780 : N=1 : GOTO 780 0770 LINPUT "Common Root ID",-I$ 0772 IF LEN(I$)>7THEN IF POS(I$="/")=0THEN GOSUB 2510 0780 PRINT : PRINT "TYPE OF FILE NAMES TO SORT" 0790 PRINT "PROGS+DATA A S ALL=P&D DATA=VS. DATA STMT L IST" 0800 PRINT "PROGRAMS AP SP P=AP+SP" 0810 PRINT "DATA AD SD D=AD+SD" 0820 PRINT "Category Active Scratched"; 0830 P$="AP" : PRINT TAB(45);F$; : LINPUT P$ : Z2$=P$ 0832 IF Z2$<>"DA"THEN 835 : Z2$="A" : P2=1 : REM /.Look only for DATA statement list 0835 Z3$=" "BOOL2Z2$ : $TRAN(Z3$,HEX(2000)) 0840 Z2$="AP" : IF Z3$="AL"THEN 860 : IF Z3$="A"THEN 860 : IF Z3$="P"THEN 860 : IF Z3$="D"THEN 850 : Z2$="SP" : IF Z3$="S"THEN 860 : Z2$=Z3$ : GOTO 860 0850 Z2$="AD" 0860 S2$=HEX(1080) : IF Z2$="AP"THEN 870 : S2$=HEX(1180) : IF Z2$="SP"THEN 870 : S2$=HEX(1000) : IF Z2$="AD"THEN 870 : S2$=HEX(1100) : IF Z2$="SD"THEN 870 : GOTO 800 0870 C9=0 : K$="0" : PRINT "Output to:","0=CRT 1=215 2=204 3=216";TAB(45);F$; : LINPUT -K$ : H=POS("012"=K$)-1 : IF H=0THEN 880 : PRINT "TITLE=",F$;C9$ : LINPUT -C9$ : INPUT "# OF COPIES (DEFAULT=1)",C9 0880 K$="0" : PRINT "List wanted","0=Cat.data 1=plus REMS ";TAB(45);F$; : LINPUT -K$ : F=POS("012"=K$)-1 : ON F+1GOTO 890,890 : GOTO 880 0890 BIN(STR(U$(U),1,1))=D9 : BIN(STR(U$(U),2,1))=N : STR(U$(U),3,8)=I$ : STR(U$(U),11,2)=Z2$ : STR(U$(U),13,2)=S2$ : BIN(STR(U$(U),15,1))=H : BIN(STR(U$(U),16,1))=F : U1$(U)=C9$ : U=U+1 0900 IF Z3$="AL"THEN 930 : IF Z3$="S"THEN 910 : IF Z3$="A"THEN 920 : IF Z3$="P"THEN 960 : IF Z3$="D"THEN 970 : GOTO 980 0910 Z2$="SD" : S2$=HEX(1100) : Z3$=" " : GOTO 890 0920 Z2$="AD" : S2$=HEX(1000) : Z3$=" " : GOTO 890 0930 IF Z2$<>"AP"THEN 940 : Z2$="AD" : S2$=HEX(1000) : GOTO 890 0940 IF Z2$<>"AD"THEN 950 : Z2$="SP" : S2$=HEX(1180) : GOTO 890 0950 IF Z2$<>"SP"THEN 980 : Z2$="SD" : S2$=HEX(1100) : GOTO 890 0960 Z2$="SP" : S2$=HEX(1180) : Z3$=" " : GOTO 890 0970 Z2$="SD" : S2$=HEX(1100) : Z3$=" " : GOTO 890 0980 K$="0" : LINPUT "INPUT NON-ZERO FOR MORE DATA "-K$ : U9=1 : IF K$="0"THEN U9=0 : IF U9<>0THEN 720 : U9=U : U=1 0990 D9=VAL(STR(U$(U),1,1)) : N=VAL(STR(U$(U),2,1)) : I$=STR(U$(U),3,8) : Z2$=STR(U$(U),11,2) : S2$=STR(U$(U),13,2) : H=VAL(STR(U$(U),15,1)) : T=VAL(STR(U$(U),16,1)) : F=VAL(STR(U$(U),16,1)) : S0=0 : T1=1 : P1=1 : L=8 1000 SELECT #1<D1$(D9)> 1010 D1=0 : IF C9$=U1$(U)THEN 1020 : C9$=U1$(U) : D1=1 1020 SELECT PRINT 005 : IF H>0THEN 1030 : IF U=1THEN 1030 : PRINT "KEY (EXEC) TO CONTINUE FOR ";Z2$; : KEYIN K$ 1030 C2$="NAME" : IF N=0THEN 1040 : C2$="SECTOR" 1040 S2,S=0 : DATA LOAD BA T#1,(S,S)Z$() : H$,D8$=Z$() : AND (H$,7F) : IF H$>HEX(02)THEN H$="?" : ELSE $TRAN(H$,HEX(200027012602))R 1042 REM %0 H$ Index.type, E #.Index.sectors, E9 Curr.end, E8 Max.sectors : REM %0 V 2.or.3.bytes, V9 Curr.byte 1050 E=VAL(STR(D8$,2)) : IF H$="&"THEN E=VAL(STR(D8$,2),2) 1060 V=2 : V9=5 : E9=VAL(STR(D8$,3),V)-1 : E8=VAL(STR(D8$,5),V)-1 : IF H$="&"THEN DO : V=3 : V9=6 : E9=VAL(STR(D8$,4),V)-1 : E8=VAL(STR(D8$,7),V)-1 : END DO 1070 GOSUB 690 1080 GOTO 200 1090 SELECT PRINT 005 : PRINT : PRINT "FOR SORTED ITEMS, KEY" : IF E0>0THEN PRINT E0;" * files are possibly corrupted i.e. invalid traile r." 1100 PRINT "'1-Cat.only '2-Cat.with REMs '7=BEGIN '14 date + '15 RECALL ID '1 6 Hard copy" : RETURN 2020 DEFFN'14 2030 LINPUT "Find programs updated after MM/DD/YY ",I$ 2040 IF POS(I$="/")>0THEN 2050 : REM /.jump if no search wanted 2045 STOP "NO SEARCH WANTED" 2050 PRINT "Find programs updated after ";I$ 2060 CONVERT STR(I$,7,2)TO W1 : CONVERT STR(I$,1,2)TO W2 : CONVERT STR(I$,4,2)TO W3 : ERRORSTOP "Error in entry use form mm/dd/yy "# 2070 PRINTUSING 2090,I$,W2,W3,W1 : F=1 2080 REM ........ MM DD YY 2090 % ######## = ##/##/## 2095 GOSUB '35 : REM /.jump into SORTCAT output 2096 RETURN 2100 REM .LOOK FOR DATE 2110 A=POS(N$="/") : A=A-2 : IF A<1THEN 2200 : A$=STR(N$,A) 2115 FOR A=1TO 8 : B$=STR(A$,A,1) : IF B$=" "THEN STR(A$,A)=STR(A$,A+1) : NEXT A 2120 C=NUM(STR(A$,1)) : IF C<1OR C>2THEN 2200 : CONVERT STR(A$,1,C)TO F1 2130 A=POS(A$="/")+1 : REM /.Position of field two 2140 C=NUM(STR(A$,A)) : IF C<1OR C>2THEN 2200 : CONVERT STR(A$,A,C)TO F2 2150 B=POS(STR(A$,A)="/") : REM /.Position of field 3 2160 C=NUM(STR(A$,A+B)) : IF C=0THEN 2200 : IF C>2THEN C=2 : CONVERT STR(A$,A+B,C)TO F3 2170 IF F1>31THEN 2180 : REM /.Jump if format YY/MM/DD 2172 IF F1>12THEN 2174 : GOTO 2178 2174 REM .Make DD/MM/YY into MM/DD/YY : C=F1 : F1=F2 : F2=C 2176 REM .Make MM/DD/YY into YY/MM/DD 2178 C=F1 : F1=F3 : F3=C : C=F2 : F2=F3 : F3=C 2180 IF F1<W1THEN 2200 : IF F1>W1THEN RETURN : IF F2<W2THEN 2200 : IF F2>W2THEN RETURN : IF F3<W3THEN 2200 2190 RETURN 2200 N$="N" 2210 RETURN 2240 DEFFN'15 2250 LINPUT "Recall to ID ",I9$ : GOTO 421 2300 REM %.Find only programs in DATA statements : RESTORE LINE9000 2310 READ P$ : IF P$=" "THEN 2330 : IF STR(P$,,8)<>C0$THEN 2310 : RETURN 2330 IF STR(Z2$,2,1)=HEX(80)THEN 2370 2350 READ P$ : IF P$=" "THEN 2370 : IF STR(P$,,8)<>C0$THEN 2350 : RETURN 2370 RETURN CLEAR : GOTO 80 2400 RESTORE LINE9000 : PRINT "Modules from DATA list not on disk surface" : C,L=L+1 : IF STR(Z2$,2)=HEX(80)THEN 2410 2405 READ P$ : IF P$<>" "THEN 2405 2410 READ P$ : IF P$=" "THEN 2420 : IF P$="CLEAR"THEN 2410 : MAT SEARCHSTR(T$(),7),=STR(P$,,8)TO M$STEP 14 : IF VAL(M$,2)>0THEN 2410 : PRINT P$ : L=L+1 : IF L>53THEN GOSUB 370 : GOTO 2410 2420 IF C=LTHEN PRINT "None" : RETURN 2500 REM %^.Use LIMITS for this 8 character ID search 2510 LIMITS T#0,I$,A,B,C,E : IF E<>0THEN 2520 : PRINT "None " : RETURN 2520 IF E<0THEN PRINT "Scratched "; : IF ABS(E)=1THEN PRINT "Program" : IF ABS(E)=2THEN PRINT "Data" : PRINT "Start = ";A,"End= ";B,"Used = ";C : RETURN 2530 DEFFN'0 : LOAD T#0,"START" 3000 REM %.Format of file is questionable 3010 E0=E0+1 : L0$="*" 3015 IF H$="&"THEN RETURN : REM !!!!!!!TEMP!!!!! 3020 IF STR(S$,,2)=HEX(1000)THEN RETURN : PRINT "Error: file ";STR(S$,7,8);"invalid trailer = ";HEXOF(STR(L$(),,4)) ,".corrupted ? file no.";E0 3030 DATA LOAD BA T#1,(S8,M)L$() : IF STR(L$(),2,8)=STR(S$,7,8)THEN RETURN : PRINT "Error: file ";STR(S$,7,8);" header = ";HEXOF(STR(L$(),,10)) 3090 RETURN 7000 DEFFN'31 : REM .Load function to use sorted list : REM .T$() and T2$() are COMMON : REM #1 is referenced disk : F8$="TBO.FIND" : LINPUT "Load function "-F8$ : LOAD T#0,F8$ 9000 DATA "TBO.SDC0","TBO.SDC1"," ","DATA"," "