home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1993 January / 1993-01.d64 / ancestry (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  7KB  |  221 lines
  1. 0 clr
  2. 5 rem copyright 1993 - compute publications intl ltd - all rights reserved
  3. 10 dim b$(50,5):sp$="........................":rem ** 24 periods
  4. 20 dt$="[163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163][163]":rem ** 24 commodore-t key presses
  5. 30 print chr$(14)"[147]"tab(9)"*** [193] [206] [195] [197] [211] [212] [210] [217] ***":printtab(19)"by"
  6. 40 printtab(13)"[210]obert [206]ellist"
  7. 50 printtab(13)"[208][210][197][211][211] [193][206][217] [203][197][217]"
  8. 60 wait 198,15:get m$
  9. 70 print"[147]"tab(11)"*** [205]ain [205]enu ***"
  10. 80 if k=1 then print"";:goto 110
  11. 90 printtab(11)"[197] = [201]nitial [197]ntry"
  12. 100 if k=0 then goto 160
  13. 110 printtab(11)"[210] = [210]esume [197]ntry"
  14. 120 printtab(11)"[211] = [211]earch"
  15. 130 printtab(11)"[195] = [197]ntry [195]orrection"
  16. 140 printtab(11)"[208] = [208]rintout"
  17. 150 printtab(11)"* = [211]ave [197]ntries"
  18. 160 printtab(11)"[204] = [204]oad a [198]ile"
  19. 170 printtab(11)"[196] = [196]isk [196]irectory"
  20. 180 printtab(11)"[209] = [209]uit"
  21. 185 printchr$(14)
  22. 190 get m$:if m$="e"and k=0 then gosub 290:goto 70
  23. 200 if m$="r"and k=1 and z<31 then z=z+1:gosub 300:goto 70
  24. 210 if m$="s"and k=1 then p=0:gosub 550:goto 70
  25. 220 if m$="c"and k=1 then p=1:gosub 550:goto 70
  26. 230 if m$="p"and k=1 then gosub 1530:goto 70
  27. 240 if m$="*"and k=1 then gosub 1070:goto 70
  28. 250 if m$="l"then gosub 1220:goto 70
  29. 260 if m$="d"then gosub 1420:goto 70
  30. 270 if m$="q"then gosub 2130:goto 70
  31. 280 goto 190
  32. 290 he$="[208]rimary [201]ndividual":z=1:a=1:printchr$(14):gosub2020:goto310
  33. 300 print chr$(14):gosub 2020:print"[145]"g$;gr$;p$
  34. 310 print he$;hd$:print:print"[197]ntry #"z:print
  35. 320 for y=1 to 5
  36. 330 printtab(9)"[175][157]";:get a$:if a$=""then 330:rem *** commodore-p + crsr-left
  37. 340 if a$=chr$(20)and len(b$)<1 or a$=chr$(34) then 330
  38. 350 if a$=chr$(20)then b$=left$(b$,len(b$)-1):goto 410
  39. 360 if a$=chr$(13)and y=1 and len(b$)<1 then gosub 2090:goto 440
  40. 370 ifa$=chr$(13)then b$=b$+sp$:b$=left$(b$,24):b$(z,y)=b$:b$="":goto 430
  41. 380 if asc(a$)<32 or asc(a$)>96 and asc(a$)<191 then 330
  42. 390 if len(b$)>23 then 330
  43. 400 b$=b$+a$
  44. 410 print a$;:if y=1 and a$="^"then y=5:z=z-1:b$="":goto 440
  45. 420 goto 330
  46. 430 print" "
  47. 440 next:if a$="^"or z=31 then 530
  48. 450 z=z+1
  49. 460 if z>1 then p$="[208]arents of [208]rimary [201]ndividual"
  50. 470 if z>3 then gr$="[199]rand":p$="parents of [208]rim.[201]ndiv."
  51. 480 if z>7 then g$="[199]reat "
  52. 490 if z>15 then g$="[199]reat [199]reat "
  53. 500 if z/2=int(z/2)then he$="[198]ather of ":hd$=b$(a,1):goto 520
  54. 510 he$="[205]other of ":hd$=b$(a,1):a=a+1
  55. 520 gosub 2020:print"[145]"g$;gr$;p$:goto 310
  56. 530 if z>0 then k=1
  57. 540 return
  58. 550 printchr$(14)"[147]"tab(3)"[208]ress f1 to [211]tart or [200]alt listing"
  59. 560 get l$:if l$<>chr$(133)then 560
  60. 570 print"[147]";:for x=1 to z
  61. 580 if x=z+1then x=31:goto 670
  62. 590 if x=1then print"[208]rimary [201]ndividual
  63. 600 [139] x[178]2[167] [153]"(NULL)arents"
  64. 610 [139] x[178]4[167] [153]"chr$randparents"
  65. 620 [139] x[178]8[167] [153]"chr$reat chr$randparents
  66. 630 if x=16then print"[199]reat [199]reat [199]randparents"
  67. 640 printtab(3);x;b$(x,1)
  68. 650 for t=1 to 300:next
  69. 660 get l$:if l$=chr$(133)then x=z
  70. 670 next
  71. 680 printtab(4)"[205]ain [205]enu"
  72. 690 printtab(4)"[210]estart listing"
  73. 700 print"[213]se [213]p/[196]own [195]rsr to select the [206]umber ofa record to be ";
  74. 710 if p=0 then print"viewed.";
  75. 720 if p=1 then print"corrected.";
  76. 730 print" [208]ress [210]eturn."
  77. 740 print""tab(4):poke 19,65
  78. 750 l$="":input l$
  79. 760 l$=left$(l$,2):x=val(l$):poke 19,0
  80. 770 if l$="[210]e"then goto550
  81. 780 if l$="[205]a"then return
  82. 790 if x<1 or x>31 then 740
  83. 800 if p=1 then print"[147]"
  84. 810 if p=0 then print"[147]#"x:print
  85. 820 for y=1 to 5
  86. 830 if b$(x,1)=""then 550
  87. 840 ify=1 then print"[206]ame   : "b$(x,y)
  88. 850 ify=2 then print"[194]orn   : "b$(x,y)
  89. 860 ify=3 then print"[215]ed    : "b$(x,y)
  90. 870 ify=4 then print"[196]ied   : "b$(x,y)
  91. 880 ify=5 then print"[211]pouse : "b$(x,y)
  92. 890 next:if p=1 then 920
  93. 900 printtab(12)"[208]ress [193]ny [203]ey"
  94. 910 wait 198,15:get m$:goto 550
  95. 920 print"[159][212]ype in line correctly - [208]ress [210]eturn."
  96. 930 print"[207]r press [210]eturn alone to leave line as  it appears above."
  97. 940 print"[145][145][145][145][145]":gosub 2070:print"":for y=1 to 5
  98. 950 printtab(9)"[175][157]";:get z$:if z$=""then 950
  99. 960 if z$=chr$(20)and len(z$(y))<1or cc$=chr$(34)then 950
  100. 970 if z$=chr$(20)then z$(y)=left$(z$(y),len(z$(y))-1):goto 1030
  101. 980 if z$=chr$(13)and z$(y)=""then print b$(x,y):print:goto 1050
  102. 990 ifz$=chr$(13)then z$(y)=z$(y)+sp$:z$(y)=left$(z$(y),24):goto 1040
  103. 1000 if asc(z$)<32 or asc(z$)>96 and asc(z$)<191 then 950
  104. 1010 if len(z$(y))>23 then 950
  105. 1020 z$(y)=z$(y)+z$
  106. 1030 print z$;:goto 950
  107. 1040 b$(x,y)=z$(y):z$(y)="":print" ":print
  108. 1050 next:printtab(12)"[208]ress [193]ny [203]ey"
  109. 1060 wait 198,15:get m$:return
  110. 1070 print"[147][197]nter filename for save. use name of theprimary indiv. (16 ";
  111. 1080 print"space/letter limit.)":print"[208]ress [210]eturn to cancel this option."
  112. 1090 input sf$:if sf$=""then return
  113. 1100 if len(sf$)>16 then 1070
  114. 1110 printtab(10)"[211]aving: "sf$:cr$=chr$(13)
  115. 1120 open 15,8,15
  116. 1130 open 2,8,2,"@0:"+sf$+",s,w":gosub 1390
  117. 1140 print#2,he$;cr$;hd$;cr$;g$;cr$;gr$;cr$;p$:print#2,z;cr$;a
  118. 1150 for x=1 to z:for y=1 to 5
  119. 1160 if b$(x,y)=""then b$(x,y)=sp$
  120. 1170 print#2,chr$(34);b$(x,y)
  121. 1180 next y:next x
  122. 1190 gosub 1390
  123. 1200 close 2:close 15
  124. 1210 printtab(12)"[211]ave completed":for g=1 to 2000:next:return
  125. 1220 if k=0 then 1270
  126. 1230 print"[147]"tab(3)"[193] file already exists in memory"
  127. 1240 printtab(9)"[207]verwrite it?  y/n"
  128. 1250 get m$:if m$="n"then return
  129. 1260 if m$<>"y"then 1250
  130. 1270 print"[147][197]nter filename to be loaded. [213]se files  with primary indiv.";
  131. 1280 print" names only.":print"[208]ress [210]eturn to cancel this option.":print
  132. 1290 lf$="":input lf$:if lf$=""then return
  133. 1300 printtab(09)"[204]oading: "lf$
  134. 1310 open 15,8,15
  135. 1320 open 2,8,2,"0:"+lf$+",s,r"
  136. 1330 input#2,he$,hd$,g$,gr$,p$:input#2,z,a:gosub 1390
  137. 1340 for x=1 to z:for y=1 to 5
  138. 1350 input#2,b$(x,y)
  139. 1360 next y:next x:gosub 1390
  140. 1370 close 2:close 15
  141. 1380 printtab(9)"[204]oad complete":for g=1 to 2000:next:k=1:return
  142. 1390 input#15,en,em$,et,es
  143. 1400 ifen>1then print en,em$,et,es:stop
  144. 1410 return
  145. 1420 print"[147] [208]ress [210]eturn to end listing prior to   completion."
  146. 1430 open 1,8,0,"$":get#1,aa$,aa$
  147. 1440 get#1,aa$,aa$:if aa$=""then 1500
  148. 1450 get#1,bb$,cc$
  149. 1460 bl=asc(bb$+chr$(0)):bh=asc(cc$+chr$(0))
  150. 1470 dd$=mid$(str$(bl+256*bh),2)+chr$(32)
  151. 1480 printtab(6)dd$;:get#1,dd$:if dd$<>""then 1480
  152. 1490 print:get ee$:if ee$<>chr$(13)then1440
  153. 1500 close 1
  154. 1510 printtab(12)"[208]ress [193]ny [203]ey"
  155. 1520 wait 198,15:get m$:return
  156. 1530 k$=b$(1,1):h$=b$(2,1):j$=b$(3,1)
  157. 1540 print chr$(14)"[147]"tab(7)"[195]hoose [208]rimary [201]ndividual":printtab(6)"[193] = "k$
  158. 1550 printtab(6)"[194] = "h$:printtab(6)"[195] = "j$
  159. 1560 print" [206]ote: [217]ou have entered"z"records.":print" [193] completely ";
  160. 1570 print"filled-in printout needs:":printtab(10)"for [193] - 15 records"
  161. 1580 printtab(10)"for [194] - 23 records":printtab(10)"for [195] - 31 records":ni=0
  162. 1590 get n$:if n$="a"then ni=1
  163. 1600 if n$="b" then ni=2
  164. 1610 if n$="c" then ni=3
  165. 1620 if ni=0 then 1590
  166. 1630 print"[147][197]nter a [206]umber & [204]etter for your [195]hart"
  167. 1635 input"(example - 1[193])";c$
  168. 1640 if len(c$)<>2then 1630
  169. 1650 input"[197]nter [196]ate (example 2/22/92) ";d$
  170. 1660 print chr$(142)"[147]"spc(12)"turn printer on"
  171. 1670 printtab(6)"p = print"spc(6)"m = main menu"
  172. 1680 get m$:if m$="p"then 1710
  173. 1690 if m$<>"m"then 1680
  174. 1700 return
  175. 1710 print "[147]"tab(14)"printing...":restore
  176. 1720 if ni=1 then goto 1760
  177. 1730 if ni=2 then goto 1750
  178. 1740 for b=1 to 15:read x:next
  179. 1750 for b=1 to 15:read x:next
  180. 1760 open4,4,7
  181. 1770 d$=d$+"        ":d$=left$(d$,8):rem ** 8 spaces
  182. 1780 pp$=b$(ni,1)+"                        ":pp$=left$(pp$,24):rem ** 24 spaces
  183. 1790 v$="":vv$="":v=0:vv=0:pv=0
  184. 1800 for t=1 to 15:read x
  185. 1810 if t=1 or t=15 then v=46
  186. 1820 if t=2 or t=14 then v=30
  187. 1830 if t=3 or t=13 then v=30:v$=":":vv=15
  188. 1840 if t=4 or t=12 then v=14
  189. 1850 if t=5 or t=11 then v=14:v$=":":vv$=":":