10
20
30
40
50
60
70 :
80 MODE&87:A%=HIMEM-TOP-&5100:IFA%<0:GOTO2600
90 ON ERROR GOTO 2070
100 MODE&81:DIMxn(5),yn(5)
110 PROCmain
120 END
130 :
140 DEFPROCmain
150 xi=12:yi=12:gxo=100:gyo=100
160 gx=18*xi:gy=17*yi+64
170 A%=49:M%=1:N%=2:tm=&900:IFHIMEM-LOMEM>1000:DIMtm 512
180 dna=tm+46:gen=dna+9*46:!gen=0
190 $tm="100000000000001000000000001000000010000000000"
200 $dna=STRING$(43,"A")
210 FORi=1TO8:$(dna+i*46)=$dna:NEXT
220 VDU19,1,6,0,0,0
230 VDU19,0,7,0,0,0,19,3,0,0,0,0
240 PROCgrid
250 VDU28,26,31,39,0:COLOUR131:COLOUR0:VDU12,28,26,31,39,0
260 PROCnewgen(A%-49)
270 CLS:PRINTTAB(0,4)"Generation ";!gen
280 IFA%<>19 PROCdisgen
290 PRINTTAB(0,10)"Select 1-9 or"''"(L)oad (S)ave"'SPC4"(Q)uit"
300 PRINTTAB(0,8)"Breed from:";
310 REPEAT:A%=GET:IFA%>95:A%=A%AND&DF
320 UNTILINSTR("LSQ",CHR$A%)OR(A%>48ANDA%<58):IFA%<64:VDUA%:!gen=!gen+1:GOTO360
330 IFA%=81:PRINTTAB(0,15):ENDPROC
340 IFA%=76:PROCload
350 IFA%=83:PROCsave:GOTO370
360 FORi=0TO8:PROCclear(i):NEXT
370 VDU24,0;0;1279;1023;
380 IFA%<64:GOTO260 ELSE GOTO270
390 ENDPROC
400 :
410 DEFPROCbug(k,xp,yp,xj,yj):LOCALi,j
420 cxo=gxo+k MOD3*gx+xi:cyo=gyo+gy*2-k DIV3*gy+yi
430 xj=xj DIV2:yj=yj DIV2
440 PROCabdomen
450 PROCthorax
460 PROChead
470 PROClegs
480 PROCwings
490 ENDPROC
500 :
510 DEFPROCgrid:LOCALyt,xt,i
520 FORi=0TO 3*gy STEPgy
530 MOVEgxo,gyo+i:DRAWgxo+gx*3,gyo+i
540 NEXT
550 FORi=0TO 3*gx STEPgx
560 MOVEgxo+i,gyo:DRAWgxo+i,gyo+gy*3
570 NEXT
580 VDU5:FORi=0TO8
590 yt=gyo+3*gy-32-i DIV3*gy
600 xt=gxo+gx DIV2-16+i MOD3*gx
610 MOVExt,yt:VDUi+49
620 NEXT
630 MOVEgxo+6*xi,gyo+3*gy+48
640 PRINT" Breed a Bug"
650 VDU4
660 ENDPROC
670 :
680 DEFPROCdisgen:LOCALyt,xt,i
690 PRINT'"Plotting...";
700 FORi=0TO8
710 yt=gyo+3*gy-gy+yi-i DIV3*gy
720 xt=gxo+xi+i MOD3*gx
730 PROCbug(i,xt,yt,xi,yi)
740 NEXT
750 PRINTCHR$13;SPC11;CHR$13;
760 ENDPROC
770 :
780 DEFFNmut(a$):LOCALp,r,d
790 p=INT(RND(1)*LEN(a$))+1
800 IFMID$($tm,p,1)="1" r=INT(RND(1)*10) MOD9:GOTO850
810 IFRND(1)>0.5 d=N% ELSE d=-N%
820 r=ASC(MID$(a$,p,1))-65+d
830 IFr>16 r=16
840 IFr<0 r=0
850 =LEFT$(a$,p-1)+CHR$(r+65)+RIGHT$(a$,LEN(a$)-p)
860 DEFPROCclear(n)
870 VDU24,gxo+n MOD3*gx+xi;gyo+gy*3-n DIV3*gy-gy+yi;gxo+n MOD3*gx+gx-xi;gyo+gy*3-n DIV3*gy-64;
880 CLG:ENDPROC
890 :
900 DEFPROCnewgen(n):LOCALi,j
910 FORi=0TO8
920 IFi=n GOTO980
930 $(dna+i*46)=FNmut($(dna+n*46))
940 IFM%<2 GOTO980
950 FORj=1TOM%-1
960 $(dna+i*46)=FNmut($(dna+i*46))
970 NEXTj
980 NEXTi
990 ENDPROC
1000 :
1010 DEFPROCabdomen:LOCALi,j,kk
1020 xn(0)=FNgene(1) MOD10:yn(0)=FNgene(2) MOD4
1030 xn(1)=FNgene(3) MOD(16-xn(0))+xn(0)
1040 yn(1)=FNgene(4) MOD(12-yn(0))+yn(0)
1050 IFxn(1)>0 xn(2)=xn(1)-FNgene(5) MODxn(1) ELSE xn(2)=0
1060 yn(2)=FNgene(6) MOD(15-yn(1))+yn(1)
1070 yn(3)=FNgene(7) MOD(16-yn(2))+yn(2)
1080 cx=16*xj+cxo:cy=16*yj+cyo
1090 kk=1:FORi=1TO2
1100 gc=3:g=FNgene(0) MOD4:IFg=2 gc=2
1110 IFg=3 gc=1
1120 GCOL0,gc
1130 MOVEcx,cy:DRAWcx,cy-yn(0)*yj
1140 FORj=0TO2
1150 PLOT85,cx+kk*xn(j)*xj,cy-yn(j)*yj
1160 IFg=2 gc=5-gc
1170 GCOL0,gc
1180 PLOT85,cx,cy-yn(j+1)*yj
1190 NEXTj:kk=-1
1200 NEXTi:ENDPROC
1210 :
1220 DEFFNgene(n):=ASC(MID$($(dna+k*46),n+1,1))-65
1230 DEFPROCthorax:LOCALi,j
1240 PROCprethorax:kk=1
1250 FORi=0TO1
1260 GCOL0,3
1270 MOVEcx,cy:MOVEcx,cy+yn(0)*yj
1280 FORj=0TO1
1290 PLOT85,cx+kk*xn(j)*xj,cy+yn(j)*yj
1300 PLOT85,cx,cy+yn(j+1)*yj
1310 NEXTj:kk=-1
1320 NEXTi:ENDPROC
1330 :
1340 DEFPROCprethorax
1350 xn(0)=FNgene(9) MOD10
1360 yn(0)=FNgene(10) MOD8
1370 xn(1)=FNgene(11) MOD(12-xn(0))+xn(0)
1380 yn(1)=FNgene(12) MOD(10-yn(0))+yn(0)
1390 yn(2)=FNgene(13) MOD(12-yn(1))+yn(1)
1400 tw=xn(1):tl=yn(2)
1410 ENDPROC
1420 :
1430 DEFPROChead:LOCALi,j
1440 PROCprehead:kk=1
1450 FORi=0TO1
1460 MOVEcx,cy+tl*yj
1470 MOVEcx,cy+yn(0)*yj
1480 FORj=0TO2
1490 PLOT85,cx+kk*xn(j)*xj,cy+yn(j)*yj
1500 PLOT85,cx,cy+yn(j+1)*yj
1510 NEXTj:kk=-1
1520 NEXTi:PROCantenna
1530 ENDPROC
1540 :
1550 DEFPROCprehead
1560 xn(0)=FNgene(15) MOD10
1570 yn(0)=FNgene(16) MOD(13-tl)+tl
1580 xn(1)=FNgene(17) MOD(12-xn(0))+xn(0)
1590 yn(1)=FNgene(18) MOD(14-yn(0))+yn(0)
1600 IFxn(1)=0 xn(2)=0 ELSE xn(2)=xn(1)-FNgene(19) MODxn(1)
1610 yn(2)=FNgene(20) MOD(15-yn(1))+yn(1)
1620 yn(3)=FNgene(21) MOD(16-yn(2))+yn(2)
1630 hw=xn(1):hl=yn(2)
1640 ENDPROC
1650 :
1660 DEFPROCantenna
1670 IFhw=0 xn(0)=0 ELSE xn(0)=FNgene(22) MODhw
1680 yn(0)=FNgene(23) MOD(16-hl)+hl
1690 xn(1)=FNgene(24) MOD(12-xn(0))+xn(0)
1700 yn(1)=yn(0)
1710 xn(2)=FNgene(25) MOD(15-xn(1))+xn(1)
1720 yn(2)=yn(1)-FNgene(26) MOD15
1730 kk=1:FORi=0TO1
1740 MOVEcx,cy+tl*yj
1750 FORj=0TO2
1760 DRAWcx+kk*xn(j)*xj,cy+yn(j)*yj
1770 NEXTj:kk=-1
1780 NEXTi:ENDPROC
1790 :
1800 DEFPROClegs:LOCALi
1810 htl=tl DIV2:g=FNgene(14) MOD3
1820 xn(0)=FNgene(27) MOD(13-tw)+tw
1830 yn(0)=FNgene(28) MOD(13-htl)+htl
1840 yn(1)=htl-FNgene(29) MOD10
1850 xn(1)=FNgene(30) MOD(15-xn(0))+xn(0)
1860 yn(2)=FNgene(31) MOD(15-yn(0))+yn(0)
1870 yn(3)=htl-FNgene(32) MOD5
1880 yn(4)=yn(1)-FNgene(33) MOD(15+htl-yn(1))
1890 kk=1
1900 FORi=0TO1
1910 MOVEcx,cy+htl*yj
1920 DRAWcx+kk*xn(0)*xj,cy+yn(0)*yj
1930 DRAWcx+kk*xn(1)*xj,cy+yn(2)*yj
1940 MOVEcx,cy+htl*yj
1950 DRAWcx+kk*xn(0)*xj,cy+htl*yj
1960 DRAWcx+kk*xn(1)*xj,cy+yn(3)*yj
1970 MOVEcx,cy+htl*yj
1980 DRAWcx+kk*xn(0)*xj,cy+yn(1)*yj
1990 DRAWcx+kk*xn(1)*xj,cy+yn(4)*yj
2000 IFg<>0 GOTO2040
2010 MOVEcx,cy+htl*yj
2020 DRAWcx+kk*xn(0)*xj,cy+(htl+yn(1))DIV2*yj
2030 DRAWcx+kk*xn(1)*xj,cy+(yn(3)+yn(4))DIV2*yj
2040 kk=-1:NEXT
2050 ENDPROC
2060 :
2070 ONERROROFF
2080 MODE7:IFERR=17 END
2090 PRINT:REPORT:PRINT" at line ";ERL
2100 END
2110 :
2120 DEFPROCwings:LOCALi,j
2130 xn(0)=FNgene(35) MOD(13-tw)+tw
2140 yn(0)=FNgene(36) MOD(15-htl)+htl
2150 xn(1)=FNgene(37) MOD(15-xn(0))+xn(0)
2160 yn(1)=yn(0)-FNgene(38) MOD(12+yn(0))
2170 xn(2)=xn(1)
2180 yn(2)=yn(1)-FNgene(39) MOD(14+yn(1))
2190 IFxn(2)=0 xn(3)=0 ELSE xn(3)=FNgene(40) MODxn(2)
2200 yn(3)=yn(2)-FNgene(41) MOD(15+yn(2))
2210 IFxn(3)=0 xn(4)=0 ELSE xn(4)=xn(3)-FNgene(42) MODxn(3)
2220 yn(4)=yn(3)
2230 xn(5)=tw-1:yn(5)=htl-1:IFtw=0 xn(5)=0
2240 g=FNgene(34) MOD9:IFg=0 ENDPROC
2250 gc=2:kp=85:IFg<3 gc=3
2260 IFg>5 gc=1
2270 IF(g=2)OR(g=4)OR(g=7) kp=5
2280 GCOL0,gc:PROCpostwings
2290 GCOL0,3
2300 IF(g=5)OR(g=8) kp=5:PROCpostwings
2310 ENDPROC
2320 :
2330 DEFPROCpostwings:LOCALi,j
2340 kk=1
2350 FORi=0TO1
2360 MOVEcx+kk*tw*xj,cy+htl*yj:MOVEcx+kk*xn(5)*xj,cy+yn(5)*yj
2370 PLOTkp,cx+kk*xn(0)*xj,cy+yn(0)*yj
2380 PLOTkp,cx+kk*xn(0)*xj,cy+yn(1)*yj
2390 PLOTkp,cx+kk*xn(1)*xj,cy+yn(1)*yj
2400 PLOTkp,cx+kk*xn(2)*xj,cy+yn(2)*yj
2410 PLOTkp,cx+kk*tw*xj,cy+yn(5)*yj
2420 PLOTkp,cx+kk*xn(3)*xj,cy+yn(3)*yj
2430 PLOTkp,cx+kk*xn(4)*xj,cy+yn(4)*yj
2440 PLOTkp,cx+xn(5)*xj*kk,cy+yn(5)*yj
2450 IFkp<>85 MOVEcx+kk*tw*xj,cy+htl*yj:FORj=0TO5:DRAWcx+xn(j)*kk*xj,cy+yn(j)*yj:NEXTj
2460 kk=-1:NEXTi
2470 GCOL0,3
2480 ENDPROC
2490 :
2500 DEFPROCload
2510 CLS:PRINT'''"Load file"''"Filename"
2520 INPUT":"F$:IFF$<>"":OSCLI"LOAD "+F$+" "+STR$~tm
2530 ENDPROC
2540 :
2550 DEFPROCsave
2560 CLS:PRINT'''"Save file"''"Filename"
2570 INPUTLINE":"F$:IFF$<>"":OSCLI"SAVE "+F$+" "+STR$~tm+"+200 0 0"
2580 ENDPROC
2590 :
2600 PRINT"Please wait";:B%=(PAGE+A%)AND-256:C%=TOP-PAGE:FORD%=0TOC%STEP4:D%!B%=D%!PAGE:NEXT:PAGE=B%:!&12=PAGE+C%:RUN