n=256:l=20:ra=0:spl=0:cs=8000:pmars$="pmars -s 8000 -p 8000 -c 80000 -l 100 -d 100 -b -r 20"
RANDOMIZE TIMER:m$=".i .i .i .a .a .b .b .x .f .ab.ba":em=11:d$="$ $ $ # @ * < > { }":ed=10
i$ = "mov mov mov mov mov mov spl spl spl spl spl djn djn dat add sub mul div mod sne seq slt jmn jmz jmp":ei=25
inl=.005:del=.007:ins=.01:inm=.03:adr=.03:chd=.05:idd=.02:dup=.1:sn=.5:ON ERROR GOTO a:OPEN "LCE8.ini" FOR INPUT AS #1
ON ERROR GOTO x:INPUT #1,n,l,ra,spl,cs,pmars$,i$,ei,m$,em,d$,ed,inl,del,ins,inm,adr,chd,idd,dup,sn:CLOSE:z8=-(m$="88")
m$=LEFT$("   ",z8*3)+m$:em=em*(1-z8)+z:IF n>5000 OR l>500 OR LCASE$(LEFT$(pmars$,2))<>"pm" THEN GOTO x ELSE GOTO b
prcl:IF k<l THEN PRINT #2,a$:k=k+1 'setup.. n=# files,l=length,ra=0 grid >0 range,spl=0 rnd 1 hint,cs=coresize for #
mrcl:a$=MID$(i$,INT(RND(1)*ei)*4+1,3)+MID$(m$,INT(RND(1)*em)*3+1,3)+" "+MID$(d$,INT(RND(1)*ed)*2+1,1):x=-(RND(1)<sn)
a$=a$+RIGHT$("   "+STR$(x*INT(RND(1)*l*2-l)+(1-x)*INT(RND(1)*cs)),5)+","+MID$(d$,INT(RND(1)*ed)*2+1,1):x=-(RND(1)<sn)
a$=a$+RIGHT$("   "+STR$(x*INT(RND(1)*l*2-l)+(1-x)*INT(RND(1)*cs)),5):GOSUB ck88:IF bad88 THEN GOTO mrcl ELSE RETURN
ck88:IF z8=0 THEN bad88=0:RETURN ELSE p$=LEFT$(a$,2):q$=MID$(a$,8,1):r$=MID$(a$,15,1):ta=(p$="jm")+(p$="dj")+(p$="sp")
bad88=ta*(q$="#")+(ta=0)*(r$="#")+((q$="$")+(q$="@")+(r$="$")+(r$="@"))*(p$="da")+(r$="#")*((p$="cm")+(p$="sl")):RETURN
a:RESUME b 'uncomment RESUME for QBasic, comment for FreeBasic (to compile for Linux requires library with fixed SHELL)
b:ON ERROR GOTO c:j=(SIN(TIMER)+2)*100:FOR k=1 TO j:z=RND(1):NEXT k:g=INT(SQR(n)):OPEN "1.red" FOR INPUT AS #1:CLOSE:GOTO m
c:FOR k=1 TO n:OPEN LTRIM$(STR$(k))+".red" FOR OUTPUT AS #1:? #1,";assert 1":IF spl THEN ? #1,"spl    $    0,$    0"
FOR j=1-(spl<>0) TO INT(RND(1)*l+1):GOSUB mrcl:? #1,a$:NEXT j:CLOSE:NEXT k:RESUME m 'uncomment for QB, comment for FB
m:ON ERROR GOTO x:w1=INT(RND(1)*n)+1:IF ra>0 THEN w2=(w1+(1+INT(RND(1)*ra))*((RND(1)<.5)*2+1)) MOD n:IF w2<1 THEN w2=w2+n
IF ra<=0 THEN w2=w1:WHILE w2=w1:w2=w1+INT(RND(1)*3-1)+(INT(RND(1)*3-1)*g):WEND:w2=w2 MOD n:IF w2<1 THEN w2=w2+n
? STR$(w1);" vs";STR$(w2),:SHELL pmars$+STR$(w1)+".red"+STR$(w2)+".red >sc.txt":OPEN "sc.txt" FOR INPUT AS #1
INPUT #1,a$:z=INSTR(a$, "scores "):s1=VAL(MID$(a$,z+7)):INPUT #1,a$:z=INSTR(a$, "scores "):s2=VAL(MID$(a$,z+7)):CLOSE
? STR$(s1);STR$(s2);"  ",:IF s1>s2 THEN s=w1:d=w2:? STR$(s);" -->";STR$(d) ELSE s=w2:d=w1:? STR$(s);" -->";STR$(d)
OPEN LTRIM$(STR$(s))+".red" FOR INPUT AS #1:OPEN LTRIM$(STR$(d))+".red" FOR OUTPUT AS #2:INPUT #1,a$:PRINT #2,a$:k=0
WHILE NOT EOF(1):LINE INPUT #1,a$:w$=a$:x1=-(RND(1)<.5):x2=-(RND(1)<.5)   ' .---------------------------------------------.
IF RND(1)<del THEN IF NOT EOF(1) THEN LINE INPUT #1,a$:w$=a$  '|Config'd-|' | ======= Little Corewar Evolver v0.8 ======= |
IF RND(1)<inl THEN z$=a$:GOSUB prcl:IF RND(1)<dup THEN a$=z$  '|--for----|' | Requires pmars. 6/10/09 WTN (public domain) |
IF RND(1)<ins THEN a$=MID$(i$,INT(RND(1)*ei)*4+1,3)+MID$(a$,4)'|-QBasic--|' | Grid or ring topology, many mutate options  |
IF RND(1)<inm THEN a$=LEFT$(a$,3)+MID$(m$,INT(RND(1)*em)*3+1,3)+MID$(a$,7)' | Now does true 88. See LCE8.ini for settings |
IF RND(1)<adr THEN a$=LEFT$(a$,7)+MID$(d$,INT(RND(1)*ed)*2+1,1)+MID$(a$,9)' `---------------------------------------------'
IF RND(1)<chd THEN x=-(RND(1)<sn):a$=LEFT$(a$,8)+RIGHT$("   "+STR$(x*INT(RND(1)*l*2-l)+(1-x)*INT(RND(1)*cs)),5)+MID$(a$,14)
IF RND(1)<idd THEN a$=LEFT$(a$,8)+RIGHT$("   "+STR$(x1*(VAL(MID$(a$,9,5))+1)+(1-x1)*(VAL(MID$(a$,9,5))-1)),5)+MID$(a$,14)
IF RND(1)<adr THEN a$=LEFT$(a$,14)+MID$(d$,INT(RND(1)*ed)*2+1,1)+MID$(a$,16) '--> Supplied as-is and without warranty <---.
IF RND(1)<chd THEN x=-(RND(1)<sn):a$=LEFT$(a$,15)+RIGHT$("   "+STR$(x*INT(RND(1)*l*2-l)+(1-x)*INT(RND(1)*cs)),5)'|run on a|
IF RND(1)<idd THEN a$=LEFT$(a$,15)+RIGHT$("   "+STR$(x2*(VAL(MID$(a$,16,5))+1)+(1-x2)*(VAL(MID$(a$,16,5))-1)),5)'|ram disk|
IF z8 THEN GOSUB ck88:IF bad88 THEN a$=w$     'other variables... m$ d$ i$ defines code, em ed ei = # entries    `--------'
w:GOSUB prcl:WEND:CLOSE:IF INKEY$<>"q" GOTO m 'mutation... inl=insert,del=delete,ins=instruction,inm=modifier,adr=mode,
x:CLOSE:SYSTEM                                'chd=random data,idd=inc/dec data,dup=dup line if insert,sn=small # ratio
