Mercurial > repo

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

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
<Gregor> tar xf egobot.tar.xz
author HackBot
date Sun, 09 Dec 2012 19:30:08 +0000
parents
children
comparison
equal deleted inserted replaced
995:6883f5911eb7 996:859f9b4339e6
1 #!/usr/bin/perl
2 # -*- cperl -*-
3 use strict;
4 use warnings;
5 use feature ":5.10";
6 use Fatal qw/open/;
7
8 my $debug = 0;
9 $/=undef;
10 $\="\n";
11 $,=" ";
12 my ($fh1,$fh2);
13 open $fh1, '<', shift;
14 open $fh2, '<', shift;
15 my $p1 = <$fh1>;
16 my $p2 = <$fh2>;
17 close $fh1;
18 close $fh2;
19 $p1 =~ y/+\-<>.[]()*0-9%{}//cd;
20 $p2 =~ y/+\-<>.[]()*0-9%{}//cd;
21 print $p1 if $debug;
22 print $p2 if $debug;
23 my $tapemaxel = int(rand(20))+10;
24 my @tape = (0) x ($tapemaxel+1);
25 my ($i1,$i2) = (0, $tapemaxel);
26 @tape[$i1,$i2]=(128,128);
27 my $steps = 0;
28 my ($warn1,$warn2) = (0,0);
29 my $bgroup = qr/(?<BGROUP>\((?:[\-+<>.*0-9%{}]|(?&BGROUP))*\))/;
30 while ($steps++ < 100000) {
31 my ($ce1,$ce2) = @tape[$i1,$i2];
32 last if $ce1 && $ce2 && $p1 =~ /^\[\]/ && $p2 =~ /^\[\]/;
33 {{
34 $p1 =~ s/^(\(((?:[\-+<>.*0-9%{}\[\]]|$bgroup)*)\))\*(?<NUM>[0-9]+)/
35 $+{NUM} > 0 ? "$2($2)*".($+{NUM}-1) : ''/e and redo;
36 $p2 =~ s/^(\(((?:[\-+<>.*0-9%{}\[\]]|$bgroup)*)\))\*(?<NUM>[0-9]+)/
37 $+{NUM} > 0 ? "$2($2)*".($+{NUM}-1) : ''/e and redo;
38 $p1 =~ s/^(\(((?:[\-+<>.*0-9%\[\]]|$bgroup)*)
39 \{(?<BRACE>(?:[\-+<>.*0-9%\[\]]|$bgroup|\{(?&BRACE)\})*)\}
40 (?<AFTER>(?:[\-+<>.*0-9%{}\[\]]|$bgroup)*)\))
41 \%(?<NUM>[0-9]+)/
42 $+{NUM} ? "$2$1%".($+{NUM}-1).$+{AFTER} : $+{BRACE}/ex and redo;
43 $p2 =~ s/^(\(((?:[\-+<>.*0-9%\[\]]|$bgroup)*)
44 \{(?<BRACE>(?:[\-+<>.*0-9%\[\]]|$bgroup|\{(?&BRACE)\})*)\}
45 (?<AFTER>(?:[\-+<>.*0-9%{}\[\]]|$bgroup)*)\))
46 \%(?<NUM>[0-9]+)/
47 $+{NUM} ? "$2$1%".($+{NUM}-1).$+{AFTER} : $+{BRACE}/ex and redo;
48 }}
49 $p1 = '.' if $p1 eq '';
50 $p2 = '.' if $p2 eq '';
51
52 given (substr ($p1,0,1,'')) {
53 when ('.') {}
54 when ('+') {$tape[$i1]++; $tape[$i1]%=256;}
55 when ('-') {$tape[$i1]+=255; $tape[$i1]%=256;}
56 when ('<') {$i1--;}
57 when ('>') {$i1++;}
58 when ('[') {
59 $p1 = "[$p1";
60 if($ce1 > 0) {
61 $p1 =~ s/^(\[((?:[\-+<>.()0-9*%{}]|(?1))*)\])/$2$1/ or die; }
62 else {
63 $p1 =~ s/^(\[((?:[\-+<>.()0-9*%{}]|(?1))*)\])// or die; }}
64 default {die "$_$p1";}}
65 given (substr ($p2,0,1,'')) {
66 when ('.') {}
67 when ('+') {$tape[$i2]++; $tape[$i2]%=256;}
68 when ('-') {$tape[$i2]+=255; $tape[$i2]%=256;}
69 when ('<') {$i2++;}
70 when ('>') {$i2--;}
71 when ('[') {
72 $p2 = "[$p2";
73 if($ce2 > 0) {
74 $p2 =~ s/^(\[((?:[\-+<>.()0-9*%{}]|(?1))*)\])/$2$1/ or die; }
75 else {
76 $p2 =~ s/^(\[((?:[\-+<>.()0-9*%{}]|(?1))*)\])// or die; }}
77 default {die "$_$p2"};}
78 print substr $p1,0,80 if $debug;
79 print substr $p2,0,80 if $debug;
80 print @tape if $debug;
81 last if $p1 eq '' && $p2 eq '';
82 last if $i1 < 0 || $i2 < 0 || $i1 > $tapemaxel || $i2 > $tapemaxel;
83 $tape[0] == 0 ? ($warn1++) : ($warn1=0);
84 $tape[$tapemaxel] == 0 ? ($warn2++) : ($warn2=0);
85 last if $warn1 == 2 || $warn2 == 2; }
86
87 my ($p1wins,$p2wins) = (0,0);
88 print "Both programs finished." if "$p1$p2" eq '';
89 print "Both programs are waiting."
90 if $tape[$i1] && $tape[$i2] && $p1 =~ /^\[\]/ && $p2 =~ /^\[\]/;
91 $p2wins++, print "Program 1 went off the left end." if $i1 < 0;
92 $p1wins++, print "Program 2 went off the right end." if $i2 < 0;
93 $p2wins++, print "Program 1 went off the right end." if $i1 > $tapemaxel;
94 $p1wins++, print "Program 2 went off the left end." if $i2 > $tapemaxel;
95 $p2wins++, print "Program 1's flag fell." if $warn1 == 2;
96 $p1wins++, print "Program 2's flag fell." if $warn2 == 2;
97 print "Timeout." if $steps >= 100000;
98 print("Player 1 wins!"), exit 1 if $p1wins > $p2wins;
99 print("Player 2 wins!"), exit 2 if $p1wins < $p2wins;
100 print("Draw!"), exit 0;