100
110
120
125
130 MODE1
140 DIM morph(5,12),parent(5)
150 DIM gi(5,2),px(12),py(12)
160
170 RESTORE 200
180 FOR A%=0 TO 2:FOR B%=0 TO 5
190 READ gi(B%,A%):NEXT:NEXT
200 DATA 1,4,0.16,0.2,0.16,2 :REM GENE INCREMENTS
210 DATA 1,-36,-3.14,0.1,-3.14,-18 :REM GENE MIN
220 DATA 9,36,3.14,10,3.14,18 :REM GENE MAX
225 ON ERROR:REPORT:IFERR<>17:PRINT" at line ";ERL:A%=GET
226 MODE1
230 PROC_INTPOS :
240 PROC_INTP :
250 gen=0
260 MODE 0
270 REPEAT
280 gen=gen+1
290 PROC_MUTATE
300 PROC_DISPLAY
310 PROC_CHOSE
320 UNTIL FALSE
330 DEF PROC_INTP
340 IF A$="C" THEN ENDPROC
350 parent(0)=1
360 parent(1)=4
370 parent(2)=.785
380 parent(3)=1
390 parent(4)=0
400 parent(5)=0
410 IF A$="A" THEN ENDPROC
420 FOR A%=0 TO 5
430 parent(A%)=(RND(5)+1)*gi(A%,0)
440 NEXT
450 parent(0)=RND(3)+1
460 ENDPROC
470 DEF PROC_MUTATE
480 FOR B%=1 TO 12
490 FOR A%=0 TO 5
500 morph(A%,B%)=parent(A%)
510 IF (B%MOD2) D%=-1 ELSE D%=1
520 C%=(B%-1)DIV2
530 IF C%<>A% THEN 560
540 IF morph(A%,B%)+D%*(gi(A%,0))<gi(A%,1) OR morph(A%,B%)+D%*(gi(A%,0))>gi(A%,2) THEN 560
550 morph(A%,B%)=morph(A%,B%)+D%*(gi(A%,0))
560 NEXT:NEXT:ENDPROC
570 DEF PROC_DISPLAY
580 PROC_LINES
590 PROC_TREE(parent(0),parent(1),parent(2),parent(3),parent(4),parent(5),640,500)
600 FOR A%=1 TO 12
610 PROC_TREE(morph(0,A%),morph(1,A%),morph(2,A%),morph(3,A%),morph(4,A%),morph(5,A%),px(A%),py(A%))
620 NEXT:ENDPROC
630 DEF PROC_INTPOS
640 RESTORE 840
650 FOR A=1 TO 12
660 READ px(A),py(A):NEXT
670 PRINT'SPC13;"Biomorph"
680 PRINT"An exercise in Darwinian Evolution"
690 PRINTSPC11;"By Mike Cook"
700 PRINT'"Based on an idea by Richard Dawkins"
710 PRINTSPC2"Author of THE BLIND WATCHMAKER"
720 PRINT''"Options to start evolving from:"'
730 PRINT"A - A microbe."
740 PRINT"B - Some random point."
750 PRINT"C - A defined point."
755 PRINT"Q - Quit."
760 PRINT'"Press the key of your choice:";
770 A$=CHR$(GET AND &DF):IFINSTR("ABCQ",A$)=0 THEN 770
775 PRINTA$:IF A$="Q":END
780 PRINT:IF A$<>"C" ENDPROC
790 FOR A%=0 TO 5
800 PRINT"Gene number ";A%;" (";INT(gi(A%,1)/gi(A%,0));" to ";INT(gi(A%,2)/gi(A%,0));")";
810 INPUT ": "parent(A%):parent(A%)=parent(A%)*gi(A%,0)
820 IF parent(A%)<INT(gi(A%,1)/gi(A%,0)) OR parent(A%)>INT(gi(A%,2)/gi(A%,0)):GOTO 800
830 NEXT:ENDPROC
840 DATA 160,860,480,860,800,860,1120,860,160,604,1120,604,160,348,1120,348
850 DATA 160,92,480,92,800,92,1120,92
860 DEF PROC_LINES
870 VDU 12,23,1,0;0;0;0;5
880 PRINT
890 FOR X%=320 TO 960 STEP 320
900 FOR Y%=256 TO 800 STEP 256
910 MOVE X%,0:DRAW X%,1023
920 MOVE 0,Y%:DRAW 1259,Y%
930 NEXT:NEXT
940 MOVE 640,260:PLOT 7,640,764
950 MOVE 324,512:PLOT 7,958,512
960 FOR A%=1 TO 12
970 MOVE px(A%)-150,py(A%)-60
980 VDU&40+A%:NEXT
990 MOVE 536,338+16
1000 PRINT"PARENT BIOMORPH"
1010 MOVE 504,755
1020 PRINT"GENERATION NUMBER ";gen
1030 VDU4:ENDPROC
1040 DEF PROC_CHOSE
1042 VDU5:MOVE 368,322
1045 FOR A%=0 TO 5:PRINT;A%;":";LEFT$(STR$INT(parent(A%)/gi(A%,0))+" ",5);:NEXT
1050 MOVE 336,290
1060 PRINT"A-L: Breed from child, R: Random child"
1070 A$=GET$
1080 C%=(ASC(A$)AND&DF)-&40:IF C%=18:C%=RND(12)
1090 IF C%<1 OR C%>12 PROC_REVIEW:ENDPROC
1100 FOR A%=0 TO 5
1110 parent(A%)=morph(A%,C%)
1120 NEXT:VDU4:ENDPROC
1130 DEF PROC_REVIEW
1140 VDU22,1
1150 PRINT''"Current Biomorph has:"
1160 FOR A%=0 TO 5
1170 PRINT"GENE ";A%" VALUE ";INT(parent(A%)/gi(A%,0))
1180 NEXT
1190 PROC_TREE(parent(0),parent(1),parent(2),parent(3),parent(4),parent(5),640,300)
1200 PRINTTAB(0,30);"Press any key to continue";
1210 A$=GET$:gen=gen-1:VDU22,0
1220 ENDPROC
1230 DEF PROC_TREE(D,L,dA,AR,DT,DS,X,Y)
1240 MOVE X,Y:DRAW X,Y-L
1250 PROC_GROW(PI/2,L,X,Y,D)
1260 ENDPROC
1270 DEF PROC_GROW(TH,L,X,Y,D)
1280 IF D MOVE X,Y ELSE ENDPROC
1290 dX=L*COS(TH+dA)*(1/AR)
1300 dY=L*SIN(TH+dA)*AR
1310 PLOT 1,dX,dY
1320 PROC_GROW(TH+dA+DT,L-DS,X+dX,Y+dY,D-1)
1330 MOVE X,Y
1340 dX=L*COS(TH-dA)*(1/AR)
1350 dY=L*SIN(TH-dA)*AR
1360 PLOT 1,dX,dY:MOVE X,Y
1370 PROC_GROW(TH-dA-DT,L-DS,X+dX,Y+dY,D-1)
1380 ENDPROC