home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
CPM
/
DATABASE
/
KEEPTRAK.LBR
/
K-TSORT.BZS
/
K-TSORT.BAS
Wrap
BASIC Source File
|
2000-06-30
|
8KB
|
228 lines
10 ' **********************************************
20 ' **********************************************
30 ' *** K-TSORT ***
40 ' *** PART OF A CLUB MEMBERSHIP ***
50 ' *** FILING SYSTEM CALLED KEEP-TRAK ***
60 ' *** ***
70 ' *** ***
80 ' *** WRITTEN IN MICROSOFT BASIC-80 REV.5.21 ***
90 ' *** ***
100 ' *** (C) COPYRIGHT 1983 BY HARVEY G. LORD ***
110 ' *** ***
120 ' *** DO NOT ATTEMPT TO RUN THIS PROGRAM ***
130 ' *** ALONE. IT IS CHAINED FROM K-TMENU. ***
140 ' **********************************************
150 ' **********************************************
160 '
170 ON ERROR GOTO 20000 ' Error traps (Ch. 10)
180 COMMON CL$,RECORDTOTAL ' Pass variables to programs (Ch. 11)
190 ' Define cursor control (Ch. 8)
200 DEF FNCUR$(V,H) = CHR$(27)+CHR$(61)+CHR$(32+V)+CHR$(32+H)
210 DEF FNCLLN$ = CHR$(27) + CHR$(84) ' Define clear line from cursor (Ch. 8)
220 '
230 '
240 '
250 '
260 '
270 ' Check for B:K-T.LST's existence. If it's not there, to error trap
280 OPEN "I",#1,"B:K-T.LST":CLOSE#1
290 '
300 '
310 '
320 '
330 '
340 ' The rest of the program's executed only if B:K-T.LST exists.
350 '
360 '
370 '
380 '
390 '
1000 ' Printer warning
1010 '
1020 PRINT CL$ ' Clear screen (Ch. 7)
1030 PRINT:PRINT ' 2 blank lines
1040 PRINT TAB(11);"*** SORTING PROGRAM ***"
1050 PRINT:PRINT:PRINT ' 3 blank lines
1060 PRINT "This program takes a long time to run and requires"
1070 PRINT "a printer to see its results. If you don't have"
1080 PRINT "a printer, this program won't do anything at all."
1090 PRINT:PRINT ' 2 blank lines
1100 PRINT "Do you want to run this program? Y = YES N = NO"
1110 CHOICE$ = INKEY$:IF CHOICE$ = "" THEN 1110 ' Waiting for keypress (Ch. 7)
1120 IF CHOICE$ = "Y" OR CHOICE$ = "y" THEN 2000
1130 IF CHOICE$ = "N" OR CHOICE$ = "n" THEN 8000
1140 '
1150 ' Catch illegal choices
1160 '
1170 PRINT CHR$(7); ' Beep (Ch. 10)
1180 FOR COUNT = 1 TO 3 ' Blink "Please choose" (Ch. 8)
1190 PRINT FNCUR$(16,3);FNCLLN$ ' Clear line
1200 FOR PAUSE = 1 TO 100:NEXT PAUSE ' Count silently to 100
1210 PRINT FNCUR$(16,3);"Please press 'Y' for 'YES' or 'N' for 'NO.'"
1220 FOR PAUSE = 1 TO 100:NEXT PAUSE ' Count silently to 100
1230 NEXT COUNT
1240 GOTO 1110 ' Try for correct choice
1250 '
1260 '
1270 '
1280 '
1290 '
2000 DIM WHOLELIST$(RECORDTOTAL,8) ' Dimension the array (Ch. 12)
2010 '
2020 '
2030 '
2040 '
2050 '
3000 ' Load array into memory
3010 '
3020 PRINT CL$ ' Clear screen (Ch. 7)
3030 PRINT:PRINT TAB(9);"Loading membership list into memory."
3040 OPEN "I",#1,"B:K-T.LST" ' OPEN B:K-T.LST for reading
3050 FOR MEMBER = 1 TO RECORDTOTAL ' Load each record into array
3060 FOR ENTRY = 1 TO 8 ' Load each field into array
3070 INPUT #1,WHOLELIST$(MEMBER,ENTRY)
3080 NEXT ENTRY
3090 NEXT MEMBER
3100 CLOSE #1
3110 PRINT:PRINT TAB(13);"Membership list is in memory."
3120 '
3130 '
3140 '
3150 '
3160 '
4000 ' Sort on last names
4010 '
4020 PRINT:PRINT TAB(17);"Begin last name sort."
4030 PRINT TAB(10);"Please wait. Sorting takes awhile."
4040 SIGNAL = 1 ' Sort at least once
4050 WHILE SIGNAL ' Begin sorting
4060 SIGNAL = 0 ' No swaps yet
4070 FOR MEMBER = 1 TO (RECORDTOTAL - 1)
4080 IF WHOLELIST$(MEMBER,2) <= WHOLELIST$(MEMBER + 1,2) THEN 4130 ' Last names in order?
4090 FOR ENTRY = 1 TO 8 ' Swap records
4100 SWAP WHOLELIST$(MEMBER,ENTRY),WHOLELIST$(MEMBER + 1,ENTRY)
4110 NEXT ENTRY
4120 SIGNAL = 1 ' Swap has been made
4130 NEXT MEMBER ' Check next record
4140 WEND ' End of last name bubble sort
4150 PRINT:PRINT TAB(14);"Done sorting by last names."
4160 '
4170 '
4180 '
4190 '
4200 '
5000 ' Sort on first names
5010 '
5020 PRINT:PRINT TAB(16);"Begin first name sort."
5030 PRINT TAB(8);"Please wait. This is faster than the"
5040 PRINT TAB(8);"last sort, but it still takes awhile."
5050 SIGNAL = 1
5060 WHILE SIGNAL
5070 SIGNAL = 0
5080 FOR MEMBER = 1 TO (RECORDTOTAL - 1)
5090 IF WHOLELIST$(MEMBER,2) <> WHOLELIST$(MEMBER + 1,2) THEN 5150
5100 IF WHOLELIST$(MEMBER,1) <= WHOLELIST$(MEMBER + 1,1) THEN 5150
5110 FOR ENTRY = 1 TO 8
5120 SWAP WHOLELIST$(MEMBER,ENTRY),WHOLELIST$(MEMBER + 1,ENTRY)
5130 NEXT ENTRY
5140 SIGNAL = 1
5150 NEXT MEMBER
5160 WEND ' End of first name bubble sort
5170 PRINT:PRINT TAB(18);"Whole list sorted."
5180 '
5190 '
5200 '
5210 '
5220 '
6000 ' Print sorted club membership list.
6010 '
6020 PRINT:PRINT TAB(7);"Please plug in and hook up your printer."
6030 PRINT TAB(21);"Load paper."
6040 PRINT TAB(10);"Press any key when you're ready"
6050 PRINT TAB(13);"to print the sorted list."
6060 IF INKEY$ = "" THEN 6060 ' Waiting for keypress (Ch. 7)
6070 FOR MEMBER = 1 TO RECORDTOTAL ' Print whole membership list
6080 LPRINT WHOLELIST$(MEMBER,1);" ";WHOLELIST$(MEMBER,2);TAB(20);"Dues Paid: $";WHOLELIST$(MEMBER,8) ' 1st name, Last name, Dues
6090 LPRINT WHOLELIST$(MEMBER,3) ' Address
6100 LPRINT WHOLELIST$(MEMBER,4);" ";WHOLELIST$(MEMBER,5);" ";WHOLELIST$(MEMBER,6) ' City, State, ZIP
6110 LPRINT "Telephone: ";WHOLELIST$(MEMBER,7) ' Phone #
6120 LPRINT
6130 NEXT MEMBER
6140 '
6150 '
6160 '
6170 '
6180 '
7000 ' Print members (on mailing labels) who haven't paid their dues.
7010 '
7020 PRINT:PRINT ' 2 blank lines
7030 PRINT TAB(3);"A list of members whose dues haven't been paid"
7040 PRINT TAB(3);"will be printed after you load mailing labels"
7050 PRINT TAB(20);"and press any key."
7060 IF INKEY$ = "" THEN 7060 ' Waiting for keypress (ch. 7)
7070 FOR MEMBER = 1 TO RECORDTOTAL ' Check whole membership list
7080 IF VAL(WHOLELIST$(MEMBER,8)) <> 0 THEN 7130 ' If member paid, don't print
7090 LPRINT WHOLELIST$(MEMBER,1);" ";WHOLELIST$(MEMBER,2)
7100 LPRINT WHOLELIST$(MEMBER,3)
7110 LPRINT WHOLELIST$(MEMBER,4);", ";WHOLELIST$(MEMBER,5);" ";WHOLELIST$(MEMBER,6)
7120 LPRINT:LPRINT:LPRINT
7130 NEXT MEMBER
7140 PRINT:PRINT ' 2 blank lines
7150 PRINT TAB(4);"Everything's in order. This program's done."
7160 '
7170 '
7180 '
7190 '
7200 '
8000 ' Return to MAIN MENU
8010 '
8020 PRINT:PRINT ' 2 blank lines
8030 PRINT TAB(15);"Returning to MAIN MENU."
8040 CHAIN "K-TMENU",270 ' Ch. 11
8050 '
8060 '
8070 '
8080 '
8090 '
20000 ' ** Error Traps ** (Ch. 10)
20010 '
20020 IF ERR <> 53 AND ERL <> 280 THEN 20220 ' Trap File not Found in line 280 (Ch. 10)
20030 PRINT CHR$(7) ' Beep (Ch. 10)
20040 PRINT CL$ ' Clear screen
20050 PRINT
20060 PRINT TAB(16);"*** Error ***"
20070 PRINT:PRINT:PRINT:PRINT ' 4 blank lines
20080 PRINT "There is no membership list on the diskette in B:."
20090 PRINT:PRINT:PRINT:PRINT ' 4 blank lines
20100 PRINT TAB(10);"You can't sort or print a list"
20110 PRINT TAB(15);"that doesn't exist."
20120 PRINT:PRINT:PRINT:PRINT:PRINT ' 5 blank lines
20130 PRINT "Please press any key to return to the MAIN MENU."
20140 IF INKEY$ = "" THEN 20140
20150 RESUME 8000 ' Return to MAIN MENU
20160 '
20170 '
20180 '
20190 '
20200 '
20210 '
20220 ' Catch-all Error Trap (Ch. 10)
20230 '
20240 PRINT CHR$(7) ' Beep
20250 PRINT CL$ ' Clear screen
20260 PRINT:PRINT ' 2 blank lines
20270 PRINT "You have generated error number";ERR
20280 PRINT "on line number";ERL;"."
20290 PRINT
20300 PRINT "Please write this fact down. Also write down ex-"
20310 PRINT "actly what you did before this error took place."
20320 PRINT
20330 PRINT "Ask a BASIC programmer what the error means and"
20340 PRINT "how to correct it."
20350 PRINT:PRINT ' 2 blank lines
20360 PRINT "Please press any key to return to the MAIN MENU."
20370 IF INKEY$ = "" THEN 20370 ' Waiting for keypress (Ch. 7)
20380 RESUME 8000 ' Return to MAIN MENU
o the MAIN MENU."
20370 IF INKEY$ = "" THEN 20370 ' Waiting for keypress (Ch. 7)
20380 R