start tok64 d64-Sqg4fi
0 POKE53280,1:POKE53281,1:PRINT"{dark gray}":GOSUB2500:POKE53272,21
100 REM family
110 REM andy gamble march 81
120 REM columbia college, 1619 w10 ave
130 REM vancouver bc v6j 2a2
140 REM idea from "genepool" cc feb 81
145 REM for 64 by dennis cumberton
150 GOTO1380
160 REM hp<=35,vp<=19
170 vt$="{home}{down*25}"
180 ht$="{right*72}"
190 x=RND(-RND(0))
200 DEFFNr(x)=INT(2*RND(1)+1)
210 no$="{sh -}{cm m}{cm g}{sh -}"
220 ch$(1)="J{sh asterisk*2}K":REM fem
230 ch$(2)="{cm z}{sh asterisk*2}{cm x}":REM male
240 ey$(1)="{sh -}{cm f}{cm d}{sh -}"
250 ey$(2)="{sh -}IU{sh -}"
260 ha$(1)="U{cm i*2}I"
270 ha$(2)="U{cm pound*2}I"
280 REM w over g, r over s
290 INPUT"{clear}{down*4}do you need instructions{space*2}{cm i}{left*3}";zz$:SYS704
300 IFzz$="{cm i}"THEN290
310 IFLEFT$(zz$,1)="y"THEN1470
320 IFLEFT$(zz$,1)<>"n"THEN290
330 PRINT"{clear}{down*3}are the genes for the parents to be{space*5}chosen randomly ":SYS704
340 INPUT"(y/n){space*2}{cm i}{left*3}";zz$
350 IFzz$="{cm i}"THENPRINT"{up}";:GOTO340
360 IFLEFT$(zz$,1)="n"THEN460
370 IFLEFT$(zz$,1)<>"y"THEN330
380 REM random
390 FORi=1TO2:fe$(i)="r":IFRND(1)>.5THENfe$(i)="s"
400 fh$(i)="w":IFRND(1)>.5THENfh$(i)="g"
410 NEXT
420 FORi=1TO2:me$(i)="r":IFRND(1)>.5THENme$(i)="s"
430 mh$(i)="w":IFRND(1)>.5THENmh$(i)="g"
440 NEXT
450 GOTO1050
460 pa=1323
470 PRINT"{clear}{down*2}choose genes for father's hair:":SYS704
480 PRINT"{down*3}"TAB(19)"{reverse on}wg"
490 e$(1)="":e$(2)=""
500 GOSUB1920
510 POKEpa,30
520 FORi=1TO2
530 GOSUB1860
540 fh$(i)="g":IFpa=1323THENfh$(i)="w"
550 h$(i)=fh$(i)
560 NEXT
570 vp=10:hp=18:sex=2
580 GOSUB1820
590 GOSUB1310
600 GOSUB1940
610 PRINT"{down*2}":GOSUB1790
620 PRINT"{clear}{down*2}choose genes for father's eyes:":SYS704
630 PRINT"{down*3}"TAB(19)"{reverse on}rs"
640 GOSUB1920
650 POKEpa,30
660 FORi=1TO2
670 GOSUB1860
680 fe$(i)="s":IFpa=1323THENfe$(i)="r"
690 e$(i)=fe$(i)
700 NEXT
710 vp=10:hp=18:sex=2
720 GOSUB1820
730 GOSUB1310
740 GOSUB1940
750 PRINT"{down*2}":GOSUB1790
760 PRINT"{clear}{down*2}choose genes for mother's hair:":SYS704
770 PRINT"{down*3}"TAB(19)"{reverse on}wg"
780 GOSUB1920
790 e$(1)="":e$(2)=""
800 POKEpa,30
810 FORi=1TO2
820 GOSUB1860
830 mh$(i)="g":IFpa=1323THENmh$(i)="w"
840 h$(i)=mh$(i)
850 NEXT
860 vp=10:hp=18:sex=1
870 GOSUB1820
880 GOSUB1310
890 GOSUB1940
900 PRINT"{down*2}":GOSUB1790
910 PRINT"{clear}{down*2}choose genes for mother's eyes:":SYS704
920 PRINT"{down*3}"TAB(19)"{reverse on}rs"
930 GOSUB1920
940 POKEpa,30
950 FORi=1TO2
960 GOSUB1860
970 me$(i)="s":IFpa=1323THENme$(i)="r"
980 e$(i)=me$(i)
990 NEXT
1000 vp=10:hp=18:sex=1
1010 GOSUB1820
1020 GOSUB1310
1030 GOSUB1940
1040 PRINT"{down*2}":GOSUB1790
1050 PRINTCHR$(147)TAB(10)"{reverse on}father{right*9}mother"
1060 vp=1:hp=11:sex=2
1070 FORi=1TO2:h$(i)=fh$(i):e$(i)=fe$(i):NEXT
1080 GOSUB1820
1090 GOSUB1310
1100 vp=1:hp=26:sex=1
1110 FORi=1TO2:h$(i)=mh$(i):e$(i)=me$(i):NEXT
1120 GOSUB1820
1130 GOSUB1310
1140 REM offspring
1150 FORi=1TO3:FORj=0TO7
1160 vp=1+5*i:hp=5*j
1170 h$(1)=fh$(FNr(1)):h$(2)=mh$(FNr(1))
1180 e$(1)=fe$(FNr(1)):e$(2)=me$(FNr(1))
1190 hc=1:IF(h$(1)="g")AND(h$(2)="g")THENhc=2
1200 ec=1:IF(e$(1)="s")AND(e$(2)="s")THENec=2
1210 sex=FNr(1)
1220 GOSUB1310
1230 NEXTj,i
1240 PRINT"{down}{reverse on}press {reverse off}e{reverse on}nd, {reverse off}n{reverse on}ew parents or {reverse off}m{reverse on}ore offspring"
1250 GOSUB1800
1260 IFzz$="n"THEN330
1270 IFzz$="m"THEN1140
1280 IFzz$<>"e"THEN1250
1290 PRINT"{home}";:END
1300 REM draw face*******************
1310 PRINTLEFT$(vt$,vp+1);
1320 PRINTLEFT$(ht$,hp);
1330 PRINTha$(hc)"{left*4}{down}";
1340 PRINTey$(ec)"{left*4}{down}";
1350 PRINTno$"{left*4}{down}"ch$(sex)"{left*4}{down}";
1360 PRINT"{reverse on}"h$(1)h$(2)e$(1)e$(2)"{reverse off}"
1370 RETURN
1380 PRINT"{clear}":FORi=1024TO1063:POKEi,224:POKEi+960,224:NEXT:SYS704
1390 FORi=1064TO1944STEP40:POKEi,224:POKEi+39,224:NEXT
1400 PRINT"{home}{down*4}"
1410 PRINTTAB(9)"{space*2}O{cm t} {cm @}{cm m}{space*6}L
1420 PRINTTAB(9)"{space*2}L{cm @}{sh @*6}MN{L*4}NM
1430 PRINT"{home}{down*10}"TAB(16)"{reverse on}family"
1440 PRINT"{home}{down*12}"TAB(25)"andy gamble"
1450 PRINT"{down*7}";:GOSUB1790
1460 GOTO170
1470 PRINT"{clear}{down*2}"TAB(15)"{reverse on}family{reverse off}{down*2}":SYS704
1480 PRINT"this program shows you a typical family of martians: two parents";
1490 PRINT" and ";
1500 PRINT"their 21{space*3}children. you can tell the difference"
1510 PRINT"between male and ";
1520 PRINT"female martians very{space*3}easily. males have square jaws and"
1530 PRINT"females have ";
1540 PRINT"round ones. other than thatthey have white or gray hair, and round
1550 PRINT"or{space*3}slanted eyes. these traits are";
1560 PRINT"{space*5}controlled by genes w and g for ";
1570 PRINT"the hairand r and s for the eyes. w is dominant over g and r is ";
1580 PRINT"dominant over s. here{space*3}are two typical martians:"
1590 vp=17:hp=15:sex=1:h$(1)="g":h$(2)="w":e$(1)="r":e$(2)="s":ec=1:hc=1
1600 GOSUB1310
1610 vp=17:hp=22:sex=2:h$(1)="g":h$(2)="g":e$(1)="s":e$(2)="s":ec=2:hc=2
1620 GOSUB1310:PRINT"{down}";
1630 GOSUB1790
1640 PRINT"{clear}{down*2}you may choose the genes for the hair":SYS704
1650 PRINT"and eyes of both the mother and the"
1660 PRINT"father when the program requests it,"
1670 PRINT"by choosing{space*2}two genes such as 'gg'"
1680 PRINT"or 'rr' - whatever you like. you can"
1690 PRINT"also let the program choose the"
1700 PRINT"parents' genes randomly."
1710 PRINT"{down}after you are shown the offspring, you"
1720 PRINT"will have a choice as to more offspring"
1730 PRINT"by the same parents, different parents,"
1740 PRINT"or ending the program."
1750 PRINT"{down*2}"TAB(11)"happy procreation!"
1760 PRINT"{down*3}";:GOSUB1790
1770 GOTO330
1780 REM get-cont******************
1790 PRINTTAB(8)"{reverse on}press any key to continue"
1800 GETzz$:IFzz$=""THEN1800
1810 RETURN
1820 hc=1:IF(h$(1)="g")AND(h$(2)="g")THENhc=2
1830 ec=1:IF(e$(1)="s")AND(e$(2)="s")THENec=2
1840 RETURN
1850 REM choose genes***************
1860 GOSUB1800
1870 IFzz$="<"ANDpa=1324THENPOKEpa,32:pa=1323:POKEpa,30
1880 IFzz$=">"ANDpa=1323THENPOKEpa,32:pa=1324:POKEpa,30
1890 IFzz$<>CHR$(13)THEN1860
1900 RETURN
1910 REM message
1920 PRINTLEFT$(vt$,19);"{reverse on}press < to move left, > to move right "
1930 PRINTLEFT$(vt$,20);"{reverse on}{space*3}press return when gene is chosen{space*3}":RETURN
1940 PRINTLEFT$(vt$,19);"{space*38}"
1950 PRINTLEFT$(vt$,20);"{space*38}":RETURN
2500 FORi=0TO300:READa$:IFa$<>"-8"THEN NEXT
2505 FORa=704TO732:READtt:POKEa,tt:NEXTa:RESTORE:RETURN:REM poke fixer
2510 DATA-8,169,0,133,140,169,219,133,141,169,11,160,255,145,140,136,192,255,208
2520 DATA 249,198,141,164,141,192,215,208,239,96,0
stop tok64
(bastext 1.0)