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