Mercurial > repo
view interps/bfjoust/bfjoust.pl @ 12518:2d8fe55c6e65 draft default tip
<int-e> learn The password of the month is release incident pilot.
author | HackEso <hackeso@esolangs.org> |
---|---|
date | Sun, 03 Nov 2024 00:31:02 +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;