home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol218 / menu.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1986-11-30  |  8.8 KB  |  271 lines
  1. 100  REM MENU Program
  2. 110  REM Menu of the available Genealogy Programs.
  3. 120  REM By:  Melvin O. Duke.  Last Updated 26 February 1986.
  4. 200  REM Screen Definitions
  5. 210  S1 = 0      'Set Text Mode
  6. 220  S2 = 1      'Enable Color
  7. 230  S3 = 0      'Active Page
  8. 240  S4 = 0      'Visual Page
  9. 250  WIDTH "scrn:",80
  10. 260  SCREEN S1, S2, S3, S4
  11. 300  REM Color Definitions
  12. 310  K = 0       'blacK
  13. 320  N = 1       'blue (Navy or uNderline)
  14. 330  G = 2       'Green
  15. 340  B = 3       'cyan (light Blue)
  16. 350  R = 4       'Red
  17. 360  P = 5       'magenta (Purple)
  18. 370  O = 6       'brown (Orange)
  19. 380  W = 7       'White
  20. 400  REM Disk Definitions
  21. 410  DD.MENU$   = "a:"
  22. 420  DD.VERI$   = "a:"
  23. 430  DD.PROG$   = "a:"
  24. 440  DD.PERS$   = "a:"
  25. 450  DD.MARR$   = "a:"
  26. 460  DD.ORD$    = "a:"
  27. 470  DD.PCIDX$  = "a:"
  28. 480  DD.MARIDX$ = "a:"
  29. 500  REM Printer Definitions
  30. 510  FORM.FEED$    = CHR$(12)
  31. 520  PAP.SENS.ON$  = CHR$(27)+"9"
  32. 530  PAP.SENS.OFF$ = CHR$(27)+"8"
  33. 540  PAP.LONG$     = CHR$(27)+"C"+CHR$(66)
  34. 550  PAP.SHORT$    = CHR$(27)+"C"+CHR$(51)
  35. 560  COMPR.ON$     = CHR$(15)
  36. 570  COMPR.OFF$    = CHR$(18)
  37. 580  BOLD.ON$      = CHR$(27)+"E"
  38. 590  BOLD.OFF$     = CHR$(27)+"F"
  39. 600  REM Maximums
  40. 610  MAX.PER = 500
  41. 620  MAX.MAR = 200
  42. 630  OLD.MAX.PER = 0
  43. 640  OLD.MAX.MAR = 0
  44. 650  MAX.GEN = 4
  45. 660  MAX.LINES = 58
  46. 670  CHART.NOS$ = "n"
  47. 700  REM Titles
  48. 710  TITLE$ = "MENU of Programs in Genealogy"
  49. 720  TITLE$ = TITLE$ + " ON DISPLAY"
  50. 730  VERSION$ = "Version 4.0"
  51. 740  COPY1$ = "Copyright (c) 1983 thru 1986, by:"
  52. 750  COPY2$ = "Melvin O. Duke"
  53. 760  PRICE$ = "$45"
  54. 770  ADDR1$ = "Melvin O. Duke"
  55. 780  ADDR2$ = "P. O. Box 20836"
  56. 790  ADDR3$ = "San Jose, CA  95160"
  57. 800  REM Make sure that BASIC was invoked with /s:256
  58. 810  ON ERROR GOTO 870
  59. 820  OPEN DD.VERI$+"verifile" AS #1 LEN = 256
  60. 830  ON ERROR GOTO 0
  61. 840  FIELD 1, 128 AS DUMY1$, 128 AS DUMY2$
  62. 850  CLOSE #1
  63. 860  GOTO 1000
  64. 870  IF ERR = 5 THEN 880 ELSE ON ERROR GOTO 0 : GOTO 820
  65. 880  REM File Buffer less than 256 bytes
  66. 890  KEY ON : CLS : LOCATE 10,1 : COLOR R,B
  67. 900  PRINT "BASIC must be brought up with /s:256, for Genealogy Records."
  68. 910  PRINT "Program has been Terminated."
  69. 920  PRINT "Enter CONT to return to DOS"
  70. 930  COLOR W,K : STOP
  71. 940  SYSTEM
  72. 1000  REM Produce the first screen
  73. 1010  KEY ON : CLS : KEY OFF
  74. 1020  REM Draw the outer double box
  75. 1030  R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 1300
  76. 1040  REM Find the title location
  77. 1050  TITLE.POS = 40 - INT(LEN(TITLE$)/2)
  78. 1060  REM Draw the title box
  79. 1070  R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 1460
  80. 1080  REM Print the title
  81. 1090  LOCATE 4,TITLE.POS : PRINT TITLE$
  82. 1100  LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
  83. 1110  REM Draw the Contribution box
  84. 1120  R1 = 7 : C1 = 18 : R2 = 17 : C2 = 61 : GOSUB 1300
  85. 1130  REM Request the Contribution
  86. 1140  LOCATE  8,20 : PRINT "If you are using these programs, you are"
  87. 1150  LOCATE  9,21 : PRINT "expected to become a Registered User,"
  88. 1160  LOCATE 10,20 : PRINT "by making a contribution to the author"
  89. 1170  LOCATE 11,23 : PRINT "of the programs ("+PRICE$+" suggested)."
  90. 1180  REM Draw the Mailing Label
  91. 1190  R1 = 12 : C1 = 28 : R2 = 16 : C2 = 52 : GOSUB 1460
  92. 1200  REM Print the Name and Address
  93. 1210  LOCATE 13,40-INT(LEN(ADDR1$)/2) :  PRINT ADDR1$;
  94. 1220  LOCATE 14,40-INT(LEN(ADDR2$)/2) :  PRINT ADDR2$;
  95. 1230  LOCATE 15,40-INT(LEN(ADDR3$)/2) :  PRINT ADDR3$;
  96. 1240  REM Draw the Copyright box
  97. 1250  R1 = 19 : C1 = 21 : R2 = 22 : C2 = 59 : GOSUB 1300
  98. 1260  REM Print the Copyright
  99. 1270  LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
  100. 1280  LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
  101. 1290  GOTO 1620
  102. 1300  REM subroutine to print a double box
  103. 1310  COLOR P
  104. 1320  FOR I = R1 + 1 TO R2 - 1
  105. 1330   LOCATE I, C1 : PRINT CHR$(186);
  106. 1340   LOCATE I, C2 : PRINT CHR$(186);
  107. 1350  NEXT I
  108. 1360  FOR J = C1 + 1 TO C2 - 1
  109. 1370   LOCATE R1, J : PRINT CHR$(205);
  110. 1380   LOCATE R2, J : PRINT CHR$(205);
  111. 1390  NEXT J
  112. 1400   LOCATE R1, C1 : PRINT CHR$(201);
  113. 1410   LOCATE R1, C2 : PRINT CHR$(187);
  114. 1420   LOCATE R2, C1 : PRINT CHR$(200);
  115. 1430   LOCATE R2, C2 : PRINT CHR$(188);
  116. 1440  COLOR W
  117. 1450  RETURN
  118. 1460  REM subroutine to print a single box
  119. 1470  COLOR B
  120. 1480  FOR I = R1 + 1 TO R2 - 1
  121. 1490   LOCATE I, C1 : PRINT CHR$(179);
  122. 1500   LOCATE I, C2 : PRINT CHR$(179);
  123. 1510  NEXT I
  124. 1520  FOR J = C1 + 1 TO C2 - 1
  125. 1530   LOCATE R1, J : PRINT CHR$(196);
  126. 1540   LOCATE R2, J : PRINT CHR$(196);
  127. 1550  NEXT J
  128. 1560   LOCATE R1, C1 : PRINT CHR$(218);
  129. 1570   LOCATE R1, C2 : PRINT CHR$(191);
  130. 1580   LOCATE R2, C1 : PRINT CHR$(192);
  131. 1590   LOCATE R2, C2 : PRINT CHR$(217);
  132. 1600  COLOR W
  133. 1610  RETURN
  134. 1620  REM ask user to press a key to continue
  135. 1630  LOCATE 25,1
  136. 1640  PRINT "Have Program Diskette in place, then press any key to continue.";
  137. 1650  A$ = INKEY$ : IF A$ = "" THEN 1650
  138. 1660  KEY ON : CLS : KEY OFF
  139. 1670  REM MENU Program Starts Here.
  140. 1680  REM Draw the Menu itself.
  141. 1690  REM Draw the Outer Double Box.
  142. 1700  R1 = 1 : C1 = 1 : R2 = 23 : C2 = 79 : GOSUB 1300
  143. 1710  REM Draw the Heading Separator.
  144. 1720  R1 = 3 : C1 = 1 : R2 = 3 : C2 = 79 : GOSUB 2780
  145. 1730  REM Draw the Vertical Separators.
  146. 1740  R1 = 1 : C1 = 6 : R2 = 23 : C2 = 6 : GOSUB 2870
  147. 1750  R1 = 1 : C1 =17 : R2 = 23 : C2 =17 : GOSUB 2870
  148. 1760  REM Attach the intersections
  149. 1770  COLOR P
  150. 1780  LOCATE 3, 6 : PRINT CHR$(197);
  151. 1790  LOCATE 3,17 : PRINT CHR$(197);
  152. 1800  COLOR W,K
  153. 1810  REM Print the content of the menu.
  154. 1820  COLOR K,W
  155. 1830  LOCATE 2,3 : PRINT "No";
  156. 1840  LOCATE 2,8 : PRINT "Name"
  157. 1850  LOCATE 2,19 : PRINT "Function of the Program"
  158. 1860  COLOR W,K
  159. 1870  COLOR K,W : LOCATE  4,3 : PRINT " 1"; : COLOR R,K
  160. 1880  LOCATE  4,  8 : PRINT "CREATPER";
  161. 1890  LOCATE  4, 19 : PRINT "Creates (FORMATS) a Persons File.";
  162. 1900  COLOR K,W : LOCATE  5,3 : PRINT " 2"; : COLOR R,K
  163. 1910  LOCATE  5,  8 : PRINT "CREATMAR";
  164. 1920  LOCATE  5, 19 : PRINT "Creates (FORMATS) a Marriages File.";
  165. 1930  IF DD.ORD$ = "no" THEN 1970
  166. 1940  COLOR K,W : LOCATE  6,3 : PRINT " 3"; : COLOR R,K
  167. 1950  LOCATE  6,  8 : PRINT "CREATORD";
  168. 1960  LOCATE  6, 19 : PRINT "Creates (FORMATS) an Ordinances File.";
  169. 1970  COLOR K,W : LOCATE  7,3 : PRINT " 4"; : COLOR G,K
  170. 1980  LOCATE  7,  8 : PRINT "UPDATPER";
  171. 1990  LOCATE  7, 19 : PRINT "Updates Information in the Persons File."
  172. 2000  COLOR K,W : LOCATE  8,3 : PRINT " 5"; : COLOR G,K
  173. 2010  LOCATE  8,  8 : PRINT "UPDATMAR";
  174. 2020  LOCATE  8, 19 : PRINT "Updates Information in the Marriages File."
  175. 2030  IF DD.ORD$ = "no" THEN 2070
  176. 2040  COLOR K,W : LOCATE  9,3 : PRINT " 6"; : COLOR G,K
  177. 2050  LOCATE  9,  8 : PRINT "UPDATORD";
  178. 2060  LOCATE  9, 19 : PRINT "Updates Information in the Ordinances File."
  179. 2070  COLOR K,W : LOCATE 10,3 : PRINT " 7"; : COLOR R,K
  180. 2080  LOCATE 10,  8 : PRINT "INDEXPC ";
  181. 2090  LOCATE 10, 19 : PRINT "Prepares a Parent/Child Index.  (For 13, 16, 18 and 19.)";
  182. 2100  COLOR K,W : LOCATE 11,3 : PRINT " 8"; : COLOR R,K
  183. 2110  LOCATE 11,  8 : PRINT "INDEXMAR";
  184. 2120  LOCATE 11, 19 : PRINT "Prepares a Marriages Index.  (For 15, 16, 17, 18 and 19.)";
  185. 2130  COLOR K,W : LOCATE 12,3 : PRINT " 9"; : COLOR O,K
  186. 2140  LOCATE 12,  8 : PRINT "PRINTPER";
  187. 2150  LOCATE 12, 19 : PRINT "Prints Detailed Information about Persons.";
  188. 2160  COLOR K,W : LOCATE 13,3 : PRINT "10"; : COLOR O,K
  189. 2170  LOCATE 13,  8 : PRINT "PRINTMAR";
  190. 2180  LOCATE 13, 19 : PRINT "Prints Detailed Information about Marriages."
  191. 2190  COLOR K,W : LOCATE 14,3 : PRINT "11"; : COLOR O,K
  192. 2200  LOCATE 14,  8 : PRINT "LISTPER ";
  193. 2210  LOCATE 14, 19 : PRINT "Prints a List of the Persons in the Persons File."
  194. 2220  COLOR K,W : LOCATE 15,3 : PRINT "12"; : COLOR O,K
  195. 2230  LOCATE 15,  8 : PRINT "LISTMAR ";
  196. 2240  LOCATE 15, 19 : PRINT "Prints a List of the Marriages in the Marriages File."
  197. 2250  COLOR K,W : LOCATE 16,3 : PRINT "13"; : COLOR O,K
  198. 2260  LOCATE 16,  8 : PRINT "LISTPCI ";
  199. 2270  LOCATE 16, 19 : PRINT "Prints a List of the Parent/Child Index.";
  200. 2280  COLOR K,W : LOCATE 17,3 : PRINT "14"; : COLOR O,K
  201. 2290  LOCATE 17,  8 : PRINT "ALPHAPER";
  202. 2300  LOCATE 17, 19 : PRINT "Prints an Alphabetical List of Persons."
  203. 2310  COLOR K,W : LOCATE 18,3 : PRINT "15"; : COLOR O,K
  204. 2320  LOCATE 18,  8 : PRINT "ALPHAMAR";
  205. 2330  LOCATE 18, 19 : PRINT "Prints an Alphabetical List of Marriages."
  206. 2340  COLOR K,W : LOCATE 19,3 : PRINT "16"; : COLOR B,K
  207. 2350  LOCATE 19,  8 : PRINT "DISPLAY ";
  208. 2360  LOCATE 19, 19 : PRINT "Displays Genealogical Information on the Screen."
  209. 2370  COLOR K,W : LOCATE 20,3 : PRINT "17"; : COLOR G,K
  210. 2380  LOCATE 20,  8 : PRINT "PEDIGREE";
  211. 2390  LOCATE 20, 19 : PRINT "Prints Pedigree Charts (Family Trees)."
  212. 2400  COLOR K,W : LOCATE 21,3 : PRINT "18"; : COLOR G,K
  213. 2410  LOCATE 21,  8 : PRINT "FAMILY  ";
  214. 2420  LOCATE 21, 19 : PRINT "Prints Family Group Sheets."
  215. 2430  COLOR K,W : LOCATE 22,3 : PRINT "19"; : COLOR B,K
  216. 2440  LOCATE 22,  8 : PRINT "DESCEND";
  217. 2450  LOCATE 22, 19 : PRINT "Displays (and Optionally Prints) Descendents Charts."
  218. 2460  COLOR W,K
  219. 2470  REM Now obtain User Response
  220. 2480  LOCATE 25,2 : PRINT "(0 to quit, 20 to restart the MENU)";
  221. 2490  LOCATE 24,1 : INPUT "Type a Program Number, and press the 'enter' key."; REPLY$
  222. 2500  IF REPLY$ = "" THEN 1660
  223. 2510  IF REPLY$ = "0" THEN 2960
  224. 2520  REPLY = VAL(REPLY$)
  225. 2530  IF REPLY < 1 OR REPLY > 20 THEN 1660
  226. 2540  IF REPLY =  1 THEN KEY ON : CHAIN DD.PROG$+"creatper",,ALL
  227. 2550  IF REPLY =  2 THEN KEY ON : CHAIN DD.PROG$+"creatmar",,ALL
  228. 2560  IF DD.ORD$ = "no" THEN 2580
  229. 2570  IF REPLY =  3 THEN KEY ON : CHAIN DD.PROG$+"creatord",,ALL
  230. 2580  IF REPLY =  4 THEN KEY ON : CHAIN DD.PROG$+"updatper",,ALL
  231. 2590  IF REPLY =  5 THEN KEY ON : CHAIN DD.PROG$+"updatmar",,ALL
  232. 2600  IF DD.ORD$ = "no" THEN 2620
  233. 2610  IF REPLY =  6 THEN KEY ON : CHAIN DD.PROG$+"updatord",,ALL
  234. 2620  IF REPLY =  7 THEN KEY ON : CHAIN DD.PROG$+"indexpc" ,,ALL
  235. 2630  IF REPLY =  8 THEN KEY ON : CHAIN DD.PROG$+"indexmar",,ALL
  236. 2640  IF REPLY =  9 THEN KEY ON : CHAIN DD.PROG$+"printper",,ALL
  237. 2650  IF REPLY = 10 THEN KEY ON : CHAIN DD.PROG$+"printmar",,ALL
  238. 2660  IF REPLY = 11 THEN KEY ON : CHAIN DD.PROG$+"listper" ,,ALL
  239. 2670  IF REPLY = 12 THEN KEY ON : CHAIN DD.PROG$+"listmar" ,,ALL
  240. 2680  IF REPLY = 13 THEN KEY ON : CHAIN DD.PROG$+"listpci" ,,ALL
  241. 2690  IF REPLY = 14 THEN KEY ON : CHAIN DD.PROG$+"alphaper",,ALL
  242. 2700  IF REPLY = 15 THEN KEY ON : CHAIN DD.PROG$+"alphamar",,ALL
  243. 2710  IF REPLY = 16 THEN KEY ON : CHAIN DD.PROG$+"display" ,,ALL
  244. 2720  IF REPLY = 17 THEN KEY ON : CHAIN DD.PROG$+"pedigree",,ALL
  245. 2730  IF REPLY = 18 THEN KEY ON : CHAIN DD.PROG$+"family"  ,,ALL
  246. 2740  IF REPLY = 19 THEN KEY ON : CHAIN DD.PROG$+"descend" ,,ALL
  247. 2750  IF REPLY = 20 THEN KEY ON : RUN DD.MENU$+"menu"
  248. 2760  REM Improper Response
  249. 2770  GOTO 1660
  250. 2780  REM Subroutine to draw a single horizontal line.  Attach to double.
  251. 2790  COLOR P
  252. 2800  FOR J = C1 + 1 TO C2 - 1
  253. 2810   LOCATE R1,J : PRINT CHR$(196);
  254. 2820  NEXT J
  255. 2830  LOCATE R1,C1 : PRINT CHR$(199);
  256. 2840  LOCATE R1,C2 : PRINT CHR$(182);
  257. 2850  COLOR W
  258. 2860  RETURN
  259. 2870  REM Subroutine to draw a single vertical line.  Attach to double.
  260. 2880  COLOR P
  261. 2890  FOR I = R1 + 1 TO R2 - 1
  262. 2900   LOCATE I,C1 : PRINT CHR$(179);
  263. 2910  NEXT I
  264. 2920  LOCATE R1,C1 : PRINT CHR$(209);
  265. 2930  LOCATE R2,C1 : PRINT CHR$(207);
  266. 2940  COLOR W
  267. 2950  RETURN
  268. 2960  KEY ON : CLS : KEY OFF : LOCATE 21,1
  269. 2970  PRINT "End of Program"
  270. 2980  END
  271.