CLS : PRINT : PRINT : PRINT : version$ = "1.2x5" PRINT " RedMixer Corewar Evolver " PRINT " Version 1.2x5(L)09.07.02 " PRINT " (C) Terry Newton (GPL) " PRINT : PRINT : showtime = 3: GOTO initialize REM REM RedMixer version 1.2 - Copyright 2009 Terry Newton REM Released under the GNU Public License (GPL, any version will do). REM Essentially that means this program is free to distribute provided REM the source code is provided and copyright(s) remain intact, REM and that this program is provided as-is and without warranty. REM For details see: http://www.gnu.org/licenses/licenses.html REM REM RedMixer evolves warrior programs for the game of CoreWar. REM It is very cpu and file intensive! best to run on a ram disk. REM Requires a version of the pmars program, pref. server v0.9.2 or above. REM Requires a version of pmarsv for visually running/battling warriors. REM Rename to pmars and pmarsv or edit redmixer.ini to specify path and name. REM REM Compiling and Running REM --------------------- REM For QBasic, set unixmode = 0 and uncomment all RESUME statements. REM Run using a command like: qbasic /run redmixer.bas REM For FreeBasic comment all RESUME statements, set unixmode = 1 if REM running under Linux, or set unixmode = 0 if running under Windows. REM Compile using a command like: [path/]fbc -e -lang qb redmixer.bas REM REM Note - compiling for Linux requires a libfb.a library with the SHELL REM command patched to avoid a file handle bug - workaround is to edit the REM src/rtlib/unix/libfb_sys_shell.c source file, comment out the calls to REM fb_hExitConsole and fb_hInitConsole, then rebuild and install the library. REM Prebuilt version is at: http://newton.freehostia.com/fb020shellmod.tar.gz REM REM Run the program to create the default INI file (set for nano), after REM running quit to edit redmixer.ini to make sure pmars and pmarsv settings REM are correct. To use the benchmark features test warriors must be in the REM directory specified by benchdir, warriors must match benchmask. REM REM Description REM ----------- REM RedMixer is patterned after REBS only it's written in a real language REM (simple QBasic but whatever, I can do without un-understandable code). REM Unlike REBS this evolver only does a grid, other topologies not supported. REM It is named "RedMixer" because 1) I'm no good at coming up with creative REM evolver names, 2) it's kind of like RedMaker so named similarly, and REM 3) implements a crossover scheme (the "Mix" part). With the crossmode REM parameter set to 0 it functions mostly like REBS with slightly more parms REM (separate chances/adrmode strings for the A/B fields). If crossmode is set REM to 1, it picks a cross partner of the same species (a tag that's changed REM when the instruction sequence changes by more than a certain amount). REM If crossmode is set to 2, it picks a partner of the same origin (a tag REM maintained from the creation of the initial random warrior). If crossmode REM is set to 3 then it picks a warrior that's the same size. If crossmose is REM set to 4 then picks any warrior. Furthermore, if the attraction flag is REM set to yes then out of the eligible cross warriors it picks the one with REM the most accumulated score (wins multiplied by average score) as a measure REM of worthiness. If no suitable cross warrior is found then it uses only REM mutation to produce the offspring. The randomspecies setting controls REM how the species tags are named, if disabled then uses the warrior's name REM based on position in the grid (default), this is useful for seeing how REM far a form has traveled in the soup. If randomspecies is enabled then it REM picks a random tag when the instructions change (without a .red at end), REM using the randomtagrange setting to determine the range of numbers. REM The number of possible tags is randomtagrange squared, this setting REM can be used to control the chance of "headless chicken" crossover. REM The specieschanges setting controls the percent of base instructions REM that can change and still be considered the same species. Insertion, REM deletion or end number change always triggers a species change. REM REM If displaysoup is enabled the program starts up to a user interface, REM which if first running with no warriors displays only Evolve and Quit REM options. When warriors are present the cursor can be moved to a warrior REM in the soup and keys pressed to list, run, battle and benchmark the REM selected warrior. The pmarsv program is required to run and battle REM warriors with a core display. A simple lister is built-in, edit the REM INI file to specify an external list program (such as LIST.COM). REM The benchmark function requires benchmark warriors to be in the REM directory specified in the INI file, edit as needed, if desired REM an external benchmark program can be specified, it is assumed it REM has its own "press any key", if not wrap in a batch with a pause. REM REM This version includes an automatic continuous benchmark feature, REM if enabled then at intervals the last winning warrior is benchmarked, REM if higher than the previous high score then the warrior is saved to REM a top-score warrior file. If above a certain score the warrior is also REM saved to a numbered file in a save directory. At intervals the current REM top-scoring warrior is reintroduced replacing last losing warrior. REM REM This version includes an ANSI "movie" feature where at intervals the soup REM "graphics" can be appended to a file which can be played back by copying REM to the screen in an environment which understands ANSI screen codes. REM For Linux or Cygwin the "cat" command displays, for WinXP an ANSI viewer REM can be used or edit config.nt, add ansi.sys and use command /c type file. REM ANSI files can be several dozen megabytes but they zip up nicely. REM writetestwarrior: REM this is the default test warrior for checking random warriors... PRINT #2, ";redcode" PRINT #2, ";name test warrior" PRINT #2, ";assert 1" PRINT #2, "jmp 0" PRINT #2, "end 0" RETURN initialize: REM important program constants... inifile$ = "redmixer.ini" 'name of INI file unixmode = 1 'set to 1 for Linux, 0 for Dos/Windows timedintro = 1 'set to 1 to use TIMER for intro delay, 0 for for/next delayconstant = 20000 'delay constant used for for/next intro delay breakavailable = 0 'set to 1 to permit control-C exiting (QBasic only) quitavailable = 1 'set to 1 if OK to Esc to quit (req's "server" pmars) 'Note - to run under QBasic all RESUME statements must be uncommented 'to compile using FreeBasic all RESUME statements must be commented RANDOMIZE TIMER IF unixmode THEN pathsymbol$ = "/" ELSE pathsymbol$ = "\" IF breakavailable AND unixmode = 0 THEN SHELL "break off" DIM wstats(7, 2) 'warrior stats - warriorsize wins avgscore DIM wstat$(7, 2) 'warrior strings - warriorname species origin REM ------ default parameters ----------------------------------------- pmars$ = "pmars" 'path/name of pmars binary coresize = 80 'size of core processes = 80 'how many processes are allowed cycles = 800 'how many cycles to run per round rounds = 100 'how many rounds to run per battle maxpmlen = 0 'maximum warrior length for pmars (if 0 then same as maxlen) maxlen = 5 'maximum evolved warrior length doublefixed = 0 'if not 0 do double-fixed battles soupdir$ = "soup" 'name of directory to put warriors in deletefile$ = "DeleteMe" 'name of file to delete to stop tempbase$ = "rmtemp" 'base name for temp files redcodeline$ = "redcode" 'redcode comment line authorline$ = "anonymous" 'author comment line versionline$ = "RedMixer " + version$ 'strategy Evolved by line minstartsize = 1 'minimum instructions for new warriors testnew = 0 'if not 0 test new warriors testwarrior$ = "test.red" 'name of warrior to test new warriors against mintestscore = 150 'minimum score to pass the new warrior xsize = 77 'number of warriors in X-dimension ysize = 21 'number of warriors in Y-dimension displaysoup = 1 'if not 0 then show soup while evolving screenlines = 0 'screen lines for listings (0=auto) colormethod = 2 '0=color by size 1=by origin 2=by species colorshift = 0 'to offset colors if needed textcolor = 2 'color used for border and stat text pmarsv$ = "pmarsv" 'path/name of pmarsv binary vparms$ = "-v 564" 'view parms for pmarsv listprog$ = "" 'external list program (empty for internal) benchdir$ = "nanotest" 'directory containing test warriors benchmask$ = "*.red" 'wildcard filemask for bench warriors benchrounds = 250 'number of rounds for benchmark battles benchfixed = 1 'if not 0 use fixed sequence for benchmark benchpermutate = 0 'if not 0 use permutate sequence for benchmark benchprog$ = "" 'path/name of external benchmark program benchinterval& = 0 'soup cycles per bench (0=disable) insertinterval& = 0 'soup cycles per reinsertion (0=disable) topwarrior$ = "top.red" 'name of file for current top-scoring warrior savedir$ = "save" 'directory to save all top-scoring warriors to savethresh = 135 'must score at least this to save to savedir instructions$ = "spl spl spl spl spl spl spl " instructions$ = instructions$ + "mov mov mov mov mov mov mov mov " instructions$ = instructions$ + "djn djn djn djn dat jmp jmn jmz " instructions$ = instructions$ + "sne seq add sub mul div mod " modifiers$ = "i i i f x a b ab ba " adrAmodes$ = "# $ @ * < > { } " adrBmodes$ = "# $ @ * < > { } " deletechance = .02 'chance of deleting a line insertchance = .02 'chance of inserting a line duplinechance = .1 'chance of inserted line being previous instchance = .02 'chance of changing an instruction modchance = .03 'chance of changing a modifier modeAchance = .03 'chance of changing A-field mode dataAchance = .05 'chance of changing A-field data dataAincdec = .5 'chance of inc/dec A-field data dataAsmall = .3 'chance of using small A-field number modeBchance = .03 'chance of changing B-field mode dataBchance = .05 'chance of changing B-field data dataBincdec = .5 'chance of inc/dec B-field data dataBsmall = .3 'chance of using small B-field number endchance = .05 'chance of changing end number endincdec = .5 'chance of inc/dec end number end0chance = .5 'chance of using end 0 crossmode = 1 '0=none 1=species 2=origin 3=size 4=any attraction = 1 'if not 0 pick surrounding mate with most wins flipstart = .5 'chance of starting with winning warrior flipitemchance = .07 'chance of flipping per item fliplinechance = .25 'chance of flipping per line randomspecies = 0 'if not 0 use random species tags randomtagrange = 20 'range of each number in random species tags specieschanges = 5 'percent instruction changes for same species enablemovie = 0 'if not 0 output ANSI frames frameinterval& = 5000 'number of battles between frames ansifile$ = "redmixer.ans" 'output file for ANSI movie (appends) REM ------------------------------------------------------------------- REM note... if default parms are changed then comment spacing may be REM off in the part that writes the default INI if none exists. If the REM default instructions$, modifiers$, adrmodes$ strings are changed then REM adjust the default INI prints accordingly. ON ERROR GOTO noinifile OPEN inifile$ FOR INPUT AS #1 PRINT "Reading INI file... "; ON ERROR GOTO fileerror tagcontrol1 = 0 tagcontrol2 = 0 tagcontrol3 = 0 tagcontrol4 = 0 WHILE NOT EOF(1) LINE INPUT #1, a$ GOSUB parseiniline IF tag$ = "pmars" THEN pmars$ = item$ IF tag$ = "coresize" THEN coresize = VAL(item$) IF tag$ = "processes" THEN processes = VAL(item$) IF tag$ = "cycles" THEN cycles = VAL(item$) IF tag$ = "rounds" THEN rounds = VAL(item$) IF tag$ = "maxpmlen" THEN maxpmlen = VAL(item$) IF tag$ = "maxlen" THEN maxlen = VAL(item$) IF tag$ = "doublefixed" THEN IF LCASE$(item$) = "yes" THEN doublefixed = 1 ELSE doublefixed = 0 END IF IF tag$ = "soupdir" THEN soupdir$ = item$ IF tag$ = "deletefile" THEN deletefile$ = item$ IF tag$ = "tempbase" THEN tempbase$ = item$ IF tag$ = "redcodeline" THEN redcodeline$ = item$ IF tag$ = "authorline" THEN authorline$ = item$ IF tag$ = "versionline" THEN versionline$ = item$ IF tag$ = "minstartsize" THEN minstartsize = VAL(item$) IF tag$ = "testnew" THEN IF LCASE$(item$) = "yes" THEN testnew = 1 ELSE testnew = 0 END IF IF tag$ = "testwarrior" THEN testwarrior$ = item$ IF tag$ = "mintestscore" THEN mintestscore = VAL(item$) IF tag$ = "xsize" THEN xsize = VAL(item$) IF tag$ = "ysize" THEN ysize = VAL(item$) IF tag$ = "displaysoup" THEN IF LCASE$(item$) = "yes" THEN displaysoup = 1 ELSE displaysoup = 0 END IF IF tag$ = "screenlines" THEN screenlines = VAL(item$) IF tag$ = "colormethod" THEN colormethod = VAL(item$) IF tag$ = "colorshift" THEN colorshift = VAL(item$) IF tag$ = "textcolor" THEN textcolor = VAL(item$) IF tag$ = "pmarsv" THEN pmarsv$ = item$ IF tag$ = "vparms" THEN vparms$ = item$ IF tag$ = "listprog" THEN listprog$ = item$ IF tag$ = "benchdir" THEN benchdir$ = item$ IF tag$ = "benchmask" THEN benchmask$ = item$ IF tag$ = "benchrounds" THEN benchrounds = VAL(item$) IF tag$ = "benchfixed" THEN IF LCASE$(item$) = "yes" THEN benchfixed = 1 ELSE benchfixed = 0 END IF IF tag$ = "benchpermutate" THEN IF LCASE$(item$) = "yes" THEN benchpermutate = 1 ELSE benchpermutate = 0 END IF IF tag$ = "benchprog" THEN benchprog$ = item$ IF tag$ = "benchinterval" THEN benchinterval& = VAL(item$) IF tag$ = "insertinterval" THEN insertinterval& = VAL(item$) IF tag$ = "topwarrior" THEN topwarrior$ = item$ IF tag$ = "savedir" THEN savedir$ = item$ IF tag$ = "savethresh" THEN savethresh = VAL(item$) IF tag$ = "instructions" THEN IF tagcontrol1 = 0 THEN tagcontrol1 = 1: instructions$ = "" instructions$ = instructions$ + item$ + " " END IF IF tag$ = "modifiers" THEN IF tagcontrol2 = 0 THEN tagcontrol2 = 1: modifiers$ = "" modifiers$ = modifiers$ + item$ + " " END IF IF tag$ = "adrAmodes" THEN IF tagcontrol3 = 0 THEN tagcontrol3 = 1: adrAmodes$ = "" adrAmodes$ = adrAmodes$ + item$ + " " END IF IF tag$ = "adrBmodes" THEN IF tagcontrol4 = 0 THEN tagcontrol4 = 1: adrBmodes$ = "" adrBmodes$ = adrBmodes$ + item$ + " " END IF IF tag$ = "deletechance" THEN deletechance = VAL(item$) IF tag$ = "insertchance" THEN insertchance = VAL(item$) IF tag$ = "duplinechance" THEN duplinechance = VAL(item$) IF tag$ = "instchance" THEN instchance = VAL(item$) IF tag$ = "modchance" THEN modchance = VAL(item$) IF tag$ = "modeAchance" THEN modeAchance = VAL(item$) IF tag$ = "dataAchance" THEN dataAchance = VAL(item$) IF tag$ = "dataAincdec" THEN dataAincdec = VAL(item$) IF tag$ = "dataAsmall" THEN dataAsmall = VAL(item$) IF tag$ = "modeBchance" THEN modeBchance = VAL(item$) IF tag$ = "dataBchance" THEN dataBchance = VAL(item$) IF tag$ = "dataBincdec" THEN dataBincdec = VAL(item$) IF tag$ = "dataBsmall" THEN dataBsmall = VAL(item$) IF tag$ = "endchance" THEN endchance = VAL(item$) IF tag$ = "endincdec" THEN endincdec = VAL(item$) IF tag$ = "end0chance" THEN end0chance = VAL(item$) IF tag$ = "crossmode" THEN crossmode = VAL(item$) IF tag$ = "attraction" THEN IF LCASE$(item$) = "yes" THEN attraction = 1 ELSE attraction = 0 END IF IF tag$ = "flipstart" THEN flipstart = VAL(item$) IF tag$ = "flipitemchance" THEN flipitemchance = VAL(item$) IF tag$ = "fliplinechance" THEN fliplinechance = VAL(item$) IF tag$ = "randomspecies" THEN IF LCASE$(item$) = "yes" THEN randomspecies = 1 ELSE randomspecies = 0 END IF IF tag$ = "randomtagrange" THEN randomtagrange = VAL(item$) IF tag$ = "specieschanges" THEN specieschanges = VAL(item$) IF tag$ = "enablemovie" THEN IF LCASE$(item$) = "yes" THEN enablemovie = 1 ELSE enablemovie = 0 END IF IF tag$ = "frameinterval" THEN frameinterval& = VAL(item$) IF tag$ = "ansifile" AND LEN(item$) > 0 THEN ansifile$ = item$ WEND CLOSE #1 PRINT "coresize="; LTRIM$(STR$(coresize)) GOTO validateparms parseiniline: tag$ = "" item$ = "" c = INSTR(a$, ";") IF c <> 1 THEN IF c > 2 THEN a$ = LEFT$(a$, c - 1) a$ = LTRIM$(RTRIM$(a$)) s = INSTR(a$, " ") IF s > 1 THEN tag$ = LEFT$(a$, s - 1) item$ = LTRIM$(MID$(a$, s)) ELSE tag$ = a$ 'this will trigger an error to alert user END IF END IF RETURN fileerror: 'RESUME fileerror1 fileerror1: CLOSE : PRINT "A file error occured." SYSTEM noinifile: 'RESUME noini1 noini1: CLOSE PRINT "Creating default INI file (coresize="; LTRIM$(RTRIM$(STR$(coresize))); ")" ON ERROR GOTO fileerror OPEN inifile$ FOR OUTPUT AS #2 PRINT #2, "; This is the settings file for RedMixer "; version$ PRINT #2, "; pmars parameters..." PRINT #2, "pmars "; pmars$; " ;path\name of pmars binary" PRINT #2, "coresize "; STR$(coresize); " ;size of core" PRINT #2, "processes "; STR$(processes); PRINT #2, " ;how many processes are allowed" PRINT #2, "cycles "; STR$(cycles); PRINT #2, " ;how many cycles to run per round" PRINT #2, "rounds "; STR$(rounds); PRINT #2, " ;how many rounds to run per battle" PRINT #2, "maxlen "; STR$(maxlen); " ;maximum evolved warrior length" PRINT #2, "maxpmlen "; STR$(maxpmlen); " ;-l -d numbers (0=same as maxlen)" PRINT #2, "doublefixed "; IF doublefixed = 0 THEN PRINT #2, "no "; ELSE PRINT #2, "yes"; PRINT #2, " ;if yes then do double-fixed battles" PRINT #2, "; file/start parameters..." PRINT #2, "soupdir "; soupdir$; PRINT #2, " ;name of directory to put warriors in" PRINT #2, "deletefile "; deletefile$; PRINT #2, " ;name of file to delete to stop" PRINT #2, "tempbase "; tempbase$; " ;base name for temp files" PRINT #2, "redcodeline "; redcodeline$; " ;redcode comment line" PRINT #2, "authorline "; authorline$; " ;author comment line" PRINT #2, "versionline "; versionline$; PRINT #2, " ;strategy Evolved by line (use to track parms)" PRINT #2, "minstartsize "; STR$(minstartsize); PRINT #2, " ;minimum instructions for new warriors" PRINT #2, "testnew "; IF testnew = 0 THEN PRINT #2, "no "; ELSE PRINT #2, "yes"; PRINT #2, " ;if yes test new warriors" PRINT #2, "testwarrior "; testwarrior$; PRINT #2, " ;name of warrior to test new warriors against" PRINT #2, "mintestscore "; STR$(mintestscore); PRINT #2, " ;minimum score to pass the new warrior" PRINT #2, "; soup/display/benchmark parameters..." PRINT #2, "xsize "; STR$(xsize); PRINT #2, " ;number of warriors in X-dimension" PRINT #2, "ysize "; STR$(ysize); PRINT #2, " ;number of warriors in Y-dimension" PRINT #2, "displaysoup "; IF displaysoup = 0 THEN PRINT #2, "no "; ELSE PRINT #2, "yes"; PRINT #2, " ;if yes then show the soup and user interface" PRINT #2, "screenlines "; STR$(screenlines); PRINT #2, " ;number of lines for listings (0=auto)" PRINT #2, "colormethod "; STR$(colormethod); PRINT #2, " ;0=color by size 1=by origin 2=by species" PRINT #2, "colorshift "; STR$(colorshift); PRINT #2, " ;to offset colors if needed" PRINT #2, "textcolor "; STR$(textcolor); PRINT #2, " ;color used for border and stat text" PRINT #2, "pmarsv "; pmarsv$; PRINT #2, " ;path\name of pmarsv program" PRINT #2, "vparms "; vparms$; PRINT #2, " ;rounds and display parms for pmarsv" PRINT #2, "listprog "; listprog$; PRINT #2, " ;path\name of external list program" PRINT #2, "benchdir "; benchdir$; PRINT #2, " ;directory containing test warriors" PRINT #2, "benchmask "; benchmask$; PRINT #2, " ;filemask for benchmark warriors" PRINT #2, "benchrounds "; STR$(benchrounds); PRINT #2, " ;number of rounds for benchmark battles" PRINT #2, "benchfixed "; IF benchfixed = 0 THEN PRINT #2, "no "; ELSE PRINT #2, "yes"; PRINT #2, " ;if yes then use fixed sequence for benchmark" PRINT #2, "benchpermutate "; IF benchpermutate = 0 THEN PRINT #2, "no "; ELSE PRINT #2, "yes"; PRINT #2, " ;if yes then use -P option (req's pmars 0.9.2+)" PRINT #2, "benchprog "; benchprog$; PRINT #2, " ;path\name of external benchmark program" PRINT #2, "; auto-bench/reinsertion parameters..." PRINT #2, "benchinterval "; STR$(benchinterval&); PRINT #2, " ;soup cycles per bench (0=disable)" PRINT #2, "insertinterval "; STR$(insertinterval&); PRINT #2, " ;soup cycles per reinsertion (0=disable)" PRINT #2, "topwarrior "; topwarrior$; PRINT #2, " ;name of file for current top-scoring warrior" PRINT #2, "savedir "; savedir$; PRINT #2, " ;directory to save all top-scoring warriors to" PRINT #2, "savethresh "; STR$(savethresh); PRINT #2, " ;must score at least this to save to savedir" PRINT #2, "; redcode strings... maintain field structure..." REM cheating here to avoid having to deparse strings to multiple lines REM change if default instructions, modifiers or address modes change PRINT #2, "instructions spl spl spl spl spl spl spl spl" PRINT #2, "instructions mov mov mov mov mov mov mov mov" PRINT #2, "instructions djn djn djn djn dat jmp jmn jmz" PRINT #2, "instructions sne seq add sub mul div mod" PRINT #2, "modifiers i i i f x a b ab ba" PRINT #2, "adrAmodes # $ @ * < > { }" PRINT #2, "adrBmodes # $ @ * < > { }" PRINT #2, "; mutation parameters..." PRINT #2, "deletechance "; STR$(deletechance); PRINT #2, " ;chance of deleting a line" PRINT #2, "insertchance "; STR$(insertchance); PRINT #2, " ;chance of inserting a line" PRINT #2, "duplinechance "; STR$(duplinechance); PRINT #2, " ;chance of inserted line being previous" PRINT #2, "instchance "; STR$(instchance); PRINT #2, " ;chance of changing an instruction" PRINT #2, "modchance "; STR$(modchance); PRINT #2, " ;chance of changing a modifier" PRINT #2, "modeAchance "; STR$(modeAchance); PRINT #2, " ;chance of changing A-field mode" PRINT #2, "dataAchance "; STR$(dataAchance); PRINT #2, " ;chance of changing A-field data" PRINT #2, "dataAincdec "; STR$(dataAincdec); PRINT #2, " ;chance of inc/dec A-field data" PRINT #2, "dataAsmall "; STR$(dataAsmall); PRINT #2, " ;chance of using small A-field number" PRINT #2, "modeBchance "; STR$(modeBchance); PRINT #2, " ;chance of changing B-field mode" PRINT #2, "dataBchance "; STR$(dataBchance); PRINT #2, " ;chance of changing B-field data" PRINT #2, "dataBincdec "; STR$(dataBincdec); PRINT #2, " ;chance of inc/dec B-field data" PRINT #2, "dataBsmall "; STR$(dataBsmall); PRINT #2, " ;chance of using small B-field number" PRINT #2, "endchance "; STR$(endchance); PRINT #2, " ;chance of changing end number" PRINT #2, "endincdec "; STR$(endincdec); PRINT #2, " ;chance of inc/dec end number" PRINT #2, "end0chance "; STR$(end0chance); PRINT #2, " ;chance of using end 0" PRINT #2, "; crossover/species parameters..." PRINT #2, "crossmode "; STR$(crossmode); PRINT #2, " ;0=none 1=species 2=origin 3=size 4=any" PRINT #2, "attraction "; IF attraction = 0 THEN PRINT #2, "no "; ELSE PRINT #2, "yes"; PRINT #2, " ;if yes pick surrounding mate with most wins" PRINT #2, "flipstart "; STR$(flipstart); PRINT #2, " ;chance of starting with winning warrior" PRINT #2, "flipitemchance "; STR$(flipitemchance); PRINT #2, " ;chance of flipping per item" PRINT #2, "fliplinechance "; STR$(fliplinechance); PRINT #2, " ;chance of flipping per line" PRINT #2, "randomspecies "; IF randomspecies THEN PRINT #2, "yes"; ELSE PRINT #2, "no "; PRINT #2, " ;if yes then use random numbers for species tag" PRINT #2, "randomtagrange "; STR$(randomtagrange); PRINT #2, " ;range of each number in random species tags" PRINT #2, "specieschanges "; STR$(specieschanges); PRINT #2, " ;percent instruction changes for same species" PRINT #2, "; ANSI movie settings..." PRINT #2, "enablemovie "; IF enablemovie THEN PRINT #2, "yes"; ELSE PRINT #2, "no "; PRINT #2, " ;set to yes to enable ansi movie" PRINT #2, "frameinterval "; STR$(frameinterval&); PRINT #2, " ;number of battles between frames" PRINT #2, "ansifile "; ansifile$; PRINT #2, " ;ansi output file (appends)" PRINT #2, "; end of parameters" CLOSE #2 GOTO validateparms generalerror: CLOSE : PRINT "An error occured." SYSTEM validateparms: ON ERROR GOTO generalerror ' adjust optional parameters... IF maxpmlen = 0 THEN maxpmlen = maxlen IF screenlines = 0 THEN screenlines = ysize + 3: IF screenlines < 22 THEN screenlines = 22 perr = 0 IF pmars$ = "" THEN PRINT "No pmars specified": perr = 1 IF coresize < 40 OR coresize > 8192 OR INT(coresize) <> coresize THEN PRINT "Bad coresize": perr = 1 IF processes < 40 OR processes > 8192 OR INT(processes) <> processes THEN PRINT "Bad processes": perr = 1 IF cycles < 40 OR cycles > 100000 OR INT(cycles) <> cycles THEN PRINT "Bad cycles": perr = 1 IF rounds < 1 OR rounds > 1666 OR INT(rounds) <> rounds THEN PRINT "Bad rounds": perr = 1 IF maxpmlen < 1 OR maxpmlen > 1000 OR INT(maxpmlen) <> maxpmlen THEN PRINT "Bad maxpmlen": perr = 1 IF maxlen < 1 OR maxlen > maxpmlen OR INT(maxlen) <> maxlen THEN PRINT "Bad maxlen": perr = 1 IF soupdir$ = "" THEN PRINT "No soupdir specified": perr = 1 IF deletefile$ = "" THEN PRINT "No deletefile specified": perr = 1 IF tempbase$ = "" THEN PRINT "No tempbase specified": perr = 1 IF redcodeline$ = "" THEN PRINT "No redcodeline specified": perr = 1 IF authorline$ = "" THEN PRINT "No authorline specified": perr = 1 IF versionline$ = "" THEN PRINT "No versionline specified": perr = 1 IF minstartsize < 1 OR minstartsize > maxlen OR INT(minstartsize) <> minstartsize THEN PRINT "Bad minstartsize": perr = 1 IF testwarrior$ = "" THEN PRINT "No testwarrior specified": perr = 1 IF mintestscore < 0 OR mintestscore > 300 THEN PRINT "Bad mintestscore": perr = 1 IF xsize < 3 OR xsize > 999 OR INT(xsize) <> xsize THEN PRINT "Bad xsize": perr = 1 IF ysize < 3 OR ysize > 999 OR INT(ysize) <> ysize THEN PRINT "Bad ysize": perr = 1 IF displaysoup AND (xsize > 77 OR ysize > 46 OR ysize > (screenlines - 3)) THEN PRINT "Note: size exceeds screen" IF colormethod <> 0 AND colormethod <> 1 AND colormethod <> 2 THEN PRINT "Bad colormethod": perr = 1 IF colorshift < 0 OR colorshift > 14 OR INT(colorshift) <> colorshift THEN PRINT "Bad colorshift": perr = 1 IF textcolor < 1 OR textcolor > 15 OR INT(textcolor) <> textcolor THEN PRINT "Bad textcolor": perr = 1 IF pmarsv$ = "" THEN PRINT "No pmarsv specified": perr = 1 p = INSTR(vparms$ + " ", "-v "): IF p = 0 THEN PRINT "Note: no -v in vparms specified" IF p > 0 THEN a = 0: a$ = MID$(vparms$ + " ", p + 3, 4): IF RIGHT$(a$, 1) <> " " THEN a = 1 FOR i = 1 TO 3: b$ = MID$(vparms$, p + 2 + i, 1): IF b$ < "0" OR b$ > "9" THEN a = 1 NEXT i: IF a THEN PRINT "Note: invalid -v setting in vparms" END IF IF benchdir$ = "" THEN PRINT "No benchdir specified": perr = 1 IF benchrounds < 1 OR INT(benchrounds) <> benchrounds THEN PRINT "Bad benchrounds": perr = 1 IF benchrounds > 1999 AND benchrounds < 3334 THEN PRINT "Note: high benchrounds may truncate ties" IF benchrounds > 3333 THEN PRINT "Note: high benchrounds may truncate individual results" a = LEN(instructions$): IF a = 0 OR INT(a / 4) <> (a / 4) THEN PRINT "Bad instructions string(s)": perr = 1 IF a >= 4 THEN sperr = 0: FOR i = 4 TO LEN(instructions$) STEP 4 IF MID$(instructions$, i, 1) <> " " THEN sperr = 1: perr = 1 NEXT i: IF sperr THEN PRINT "Spacing of instructions string(s) incorrect" END IF a = LEN(modifiers$): IF a = 0 OR INT(a / 3) <> (a / 3) THEN PRINT "Bad modifier string(s)": perr = 1 IF a >= 3 THEN sperr = 0: FOR i = 3 TO LEN(modifiers$) STEP 3 IF MID$(modifiers$, i, 1) <> " " THEN sperr = 1: perr = 1 NEXT i: IF sperr THEN PRINT "Spacing of modifiers string(s) incorrect" END IF a = LEN(adrAmodes$): IF a = 0 OR INT(a / 2) <> (a / 2) THEN PRINT "Bad adrAmodes string(s)": perr = 1 IF a >= 2 THEN sperr = 0: FOR i = 2 TO LEN(adrAmodes$) STEP 2 IF MID$(adrAmodes$, i, 1) <> " " THEN sperr = 1: perr = 1 NEXT i: IF sperr THEN PRINT "Spacing of adrAmodes string(s) incorrect" END IF a = LEN(adrBmodes$): IF a = 0 OR INT(a / 2) <> (a / 2) THEN PRINT "Bad adrBmodes string(s)": perr = 1 IF a >= 2 THEN sperr = 0: FOR i = 2 TO LEN(adrBmodes$) STEP 2 IF MID$(adrBmodes$, i, 1) <> " " THEN sperr = 1: perr = 1 NEXT i: IF sperr THEN PRINT "Spacing of adrBmodes string(s) incorrect" END IF IF deletechance < 0 OR deletechance > 1 THEN PRINT "Bad deletechance": perr = 1 IF insertchance < 0 OR insertchance > 1 THEN PRINT "Bad insertchance": perr = 1 IF duplinechance < 0 OR duplinechance > 1 THEN PRINT "Bad duplinechance": perr = 1 IF instchance < 0 OR instchance > 1 THEN PRINT "Bad instchance": perr = 1 IF modchance < 0 OR modchance > 1 THEN PRINT "Bad modchance": perr = 1 IF modeAchance < 0 OR modeAchance > 1 THEN PRINT "Bad modeAchance": perr = 1 IF dataAchance < 0 OR dataAchance > 1 THEN PRINT "Bad dataAchance": perr = 1 IF dataAincdec < 0 OR dataAincdec > 1 THEN PRINT "Bad dataAincdec": perr = 1 IF dataAsmall < 0 OR dataAsmall > 1 THEN PRINT "Bad dataAsmall": perr = 1 IF modeBchance < 0 OR modeBchance > 1 THEN PRINT "Bad modeBchance": perr = 1 IF dataBchance < 0 OR dataBchance > 1 THEN PRINT "Bad dataBchance": perr = 1 IF dataBincdec < 0 OR dataBincdec > 1 THEN PRINT "Bad dataBincdec": perr = 1 IF dataBsmall < 0 OR dataBsmall > 1 THEN PRINT "Bad dataBsmall": perr = 1 IF endchance < 0 OR endchance > 1 THEN PRINT "Bad endchance": perr = 1 IF endincdec < 0 OR endincdec > 1 THEN PRINT "Bad endincdec": perr = 1 IF end0chance < 0 OR end0chance > 1 THEN PRINT "Bad end0chance": perr = 1 IF INT(crossmode) <> crossmode OR crossmode < 0 OR crossmode > 4 THEN PRINT "Bad crossmode": perr = 1 IF flipstart < 0 OR flipstart > 1 THEN PRINT "Bad flipstart": perr = 1 IF flipitemchance < 0 OR flipitemchance > 1 THEN PRINT "Bad flipitemchance": perr = 1 IF fliplinechance < 0 OR fliplinechance > 1 THEN PRINT "Bad fliplinechance": perr = 1 IF randomtagrange < 1 OR INT(randomtagrange) <> randomtagrange THEN PRINT "Bad randomtagrange": perr = 1 IF specieschanges < 0 OR specieschanges > 100 THEN PRINT "Bad specieschanges": perr = 1 IF enablemovie THEN IF ansifile$ = "" THEN PRINT "No ANSI file specified": perr = 1 IF frameinterval& < 50 THEN PRINT "Bad frameinterval": perr = 1 IF perr = 0 THEN PRINT "ANSI movie enabled, will write large file to ";ansifile$ IF perr = 0 AND frameinterval& < 1000 THEN PRINT "Note: frameinterval low, will make huge file!" PRINT "Say yes to confirm: ";: LINE INPUT a$: IF a$ <> "yes" THEN perr = 1 END IF END IF IF benchinterval& > 0 AND savedir$ = "" THEN PRINT "No savedir": perr = 1 IF (benchinterval& + insertinterval&) > 0 AND topwarrior$ = "" THEN PRINT "No topwarrior": perr = 1 IF benchinterval& > 0 AND (savethresh < 0 OR savethresh > 300) THEN PRINT "Bad savethresh": perr = 1 IF perr THEN PRINT "Can't continue, fix INI file or remove to recreate." SYSTEM END IF REM parameters appear consistent REM if displaysoup enabled then dimension speed-up array IF displaysoup THEN DIM sdarray%(ysize, xsize, 4) REM (y, x, 0) = warriorsize REM (y, x, 1) = Y part of origin (y, x, 2) = X part of origin REM (y, x, 3) = Y part of species (y, x, 4) = X part of species REM make sure soup directory exists ON ERROR GOTO nosoupdir OPEN soupdir$ + pathsymbol$ + "testdir.tmp" FOR OUTPUT AS #2 ON ERROR GOTO generalerror CLOSE #2 KILL soupdir$ + pathsymbol$ + "testdir.tmp" GOTO endofsoupcheck nosoupdir: 'RESUME nosoupdir1 nosoupdir1: ON ERROR GOTO generalerror CLOSE PRINT "Creating "; soupdir$; " directory" SHELL "mkdir " + soupdir$ OPEN soupdir$ + pathsymbol$ + "testdir.tmp" FOR OUTPUT AS #2 CLOSE #2 KILL soupdir$ + pathsymbol$ + "testdir.tmp" endofsoupcheck: REM if testnew specified make sure testwarrior exists IF testnew THEN ON ERROR GOTO notestwarrior OPEN testwarrior$ FOR INPUT AS #1 ON ERROR GOTO generalerror CLOSE END IF GOTO endoftestwarriorcheck notestwarrior: 'RESUME notestwarrior1 notestwarrior1: ON ERROR GOTO generalerror CLOSE PRINT "Creating test warrior in "; testwarrior$ OPEN testwarrior$ FOR OUTPUT AS #2 GOSUB writetestwarrior CLOSE #2 endoftestwarriorcheck: REM if benchinterval specified make list of benchmark warriors IF benchinterval& > 0 THEN 'first make sure dir exists ON ERROR GOTO nobenchdir OPEN benchdir$ + pathsymbol$ + "testdir.tmp" FOR OUTPUT AS #2 ON ERROR GOTO generalerror CLOSE #2 KILL benchdir$ + pathsymbol$ + "testdir.tmp" 'bench dir exists, make benchmark list 'the following line assumes standard commands dos/win and 'nix IF unixmode THEN dircmd$ = "ls -1 " ELSE dircmd$ = "dir /b " SHELL dircmd$ + benchdir$ + pathsymbol$ + benchmask$ + " > " + tempbase$ + ".tmp" 'if dos then add path info ON ERROR GOTO fileerror OPEN tempbase$ + ".tmp" FOR INPUT AS #1 OPEN tempbase$ + ".bmk" FOR OUTPUT AS #2 WHILE NOT EOF(1) LINE INPUT #1, a$ IF unixmode = 0 THEN a$ = benchdir$ + pathsymbol$ + a$ PRINT #2, a$ WEND CLOSE #1: CLOSE #2 KILL tempbase$ + ".tmp" 'make sure 1st entry is actually a file OPEN tempbase$ + ".bmk" FOR INPUT AS #1 LINE INPUT #1, a$ CLOSE #1 ON ERROR GOTO badbenchset OPEN a$ FOR INPUT AS #1 CLOSE #1 'bench warrior exists END IF 'derive pmars command line for auto-benching 'from INI file - changing bench parms through interface does not change bop$ = " -b": IF benchfixed THEN bop$ = " -b -f" IF benchfixed AND benchpermutate THEN bop$ = " -b -P" bxcmd$ = pmars$ + bop$ + " -s " + STR$(coresize) + " -c " + STR$(cycles) bxcmd$ = bxcmd$ + " -p " + STR$(processes) + " -r " + STR$(benchrounds) bxcmd$ = bxcmd$ + " -l " + STR$(maxpmlen) + " -d " + STR$(maxpmlen) + " " bxrounds = benchrounds: bxdir$ = benchdir$ GOTO endofbenchdircheck nobenchdir: 'RESUME nobenchdir1 nobenchdir1: PRINT "Can't continue, no benchmark directory" SYSTEM badbenchset: 'RESUME badbenchset1 badbenchset1: PRINT "Can't continue, no benchmark warriors" SYSTEM endofbenchdircheck: REM if benchinterval specified make sure save directory exists nextsavefile& = 1 IF benchinterval& > 0 THEN ON ERROR GOTO nosavedir OPEN savedir$ + pathsymbol$ + "testdir.tmp" FOR OUTPUT AS #2 ON ERROR GOTO generalerror CLOSE #2 KILL savedir$ + pathsymbol$ + "testdir.tmp" 'save dir exists, determine next save number ON ERROR GOTO foundnextsavefile trynextsavefile: a$ = savedir$ + pathsymbol$ + MID$(STR$(-nextsavefile&), 2) + ".red" OPEN a$ FOR INPUT AS #1: CLOSE #1 nextsavefile& = nextsavefile& + 1 GOTO trynextsavefile END IF GOTO endofsavecheck foundnextsavefile: 'RESUME fnsfile1 fnsfile1: ON ERROR GOTO generalerror CLOSE GOTO endofsavecheck nosavedir: 'RESUME nosavedir1 nosavedir1: ON ERROR GOTO generalerror CLOSE PRINT "Creating "; savedir$; " directory" SHELL "mkdir " + savedir$ OPEN savedir$ + pathsymbol$ + "testdir.tmp" FOR OUTPUT AS #2 CLOSE #2 KILL savedir$ + pathsymbol$ + "testdir.tmp" endofsavecheck: REM if benchinterval specified check to see if topwarrior$ exists, REM if it does then restore topscore else start topscore at 0 topscore = 0 IF benchinterval& > 0 THEN ON ERROR GOTO notopwarrior OPEN topwarrior$ FOR INPUT AS #1 WHILE NOT EOF(1) LINE INPUT #1, a$ IF LEFT$(a$, 13) = ";bench score " THEN topscore = VAL(MID$(a$, 14)) WEND CLOSE #1 ON ERROR GOTO generalerror END IF GOTO gottopscore notopwarrior: 'RESUME notopwarrior1 notopwarrior1: ON ERROR GOTO generalerror CLOSE gottopscore: IF topscore > 0 THEN PRINT "Current top score ="; STR$(topscore) REM randomize better... call RND from 100 to 300 times j = INT((SIN(TIMER) + 2) * 100): FOR i = 1 TO j: k = RND(1): NEXT i REM derive other needed variables ninstructions = LEN(instructions$) / 4 nmodifiers = LEN(modifiers$) / 3 nadrAmodes = LEN(adrAmodes$) / 2 nadrBmodes = LEN(adrBmodes$) / 2 statline = ysize + 3 statcol = INT(xsize / 2) - 24: IF statcol < 1 THEN statcol = 1 wnxdigits = 2: IF xsize > 99 THEN wnxdigits = 3 wnydigits = 2: IF ysize > 99 THEN wnydigits = 3 wnbaselen = wnxdigits + wnydigits + 1 pmbase$ = pmars$ + " -b -s" + STR$(coresize) + " -p" + STR$(processes) pmbase$ = pmbase$ + " -c" + STR$(cycles) + " -r" + STR$(rounds) pmbase$ = pmbase$ + " -l" + STR$(maxpmlen) + " -d" + STR$(maxpmlen) + " " IF doublefixed THEN pmbase$ = pmbase$ + "-f " scorefile$ = tempbase$ + ".sco" cx = 1: cy = 1: pmerror = 0 ansicount& = 0: benchcount& = 0: insertcount& = 0 REM make sure deletefile doesn't exist ON ERROR GOTO nodeletefile OPEN deletefile$ FOR INPUT AS #1 CLOSE PRINT deletefile$; " exists, not running." SYSTEM nodeletefile: 'RESUME nodeletefile1 nodeletefile1: IF breakavailable AND NOT quitavailable THEN PRINT "Don't press any keys while evolving" PRINT "Delete the "; deletefile$; " file "; IF breakavailable THEN PRINT "or press ctrl-c "; IF quitavailable THEN PRINT "or press Esc "; PRINT "to stop evolving." IF timedintro THEN 'delay showtime seconds ta& = TIMER delaying = 1 WHILE delaying tb& = TIMER IF tb& < ta& THEN ta& = TIMER IF tb& > (ta& + showtime) THEN delaying = 0 WEND ELSE 'if TIMER gives grief use this instead... a = showtime * delayconstant FOR i = 1 TO a FOR j = 1 TO 1000 b = i * (j / 1.4) NEXT j NEXT i END IF restartinterface: sdarrayvalid = 0 refreshdisplay: pmvbase$ = pmarsv$ + " -s" + STR$(coresize) + " -p" + STR$(processes) pmvbase$ = pmvbase$ + " -c" + STR$(cycles) + " -l" + STR$(maxlen) pmvbase$ = pmvbase$ + " -d" + STR$(maxlen) + " " + vparms$ + " " FOR i = 1 TO 200: a$ = INKEY$: NEXT i 'make sure key buffer is empty REM show current soup if present ON ERROR GOTO generalerror IF displaysoup THEN REM ******* user interface ******************************* COLOR textcolor: CLS PRINT "."; : FOR i = 1 TO xsize: PRINT "-"; : NEXT i: PRINT "." FOR j = 1 TO ysize PRINT "|"; : FOR i = 1 TO xsize: PRINT " "; : NEXT i: PRINT "|" NEXT j PRINT "`"; : FOR i = 1 TO xsize: PRINT "-"; : NEXT i: PRINT "'" warriorspresent = 0 FOR ywar = 1 TO ysize FOR xwar = 1 TO xsize IF sdarrayvalid = 0 THEN GOSUB getwarriorstats 'return warriorsize,origin$,species$ etc sdarray%(ywar, xwar, 0) = warriorsize a$ = origin$: GOSUB derivexynumbers sdarray%(ywar, xwar, 1) = y: sdarray%(ywar, xwar, 2) = x a$ = species$: GOSUB derivexynumbers sdarray%(ywar, xwar, 3) = y: sdarray%(ywar, xwar, 4) = x ELSE warriorsize = sdarray%(ywar, xwar, 0) y$ = RIGHT$("00" + LTRIM$(RTRIM$(STR$(sdarray%(ywar, xwar, 1)))), wnxdigits) x$ = RIGHT$("00" + LTRIM$(RTRIM$(STR$(sdarray%(ywar, xwar, 2)))), wnxdigits) origin$ = y$ + "_" + x$ + ".red" y$ = RIGHT$("00" + LTRIM$(RTRIM$(STR$(sdarray%(ywar, xwar, 3)))), wnxdigits) x$ = RIGHT$("00" + LTRIM$(RTRIM$(STR$(sdarray%(ywar, xwar, 4)))), wnxdigits) species$ = y$ + "_" + x$ + ".red" END IF IF warriorsize > 0 THEN warriorspresent = 1: GOSUB plotwarrior NEXT xwar NEXT ywar sdarrayvalid = 1 COLOR textcolor: LOCATE statline, 2 IF warriorspresent THEN PRINT "(L) list (R) run (1-9) battle (B) bench (O) options "; END IF PRINT "(E) evolve (Q) quit"; LOCATE cy + 1, cx + 1, 1 interfaceloop: k$ = "": WHILE k$ = "": k$ = INKEY$: WEND IF UCASE$(k$) = "E" THEN GOTO startevolver IF UCASE$(k$) = "Q" THEN GOTO exitprogram IF warriorspresent THEN IF UCASE$(k$) = "L" THEN GOSUB listwarrior: IF refresh GOTO refreshdisplay IF UCASE$(k$) = "R" THEN GOSUB runwarrior: IF refresh GOTO refreshdisplay IF UCASE$(k$) = "B" THEN GOSUB benchwarrior: IF refresh GOTO refreshdisplay IF UCASE$(k$) = "O" THEN GOSUB setoptions: GOTO refreshdisplay IF k$ >= "1" AND k$ <= "9" THEN GOSUB battlesurrounding: IF refresh GOTO refreshdisplay END IF k = 0: IF LEN(k$) = 2 THEN k = ASC(RIGHT$(k$, 1)) IF k = 72 THEN cy = cy - 1: IF cy < 1 THEN cy = ysize IF k = 80 THEN cy = cy + 1: IF cy > ysize THEN cy = 1 IF k = 75 THEN cx = cx - 1: IF cx < 1 THEN cx = xsize IF k = 77 THEN cx = cx + 1: IF cx > xsize THEN cx = 1 IF k > 0 THEN LOCATE cy + 1, cx + 1, 1 END IF GOTO interfaceloop REM ****************************************************** END IF startevolver: FOR i = 1 TO 200: a$ = INKEY$: NEXT i IF displaysoup THEN LOCATE statline, 1: PRINT SPACE$(78); : LOCATE statline, 1 ON ERROR GOTO oktostartevol OPEN deletefile$ FOR INPUT AS #1: CLOSE #1 PRINT "Error - another instance running": SYSTEM oktostartevol: 'RESUME oktostart1 oktostart1: CLOSE : ON ERROR GOTO fileerror OPEN deletefile$ FOR OUTPUT AS #2 PRINT #2, "Delete this file to stop RedMixer" CLOSE #2 GOTO mainloop plotwarrior: REM input ywar, xwar, colormethod, wnxdigits, wnydigits, origin$, species$, warriorsize REM output plots warrior on screen warriorcolor = 0 IF colormethod = 0 THEN warriorcolor = (warriorsize + colorshift) MOD 14 IF colormethod = 1 THEN a$ = origin$: GOSUB derivexynumbers warriorcolor = (x + y * xsize + colorshift) MOD 14 'fixed END IF IF colormethod = 2 THEN a$ = species$: GOSUB derivexynumbers warriorcolor = (x + y * xsize + colorshift) MOD 14 'fixed END IF warriorcolor = warriorcolor + 1 LOCATE ywar + 1, xwar + 1, 0 COLOR warriorcolor warriorchar$ = CHR$(126) IF warriorsize > 0 AND warriorsize < 10 THEN warriorchar$ = CHR$(warriorsize + 48) IF warriorsize > 9 AND warriorsize < 36 THEN warriorchar$ = CHR$(warriorsize + 55) IF warriorsize > 35 AND warriorsize < 62 THEN warriorchar$ = CHR$(warriorsize + 61) IF warriorsize > 61 AND warriorsize < 77 THEN warriorchar$ = CHR$(warriorsize - 29) IF warriorsize > 76 AND warriorsize < 84 THEN warriorchar$ = CHR$(warriorsize - 19) IF warriorsize > 83 AND warriorsize < 87 THEN warriorchar$ = CHR$(warriorsize + 39) PRINT warriorchar$; RETURN derivexynumbers: REM input a$, wnxdigits, wnydigits REM output x, y x = 0: y = 0 a$ = LTRIM$(RTRIM$(a$)) p1 = INSTR(a$, "_"): p2 = INSTR(a$, ".") IF p1 > 1 AND LEN(a$) > 2 THEN IF p2 > 1 THEN a$ = LEFT$(a$, p2 - 1) y = VAL(LEFT$(a$, wnydigits)): x = VAL(RIGHT$(a$, wnxdigits)) END IF RETURN derivewarriorname: REM input ywar, xwar, wnxdigits, wnydigits REM output warriorname$ containing string like "12_43.red" REM yy_xx.red, yy_xxx.red or yyy_xxx.red with leading 0's x$ = RIGHT$("00" + LTRIM$(RTRIM$(STR$(xwar))), wnxdigits) y$ = RIGHT$("00" + LTRIM$(RTRIM$(STR$(ywar))), wnydigits) warriorname$ = y$ + "_" + x$ + ".red" RETURN getwarriorstats: REM input ywar xwar soupdir$ pathsymbol$ wnxdigits wnydigits REM output warriorname$ warriorfile$ warriorsize origin$ species$ REM wins avgscore generation& REM if warrior doesn't exist warriorsize of 0 returned warriorsize = 0: origin$ = "": species$ = "" wins = 0: generation& = 0: avgscore = 0 GOSUB derivewarriorname warriorfile$ = soupdir$ + pathsymbol$ + warriorname$ ON ERROR GOTO nowarriorstats OPEN warriorfile$ FOR INPUT AS #1 ON ERROR GOTO fileerror WHILE NOT EOF(1) LINE INPUT #1, a$ a$ = LCASE$(LTRIM$(a$)): b = LEN(a$) IF b > 8 THEN IF LEFT$(a$, 8) = ";origin " THEN origin$ = MID$(a$, 9) IF b > 9 THEN IF LEFT$(a$, 9) = ";species " THEN species$ = MID$(a$, 10) IF b > 12 THEN IF LEFT$(a$, 12) = ";generation " THEN generation& = VAL(MID$(a$, 13)) IF b > 6 THEN IF LEFT$(a$, 6) = ";wins " THEN wins = VAL(MID$(a$, 7)) IF b > 7 THEN IF LEFT$(a$, 7) = ";score " THEN avgscore = VAL(MID$(a$, 7)) IF b > 20 THEN IF LEFT$(a$, 1) <> ";" AND LEFT$(a$, 4) <> "end " THEN warriorsize = warriorsize + 1 WEND exitgetwarriorstats: CLOSE : ON ERROR GOTO generalerror RETURN nowarriorstats: 'RESUME exitgetwarriorstats GOTO exitgetwarriorstats 'added for FB mainloop: REM ******************************************************************* ON ERROR GOTO deletefiledeleted OPEN deletefile$ FOR INPUT AS #1 CLOSE : ON ERROR GOTO generalerror REM pick a random warrior xwar = INT(RND(1) * xsize + 1): ywar = INT(RND(1) * ysize + 1) GOSUB derivewarriorname warriorfile$ = soupdir$ + pathsymbol$ + warriorname$ ON ERROR GOTO createwarrior1 OPEN warriorfile$ FOR INPUT AS #1 ON ERROR GOTO generalerror CLOSE #1 warrior1created: warriorname1$ = warriorname$ war1x$ = warriorfile$ xwar1 = xwar: ywar1 = ywar REM pick another surrounding warrior pickok = 0 WHILE pickok = 0 n = INT(RND(1) * 8) GOSUB picksurrounding pickok = 1 IF ywar < 1 OR ywar > ysize THEN pickok = 0'no wrap on top/bottom IF xwar < 1 THEN xwar = xsize 'wrap on sides IF xwar > xsize THEN xwar = 1 WEND GOSUB derivewarriorname warriorfile$ = soupdir$ + pathsymbol$ + warriorname$ ON ERROR GOTO createwarrior2 OPEN warriorfile$ FOR INPUT AS #1 ON ERROR GOTO generalerror CLOSE #1 warrior2created: warriorname2$ = warriorname$ war1$ = war1x$: war2$ = warriorfile$ xwar2 = xwar: ywar2 = ywar IF displaysoup THEN LOCATE statline - 2, 1, 0: COLOR textcolor ELSE PRINT GOSUB battlewarriors IF pmerror THEN GOTO pmarsexit IF displaysoup THEN LOCATE statline, statcol, 0: COLOR textcolor base1$ = LEFT$(warriorname1$, wnbaselen) base2$ = LEFT$(warriorname2$, wnbaselen) PRINT base1$; " vs "; base2$; ":"; PRINT RIGHT$(" " + STR$(INT(score1)), 4); PRINT RIGHT$(" " + STR$(INT(score2)), 4); IF score1 >= score2 THEN winnername$ = warriorname1$: winnerfile$ = war1$: winnerbase$ = base1$ losername$ = warriorname2$: loserfile$ = war2$: loserbase$ = base2$ winnerscore = score1 ELSE winnername$ = warriorname2$: winnerfile$ = war2$: winnerbase$ = base2$ losername$ = warriorname1$: loserfile$ = war1$: loserbase$ = base1$ winnerscore = score2 END IF PRINT " "; winnerbase$; "-->"; loserbase$; IF attraction THEN GOSUB updatewins GOSUB evolvewarrior IF crossoccured THEN PRINT " C"; ELSE PRINT " "; IF spchanged THEN PRINT "S"; ELSE PRINT " "; PRINT " Gen:"; STR$(generation&); " "; IF displaysoup THEN GOSUB plotwarrior 'added to perform auto-extraction and guided evolution... IF benchinterval& > 0 THEN benchcount& = benchcount& + 1 IF benchcount& >= benchinterval& THEN GOSUB BenchAndUpdate: benchcount& = 0 END IF END IF IF insertinterval& > 0 THEN insertcount& = insertcount& + 1 IF insertcount& >= insertinterval& THEN GOSUB InsertTopWarrior: insertcount& = 0 END IF END IF '------------------- 'ansi movie processing... IF enablemovie THEN ansicount& = ansicount& + 1 IF ansicount& >= frameinterval& THEN ansicount& = 0: genacc& = 0: wsizeacc& = 0: nwars& = 0 ON ERROR GOTO ansierror OPEN ansifile$ FOR APPEND AS #3 ON ERROR GOTO fileerror PRINT #3, CHR$(27); "[H."; FOR i = 1 TO xsize: PRINT #3, "-"; : NEXT i PRINT #3, ".";: IF unixmode THEN PRINT #3, CHR$(13) ELSE PRINT #3, "" FOR y = 1 TO ysize PRINT #3, "|"; FOR x = 1 TO xsize species$ = "00_00": warlen = 0 yn$ = RIGHT$("0" + LTRIM$(RTRIM$(STR$(y))), 2) xn$ = RIGHT$("0" + LTRIM$(RTRIM$(STR$(x))), 2) f$ = soupdir$ + "\" + yn$ + "_" + xn$ + ".red" ON ERROR GOTO ansinowarrior OPEN f$ FOR INPUT AS #1 ON ERROR GOTO fileerror WHILE NOT EOF(1) LINE INPUT #1, a$ IF LEFT$(a$, 9) = ";species " THEN species$ = MID$(a$, 10) IF LEFT$(a$, 12) = ";generation " THEN generation& = VAL(MID$(a$, 13)) IF MID$(a$, 4, 1) = "." THEN warlen = warlen + 1 WEND CLOSE #1 wsizeacc& = wsizeacc& + warlen: genacc& = genacc& + generation& nwars& = nwars& + 1 yc = VAL(LEFT$(species$, 2)): xc = VAL(MID$(species$, 4, 2)) ansicolor = ((xc + yc * xsize) MOD 14) + 31 s = warlen: char$ = CHR$(126) IF s > 0 AND s < 10 THEN char$ = CHR$(s + 48) IF s > 9 AND s < 36 THEN char$ = CHR$(s + 55) IF s > 35 AND s < 62 THEN char$ = CHR$(s + 61) IF s > 61 AND s < 77 THEN char$ = CHR$(s - 29) IF s > 76 AND s < 84 THEN char$ = CHR$(s - 19) IF s > 83 AND s < 87 THEN char$ = CHR$(s + 39) writeansichar: PRINT #3, CHR$(27); "["; IF ansicolor > 37 THEN PRINT #3, "1;"; : ansicolor = ansicolor - 8 ELSE PRINT #3, "0;"; END IF PRINT #3, LTRIM$(RTRIM$(STR$(ansicolor))); "m"; char$; NEXT x PRINT #3, CHR$(27); "[0m"; "|"; IF unixmode THEN PRINT #3, CHR$(13) ELSE PRINT #3, "" NEXT y PRINT #3, "`";: FOR i = 1 TO xsize: PRINT #3, "-"; : NEXT i: PRINT #3, "'"; IF unixmode THEN PRINT #3, CHR$(13) ELSE PRINT #3, "" a$ = LEFT$(STR$(wsizeacc& / nwars&) + " ", 6) b$ = LEFT$(STR$(INT(genacc& / nwars& + .5)) + " ", 8) PRINT #3, " Avg Size:"; a$; " Avg Gen:"; b$; IF benchinterval& > 0 THEN a$ = LEFT$(STR$(bscore) + " ", 6) b$ = LEFT$(STR$(topscore) + " ", 6) PRINT #3, " Last Score:"; a$;" Top Score:"; b$; END IF CLOSE #3: GOTO donewithansi ansinowarrior: 'RESUME ansinw1 ansinw1: char$ = " " ansicolor = 37 ON ERROR GOTO fileerror GOTO writeansichar ansierror: CLOSE : PRINT : PRINT "Error opening ANSI file": SYSTEM donewithansi: END IF END IF '------------------- 'exit using Esc... IF quitavailable THEN IF INKEY$ = CHR$(27) GOTO pmarsexit REM ******************************************************************* GOTO mainloop deletefiledeleted: 'RESUME dfdeleted1 dfdeleted1: CLOSE ON ERROR GOTO filesalreadydeleted KILL scorefile$ GOTO checkforinterface pmarsexit: ON ERROR GOTO tempfilesalreadydeleted KILL deletefile$ KILL scorefile$ checkforinterface: IF displaysoup THEN GOTO restartinterface exitprogram: ON ERROR GOTO fileerror IF displaysoup THEN LOCATE statline, 1: COLOR textcolor ELSE PRINT IF benchinterval& > 0 THEN KILL tempbase$ + ".bmk" SYSTEM tempfilesalreadydeleted: 'RESUME tfadeleted1 tfadeleted1: GOTO exitprogram filesalreadydeleted: 'RESUME fadeleted1 fadeleted1: GOTO checkforinterface REM ahh love the smell of spaghetti! picksurrounding: REM input xwar1, ywar1, n REM output xwar, ywar IF n = 0 THEN xwar = xwar1 - 1: ywar = ywar - 1 IF n = 1 THEN xwar = xwar1: ywar = ywar1 - 1 IF n = 2 THEN xwar = xwar1 + 1: ywar = ywar1 - 1 IF n = 3 THEN xwar = xwar1 + 1: ywar = ywar1 IF n = 4 THEN xwar = xwar1 + 1: ywar = ywar1 + 1 IF n = 5 THEN xwar = xwar1: ywar = ywar1 + 1 IF n = 6 THEN xwar = xwar1 - 1: ywar = ywar1 + 1 IF n = 7 THEN xwar = xwar1 - 1: ywar = ywar1 RETURN createwarrior1: 'RESUME createwarrior11 createwarrior11: CLOSE IF displaysoup THEN LOCATE statline - 2, 1, 0: COLOR textcolor GOSUB createwarrior IF pmerror THEN GOTO pmarsexit GOTO warrior1created createwarrior2: 'RESUME createwarrior21 createwarrior21: CLOSE IF displaysoup THEN LOCATE statline - 2, 1, 0: COLOR textcolor GOSUB createwarrior IF pmerror THEN GOTO pmarsexit GOTO warrior2created createwarrior: IF testnew THEN GOSUB createtestedwarrior ELSE GOSUB createrandomwarrior END IF IF displaysoup THEN GOSUB plotwarrior: LOCATE statline - 2, 1, 0: COLOR textcolor END IF RETURN createtestedwarrior: war1$ = warriorfile$ war2$ = testwarrior$ passed = 0 WHILE passed = 0 AND pmerror = 0 GOSUB createrandomwarrior GOSUB battlewarriors IF score1 >= mintestscore THEN passed = 1 WEND RETURN createrandomwarrior: REM input xwar ywar warriorname$ warriorfile$ + all the parms REM output a random warrior in the soup, for plotting returns REM generation&(0) origin$ species$ warriorsize ON ERROR GOTO fileerror generation& = 0: parent$ = "random": origin$ = warriorname$ IF randomspecies THEN GOSUB getrandomspecies ELSE species$ = warriorname$ OPEN warriorfile$ FOR OUTPUT AS #2 GOSUB writeheader warriorsize = INT(RND(1) * (maxlen - minstartsize + 1)) + minstartsize FOR warline = 1 TO warriorsize GOSUB writerandomline NEXT warline GOSUB getrandomendnumber PRINT #2, "end"; STR$(endnumber) PRINT #2, ";species "; species$ CLOSE #2 ON ERROR GOTO generalerror RETURN getrandomspecies: REM input randomtagrange wnxdigits wnydigits REM output species$ containing random species tag x = INT(RND(1) * 10 ^ wnxdigits) MOD randomtagrange y = INT(RND(1) * 10 ^ wnydigits) MOD randomtagrange x$ = RIGHT$("00" + LTRIM$(RTRIM$(STR$(x))), wnxdigits) y$ = RIGHT$("00" + LTRIM$(RTRIM$(STR$(y))), wnydigits) species$ = y$ + "_" + x$ RETURN writeheader: REM input output file open for write as #2 REM warriorname$ origin$ parent$ redcodeline$ REM authorline$ versionline$ REM output writes initial comments PRINT #2, ";"; redcodeline$ PRINT #2, ";name "; warriorname$ PRINT #2, ";author "; authorline$ PRINT #2, ";strategy Evolved by "; versionline$ PRINT #2, ";origin "; origin$ p = INSTR(parent$, " ") IF p > 0 THEN PRINT #2, ";parents "; parent$ ELSE PRINT #2, ";parent "; parent$ PRINT #2, ";generation"; STR$(generation&) PRINT #2, ";assert 1" RETURN writerandomline: GOSUB getrandominstruction GOSUB getrandommodifier GOSUB getrandomAmode GOSUB getrandomAdata GOSUB getrandomBmode GOSUB getrandomBdata PRINT #2, instruction$; modifier$; Amode$; Adata$; " , "; Bmode$; Bdata$ RETURN getrandominstruction: p = INT(RND(1) * ninstructions) * 4 + 1 instruction$ = MID$(instructions$, p, 3) RETURN getrandommodifier: p = INT(RND(1) * nmodifiers) * 3 + 1 modifier$ = "." + MID$(modifiers$, p, 2) + " " RETURN getrandomAmode: p = INT(RND(1) * nadrAmodes) * 2 + 1 Amode$ = MID$(adrAmodes$, p, 2) RETURN getrandomBmode: p = INT(RND(1) * nadrBmodes) * 2 + 1 Bmode$ = MID$(adrBmodes$, p, 2) RETURN getrandomAdata: IF RND(1) < dataAsmall THEN dataval = INT(RND(1) * warriorsize) IF RND(1) > .5 AND dataval <> 0 THEN dataval = dataval * -1 ELSE dataval = INT(RND(1) * coresize) END IF GOSUB formatdata Adata$ = dataval$ RETURN getrandomBdata: IF RND(1) < dataBsmall THEN dataval = INT(RND(1) * warriorsize) IF RND(1) > .5 AND dataval <> 0 THEN dataval = dataval * -1 ELSE dataval = INT(RND(1) * coresize) END IF GOSUB formatdata Bdata$ = dataval$ RETURN formatdata: REM input dataval REM output dataval$ with leading spaces, 4 chars long dataval$ = RIGHT$(" " + RTRIM$(STR$(dataval)), 4) RETURN getrandomendnumber: IF RND(1) < end0chance THEN endnumber = 0 ELSE endnumber = INT(RND(1) * warriorsize) END IF RETURN battlewarriors: REM input war1$ war2$ containing filenames of warriors to battle REM output score1 score2 containing scores normalized 0-300 (floating point) REM pmerror=0 if scores OK, pmerror=1 if no scores obtained ON ERROR GOTO noscores SHELL pmbase$ + war1$ + " " + war2$ + " > " + scorefile$ pmerror = 0 OPEN scorefile$ FOR INPUT AS #1 LINE INPUT #1, a$ LINE INPUT #1, b$ LINE INPUT #1, c$ CLOSE #1 p = INSTR(a$, "scores ") IF p = 0 THEN pmerror = 1: GOTO battledone score1 = VAL(MID$(a$, p + 7)) p = INSTR(b$, "scores ") IF p = 0 THEN pmerror = 1: GOTO battledone score2 = VAL(MID$(b$, p + 7)) IF doublefixed THEN SHELL pmbase$ + war2$ + " " + war1$ + " > " + scorefile$ OPEN scorefile$ FOR INPUT AS #1 LINE INPUT #1, a$ LINE INPUT #1, b$ LINE INPUT #1, c$ CLOSE #1 p = INSTR(a$, "scores ") IF p = 0 THEN pmerror = 1: GOTO battledone score1 = (score1 + VAL(MID$(b$, p + 7))) / 2 p = INSTR(b$, "scores ") IF p = 0 THEN pmerror = 1: GOTO battledone score2 = (score2 + VAL(MID$(a$, p + 7))) / 2 END IF REM normalize scores score1 = score1 * (100 / rounds) score2 = score2 * (100 / rounds) GOTO battledone noscores: 'RESUME noscores1 noscores1: CLOSE : pmerror = 1 battledone: ON ERROR GOTO generalerror RETURN updatewins: REM input winnerfile$ winnerscore soupdir$ pathsymbol$ REM output ;wins comment at end incremented if exists REM ;score comment at end updated if exists REM otherwise creates ;wins 1 and/or ;score [score] comments ON ERROR GOTO fileerror OPEN winnerfile$ FOR INPUT AS #1 OPEN soupdir$ + pathsymbol$ + "winner.tmp" FOR OUTPUT AS #2 wincommentfound = 0: scorecommentfound = 0 wins = 1 'avoid error WHILE NOT EOF(1) LINE INPUT #1, a$ IF LEN(a$) > 6 THEN IF LEFT$(a$, 6) = ";wins " THEN wincommentfound = 1 wins = VAL(MID$(a$, 6)) + 1 a$ = ";wins" + STR$(wins) END IF END IF IF LEN(a$) > 7 THEN IF LEFT$(a$, 7) = ";score " THEN scorecommentfound = 1 avgscore = INT((VAL(MID$(a$, 7)) * (wins - 1) + winnerscore) / wins) a$ = ";score" + STR$(avgscore) END IF END IF PRINT #2, a$ WEND IF wincommentfound = 0 THEN PRINT #2, ";wins 1" IF scorecommentfound = 0 THEN PRINT #2, ";score"; STR$(winnerscore) CLOSE #2: CLOSE #1 KILL winnerfile$ NAME soupdir$ + pathsymbol$ + "winner.tmp" AS winnerfile$ ON ERROR GOTO generalerror RETURN evolvewarrior: REM input winnerfile$ winnername$ loserfile$ losername$ REM and all the parameters REM output warriorfile$ replaced with evolved copy of winnerfile$ REM crossoccured set if crossed with another warrior REM spchanged set if offspring is new species REM origin$ species$ warriorsize xwar ywar for plotwarrior ON ERROR GOTO fileerror IF crossmode > 0 THEN 'get information about surrounding warriors... a$ = winnername$: GOSUB derivexynumbers: xwar1 = x: ywar1 = y a$ = losername$: GOSUB derivexynumbers: xwar2 = x: ywar2 = y FOR n = 0 TO 7 wstats(n, 0) = 0: wstats(n, 1) = 0: wstats(n, 2) = 0 wstat$(n, 0) = "": wstat$(n, 1) = "": wstat$(n, 2) = "" GOSUB picksurrounding IF xwar <> xwar2 OR ywar <> ywar2 THEN 'scan all but loser GOSUB getwarriorstats wstats(n, 0) = warriorsize: wstats(n, 1) = wins wstats(n, 2) = avgscore: wstat$(n, 0) = warriorname$ wstat$(n, 1) = species$: wstat$(n, 2) = origin$ END IF NEXT n END IF IF crossmode = 1 OR crossmode = 3 THEN 'if match species then need to know winner species 'if match size then need to know winner size a$ = winnername$: GOSUB derivexynumbers xwar = x: ywar = y: GOSUB getwarriorstats END IF OPEN winnerfile$ FOR INPUT AS #1 REM parse comments... there must be 8 comments FOR i = 1 TO 8 LINE INPUT #1, a$ a$ = LCASE$(LTRIM$(a$)): b = LEN(a$) IF b > 8 THEN IF LEFT$(a$, 8) = ";origin " THEN origin$ = MID$(a$, 9) IF b > 12 THEN IF LEFT$(a$, 12) = ";generation " THEN generation& = VAL(MID$(a$, 13)) NEXT i generation& = generation& + 1: parent$ = winnername$: docross = 0 IF crossmode > 0 THEN 'select another warrior to cross with FOR n = 0 TO 7 'exclude unsuitable... IF crossmode = 1 THEN IF wstat$(n, 1) <> species$ THEN wstats(n, 0) = 0 IF crossmode = 2 THEN IF wstat$(n, 2) <> origin$ THEN wstats(n, 0) = 0 IF crossmode = 3 THEN IF wstats(n, 0) <> warriorsize THEN wstats(n, 0) = 0 IF wstats(n, 0) > 0 THEN docross = 1 'set docross if at least one suitable NEXT n IF docross THEN IF attraction THEN 'exclude warriors with score < highest (leaving ties) bestscore = 0 FOR n = 0 TO 7 'scan to find highest score (wins * avgscore) warscore = 0 IF wstats(n, 0) > 0 THEN warscore = wstats(n, 1) * wstats(n, 2) IF warscore > bestscore THEN bestscore = warscore NEXT n FOR n = 0 TO 7 'exclude warriors that score less than bestscore IF bestscore > (wstats(n, 1) * wstats(n, 2)) THEN wstats(n, 0) = 0 NEXT n END IF foundcross = 0 WHILE foundcross = 0 'randomly choose from warriors that remain n = INT(RND(1) * 8): IF wstats(n, 0) > 0 THEN foundcross = 1 WEND crossname$ = wstat$(n, 0) crossfile$ = soupdir$ + pathsymbol$ + crossname$ OPEN crossfile$ FOR INPUT AS #3 FOR i = 1 TO 8: LINE INPUT #3, a$: NEXT i 'skip over comments stopflipping = 0 'flag to set if cross runs out of code parent$ = parent$ + " " + crossname$ END IF END IF warriorfile$ = loserfile$: warriorname$ = losername$ OPEN warriorfile$ FOR OUTPUT AS #2 GOSUB writeheader warriorsize = 0: endofwarriorcode = 0: crossoccured = 0 instchanges = 0 'count of changes to determine species change spchanged = 0 'set if species changed 'species always changed if insert/delete or end # changes 'otherwise up to warriorsize * specieschanges * .01 base instruction 'changes permitted and still be considered the same species flip = 0: IF RND(1) > flipstart THEN flip = 1 'if not docross then flip doesn't matter, reset to 0 WHILE endofwarriorcode = 0 LINE INPUT #1, a$: a$ = LCASE$(a$) IF docross AND stopflipping = 0 THEN LINE INPUT #3, b$: b$ = LCASE$(b$) IF LEFT$(b$, 4) = "end " THEN stopflipping = 1 END IF IF LEFT$(a$, 4) = "end " THEN endnumber = VAL(MID$(a$, 5)) endofwarriorcode = 1 ELSE IF docross AND stopflipping = 0 AND RND(1) < fliplinechance THEN IF flip = 0 THEN flip = 1 ELSE flip = 0 END IF previnst$ = LEFT$(a$, 3) GOSUB choosesource: instruction$ = LEFT$(c$, 3) GOSUB choosesource: modifier$ = MID$(c$, 4, 4) GOSUB choosesource: Amode$ = MID$(c$, 8, 2) GOSUB choosesource: Adata$ = MID$(c$, 10, 4) GOSUB choosesource: Bmode$ = MID$(c$, 17, 2) GOSUB choosesource: Bdata$ = MID$(c$, 19, 4) IF RND(1) < instchance THEN GOSUB getrandominstruction IF instruction$ <> previnst$ THEN instchanges = instchanges + 1 IF RND(1) < modchance THEN GOSUB getrandommodifier IF RND(1) < modeAchance THEN GOSUB getrandomAmode IF RND(1) < modeBchance THEN GOSUB getrandomBmode IF RND(1) < dataAchance THEN IF RND(1) < dataAincdec THEN dataval = VAL(Adata$) IF RND(1) > .5 THEN dataval = dataval + 1 ELSE dataval = dataval - 1 GOSUB formatdata: Adata$ = dataval$ ELSE GOSUB getrandomAdata END IF END IF IF RND(1) < dataBchance THEN IF RND(1) < dataBincdec THEN dataval = VAL(Bdata$) IF RND(1) > .5 THEN dataval = dataval + 1 ELSE dataval = dataval - 1 GOSUB formatdata: Bdata$ = dataval$ ELSE GOSUB getrandomBdata END IF END IF IF RND(1) > deletechance AND warriorsize < maxlen THEN warriorsize = warriorsize + 1 PRINT #2, instruction$; modifier$; Amode$; Adata$; " , "; Bmode$; Bdata$ ELSE spchanged = 1 END IF IF RND(1) < insertchance AND warriorsize < maxlen THEN spchanged = 1: warriorsize = warriorsize + 1 IF RND(1) < duplinechance THEN PRINT #2, instruction$; modifier$; Amode$; Adata$; " , "; Bmode$; Bdata$ ELSE GOSUB writerandomline END IF END IF END IF WEND IF warriorsize = 0 THEN GOSUB writerandomline 'in case all instructions get deleted warriorsize = 1 END IF prevendnumber = endnumber IF RND(1) < endchance THEN IF RND(1) < endincdec THEN IF RND(1) > .5 THEN endnumber = endnumber + 1 ELSE endnumber = endnumber - 1 ELSE GOSUB getrandomendnumber END IF END IF IF endnumber < 0 THEN endnumber = 0 IF endnumber >= warriorsize THEN endnumber = warriorsize - 1 IF endnumber <> prevendnumber THEN spchanged = 1 PRINT #2, "end"; STR$(endnumber) ' in this evolver the species tag must be present (in REBS was optional) ' however the wins/score tags optional, not present in new warriors and ' not created at all unless attraction set. LINE INPUT #1, a$ IF instchanges > (warriorsize * specieschanges * .01) THEN spchanged = 1 IF spchanged THEN IF randomspecies THEN GOSUB getrandomspecies ELSE species$ = warriorname$ END IF ELSE species$ = MID$(a$, 10) END IF PRINT #2, ";species "; species$ CLOSE #2: CLOSE #1: IF docross THEN CLOSE #3 a$ = warriorname$: GOSUB derivexynumbers: xwar = x: ywar = y RETURN choosesource: REM for crossover, selects source warrior REM flipping can occur on a per-item basis if flipitemchance > 0 REM otherwise flipping occurs only line-by-line by fliplinechance REM if not docross then sets flip to 0 and selects only winner code REM input flip docross stopflipping a$ b$ containing winner line, cross line REM output possibly changed flip, c$ containing code line to use REM crossoccured set if at any time flip not 0 IF docross AND stopflipping = 0 THEN IF RND(1) < flipitemchance THEN IF flip = 0 THEN flip = 1 ELSE flip = 0 ELSE flip = 0 END IF IF flip THEN c$ = b$: crossoccured = 1 ELSE c$ = a$ RETURN REM ******* user interface subroutines ******* getwarriorfile: REM input cx, cy REM output warriorfile$, warriorsize = 0 if doesn't exist ywar = cy: xwar = cx: GOSUB getwarriorstats RETURN viewfile: REM input filename$, listprog$, screenlines REM output views file using listprog$ if set REM otherwise uses internal lister CLS IF listprog$ = "" THEN pausecontrol = 0: ON ERROR GOTO fileerror OPEN filename$ FOR INPUT AS #1 WHILE NOT EOF(1) IF pausecontrol >= screenlines THEN WHILE INKEY$ = "": WEND: pausecontrol = 0 FOR i = 1 TO 200: a$ = INKEY$: NEXT i: CLS END IF IF pausecontrol > 0 THEN PRINT LINE INPUT #1, a$: PRINT a$; IF LEN(a$) < 78 THEN PRINT " "; pausecontrol = pausecontrol + 1 WEND CLOSE #1 WHILE INKEY$ = "": WEND ELSE SHELL listprog$ + " " + filename$ END IF RETURN listwarrior: REM input cx cy and settings REM output lists warrior to screen refresh = 0: GOSUB getwarriorfile: IF warriorsize = 0 THEN RETURN refresh = 1: filename$ = warriorfile$: GOSUB viewfile RETURN runwarrior: REM input cx cy and settings REM output runs warrior in pmarsv refresh = 0: GOSUB getwarriorfile: IF warriorsize = 0 THEN RETURN refresh = 1: CLS : SHELL pmvbase$ + warriorfile$ RETURN battlesurrounding: REM input cx cy k$ and settings REM output battles warrior against surrounding warrior in pmarsv REM which warrior determined by k$, 1 to 9 for directions on keypad REM key 5 battles warrior against itself refresh = 0: GOSUB getwarriorfile: IF warriorsize = 0 THEN RETURN war1$ = warriorfile$: xwar = 0 IF k$ = "1" THEN xwar = cx - 1: ywar = cy + 1 IF k$ = "2" THEN xwar = cx: ywar = cy + 1 IF k$ = "3" THEN xwar = cx + 1: ywar = cy + 1 IF k$ = "4" THEN xwar = cx - 1: ywar = cy IF k$ = "5" THEN xwar = cx: ywar = cy IF k$ = "6" THEN xwar = cx + 1: ywar = cy IF k$ = "7" THEN xwar = cx - 1: ywar = cy - 1 IF k$ = "8" THEN xwar = cx: ywar = cy - 1 IF k$ = "9" THEN xwar = cx + 1: ywar = cy - 1 GOSUB getwarriorstats: IF warriorsize = 0 THEN RETURN refresh = 1: CLS : SHELL pmvbase$ + war1$ + " " + warriorfile$ LOCATE screenlines - 1, 63: PRINT "(press any key) "; FOR i = 1 TO 200: a$ = INKEY$: NEXT i WHILE INKEY$ = "": WEND RETURN benchwarrior: REM input cx cy and settings REM output benchmarks warrior and displays chart of results refresh = 0: GOSUB getwarriorfile: IF warriorsize = 0 THEN RETURN refresh = 1: f$ = warriorfile$ ON ERROR GOTO fileerror IF NOT benchprog$ = "" GOTO exttester REM Reworked benchmark code, should work for QBasic/Dos or FreeBasic/Linux CLS : PRINT : PRINT "Testing redcode... "; IF breakavailable AND NOT quitavailable THEN PRINT "(don't press any keys)"; PRINT 'compose pmars command line bop$ = " -b": IF benchfixed THEN bop$ = " -b -f" IF benchfixed AND benchpermutate THEN bop$ = " -b -P" bcmd$ = pmars$ + bop$ + " -s " + STR$(coresize) + " -c " + STR$(cycles) bcmd$ = bcmd$ + " -p " + STR$(processes) + " -r " + STR$(benchrounds) bcmd$ = bcmd$ + " -l " + STR$(maxpmlen) + " -d " + STR$(maxpmlen) + " " + f$ + " " 'get list of benchmark warriors and run warrior against all... 'the following line assumes standard commands dos/win and 'nix IF unixmode THEN dircmd$ = "ls -1 " ELSE dircmd$ = "dir /b " SHELL dircmd$ + benchdir$ + pathsymbol$ + benchmask$ + " > " + tempbase$ + ".dir" OPEN tempbase$ + ".out" FOR OUTPUT AS #1: CLOSE #1 'zero score file if exists OPEN tempbase$ + ".dir" FOR INPUT AS #1 'open directory list WHILE NOT EOF(1) 'loop through all benchmark warrior names LINE INPUT #1, a$ 'get name, run pmars to add to score file... 'in Linux the path info is included, not in dos, so... IF unixmode THEN PRINT f$; " vs "; a$ SHELL bcmd$ + a$ + " >> " + tempbase$ + ".out" ELSE PRINT f$; " vs "; benchdir$; "\"; a$ SHELL bcmd$ + benchdir$ + "\" + a$ + " >> " + tempbase$ + ".out" END IF WEND CLOSE #1 KILL tempbase$ + ".dir" REM Adapted from the benchmarker code from RedMaker... ' determine warrior name OPEN f$ FOR INPUT AS #1: zname$ = "" WHILE (NOT EOF(1) AND zname$ = "") LINE INPUT #1, a$ IF LEFT$(a$, 6) = ";name " THEN zname$ = RIGHT$(a$, LEN(a$) - 6) WEND: CLOSE #1 ' tally up the scores, ripped from my testwar batch ts = 0: no = 0: ON ERROR GOTO mtnoscore OPEN tempbase$ + ".out" FOR INPUT AS #1 OPEN tempbase$ + ".rep" FOR OUTPUT AS #2 PRINT #2, "Opponent Scores Results Performance of "; zname$ PRINT #2, "--------------- --------- ----------- ---------=---------=---------=---------=" mtL: IF EOF(1) GOTO mtX LINE INPUT #1, a$: IF INSTR(a$, "scores ") = 0 GOTO mtL LINE INPUT #1, b$: LINE INPUT #1, c$: IF INSTR(a$, zname$) = 0 GOTO mtL w$ = LEFT$(b$, INSTR(b$, " by ")) w$ = LEFT$(w$ + " ", 15) ms = VAL(RIGHT$(a$, LEN(a$) - INSTR(a$, "scores ") - 6)): ts = ts + ms os = VAL(RIGHT$(b$, LEN(b$) - INSTR(b$, "scores ") - 6)): no = no + 1 ms$ = LEFT$(STR$(ms) + " ", 5): os$ = LEFT$(STR$(os) + " ", 5) re$ = RIGHT$(c$, LEN(c$) - 8): re$ = LEFT$(re$ + " ", 13) PRINT #2, w$; ms$; os$; " "; re$; : IF os + ms = 0 OR ms = 0 GOTO mtN ra = (ms / (benchrounds * 3)) * 40: FOR z = 1 TO ra: PRINT #2, "*"; : NEXT z mtN: PRINT #2, "": GOTO mtL mtX: PRINT #2, "--------------- --------- ----------- ---------=---------=---------=---------=" IF no > 0 THEN PRINT #2, "Adjusted Score:"; a = INT(INT(((ts / no) / (benchrounds / 100)) * 10) + .0001) / 10 PRINT #2, STR$(a); " " CLOSE #1: CLOSE #2: ON ERROR GOTO fileerror KILL tempbase$ + ".out" filename$ = tempbase$ + ".rep": GOSUB viewfile KILL filename$ exitbench: RETURN mtnoscore: CLOSE : PRINT "No scores, check test directory "; FOR i = 1 TO 200: a$ = INKEY$: NEXT i WHILE INKEY$ = "": WEND 'RESUME exitbench GOTO exitbench 'added for FB exttester: CLS : SHELL benchprog$ + " " + f$: RETURN setoptions: REM these are a few things that are handy to change REM without having to edit the INI file and restart COLOR textcolor: CLS : PRINT : PRINT PRINT " (A) Color method "; IF colormethod = 0 THEN PRINT "by size" IF colormethod = 1 THEN PRINT "by origin" IF colormethod = 2 THEN PRINT "by species" PRINT " (B) Color shift "; STR$(colorshift) PRINT " (C) Text color "; STR$(textcolor) PRINT " (D) Bench rounds "; STR$(benchrounds) PRINT " (E) Bench fixed "; IF benchfixed THEN PRINT "yes" ELSE PRINT "no" PRINT " (F) Bench dir "; benchdir$ PRINT " (G) PMARSV parms "; vparms$ PRINT " (X) Exit" PRINT optionsgetkey: FOR i = 1 TO 200: a$ = INKEY$: NEXT i a$ = "": WHILE a$ = "": a$ = UCASE$(INKEY$): WEND IF a$ = "A" THEN colormethod = colormethod + 1: IF colormethod > 2 THEN colormethod = 0 GOTO setoptions END IF IF a$ = "B" THEN PRINT " Enter color shift: "; : LINE INPUT b$: c = VAL(b$) IF c >= 0 AND c < 15 AND INT(c) = c THEN colorshift = c GOTO setoptions END IF IF a$ = "C" THEN PRINT " Enter text color: "; : LINE INPUT b$: c = VAL(b$) IF c > 0 AND c < 16 AND INT(c) = c THEN textcolor = c GOTO setoptions END IF IF a$ = "D" THEN PRINT " Enter bench rounds: "; : LINE INPUT b$: c = VAL(b$) IF c > 0 AND c < 10000 AND INT(c) = c THEN benchrounds = c GOTO setoptions END IF IF a$ = "E" THEN IF benchfixed THEN benchfixed = 0 ELSE benchfixed = 1 GOTO setoptions END IF IF a$ = "F" THEN PRINT " Enter bench directory: "; : LINE INPUT b$ b$ = LTRIM$(RTRIM$(b$)): IF b$ <> "" THEN benchdir$ = b$ GOTO setoptions END IF IF a$ = "G" THEN PRINT " Enter PMARSV parms: "; : LINE INPUT b$ IF b$ <> "" THEN vparms$ = b$ GOTO setoptions END IF IF a$ <> "X" GOTO optionsgetkey RETURN REM benchmark winner, if score > topscore then save to topwarrior file REM if > topscore and >= savethresh then save to numbered file in save dir REM input winnerfile$ topwarrior$ nextsavefile& topscore savedir$ savethresh REM bxcmd$ bxrounds REM [tempbase$].bmk file containing list of benchmark warriors REM output updates topwarrior$ topscore and saves to save dir as needed BenchAndUpdate: ON ERROR GOTO noduptocheck 'make sure it's not a duplicate of the current top warrior... (if it exists) notadup = 0 OPEN topwarrior$ FOR INPUT AS #2 OPEN winnerfile$ FOR INPUT AS #1 FOR i = 1 TO 8 LINE INPUT #1, a$: LINE INPUT #2, a$ NEXT i 'skip comments a$ = "": b$ = "" WHILE LEFT$(a$, 3) <> "end" AND a$ = b$ LINE INPUT #1, a$: LINE INPUT #1, b$ IF a$ <> b$ THEN notadup = 1 WEND CLOSE #1: CLOSE #2 GOTO checktopscore noduptocheck: 'RESUME noduptocheck1 noduptocheck1: CLOSE notadup = 1 checktopscore: ON ERROR GOTO fileerror IF notadup THEN n = 0: bscore = 0 OPEN tempbase$ + ".bmk" FOR INPUT AS #1 WHILE NOT EOF(1) LINE INPUT #1, bwar$: n = n + 1 SHELL bxcmd$ + winnerfile$ + " " + bwar$ + " >" + scorefile$ OPEN scorefile$ FOR INPUT AS #2 LINE INPUT #2, bresult$: CLOSE #2 z = INSTR(bresult$, "scores ") bscore = bscore + VAL(MID$(bresult$, z + 7)) WEND CLOSE #1 bscore = (bscore / n) * (100 / bxrounds) IF bscore > (topscore + .01) THEN topscore = bscore OPEN winnerfile$ FOR INPUT AS #1 OPEN topwarrior$ FOR OUTPUT AS #2 WHILE NOT EOF(1) LINE INPUT #1, a$: PRINT #2, a$ WEND PRINT #2, ";bench score"; STR$(bscore) PRINT #2, ";bench dir "; bxdir$; " ("; MID$(STR$(-n), 2); " warriors,"; PRINT #2, STR$(bxrounds); " rounds)" CLOSE #1: CLOSE #2 IF bscore >= savethresh THEN OPEN topwarrior$ FOR INPUT AS #1 f$ = savedir$ + pathsymbol$ + MID$(STR$(-nextsavefile&), 2) + ".red" OPEN f$ FOR OUTPUT AS #2 WHILE NOT EOF(1) LINE INPUT #1, a$: PRINT #2, a$ WEND CLOSE #1: CLOSE #2 nextsavefile& = nextsavefile& + 1 END IF END IF END IF RETURN REM insert topwarrior back into the soup REM input topwarrior$ loserfile$ loserbase$ REM output copies topwarrior to loserfile, updates display REM not bothering to reset name, it's an imposter anyway InsertTopWarrior: ON ERROR GOTO notopwarrioryet OPEN topwarrior$ FOR INPUT AS #1 ON ERROR GOTO fileerror OPEN loserfile$ FOR OUTPUT AS #2 WHILE NOT EOF(1) LINE INPUT #1, a$: PRINT #2, a$ WEND CLOSE #1: CLOSE #2 a$ = loserbase$: GOSUB derivexynumbers: xwar = x: ywar = y GOSUB getwarriorstats: GOSUB plotwarrior RETURN notopwarrioryet: 'RESUME ntwyet1 ntwyet1: CLOSE RETURN REM End of the RedMixer program REM REM History... REM 7/2/09 - v1.2 summary... REM Added automatic benchmarking, saving and re-insertion REM new settings: benchinterval insertinterval topwarrior savedir savethresh REM If benchinterval > 0 every benchinverval soup battles performs a bench REM of current winner (using INI benchdir etc, not changed if changed thru REM options menu), if score > topscore then writes to topwarrior, and if REM score > savethresh also writes to savedir (sequentially numbered). REM If insertinterval > 0 every insertinterval soup battles copies topwarrior REM to current losing warrior (replacing the mutated winner). Usually insert REM is only used if benching but can be used alone to provide pressure. REM Inserted warriors have a complex effect - can induce creation of code REM that beats the warrior, or can mutate to produce stronger varients. REM Added new INI setting: benchpermutate - if yes then uses pmars option -P REM instead of -f (fixed must also be yes, rounds still passed, 142 for nano) REM Added version of ANSI movie mod that also writes average warrior size, REM generation, (and if benchmarking enabled) last score and top score REM new settings: enablemovie (yes/no) frameinverval ansifile REM If enabled, every frameinterval soup battles the current soup display REM is appended to ansifile (interface doesn't have to be enabled). REM Other minor tweaks... unixmode setting, added & to counting vars, REM added code to avoid starting evol if another instance is evolving. REM 5/31/09 - v1.1a - added STR$() around number prints (for FB/Win) REM made so statline column adjusts (was bugging me with small soups) REM modified startup timer to work with Linux (about a second varience) REM added optional INI parameters to solve a couple of usage glitches... REM maxpmlen specifies -l -d numbers for pmars (0 = same as maxlen) REM screenlines specifies # terminal lines (0 = derive from soup Y size) REM benchmask specifies filemask for benchmark warriors (default *.red) REM fixed up other stuff throughout (like reporting coresize on startup) REM 5/17/09 - v1.0e - Linux FreeBasic conversion... commented all RESUME, REM commented break off, added option to quit using Esc (req's server pmars) REM Rewrote benchmark code so not as dos-dependent REM Fixed minor soup coloring bug in plotwarrior (not that it makes much diff) REM Increased "key soak" iterations to 200 to help avoid key bounce REM 2/19/09 - v1.0d improved vparms validation, added specieschanges to set REM how many instructions can change (in percent) and still be same species REM note - behavior change - previous code picked new species even if the REM same instruction was selected again, now checks to make sure different REM Modified status display to print C for cross, S for species change REM Moved "press any key" after battles to avoid covering up results REM Fixed comments and other general editing REM 2/15/09 - v1.0c fixed colormethod validation, added new randomspecies REM setting to select random species rather than name, randomtagrange setting REM to control range of random tags (still in yy_xx format for compatibility, REM number of possible tags is randomtagrange squared), added new crossmode REM value to select cross partner by size REM 2/14/09 - v1.0b fixed getwarriorstats error handling [...] REM modified internal lister so if ysize > 21 it adjusts screen size REM added an array to speed up screen refresh, cleaned up other stuff REM 2/12/09 - v1.0a added benchfixed INI setting, added dialog for REM changing some of the view/bench/pmarsv options, fixed validation REM for crossmode 0 and touched up other INI validation things, REM expanded fields in bench report to permit more bench rounds REM 2/12/09 - v1.0 added a user interface for exploring the soup REM 2/11/09 - fixed incorrect display chars for larger warriors REM 2/10/09 - initial release