100 REM JB Corewar Evolver for Blassic 6/14/09 WTN (mod 6/21/09)
110 REM Requires the pmars program, edit below if needed.
120 REM This code is Public Domain, as-is, no warranty.
130 REM ===== Default variables for Nano =============
140 L=5:N=200:X=50:C=80:R=100:PM$="pmars"
150 I$="spl.b mov.i mov.i djn.f ":N$="$#@<>*{}"
160 MA=.02:MC=.03:MD=.06:ME=.03:MF=.06:MG=.01:WA=1:WB=1
170 REM L=warrior length, N=number of soup warriors
180 REM X=width of grid (<= soup size), C=core size
190 REM R=battle rounds, PM$=pmars base command
200 REM I$=instruction.modifier list, N$=address mode list
210 REM  (each instr.mod must be 6 chars, space pad)
220 REM MA,MC,MD,ME,MF,MG=mutation rates for instruction,
230 REM  A mode, A value, B mode, B value, line swap
240 REM WA,WB=if <0 then small-number ratio for A/B fields
250 REM If WA or WB >=1 then uses INT((RND^n-RND^n)*C)
260 REM All these except PM$ recorded in soup.txt file
270 CY=1 'set CY to 1 for "cylons", 0 to don't do that
280 REM ===== Initial prompts and soup load ==========
290 RANDOMIZE 'TIMER
300 PRINT "JB v0.71 Evolver":PRINT "Reload soup? ";
310 T$=INKEY$:IF T$="y" THEN PRINT "Yes":GOTO 330
320 IF T$="n" THEN PRINT "No":GOTO 430 ELSE GOTO 310
330 OPEN "soup.txt" FOR INPUT AS #1:INPUT #1,T$:T$=MID$(T$,5,3)
340 IF T$<>"JB7" THEN CLOSE #1:PRINT "Incorrect soup file":SYSTEM
350 INPUT #1,L:INPUT #1,N:DIM A$(N,L),C$(N,L),D(N,L),E$(N,L),F(N,L)
360 INPUT #1,X:INPUT #1,C:INPUT #1,R:LINE INPUT #1,I$:LINE INPUT #1,N$
370 INPUT #1,MA:INPUT #1,MC:INPUT #1,MD:INPUT #1,ME:INPUT #1,MF
380 INPUT #1,MG:INPUT #1,WA:INPUT #1,WB:FOR W=1 TO N:INPUT #1,T$
390 IF LEFT$(T$,1)<>"-" THEN CLOSE #1:GOTO 440 'permit partial load
400 FOR I=1 TO L:INPUT #1,A$(W,I),C$(W,I),D(W,I),E$(W,I),F(W,I)
410 NEXT I:NEXT W:CLOSE #1:GOTO 440
420 REM ===== Initialize =============================
430 DIM A$(N,L),C$(N,L),D(N,L),E$(N,L),F(N,L) 'skip if soup loaded
440 IF N>5000 OR X>N OR L>500 THEN PRINT "Settings too big":SYSTEM
450 T=INT((SIN(TIMER)+2)*100):FOR I=1 TO T:W=RND:NEXT I 'shuffle
460 P$=PM$+" -k -b -s "+STR$(C)+" -p "+STR$(C)+" -c "+STR$(C*10)
470 P$=P$+" -l "+STR$(L)+" -r "+STR$(R):NN=LEN(N$):NI=INT(LEN(I$)/6)
480 PRINT "Evolving...  (press q to quit)"
490 IF CY THEN PRINT "                             |";CHR$(13);"|*";
500 REM ===== Main Loop ==============================
510 W1=INT(RND*N+1):F$="a":W=W1:GOSUB 780
520 W2=W1+INT(RND*3-1)+INT(RND*3-1)*X:IF W2<1 OR W2>N OR W1=W2 THEN 520
530 F$="b":W=W2:GOSUB 780:SHELL P$+" a b >s":OPEN "s" FOR INPUT AS #1
540 INPUT #1,L$:S1=VAL(L$):INPUT #1,L$:S2=VAL(L$)
550 CLOSE #1:IF S1<=S2 THEN T=W1:W1=W2:W2=T:IF CY=0 THEN 590
560 IF DI=0 THEN CP=CP+1:PRINT CHR$(8);" *";
570 IF DI=1 THEN CP=CP-1:PRINT CHR$(8);CHR$(8);"* ";CHR$(8);
580 IF CP>26 THEN DI=1 ELSE IF CP<1 THEN DI=0
590 W=W2:FOR I=1 TO L:A$(W,I)=A$(W1,I):C$(W,I)=C$(W1,I)
600 D(W,I)=D(W1,I):E$(W,I)=E$(W1,I):F(W,I)=F(W1,I)
610 IF RND<MA THEN GOSUB 840  'mutate instruction
620 IF RND<MC THEN GOSUB 850  'mutate A address mode
630 IF RND<MD THEN GOSUB 860  'mutate A value
640 IF RND<ME THEN GOSUB 890  'mutate B address mode
650 IF RND<MF THEN GOSUB 900  'mutate B value
660 IF RND<MG THEN GOSUB 930  'mutate by swapping lines
670 NEXT I:IF INKEY$<>"q" THEN 510
680 REM ===== Save soup and exit =====================
690 OPEN "soup.txt" FOR OUTPUT AS #1:PRINT #1,"----JB7 Soup File----"
700 PRINT #1,L:PRINT #1,N:PRINT #1,X:PRINT #1,C:PRINT #1,R:PRINT #1,I$
710 PRINT #1,N$:PRINT #1,MA:PRINT #1,MC:PRINT #1,MD:PRINT #1,ME
720 PRINT #1,MF:PRINT #1,MG:PRINT #1,WA:PRINT #1,WB:FOR W=1 TO N
730 PRINT #1,"----";W:FOR I=1 TO L:PRINT #1,A$(W,I);",";C$(W,I);
740 PRINT #1,",";D(W,I);",";E$(W,I);",";F(W,I):NEXT I:NEXT W:CLOSE #1
750 FOR W=1 TO N:F$=MID$(STR$(-W),2)+".red":GOSUB 780:NEXT W
760 PRINT:SYSTEM
770 REM ===== Subroutine: Write warrior to file ======
780 OPEN F$ FOR OUTPUT AS #1:PRINT #1,";assert 1"
790 FOR I=1 TO L:IF A$(W,I)<>"" THEN 810
800 GOSUB 840:GOSUB 850:GOSUB 860:GOSUB 890:GOSUB 900
810 PRINT #1,A$(W,I);" ";C$(W,I);D(W,I);",";
820 PRINT #1,E$(W,I);F(W,I):NEXT I:CLOSE #1:RETURN
830 REM ===== Subroutines for mutations ==============
840 A$(W,I)=MID$(I$,INT(RND*NI)*6+1,6):RETURN
850 C$(W,I)=MID$(N$,INT(RND*NN)+1,1):RETURN
860 IF WA>=1 THEN D(W,I)=INT((RND^WA-RND^WA)*C):RETURN
870 IF RND>WA THEN D(W,I)=INT(RND*C):RETURN
880 D(W,I)=INT(RND*L*2-L):RETURN
890 E$(W,I)=MID$(N$,INT(RND*NN)+1,1):RETURN
900 IF WB>=1 THEN F(W,I)=INT((RND^WB-RND^WB)*C):RETURN
910 IF RND>WB THEN F(W,I)=INT(RND*C):RETURN
920 F(W,I)=INT(RND*L*2-L):RETURN
930 IF I=1 THEN RETURN
940 T$=A$(W,I):A$(W,I)=A$(W,I-1):A$(W,I-1)=T$
950 T$=C$(W,I):C$(W,I)=C$(W,I-1):C$(W,I-1)=T$
960 T=D(W,I):D(W,I)=D(W,I-1):D(W,I-1)=T
970 T$=E$(W,I):E$(W,I)=E$(W,I-1):E$(W,I-1)=T$
980 T=F(W,I):F(W,I)=F(W,I-1):F(W,I-1)=T:RETURN
990 REM ===== End of program =========================