view interps/bfjoust/bfjoust.pl @ 3418:d0d4a6a6ad9b

<boily> learn ph\xe1\xbb\x9f l\xc3\xa0 m\xe1\xbb\x99t m\xc3\xb3n \xc4\x83n truy\xe1\xbb\x81n th\xe1\xbb\x91ng c\xe1\xbb\xa7a Vi\xe1\xbb\x87t Nam, c\xc5\xa9ng c\xc3\xb3 th\xe1\xbb\x83 xem l\xc3\xa0 m\xe1\xbb\x99t trong nh\xe1\xbb\xafng m\xc3\xb3n \xc4\x83n \xc4\x91\xe1\xba\xb7c tr\xc6\xb0ng nh\xe1\xba\xa5t cho \xe1\xba\xa9m th\xe1\xbb\xb1c Vi\xe1\xbb\x87t Nam.
author HackBot
date Thu, 15 Aug 2013 19:52:26 +0000
parents 859f9b4339e6
children
line wrap: on
line source

#!/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;