Ehm... not 100% sure it isn't full of bugs.
And never realy got some propper safety around and/or so words with or in them like floor can cause problems... unless on the same line as a store
Kinda silly, think it manages it right in the sgfy function, just not all the other places it checks...
Anyway I'll update when/if I fix it.. it should though, since the whole reason I made this was to try and get the hang of regular expressions and perl.
Also it doesn't handle not, xot, dropbool, clearbool, asf asf...
But it can understand a lot, and I think I'll work on the details and all that.
But so far it can translate a lot of bots, and the script should be easy to adjust and fix.
Just write the name of the file you want translated in the $readfile var.
You'll need something to run the script, I use ActivePerl 5.8.9.825 :
linkTips and tricks for perl and regular expressions are more than welcome.
SGfyer.plmy $readfile = "Filey.txt";
my $writefile = "Sgfied_$readfile";
open(READFILE, "<$readfile");
open(WRITEFILE, ">$writefile");
my @lines = <READFILE>;
my $lineNr = 0;
my $main = 0;
my $header = 1;
my $headerText = "";
my @mainConditionStack;
my @conditionStack;
my $conditions = "";
sub sgfy
{
my $localLine = "$_[0]";
if($localLine =~ m/[\s]*(<=)/){$localLine = "$` 1 sub sub -1 mult sqr dup div$'";}
if($localLine =~ m/[\s]*(>=)/){$localLine = "$` 1 add sub sqr dup div$'";}
if($localLine =~ m/[\s]*(!=)/){$localLine = "$` sub dup div$'";}
if($localLine =~ m/([^!|>|<])=([^!|>|<])/){$localLine = "$`$1sub dup div 1 sub abs$2$'";}
if($localLine =~ m/([^!])<([^!])/){$localLine = "$`$1sub -1 mult sqr dup div$2$'";}
if($localLine =~ m/([^=])>([^=])/){$localLine = "$`$1sub sqr dup div$2$'";}
if($localLine =~ m/[\W]?(and)[\W]?/){$localLine = "$`mult $'";}
if($localLine =~ m/[\W]?(or)[\W]?/){$localLine = "$`add $'";}
return $localLine;
}
sub addCondition
{
my $newLine = "$_[0]";
if($newLine =~ m/([\W\D]{1})([=|>|<]{1})([\W\D]{1})/)
{
if($main){unshift(@mainConditionStack, sgfy("$`$1$2$3"));}
else{unshift(@conditionStack, sgfy("$`$1$2$3"));}
$newLine = "$'";
}
while($newLine =~ m/[\W]?(and)[\W]?/|| $newLine =~ m/[\W]?(or)[\W]?/)
{
if($main){unshift(@mainConditionStack, sgfy("$`$1\n"));}
else{unshift(@conditionStack, sgfy("$`$1\n"));}
$newLine = "$'";
}
}
sub getConditions
{
my $currentConditions = "";
my $bools = 1;
if(@conditionStack == 0 && @mainConditionStack == 0){return "";}
#Non main is backwards
foreach my $cond (@conditionStack)
{
if($bools <= 0){next;}
if($cond =~m/^(mult|add)/){$bools += 2;}
$bools--;
$currentConditions = "$cond$currentConditions";
#if($bools <= 0){continue;}
}
if(!($currentConditions eq "")){$currentConditions = "$currentConditions mult ";}
#Main is backwards, then forwards
$bools = 1;
my @mergedMain = ();
my $mergedMainCond = "";
foreach my $mmcond (@mainConditionStack)
{
if($mmcond =~m/^(mult|add)/){$bools += 2;}
$bools--;
$mergedMainCond = "$mmcond$mergedMainCond";
if($bools <= 0)
{
push(@mergedMain, $mergedMainCond);
$mergedMainCond = "";
$bools = 1;
}
}
$bools = 1;
foreach my $mcond (@mergedMain)
{
if($bools)
{
$bools = 0;
$currentConditions = "$currentConditions $mcond";
next;
}
$currentConditions = "$currentConditions $mcond mult ";
}
$currentConditions = "$currentConditions mult ";
return $currentConditions;
}
print "SGFYING!\n";
foreach my $line (@lines)
{
#Comments
if($line =~ m/^'/)
{
if($header){$headerText = "$headerText$line";}
else{print WRITEFILE $line;}
next;
}
#Not supported
$lineNr++;
if($line =~ m/(\s[*]\s|~=|%=|clearbool|dropbool|dupbool|swapbool|overbool|xor|not)/)
{
print "$1 not supported line $lineNr\n";
next;
}
if($header)
{
$headerText = "$headerText\n'****************\n'*****SGfyed*****\n'****************\n\n";
print WRITEFILE $headerText;
$header = 0;
}
#Pre manage
if($line =~ m/[^*]([.]{1}[\w]+|[\d]+)\s+inc/){$line = "*$1 1 add $1 store\n";}
if($line =~ m/([*.]{1}[\w]+|[\d]+)\s+inc/){$line = "$1 * 1 add $1 store\n";}
if($line =~ m/[^*]([.]{1}[\w]+|[\d]+)\s+dec/){$line = "*$1 1 sub $1 store\n";}
if($line =~ m/([*.]{1}[\w]+|[\d]+)\s+dec/){$line = "$1 * 1 sub $1 store\n";}
#Genes
if($line =~ m/[\W]*cond[\W]*/){$main = 1; next;}
if($line =~ m/[\W]*start[\W]*/){$main = 0; print WRITEFILE "start\n"; next;}
if($line =~ m/[\W]*stop[\W]*/){@mainConditionStack = (); print WRITEFILE "stop\n"; next;}
#Store
if($line =~ m/(store)/)
{
$conditions = getConditions();
$line = "$` $conditions $1$'";
#print $line;
print WRITEFILE $line;
next;
}
#Conditions
if($line =~ m/[=|>|<]/ || $line =~ m/[\W]and[\W]/|| $line =~ m/[\W]or[\W]/){addCondition($line);next;}
print WRITEFILE $line;
}
close(READFILE);
close(WRITEFILE);
print "\nDONE!";
I'd upload the file, but would have to rar it (Not allowed to upload this type of file).
Could SGfy bots like Roto1 and Bubbles... didn't try much else.
Even with the extreme amount of conditions in bubbles the SGfying didn't make any notisable difference.
Litle disapointed, had hoped it might have improved bubbles slightly, but the new and old versions are a clear tie...
I figure cost reduction is only usefull in numreous micro bots with low energy that don't move or shoot much
But had some fun while exploring perl and reg expressions, and so far perl is growing on me $-)