home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Compute! Gazette 1993 January
/
1993-01.d64
/
ancestry
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-09-20
|
7KB
|
221 lines
0 clr
5 rem copyright 1993 - compute publications intl ltd - all rights reserved
10 dim b$(50,5):sp$="........................":rem ** 24 periods
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
30 print chr$(14)"[147]"tab(9)"*** [193] [206] [195] [197] [211] [212] [210] [217] ***":printtab(19)"by"
40 printtab(13)"[210]obert [206]ellist"
50 printtab(13)"[208][210][197][211][211] [193][206][217] [203][197][217]"
60 wait 198,15:get m$
70 print"[147]"tab(11)"*** [205]ain [205]enu ***"
80 if k=1 then print"";:goto 110
90 printtab(11)"[197] = [201]nitial [197]ntry"
100 if k=0 then goto 160
110 printtab(11)"[210] = [210]esume [197]ntry"
120 printtab(11)"[211] = [211]earch"
130 printtab(11)"[195] = [197]ntry [195]orrection"
140 printtab(11)"[208] = [208]rintout"
150 printtab(11)"* = [211]ave [197]ntries"
160 printtab(11)"[204] = [204]oad a [198]ile"
170 printtab(11)"[196] = [196]isk [196]irectory"
180 printtab(11)"[209] = [209]uit"
185 printchr$(14)
190 get m$:if m$="e"and k=0 then gosub 290:goto 70
200 if m$="r"and k=1 and z<31 then z=z+1:gosub 300:goto 70
210 if m$="s"and k=1 then p=0:gosub 550:goto 70
220 if m$="c"and k=1 then p=1:gosub 550:goto 70
230 if m$="p"and k=1 then gosub 1530:goto 70
240 if m$="*"and k=1 then gosub 1070:goto 70
250 if m$="l"then gosub 1220:goto 70
260 if m$="d"then gosub 1420:goto 70
270 if m$="q"then gosub 2130:goto 70
280 goto 190
290 he$="[208]rimary [201]ndividual":z=1:a=1:printchr$(14):gosub2020:goto310
300 print chr$(14):gosub 2020:print"[145]"g$;gr$;p$
310 print he$;hd$:print:print"[197]ntry #"z:print
320 for y=1 to 5
330 printtab(9)"[175][157]";:get a$:if a$=""then 330:rem *** commodore-p + crsr-left
340 if a$=chr$(20)and len(b$)<1 or a$=chr$(34) then 330
350 if a$=chr$(20)then b$=left$(b$,len(b$)-1):goto 410
360 if a$=chr$(13)and y=1 and len(b$)<1 then gosub 2090:goto 440
370 ifa$=chr$(13)then b$=b$+sp$:b$=left$(b$,24):b$(z,y)=b$:b$="":goto 430
380 if asc(a$)<32 or asc(a$)>96 and asc(a$)<191 then 330
390 if len(b$)>23 then 330
400 b$=b$+a$
410 print a$;:if y=1 and a$="^"then y=5:z=z-1:b$="":goto 440
420 goto 330
430 print" "
440 next:if a$="^"or z=31 then 530
450 z=z+1
460 if z>1 then p$="[208]arents of [208]rimary [201]ndividual"
470 if z>3 then gr$="[199]rand":p$="parents of [208]rim.[201]ndiv."
480 if z>7 then g$="[199]reat "
490 if z>15 then g$="[199]reat [199]reat "
500 if z/2=int(z/2)then he$="[198]ather of ":hd$=b$(a,1):goto 520
510 he$="[205]other of ":hd$=b$(a,1):a=a+1
520 gosub 2020:print"[145]"g$;gr$;p$:goto 310
530 if z>0 then k=1
540 return
550 printchr$(14)"[147]"tab(3)"[208]ress f1 to [211]tart or [200]alt listing"
560 get l$:if l$<>chr$(133)then 560
570 print"[147]";:for x=1 to z
580 if x=z+1then x=31:goto 670
590 if x=1then print"[208]rimary [201]ndividual
600 [139] x[178]2[167] [153]"(NULL)arents"
610 [139] x[178]4[167] [153]"chr$randparents"
620 [139] x[178]8[167] [153]"chr$reat chr$randparents
630 if x=16then print"[199]reat [199]reat [199]randparents"
640 printtab(3);x;b$(x,1)
650 for t=1 to 300:next
660 get l$:if l$=chr$(133)then x=z
670 next
680 printtab(4)"[205]ain [205]enu"
690 printtab(4)"[210]estart listing"
700 print"[213]se [213]p/[196]own [195]rsr to select the [206]umber ofa record to be ";
710 if p=0 then print"viewed.";
720 if p=1 then print"corrected.";
730 print" [208]ress [210]eturn."
740 print""tab(4):poke 19,65
750 l$="":input l$
760 l$=left$(l$,2):x=val(l$):poke 19,0
770 if l$="[210]e"then goto550
780 if l$="[205]a"then return
790 if x<1 or x>31 then 740
800 if p=1 then print"[147]"
810 if p=0 then print"[147]#"x:print
820 for y=1 to 5
830 if b$(x,1)=""then 550
840 ify=1 then print"[206]ame : "b$(x,y)
850 ify=2 then print"[194]orn : "b$(x,y)
860 ify=3 then print"[215]ed : "b$(x,y)
870 ify=4 then print"[196]ied : "b$(x,y)
880 ify=5 then print"[211]pouse : "b$(x,y)
890 next:if p=1 then 920
900 printtab(12)"[208]ress [193]ny [203]ey"
910 wait 198,15:get m$:goto 550
920 print"[159][212]ype in line correctly - [208]ress [210]eturn."
930 print"[207]r press [210]eturn alone to leave line as it appears above."
940 print"[145][145][145][145][145]":gosub 2070:print"":for y=1 to 5
950 printtab(9)"[175][157]";:get z$:if z$=""then 950
960 if z$=chr$(20)and len(z$(y))<1or cc$=chr$(34)then 950
970 if z$=chr$(20)then z$(y)=left$(z$(y),len(z$(y))-1):goto 1030
980 if z$=chr$(13)and z$(y)=""then print b$(x,y):print:goto 1050
990 ifz$=chr$(13)then z$(y)=z$(y)+sp$:z$(y)=left$(z$(y),24):goto 1040
1000 if asc(z$)<32 or asc(z$)>96 and asc(z$)<191 then 950
1010 if len(z$(y))>23 then 950
1020 z$(y)=z$(y)+z$
1030 print z$;:goto 950
1040 b$(x,y)=z$(y):z$(y)="":print" ":print
1050 next:printtab(12)"[208]ress [193]ny [203]ey"
1060 wait 198,15:get m$:return
1070 print"[147][197]nter filename for save. use name of theprimary indiv. (16 ";
1080 print"space/letter limit.)":print"[208]ress [210]eturn to cancel this option."
1090 input sf$:if sf$=""then return
1100 if len(sf$)>16 then 1070
1110 printtab(10)"[211]aving: "sf$:cr$=chr$(13)
1120 open 15,8,15
1130 open 2,8,2,"@0:"+sf$+",s,w":gosub 1390
1140 print#2,he$;cr$;hd$;cr$;g$;cr$;gr$;cr$;p$:print#2,z;cr$;a
1150 for x=1 to z:for y=1 to 5
1160 if b$(x,y)=""then b$(x,y)=sp$
1170 print#2,chr$(34);b$(x,y)
1180 next y:next x
1190 gosub 1390
1200 close 2:close 15
1210 printtab(12)"[211]ave completed":for g=1 to 2000:next:return
1220 if k=0 then 1270
1230 print"[147]"tab(3)"[193] file already exists in memory"
1240 printtab(9)"[207]verwrite it? y/n"
1250 get m$:if m$="n"then return
1260 if m$<>"y"then 1250
1270 print"[147][197]nter filename to be loaded. [213]se files with primary indiv.";
1280 print" names only.":print"[208]ress [210]eturn to cancel this option.":print
1290 lf$="":input lf$:if lf$=""then return
1300 printtab(09)"[204]oading: "lf$
1310 open 15,8,15
1320 open 2,8,2,"0:"+lf$+",s,r"
1330 input#2,he$,hd$,g$,gr$,p$:input#2,z,a:gosub 1390
1340 for x=1 to z:for y=1 to 5
1350 input#2,b$(x,y)
1360 next y:next x:gosub 1390
1370 close 2:close 15
1380 printtab(9)"[204]oad complete":for g=1 to 2000:next:k=1:return
1390 input#15,en,em$,et,es
1400 ifen>1then print en,em$,et,es:stop
1410 return
1420 print"[147] [208]ress [210]eturn to end listing prior to completion."
1430 open 1,8,0,"$":get#1,aa$,aa$
1440 get#1,aa$,aa$:if aa$=""then 1500
1450 get#1,bb$,cc$
1460 bl=asc(bb$+chr$(0)):bh=asc(cc$+chr$(0))
1470 dd$=mid$(str$(bl+256*bh),2)+chr$(32)
1480 printtab(6)dd$;:get#1,dd$:if dd$<>""then 1480
1490 print:get ee$:if ee$<>chr$(13)then1440
1500 close 1
1510 printtab(12)"[208]ress [193]ny [203]ey"
1520 wait 198,15:get m$:return
1530 k$=b$(1,1):h$=b$(2,1):j$=b$(3,1)
1540 print chr$(14)"[147]"tab(7)"[195]hoose [208]rimary [201]ndividual":printtab(6)"[193] = "k$
1550 printtab(6)"[194] = "h$:printtab(6)"[195] = "j$
1560 print" [206]ote: [217]ou have entered"z"records.":print" [193] completely ";
1570 print"filled-in printout needs:":printtab(10)"for [193] - 15 records"
1580 printtab(10)"for [194] - 23 records":printtab(10)"for [195] - 31 records":ni=0
1590 get n$:if n$="a"then ni=1
1600 if n$="b" then ni=2
1610 if n$="c" then ni=3
1620 if ni=0 then 1590
1630 print"[147][197]nter a [206]umber & [204]etter for your [195]hart"
1635 input"(example - 1[193])";c$
1640 if len(c$)<>2then 1630
1650 input"[197]nter [196]ate (example 2/22/92) ";d$
1660 print chr$(142)"[147]"spc(12)"turn printer on"
1670 printtab(6)"p = print"spc(6)"m = main menu"
1680 get m$:if m$="p"then 1710
1690 if m$<>"m"then 1680
1700 return
1710 print "[147]"tab(14)"printing...":restore
1720 if ni=1 then goto 1760
1730 if ni=2 then goto 1750
1740 for b=1 to 15:read x:next
1750 for b=1 to 15:read x:next
1760 open4,4,7
1770 d$=d$+" ":d$=left$(d$,8):rem ** 8 spaces
1780 pp$=b$(ni,1)+" ":pp$=left$(pp$,24):rem ** 24 spaces
1790 v$="":vv$="":v=0:vv=0:pv=0
1800 for t=1 to 15:read x
1810 if t=1 or t=15 then v=46
1820 if t=2 or t=14 then v=30
1830 if t=3 or t=13 then v=30:v$=":":vv=15
1840 if t=4 or t=12 then v=14
1850 if t=5 or t=11 then v=14:v$=":":vv$=":":