diff interps/bfjoust/bfjoust.pl @ 996:859f9b4339e6

<Gregor> tar xf egobot.tar.xz
author HackBot
date Sun, 09 Dec 2012 19:30:08 +0000
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/interps/bfjoust/bfjoust.pl	Sun Dec 09 19:30:08 2012 +0000
@@ -0,0 +1,100 @@
+#!/usr/bin/perl
+# -*- cperl -*-
+use strict;
+use warnings;
+use feature ":5.10";
+use Fatal qw/open/;
+
+my $debug = 0;
+$/=undef;
+$\="\n";
+$,=" ";
+my ($fh1,$fh2);
+open $fh1, '<', shift;
+open $fh2, '<', shift;
+my $p1 = <$fh1>;
+my $p2 = <$fh2>;
+close $fh1;
+close $fh2;
+$p1 =~ y/+\-<>.[]()*0-9%{}//cd;
+$p2 =~ y/+\-<>.[]()*0-9%{}//cd;
+print $p1 if $debug;
+print $p2 if $debug;
+my $tapemaxel = int(rand(20))+10;
+my @tape = (0) x ($tapemaxel+1);
+my ($i1,$i2) = (0, $tapemaxel);
+@tape[$i1,$i2]=(128,128);
+my $steps = 0;
+my ($warn1,$warn2) = (0,0);
+my $bgroup = qr/(?<BGROUP>\((?:[\-+<>.*0-9%{}]|(?&BGROUP))*\))/;
+while ($steps++ < 100000) {
+  my ($ce1,$ce2) = @tape[$i1,$i2];
+  last if $ce1 && $ce2 && $p1 =~ /^\[\]/ && $p2 =~ /^\[\]/;
+  {{
+    $p1 =~ s/^(\(((?:[\-+<>.*0-9%{}\[\]]|$bgroup)*)\))\*(?<NUM>[0-9]+)/
+      $+{NUM} > 0 ? "$2($2)*".($+{NUM}-1) : ''/e and redo;
+    $p2 =~ s/^(\(((?:[\-+<>.*0-9%{}\[\]]|$bgroup)*)\))\*(?<NUM>[0-9]+)/
+      $+{NUM} > 0 ? "$2($2)*".($+{NUM}-1) : ''/e and redo;
+    $p1 =~ s/^(\(((?:[\-+<>.*0-9%\[\]]|$bgroup)*)
+	      \{(?<BRACE>(?:[\-+<>.*0-9%\[\]]|$bgroup|\{(?&BRACE)\})*)\}
+		(?<AFTER>(?:[\-+<>.*0-9%{}\[\]]|$bgroup)*)\))
+	    \%(?<NUM>[0-9]+)/
+	     $+{NUM} ? "$2$1%".($+{NUM}-1).$+{AFTER} : $+{BRACE}/ex and redo;
+    $p2 =~ s/^(\(((?:[\-+<>.*0-9%\[\]]|$bgroup)*)
+	      \{(?<BRACE>(?:[\-+<>.*0-9%\[\]]|$bgroup|\{(?&BRACE)\})*)\}
+		(?<AFTER>(?:[\-+<>.*0-9%{}\[\]]|$bgroup)*)\))
+	    \%(?<NUM>[0-9]+)/
+	     $+{NUM} ? "$2$1%".($+{NUM}-1).$+{AFTER} : $+{BRACE}/ex and redo;
+  }}
+  $p1 = '.' if $p1 eq '';
+  $p2 = '.' if $p2 eq '';
+
+  given (substr ($p1,0,1,'')) {
+    when ('.') {}
+    when ('+') {$tape[$i1]++;    $tape[$i1]%=256;}
+    when ('-') {$tape[$i1]+=255; $tape[$i1]%=256;}
+    when ('<') {$i1--;}
+    when ('>') {$i1++;}
+    when ('[') {
+      $p1 = "[$p1";
+      if($ce1 > 0) {
+	$p1 =~ s/^(\[((?:[\-+<>.()0-9*%{}]|(?1))*)\])/$2$1/ or die; }
+      else {
+	$p1 =~ s/^(\[((?:[\-+<>.()0-9*%{}]|(?1))*)\])// or die; }}
+    default {die "$_$p1";}}
+  given (substr ($p2,0,1,'')) {
+    when ('.') {}
+    when ('+') {$tape[$i2]++;    $tape[$i2]%=256;}
+    when ('-') {$tape[$i2]+=255; $tape[$i2]%=256;}
+    when ('<') {$i2++;}
+    when ('>') {$i2--;}
+    when ('[') {
+      $p2 = "[$p2";
+      if($ce2 > 0) {
+	$p2 =~ s/^(\[((?:[\-+<>.()0-9*%{}]|(?1))*)\])/$2$1/ or die; }
+      else {
+	$p2 =~ s/^(\[((?:[\-+<>.()0-9*%{}]|(?1))*)\])// or die; }}
+    default {die "$_$p2"};}
+  print substr $p1,0,80 if $debug;
+  print substr $p2,0,80 if $debug;
+  print @tape if $debug;
+  last if $p1 eq '' && $p2 eq '';
+  last if $i1 < 0 || $i2 < 0 || $i1 > $tapemaxel || $i2 > $tapemaxel;
+  $tape[0]          == 0 ? ($warn1++) : ($warn1=0);
+  $tape[$tapemaxel] == 0 ? ($warn2++) : ($warn2=0);
+  last if $warn1 == 2 || $warn2 == 2; }
+
+my ($p1wins,$p2wins) = (0,0);
+print "Both programs finished." if "$p1$p2" eq '';
+print "Both programs are waiting."
+  if $tape[$i1] && $tape[$i2] && $p1 =~ /^\[\]/ && $p2 =~ /^\[\]/;
+$p2wins++, print "Program 1 went off the left end."  if $i1 < 0;
+$p1wins++, print "Program 2 went off the right end." if $i2 < 0;
+$p2wins++, print "Program 1 went off the right end." if $i1 > $tapemaxel;
+$p1wins++, print "Program 2 went off the left end."  if $i2 > $tapemaxel;
+$p2wins++, print "Program 1's flag fell." if $warn1 == 2;
+$p1wins++, print "Program 2's flag fell." if $warn2 == 2;
+print "Timeout." if $steps >= 100000;
+print("Player 1 wins!"), exit 1 if $p1wins > $p2wins;
+print("Player 2 wins!"), exit 2 if $p1wins < $p2wins;
+print("Draw!"), exit 0;