Mercurial > repo
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;