Multi disk catalog

[apersson850]

I once wrote, or at least attempted to write, a disk catalog program, which should be able to handle multiple floppies. Those were the only interesting storage media at that time. Here's a list of required functions:

• Should be able to read the file catalog on multiple diskettes.
• Files should be possible to list in alphabetical order, even if they were found on different diskettes.
• The list should include the name of the diskettes they were found on, and/or a reference number for the diskette.
• The reference number should remain the same for a disk, even if the name was changed.
• You were supposed to mark the label on the disk with the reference number, but the number was also stored in an unused part of the diskette catalog sector.
• If you read the same diskette once again, it was recognized from the number stored in the catalog sector. In such a case, the content for that disk was updated, not just read again completely.
• The list of files should be kept in a data file.
• It should be possible to start the catalog program at a later time, i.e. not the same day the diskettes were read, and still locate a file name, and the corresponding diskette name/number, by using the stored data from previous sessions.
• A diskette number should be possible to remove manually from the database, e.g. if the diskette was destroyed.
• The program required at least two diskette stations, one for the program and the data file with diskette names, the other for reading new diskettes.
• If the database was large, it would require the program on one drive, the database on a second and new diskettes in a third drive.

 

Although my basic idea worked, so that I could generate lists of files, with reference to the diskette they resided on, I found that it wasn't feasible when the number of diskettes grew large. 10, 20, maybe even 30 diskettes, well, that kind of worked. But when they grew to a hundred or more, the program became too slow to be reasonable to use. Back then, I had only the standard TI 99/4A, with 32 K memory expansion. I had neither a RAMdisk nor any other additional RAM. Handling the database simply got too slow.

 

I've been searching here for a while, but can't find anything similar. Has it ever been created? Does a working program of this kind exist? I'm talking about something that can run on a real TI, since emulated versions present other possibilities for overviewing the emulated diskettes.

[sparkdrummer]

Check out DISKODEX. It’s in the Yesterday’s News thread - vol 5, No 2. I think it’s the best catalog database that we have. 

[apersson850]

Yes, that's something similar. The same basic idea. Thank you!

[apersson850]

I read a bit more in the manual for Diskodex. It says it was launched in 2001. Then there were of course more RAM devices available, which could make a program like this more realistic. I developed my catalog program in 1986. I was probably a bit too early. It's like that with most things. They need to be invented twice. First when you get the idea and then again when it can be realized.

[Ed in SoDak]

I wrote an XB program I called Catman. It was a kludge of existing small utilities and XBLOAD 3.6 by Jim Swedlow. Catman used a master disk number and categories based on divider names in my disk cabinets, and allowed a brief info line for each program on a disk. It created two DV80 data files and converted them into a TIBase format. TIBase handled sorting, alphabetizing and searching via a customized script. It had no problem creating a master list of some 200 floppies.

 

It was a bit bloated, since I intentionally tried to make it use as much program space as I could.   And a bit buggy. But it worked fine on real iron.

 

Nowadays, I just load the DV80 converted to text into my Mac TextEdit and I surf it or search using that.

-Ed

 

CATMAN2022.dsk

Edited February 21, 2022 by Ed in SoDak
Replaced buggy download with less buggy one! ;)

[atrax27407]

There was an Assembly Language disk catalog program written by Marty Kroll that also did an admirable job of cataloging and alphabetizing disks and files. It was more cumbersome to use than DISKODEX. As best I remember, it came out in the early 80's as well.

[apersson850]

OK. It wasn't as easy to keep track of everything before internet. Thanks for the information.

[+InsaneMultitasker]

2 hours ago, atrax27407 said:

There was an Assembly Language disk catalog program written by Marty Kroll that also did an admirable job of cataloging and alphabetizing disks and files. It was more cumbersome to use than DISKODEX. As best I remember, it came out in the early 80's as well.

Was that CATLIB and CATLIB companion?  I used those two programs quite a lot; the only thing I recall was that it was slow to sort, otherwise it did a pretty decent job for the time period.

[+TheBF]

10 hours ago, apersson850 said:

I once wrote, or at least attempted to write, a disk catalog program, which should be able to handle multiple floppies. Those were the only interesting storage media at that time. Here's a list of required functions:

• Should be able to read the file catalog on multiple diskettes.
• Files should be possible to list in alphabetical order, even if they were found on different diskettes.
• The list should include the name of the diskettes they were found on, and/or a reference number for the diskette.
• The reference number should remain the same for a disk, even if the name was changed.
• You were supposed to mark the label on the disk with the reference number, but the number was also stored in an unused part of the diskette catalog sector.
• If you read the same diskette once again, it was recognized from the number stored in the catalog sector. In such a case, the content for that disk was updated, not just read again completely.
• The list of files should be kept in a data file.
• It should be possible to start the catalog program at a later time, i.e. not the same day the diskettes were read, and still locate a file name, and the corresponding diskette name/number, by using the stored data from previous sessions.
• A diskette number should be possible to remove manually from the database, e.g. if the diskette was destroyed.
• The program required at least two diskette stations, one for the program and the data file with diskette names, the other for reading new diskettes.
• If the database was large, it would require the program on one drive, the database on a second and new diskettes in a third drive.

 

Although my basic idea worked, so that I could generate lists of files, with reference to the diskette they resided on, I found that it wasn't feasible when the number of diskettes grew large. 10, 20, maybe even 30 diskettes, well, that kind of worked. But when they grew to a hundred or more, the program became too slow to be reasonable to use. Back then, I had only the standard TI 99/4A, with 32 K memory expansion. I had neither a RAMdisk nor any other additional RAM. Handling the database simply got too slow.

 

I've been searching here for a while, but can't find anything similar. Has it ever been created? Does a working program of this kind exist? I'm talking about something that can run on a real TI, since emulated versions present other possibilities for overviewing the emulated diskettes.

Are all the devices starting with DSK1. DSK2. DSK3 etc. ?

 

Based on our work before and using VDP to hold the strings I might be able to make something like this with the tools I have at the moment.

 

[+TheBF]

This is an interesting problem.

 

I started playing with sorting the directory of multiple disks.

I used my Shell program as a start since it had the fundamentals already built.

 

The method is to read the file names into VDP RAM as a byte-counted compact list.

Starting at >1000 there is room for 947, 10 character filenames stored this way.

More room if the file names are smaller.

This could be modified to be record based and save out to disk.

 

To sort that array the string addresses are transferred into low RAM.

So that gives us a potential for 4K pointers 

 

The sort does a VDP string compare (the strings never leave VDP RAM in this example  ) 

It's COMBSORT in Forth, so it's not overly fast. 

The result of the string comparison controls if the pointer array elements are swapped.

 

The video shows me using the programmer API commands.

They can be humanized later.

 

Time for bed. 

 

 

 

 

 

 

[+Schmitzi]

 

CATLIB: (untested  file, found with WEB99)

 

CatLibV15_MartyKroll.dsk

 

[apersson850]

The number of files that must be possible to handle makes it impossible to keep them in memory in a TI 99/4A as they were back then. There were no megabyte memories available.

[Ed in SoDak]

My Catman program would append the disk listing to the end of the file. It could grow to fill the disk, not too practical for a DSSD floppy system. I split my catalog up into 8 separate files. About 100k when combined and converted to text.

 

I have no idea if the download for CATMAN in my post @ #5 above, functions on real iron or not!  [Feb 20- That file has been updated] I see it had some downloads. It's maybe worth what you paid for it. TBH, It's been awhile since I ran it on my TI. I do know it does NOT play well in emulation. Buggy I'm sure.  An earlier version 2.12 seems better in an emulator at least, it does catalog and create a DV80 file listing. I'd still expect a few bugs in it too. If anyone tries them let me know what happens, out of curiousity.

 

EDIT: Left this legacy version in place here.

 

CAT212

Edited February 21, 2022 by Ed in SoDak
Program updated to 215, see below

[+OLD CS1]

1 hour ago, Ed in SoDak said:

My Catman program

 

[Ed in SoDak]

Catman, save us!  Not I, LOL. I usually break ribs when that happens.

 

Hokay, so mebee it DOES work. [EDIT: Nope! See post #22] Version 2.13 allows printer options, default is OFF. The XBLoad option 4 has issues under emulation when there's more than about 7 files on the disk. But the main option 1 to write the catalog and convert it did work in a brief test. Whatevs... so one more version to try if you dare!

 

EDIT: This version has problems with the XBLOAD option. Deleted.

 

 

Edited February 21, 2022 by Ed in SoDak
Fixing my bugged uploads...

[+FarmerPotato]

I liked a Basic program called DISKRUNNER, around 1985.

 

I can’t remember how many functions it accomplished, but I used it to read in all my disks’ catalogs. Then it made a sorted list of files (one column was diskname) or a disk-by-disk catalog.

 

I can’t remember if it wrote a database. I just remember that it did a good job for the time. 

 

 

[+Schmitzi]

4 hours ago, FarmerPotato said:

I liked a Basic program called DISKRUNNER, around 1985.

 

I can’t remember how many functions it accomplished, but I used it to read in all my disks’ catalogs. Then it made a sorted list of files (one column was diskname) or a disk-by-disk catalog.

 

I can’t remember if it wrote a database. I just remember that it did a good job for the time. 

 

 

 

DISKRUNNER

Code: (from the disk "LA4526")

 

Spoiler

100 !@+++++++++++++++++++++
110 !@++   DISKRUNNER    ++
120 !@++BY MIKE DE FRANK ++
130 !@++ CIS (74015,673) ++
140 !@++     8308.05     ++
150 !@++  INSPIRED BY    ++
160 !@++BY STEVE DAVIS'S ++
170 !@++ DISK LISTER (C) ++
180 !@+++++++++++++++++++++
190 DIM A$(10),B$(300),C$(40),D$(40):: E$=RPT$(" ",17):: F$=RPT$(".",17):: CALL CLEAR
200 CALL CHAR(129,"7F40404040404040"):: CALL CHAR(130,"C040404245424070"):: CALL CHAR(131,"000000FF8080C020")
210 CALL CHAR(132,"404047C4080F0001"):: CALL CHAR(133,"102DCD1818B3B464"):: CALL CHAR(134,"FC04F41426E10101")
220 CALL CHAR(135,"1010080403000000"):: CALL CHAR(136,"010242A424242211"):: CALL CHAR(137,"64C8C810101808F1")
230 CALL CHAR(138,"010101060830C000"):: CALL CHAR(139,"0804040201000000"):: CALL CHAR(140,"0204040808C42418")
240 CALL CHAR(126,"000000FF00FF0000"):: CALL CHAR(141,"FF818181818181FF"):: CALL CHAR(58,"0000003030003030")
250 CALL HCHAR(1,2,141,30):: CALL VCHAR(1,31,141,24):: CALL VCHAR(1,2,141,24):: CALL HCHAR(24,2,141,30)
260 DISPLAY AT(3,09):RPT$("~",12):: DISPLAY AT(4,8):"~ DISKRUNNER ~"
270 DISPLAY AT(5,7):RPT$("~",16):: DISPLAY AT(07,7):"by mike de frank" :: DISPLAY AT(09,11):"for the"
280 DISPLAY AT(10,3):"üé" :: DISPLAY AT(11,2):"âäàå" :: DISPLAY AT(12,2):"çêëè" :: DISPLAY AT(13,3):"ïî"
290 DISPLAY AT(11,7):"Texas Instruments" :: DISPLAY AT(13,11):"TI-99/4A"
300 DISPLAY AT(16,3):"Please Enter Current Date": :"      Example: 08-06-83"
310 DISPLAY AT(22,3)BEEP:"Date:" :: ACCEPT AT(22,8)VALIDATE("-/0123456789")SIZE(8):G$ :: IF G$="" THEN 310
320 DISPLAY AT(15,2):"Press:": :"    1.Create Catalog": :"    2.Load Catalog File"
330 DISPLAY AT(22,2)SIZE(26)BEEP:" Choice: 1" :: ACCEPT AT(22,11)VALIDATE("12")SIZE(-1):H$ :: IF H$="2" THEN 770
340 CALL A(14,22):: DISPLAY AT(22,2)SIZE(25)BEEP:" Press any Key when Ready"
350 DISPLAY AT(17,3):"INSERT DISK INTO DRIVE 1" :: CALL KEY(0,A,B):: DISPLAY AT(17,3)SIZE(24):" " :: IF B=0 THEN 350
360 DISPLAY AT(17,5):"Scanning Disk Header"
370 OPEN #1:"DSK1.",INPUT ,RELATIVE,INTERNAL :: ON ERROR 640
380 INPUT #1:I$,C,D,E :: CALL B(E,J$):: FOR F=1 TO G :: H=POS(A$(F)," ",1):: IF I$<>SEG$(A$(F),1,H-1)THEN 410
390 A$(F)=I$&SEG$(E$,1,11-LEN(I$))&"Free:" &J$&" Used:" &STR$(D-E):: H$="Updating" :: DISPLAY AT(2,1)ERASE ALL:A$(F):: FOR B=1 TO I :: IF I$=SEG$(B$(B),30,LEN(I$))THEN B$(B)="" :: J=J+1
400 NEXT B :: GOTO 490
410 NEXT F :: H$="Scanning" :: G=G+1 :: IF G<11 THEN 480
420 G=10 :: DISPLAY AT(2,09)ERASE ALL:RPT$("~",12):: DISPLAY AT(3,8):"~ DISKRUNNER ~" :: DISPLAY AT(4,7):RPT$("~",16):: DISPLAY AT(6,1)BEEP:" This disk cannot be added  to the file now in memory."
430 DISPLAY AT(9,1):" This space is now reserved for any future updates for  the disks in this file."
440 DISPLAY AT(13,1):" A maximum of 10 disks (box)may be stored in each file."
450 DISPLAY AT(16,1):" After you've finished usingthis file, Save it, then usePurge, to clear the memory."
460 DISPLAY AT(20,1):" You will then be ready to  Create a new file."
470 DISPLAY AT(24,2):"Press any key to Continue" :: CALL KEY(0,A,B):: IF B=0 THEN 470 ELSE 640
480 A$(G)=I$&SEG$(E$,1,11-LEN(I$))&"Free:" &J$&" Used:" &STR$(D-E):: DISPLAY AT(2,1)ERASE ALL:A$(G)
490 K=5 :: CALL C :: DISPLAY AT(21,1):RPT$("~",28): : :"   Status: " &H$&" Disk"
500 INPUT #1:K$,C,D,E :: IF LEN(K$)=0 THEN 630
510 ON ABS(C) GOTO 520,530,540,550,560
520 L$="D/F:" :: GOTO 570
530 L$="D/V:" :: GOTO 570
540 L$="I/F:" :: GOTO 570
550 L$="I/V:" :: GOTO 570
560 J$="Program" :: GOTO 580
570 CALL B(E,J$):: J$=L$&J$
580 IF C<0 THEN M$="Y" ELSE M$="-"
590 CALL B(D,N$):: IF I-J<230 THEN 610
600 DISPLAY AT(22,6)BEEP:"** File is Full **" :: GOTO 700
610 I=I+1 :: B$(I)=K$&SEG$(F$,1,12-LEN(K$))&N$&".." &J$&".." &M$&".." &I$&SEG$(E$,1,10-LEN(I$)):: K=K+1 :: IF K>20 THEN K=6 :: CALL HCHAR(6,1,32,480)
620 DISPLAY AT(K,1):" " &SEG$(B$(I),1,27):: GOTO 500
630 DISPLAY AT(22,1):"  Disks: " &STR$(G)&"     Files: " &STR$(I-J)
640 ON ERROR 320 :: CLOSE #1
650 ON ERROR STOP
660 DISPLAY AT(24,1)BEEP:"Add/update Another? (Y/N): Y" :: ACCEPT AT(24,28)VALIDATE("YN")SIZE(-1):H$ :: IF H$="N" THEN 700
670 DISPLAY AT(24,1):" Press any Key to Continue" :: FOR F=1 TO 50 :: NEXT F
680 DISPLAY AT(22,2)SIZE(25):" " :: CALL KEY(0,A,B):: IF B=0 THEN DISPLAY AT(22,2):" INSERT DISK INTO DRIVE 1" :: GOTO 680
690 CALL CLEAR :: GOTO 370
700 CALL D(B$(),I,"Files"):: CALL D(A$(),G,"Disks"):: GOTO 840
710 DISPLAY AT(24,2)BEEP:"** Input Error **" :: FOR F=1 TO 300 :: NEXT F
720 DISPLAY AT(24,2)BEEP:"Library Filename:" :: ACCEPT AT(24,19)SIZE(10):O$ :: IF SEG$(O$,1,5)="DSK1." THEN 740 ELSE IF O$="" THEN 890
730 P$=O$ :: O$="DSK1." &O$
740 ON ERROR 710 :: OPEN #3:O$,UPDATE,DISPLAY ,VARIABLE
750 PRINT #3:G$ :: PRINT #3:G :: FOR F=1 TO G :: PRINT #3:A$(F):: NEXT F :: FOR F=J+1 TO I :: PRINT #3:B$(F)&"*" :: NEXT F :: CLOSE #3 :: ON ERROR STOP :: GOTO 840
760 DISPLAY AT(22,2)BEEP:"** Input Error **" :: FOR F=1 TO 300 :: NEXT F
770 DISPLAY AT(22,2)BEEP:"Library Filename:" :: ACCEPT AT(22,19)SIZE(10):O$ :: IF O$="" THEN 330
780 IF SEG$(O$,1,5)="DSK1." THEN 800 ELSE IF O$="" THEN 770
790 P$=O$ :: O$="DSK1." &O$
800 ON ERROR 830 :: OPEN #1:O$,INPUT ,DISPLAY ,VARIABLE
810 INPUT #1:Q$ :: INPUT #1:G :: FOR F=1 TO G :: INPUT #1:A$(F):: NEXT F :: I=0
820 I=I+1 :: INPUT #1:B$(I):: B$(I)=SEG$(B$(I),1,39):: IF EOF(1)THEN 830 ELSE 820
830 ON ERROR 760 :: CLOSE #1 :: ON ERROR STOP
840 DISPLAY AT(2,09)ERASE ALL:RPT$("~",12):: DISPLAY AT(3,8):"~ DISKRUNNER ~" :: DISPLAY AT(4,7):RPT$("~",16):: IF P$="" THEN 850 ELSE DISPLAY AT(6,2):"Library Filename:" &P$
850 IF Q$="" THEN DISPLAY AT(8,4):"Current Date:" &G$ ELSE DISPLAY AT(8,4):" Last Update:" &Q$
860 DISPLAY AT(11,3):"Disks:" &STR$(G):: DISPLAY AT(11,19):"Files:" &STR$(I-J)
870 DISPLAY AT(13,1):"~~~~~~~~~~Main Menu~~~~~~~~~" :: DISPLAY AT(15,2):"Press:": :"    1.Display options":"    2.Printer options"
880 DISPLAY AT(19,5):"3.Add or update":"    4.Save to disk":"    5.Purge memory":"    6.Terminate"
890 DISPLAY AT(24,2):"Choice: 1" :: ACCEPT AT(24,10)SIZE(-1)VALIDATE("123456")BEEP:H$ :: IF H$="6" THEN DISPLAY AT(24,2):"Terminate? (Y/N): Y" :: ACCEPT AT(24,20)VALIDATE("YN")SIZE(-1)BEEP:H$ :: IF H$="N" THEN 890 ELSE CALL CLEAR :: END
900 IF H$="5" THEN DISPLAY AT(21,4)SIZE(1):">" :: GOTO 1410
910 IF H$="4" THEN 720
920 IF H$="3" THEN DISPLAY AT(24,1)SIZE(11):" " :: DISPLAY AT(14,1):"      " :: GOTO 340
930 IF H$="2" THEN 1200
940 IF H$="1" THEN 950
950 DISPLAY AT(13,1):"~~~~~~~Display Options~~~~~~" :: CALL A(17,22):: DISPLAY AT(17,5):"1.Display catalog"
960 DISPLAY AT(18,5):"2.Filename search":"    3.Diskname search":"    4.Return to main" :: DISPLAY AT(24,2)BEEP:"Choice: 1" :: ACCEPT AT(24,10)VALIDATE("1234")SIZE(-1):H$
970 IF H$="1" THEN R$="Display Catalog"
980 IF H$="2" THEN R$="Filename Search"
990 IF H$="3" THEN R$="Diskname Search"
1000 IF H$="4" THEN 870
1010 K=5 :: C=0 :: DISPLAY AT(2,4)ERASE ALL:"++ " &R$&" ++" :: IF H$="1" THEN CALL C :: DISPLAY AT(22,1):RPT$("~",28)
1020 IF H$="2" THEN DISPLAY AT(4,4):"Filename      Diskname":RPT$("~",28):: DISPLAY AT(22,1):RPT$("~",28)
1030 ON VAL(H$) GOTO 1040,1060,1090
1040 FOR F=J+1 TO I :: CALL E(SEG$(B$(F),1,27),H$,C,K):: IF H$="N" THEN 840
1050 NEXT F :: DISPLAY AT(22,1)BEEP:"~~~~~~~~End of File~~~~~~~~~" :: GOTO 1190
1060 DISPLAY AT(24,2)BEEP:"Search String:" :: ACCEPT AT(24,16)SIZE(10):L$ :: DISPLAY AT(24,1):" Searching For:" &L$ :: FOR F=J+1 TO I :: IF POS(SEG$(B$(F),1,10),L$,1)=0 THEN 1080
1070 CALL E("  " &SEG$(B$(F),1,12)&".." &SEG$(B$(F),30,10),H$,C,K):: IF H$="N" THEN 840
1080 NEXT F :: GOTO 1180
1090 IF P$="" THEN K$="Memory" ELSE K$=P$
1100 DISPLAY AT(6,8):"Disks in " &K$:RPT$("~",28):: FOR F=1 TO G :: DISPLAY AT(F+7,1):A$(F):: NEXT F :: DISPLAY AT(F+7,1):RPT$("~",28)
1110 DISPLAY AT(24,2)BEEP:"Disk Name:" :: ACCEPT AT(24,12)SIZE(10):L$ :: IF L$="" THEN 840 ELSE DISPLAY AT(24,2)BEEP:" Searching For:" &L$
1120 FOR F=1 TO G :: IF SEG$(A$(F),1,LEN(L$))<>L$ THEN 1140
1130 DISPLAY AT(1,1)ERASE ALL:A$(F):: CALL C :: L$=SEG$(A$(F),1,10):: DISPLAY AT(22,1):RPT$("~",28):: GOTO 1150
1140 NEXT F :: DISPLAY AT(24,2):" Cannot Locate:" &L$ :: FOR F=1 TO 300 :: NEXT F :: GOTO 1110
1150 FOR F=J+1 TO I :: IF SEG$(B$(F),30,10)<>L$ THEN 1170
1160 CALL E(SEG$(B$(F),1,27),H$,C,K):: IF H$="N" THEN 840
1170 NEXT F
1180 DISPLAY AT(22,1)BEEP:"~~~~~~~End of Search~~~~~~~~"
1190 DISPLAY AT(24,1):" Press any Key to Continue" :: CALL KEY(0,A,B):: IF B=0 THEN 1190 ELSE 840
1200 DISPLAY AT(13,1):"~~~~~~~Printer Options~~~~~~" :: CALL A(17,22):: DISPLAY AT(17,5):"1.Print by filename" :: DISPLAY AT(18,5):"2.Print by diskname"
1210 DISPLAY AT(19,5):"3.Return to main"
1220 DISPLAY AT(24,2)BEEP:"Choice: 1" :: ACCEPT AT(24,10)VALIDATE("123")SIZE(-1):H$ :: IF H$="3" THEN 870 ELSE DISPLAY AT(16+VAL(H$),4)SIZE(1):">"
1230 IF L=1 THEN DISPLAY AT(24,2):"Same Device? (Y/N/A): Y" :: ACCEPT AT(24,24)VALIDATE("YNA")SIZE(-1):L$ :: IF L$="A" THEN DISPLAY AT(16+VAL(H$),4)SIZE(1):" " :: GOTO 1220
1240 IF L$="Y" THEN 1260
1250 DISPLAY AT(24,2):"Printer Device Name:" :: ACCEPT AT(24,22)VALIDATE("PIORS232/1TP")BEEP:S$
1260 ON ERROR 1250 :: L=1 :: OPEN #2:S$
1270 ON ERROR STOP :: PRINT #2:CHR$(27)&CHR$(68)&CHR$(41)&CHR$(0)
1280 PRINT #2:CHR$(14);TAB(12);RPT$("-",21):: PRINT #2:CHR$(14);TAB(11);"- D I S K R U N N E R -" :: IF Q$="" THEN L$="CURRENT DATE:" &G$ ELSE L$=" LAST UPDATE:" &Q$
1290 PRINT #2:CHR$(14);TAB(09);RPT$("-",27): :TAB(27);"LIBRARY FILENAME: " &P$: :TAB(29);L$ :: PRINT #2:CHR$(10)&CHR$(10):: L$="FILENAME    SIZE   TYPE   P  DISK" :: IF H$="1" THEN 1360
1300 A=INT(G/2+.5):: FOR B=1 TO A
1320 PRINT #2:CHR$(27)&"E" &"    " &A$(B)&CHR$(9)&"    " &A$(B+A):: PRINT #2:" " :: PRINT #2:L$&CHR$(9)&L$ :: PRINT #2:RPT$("-",80)&CHR$(27)&"F" :: C,D=0 :: FOR F=J+1 TO I
1330 IF SEG$(B$(F),30,10)=SEG$(A$(B),1,10)THEN C=C+1 :: C$(C)=B$(F)
1340 IF SEG$(B$(F),30,10)=SEG$(A$(B+A),1,10)THEN D=D+1 :: D$(D)=B$(F)
1350 NEXT F :: FOR F=1 TO MAX(C,D):: PRINT #2:C$(F)&CHR$(9)&D$(F):: NEXT F :: FOR F=1 TO 5 :: PRINT #2:CHR$(10):: NEXT F :: FOR F=1 TO MAX(C,D):: C$(F),D$(F)="" :: NEXT F :: NEXT B :: CLOSE #2 :: GOTO 840
1360 PRINT #2:CHR$(27)&"E";TAB(19);"DISKS" &CHR$(9)&"             DISKS" :: PRINT #2:TAB(6);RPT$("-",28)&CHR$(9)&"   " &RPT$("-",28):: F=INT(G/2+.5):: FOR B=1 TO F
1370 PRINT #2:TAB(6);A$(B)&CHR$(9)&"   " &A$(B+F):: NEXT B :: PRINT #2:TAB(6);RPT$("-",28)&CHR$(9)&"   " &RPT$("-",28)
1380 PRINT #2:CHR$(10)&CHR$(10)&"          " &"NUMBER OF DISKS:" &STR$(G)&CHR$(9)&"        " &"NUMBER OF FILES:" &STR$(I-J):: PRINT #2:CHR$(10)&CHR$(10):: PRINT #2:L$&CHR$(9)&L$
1390 PRINT #2:RPT$("-",80)&CHR$(27)&"F" :: K=0 :: C=INT((I-(J+1))/2):: F=C+(J+1):: FOR B=J+1 TO F :: K=K+1 :: PRINT #2:B$(B)&CHR$(9)&B$(B+F):: NEXT B :: PRINT #2:CHR$(27)&"E":RPT$("-",80)&CHR$(27)&"F"
1400 FOR F=1 TO 5 :: PRINT #2:CHR$(10):: NEXT F :: CLOSE #2 :: GOTO 840
1410 DISPLAY AT(24,1):" Are You Sure? (Y/N): Y" :: ACCEPT AT(24,23)VALIDATE("YN")SIZE(-1)BEEP:H$ :: IF H$="N" THEN DISPLAY AT(21,4)SIZE(1):" " :: GOTO 890
1420 CALL A(15,24):: DISPLAY AT(18,4)BEEP:"ì ì Purging Memory ì ì" :: C=G :: FOR F=1 TO G :: A$(F)="" :: C=C-1 :: CALL SOUND(-99,990,12):: DISPLAY AT(11,3)SIZE(9):"Disks:" &STR$(C):: NEXT F
1430 C=I :: FOR F=1 TO I :: C=C-1 :: B$(F)="" :: CALL SOUND(-99,990,12):: DISPLAY AT(11,19)SIZE(9):"Files:" &STR$(C):: NEXT F :: I,G,J=0 :: Q$,P$="" :: DISPLAY AT(6,2)SIZE(28):" "
1440 DISPLAY AT(8,4):"Current Date:" &G$ :: GOTO 320
1450 SUB A(A,B):: FOR C=A TO B :: DISPLAY AT(C,2)SIZE(22):" " :: NEXT C :: SUBEND
1460 SUB B(A,A$):: A$=STR$(A):: B=LEN(A$):: IF B=1 THEN A$="00" &A$ ELSE IF B=2 THEN A$="0" &A$
1470 SUBEND
1480 SUB C :: DISPLAY AT(4,1):" Filename    Size   Type   P" :: DISPLAY AT(5,1):RPT$("~",28):: SUBEND
1490 SUB D(A$(),A,B$):: DISPLAY AT(24,1)BEEP:"   Status: Sorting " &B$ :: B=1
1500 B=2*B :: IF B<=A THEN 1500
1510 B=INT(B/2):: IF B=0 THEN 1560
1520 FOR C=1 TO A-B :: D=C
1530 E=D+B :: IF A$(D)<=A$(E)THEN 1550
1540 C$=A$(D):: A$(D)=A$(E):: A$(E)=C$ :: D=D-B :: IF D>0 THEN 1530
1550 NEXT C :: GOTO 1510
1560 SUBEND
1570 SUB E(A$,B$,A,B):: IF A=1 THEN A=0 :: GOTO 1590
1580 B=B+1 :: DISPLAY AT(B,1):" " &A$ :: IF B>20 THEN A=1 :: SUBEXIT ELSE SUBEXIT
1590 DISPLAY AT(24,2)BEEP:"Continue Listing? (Y/N): Y" :: ACCEPT AT(24,27)VALIDATE("YN")SIZE(-1):B$ :: DISPLAY AT(24,1)SIZE(28):" " :: IF B$="N" THEN SUBEXIT
1600 B=5 :: CALL HCHAR(6,1,32,512):: GOTO 1580
1610 SUBEND

 

 

 

 

Another code with some small differences in the code (i.e. Lines 310 + 350)

(i.e. from Pergrem 3154.DSK and a disk from Paolo Bagnaresi)

Spoiler

100 !@+++++++++++++++++++++
110 !@++   DISKRUNNER    ++
120 !@++BY MIKE DE FRANK ++
130 !@++ CIS (74015,673) ++
140 !@++     8308.05     ++
150 !@++  INSPIRED BY    ++
160 !@++BY STEVE DAVIS'S ++
170 !@++ DISK LISTER (C) ++
180 !@+++++++++++++++++++++
190 DIM A$(10),B$(300),C$(40),D$(40):: E$=RPT$(" ",17):: F$=RPT$(".",17):: CALL CLEAR
200 CALL CHAR(129,"7F40404040404040"):: CALL CHAR(130,"C040404245424070"):: CALL CHAR(131,"000000FF8080C020")
210 CALL CHAR(132,"404047C4080F0001"):: CALL CHAR(133,"102DCD1818B3B464"):: CALL CHAR(134,"FC04F41426E10101")
220 CALL CHAR(135,"1010080403000000"):: CALL CHAR(136,"010242A424242211"):: CALL CHAR(137,"64C8C810101808F1")
230 CALL CHAR(138,"010101060830C000"):: CALL CHAR(139,"0804040201000000"):: CALL CHAR(140,"0204040808C42418")
240 CALL CHAR(126,"000000FF00FF0000"):: CALL CHAR(141,"FF818181818181FF"):: CALL CHAR(58,"0000003030003030")
250 CALL HCHAR(1,2,141,30):: CALL VCHAR(1,31,141,24):: CALL VCHAR(1,2,141,24):: CALL HCHAR(24,2,141,30)
260 DISPLAY AT(3,09):RPT$("~",12):: DISPLAY AT(4,8):"~ DISKRUNNER ~"
270 DISPLAY AT(5,7):RPT$("~",16):: DISPLAY AT(07,7):"by mike de frank" :: DISPLAY AT(09,11):"for the"
280 DISPLAY AT(10,3):"üé" :: DISPLAY AT(11,2):"âäàå" :: DISPLAY AT(12,2):"çêëè" :: DISPLAY AT(13,3):"ïî"
290 DISPLAY AT(11,7):"Texas Instruments" :: DISPLAY AT(13,11):"TI-99/4A"
300 DISPLAY AT(16,3):"Please Enter Current Date": :"      Example: 08-06-83"
310 DISPLAY AT(22,3)BEEP:"Date:" :: ACCEPT AT(22,8)VALIDATE("-0123456789")SIZE(8):G$ :: IF G$="" THEN 310
320 DISPLAY AT(15,2):"Press:": :"    1.Create Catalog": :"    2.Load Catalog File"
330 DISPLAY AT(22,2)SIZE(26)BEEP:" Choice: 1" :: ACCEPT AT(22,11)VALIDATE("12")SIZE(-1):H$ :: IF H$="2" THEN 770
340 CALL A(14,22):: DISPLAY AT(22,2)SIZE(25)BEEP:" Press any Key when Ready"
350 DISPLAY AT(18,3)SIZE(25):" " :: CALL KEY(0,A,B):: IF B=0 THEN DISPLAY AT(18,3):"INSERT DISK INTO DRIVE 1" :: GOTO 350
360 DISPLAY AT(17,5):"Scanning Disk Header"
370 OPEN #1:"DSK1.",INPUT ,RELATIVE,INTERNAL :: ON ERROR 640
380 INPUT #1:I$,C,D,E :: CALL B(E,J$):: FOR F=1 TO G :: H=POS(A$(F)," ",1):: IF I$<>SEG$(A$(F),1,H-1)THEN 410
390 A$(F)=I$&SEG$(E$,1,11-LEN(I$))&"Free:" &J$&" Used:" &STR$(D-E):: H$="Updating" :: DISPLAY AT(2,1)ERASE ALL:A$(F):: FOR B=1 TO I :: IF I$=SEG$(B$(B),30,LEN(I$))THEN B$(B)="" :: J=J+1
400 NEXT B :: GOTO 490
410 NEXT F :: H$="Scanning" :: G=G+1 :: IF G<11 THEN 480
420 G=10 :: DISPLAY AT(2,09)ERASE ALL:RPT$("~",12):: DISPLAY AT(3,8):"~ DISKRUNNER ~" :: DISPLAY AT(4,7):RPT$("~",16):: DISPLAY AT(6,1)BEEP:" This disk cannot be added  to the file now in memory."
430 DISPLAY AT(9,1):" This space is now reserved for any future updates for  the disks in this file."
440 DISPLAY AT(13,1):" A maximum of 10 disks (box)may be stored in each file."
450 DISPLAY AT(16,1):" After you've finished usingthis file, Save it, then usePurge, to clear the memory."
460 DISPLAY AT(20,1):" You will then be ready to  Create a new file."
470 DISPLAY AT(24,2):"Press any key to Continue" :: CALL KEY(0,A,B):: IF B=0 THEN 470 ELSE 640
480 A$(G)=I$&SEG$(E$,1,11-LEN(I$))&"Free:" &J$&" Used:" &STR$(D-E):: DISPLAY AT(2,1)ERASE ALL:A$(G)
490 K=5 :: CALL C :: DISPLAY AT(21,1):RPT$("~",28): : :"   Status: " &H$&" Disk"
500 INPUT #1:K$,C,D,E :: IF LEN(K$)=0 THEN 630
510 ON ABS(C) GOTO 520,530,540,550,560
520 L$="D/F:" :: GOTO 570
530 L$="D/V:" :: GOTO 570
540 L$="I/F:" :: GOTO 570
550 L$="I/V:" :: GOTO 570
560 J$="Program" :: GOTO 580
570 CALL B(E,J$):: J$=L$&J$
580 IF C<0 THEN M$="Y" ELSE M$="-"
590 CALL B(D,N$):: IF I-J<230 THEN 610
600 DISPLAY AT(22,6)BEEP:"** File is Full **" :: GOTO 700
610 I=I+1 :: B$(I)=K$&SEG$(F$,1,12-LEN(K$))&N$&".." &J$&".." &M$&".." &I$&SEG$(E$,1,10-LEN(I$)):: K=K+1 :: IF K>20 THEN K=6 :: CALL HCHAR(6,1,32,480)
620 DISPLAY AT(K,1):" " &SEG$(B$(I),1,27):: GOTO 500
630 DISPLAY AT(22,1):"  Disks: " &STR$(G)&"     Files: " &STR$(I-J)
640 ON ERROR 320 :: CLOSE #1
650 ON ERROR STOP
660 DISPLAY AT(24,1)BEEP:"Add/update Another? (Y/N): Y" :: ACCEPT AT(24,28)VALIDATE("YN")SIZE(-1):H$ :: IF H$="N" THEN 700
670 DISPLAY AT(24,1):" Press any Key to Continue" :: FOR F=1 TO 50 :: NEXT F
680 DISPLAY AT(22,2)SIZE(25):" " :: CALL KEY(0,A,B):: IF B=0 THEN DISPLAY AT(22,2):"INSERT DISK INTO DRIVE 1" :: GOTO 680
690 CALL CLEAR :: GOTO 370
700 CALL D(B$(),I,"Files"):: CALL D(A$(),G,"Disks"):: GOTO 840
710 DISPLAY AT(24,2)BEEP:"** Input Error **" :: FOR F=1 TO 300 :: NEXT F
720 DISPLAY AT(24,2)BEEP:"Library Filename:" :: ACCEPT AT(24,19)SIZE(10):O$ :: IF SEG$(O$,1,5)="DSK1." THEN 740 ELSE IF O$="" THEN 890
730 P$=O$ :: O$="DSK1." &O$
740 ON ERROR 710 :: OPEN #3:O$,UPDATE,DISPLAY ,VARIABLE
750 PRINT #3:G$ :: PRINT #3:G :: FOR F=1 TO G :: PRINT #3:A$(F):: NEXT F :: FOR F=J+1 TO I :: PRINT #3:B$(F)&"*" :: NEXT F :: CLOSE #3 :: ON ERROR STOP :: GOTO 840
760 DISPLAY AT(22,2)BEEP:"** Input Error **" :: FOR F=1 TO 300 :: NEXT F
770 DISPLAY AT(22,2)BEEP:"Library Filename:" :: ACCEPT AT(22,19)SIZE(10):O$ :: IF O$="" THEN 330
780 IF SEG$(O$,1,5)="DSK1." THEN 800 ELSE IF O$="" THEN 770
790 P$=O$ :: O$="DSK1." &O$
800 ON ERROR 830 :: OPEN #1:O$,INPUT ,DISPLAY ,VARIABLE
810 INPUT #1:Q$ :: INPUT #1:G :: FOR F=1 TO G :: INPUT #1:A$(F):: NEXT F :: I=0
820 I=I+1 :: INPUT #1:B$(I):: B$(I)=SEG$(B$(I),1,39):: IF EOF(1)THEN 830 ELSE 820
830 ON ERROR 760 :: CLOSE #1 :: ON ERROR STOP
840 DISPLAY AT(2,09)ERASE ALL:RPT$("~",12):: DISPLAY AT(3,8):"~ DISKRUNNER ~" :: DISPLAY AT(4,7):RPT$("~",16):: IF P$="" THEN 850 ELSE DISPLAY AT(6,2):"Library Filename:" &P$
850 IF Q$="" THEN DISPLAY AT(8,4):"Current Date:" &G$ ELSE DISPLAY AT(8,4):" Last Update:" &Q$
860 DISPLAY AT(11,3):"Disks:" &STR$(G):: DISPLAY AT(11,19):"Files:" &STR$(I-J)
870 DISPLAY AT(13,1):"~~~~~~~~~~Main Menu~~~~~~~~~" :: DISPLAY AT(15,2):"Press:": :"    1.Display options":"    2.Printer options"
880 DISPLAY AT(19,5):"3.Add or update":"    4.Save to disk":"    5.Purge memory":"    6.Terminate"
890 DISPLAY AT(24,2):"Choice: 1" :: ACCEPT AT(24,10)SIZE(-1)VALIDATE("123456")BEEP:H$ :: IF H$="6" THEN DISPLAY AT(24,2):"Terminate? (Y/N): Y" :: ACCEPT AT(24,20)VALIDATE("YN")SIZE(-1)BEEP:H$ :: IF H$="N" THEN 890 ELSE CALL CLEAR :: END
900 IF H$="5" THEN DISPLAY AT(21,4)SIZE(1):">" :: GOTO 1410
910 IF H$="4" THEN 720
920 IF H$="3" THEN DISPLAY AT(24,1)SIZE(11):" " :: DISPLAY AT(14,1):"      " :: GOTO 340
930 IF H$="2" THEN 1200
940 IF H$="1" THEN 950
950 DISPLAY AT(13,1):"~~~~~~~Display Options~~~~~~" :: CALL A(17,22):: DISPLAY AT(17,5):"1.Display catalog"
960 DISPLAY AT(18,5):"2.Filename search":"    3.Diskname search":"    4.Return to main" :: DISPLAY AT(24,2)BEEP:"Choice: 1" :: ACCEPT AT(24,10)VALIDATE("1234")SIZE(-1):H$
970 IF H$="1" THEN R$="Display Catalog"
980 IF H$="2" THEN R$="Filename Search"
990 IF H$="3" THEN R$="Diskname Search"
1000 IF H$="4" THEN 870
1010 K=5 :: C=0 :: DISPLAY AT(2,4)ERASE ALL:"++ " &R$&" ++" :: IF H$="1" THEN CALL C :: DISPLAY AT(22,1):RPT$("~",28)
1020 IF H$="2" THEN DISPLAY AT(4,4):"Filename      Diskname":RPT$("~",28):: DISPLAY AT(22,1):RPT$("~",28)
1030 ON VAL(H$) GOTO 1040,1060,1090
1040 FOR F=J+1 TO I :: CALL E(SEG$(B$(F),1,27),H$,C,K):: IF H$="N" THEN 840
1050 NEXT F :: DISPLAY AT(22,1)BEEP:"~~~~~~~~End of File~~~~~~~~~" :: GOTO 1190
1060 DISPLAY AT(24,2)BEEP:"Search String:" :: ACCEPT AT(24,16)SIZE(10):L$ :: DISPLAY AT(24,1):" Searching For:" &L$ :: FOR F=J+1 TO I :: IF POS(SEG$(B$(F),1,10),L$,1)=0 THEN 1080
1070 CALL E("  " &SEG$(B$(F),1,12)&".." &SEG$(B$(F),30,10),H$,C,K):: IF H$="N" THEN 840
1080 NEXT F :: GOTO 1180
1090 IF P$="" THEN K$="Memory" ELSE K$=P$
1100 DISPLAY AT(6,8):"Disks in " &K$:RPT$("~",28):: FOR F=1 TO G :: DISPLAY AT(F+7,1):A$(F):: NEXT F :: DISPLAY AT(F+7,1):RPT$("~",28)
1110 DISPLAY AT(24,2)BEEP:"Disk Name:" :: ACCEPT AT(24,12)SIZE(10):L$ :: IF L$="" THEN 840 ELSE DISPLAY AT(24,2)BEEP:" Searching For:" &L$
1120 FOR F=1 TO G :: IF SEG$(A$(F),1,LEN(L$))<>L$ THEN 1140
1130 DISPLAY AT(1,1)ERASE ALL:A$(F):: CALL C :: L$=SEG$(A$(F),1,10):: DISPLAY AT(22,1):RPT$("~",28):: GOTO 1150
1140 NEXT F :: DISPLAY AT(24,2):" Cannot Locate:" &L$ :: FOR F=1 TO 300 :: NEXT F :: GOTO 1110
1150 FOR F=J+1 TO I :: IF SEG$(B$(F),30,10)<>L$ THEN 1170
1160 CALL E(SEG$(B$(F),1,27),H$,C,K):: IF H$="N" THEN 840
1170 NEXT F
1180 DISPLAY AT(22,1)BEEP:"~~~~~~~End of Search~~~~~~~~"
1190 DISPLAY AT(24,1):" Press any Key to Continue" :: CALL KEY(0,A,B):: IF B=0 THEN 1190 ELSE 840
1200 DISPLAY AT(13,1):"~~~~~~~Printer Options~~~~~~" :: CALL A(17,22):: DISPLAY AT(17,5):"1.Print by filename" :: DISPLAY AT(18,5):"2.Print by diskname"
1210 DISPLAY AT(19,5):"3.Return to main"
1220 DISPLAY AT(24,2)BEEP:"Choice: 1" :: ACCEPT AT(24,10)VALIDATE("123")SIZE(-1):H$ :: IF H$="3" THEN 870 ELSE DISPLAY AT(16+VAL(H$),4)SIZE(1):">"
1230 IF L=1 THEN DISPLAY AT(24,2):"Same Device? (Y/N/A): Y" :: ACCEPT AT(24,24)VALIDATE("YNA")SIZE(-1):L$ :: IF L$="A" THEN DISPLAY AT(16+VAL(H$),4)SIZE(1):" " :: GOTO 1220
1240 IF L$="Y" THEN 1260
1250 DISPLAY AT(24,2):"Printer Device Name:" :: ACCEPT AT(24,22)VALIDATE("PIORS232/1TP")BEEP:S$
1260 ON ERROR 1250 :: L=1 :: OPEN #2:S$
1270 ON ERROR STOP :: PRINT #2:CHR$(27)&CHR$(68)&CHR$(41)&CHR$(0)
1280 PRINT #2:CHR$(14);TAB(12);RPT$("-",21):: PRINT #2:CHR$(14);TAB(11);"- D I S K R U N N E R -" :: IF Q$="" THEN L$="CURRENT DATE:" &G$ ELSE L$=" LAST UPDATE:" &Q$
1290 PRINT #2:CHR$(14);TAB(09);RPT$("-",27): :TAB(27);"LIBRARY FILENAME: " &P$: :TAB(29);L$ :: PRINT #2:CHR$(10)&CHR$(10):: L$="FILENAME    SIZE   TYPE   P  DISK" :: IF H$="1" THEN 1360
1300 A=INT(G/2+.5):: FOR B=1 TO A
1320 PRINT #2:CHR$(27)&"E" &"    " &A$(B)&CHR$(9)&"    " &A$(B+A):: PRINT #2:" " :: PRINT #2:L$&CHR$(9)&L$ :: PRINT #2:RPT$("-",80)&CHR$(27)&"F" :: C,D=0 :: FOR F=J+1 TO I
1330 IF SEG$(B$(F),30,10)=SEG$(A$(B),1,10)THEN C=C+1 :: C$(C)=B$(F)
1340 IF SEG$(B$(F),30,10)=SEG$(A$(B+A),1,10)THEN D=D+1 :: D$(D)=B$(F)
1350 NEXT F :: FOR F=1 TO MAX(C,D):: PRINT #2:C$(F)&CHR$(9)&D$(F):: NEXT F :: FOR F=1 TO 5 :: PRINT #2:CHR$(10):: NEXT F :: FOR F=1 TO MAX(C,D):: C$(F),D$(F)="" :: NEXT F :: NEXT B :: CLOSE #2 :: GOTO 840
1360 PRINT #2:CHR$(27)&"E";TAB(19);"DISKS" &CHR$(9)&"             DISKS" :: PRINT #2:TAB(6);RPT$("-",28)&CHR$(9)&"   " &RPT$("-",28):: F=INT(G/2+.5):: FOR B=1 TO F
1370 PRINT #2:TAB(6);A$(B)&CHR$(9)&"   " &A$(B+F):: NEXT B :: PRINT #2:TAB(6);RPT$("-",28)&CHR$(9)&"   " &RPT$("-",28)
1380 PRINT #2:CHR$(10)&CHR$(10)&"          " &"NUMBER OF DISKS:" &STR$(G)&CHR$(9)&"        " &"NUMBER OF FILES:" &STR$(I-J):: PRINT #2:CHR$(10)&CHR$(10):: PRINT #2:L$&CHR$(9)&L$
1390 PRINT #2:RPT$("-",80)&CHR$(27)&"F" :: K=0 :: C=INT((I-(J+1))/2):: F=C+(J+1):: FOR B=J+1 TO F :: K=K+1 :: PRINT #2:B$(B)&CHR$(9)&B$(B+F):: NEXT B :: PRINT #2:CHR$(27)&"E":RPT$("-",80)&CHR$(27)&"F"
1400 FOR F=1 TO 5 :: PRINT #2:CHR$(10):: NEXT F :: CLOSE #2 :: GOTO 840
1410 DISPLAY AT(24,1):" Are You Sure? (Y/N): Y" :: ACCEPT AT(24,23)VALIDATE("YN")SIZE(-1)BEEP:H$ :: IF H$="N" THEN DISPLAY AT(21,4)SIZE(1):" " :: GOTO 890
1420 CALL A(15,24):: DISPLAY AT(18,4)BEEP:"ì ì Purging Memory ì ì" :: C=G :: FOR F=1 TO G :: A$(F)="" :: C=C-1 :: CALL SOUND(-99,990,12):: DISPLAY AT(11,3)SIZE(9):"Disks:" &STR$(C):: NEXT F
1430 C=I :: FOR F=1 TO I :: C=C-1 :: B$(F)="" :: CALL SOUND(-99,990,12):: DISPLAY AT(11,19)SIZE(9):"Files:" &STR$(C):: NEXT F :: I,G,J=0 :: Q$,P$="" :: DISPLAY AT(6,2)SIZE(28):" "
1440 DISPLAY AT(8,4):"Current Date:" &G$ :: GOTO 320
1450 SUB A(A,B):: FOR C=A TO B :: DISPLAY AT(C,2)SIZE(22):" " :: NEXT C :: SUBEND
1460 SUB B(A,A$):: A$=STR$(A):: B=LEN(A$):: IF B=1 THEN A$="00" &A$ ELSE IF B=2 THEN A$="0" &A$
1470 SUBEND
1480 SUB C :: DISPLAY AT(4,1):" Filename    Size   Type   P" :: DISPLAY AT(5,1):RPT$("~",28):: SUBEND
1490 SUB D(A$(),A,B$):: DISPLAY AT(24,1)BEEP:"   Status: Sorting " &B$ :: B=1
1500 B=2*B :: IF B<=A THEN 1500
1510 B=INT(B/2):: IF B=0 THEN 1560
1520 FOR C=1 TO A-B :: D=C
1530 E=D+B :: IF A$(D)<=A$(E)THEN 1550
1540 C$=A$(D):: A$(D)=A$(E):: A$(E)=C$ :: D=D-B :: IF D>0 THEN 1530
1550 NEXT C :: GOTO 1510
1560 SUBEND
1570 SUB E(A$,B$,A,B):: IF A=1 THEN A=0 :: GOTO 1590
1580 B=B+1 :: DISPLAY AT(B,1):" " &A$ :: IF B>20 THEN A=1 :: SUBEXIT ELSE SUBEXIT
1590 DISPLAY AT(24,2)BEEP:"Continue Listing? (Y/N): Y" :: ACCEPT AT(24,27)VALIDATE("YN")SIZE(-1):B$ :: DISPLAY AT(24,1)SIZE(28):" " :: IF B$="N" THEN SUBEXIT
1600 B=5 :: CALL HCHAR(6,1,32,512):: GOTO 1580
1610 SUBEND

 

 

 

 

 WEB99 DANG ? ? ?

 

 

 

 

 

[+Schmitzi]

 

DISKLISTER (german) from Bruce Rodenkirch?:

 

DISKLISTER-Bruce-Rodenkirch

 

CODE:

Spoiler

100 !*===============================*
110 !*                               *
120 !* Dateilisten f}r Diskettenuser *
130 !* ----------------------------- *
140 !*                               *
150 !* Erstellt eine Diskettendatei- *
160 !* liste,die mit dem TI-SORT PGM *
170 !* sortiert werden kann.         *
180 !* Dadurch hat ein Benutzer im-  *
190 !* mer eine Uebersicht, welche   *
200 !* Dateien auf welcher Disk abge-*
210 !* legt sind.                    *
220 !*                               *
230 !* If you handle this program,   *
240 !* Please send donation to :     *
250 !* Mister Rodenkirch             *
260 !*                               *
270 !* Version#: 19960505 ZE         *
280 !*-------------------------------*
290 ! Basiert auf dem PGM : CAT-TO-DSK (Public Dom)by Bruce Rodenkirch, 1514 Julian St, Cuyahoga Falls, OH 44221. May 1995
300 ZIEL$="DSK5." :: OHNE_RAMDISK$="DSK2."
310 LISTE$="LISTE"
320 DRUCKER$="RS232.BA=9600.DA=8.LF.CR" :: LF$=CHR$(10)&CHR$(13)
330 ANZAHL=0 ! Anzahl der Eintraege in der erstellten Listendatei
340 DIM NEU$(130)! Zwischenspeicher fuer ueberarbeitende Diskdaten
350 CALL VERSION(BASIC)
360 CALL TCOLOR(2,7):: CALL GRAPHICS(3,3):: CALL DEUZEI80
370 ON ERROR 1960
380 CALL TCOLOR(2,7)
390 CALL RAM_DA(F)! Ramdisk im System  
400 ON ERROR 1960
410 IF NOT(F)THEN ZIEL$=OHNE_RAMDISK$ ! Ziellaufwerk bei Betrieb ohne Ramdisk einstellen
420 CALL LINK("F2")! Linkversuch um festzustellen ob die Fenster bereits geladen
430 GOTO 470
440 CALL MITTE(23,"Einlesen der Textfenster !")
450 FOR I=1 TO 3 :: D$=ZIEL$&"DISKLIF" &STR$(I)&"_O" :: CALL LOAD(D$):: NEXT I ! Hinweisfenster einlesen
460 CALL LINK("F2")! Bildkopf anzeigen
470 CALL KOPF(ZIEL$,LISTE$,ANZAHL)
480 CALL MITTE(23,"Ger{tenamen eingeben auf den die Liste geschrieben werden soll"):: ACCEPT AT(3,15)SIZE(-15)BEEP:ZIEL$
490 CALL MITTE(23,"Name der durch das PGM zu erzeugten Listendatei-Datei eingeben")
500 ACCEPT AT(3,71)SIZE(-10)BEEP:LISTE$
510 CALL UPPERSTR(LISTE$):: CALL UPPERSTR(ZIEL$):: CALL KOPF(ZIEL$,LISTE$,ANZAHL)
520 CALL HCHAR(23,1,32,80)
530 TEST$=ZIEL$&LISTE$
540 CALL DATEI_DA(TEST$,STATUS)! Liste bereits vorhanden ?  
550 ON ERROR 1960 :: ZIELDATEI$=ZIEL$&LISTE$
560 IF NOT(STATUS)THEN 1550 ! Keine alte List-Datei gefunden                                      
570 CALL OEFFNE_ZIEL(ZIELDATEI$)
580 CALL SUCHE_ENDE(ANZAHL):: CALL KOPF(ZIEL$,LISTE$,ANZAHL):: CLOSE #2 ! Eintragsanzahl ermitteln
590 CALL LINK("F1")! Auswahlmenue darstellen   
600 CALL MITTE(24,"Funktion durch Tastendruck w{hlen")
610 A=-1 ! Ton AN bei Warten auf Eingabe
620 LIBRARY(A<>65)AND(A<>68)AND(A<>76)AND(A<>78)AND(A<>88)
630 CALL WARTE_TASTE(A)
640
650 CALL HCHAR(23,1,32,80)
660 FOR I=5 TO 14 :: CALL HCHAR(I,20,32,45):: NEXT I ! Menu - Fenster loeschen     
670 CALL HCHAR(24,15,32,60)! Hinweiszeile loeschen
680 ! --- Test ob Programm beendet werden soll ---
690 IF A=88 THEN 1890 ! Programm beenden
700 ! -- Neues Verzeichniss auf bekannter Diskette --
710 IF A=78 THEN 720 ELSE 1110
720 IF ZIEL$<>"DSK1." THEN 750 ! Funktion nur ermoeglichen wenn nicht DSK1.    
730 CALL LINK("F3")! Bedienerhinweis anzeigen                
740 A=-1 :: CALL MITTE(24,"Taste druecken !"):: CALL WARTE_TASTE(A):: CLOSE #2 :: GOTO 300
750 CALL OEFFNE_ZIEL(ZIELDATEI$)
760 CALL KOPF(ZIEL$,LISTE$,ANZAHL)
770 DISPLAY AT(8,25):"Diskette mit neuen Verzeichnissdaten" :: DISPLAY AT(9,25):"in DSK1. einlegen ---> <ENTER>"
780 A=-1 :: CALL WARTE_TASTE(A):: IF A<>13 THEN 780
790 CALL MITTE(24,"Suchen des Diskettennamens")
800 OPEN #1:"DSK1.",INPUT ,RELATIVE,INTERNAL
810 INPUT #1:N$,A,J,K
820 DISPLAY AT(12,15):"Die eingelegte Disk heisst: ";N$;
830 CALL MITTE(24,"Einlesen der neuen Verzeichnissdaten !")
840 FOR X=1 TO 127 ! max. 127 Eintraege auf Disk moeglich
850 INPUT #1:P$,A,J,B ! Verzeichnisseintrag lesen
860 IF P$="" THEN 890
870 CALL DATENSATZ(N$,P$,A,J,B,NEU$(X))
880 NEXT X
890 CALL DEC(X)! Letztes benutztes Bufferfeld
900 CLOSE #1 ! Neue Verzeichnissdisk schliessen
910 CALL MITTE(24,"]berarbeiten der alten Diskliste")
920 DZ=1 :: ENDE_NEU=X :: BN=1
930 IF EOF(2)THEN 1020
940 LINPUT #2,REC DZ:INHALT$
950 PRINT TAB(5);INHALT$
960 IF SEG$(N$,1,10)=SEG$(INHALT$,1,10)THEN 970 ELSE CALL INC(DZ):: GOTO 930 ! Diskname identisch ?  
970 PRINT "ALT: ";INHALT$
980 INHALT$=NEU$(BN):: CALL INC(BN)! Datensatz austauschen
990 PRINT "Neu: ";INHALT$
1000 PRINT #2,REC DZ:INHALT$
1010 CALL INC(DZ):: GOTO 930 ! naechster Datensatz in Liste
1020 IF ENDE_NEU<BN THEN 1080 ! Alle Neudaten uebernommen
1030 REST=(ENDE_NEU-BN)
1040 T$="Anh{ngen von " &STR$(REST)&" Datensaetzen !" :: CALL MITTE(24,T$)
1050 FOR I=DZ TO DZ+REST ! verbleibende Saetze anh{ngen
1060 PRINT #2,REC I:NEU$(BN)
1070 CALL INC(BN):: NEXT I
1080 ANZAHL=ANZAHL+REST :: CLOSE #2 ! Ueberarbeitete Datei schliessen                 
1090 CALL CLEAR :: CALL LINK("F2"):: CALL KOPF(ZIEL$,LISTE$,ANZAHL):: GOTO 590 ! Anh{ngen/Austauschen beendet Menue anzeigen
1100 ! -- Neue Daten an vorhandene Datei anh{ngen --
1110 IF A=65 THEN 1560 ELSE 1130
1120 ! -- Diskettenliste ausdrucken --
1130 IF A=68 THEN 1140 ELSE 1500 ! Drucken der alten Liste
1140 STARTZEIT$=STATUS IF :: SEITE=69 :: SEITEN_ZAHL=1
1150 CALL MITTE(23,"Ausdruck der Disketten-Datei-Liste l{uft !")
1160 CALL MITTE(10,"Vorgang in Arbeit !! Datensatz:")
1170 CALL MITTE(14,"wurde bearbeitet")
1180 CALL OEFFNE_ZIEL(ZIELDATEI$):: ANZAHL=1
1190 OPEN #3:DRUCKER$,OUTPUT
1200 CALL KOPFZEILE(LF$)
1210 SEITE=SEITE-3
1220 IF EOF(2)THEN CALL KOPF(ZIEL$,LISTE$,ANZAHL):: GOTO 1320
1230 LINPUT #2,REC ANZAHL:N$
1240 DISPLAY AT(12,38)SIZE(5):ANZAHL
1250 PRINT #3:TAB(5);ANZAHL;TAB(15);N$;LF$
1260 CALL INC(ANZAHL):: CALL DEC(SEITE)
1270 IF SEITE>1 THEN 1310
1280 PRINT #3:"Diskettenliste";TAB(65);"Seite : ";SEITEN_ZAHL;LF$
1290 CALL INC(SEITEN_ZAHL)
1300 PRINT #3:CHR$(12):: CALL KOPFZEILE(LF$):: SEITE=68 ! Seitenvorschub    
1310 GOTO 1220
1320 IF SEITE>1 THEN PRINT #3:LF$ :: CALL DEC(SEITE):: GOTO 1320 ! Seite mit Lerrzeilen fuellen
1330 PRINT #3:"Diskettenliste";TAB(65);"Seite : ";SEITEN_ZAHL;LF$
1340 PRINT #3:CHR$(12)! Seitenvorschub auch nach letztem ausgedruckten Blatt
1350 CALL MITTE(23,"Deckblatt des Ausdrucks wird erstellt !")
1360 FOR I=1 TO 12 :: PRINT #3:LF$ :: NEXT I
1370 CALL DRUCK_GROSS("Liste fuer",5,5,25)
1380 PRINT #3:LF$;LF$;LF$;LF$;LF$ :: D$="Rubrikdatei: " &LISTE$
1390 CALL DRUCK_GROSS(D$,4,4,6)
1400 PRINT #3:LF$;LF$;LF$;LF$;LF$
1410 DATUM$=STATUS GO :: CALL DATUMTXT(DATUM$)
1420 PRINT #3:TAB(7);"Diese Ausdruck wurde am : ";DATUM$;LF$
1430 ENDZEIT$=STATUS IF
1440 PRINT #3:LF$;TAB(9);"Druckzeit von ";STARTZEIT$;" bis ";ENDZEIT$;LF$
1450 FOR I=1 TO 36 :: PRINT #3:LF$ :: NEXT I
1460 PRINT #3:"Diskettenliste        Version#:19951206 ZE";TAB(65);"Deckblatt";LF$
1470 PRINT #3:CHR$(12)
1480 CLOSE #3 :: GOTO 1890 ! Nach Ausdruck Programm beenden  
1490 ! -- Vorhandene Datei loeschen und Neu beginnen --
1500 IF A=76 THEN 1510 ELSE 1570 ! Neue Liste unter altem Namen   
1510 CALL MITTE(23,"Alter Dateninhalt wird gel|scht !")
1520 CLOSE #2 ! Vor dem L|schen besser schliessen
1530 ALTE$=ZIEL$&LISTE$ ! Diese Datei l|schen
1540 DELETE ALTE$
1550 ANZAHL=0
1560 CALL OEFFNE_ZIEL(ZIELDATEI$)
1570 CALL KOPF(ZIEL$,LISTE$,ANZAHL)
1580 DISPLAY AT(5,4):"Aus welchen Laufwerk lesen? : DSK1."
1590 CALL HCHAR(8,1,32,1360)! Angezeigten Katalog loeschen
1600 CALL KOPF(ZIEL$,LISTE$,ANZAHL)
1610 CALL MITTE(24,"Diskette einlegen -> <ENTER> / 0 = Programmende"):: ACCEPT AT(5,37)SIZE(-1)VALIDATE(NUMERIC)BEEP:D$
1620 V$="DSK" &D$&"." :: IF V$=ZIEL$ THEN 1630 ELSE 1650 ! Katalog aus Ziellaufwerk ?
1630 CALL MITTE(24,"WARNUNG: Kataloglaufwerk ist Speicherlaufwerk UNZUL[SSIG !!")
1640 A=-1 :: LIBRARYA=-1 :: CALL WARTE_TASTE(A):: :: CALL HCHAR(24,1,32,80):: GOTO 1610
1650 IF D$="0" THEN 1890
1660 CALL HCHAR(23,1,32,80)! Eingabeaufforderung l|schen
1670 ZEILE=8
1680 CALL MITTE(24,"Arbeitstatus: *\ffnen*       Eintrag:    0"):: DISPLAY AT(7,2):"Inhaltsverzeichniss der Diskette :"
1690 D$="DSK" &D$&"." ! Dateiname fuer Katalogzugriff
1700 OPEN #1:D$,INPUT ,RELATIVE,INTERNAL
1710 INPUT #1:N$,A,J,K
1720 DISPLAY AT(24,34)SIZE(-8):" *LESEN*"
1730 FOR X=1 TO 127
1740 INPUT #1:P$,A,J,B
1750 IF P$="" THEN 1840
1760 DISPLAY AT(24,60):USING "###":X
1770 CALL DATENSATZ(N$,P$,A,J,B,INHALT$)
1780 DISPLAY AT(ZEILE,2):INHALT$
1790 ZEILE=ZEILE+1
1800 IF ZEILE=24 THEN ZEILE=8 :: CALL HCHAR(8,1,32,1280)
1810 S=ANZAHL+X ! Satznummer zum Abspeichern berechnen
1820 PRINT #2,REC S:INHALT$ ! Disk,Name,Typ,Groesse in Sek,Satzlaenge  
1830 NEXT X
1840 DISPLAY AT(24,34)SIZE(-12):"*SCHLIESSEN*"
1850 CLOSE #1
1860 ANZAHL=ANZAHL+X-1
1870 GOTO 1580
1880 ! --- Programmende ---
1890 IF BASIC>200 THEN CALL GRAPHICS(3,1)! In MY-BASIC zur}ckschalten auf 80 Zeichen   
1900 CALL MITTE(23,"Angelegte Listendatei wird geschlossen !")
1910 CLOSE ALL
1920 CALL CLEAR
1930 PRINT "*  GET  *"
1940 END
1950 ! --- Fehlerdiagnose & Auswertung ---
1960 CALL ERR(KODE,TYP,GEW,ZEILE)
1970 IF (ZEILE=420)AND(KODE=116)THEN CALL INIT :: GOTO 440 ! Fehler wenn keine Fenster geladen
1980 IF (ZEILE=440)AND(KODE=130)THEN CALL WARNE("Kein Zugriff auf ben|tigte Maschinenroutinen !"):: GOTO 1920
1990 IF (ZEILE=720)AND(KODE=130)THEN CALL WARNE("DRUCKERPROBLEM: Schnittstellenfehler !"):: GOTO 1890
2000 IF (ZEILE=800)THEN BREAK
2010 IF (ZEILE=1210)AND(KODE=130)THEN CALL WARNE("DISK-FEHLER: Kein Zugriff auf Quelldiskette m|glich !"):: GOTO 1570
2020 IF (ZEILE=1250)AND(KODE=130)THEN CALL WARNE("DISK-FEHLER: Dateiverzeichniss nicht lesbar !"):: GOTO 1890
2030 PRINT "Unerwarteter Fehler in Zeile: ";ZEILE;" Kode: ";KODE;" Typ: ";TYP
2040 GOTO 1930
2050 ! --- Lokale Unterprogramme ---
2060 SUB MITTE(ZEILE,A$)
2070 CALL PEEK(-965,B)! Bildschirmbreite
2080 CALL HCHAR(ZEILE,1,32,B)
2090 M=INT((B-LEN(A$))/2)+1 ! TAB zentrieren
2100 DISPLAY AT(ZEILE,M):A$
2110 SUBEND
2120 SUB DEUZEI80
2130 CALL CHAR(91,"88708888F8888800")!AE
2140 CALL CHAR(92,"8800F8888888F800")!OE  
2150 CALL CHAR(93,"8800888888887000")!UE
2160 CALL CHAR(123,"0048304848483C00")!ae
2170 CALL CHAR(124,"0048003048483000")!oe
2180 CALL CHAR(125,"0048004848483C00")!ue
2190 CALL CHAR(126,"708888B088B08000")!sz
2200 SUBEND
2210 SUB DATEI_DA(DATEI$,STATUS)
2220 ON ERROR 2260
2230 STATUS=0 ! Datei gilt als nicht vorhanden
2240 OPEN #99:DATEI$,RELATIVE,DISPLAY ,FIXED 50,INPUT ! Oeffnungsversuch    
2250 CLOSE #99 :: STATUS=-1 ! Datei ist vorhanden
2260 SUBEND
2270 SUB RAM_DA(RAMFLAG)
2280 ON ERROR 2330
2290 RAMFLAG=0 ! Keine RAMdisk im System
2300 OPEN #99:"DSK5.T",OUTPUT !Versuch des Diskzugriffs     
2310 CLOSE #99 :: RAMFLAG=-1 ! OK RAMdisk vorhanden
2320 DELETE "DSK5.T"
2330 SUBEND
2340 SUB WARTE_TASTE(ASC_KODE)! ASC_KODE bei Rueckgabe ASC der gedrueckten Taste (Grossbuchstabe)/Bei Aufruf -1= akustische Eingabeaufforderung
2350 LIBRARY(K<>-1)DO ! Tasterturbuffer leeren  /-1 bedeutet keine Taste gedrueckt.
2360 CALL KEY(0,K,S)
2370
2380 LIBRARY(K=-1)! Bis Tastendruck        
2390 IF ASC_KODE=-1 THEN CALL SOUND(75,850-INT(RND*400),17,900-INT(600*RND),19)! Eingabetoene      
2400 CALL KEY(0,K,S)
2410 IF K>96 THEN K=K-32 ! In Grossbuchstaben umrechnen
2420
2430 ASC_KODE=K
2440 SUBEND
2450 SUB DEC(V)
2460 V=V-1
2470 SUBEND
2480 SUB INC(V)
2490 V=V+1
2500 SUBEND
2510 SUB KOPFZEILE(LF$)
2520 PRINT #3:TAB(3);"Listen#     Diskette       Dateiname     Typ  Sek.L{nge";LF$
2530 PRINT #3:TAB(3);RPT$("-",65);LF$
2540 SUBEND
2550 ! CALL Routine: DRUCK_GROS Version#: 19951202 ZE  
2560 SUB DRUCK_GROSS(TEXT$,HOEHE,ZEICHENBREITE,STARTSPALTE)
2570 DIM A$(80),Z$(16)
2580 DATA 0000,0001,0010,0011,0100,0101,0110,0111,1000,1001,1010,1011,1100,1101,1110,1111
2590 D=2^HOEHE-1
2600 RESTORE 2580 :: FOR L=1 TO 16 :: READ T$ :: Z$(L)=CHR$(27)&CHR$(76)&CHR$(ZEICHENBREITE*4)&CHR$(0):: FOR L2=1 TO 4
2610 Z$(L)=Z$(L)&RPT$(CHR$(VAL(SEG$(T$,L2,1))*D),ZEICHENBREITE):: NEXT L2 :: NEXT L
2620 IF LEN(TEXT$)*ZEICHENBREITE*8>960-8*STARTSPALTE THEN HOEHE,ZEICHENBREITE=999 :: SUBEXIT
2630 P1$=CHR$(13)&CHR$(27)&CHR$(65)&CHR$(HOEHE)&CHR$(18)
2640 PRINT #3:P1$
2650 FOR L=1 TO LEN(TEXT$):: CALL CHARPAT(ASC(SEG$(TEXT$,L,1)),A$(L)):: NEXT L
2660 FOR L=1 TO 15 STEP 2 :: PRINT #3:TAB(STARTSPALTE);:: FOR L2=1 TO LEN(TEXT$):: FOR L3=L TO L+1 :: T=ASC(SEG$(A$(L2),L3,1))-47 :: IF T>10 THEN T=T-7
2670 PRINT #3:Z$(T);
2680 NEXT L3 :: NEXT L2 :: PRINT #3:CHR$(10);CHR$(13):: NEXT L :: PRINT #3:CHR$(10);CHR$(27);CHR$(50)
2690 SUBEND
2700 SUB DATUMTXT(DATUM$)
2710 RESTORE 2720
2720 DATA Januar,Februar,Maerz,April,Mai,Juni
2730 DATA Juli,August,September,Oktober,November,Dezember
2740 IF ASC(SEG$(DATUM$,3,1))<>45 ORASC(SEG$(DATUM$,6,1))<>45 ORLEN(DATUM$)<>8 THEN PRINT " ! Syntaxfehler im Datum !" :: SUBEXIT
2750 NEU$=SEG$(DATUM$,4,2)! Tag isolieren
2760 FOR M=1 TO VAL(SEG$(DATUM$,1,2)):: READ M$ :: NEXT M ! Monatsschleife  
2770 NEU$=NEU$&"." &M$&" " &"19" &SEG$(DATUM$,7,2)
2780 DATUM$=NEU$ ! Rueckgabewert akt.
2790 SUBEND
2800 SUB DATENSATZ(N$,P$,A,J,B,INHALT$)
2810 IF LEN(N$)<15 THEN CALL STR_FUELL(N$,32,15)
2820 IF LEN(P$)<15 THEN CALL STR_FUELL(P$,32,15)
2830 A$=STR$(A):: IF LEN(A$)<3 THEN CALL STR_FUELL(A$,32,3)
2840 J$=STR$(J):: IF LEN(J$)<5 THEN CALL STR_FUELL(J$,32,5)
2850 B$=STR$(B):: IF LEN(B$)<8 THEN CALL STR_FUELL(B$,32,8)
2860 INHALT$=N$&P$&A$&J$&B$
2870 SUBEND
2880 SUB STR_FUELL(STRING$,MIT_ASC,LANG)
2890 IF LEN(STRING$)>=LANG THEN SUBEXIT ! String hat Ueberlaenge
2900 LIBRARYLEN(STRING$)<LANG
2910 STRING$=STRING$&CHR$(MIT_ASC)
2920
2930 SUBEND
2940 SUB SUCHE_ENDE(ANZAHL)
2950 CALL MITTE(24,"Suchen des letzten Dateieintrages der Liste"):: Z=0
2960 IF EOF(2)THEN ANZAHL=Z-1 :: CALL HCHAR(24,1,32,80):: SUBEXIT
2970 LINPUT #2:N$
2980 CALL INC(Z):: GOTO 2960
2990 SUBEND
3000 SUB OEFFNE_ZIEL(DATEINAME$)
3010 OPEN #2:DATEINAME$,RELATIVE,DISPLAY ,FIXED 50,UPDATE
3020 SUBEND
3030 SUB WARNE(TEXT$)
3040 CALL PEEK(-965,B)! Bildschirmbreite
3050 P=INT((B-LEN(TEXT$))/2)+1 :: CALL TCOLOR(9,11):: DISPLAY AT(24,P):TEXT$;
3060 CALL TCOLOR(2,7):: CALL SOUND(1000,30000,30)! Wartezeit
3070 CALL KEY(0,K,S):: CALL SOUND(-10,200,0):: IF (K=-1)OR(K=13)THEN 3070
3080 CALL HCHAR(24,1,32,B)
3090 SUBEND
3100 SUB KOPF(ZIEL$,LISTE$,ANZAHL)
3110 DISPLAY AT(3,15)SIZE(5):ZIEL$ :: DISPLAY AT(3,71)SIZE(10):LISTE$
3120 DISPLAY AT(4,72):USING "###":ANZAHL
3130 SUBEND
3140 SUB UPPERSTR(STRING$)
3150 FOR A=1 TO LEN(STRING$)
3160 B=ASC(SEG$(STRING$,A,1))
3170 IF (B>96)AND(B<123)THEN STRING$=SEG$(STRING$,1,A-1)&CHR$(B-32)&SEG$(STRING$,A+1,LEN(STRING$)-A)
3180 NEXT A
3190 SUBEND

 

 

[GDMike]

2 hours ago, Schmitzi said:

 

DISKRUNNER

Code: (from the disk "LA4526")

 

  Hide contents

100 !@+++++++++++++++++++++
110 !@++   DISKRUNNER    ++
120 !@++BY MIKE DE FRANK ++
130 !@++ CIS (74015,673) ++
140 !@++     8308.05     ++
150 !@++  INSPIRED BY    ++
160 !@++BY STEVE DAVIS'S ++
170 !@++ DISK LISTER (C) ++
180 !@+++++++++++++++++++++
190 DIM A$(10),B$(300),C$(40),D$(40):: E$=RPT$(" ",17):: F$=RPT$(".",17):: CALL CLEAR
200 CALL CHAR(129,"7F40404040404040"):: CALL CHAR(130,"C040404245424070"):: CALL CHAR(131,"000000FF8080C020")
210 CALL CHAR(132,"404047C4080F0001"):: CALL CHAR(133,"102DCD1818B3B464"):: CALL CHAR(134,"FC04F41426E10101")
220 CALL CHAR(135,"1010080403000000"):: CALL CHAR(136,"010242A424242211"):: CALL CHAR(137,"64C8C810101808F1")
230 CALL CHAR(138,"010101060830C000"):: CALL CHAR(139,"0804040201000000"):: CALL CHAR(140,"0204040808C42418")
240 CALL CHAR(126,"000000FF00FF0000"):: CALL CHAR(141,"FF818181818181FF"):: CALL CHAR(58,"0000003030003030")
250 CALL HCHAR(1,2,141,30):: CALL VCHAR(1,31,141,24):: CALL VCHAR(1,2,141,24):: CALL HCHAR(24,2,141,30)
260 DISPLAY AT(3,09):RPT$("~",12):: DISPLAY AT(4,8):"~ DISKRUNNER ~"
270 DISPLAY AT(5,7):RPT$("~",16):: DISPLAY AT(07,7):"by mike de frank" :: DISPLAY AT(09,11):"for the"
280 DISPLAY AT(10,3):"üé" :: DISPLAY AT(11,2):"âäàå" :: DISPLAY AT(12,2):"çêëè" :: DISPLAY AT(13,3):"ïî"
290 DISPLAY AT(11,7):"Texas Instruments" :: DISPLAY AT(13,11):"TI-99/4A"
300 DISPLAY AT(16,3):"Please Enter Current Date": :"      Example: 08-06-83"
310 DISPLAY AT(22,3)BEEP:"Date:" :: ACCEPT AT(22,8)VALIDATE("-/0123456789")SIZE(8):G$ :: IF G$="" THEN 310
320 DISPLAY AT(15,2):"Press:": :"    1.Create Catalog": :"    2.Load Catalog File"
330 DISPLAY AT(22,2)SIZE(26)BEEP:" Choice: 1" :: ACCEPT AT(22,11)VALIDATE("12")SIZE(-1):H$ :: IF H$="2" THEN 770
340 CALL A(14,22):: DISPLAY AT(22,2)SIZE(25)BEEP:" Press any Key when Ready"
350 DISPLAY AT(17,3):"INSERT DISK INTO DRIVE 1" :: CALL KEY(0,A,B):: DISPLAY AT(17,3)SIZE(24):" " :: IF B=0 THEN 350
360 DISPLAY AT(17,5):"Scanning Disk Header"
370 OPEN #1:"DSK1.",INPUT ,RELATIVE,INTERNAL :: ON ERROR 640
380 INPUT #1:I$,C,D,E :: CALL B(E,J$):: FOR F=1 TO G :: H=POS(A$(F)," ",1):: IF I$<>SEG$(A$(F),1,H-1)THEN 410
390 A$(F)=I$&SEG$(E$,1,11-LEN(I$))&"Free:" &J$&" Used:" &STR$(D-E):: H$="Updating" :: DISPLAY AT(2,1)ERASE ALL:A$(F):: FOR B=1 TO I :: IF I$=SEG$(B$(B),30,LEN(I$))THEN B$(B)="" :: J=J+1
400 NEXT B :: GOTO 490
410 NEXT F :: H$="Scanning" :: G=G+1 :: IF G<11 THEN 480
420 G=10 :: DISPLAY AT(2,09)ERASE ALL:RPT$("~",12):: DISPLAY AT(3,8):"~ DISKRUNNER ~" :: DISPLAY AT(4,7):RPT$("~",16):: DISPLAY AT(6,1)BEEP:" This disk cannot be added  to the file now in memory."
430 DISPLAY AT(9,1):" This space is now reserved for any future updates for  the disks in this file."
440 DISPLAY AT(13,1):" A maximum of 10 disks (box)may be stored in each file."
450 DISPLAY AT(16,1):" After you've finished usingthis file, Save it, then usePurge, to clear the memory."
460 DISPLAY AT(20,1):" You will then be ready to  Create a new file."
470 DISPLAY AT(24,2):"Press any key to Continue" :: CALL KEY(0,A,B):: IF B=0 THEN 470 ELSE 640
480 A$(G)=I$&SEG$(E$,1,11-LEN(I$))&"Free:" &J$&" Used:" &STR$(D-E):: DISPLAY AT(2,1)ERASE ALL:A$(G)
490 K=5 :: CALL C :: DISPLAY AT(21,1):RPT$("~",28): : :"   Status: " &H$&" Disk"
500 INPUT #1:K$,C,D,E :: IF LEN(K$)=0 THEN 630
510 ON ABS(C) GOTO 520,530,540,550,560
520 L$="D/F:" :: GOTO 570
530 L$="D/V:" :: GOTO 570
540 L$="I/F:" :: GOTO 570
550 L$="I/V:" :: GOTO 570
560 J$="Program" :: GOTO 580
570 CALL B(E,J$):: J$=L$&J$
580 IF C<0 THEN M$="Y" ELSE M$="-"
590 CALL B(D,N$):: IF I-J<230 THEN 610
600 DISPLAY AT(22,6)BEEP:"** File is Full **" :: GOTO 700
610 I=I+1 :: B$(I)=K$&SEG$(F$,1,12-LEN(K$))&N$&".." &J$&".." &M$&".." &I$&SEG$(E$,1,10-LEN(I$)):: K=K+1 :: IF K>20 THEN K=6 :: CALL HCHAR(6,1,32,480)
620 DISPLAY AT(K,1):" " &SEG$(B$(I),1,27):: GOTO 500
630 DISPLAY AT(22,1):"  Disks: " &STR$(G)&"     Files: " &STR$(I-J)
640 ON ERROR 320 :: CLOSE #1
650 ON ERROR STOP
660 DISPLAY AT(24,1)BEEP:"Add/update Another? (Y/N): Y" :: ACCEPT AT(24,28)VALIDATE("YN")SIZE(-1):H$ :: IF H$="N" THEN 700
670 DISPLAY AT(24,1):" Press any Key to Continue" :: FOR F=1 TO 50 :: NEXT F
680 DISPLAY AT(22,2)SIZE(25):" " :: CALL KEY(0,A,B):: IF B=0 THEN DISPLAY AT(22,2):" INSERT DISK INTO DRIVE 1" :: GOTO 680
690 CALL CLEAR :: GOTO 370
700 CALL D(B$(),I,"Files"):: CALL D(A$(),G,"Disks"):: GOTO 840
710 DISPLAY AT(24,2)BEEP:"** Input Error **" :: FOR F=1 TO 300 :: NEXT F
720 DISPLAY AT(24,2)BEEP:"Library Filename:" :: ACCEPT AT(24,19)SIZE(10):O$ :: IF SEG$(O$,1,5)="DSK1." THEN 740 ELSE IF O$="" THEN 890
730 P$=O$ :: O$="DSK1." &O$
740 ON ERROR 710 :: OPEN #3:O$,UPDATE,DISPLAY ,VARIABLE
750 PRINT #3:G$ :: PRINT #3:G :: FOR F=1 TO G :: PRINT #3:A$(F):: NEXT F :: FOR F=J+1 TO I :: PRINT #3:B$(F)&"*" :: NEXT F :: CLOSE #3 :: ON ERROR STOP :: GOTO 840
760 DISPLAY AT(22,2)BEEP:"** Input Error **" :: FOR F=1 TO 300 :: NEXT F
770 DISPLAY AT(22,2)BEEP:"Library Filename:" :: ACCEPT AT(22,19)SIZE(10):O$ :: IF O$="" THEN 330
780 IF SEG$(O$,1,5)="DSK1." THEN 800 ELSE IF O$="" THEN 770
790 P$=O$ :: O$="DSK1." &O$
800 ON ERROR 830 :: OPEN #1:O$,INPUT ,DISPLAY ,VARIABLE
810 INPUT #1:Q$ :: INPUT #1:G :: FOR F=1 TO G :: INPUT #1:A$(F):: NEXT F :: I=0
820 I=I+1 :: INPUT #1:B$(I):: B$(I)=SEG$(B$(I),1,39):: IF EOF(1)THEN 830 ELSE 820
830 ON ERROR 760 :: CLOSE #1 :: ON ERROR STOP
840 DISPLAY AT(2,09)ERASE ALL:RPT$("~",12):: DISPLAY AT(3,8):"~ DISKRUNNER ~" :: DISPLAY AT(4,7):RPT$("~",16):: IF P$="" THEN 850 ELSE DISPLAY AT(6,2):"Library Filename:" &P$
850 IF Q$="" THEN DISPLAY AT(8,4):"Current Date:" &G$ ELSE DISPLAY AT(8,4):" Last Update:" &Q$
860 DISPLAY AT(11,3):"Disks:" &STR$(G):: DISPLAY AT(11,19):"Files:" &STR$(I-J)
870 DISPLAY AT(13,1):"~~~~~~~~~~Main Menu~~~~~~~~~" :: DISPLAY AT(15,2):"Press:": :"    1.Display options":"    2.Printer options"
880 DISPLAY AT(19,5):"3.Add or update":"    4.Save to disk":"    5.Purge memory":"    6.Terminate"
890 DISPLAY AT(24,2):"Choice: 1" :: ACCEPT AT(24,10)SIZE(-1)VALIDATE("123456")BEEP:H$ :: IF H$="6" THEN DISPLAY AT(24,2):"Terminate? (Y/N): Y" :: ACCEPT AT(24,20)VALIDATE("YN")SIZE(-1)BEEP:H$ :: IF H$="N" THEN 890 ELSE CALL CLEAR :: END
900 IF H$="5" THEN DISPLAY AT(21,4)SIZE(1):">" :: GOTO 1410
910 IF H$="4" THEN 720
920 IF H$="3" THEN DISPLAY AT(24,1)SIZE(11):" " :: DISPLAY AT(14,1):"      " :: GOTO 340
930 IF H$="2" THEN 1200
940 IF H$="1" THEN 950
950 DISPLAY AT(13,1):"~~~~~~~Display Options~~~~~~" :: CALL A(17,22):: DISPLAY AT(17,5):"1.Display catalog"
960 DISPLAY AT(18,5):"2.Filename search":"    3.Diskname search":"    4.Return to main" :: DISPLAY AT(24,2)BEEP:"Choice: 1" :: ACCEPT AT(24,10)VALIDATE("1234")SIZE(-1):H$
970 IF H$="1" THEN R$="Display Catalog"
980 IF H$="2" THEN R$="Filename Search"
990 IF H$="3" THEN R$="Diskname Search"
1000 IF H$="4" THEN 870
1010 K=5 :: C=0 :: DISPLAY AT(2,4)ERASE ALL:"++ " &R$&" ++" :: IF H$="1" THEN CALL C :: DISPLAY AT(22,1):RPT$("~",28)
1020 IF H$="2" THEN DISPLAY AT(4,4):"Filename      Diskname":RPT$("~",28):: DISPLAY AT(22,1):RPT$("~",28)
1030 ON VAL(H$) GOTO 1040,1060,1090
1040 FOR F=J+1 TO I :: CALL E(SEG$(B$(F),1,27),H$,C,K):: IF H$="N" THEN 840
1050 NEXT F :: DISPLAY AT(22,1)BEEP:"~~~~~~~~End of File~~~~~~~~~" :: GOTO 1190
1060 DISPLAY AT(24,2)BEEP:"Search String:" :: ACCEPT AT(24,16)SIZE(10):L$ :: DISPLAY AT(24,1):" Searching For:" &L$ :: FOR F=J+1 TO I :: IF POS(SEG$(B$(F),1,10),L$,1)=0 THEN 1080
1070 CALL E("  " &SEG$(B$(F),1,12)&".." &SEG$(B$(F),30,10),H$,C,K):: IF H$="N" THEN 840
1080 NEXT F :: GOTO 1180
1090 IF P$="" THEN K$="Memory" ELSE K$=P$
1100 DISPLAY AT(6,8):"Disks in " &K$:RPT$("~",28):: FOR F=1 TO G :: DISPLAY AT(F+7,1):A$(F):: NEXT F :: DISPLAY AT(F+7,1):RPT$("~",28)
1110 DISPLAY AT(24,2)BEEP:"Disk Name:" :: ACCEPT AT(24,12)SIZE(10):L$ :: IF L$="" THEN 840 ELSE DISPLAY AT(24,2)BEEP:" Searching For:" &L$
1120 FOR F=1 TO G :: IF SEG$(A$(F),1,LEN(L$))<>L$ THEN 1140
1130 DISPLAY AT(1,1)ERASE ALL:A$(F):: CALL C :: L$=SEG$(A$(F),1,10):: DISPLAY AT(22,1):RPT$("~",28):: GOTO 1150
1140 NEXT F :: DISPLAY AT(24,2):" Cannot Locate:" &L$ :: FOR F=1 TO 300 :: NEXT F :: GOTO 1110
1150 FOR F=J+1 TO I :: IF SEG$(B$(F),30,10)<>L$ THEN 1170
1160 CALL E(SEG$(B$(F),1,27),H$,C,K):: IF H$="N" THEN 840
1170 NEXT F
1180 DISPLAY AT(22,1)BEEP:"~~~~~~~End of Search~~~~~~~~"
1190 DISPLAY AT(24,1):" Press any Key to Continue" :: CALL KEY(0,A,B):: IF B=0 THEN 1190 ELSE 840
1200 DISPLAY AT(13,1):"~~~~~~~Printer Options~~~~~~" :: CALL A(17,22):: DISPLAY AT(17,5):"1.Print by filename" :: DISPLAY AT(18,5):"2.Print by diskname"
1210 DISPLAY AT(19,5):"3.Return to main"
1220 DISPLAY AT(24,2)BEEP:"Choice: 1" :: ACCEPT AT(24,10)VALIDATE("123")SIZE(-1):H$ :: IF H$="3" THEN 870 ELSE DISPLAY AT(16+VAL(H$),4)SIZE(1):">"
1230 IF L=1 THEN DISPLAY AT(24,2):"Same Device? (Y/N/A): Y" :: ACCEPT AT(24,24)VALIDATE("YNA")SIZE(-1):L$ :: IF L$="A" THEN DISPLAY AT(16+VAL(H$),4)SIZE(1):" " :: GOTO 1220
1240 IF L$="Y" THEN 1260
1250 DISPLAY AT(24,2):"Printer Device Name:" :: ACCEPT AT(24,22)VALIDATE("PIORS232/1TP")BEEP:S$
1260 ON ERROR 1250 :: L=1 :: OPEN #2:S$
1270 ON ERROR STOP :: PRINT #2:CHR$(27)&CHR$(68)&CHR$(41)&CHR$(0)
1280 PRINT #2:CHR$(14);TAB(12);RPT$("-",21):: PRINT #2:CHR$(14);TAB(11);"- D I S K R U N N E R -" :: IF Q$="" THEN L$="CURRENT DATE:" &G$ ELSE L$=" LAST UPDATE:" &Q$
1290 PRINT #2:CHR$(14);TAB(09);RPT$("-",27): :TAB(27);"LIBRARY FILENAME: " &P$: :TAB(29);L$ :: PRINT #2:CHR$(10)&CHR$(10):: L$="FILENAME    SIZE   TYPE   P  DISK" :: IF H$="1" THEN 1360
1300 A=INT(G/2+.5):: FOR B=1 TO A
1320 PRINT #2:CHR$(27)&"E" &"    " &A$(B)&CHR$(9)&"    " &A$(B+A):: PRINT #2:" " :: PRINT #2:L$&CHR$(9)&L$ :: PRINT #2:RPT$("-",80)&CHR$(27)&"F" :: C,D=0 :: FOR F=J+1 TO I
1330 IF SEG$(B$(F),30,10)=SEG$(A$(B),1,10)THEN C=C+1 :: C$(C)=B$(F)
1340 IF SEG$(B$(F),30,10)=SEG$(A$(B+A),1,10)THEN D=D+1 :: D$(D)=B$(F)
1350 NEXT F :: FOR F=1 TO MAX(C,D):: PRINT #2:C$(F)&CHR$(9)&D$(F):: NEXT F :: FOR F=1 TO 5 :: PRINT #2:CHR$(10):: NEXT F :: FOR F=1 TO MAX(C,D):: C$(F),D$(F)="" :: NEXT F :: NEXT B :: CLOSE #2 :: GOTO 840
1360 PRINT #2:CHR$(27)&"E";TAB(19);"DISKS" &CHR$(9)&"             DISKS" :: PRINT #2:TAB(6);RPT$("-",28)&CHR$(9)&"   " &RPT$("-",28):: F=INT(G/2+.5):: FOR B=1 TO F
1370 PRINT #2:TAB(6);A$(B)&CHR$(9)&"   " &A$(B+F):: NEXT B :: PRINT #2:TAB(6);RPT$("-",28)&CHR$(9)&"   " &RPT$("-",28)
1380 PRINT #2:CHR$(10)&CHR$(10)&"          " &"NUMBER OF DISKS:" &STR$(G)&CHR$(9)&"        " &"NUMBER OF FILES:" &STR$(I-J):: PRINT #2:CHR$(10)&CHR$(10):: PRINT #2:L$&CHR$(9)&L$
1390 PRINT #2:RPT$("-",80)&CHR$(27)&"F" :: K=0 :: C=INT((I-(J+1))/2):: F=C+(J+1):: FOR B=J+1 TO F :: K=K+1 :: PRINT #2:B$(B)&CHR$(9)&B$(B+F):: NEXT B :: PRINT #2:CHR$(27)&"E":RPT$("-",80)&CHR$(27)&"F"
1400 FOR F=1 TO 5 :: PRINT #2:CHR$(10):: NEXT F :: CLOSE #2 :: GOTO 840
1410 DISPLAY AT(24,1):" Are You Sure? (Y/N): Y" :: ACCEPT AT(24,23)VALIDATE("YN")SIZE(-1)BEEP:H$ :: IF H$="N" THEN DISPLAY AT(21,4)SIZE(1):" " :: GOTO 890
1420 CALL A(15,24):: DISPLAY AT(18,4)BEEP:"ì ì Purging Memory ì ì" :: C=G :: FOR F=1 TO G :: A$(F)="" :: C=C-1 :: CALL SOUND(-99,990,12):: DISPLAY AT(11,3)SIZE(9):"Disks:" &STR$(C):: NEXT F
1430 C=I :: FOR F=1 TO I :: C=C-1 :: B$(F)="" :: CALL SOUND(-99,990,12):: DISPLAY AT(11,19)SIZE(9):"Files:" &STR$(C):: NEXT F :: I,G,J=0 :: Q$,P$="" :: DISPLAY AT(6,2)SIZE(28):" "
1440 DISPLAY AT(8,4):"Current Date:" &G$ :: GOTO 320
1450 SUB A(A,B):: FOR C=A TO B :: DISPLAY AT(C,2)SIZE(22):" " :: NEXT C :: SUBEND
1460 SUB B(A,A$):: A$=STR$(A):: B=LEN(A$):: IF B=1 THEN A$="00" &A$ ELSE IF B=2 THEN A$="0" &A$
1470 SUBEND
1480 SUB C :: DISPLAY AT(4,1):" Filename    Size   Type   P" :: DISPLAY AT(5,1):RPT$("~",28):: SUBEND
1490 SUB D(A$(),A,B$):: DISPLAY AT(24,1)BEEP:"   Status: Sorting " &B$ :: B=1
1500 B=2*B :: IF B<=A THEN 1500
1510 B=INT(B/2):: IF B=0 THEN 1560
1520 FOR C=1 TO A-B :: D=C
1530 E=D+B :: IF A$(D)<=A$(E)THEN 1550
1540 C$=A$(D):: A$(D)=A$(E):: A$(E)=C$ :: D=D-B :: IF D>0 THEN 1530
1550 NEXT C :: GOTO 1510
1560 SUBEND
1570 SUB E(A$,B$,A,B):: IF A=1 THEN A=0 :: GOTO 1590
1580 B=B+1 :: DISPLAY AT(B,1):" " &A$ :: IF B>20 THEN A=1 :: SUBEXIT ELSE SUBEXIT
1590 DISPLAY AT(24,2)BEEP:"Continue Listing? (Y/N): Y" :: ACCEPT AT(24,27)VALIDATE("YN")SIZE(-1):B$ :: DISPLAY AT(24,1)SIZE(28):" " :: IF B$="N" THEN SUBEXIT
1600 B=5 :: CALL HCHAR(6,1,32,512):: GOTO 1580
1610 SUBEND

 

 

 

 

Another code with some small differences in the code (i.e. Lines 310 + 350)

(i.e. from Pergrem 3154.DSK and a disk from Paolo Bagnaresi)

  Reveal hidden contents

100 !@+++++++++++++++++++++
110 !@++   DISKRUNNER    ++
120 !@++BY MIKE DE FRANK ++
130 !@++ CIS (74015,673) ++
140 !@++     8308.05     ++
150 !@++  INSPIRED BY    ++
160 !@++BY STEVE DAVIS'S ++
170 !@++ DISK LISTER (C) ++
180 !@+++++++++++++++++++++
190 DIM A$(10),B$(300),C$(40),D$(40):: E$=RPT$(" ",17):: F$=RPT$(".",17):: CALL CLEAR
200 CALL CHAR(129,"7F40404040404040"):: CALL CHAR(130,"C040404245424070"):: CALL CHAR(131,"000000FF8080C020")
210 CALL CHAR(132,"404047C4080F0001"):: CALL CHAR(133,"102DCD1818B3B464"):: CALL CHAR(134,"FC04F41426E10101")
220 CALL CHAR(135,"1010080403000000"):: CALL CHAR(136,"010242A424242211"):: CALL CHAR(137,"64C8C810101808F1")
230 CALL CHAR(138,"010101060830C000"):: CALL CHAR(139,"0804040201000000"):: CALL CHAR(140,"0204040808C42418")
240 CALL CHAR(126,"000000FF00FF0000"):: CALL CHAR(141,"FF818181818181FF"):: CALL CHAR(58,"0000003030003030")
250 CALL HCHAR(1,2,141,30):: CALL VCHAR(1,31,141,24):: CALL VCHAR(1,2,141,24):: CALL HCHAR(24,2,141,30)
260 DISPLAY AT(3,09):RPT$("~",12):: DISPLAY AT(4,8):"~ DISKRUNNER ~"
270 DISPLAY AT(5,7):RPT$("~",16):: DISPLAY AT(07,7):"by mike de frank" :: DISPLAY AT(09,11):"for the"
280 DISPLAY AT(10,3):"üé" :: DISPLAY AT(11,2):"âäàå" :: DISPLAY AT(12,2):"çêëè" :: DISPLAY AT(13,3):"ïî"
290 DISPLAY AT(11,7):"Texas Instruments" :: DISPLAY AT(13,11):"TI-99/4A"
300 DISPLAY AT(16,3):"Please Enter Current Date": :"      Example: 08-06-83"
310 DISPLAY AT(22,3)BEEP:"Date:" :: ACCEPT AT(22,8)VALIDATE("-0123456789")SIZE(8):G$ :: IF G$="" THEN 310
320 DISPLAY AT(15,2):"Press:": :"    1.Create Catalog": :"    2.Load Catalog File"
330 DISPLAY AT(22,2)SIZE(26)BEEP:" Choice: 1" :: ACCEPT AT(22,11)VALIDATE("12")SIZE(-1):H$ :: IF H$="2" THEN 770
340 CALL A(14,22):: DISPLAY AT(22,2)SIZE(25)BEEP:" Press any Key when Ready"
350 DISPLAY AT(18,3)SIZE(25):" " :: CALL KEY(0,A,B):: IF B=0 THEN DISPLAY AT(18,3):"INSERT DISK INTO DRIVE 1" :: GOTO 350
360 DISPLAY AT(17,5):"Scanning Disk Header"
370 OPEN #1:"DSK1.",INPUT ,RELATIVE,INTERNAL :: ON ERROR 640
380 INPUT #1:I$,C,D,E :: CALL B(E,J$):: FOR F=1 TO G :: H=POS(A$(F)," ",1):: IF I$<>SEG$(A$(F),1,H-1)THEN 410
390 A$(F)=I$&SEG$(E$,1,11-LEN(I$))&"Free:" &J$&" Used:" &STR$(D-E):: H$="Updating" :: DISPLAY AT(2,1)ERASE ALL:A$(F):: FOR B=1 TO I :: IF I$=SEG$(B$(B),30,LEN(I$))THEN B$(B)="" :: J=J+1
400 NEXT B :: GOTO 490
410 NEXT F :: H$="Scanning" :: G=G+1 :: IF G<11 THEN 480
420 G=10 :: DISPLAY AT(2,09)ERASE ALL:RPT$("~",12):: DISPLAY AT(3,8):"~ DISKRUNNER ~" :: DISPLAY AT(4,7):RPT$("~",16):: DISPLAY AT(6,1)BEEP:" This disk cannot be added  to the file now in memory."
430 DISPLAY AT(9,1):" This space is now reserved for any future updates for  the disks in this file."
440 DISPLAY AT(13,1):" A maximum of 10 disks (box)may be stored in each file."
450 DISPLAY AT(16,1):" After you've finished usingthis file, Save it, then usePurge, to clear the memory."
460 DISPLAY AT(20,1):" You will then be ready to  Create a new file."
470 DISPLAY AT(24,2):"Press any key to Continue" :: CALL KEY(0,A,B):: IF B=0 THEN 470 ELSE 640
480 A$(G)=I$&SEG$(E$,1,11-LEN(I$))&"Free:" &J$&" Used:" &STR$(D-E):: DISPLAY AT(2,1)ERASE ALL:A$(G)
490 K=5 :: CALL C :: DISPLAY AT(21,1):RPT$("~",28): : :"   Status: " &H$&" Disk"
500 INPUT #1:K$,C,D,E :: IF LEN(K$)=0 THEN 630
510 ON ABS(C) GOTO 520,530,540,550,560
520 L$="D/F:" :: GOTO 570
530 L$="D/V:" :: GOTO 570
540 L$="I/F:" :: GOTO 570
550 L$="I/V:" :: GOTO 570
560 J$="Program" :: GOTO 580
570 CALL B(E,J$):: J$=L$&J$
580 IF C<0 THEN M$="Y" ELSE M$="-"
590 CALL B(D,N$):: IF I-J<230 THEN 610
600 DISPLAY AT(22,6)BEEP:"** File is Full **" :: GOTO 700
610 I=I+1 :: B$(I)=K$&SEG$(F$,1,12-LEN(K$))&N$&".." &J$&".." &M$&".." &I$&SEG$(E$,1,10-LEN(I$)):: K=K+1 :: IF K>20 THEN K=6 :: CALL HCHAR(6,1,32,480)
620 DISPLAY AT(K,1):" " &SEG$(B$(I),1,27):: GOTO 500
630 DISPLAY AT(22,1):"  Disks: " &STR$(G)&"     Files: " &STR$(I-J)
640 ON ERROR 320 :: CLOSE #1
650 ON ERROR STOP
660 DISPLAY AT(24,1)BEEP:"Add/update Another? (Y/N): Y" :: ACCEPT AT(24,28)VALIDATE("YN")SIZE(-1):H$ :: IF H$="N" THEN 700
670 DISPLAY AT(24,1):" Press any Key to Continue" :: FOR F=1 TO 50 :: NEXT F
680 DISPLAY AT(22,2)SIZE(25):" " :: CALL KEY(0,A,B):: IF B=0 THEN DISPLAY AT(22,2):"INSERT DISK INTO DRIVE 1" :: GOTO 680
690 CALL CLEAR :: GOTO 370
700 CALL D(B$(),I,"Files"):: CALL D(A$(),G,"Disks"):: GOTO 840
710 DISPLAY AT(24,2)BEEP:"** Input Error **" :: FOR F=1 TO 300 :: NEXT F
720 DISPLAY AT(24,2)BEEP:"Library Filename:" :: ACCEPT AT(24,19)SIZE(10):O$ :: IF SEG$(O$,1,5)="DSK1." THEN 740 ELSE IF O$="" THEN 890
730 P$=O$ :: O$="DSK1." &O$
740 ON ERROR 710 :: OPEN #3:O$,UPDATE,DISPLAY ,VARIABLE
750 PRINT #3:G$ :: PRINT #3:G :: FOR F=1 TO G :: PRINT #3:A$(F):: NEXT F :: FOR F=J+1 TO I :: PRINT #3:B$(F)&"*" :: NEXT F :: CLOSE #3 :: ON ERROR STOP :: GOTO 840
760 DISPLAY AT(22,2)BEEP:"** Input Error **" :: FOR F=1 TO 300 :: NEXT F
770 DISPLAY AT(22,2)BEEP:"Library Filename:" :: ACCEPT AT(22,19)SIZE(10):O$ :: IF O$="" THEN 330
780 IF SEG$(O$,1,5)="DSK1." THEN 800 ELSE IF O$="" THEN 770
790 P$=O$ :: O$="DSK1." &O$
800 ON ERROR 830 :: OPEN #1:O$,INPUT ,DISPLAY ,VARIABLE
810 INPUT #1:Q$ :: INPUT #1:G :: FOR F=1 TO G :: INPUT #1:A$(F):: NEXT F :: I=0
820 I=I+1 :: INPUT #1:B$(I):: B$(I)=SEG$(B$(I),1,39):: IF EOF(1)THEN 830 ELSE 820
830 ON ERROR 760 :: CLOSE #1 :: ON ERROR STOP
840 DISPLAY AT(2,09)ERASE ALL:RPT$("~",12):: DISPLAY AT(3,8):"~ DISKRUNNER ~" :: DISPLAY AT(4,7):RPT$("~",16):: IF P$="" THEN 850 ELSE DISPLAY AT(6,2):"Library Filename:" &P$
850 IF Q$="" THEN DISPLAY AT(8,4):"Current Date:" &G$ ELSE DISPLAY AT(8,4):" Last Update:" &Q$
860 DISPLAY AT(11,3):"Disks:" &STR$(G):: DISPLAY AT(11,19):"Files:" &STR$(I-J)
870 DISPLAY AT(13,1):"~~~~~~~~~~Main Menu~~~~~~~~~" :: DISPLAY AT(15,2):"Press:": :"    1.Display options":"    2.Printer options"
880 DISPLAY AT(19,5):"3.Add or update":"    4.Save to disk":"    5.Purge memory":"    6.Terminate"
890 DISPLAY AT(24,2):"Choice: 1" :: ACCEPT AT(24,10)SIZE(-1)VALIDATE("123456")BEEP:H$ :: IF H$="6" THEN DISPLAY AT(24,2):"Terminate? (Y/N): Y" :: ACCEPT AT(24,20)VALIDATE("YN")SIZE(-1)BEEP:H$ :: IF H$="N" THEN 890 ELSE CALL CLEAR :: END
900 IF H$="5" THEN DISPLAY AT(21,4)SIZE(1):">" :: GOTO 1410
910 IF H$="4" THEN 720
920 IF H$="3" THEN DISPLAY AT(24,1)SIZE(11):" " :: DISPLAY AT(14,1):"      " :: GOTO 340
930 IF H$="2" THEN 1200
940 IF H$="1" THEN 950
950 DISPLAY AT(13,1):"~~~~~~~Display Options~~~~~~" :: CALL A(17,22):: DISPLAY AT(17,5):"1.Display catalog"
960 DISPLAY AT(18,5):"2.Filename search":"    3.Diskname search":"    4.Return to main" :: DISPLAY AT(24,2)BEEP:"Choice: 1" :: ACCEPT AT(24,10)VALIDATE("1234")SIZE(-1):H$
970 IF H$="1" THEN R$="Display Catalog"
980 IF H$="2" THEN R$="Filename Search"
990 IF H$="3" THEN R$="Diskname Search"
1000 IF H$="4" THEN 870
1010 K=5 :: C=0 :: DISPLAY AT(2,4)ERASE ALL:"++ " &R$&" ++" :: IF H$="1" THEN CALL C :: DISPLAY AT(22,1):RPT$("~",28)
1020 IF H$="2" THEN DISPLAY AT(4,4):"Filename      Diskname":RPT$("~",28):: DISPLAY AT(22,1):RPT$("~",28)
1030 ON VAL(H$) GOTO 1040,1060,1090
1040 FOR F=J+1 TO I :: CALL E(SEG$(B$(F),1,27),H$,C,K):: IF H$="N" THEN 840
1050 NEXT F :: DISPLAY AT(22,1)BEEP:"~~~~~~~~End of File~~~~~~~~~" :: GOTO 1190
1060 DISPLAY AT(24,2)BEEP:"Search String:" :: ACCEPT AT(24,16)SIZE(10):L$ :: DISPLAY AT(24,1):" Searching For:" &L$ :: FOR F=J+1 TO I :: IF POS(SEG$(B$(F),1,10),L$,1)=0 THEN 1080
1070 CALL E("  " &SEG$(B$(F),1,12)&".." &SEG$(B$(F),30,10),H$,C,K):: IF H$="N" THEN 840
1080 NEXT F :: GOTO 1180
1090 IF P$="" THEN K$="Memory" ELSE K$=P$
1100 DISPLAY AT(6,8):"Disks in " &K$:RPT$("~",28):: FOR F=1 TO G :: DISPLAY AT(F+7,1):A$(F):: NEXT F :: DISPLAY AT(F+7,1):RPT$("~",28)
1110 DISPLAY AT(24,2)BEEP:"Disk Name:" :: ACCEPT AT(24,12)SIZE(10):L$ :: IF L$="" THEN 840 ELSE DISPLAY AT(24,2)BEEP:" Searching For:" &L$
1120 FOR F=1 TO G :: IF SEG$(A$(F),1,LEN(L$))<>L$ THEN 1140
1130 DISPLAY AT(1,1)ERASE ALL:A$(F):: CALL C :: L$=SEG$(A$(F),1,10):: DISPLAY AT(22,1):RPT$("~",28):: GOTO 1150
1140 NEXT F :: DISPLAY AT(24,2):" Cannot Locate:" &L$ :: FOR F=1 TO 300 :: NEXT F :: GOTO 1110
1150 FOR F=J+1 TO I :: IF SEG$(B$(F),30,10)<>L$ THEN 1170
1160 CALL E(SEG$(B$(F),1,27),H$,C,K):: IF H$="N" THEN 840
1170 NEXT F
1180 DISPLAY AT(22,1)BEEP:"~~~~~~~End of Search~~~~~~~~"
1190 DISPLAY AT(24,1):" Press any Key to Continue" :: CALL KEY(0,A,B):: IF B=0 THEN 1190 ELSE 840
1200 DISPLAY AT(13,1):"~~~~~~~Printer Options~~~~~~" :: CALL A(17,22):: DISPLAY AT(17,5):"1.Print by filename" :: DISPLAY AT(18,5):"2.Print by diskname"
1210 DISPLAY AT(19,5):"3.Return to main"
1220 DISPLAY AT(24,2)BEEP:"Choice: 1" :: ACCEPT AT(24,10)VALIDATE("123")SIZE(-1):H$ :: IF H$="3" THEN 870 ELSE DISPLAY AT(16+VAL(H$),4)SIZE(1):">"
1230 IF L=1 THEN DISPLAY AT(24,2):"Same Device? (Y/N/A): Y" :: ACCEPT AT(24,24)VALIDATE("YNA")SIZE(-1):L$ :: IF L$="A" THEN DISPLAY AT(16+VAL(H$),4)SIZE(1):" " :: GOTO 1220
1240 IF L$="Y" THEN 1260
1250 DISPLAY AT(24,2):"Printer Device Name:" :: ACCEPT AT(24,22)VALIDATE("PIORS232/1TP")BEEP:S$
1260 ON ERROR 1250 :: L=1 :: OPEN #2:S$
1270 ON ERROR STOP :: PRINT #2:CHR$(27)&CHR$(68)&CHR$(41)&CHR$(0)
1280 PRINT #2:CHR$(14);TAB(12);RPT$("-",21):: PRINT #2:CHR$(14);TAB(11);"- D I S K R U N N E R -" :: IF Q$="" THEN L$="CURRENT DATE:" &G$ ELSE L$=" LAST UPDATE:" &Q$
1290 PRINT #2:CHR$(14);TAB(09);RPT$("-",27): :TAB(27);"LIBRARY FILENAME: " &P$: :TAB(29);L$ :: PRINT #2:CHR$(10)&CHR$(10):: L$="FILENAME    SIZE   TYPE   P  DISK" :: IF H$="1" THEN 1360
1300 A=INT(G/2+.5):: FOR B=1 TO A
1320 PRINT #2:CHR$(27)&"E" &"    " &A$(B)&CHR$(9)&"    " &A$(B+A):: PRINT #2:" " :: PRINT #2:L$&CHR$(9)&L$ :: PRINT #2:RPT$("-",80)&CHR$(27)&"F" :: C,D=0 :: FOR F=J+1 TO I
1330 IF SEG$(B$(F),30,10)=SEG$(A$(B),1,10)THEN C=C+1 :: C$(C)=B$(F)
1340 IF SEG$(B$(F),30,10)=SEG$(A$(B+A),1,10)THEN D=D+1 :: D$(D)=B$(F)
1350 NEXT F :: FOR F=1 TO MAX(C,D):: PRINT #2:C$(F)&CHR$(9)&D$(F):: NEXT F :: FOR F=1 TO 5 :: PRINT #2:CHR$(10):: NEXT F :: FOR F=1 TO MAX(C,D):: C$(F),D$(F)="" :: NEXT F :: NEXT B :: CLOSE #2 :: GOTO 840
1360 PRINT #2:CHR$(27)&"E";TAB(19);"DISKS" &CHR$(9)&"             DISKS" :: PRINT #2:TAB(6);RPT$("-",28)&CHR$(9)&"   " &RPT$("-",28):: F=INT(G/2+.5):: FOR B=1 TO F
1370 PRINT #2:TAB(6);A$(B)&CHR$(9)&"   " &A$(B+F):: NEXT B :: PRINT #2:TAB(6);RPT$("-",28)&CHR$(9)&"   " &RPT$("-",28)
1380 PRINT #2:CHR$(10)&CHR$(10)&"          " &"NUMBER OF DISKS:" &STR$(G)&CHR$(9)&"        " &"NUMBER OF FILES:" &STR$(I-J):: PRINT #2:CHR$(10)&CHR$(10):: PRINT #2:L$&CHR$(9)&L$
1390 PRINT #2:RPT$("-",80)&CHR$(27)&"F" :: K=0 :: C=INT((I-(J+1))/2):: F=C+(J+1):: FOR B=J+1 TO F :: K=K+1 :: PRINT #2:B$(B)&CHR$(9)&B$(B+F):: NEXT B :: PRINT #2:CHR$(27)&"E":RPT$("-",80)&CHR$(27)&"F"
1400 FOR F=1 TO 5 :: PRINT #2:CHR$(10):: NEXT F :: CLOSE #2 :: GOTO 840
1410 DISPLAY AT(24,1):" Are You Sure? (Y/N): Y" :: ACCEPT AT(24,23)VALIDATE("YN")SIZE(-1)BEEP:H$ :: IF H$="N" THEN DISPLAY AT(21,4)SIZE(1):" " :: GOTO 890
1420 CALL A(15,24):: DISPLAY AT(18,4)BEEP:"ì ì Purging Memory ì ì" :: C=G :: FOR F=1 TO G :: A$(F)="" :: C=C-1 :: CALL SOUND(-99,990,12):: DISPLAY AT(11,3)SIZE(9):"Disks:" &STR$(C):: NEXT F
1430 C=I :: FOR F=1 TO I :: C=C-1 :: B$(F)="" :: CALL SOUND(-99,990,12):: DISPLAY AT(11,19)SIZE(9):"Files:" &STR$(C):: NEXT F :: I,G,J=0 :: Q$,P$="" :: DISPLAY AT(6,2)SIZE(28):" "
1440 DISPLAY AT(8,4):"Current Date:" &G$ :: GOTO 320
1450 SUB A(A,B):: FOR C=A TO B :: DISPLAY AT(C,2)SIZE(22):" " :: NEXT C :: SUBEND
1460 SUB B(A,A$):: A$=STR$(A):: B=LEN(A$):: IF B=1 THEN A$="00" &A$ ELSE IF B=2 THEN A$="0" &A$
1470 SUBEND
1480 SUB C :: DISPLAY AT(4,1):" Filename    Size   Type   P" :: DISPLAY AT(5,1):RPT$("~",28):: SUBEND
1490 SUB D(A$(),A,B$):: DISPLAY AT(24,1)BEEP:"   Status: Sorting " &B$ :: B=1
1500 B=2*B :: IF B<=A THEN 1500
1510 B=INT(B/2):: IF B=0 THEN 1560
1520 FOR C=1 TO A-B :: D=C
1530 E=D+B :: IF A$(D)<=A$(E)THEN 1550
1540 C$=A$(D):: A$(D)=A$(E):: A$(E)=C$ :: D=D-B :: IF D>0 THEN 1530
1550 NEXT C :: GOTO 1510
1560 SUBEND
1570 SUB E(A$,B$,A,B):: IF A=1 THEN A=0 :: GOTO 1590
1580 B=B+1 :: DISPLAY AT(B,1):" " &A$ :: IF B>20 THEN A=1 :: SUBEXIT ELSE SUBEXIT
1590 DISPLAY AT(24,2)BEEP:"Continue Listing? (Y/N): Y" :: ACCEPT AT(24,27)VALIDATE("YN")SIZE(-1):B$ :: DISPLAY AT(24,1)SIZE(28):" " :: IF B$="N" THEN SUBEXIT
1600 B=5 :: CALL HCHAR(6,1,32,512):: GOTO 1580
1610 SUBEND

 

 

 

 

 WEB99 DANG ? ? ?

 

 

 

 

 

This could be modified by adding tipi clock information.

[apersson850]

It's very obvious that a lot of other people have seen the same benefit from this as I did.

[+Schmitzi]

For me today, WEB99 is the biggest multi-disk-catalog.

It knows all my hundreds of thousands DSKs and more.

Really all contents and much much more. Just in milliseconds.

And it generates TIFILES per one click into the Classic99-folder (or any other).

(And this in it´s beta state)

 

[Ed in SoDak]

Looking into my buggy Catman program, I discovered it didn't run right on the real thing either. I've been busy finding the problems and now have it updated so it works under Classic99. So happy to finally have this running more as I originally intended. (Thanks @Tursi!)

 

I added support for drives 0-9, CLIP for printer support and maybe a few other tweaks. I did not add input checking if running on a TI and you select a drive number not supported by the controller card. Maybe next time around. The program's error-handling should still keep it from crashing. Thanks to all who at least downloaded the older versions. Now try THIS one, LOL.  Single file is in TIFILES format, DSK is in V9T9, same otherwise.

 

CAT215A CATMAN2022.dsk