10 REM > Insect
   20 REM Program Breeding
   30 REM Version B0.3a 06/04/1987
   40 REM Author  P.Bampton
   50 REM BEEBUG  May 1987
   60 REM Program subject to copyright
   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