Biomorphs (BBC BASIC)

discussion of beeb/electron applications, languages, utils and educational s/w
Post Reply
User avatar
lurkio
Posts: 2148
Joined: Tue Apr 09, 2013 11:30 pm
Location: Doomawangara
Contact:

Biomorphs (BBC BASIC)

Post by lurkio » Fri Mar 29, 2019 12:40 am

From the April 1987 issue of The Micro User (via mdfs.net), Richard Dawkins's Biomorphs program as adapted for the BBC Micro by Mike Cook:

Code: Select all

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

Screenshot:

Screenshot.png


The article from the magazine:

Page18.jpg
Page19.jpg
Page21.jpg
Last edited by lurkio on Fri Mar 29, 2019 10:25 am, edited 1 time in total.

User avatar
simonm
Posts: 300
Joined: Mon May 09, 2016 2:40 pm
Contact:

Re: Biomorphs (BBC BASIC)

Post by simonm » Fri Mar 29, 2019 3:42 pm

These articles are awesome. I always really loved the artwork that went with them too.

strawberrytau
Posts: 43
Joined: Sun Mar 11, 2018 8:58 am
Contact:

Re: Biomorphs (BBC BASIC)

Post by strawberrytau » Fri Mar 29, 2019 3:53 pm

I remember this. :-)

Post Reply