rem === MEVO === Multi-threaded Evolver === 12/3/09 ===
rem Copyright 2009 by Terry Newton under the terms of the GNU General Public
rem License (GPL, v3 or above), see: http://www.gnu.org/licenses/gpl.html
rem Main terms are this software is provided as-is and without warranty,
rem and that this software may be distributed as-is or modified, provided
rem that the copyright notice remains intact and source code is included.
rem Further terms for this program are that modifications be clearly noted.
rem ------------------------------------------------------------------------
rem MEVO automatically creates redcode warriors for the game of Corewar
rem by applying simple principles of evolution to a population of warriors.
rem Requires pmars or exmars (set maxlen to 0 for stock exmars)
rem Requires pmarsv or pmarsw for visually running/battling warriors
rem This source is for freebasic (compile using fbc -mt mevo.bas)
rem ------------------------------------------------------------------------
#include "file.bi"
rem --- OS/display setup ---
dim shared usewin as integer = 0          '0 for linux 1 for windows
dim shared useuni as integer = 1          '0 for ascii 1 for unicode (UTF-8)
dim shared numberofthreads as integer = 1 'default number of parallel threads
dim shared textcolor as integer = 10      'color used for printing text
dim shared framecolor as integer = 11     'color used for drawing soup frame
dim shared mintermheight as integer = 24  'minimum term height when listing
dim startupcolor as integer = 2           'color used when starting
rem --- if linux exit if not running in a terminal
if usewin=0 then if environ("TERM")="" then system
rem --- display title
color startupcolor
cls
print
print "  MEVO - a Multi-threaded Evolver  "
print "  Copyright Terry Newton (GPL)     "
print "  Version date 12/3/09             "
print
sleep 1000
rem --- declare subs
declare sub DrawSoup()
declare sub Evolve()
declare sub WriteWarrior(byval as string,byval as integer,byval as integer,byval as integer)
declare sub ChangeData(byval as integer,byval as integer,byval as integer,byval as integer)
declare sub RunEvolveTask (byval as any ptr)
declare sub PerformBenchmark()
declare sub PerformReinsertion()
declare sub DisplayFile(byval as string)
declare sub TestWarrior(byval as integer,byval as integer)
declare sub RunWarrior(byval as integer,byval as integer)
declare sub BattleWarrior(byval as integer,byval as integer,byval as string)
rem --- array parameters
dim shared xsize as integer = 77    'number of warriors in X dimension
dim shared ysize as integer = 21    'number of warriors in Y dimension
dim shared maxsize as integer = 20  'maximum evolved size
dim shared xwrap as integer = 0     'enable side-side wraparound
dim shared ywrap as integer = 0     'enable top-bottom wraparound
dim shared instructions as string
dim shared modifiers as string
dim shared modes as string
dim shared ninstructions as integer
dim shared nmodifiers as integer
dim shared nmodes as integer
instructions = "nop mov mov mov mov mov spl spl spl spl djn djn djn dat"
instructions = instructions + " add sub mul div slt sne seq jmp jmn jmz mod"
modifiers = ".i .i .i .a .b .f .x .ab.ba"
modes = "$$#@*<>{}"
rem --- file parameters
dim pathsep as string
dim soupdir as string
dim souppath as string
dim tempdir as string
dim shared temppath as string
dim soupfile as string
dim inifile as string
soupdir = "soup"
tempdir = "temp"
soupfile = "soup.dat"
inifile = "mevo.ini"
rem --- pmars parameters
dim shared coresize as integer = 800
dim processes as integer = 800
dim cycles as integer = 8000
dim shared maxlen as integer = 20
dim mindist as integer = 20
dim rounds as integer = 50
dim pmarsbin as string
dim shared pmarsvbin as string
dim pmarsvopt as string
pmarsbin = "pmars"    'name of pmars binary
pmarsvbin = "pmarsv"  'name of pmarsv binary
pmarsvopt = "-v 444"  'pmarsv options
dim shared pmarscl as string
dim shared benchcl as string
dim shared pmarsvcl as string
rem --- evolving parameters
dim shared instrate as single = 0.02  'chance of instruction change
dim shared modrate as single = 0.03   'chance of modifier change
dim shared moderate as single = 0.04  'chance of mode change
dim shared datarate as single = 0.05  'chance of data change
dim shared insrate as single = 0.007  'chance of line insert
dim shared delrate as single = 0.01   'chance of line delete
dim shared swaprate as single = 0.01  'chance of line swap
dim shared dupline as single = 0.2    'if inserting, chance of dup line
dim shared incdec as single = 0.2     'if changing data, chance of inc/dec
dim shared bignum as single = 0.5     ' otherwise chance of big number
dim shared initmode as integer = 1    '0 for 1st elements, 1 for random
dim shared endrate as single = 0      'chance of changing end number
dim shared endincdec as single = 0.5  'if end changed, chance of inc/dec
dim shared end0chance as single = 1   'if end changed and not inc/dec, chance of 0
rem --- benchmark parameters and variables
dim shared benchcounter as integer    'counter to determine when to sample
dim shared reinsertcounter as integer 'counter to determine when to reinsert
dim shared topscore as single         'best bench score so far
dim shared topnumber as integer       'saved number of topscore warrior
dim shared benchscore as single       'bench score of warrior being tested
dim shared benchscorestring as string 'string version of score
dim enablebench as integer            '0 = no benchmarking, 1 = enable
dim shared reinsertmode as integer    '0 = none, 1 = top score, 2 = from save
dim shared benchinterval as integer = 1000  'sample when benchinterval >= benchcounter
dim shared reinsertinterval as integer = 2500 'reinsert when re'counter >= re'interval
dim shared savethresh as single = 93  'percentage of top score to save
dim shared benchrounds as integer = 200 'pmars rounds for benchmarking
dim shared benchdir as string         'directory containing bench warriors
dim shared testdir as string          'directory containing interface test warriors
dim shared savedir as string          'directory to save strong warriors to
dim shared topwarrior as string       'name of top-score warrior file
dim shared numberofbenchwarriors as integer
dim shared savepath as string
dim shared benchpath as string
dim shared lastsavedwarnum as integer
dim shared numberofbenchscores as integer
dim shared benchscorenumber as integer
dim shared benchdirname as string
dim shared warfile as string
dim shared benchfile as string
benchdir = "bench"
savedir = "save"
topwarrior = "top.red"
dim shared numberofbenchmasks as integer = 6
dim shared benchmask(1 to numberofbenchmasks) as string
benchmask(1)="*.red"
benchmask(2)="*.war"
benchmask(3)="*.rc"
benchmask(4)="*.RED"
benchmask(5)="*.WAR"
benchmask(6)="*.RC"
if usewin then numberofbenchmasks = numberofbenchmasks/2
dim shared maxnumberofbenchscores as integer = 500   'maximum number of saved scores
dim shared prevbenchscores(1 to maxnumberofbenchscores) as string 'for exactness
rem --- crossover variables
dim shared enablecross as integer      '0 = no crossover 1 = enable crossover
dim shared flipstart as single = .5    'chance of starting with winning warrior
dim shared flipmaterate as single = .3 'chance of switching to mate
dim shared flipbackrate as single = .3 'chance of switching back
dim shared anychance as single = 0     'chance of crossing with dissimilar warrior
dim shared bestchance as single = 1      'chance of crossing with warrior with most wins
rem --- other variables
dim shared infoline as string
infoline = "evolved"  'string used for strategy comment
dim i as integer
dim j as integer
dim k as integer
dim x as integer
dim y as integer
dim z as integer
dim s as integer
dim shared numberofspecies as integer = 10000  'total number of species tags
dim shared speciesthresh as single = 5  'percentage change for new species
dim shared threadsleep as integer = 25  'ms delay between thread launches
dim shared testpath as string  'separate path to test warriors (set to benchpath)
dim shared enablelog as integer = 0     'enable logging of activity
dim shared logfile as string            'name of log file
logfile = "mevo.log"
dim shared iterationcount as longint
dim shared temp as integer
dim shared tempstring as string
dim item as string
dim parm as string
dim instrflag as integer
dim modsflag as integer
dim modesflag as integer
dim shared thread as integer
dim shared threadselect as any ptr
dim shared as integer locx,locy
dim shared as string tlcorner,trcorner,blcorner,brcorner,hlinechr,vlinechr
rem --- read INI file
temp = open(inifile,for input,as #1)
if temp = 0 then
 instrflag = 0
 modsflag = 0
 modesflag = 0
 while not eof(1)
  line input #1,tempstring
  tempstring = ltrim(rtrim(tempstring))
  z = instr(tempstring,":")
  if z > 1 and z < len(tempstring) then
   item = rtrim(left(tempstring,z-1))
   parm = " " + mid(tempstring,z+1)
   z = instr(parm,";")
   if z then parm = left(parm,z-1)
   parm = ltrim(rtrim(parm))
   if item = "xsize" then xsize = val(parm)
   if item = "ysize" then ysize = val(parm)
   if item = "maxsize" then maxsize = val(parm)
   if item = "threads" then numberofthreads=val(parm)
   if item = "threadsleep" then threadsleep=val(parm)
   if item = "infoline" then infoline=parm
   if item = "coresize" then coresize = val(parm)
   if item = "processes" then processes = val(parm)
   if item = "cycles" then cycles = val(parm)
   if item = "maxlen" then maxlen = val(parm)
   if item = "mindist" then mindist = val(parm)
   if item = "rounds" then rounds = val(parm)
   if item = "pmarsbin" then pmarsbin = parm
   if item = "pmarsvbin" then pmarsvbin = parm
   if item = "pmarsvopt" then pmarsvopt = parm
   if item = "instrate" then instrate = val(parm)
   if item = "modrate" then modrate = val(parm)
   if item = "moderate" then moderate = val(parm)
   if item = "datarate" then datarate = val(parm)
   if item = "insrate" then insrate = val(parm)
   if item = "delrate" then delrate = val(parm)
   if item = "swaprate" then swaprate = val(parm)
   if item = "dupline" then dupline = val(parm)
   if item = "incdec" then incdec = val(parm)
   if item = "bignum" then bignum = val(parm)
   if item = "initmode" then initmode = val(parm)
   if item = "spthresh" then speciesthresh = val(parm)
   if item = "instructions" then
    if instrflag then
     instructions = instructions+" "+parm
    else
     instructions = parm
     instrflag = 1
    end if
   end if
   if item = "modifiers" then
    if modsflag then
     modifiers = modifiers+" "+parm
    else
     modifiers = parm
     modsflag = 1
    end if
   end if
   if item = "modes" then
    if modesflag then
     modes = modes+" "+parm
    else
     modes = parm
     modesflag = 1
    end if
   end if
   if item = "enablebench" then
    if lcase(parm) = "yes" then enablebench = 1 else enablebench = 0
   end if
   if item = "benchrounds" then benchrounds = val(parm)
   if item = "savethresh" then savethresh = val(parm)
   if item = "reinsertmode" then reinsertmode = val(parm)
   if item = "benchinterval" then benchinterval = val(parm)
   if item = "reinsertinterval" then reinsertinterval = val(parm)
   if item = "benchdir" then benchdir = parm
   if item = "savedir" then savedir = parm
   if item = "testdir" then testdir = parm
   if item = "enablelog" then
    if lcase(parm) = "yes" then enablelog = 1 else enablelog = 0
   end if
   if item = "displayopts" then
    'parse mintermheight, textcolor, framecolor and useuni from parm
    'a bit of code but want to allow for missing parms, spacing, etc
    parm = parm + ", "
    z = instr(parm,",")
    if z > 1 then
     tempstring=ltrim(rtrim(left(parm,z-1)))
     if len(tempstring)>0 then mintermheight=val(tempstring)
     parm=mid(parm,z+1)
    end if
    z = instr(parm,",")
    if z > 1 then
     tempstring=ltrim(rtrim(left(parm,z-1)))
     if len(tempstring)>0 then textcolor=val(tempstring)
     parm=mid(parm,z+1)
    end if
    z = instr(parm,",")
    if z > 1 then
     tempstring=ltrim(rtrim(left(parm,z-1)))
     if len(tempstring)>0 then framecolor=val(tempstring)
     parm=mid(parm,z+1)
    end if
    z = instr(parm,",")
    if z > 1 then
     tempstring=ltrim(rtrim(left(parm,z-1)))
     if len(tempstring)>0 then useuni=val(tempstring)
    end if
   end if 'displayops
   if item = "enablecross" then
    if lcase(parm) = "yes" then enablecross = 1 else enablecross = 0
   end if
   if item = "flipmaterate" then flipmaterate = val(parm)
   if item = "flipbackrate" then flipbackrate = val(parm)
   if item = "xwrap" then
    if lcase(parm) = "yes" then xwrap = 1 else xwrap = 0
   end if
   if item = "ywrap" then
    if lcase(parm) = "yes" then ywrap = 1 else ywrap = 0
   end if
   if item = "flipstart" then flipstart = val(parm)
   if item = "endrate" then endrate = val(parm)
   if item = "endincdec" then endincdec = val(parm)
   if item = "end0chance" then end0chance = val(parm)
   if item = "anychance" then anychance = val(parm)
   if item = "bestchance" then bestchance = val(parm)
  end if 'valid setting
 wend
 close #1
else
rem --- write default ini file
 open inifile for output as #1
 print #1,";ini file for mevo"
 print #1,"xsize:    ";str(xsize);"  ;width of soup"
 print #1,"ysize:    ";str(ysize);"  ;height of soup"
 print #1,"xwrap:    ";
 if xwrap then print #1, "yes"; else print #1, "no ";
 print #1," ;if yes enable side-side wraparound"
 print #1,"ywrap:    ";
 if ywrap then print #1, "yes"; else print #1, "no ";
 print #1," ;if yes enable top-bottom wraparound"
 print #1,"maxsize:  ";str(maxsize);"  ;max evolved length"
 print #1,";pmars parameters..."
 print #1,"coresize: ";str(coresize);"  ;size of core array"
 print #1,"processes:";str(processes);"  ;max processes"
 print #1,"cycles:   ";str(cycles);"  ;cycles before tie"
 print #1,"maxlen:   ";str(maxlen);"  ;maximum warrior length"
 print #1,"mindist:  ";str(mindist);"  ;minimum separation"
 print #1,"rounds:   ";str(rounds);"  ;# of battle rounds"
 print #1,"pmarsbin: ";pmarsbin;"  ;path/name of pmars binary"
 print #1,"pmarsvbin: ";pmarsvbin;"  ;path/name of pmarsv binary"
 print #1,"pmarsvopt: ";pmarsvopt;"  ;pmarsv view options etc"
 print #1,";mutation parameters..."
 print #1,"instrate: ";str(instrate);"  ;chance of instruction change"
 print #1,"modrate:  ";str(modrate);"  ;chance of modifier change"
 print #1,"moderate: ";str(moderate);"  ;chance of address mode change"
 print #1,"datarate: ";str(datarate);"  ;chance of field value change"
 print #1,"insrate:  ";str(insrate);"  ;chance of line insert"
 print #1,"delrate:  ";str(delrate);"  ;chance of line delete"
 print #1,"swaprate: ";str(swaprate);"  ;chance of line swap"
 print #1,"endrate:  ";str(endrate);"  ;chance of changing end number"
 print #1,"dupline:  ";str(dupline);"  ;if insert, chance of dup line"
 print #1,"incdec:   ";str(incdec);"  ;if data, chance of inc or dec"
 print #1,"bignum:   ";str(bignum);"  ;if data, chance of big number"
 print #1,"endincdec: ";str(endincdec);"  ;if end, chance of inc or dec"
 print #1,"end0chance: ";str(end0chance);"  ;chance of end 0"
 print #1,";crossover parameters..."
 print #1,"enablecross:  ";
 if enablecross then print #1,"yes"; else print #1,"no";
 print #1,"  ;if yes then cross with surrounding warrior"
 print #1,"flipstart: ";str(flipstart);"  ;chance of starting with winning warrior"
 print #1,"flipmaterate: ";str(flipmaterate);"  ;chance of changing to mate"
 print #1,"flipbackrate: ";str(flipbackrate);"  ;chance of flipping back"
 print #1,"anychance: ";str(anychance);"  ;chance of crossing with dissimilar warrior"
 print #1,"bestchance: ";str(bestchance);"  ;chance of crossing with warrior with most wins"
 print #1,";code generation..."
 print #1,"instructions: ";left(instructions,51)
 if len(instructions)>53 then print #1,"instructions: ";mid(instructions,53,51)
 print #1,"modifiers: ";modifiers
 print #1,"modes: ";modes
 print #1,";bench parameters..."
 print #1,"enablebench: ";
 if enablebench then print #1,"yes"; else print #1,"no";
 print #1,"  ;yes to enable auto-bench/re-ins"
 print #1,"benchrounds: ";str(benchrounds);"  ;rounds used for benchmarking"
 print #1,"savethresh: ";str(savethresh);"  ;percent of top score to save"
 print #1,"reinsertmode: ";str(reinsertmode);"  ;0=none 1=top.red 2=from save"
 print #1,"benchinterval: ";str(benchinterval);"  ;bench every n iterations (0=none)"
 print #1,"reinsertinterval: ";str(reinsertinterval);"  ;re-insert every n iterations (0=none)"
 print #1,"benchdir: ";benchdir;"  ;directory containing benchmark warriors"
 print #1,"savedir: ";savedir;"  ;directory to save warriors to"
 print #1,"testdir: ";testdir;"  ;directory for single-test warriors (def.benchdir)"
 print #1,";other parameters..."
 print #1,"initmode: ";str(initmode);"  ;start warriors 0=first inst, 1=random"
 print #1,"spthresh: ";str(speciesthresh);"  ;percent change before different color"
 print #1,"infoline: ";infoline;"  ;added to strategy line"
 print #1,"threads: ";str(numberofthreads);"  ;# of processing threads"
 print #1,"threadsleep: ";str(threadsleep);"  ;# ms to sleep between threads"
 print #1,"enablelog: ";
 if enablelog then print #1,"yes"; else print #1,"no";
 print #1,"  ;yes to log to mevo.log file"
 print #1,"displayopts: ";str(mintermheight);",";str(textcolor);",";str(framecolor);",";
 print #1,str(useuni);"  ;term height,text col,frame col,unicode"
 print #1,";end of ini file"
 close #1
end if
rem --- check critical variables (not to catch all errors)
temp = 0
if xsize > 130 or ysize > 100 then print "Soup is too big" : temp = 1
if xsize < 1 or ysize < 1 or xsize*ysize < numberofthreads*2 then print "Soup is too small" : temp = 1
if maxsize > 500 or maxsize < 2 or (maxsize > maxlen and maxlen <> 0) then print "Bad maxsize" : temp = 1
if numberofthreads < 1 or numberofthreads > 20 then print "Bad threads" : temp = 1
if instr(lcase(pmarsbin),"mars") = 0 then print "Bad pmarsbin" : temp = 1
if instr(lcase(pmarsvbin),"mars") = 0 then print "Bad pmarsvbin" : temp = 1
if enablebench and savedir = "" then print "Missing save dir" : temp = 1
if temp then sleep 1000 : system
if xsize > 77 or ysize > 21 then print "Soup is bigger than standard terminal" : temp = 1
if instr(pmarsvopt,"-v ") = 0 then print "Missing pmarsvopt -v option" : temp = 1
if benchdir = "" and testdir = "" then print "No bench or test dir specified" : temp = 1
if temp then sleep 1000
rem --- dimension variables
dim shared threadarray (1 to numberofthreads) as any ptr
dim shared threadnumber(1 to numberofthreads) as integer 'needed so ptr to the
for i=1 to numberofthreads:threadnumber(i)=i:next i      'thread number is stable
dim shared threadlock (1 to numberofthreads, 1 to 4) as integer
dim shared soup(1 to xsize, 1 to ysize, 1 to maxsize, 1 to 6) as integer
dim shared species(1 to xsize, 1 to ysize) as integer
dim shared generation(1 to xsize, 1 to ysize) as integer
dim shared warsize(1 to xsize, 1 to ysize) as integer
dim shared origin(1 to xsize, 1 to ysize) as string
dim shared wins(1 to xsize, 1 to ysize) as integer
dim shared endnum(1 to xsize, 1 to ysize) as integer
rem --- derive other variables
randomize timer
pmarscl = pmarsbin+" -bks "+str(coresize)+" -p "+str(processes)
pmarscl = pmarscl+" -c "+str(cycles)+" -d "+str(mindist)
if maxlen > 0 then pmarscl = pmarscl+" -l "+str(maxlen)
pmarscl = pmarscl+" -r "+str(rounds)+" "
benchcl = pmarsbin+" -bks "+str(coresize)+" -p "+str(processes)
benchcl = benchcl+" -c "+str(cycles)+" -d "+str(mindist)
if maxlen > 0 then benchcl = benchcl+" -l "+str(maxlen)
if coresize = 80 and benchrounds = 142 then
 benchcl = benchcl+" -P "
else
 benchcl = benchcl+" -r "+str(benchrounds)+" -F "+str(int(coresize/2))+" "
end if
pmarsvcl = pmarsvbin + " -bs "+str(coresize)+" -p "+str(processes)
pmarsvcl = pmarsvcl+" -c "+str(cycles)+" -d "+str(mindist)
if maxlen > 0 then
 pmarsvcl = pmarsvcl+" -l "+str(maxlen)
else
 pmarsvcl = pmarsvcl+" -l "+str(mindist)  'in case stock exmars is used
end if
pmarsvcl = pmarsvcl+" "+pmarsvopt+" "
ninstructions = int((len(instructions)+1)/4)
nmodifiers = int((len(modifiers)+1)/3)
nmodes = len(modes)
speciesthresh = speciesthresh/100 'convert percentage to float
savethresh = savethresh/100       'ditto for savethresh
if usewin then pathsep = "\" else pathsep = "/"
benchpath = benchdir + pathsep    'set path to benchmark warriors
if testdir = "" then
 testpath = benchpath 'set interface test path if not set
else
 testpath = testdir + pathsep
end if
rem --- set up soup box characters
if useuni then
 tlcorner = chr(&hE2)+chr(&h94)+chr(&h8C)
 trcorner = chr(&hE2)+chr(&h94)+chr(&h90)
 blcorner = chr(&hE2)+chr(&h94)+chr(&h94)
 brcorner = chr(&hE2)+chr(&h94)+chr(&h98)
 hlinechr = chr(&hE2)+chr(&h94)+chr(&h80)
 vlinechr = chr(&hE2)+chr(&h94)+chr(&h82)
else
 tlcorner = "."
 trcorner = "."
 blcorner = "`"
 brcorner = "'"
 hlinechr = "-"
 vlinechr = "|"
end if
rem --- if both intervals are 0 then disable benchmarking
if benchinterval = 0 and reinsertinterval = 0 then enablebench = 0
rem --- if benchmarking not enabled, then set both intervals to 0
if enablebench = 0 then benchinterval = 0 : reinsertinterval = 0
rem --- if benchmarking enabled make sure bench warriors exist
if enablebench then
 tempstring = ""
 for i = 1 to numberofbenchmasks
  if tempstring = "" then tempstring = dir(benchpath+benchmask(i))
 next i
 if tempstring = "" then
  print "Error - auto-bench enabled but no bench warriors found"
  sleep 1000
  system
 end if
end if
rem --- load soup array from soup file if exists
temp=open(soupfile,for input,as #1)
if temp=0 then
 dim evoend as integer
 print "Loading soup file..."
 line input #1,tempstring 'header
 z = instr(tempstring,":") 'see if soup file has iterationcount
 if z then iterationcount = val(mid(tempstring,z+1)) 'if present set it
 evoend = instr(tempstring,"(ee)") 'see if soup file has evolved end
 line input #1,instructions  'override settings in INI file
 line input #1,modifiers
 line input #1,modes
 ninstructions = int((len(instructions)+1)/4) 'recalc lengths
 nmodifiers = int((len(modifiers)+1)/3)
 nmodes = len(modes)
 input #1,x,y,z
 if x<>xsize or y<>ysize or z<>maxsize then
  close #1
  print "error - soup file doesn't match parms"
  sleep 1000
  system
 end if
 for x = 1 to xsize
  for y = 1 to ysize
   input #1,tempstring 'skip identifier
   input #1,warsize(x,y)
   input #1,species(x,y)
   input #1,generation(x,y)
   input #1,origin(x,y)
   s = warsize(x,y)
   for z = 1 to s
    for i = 1 to 6
     input #1,soup(x,y,z,i)
    next i
   next z
   if evoend then input #1,endnum(x,y)
  next y
 next x
 close #1
else
rem --- create random or zeroed soup
 print "Initializing..."
 for x = 1 to xsize
  for y = 1 to ysize
   s = int(rnd*maxsize)+1
   if maxsize<=5 then s=maxsize
   warsize(x,y)=s
   species(x,y)=int(rnd*numberofspecies)
   generation(x,y)=0
   origin(x,y)=str(x)+"_"+str(y)
   for z = 1 to s
    if initmode then
     soup(x,y,z,1)=int(rnd*ninstructions)
     soup(x,y,z,2)=int(rnd*nmodifiers)
     soup(x,y,z,3)=int(rnd*nmodes)
     ChangeData(x,y,z,4)
     soup(x,y,z,5)=int(rnd*nmodes)
     ChangeData(x,y,z,6)
    else
     for i = 1 to 6
      soup(x,y,z,i)=0
     next i
    end if
   next z
   if rnd < end0chance then
    endnum(x,y)=0
   else
    endnum(x,y)=int(rnd*s)
   end if
  next y
 next x
end if
rem --- if specified make temp dir and adjust path
if tempdir <> "" then
 mkdir(tempdir)
 temppath=tempdir+pathsep
 'otherwise temppath remains empty and temps go to current
end if
rem --- make sure another instance isn't running
if fileexists(temppath+"mevolock") then
 print "Error - another instance running"
 sleep 1000
 system
else
 open temppath+"mevolock" for output as #1
 close #1
end if
rem --- if benchmarking enabled make sure save directory exists,
rem --- derive benchdirname (strip path so only name appears in warrior)
rem --- scan saved warriors and add scores to prevbenchscores array
rem --- determine top score (from saved warriors, not top.red) and file #
rem --- determine highest saved warrior number
if enablebench then
 mkdir(savedir)
 savepath = savedir+pathsep
 benchdirname = benchdir
 temp = instr(benchdirname,pathsep)
 while temp > 0
  benchdirname = mid(benchdirname, temp+1)
  temp = instr(benchdirname,pathsep)
 wend
 warfile = dir(savepath+"*.red")
 if warfile <> "" then
  print "Scanning saved warriors..."
  do
   z = instr(warfile,".")  'find position of extension
   if z > 0 then z = val(left(warfile,z-1)) 'get numerical value of base name
   if z > lastsavedwarnum then lastsavedwarnum = z 'update last saved warrior
   if z > 0 then 'if a numbered file  (ignore non-numbered files)
    temp=open(savepath+warfile,for input,as #1) 'open file to check for score
    if temp=0 then 'if open successful
     while not eof(1)
      line input #1,tempstring
      if left(tempstring,12)=";benchscore " then
       if numberofbenchscores < maxnumberofbenchscores then
        numberofbenchscores=numberofbenchscores+1
       end if
       benchscorenumber = benchscorenumber+1
       if benchscorenumber > maxnumberofbenchscores then benchscorenumber = 1
       benchscorestring = mid(tempstring,13,6) 'spaces and all
       benchscore=val(benchscorestring)
       prevbenchscores(benchscorenumber)=benchscorestring
       if topscore < benchscore then
        topscore = benchscore
        topnumber = z 'file number of top-scoring warrior
       end if
      end if 'benchscore found
     wend
     close #1
    end if 'open successful
   end if 'numbered file
   warfile = dir()
  loop until warfile=""
 end if 'warriors in save dir
end if
rem ============= user interface ==========================
dim as integer exitprogram,gotkey
dim cursorx as integer = 1
dim cursory as integer = 1
dim refreshscreen as integer = 1
dim userkey as string
do
 if refreshscreen then DrawSoup()
 locate ysize+3,1,0
 color textcolor
 print space(77);chr(13);
 print " E) Evolve  L) List  R) Run  1-9) Battle  T) Test  Q) Quit ";
 do
  locate cursory+1,cursorx+1,1 'show cursor position
  while inkey<>"" : wend 'clear key buffer
  sleep                  'wait for a keypress
  userkey = inkey
  refreshscreen = 1
  gotkey = 1
  select case ucase(left(userkey,1))
   case "Q"
     exitprogram = 1
   case "E"
     locate ysize+3,1,0
     print space(77);chr(13);  'erase prompt text
     Evolve()          'run evolution until terminated
     refreshscreen = 0 'should not need to, don't obscure error messages
   case "L"
     WriteWarrior(temppath+"temp.war",1,cursorx,cursory)
     DisplayFile(temppath+"temp.war")
     kill temppath+"temp.war"
   case "T"
     TestWarrior(cursorx,cursory)
   case "R"
     RunWarrior(cursorx,cursory)
   case "1" to "9"
     BattleWarrior(cursorx,cursory,userkey)
   case chr(255) 'extended key
     if right(userkey,1) = "K" then cursorx = cursorx - 1
     if right(userkey,1) = "H" then cursory = cursory - 1
     if right(userkey,1) = "M" then cursorx = cursorx + 1
     if right(userkey,1) = "P" then cursory = cursory + 1
     if cursorx < 1 then cursorx = 1
     if cursory < 1 then cursory = 1
     if cursorx > xsize then cursorx = xsize
     if cursory > ysize then cursory = ysize
     gotkey = 0
   case else
     gotkey = 0
  end select
 loop until gotkey
loop until exitprogram
rem ============= end user interface ======================
locate ysize+3,1
print space(77);chr(13);
print "Saving soup...";
rem --- remove temps
for i = 1 to numberofthreads
 kill temppath+str(i)+"a"
 kill temppath+str(i)+"b"
 kill temppath+str(i)+"s"
next i
kill temppath+"mevolock"
rmdir(tempdir)
rem --- dump soup file
open soupfile for output as #1
print #1,"=== MEVO Soup Data File (ee) === iteration:";iterationcount
print #1,instructions
print #1,modifiers
print #1,modes
print #1,str(xsize);",";str(ysize);",";str(maxsize)
for x = 1 to xsize
 for y = 1 to ysize
  print #1,"warrior ";str(x);" ";str(y)
  print #1,str(warsize(x,y))
  print #1,str(species(x,y))
  print #1,str(generation(x,y))
  print #1,origin(x,y)
  s = warsize(x,y)
  for z = 1 to s
   print #1,str(soup(x,y,z,1));",";str(soup(x,y,z,2));",";
   print #1,str(soup(x,y,z,3));",";str(soup(x,y,z,4));",";
   print #1,str(soup(x,y,z,5));",";str(soup(x,y,z,6))
  next z
  print #1,str(endnum(x,y))
 next y
next x
close #1
rem --- dump warriors as files
if soupdir <> "" then
 mkdir(soupdir)
 souppath=soupdir+pathsep
endif
for x = 1 to xsize
 for y = 1 to ysize
  WriteWarrior(souppath+str(x)+"_"+str(y)+".red",1,x,y)
 next y
next x
print chr(13);space(20);chr(13);
system
rem ======================= subs ==========================
rem --- draw soup on screen
sub DrawSoup()
 dim as integer lx,ly,li
 dim tempstr as string
 cls
 color framecolor
 print tlcorner;:for li=1 to xsize:print hlinechr;:next li:print trcorner
 for ly=1 to ysize
  color framecolor:print vlinechr;
  for lx=1 to xsize
   li=warsize(lx,ly)
   if li < 10 then
    tempstr=str(li)
   else
    tempstr=chr(li+55)
   end if
   color species(lx,ly) mod 14 + 1
   print tempstr;
  next lx
  color framecolor:print vlinechr
 next ly
 print blcorner;:for li=1 to xsize:print hlinechr;:next li:print brcorner
end sub
rem ==============================
rem --- the evolve action - launches threads to perform
rem --- evolution until stopped by pressing the Esc key
sub Evolve()
 if enablelog then
  open logfile for append as #1
  print #1,"START,";date;",";time;",";str(iterationcount)
  close #1
 end if
 if topnumber > 0 then 'if top-scoring warrior exists
  locate ysize+3,30    'update top-score display
  color textcolor
  print "Top ";str(topnumber);" score=";left(str(topscore),6);
 end if
 if numberofthreads > 1 then threadselect = mutexcreate
 do
  if numberofthreads > 1 then
   for thread = 1 to numberofthreads
    if threadarray(thread)<>0 then threadwait(threadarray(thread))
    threadarray(thread)=threadcreate(@RunEvolveTask,@threadnumber(thread))
    if threadsleep > 0 then sleep threadsleep
   next thread
  else
   RunEvolveTask(@threadnumber(1))
   if threadsleep > 0 then sleep threadsleep
  end if
  iterationcount = iterationcount + numberofthreads
  rem --- bench stuff
  'the logic here is a bit convoluted... bench or reinsertion can be disabled
  'independently by setting the associated interval to 0, and need to trigger
  'at exactly the specified interval if a single thread. Careful here or bugs.
  if benchinterval > 0 then benchcounter = benchcounter+numberofthreads
  if reinsertinterval > 0 then reinsertcounter = reinsertcounter+numberofthreads
  if (benchinterval > 0 and benchcounter >= benchinterval) or _
     (reinsertinterval > 0 and reinsertcounter >= reinsertinterval) then
   if numberofthreads > 1 then
    for thread=1 to numberofthreads  'wait for all threads to finish
     if threadarray(thread)<>0 then threadwait(threadarray(thread))
     threadarray(thread)=0  'clear array so it won't try to wait on it
    next thread
   end if
   if benchinterval > 0 and benchcounter >= benchinterval then
    PerformBenchmark()
    benchcounter = 0
   end if
   if reinsertinterval > 0 and reinsertcounter > reinsertinterval then
    PerformReinsertion()
    reinsertcounter = 0
   end if
  end if 'bench or reinsert triggered
  rem --- end bench stuff
 loop until inkey=chr(27) 'loop until evolver is cancelled
 if numberofthreads > 1 then
  for thread=1 to numberofthreads  'wait for all threads to finish
   if threadarray(thread)<>0 then threadwait(threadarray(thread))
   threadarray(thread)=0
  next thread
  mutexdestroy threadselect
 end if
 if enablelog then
  open logfile for append as #1
  print #1,"STOP,";date;",";time;",";str(iterationcount)
  close #1
 end if
end sub
rem ==============================
rem --- write warrior
sub WriteWarrior(byval fname as string,byval handle as integer,byval sx as integer,byval sy as integer)
 dim as integer ss,sz,t
 ss = warsize(sx,sy)
 open fname for output as handle
 print #handle,";redcode"
 print #handle,";name ";str(sx);"_";str(sy)
 print #handle,";author mevo"
 print #handle,";strategy ";infoline
 print #handle,";generation ";str(generation(sx,sy))
 print #handle,";species ";str(species(sx,sy))
 print #handle,";origin ";origin(sx,sy)
 print #handle,";assert 1"
 for sz=1 to ss
  print #handle,mid(instructions,soup(sx,sy,sz,1)*4+1,3);
  print #handle,mid(modifiers,soup(sx,sy,sz,2)*3+1,3);" ";
  print #handle,mid(modes,soup(sx,sy,sz,3)+1,1);
  print #handle,str(soup(sx,sy,sz,4));",";
  print #handle,mid(modes,soup(sx,sy,sz,5)+1,1);
  print #handle,str(soup(sx,sy,sz,6))
 next sz
 t = endnum(sx,sy)
 if t > 0 then
  print #handle,"end ";str(t)
 else
  print #handle,"end"
 end if
 close handle
end sub
rem ==============================
rem --- change data
sub ChangeData(byval sx as integer,byval sy as integer,byval sz as integer,byval sk as integer)
 if rnd<bignum then
  soup(sx,sy,sz,sk)=int(rnd*coresize)-int(coresize/2)
 else
  soup(sx,sy,sz,sk)=int(rnd*maxsize*2)-maxsize
 end if
end sub
rem ==============================
rem --- the thread
sub RunEvolveTask(byval idp as any ptr) 'parm: thread number
 dim as integer id,ok,lz,li,lx1,ly1,lx2,ly2,s1,s2,t,wline1,wline2,changes
 dim as integer flipflag,xsrc,ysrc,xcross,ycross,cx,cy,cwins,cbest,cbetter
 dim as integer cstart,cstop,allowany,usebest
 dim tempstr as string
 id = *cast(integer ptr,idp)
 if numberofthreads > 1 then mutexlock threadselect
 do
  do
   lx1 = int(rnd*xsize)+1
   ly1 = int(rnd*ysize)+1
   lz = int(rnd*8)
   select case lz
    case 0: lx2=lx1-1:ly2=ly1-1
    case 1: lx2=lx1-1:ly2=ly1
    case 2: lx2=lx1-1:ly2=ly1+1
    case 3: lx2=lx1:ly2=ly1-1
    case 4: lx2=lx1:ly2=ly1+1
    case 5: lx2=lx1+1:ly2=ly1-1
    case 6: lx2=lx1+1:ly2=ly1
    case 7: lx2=lx1+1:ly2=ly1+1
   end select
   if xwrap then
    if lx2 < 1 then lx2 = lx2 + xsize
    if lx2 > xsize then lx2 = lx2 - xsize
   end if
   if ywrap then
    if ly2 < 1 then ly2 = ly2 + ysize
    if ly2 > ysize then ly2 = ly2 - ysize
   end if
  loop until lx2>0 and lx2<=xsize and ly2>0 and ly2<=ysize
  ok = 1
  if numberofthreads > 1 then
   for li=1 to numberofthreads
    if threadlock(li,1)=lx1 and threadlock(li,2)=ly1 then ok = 0
    if threadlock(li,3)=lx1 and threadlock(li,4)=ly1 then ok = 0
    if threadlock(li,1)=lx2 and threadlock(li,2)=ly2 then ok = 0
    if threadlock(li,3)=lx2 and threadlock(li,4)=ly2 then ok = 0
   next li
   if ok then
    threadlock(id,1)=lx1
    threadlock(id,2)=ly1
    threadlock(id,3)=lx2
    threadlock(id,4)=ly2
   end if
  end if
 loop until ok
 rem --- battle warriors in pmars
 WriteWarrior(temppath+str(id)+"a",id+10,lx1,ly1)
 WriteWarrior(temppath+str(id)+"b",id+10,lx2,ly2)
 tempstr=pmarscl+temppath+str(id)+"a "+temppath+str(id)+"b"
 if numberofthreads > 1 then mutexunlock threadselect
 if usewin then
  shell tempstr+" > "+temppath+str(id)+"s"
  open temppath+str(id)+"s" for input as #(id+10)
 else
  open pipe tempstr for input as #(id+10)
 end if
 if numberofthreads > 1 then mutexlock threadselect
 input #(id+10),tempstr
 lz = instr(tempstr," ")
 s1 = val(left(tempstr,lz))
 input #(id+10),tempstr
 lz = instr(tempstr," ")
 s2 = val(left(tempstr,lz))
 close #(id+10)
 rem --- determine winner, if 2nd tied or won then swap 1/2
 if s2 >= s1 then
  t=lx1 : lx1=lx2: lx2=t
  t=ly1 : ly1=ly2: ly2=t
 end if
 rem --- update wins array
 wins(lx1,ly1) = wins(lx1,ly1)+1
 wins(lx2,ly2) = 0
 rem --- copy 1 to 2 while making random changes
 xsrc = lx1
 ysrc = ly1
 if enablecross then
  allowany = 0  'flag to enable different size/species crosses
  usebest = 0  'flag to control crossover "attraction"
  if rnd < anychance then allowany = 1 'if set, occasionally allow all crosses
  if rnd < bestchance then usebest = 1 'if set cross with warrior with most wins
  xcross = 0
  ycross = 0
  cstart = int(rnd*8)  'random start direction for no bias
  cstop = cstart + 7   'scan 8 directions
  for li = cstart to cstop
   select case (li mod 8)  'reduce to 0-7
    case 0: cx=lx1-1:cy=ly1-1
    case 1: cx=lx1-1:cy=ly1
    case 2: cx=lx1-1:cy=ly1+1
    case 3: cx=lx1:cy=ly1-1
    case 4: cx=lx1:cy=ly1+1
    case 5: cx=lx1+1:cy=ly1-1
    case 6: cx=lx1+1:cy=ly1
    case 7: cx=lx1+1:cy=ly1+1
   end select
   'adjust if soup wrap selected...
   if xwrap then
    if cx < 1 then cx = cx + xsize
    if cx > xsize then cx = cx - xsize
   end if
   if ywrap then
    if cy < 1 then cy = cy + ysize
    if cy > ysize then cy = cy - ysize
   end if
   'check to see within grid limits...
   if cx > 0 and cx <= xsize and cy > 0 and cy <= ysize then
    'make sure it's not the warrior that just lost...
    if not (cx=lx2 and cy=ly2) then
     if allowany or species(cx,cy) = species(lx1,ly1) then
      if allowany or warsize(cx,cy) = warsize(lx1,ly1) then
       if usebest then 'choose a warrior that has the most wins
        cbetter = 0
        cwins = wins(cx,cy) 'minimize array access
        if cwins > cbest then  'always choose if more wins
         cbetter = 1
        else
         if cwins = cbest then 'sometimes choose if the same wins
          if rnd < .5 then cbetter = 1
         end if
        end if
        if cbetter then  'if better than previous considerations
         cbest = cwins   'update best
         xcross = cx     'indicate selection
         ycross = cy
        end if
       else 'don't discriminate
        xcross = cx  'just select last available one
        ycross = cy
       end if 'usebest
      end if 'same size
     end if 'same species
    end if 'not the warrior being mutated to
   end if 'selection is in range
  next li
  flipflag = 0
  if xcross > 0 then  'if mate found
   if rnd > flipstart then   'determine starting warrior
    flipflag = 1
    xsrc = xcross
    ysrc = ycross
   end if
  end if
 end if 'enable cross
 wline1 = 0  'initialize source and dest line counters
 wline2 = 0
 warsize(lx2,ly2)=warsize(lx1,ly1)
 origin(lx2,ly2)=origin(lx1,ly1)
 generation(lx2,ly2)=generation(lx1,ly1)+1
 species(lx2,ly2)=species(lx1,ly1)
 changes = 0
 endnum(lx2,ly2)=endnum(xsrc,ysrc) 'use end number of whichever is first
 do
  wline1 = wline1 + 1 'increment source line
  wline2 = wline2 + 1 'increment destination line
  if enablecross and xcross > 0 then
   if flipflag then 'account for possibility mate is smaller than winner
    if rnd < flipbackrate or wline1 > warsize(xcross,ycross) then
     flipflag = 0
     xsrc = lx1
     ysrc = ly1
    end if
   else
    if rnd < flipmaterate then
     if wline1 <= warsize(xcross,ycross) then 'only flip if a line is present
      flipflag = 1
      xsrc = xcross
      ysrc = ycross
     end if
    end if
   end if
  end if
  for li=1 to 6  'default copy line exactly
   soup(lx2,ly2,wline2,li)=soup(xsrc,ysrc,wline1,li)
  next li
  if flipflag then 'account for cross differences in changes count
   if soup(lx2,ly2,wline2,1)<>soup(lx1,ly1,wline1,1) then changes=changes+1
  end if
  if rnd < delrate and warsize(lx2,ly2) > 1 then 'delete line
   wline2 = wline2-1  'decrement dest line so next line will overwrite
   warsize(lx2,ly2)=warsize(lx2,ly2)-1
   changes = changes+1
  else
   if rnd < insrate then 'insert a new line..
    wline1 = wline1 - 1  'back up source pointer, replace current dest line
    if warsize(lx2,ly2) < maxsize then warsize(lx2,ly2)=warsize(lx2,ly2)+1
    if rnd < dupline and wline2 > 1 then 'copy previous line to new line
     for li=1 to 6
      soup(lx2,ly2,wline2,li)=soup(lx2,ly2,wline2-1,li)
     next li
    else 'make a random line
     soup(lx2,ly2,wline2,1)=int(rnd*ninstructions)
     soup(lx2,ly2,wline2,2)=int(rnd*nmodifiers)
     soup(lx2,ly2,wline2,3)=int(rnd*nmodes)
     ChangeData(lx2,ly2,wline2,4)
     soup(lx2,ly2,wline2,5)=int(rnd*nmodes)
     ChangeData(lx2,ly2,wline2,6)
    end if
    changes = changes+1
   end if 'insert line, further mutate the line
   if rnd < swaprate and wline2 > 1 then 'swap line with previous line
    for li=1 to 6
     t=soup(lx2,ly2,wline2,li)
     soup(lx2,ly2,wline2,li)=soup(lx2,ly2,wline2-1,li)
     soup(lx2,ly2,wline2-1,li)=t
    next li
    changes=changes+2
   end if
   if rnd < instrate then  'randomly pick a new instruction
    soup(lx2,ly2,wline2,1)=int(rnd*ninstructions)
    changes=changes+1
   end if                  'randomly pick new modifier and mode..
   if rnd < modrate then soup(lx2,ly2,wline2,2)=int(rnd*nmodifiers)
   if rnd < moderate then soup(lx2,ly2,wline2,3)=int(rnd*nmodes)
   if rnd < datarate then  'pick new field value
    if rnd < incdec then   'increment or decrement existing value
     soup(lx2,ly2,wline2,4)=soup(lx2,ly2,wline2,4)+int(rnd*2)*2-1
    else                   'pick new random value (weighted by bignum)
     ChangeData(lx2,ly2,wline2,4)
    end if
   end if                  'same for B mode and value..
   if rnd < moderate then soup(lx2,ly2,wline2,5)=int(rnd*nmodes)
   if rnd < datarate then
    if rnd < incdec then
     soup(lx2,ly2,wline2,6)=soup(lx2,ly2,wline2,6)+int(rnd*2)*2-1
    else
     ChangeData(lx2,ly2,wline2,6)
    end if
   end if
  end if 'delete line
 loop while wline1 < warsize(lx1,ly1) and wline2 < maxsize
 if rnd < endrate then  'evolve end number...
  t = endnum(lx2,ly2)
  if rnd < endincdec then
   if rnd < .5 then
    if t > 0 then t=t-1
   else
    if t < warsize(lx2,ly2) then t=t+1
   end if
  else
   if rnd < end0chance then
    t = 0
   else
    t = int(rnd*warsize(lx2,ly2)-1)+1
   end if
  end if
  if t <> endnum(lx2,ly2) then
   endnum(lx2,ly2)=t
   changes = changes+1  'count as a single change
  end if
 end if
 'make sure end number is valid...
 if endnum(lx2,ly2) >= warsize(lx2,ly2) then endnum(lx2,ly2)=warsize(lx2,ly2)-1
 'no change indication if not, would be a rare situation
 if changes > maxsize*speciesthresh then 'pick a new species/color
  species(lx2,ly2)=int(rnd*numberofspecies)
 end if
 rem --- plot warrior on screen
 li=warsize(lx2,ly2)
 if li < 10 then
  tempstr=str(li)
 else
  tempstr=chr(li+55)
 end if
 locate ly2+1,lx2+1,0
 color species(lx2,ly2) mod 14 + 1
 print tempstr;
 rem --- empty threadlocks
 if numberofthreads > 1 then
  threadlock(id,1)=0
  threadlock(id,2)=0
  threadlock(id,3)=0
  threadlock(id,4)=0
  mutexunlock threadselect
 end if
end sub
rem ==============================
rem --- benchmark warrior temp/1a (called from evolve loop)
rem --- if over savethresh of topscore then save it
rem --- if over topscore then save to topwarrior
sub PerformBenchmark()
 dim as integer wins,ties,maskcount,li,tempint
 dim as string savefile,tempstr,tempgen
 numberofbenchwarriors = 0
 benchscore = 0
 maskcount = 0
 savefile = "not saved" 'for logging
 warfile = temppath + "1a"
 do
  maskcount = maskcount+1
  benchfile = dir(benchpath+benchmask(maskcount))
 loop until benchfile <> "" or maskcount = numberofbenchmasks
 if benchfile <> "" then 'in case bench warriors removed while running
  do
   numberofbenchwarriors = numberofbenchwarriors + 1
   benchfile = benchpath + benchfile
   tempstr=benchcl+warfile+" "+benchfile
   if usewin then
    shell tempstr+" > "+temppath+"1s"
    open temppath+"1s" for input as #1
   else
    open pipe tempstr for input as #1
   end if
   input #1,tempstr
   close #1
   tempint = instr(tempstr," ")
   wins = val(left(tempstr,tempint))
   ties = val(mid(tempstr,tempint))
   benchscore = benchscore + wins * 3 + ties
   benchfile = dir()
   if benchfile = "" and maskcount < numberofbenchmasks then
    do
     maskcount = maskcount + 1
     benchfile = dir(benchpath+benchmask(maskcount))
    loop until benchfile <> "" or maskcount = numberofbenchmasks
   end if
  loop until benchfile = ""
  benchscore = (benchscore/numberofbenchwarriors)*(100/benchrounds)
  benchscorestring = left(str(benchscore)+"     ",6)
  if benchscore > topscore * savethresh then 'good enough to save
   tempint = 1
   for li = 1 to numberofbenchscores
    if prevbenchscores(li) = benchscorestring then tempint = 0
   next li
   if tempint then 'not a duplicate
    lastsavedwarnum = lastsavedwarnum + 1
    if numberofbenchscores < maxnumberofbenchscores then
     numberofbenchscores = numberofbenchscores + 1
    end if
    benchscorenumber = benchscorenumber + 1
    if benchscorenumber > maxnumberofbenchscores then benchscorenumber = 1
    prevbenchscores(benchscorenumber) = benchscorestring
    savefile = savepath + str(lastsavedwarnum)+".red"
    filecopy(warfile,savefile)
    open savefile for append as #1
    print #1,";benchscore ";benchscorestring;
    print #1," (";benchdirname;" ";str(benchrounds);" rounds)"
    close #1
    if benchscore > topscore + .0001 then
     topscore = benchscore
     topnumber = lastsavedwarnum
     filecopy(savefile,topwarrior)
     locate ysize+3,30
     color textcolor
     print "Top ";str(topnumber);" score=";left(str(topscore),6);"    ";
    end if
    locate ysize+3,2
    color textcolor
    print "Saved ";str(lastsavedwarnum);" score=";left(str(benchscore),6);"    ";
   end if 'not a duplicate
  end if 'good enough to save
  if enablelog then
   open warfile for input as #1   'open file to read generation
   tempgen = "unknown"
   while not eof(1)
    line input #1,tempstr
    if left(tempstr,12)=";generation " then tempgen = ltrim(mid(tempstr,13))
   wend
   close #1
   open logfile for append as #1
   print #1,"BENCH,";benchscorestring;",";left(str(topscore),6);",";
   print #1,tempgen;",";date;",";time;",";str(iterationcount);",";savefile
   close #1
  end if
 end if 'bench performed
end sub
rem ==============================
rem --- reinsert a warrior back into the soup
rem --- tricky... have to convert string format back to numbers
sub PerformReinsertion()
 dim as integer lx,ly,lz,li,num
 dim as string ts,wln
 warfile = ""
 if reinsertmode = 1 then 'reinsert top.red
  if fileexists(topwarrior) then warfile = topwarrior
 end if
 if reinsertmode = 2 then 'reinsert randomly selected saved warrior
  ts = savepath+str(int(rnd*lastsavedwarnum)+1)+".red"
  if fileexists(ts) then warfile = ts
 end if
 if warfile <> "" then
  temp = open(warfile,for input,as #1)
  if temp = 0 then
   lx = int(rnd*xsize)+1  'pick a random soup location to overwrite
   ly = int(rnd*ysize)+1
   lz = 0  'line counter
   generation(lx,ly) = 0  'defaults in case comments missing
   species(lx,ly) = 0
   origin(lx,ly) = ""
   while not eof(1)
    line input #1,wln
    wln=ltrim(rtrim(lcase(wln)))
    if left(wln,12)=";generation " then generation(lx,ly)=val(mid(wln,13))
    if left(wln,9)=";species " then species(lx,ly)=val(mid(wln,10))
    if left(wln,8)=";origin " then origin(lx,ly)=mid(wln,9)
    if left(wln,3)="end" then endnum(lx,ly) = val(mid(wln,5))
    if left(wln,1)<>";" and left(wln,3)<>"end" and lz < maxsize then 'looks like code
     ts=left(wln,3)  'instruction
     num=-1
     for li=0 to ninstructions-1
      if lcase(mid(instructions,li*4+1,3))=ts then num=li
     next li
     temp = instr(wln,",")
     if num>=0 and temp>7 and len(wln)>temp then 'matched instruction
      lz = lz + 1
      soup(lx,ly,lz,1)=num
      num=0
      ts=mid(wln,4,3) 'modifier
      if left(ts,1)="." or ts="   " then
       for li=0 to nmodifiers-1
        if lcase(mid(modifiers+" ",li*3+1,3))=ts then num=li
       next li
       wln=ltrim(mid(wln,7))
      else
       wln=ltrim(mid(wln,5))  'handle no-modifier tab hack
      end if
      soup(lx,ly,lz,2)=num
      ts=left(wln,1)
      num=0
      for li=0 to nmodes-1
       if mid(modes,li+1,1)=ts then num=li
      next li
      soup(lx,ly,lz,3)=num
      wln=mid(wln,2)
      temp=instr(wln,",")
      soup(lx,ly,lz,4)=val(left(wln,temp-1))
      wln=ltrim(mid(wln,temp+1))
      ts=left(wln,1)
      num=0
      for li=0 to nmodes-1
       if mid(modes,li+1,1)=ts then num = li
      next li
      soup(lx,ly,lz,5)=num
      wln=mid(wln,2)
      temp=instr(wln,";")
      if temp>1 then wln=left(wln,temp-1)
      soup(lx,ly,lz,6)=val(wln)
     end if 'matched instruction
    end if 'looks like code
   wend
   close #1
   warsize(lx,ly) = lz
   locate ysize+3,60
   color textcolor
   print "Last RI ";str(lx);" ";str(ly);"    ";
   if lz < 10 then
    ts=str(lz)
   else
    ts=chr(lz+55)
   end if
   locate ly+1,lx+1,0
   color species(lx,ly) mod 14 + 1
   print ts;
  end if 'valid file
 end if 'file picked
end sub
rem ==============================
rem --- display a file (uses handle 1)
rem --- limited to 1000 lines of 79 chars max
rem --- this is just a crude lister, nothing special
rem --- obvious keys.. up down to move, esc to exit
sub DisplayFile(byval fname as string)
 dim as integer aline,asize,dsize,ferror,li,bt,exitsub,validkey
 dim tmpstr as string
 dim afile(1 to 1000) as string
 color textcolor
 dsize = ysize + 3
 if dsize < mintermheight then dsize = mintermheight
 ferror = open(fname,for input,as #1)
 if ferror = 0 then
  asize = 0
  while asize < 1000 and not eof(1)
   line input #1,tmpstr   'get line from file
   asize = asize+1
   afile(asize)=left(tmpstr+space(79),79) 'space pad in array
  wend
  close #1
  bt = 1000     'calculate needed space lines at end
  if asize+dsize < 1000 then bt = asize+dsize
  if asize < 1000 then
   for li=asize+1 to bt     'add space lines to end of array
    afile(li)=space(79)
   next li
  end if
  aline = 1   'start at first line
  exitsub = 0
  cls
  do  'until exited
   locate 1,1,0
   for li=aline to aline+dsize-1     'print lines from array
    print afile(li);                 'no newline
    if li < aline+dsize-1 then print 'if not last line add newline
   next li
   do
    sleep  'wait for keypress
    tmpstr = inkey 'key keypress
    validkey = 1
    if left(tmpstr,1) = chr(255) then
     select case right(tmpstr,1)
      case "H"                  'cursor up
        aline = aline-1
        if aline < 1 then aline = 1
      case "P"                  'cursor down
        aline = aline+1
        if aline > asize-dsize+1 then aline = asize-dsize+1
        if aline < 1 then aline = 1 'handle files less than 1 screen
      case else
        validkey = 0
     end select
    else
     if tmpstr = chr(27) then   'exit
      exitsub = 1
      validkey = 1
     else
      validkey = 0
     end if
    end if
   loop until validkey
  loop until exitsub
 end if
end sub
rem ==============================
sub TestWarrior(byval sx as integer,byval sy as integer)
 dim as string tempstr,tempstr2,benchwarname
 dim as integer wins,ties,losses,maskcount,li,tempint
 dim warscore as single
 numberofbenchwarriors = 0
 benchscore = 0
 maskcount = 0
 do
  maskcount = maskcount+1
  benchfile = dir(testpath+benchmask(maskcount))
 loop until benchfile <> "" or maskcount = numberofbenchmasks
 if benchfile <> "" then 'benchmark warriors present
  warfile = temppath+"temp.war"
  WriteWarrior(warfile,1,sx,sy)
  open temppath+"temp.rep" for output as #2
  print #2,"Opponent              Wins  Ties  Loss  Score  Performance of ";str(sx);"_";str(sy)
  print #2,"--------------------  ----  ----  ----  -----  ------------------------------"
  color textcolor
  cls
  print "Performing warrior test..."
  do
   print benchfile
   benchwarname = benchfile 'save for default name without path
   numberofbenchwarriors = numberofbenchwarriors + 1
   benchfile = testpath + benchfile
   tempstr=benchcl+warfile+" "+benchfile
   if usewin then
    shell tempstr+" > "+temppath+"1s"
    open temppath+"1s" for input as #1
   else
    open pipe tempstr for input as #1
   end if
   input #1,tempstr
   close #1
   tempint = instr(tempstr," ")
   wins = val(left(tempstr,tempint))
   ties = val(mid(tempstr,tempint))
   losses = benchrounds - wins - ties
   warscore = wins * 3 + ties  'calc raw score for warrior
   benchscore = benchscore + warscore 'add raw score to cumulative score
   warscore = warscore * (100/benchrounds) 'adjust raw score for 0-300 range
   open benchfile for input as #1 'get name from bench warrior
   tempstr2 = ""
   while not eof(1)
    line input #1,tempstr
    if left(tempstr,6)=";name " then tempstr2=ltrim(rtrim(mid(tempstr,7)))
   wend
   close #1
   if tempstr2 <> "" then benchwarname = tempstr2 'assign if a name is present
   print #2,left(benchwarname+space(20),20);"  ";
   print #2,left(str(wins)+"    ",5);" ";left(str(ties)+"    ",5);" ";
   print #2,left(str(losses)+"    ",5);" ";
   print #2,left(str(warscore)+"    ",5);"  ";
   tempint = int(warscore/10)  'number of *'s for performance bar
   tempstr = ""
   if tempint > 0 then
    for li = 1 to tempint
     tempstr = tempstr+"*"
    next li
   end if
   print #2,tempstr
   benchfile = dir()  'get next benchmark warrior filename
   if benchfile = "" and maskcount < numberofbenchmasks then
    do
     maskcount = maskcount + 1
     benchfile = dir(testpath+benchmask(maskcount))
    loop until benchfile <> "" or maskcount = numberofbenchmasks
   end if
  loop until benchfile = ""
  benchscore = (benchscore/numberofbenchwarriors)*(100/benchrounds)
  print #2,"--------------------  ----  ----  ----  -----  ------------------------------"
  print #2,"Benchmark score: ";left(str(benchscore),6)
  close #2 'close the report file
  DisplayFile(temppath+"temp.rep")
  kill temppath+"temp.rep"
  kill temppath+"temp.war"
 end if
end sub
rem ==============================
sub RunWarrior(byval sx as integer,byval sy as integer)
 WriteWarrior(temppath+"temp.war",1,sx,sy)
 if usewin then
  color textcolor
  cls
  shell pmarsvcl+temppath+"temp.war"
 else
  open pipe pmarsvcl+temppath+"temp.war" for input as #1
  close #1
 end if
 kill temppath+"temp.war"
end sub
rem ==============================
sub BattleWarrior(byval sx as integer,byval sy as integer,byval numkey as string)
 dim tempstr as string
 dim as integer opx,opy
 select case numkey  'determine opponent coordinates in opx,opy
  case "1": opx=sx-1:opy=sy+1
  case "2": opx=sx  :opy=sy+1
  case "3": opx=sx+1:opy=sy+1
  case "4": opx=sx-1:opy=sy
  case "5": opx=sx  :opy=sy
  case "6": opx=sx+1:opy=sy
  case "7": opx=sx-1:opy=sy-1
  case "8": opx=sx  :opy=sy-1
  case "9": opx=sx+1:opy=sy-1
 end select
 if opx > 0 and opx <= xsize and opy > 0 and opy <= ysize then 'in range
  color textcolor
  WriteWarrior(temppath+"temp1.war",1,sx,sy)
  WriteWarrior(temppath+"temp2.war",1,opx,opy)
  if usewin then
   cls 'hard to predict how it'll behave so just clear and run pmarsv/pmarsw
   shell pmarsvcl+temppath+"temp1.war "+temppath+"temp2.war"
   print "(press a key)" 'always prompt to continue
   sleep
   tempstr = inkey
  else
   open pipe pmarsvcl+temppath+"temp1.war "+temppath+"temp2.war" for input as #1
   tempstr = ""
   if not eof(1) then line input #1,tempstr : tempstr=ltrim(tempstr)
   if tempstr <> "" then  'for Linux only clear if text is actually returned
    cls                   'if user aborts battle then don't bother user
    print tempstr
    while not eof(1)
     line input #1,tempstr
     print tempstr
    wend
    print "(press a key)"
    sleep
    tempstr = inkey
   end if
   close #1
  end if
  kill temppath+"temp1.war"
  kill temppath+"temp2.war"
 end if
end sub
rem ==============================
rem --- end of evolver
rem --- history...
rem 12/3/09  added anychance to occasionally cross dissimilar warriors
rem          added bestchance to control crossing with "best" warrior
rem 11/27/09 added end number mutation and options for rate, incdec and 0
rem 11/19/09 added xwrap and ywrap options to enable wraparound
rem          added flipstart option to select starting warrior for crossover
rem 10/2/09  added crossover and options to enable and set flip rates
rem 9/20/09  improved selection for battle warriors
rem          added option to set min lines, text/frame colors, unicode
rem          added separate color for starting up (and to avoid odd effect)
rem          modified pmarsv battle code for Linux to not prompt if cancelled
rem 9/19/09  finished writing the testdir setting code
rem 9/18/09  improved save dir scan to parse actual file numbers
rem          immediately display current top score when evolving
rem 9/16/09  added iteration counter and an option to log
rem          start bench and stop data to a mevo.log file
rem          fixed interval logic to count better (was off by 1)
rem          (B) fixed soup display for smaller soups
rem 9/14/09  comments and stuff, changed so ties are losses
rem          (B) modified line insert code to work on all lines
rem 9/13/09  moved evolve and display soup to subs with tweaks
rem          added subs for listing, running, battling and testing warriors
rem          added new INI parms pmarsvbin, pmarsvopt, threadsleep
rem          added key-based user interface code for exploring the soup
rem          more conservative thread code, none at all if just 1 thread
rem          fixed bugs in mutation and benchmark code
rem          license changed to GPL
rem 9/7/09   soup.dat file now includes code tables for self-sufficiency
rem          (to convert existing soup file add instructions,modifiers,modes)
rem          added automatic benchmarking and extraction and reinsertion
rem 9/6/09   added check for another instance, added check for linux
rem          to make sure env var TERM is set to avoid running raw binary
rem          removed some of the threadlocks to make it go faster
rem 9/5/09   initial release