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"," "