image of READY prompt

Wang2200.org

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