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
BASIC Source File  |  2000-06-30  |  8KB  |  228 lines
  1. 10  ' **********************************************
  2. 20  ' **********************************************
  3. 30  ' ***               K-TSORT             ***
  4. 40  ' ***      PART OF A CLUB MEMBERSHIP     ***
  5. 50  ' ***    FILING SYSTEM CALLED KEEP-TRAK     ***
  6. 60  ' ***                     ***
  7. 70  ' ***                                        ***
  8. 80  ' *** WRITTEN IN MICROSOFT BASIC-80 REV.5.21 ***
  9. 90  ' ***                                        ***
  10. 100 ' ***  (C) COPYRIGHT 1983 BY HARVEY G. LORD  ***
  11. 110 ' ***                                        ***
  12. 120 ' ***   DO NOT ATTEMPT TO RUN THIS PROGRAM   ***
  13. 130 ' ***   ALONE. IT IS CHAINED FROM K-TMENU.   ***
  14. 140 ' **********************************************
  15. 150 ' **********************************************
  16. 160 '
  17. 170 ON ERROR GOTO 20000                ' Error traps (Ch. 10)
  18. 180 COMMON CL$,RECORDTOTAL            ' Pass variables to programs (Ch. 11)
  19. 190 ' Define cursor control (Ch. 8)
  20. 200 DEF FNCUR$(V,H) = CHR$(27)+CHR$(61)+CHR$(32+V)+CHR$(32+H)
  21. 210 DEF FNCLLN$ = CHR$(27) + CHR$(84)         ' Define clear line from cursor (Ch. 8)
  22. 220 '
  23. 230 '
  24. 240 '
  25. 250 '
  26. 260 '
  27. 270 ' Check for B:K-T.LST's existence.  If it's not there, to error trap
  28. 280 OPEN "I",#1,"B:K-T.LST":CLOSE#1
  29. 290 '
  30. 300 '
  31. 310 '
  32. 320 '
  33. 330 '
  34. 340 ' The rest of the program's executed only if B:K-T.LST exists.
  35. 350 '
  36. 360 '
  37. 370 '
  38. 380 '
  39. 390 '
  40. 1000 ' Printer warning
  41. 1010 '
  42. 1020 PRINT CL$                    ' Clear screen (Ch. 7)
  43. 1030 PRINT:PRINT                ' 2 blank lines
  44. 1040 PRINT TAB(11);"***    SORTING PROGRAM    ***"
  45. 1050 PRINT:PRINT:PRINT                ' 3 blank lines
  46. 1060 PRINT "This program takes a long time to run and requires"
  47. 1070 PRINT "a printer  to see its results.   If you don't have"
  48. 1080 PRINT "a printer, this program won't do anything at all."
  49. 1090 PRINT:PRINT                ' 2 blank lines
  50. 1100 PRINT "Do you want to run this program?  Y = YES  N = NO"
  51. 1110 CHOICE$ = INKEY$:IF CHOICE$ = "" THEN 1110 ' Waiting for keypress (Ch. 7)
  52. 1120 IF CHOICE$ = "Y" OR CHOICE$ = "y" THEN 2000
  53. 1130 IF CHOICE$ = "N" OR CHOICE$ = "n" THEN 8000
  54. 1140 '
  55. 1150 ' Catch illegal choices
  56. 1160 '
  57. 1170 PRINT CHR$(7);                ' Beep (Ch. 10)
  58. 1180 FOR COUNT = 1 TO 3                ' Blink "Please choose" (Ch. 8)
  59. 1190    PRINT FNCUR$(16,3);FNCLLN$        ' Clear line
  60. 1200    FOR PAUSE = 1 TO 100:NEXT PAUSE        ' Count silently to 100
  61. 1210    PRINT FNCUR$(16,3);"Please press 'Y' for 'YES' or 'N' for 'NO.'"
  62. 1220    FOR PAUSE = 1 TO 100:NEXT PAUSE        ' Count silently to 100
  63. 1230 NEXT COUNT
  64. 1240 GOTO 1110                    ' Try for correct choice
  65. 1250 '
  66. 1260 '
  67. 1270 '
  68. 1280 '
  69. 1290 '
  70. 2000 DIM WHOLELIST$(RECORDTOTAL,8)        ' Dimension the array (Ch. 12)
  71. 2010 '
  72. 2020 '
  73. 2030 '
  74. 2040 '
  75. 2050 '
  76. 3000 ' Load array into memory
  77. 3010 '
  78. 3020 PRINT CL$                    ' Clear screen (Ch. 7)
  79. 3030 PRINT:PRINT TAB(9);"Loading membership list into memory."
  80. 3040 OPEN "I",#1,"B:K-T.LST"            ' OPEN B:K-T.LST for reading
  81. 3050 FOR MEMBER = 1 TO RECORDTOTAL        ' Load each record into array
  82. 3060       FOR ENTRY = 1 TO 8            ' Load each field into array
  83. 3070            INPUT #1,WHOLELIST$(MEMBER,ENTRY)
  84. 3080       NEXT ENTRY
  85. 3090 NEXT MEMBER
  86. 3100 CLOSE #1
  87. 3110 PRINT:PRINT TAB(13);"Membership list is in memory."
  88. 3120 '
  89. 3130 '
  90. 3140 '
  91. 3150 '
  92. 3160 '
  93. 4000 ' Sort on last names
  94. 4010 '
  95. 4020 PRINT:PRINT TAB(17);"Begin last name sort."
  96. 4030 PRINT TAB(10);"Please wait.  Sorting takes awhile."
  97. 4040 SIGNAL = 1                    ' Sort at least once
  98. 4050 WHILE SIGNAL                ' Begin sorting
  99. 4060    SIGNAL = 0                ' No swaps yet
  100. 4070    FOR MEMBER = 1 TO (RECORDTOTAL - 1)
  101. 4080           IF WHOLELIST$(MEMBER,2) <= WHOLELIST$(MEMBER + 1,2) THEN 4130 ' Last names in order?
  102. 4090           FOR ENTRY = 1 TO 8        ' Swap records
  103. 4100                SWAP WHOLELIST$(MEMBER,ENTRY),WHOLELIST$(MEMBER + 1,ENTRY)
  104. 4110           NEXT ENTRY
  105. 4120      SIGNAL = 1                ' Swap has been made
  106. 4130    NEXT MEMBER                ' Check next record
  107. 4140 WEND                    ' End of last name bubble sort
  108. 4150 PRINT:PRINT TAB(14);"Done sorting by last names."
  109. 4160 '
  110. 4170 '
  111. 4180 '
  112. 4190 '
  113. 4200 '
  114. 5000 ' Sort on first names
  115. 5010 '
  116. 5020 PRINT:PRINT TAB(16);"Begin first name sort."
  117. 5030 PRINT TAB(8);"Please wait.  This is faster than the"
  118. 5040 PRINT TAB(8);"last sort, but it still takes awhile."
  119. 5050 SIGNAL = 1
  120. 5060 WHILE SIGNAL
  121. 5070    SIGNAL = 0
  122. 5080    FOR MEMBER = 1 TO (RECORDTOTAL - 1)
  123. 5090            IF WHOLELIST$(MEMBER,2) <> WHOLELIST$(MEMBER + 1,2) THEN 5150
  124. 5100            IF WHOLELIST$(MEMBER,1) <= WHOLELIST$(MEMBER + 1,1) THEN 5150
  125. 5110            FOR ENTRY = 1 TO 8
  126. 5120                SWAP WHOLELIST$(MEMBER,ENTRY),WHOLELIST$(MEMBER + 1,ENTRY)
  127. 5130           NEXT ENTRY
  128. 5140      SIGNAL = 1
  129. 5150    NEXT MEMBER
  130. 5160 WEND                    ' End of first name bubble sort
  131. 5170 PRINT:PRINT TAB(18);"Whole list sorted."
  132. 5180 '
  133. 5190 '
  134. 5200 '
  135. 5210 '
  136. 5220 '
  137. 6000 ' Print sorted club membership list.
  138. 6010 '
  139. 6020 PRINT:PRINT TAB(7);"Please plug in and hook up your printer."
  140. 6030 PRINT TAB(21);"Load paper."
  141. 6040 PRINT TAB(10);"Press any key when you're ready"
  142. 6050 PRINT TAB(13);"to print the sorted list."
  143. 6060 IF INKEY$ = "" THEN 6060            ' Waiting for keypress (Ch. 7)
  144. 6070 FOR MEMBER = 1 TO RECORDTOTAL        ' Print whole membership list
  145. 6080       LPRINT WHOLELIST$(MEMBER,1);" ";WHOLELIST$(MEMBER,2);TAB(20);"Dues Paid:  $";WHOLELIST$(MEMBER,8) ' 1st name, Last name, Dues
  146. 6090       LPRINT WHOLELIST$(MEMBER,3)        ' Address
  147. 6100       LPRINT WHOLELIST$(MEMBER,4);" ";WHOLELIST$(MEMBER,5);"  ";WHOLELIST$(MEMBER,6) ' City, State, ZIP
  148. 6110       LPRINT "Telephone:  ";WHOLELIST$(MEMBER,7) ' Phone #
  149. 6120       LPRINT
  150. 6130 NEXT MEMBER
  151. 6140 '
  152. 6150 '
  153. 6160 '
  154. 6170 '
  155. 6180 '
  156. 7000 ' Print members (on mailing labels) who haven't paid their dues.
  157. 7010 '
  158. 7020 PRINT:PRINT                ' 2 blank lines
  159. 7030 PRINT TAB(3);"A list of members whose dues haven't been paid"
  160. 7040 PRINT TAB(3);"will be printed  after you load mailing labels"
  161. 7050 PRINT TAB(20);"and press any key."
  162. 7060 IF INKEY$ = "" THEN 7060            ' Waiting for keypress (ch. 7)
  163. 7070 FOR MEMBER = 1 TO RECORDTOTAL        ' Check whole membership list
  164. 7080       IF VAL(WHOLELIST$(MEMBER,8)) <> 0 THEN 7130 ' If member paid, don't print
  165. 7090       LPRINT WHOLELIST$(MEMBER,1);" ";WHOLELIST$(MEMBER,2)
  166. 7100       LPRINT WHOLELIST$(MEMBER,3)
  167. 7110       LPRINT WHOLELIST$(MEMBER,4);", ";WHOLELIST$(MEMBER,5);"  ";WHOLELIST$(MEMBER,6)
  168. 7120       LPRINT:LPRINT:LPRINT
  169. 7130 NEXT MEMBER
  170. 7140 PRINT:PRINT                ' 2 blank lines
  171. 7150 PRINT TAB(4);"Everything's in order.  This program's done."
  172. 7160 '
  173. 7170 '
  174. 7180 '
  175. 7190 '
  176. 7200 '
  177. 8000 ' Return to MAIN MENU
  178. 8010 '
  179. 8020 PRINT:PRINT                ' 2 blank lines
  180. 8030 PRINT TAB(15);"Returning to MAIN MENU."
  181. 8040 CHAIN "K-TMENU",270            ' Ch. 11
  182. 8050 '
  183. 8060 '
  184. 8070 '
  185. 8080 '
  186. 8090 '
  187. 20000 ' ** Error Traps ** (Ch. 10)
  188. 20010 '
  189. 20020 IF ERR <> 53 AND ERL <> 280 THEN 20220    ' Trap File not Found in line 280 (Ch. 10)
  190. 20030 PRINT CHR$(7)                ' Beep (Ch. 10)
  191. 20040 PRINT CL$                    ' Clear screen
  192. 20050 PRINT
  193. 20060 PRINT TAB(16);"***   Error   ***"
  194. 20070 PRINT:PRINT:PRINT:PRINT            ' 4 blank lines
  195. 20080 PRINT "There is no membership list on the diskette in B:."
  196. 20090 PRINT:PRINT:PRINT:PRINT            ' 4 blank lines
  197. 20100 PRINT TAB(10);"You can't sort or print a list"
  198. 20110 PRINT TAB(15);"that doesn't exist."
  199. 20120 PRINT:PRINT:PRINT:PRINT:PRINT                ' 5 blank lines
  200. 20130 PRINT "Please press any key to return to the MAIN MENU."
  201. 20140 IF INKEY$ = "" THEN 20140
  202. 20150 RESUME 8000                ' Return to MAIN MENU
  203. 20160 '
  204. 20170 '
  205. 20180 '
  206. 20190 '
  207. 20200 '
  208. 20210 '
  209. 20220 ' Catch-all Error Trap (Ch. 10)
  210. 20230 '
  211. 20240 PRINT CHR$(7)            ' Beep
  212. 20250 PRINT CL$                ' Clear screen
  213. 20260 PRINT:PRINT            ' 2 blank lines
  214. 20270 PRINT "You have generated error number";ERR
  215. 20280 PRINT "on line number";ERL;"."
  216. 20290 PRINT
  217. 20300 PRINT "Please write this fact down.  Also write down ex-"
  218. 20310 PRINT "actly what you did before this error took place."
  219. 20320 PRINT
  220. 20330 PRINT "Ask a BASIC  programmer what the error means and" 
  221. 20340 PRINT "how to correct it."
  222. 20350 PRINT:PRINT            ' 2 blank lines
  223. 20360 PRINT "Please press any key to return to the MAIN MENU."
  224. 20370 IF INKEY$ = "" THEN 20370        ' Waiting for keypress (Ch. 7)
  225. 20380 RESUME 8000            ' Return to MAIN MENU
  226. o the MAIN MENU."
  227. 20370 IF INKEY$ = "" THEN 20370        ' Waiting for keypress (Ch. 7)
  228. 20380 R