#!/usr/bin/perl

=pod

Below is the original unobfuscated source that I originally wrote. It
is a fairly simple Befunge-93 interpreter, implementing almost all of
the befunge language as described by
http://www.cats-eye.com/funge/doc/df93.html The only operations that

****** Note from Orwant:
Invalid URL.  Try http://www.cats-eye.com/funge and descend.
******
are missing are the user input functions '&' and '~', which were going
to take too much space.

The comments eventually got removed to cut the 3K file down to 1000
bytes.  I left use strict in until very near the end of the
obfuscation process, along with the my declarations of most of the
variables, even the new ones I set up during the obfuscation, to help
me keep from shooting myself in the foot.

I chose what I thought to be a somewhat odd way to implement the
interpreter from the beginning - choosing to implement a perl swich
with a hash and a bag of anonymous subroutine references. The big hash
in the middle of the code just literally translates the html
specification into perl code. I wanted to set up some kind of use of
closures within the code, too.

I wanted to implement the befunge virtual machine as in such a way
that the internals of it were not visible to the main part of the
program. I declared a BEGIN sub which declared most of the state
variables of the befunge machine with my ($row, $col, @stack, $d), so
that they would not be visible to the outside world. However, I 
aranged for the BEGIN sub to also create subs that would do all
of the primative operations on the state variables - this way
the befunge virtual machine is implemented as a closure. 

The only state variable that is not part of the closure, in the
obfuscated version, is the instruction table. I call this a state
variable, because I actually have two instruction tables that get
interchenged as teh befunge machine enters/leaves quote mode.  You can
see the instruction table in the unobfuscated code below.  I thought
it was kind of cool to have a hash of anonymous subs as the values,
with the instruction characters as the keys. This actually seems
fairly natural to me now. 

The obfuscation of the instruction table happened in several
stages. First, I removed references to the state variables, replacing
them with the functions described above in the BEGIN block. Next, I
noticed a great deal of repetion in the declaration, so I wrote
another handful of subroutines that generated the text of the table,
and called eval on the result. (This is the eval outside the BEGIN
block. I then moved all of the generator functions into the BEGIN
block, and did a similar eval trick with them. I didnt like all of the
perl keywords that were residing in the eval strings, so I wrote a
coupleof cheap regex replaces to hide some of them. In particular I
wanted to get rid of all of the sub keywords. Hopefully they are not
too obvious.

Next, I had to carefully trim down the code to get it under 1000
bytes. This resulted in a handful of minor obfuscations, which I no
longer remember.

Finally, I had to arrange the code to be a Befunge program, while
keeping it functioning as a perl script and under 1000 bytes. I am
somewhat pleased by the fact that I managed to get many of the letters
for the output out of the code itself. The '^' in the comment in the
first line directs the befunge program counter to proceed vertically,
where it immediately wraps to the end of the code, and starts moving
up column 4. It pushes 'l','a','n','o', and 'u' onto the stack. The
comment on line 6 then does some significant work. The '>' in column 4
directs the program counter to proceed to the right. The \ swaps the
'u' and the 'o' on the stack. We next enter quote mode, and push 'J',
' ',' ','e','g' onto the stack and exit quote mode. '1+' adds a unit
to 'g' turning it into an 'h'. 'T' gets itself pushed onto the
stack. The four commas print out "The ". 'l' gets pushed on the
stack. The '#' forces the processor to skip the next character. The
way I have implemented horizontal wrapping, the next instruction is
the '#' character in column 1. Other befunge interpreters will behave
slightly differently. We now push 'r' onto the stack, and the '^' make
the processor move up again. 'e','P','G' are pushed onto the
stack. The '_' pops the 'G' off the stack, and check to see if it is
zero. If so the program counter proceeds to the left, otherwise to the
right. 'G' is not zero, so left it is. ',' prints the 'P'. '#' skips
the '@'. ':' clones the 'e' on the stack. We are back to the '_'. It
pops one of the 'e's off the stack, and check to see if it is
zero. No? Go left, and print the other 'e'. This loop will eventually
iterate though all of the letters on the stack, printing out the rest
of the message. When the stack is empty it will appear to be an
endless stream of zeros, so the ':' operator effectively does nothing,
and the '_' operator forces the execution to the right, where the
program counter encounters the terminating '@' sign.

If you are curious, you can uncomment out the print statement in
the main loop below, and watch this happen by invoking 
"perl SOLUTION bejourn.pl"

Happy judging.

=cut

#!/usr/bin/perl
use strict;

##read in the board
#open FILE,$ARGV[0];

#originally planned not to take the board from STDIN, so that I could
# have a way to get some input operators, but it was too much work.

my @board = <>;

#turn lines into arrays...
foreach (@board) { $_=[split /\n*/] }

#these variables describe the state of the befunge machine
my $row = 0;
my $col = 0;
my $d = 0;
my @stack = ();


#pc motion encoding:
#
#   1
#   ^
#2 < > 0
#   v
#   3 
#
# @ -99

sub move {
    my $w = @{$board[$row]}; 
    my $h = @board;

    $d==0 && do{ $col++; $col=0 if $col>=$w;};
    $d==2 && do{ $col||($col=$w); $col--;   };
    $d==3 && do{ $row++; $row=0 if $row>=$h;};
    $d==1 && do{ $row||($row=$h);$row--;    };

#    do { $col++; $col = 0 unless $col < $w } if $d == 0;
#    do { $col ? $col-- : $col += $w} } if $d == 2;
#    do { $row++; $row = 0 unless $row < $h } if $d == 3;
#    do { $row ? $row-- : do{$row +=$h} } if $d == 1;
}

#it was too much typing to declare these locally within the
#anonymous subs, and it also gives me an idea for trying to
#throw in some unnecessary closures.
my ($a,$b,$x,$y,$val);

my @op_tables = (0,0);

my %instructions = 
    ( 
      "+" => sub { $a = pop(@stack); $b = pop(@stack);push @stack, $b+$a },
      "-" => sub { $a = pop(@stack); $b = pop(@stack);push @stack, $b-$a },
      "*" => sub { $a = pop(@stack); $b = pop(@stack);push @stack, $b*$a },
      "/" => sub { $a = pop(@stack); $b = pop(@stack);push @stack, $b/$a },
      "%" => sub { $a = pop(@stack); $b = pop(@stack);push @stack, $b%$a },
      "`" => sub { $a = pop(@stack); $b = pop(@stack);push @stack, $b>$a },
      "!" => sub { $a = pop(@stack); push @stack, !$a },
      "<" => sub { $d = 2 },
      ">" => sub { $d = 0 },
      "^" => sub { $d = 1 },
      "v" => sub { $d = 3 },
      "?" => sub { int rand(4) },
      "_" => sub { $d = pop(@stack) ? 2 : 0 },
      "|" => sub { $d = pop(@stack) ? 1 : 3 },
      '"' => sub { @op_tables[0,1] = @op_tables[1,0] },
      ":" => sub { push @stack, $stack[-1] },
      '\\' => sub { @stack[-1,-2] = @stack[-2,-1] },
      "#" => sub { move },
      "g" => sub { $y = pop @stack; $x = pop @stack; 
		   push @stack, ord $board[$x][$y]; },
      "p" => sub { $y = pop @stack; $x = pop @stack; 
                   my $val = pop @stack;
		   $board[$x][$y] = chr $val;},
      "." => sub { print pop(@stack)," " },
      "," => sub { print chr pop(@stack) },
      "\$" => sub { pop @stack },
      "@" => sub { print "\n"; $d = -99 },
      " " => sub { 123; },

      #input operations -- not supported (too much trouble)
      #~" => sub { push @stack, getc },
      #&" => sub { push @stack, <> },

      #special digit operators
      "0" => sub {push @stack,0},
      "1" => sub {push @stack,1},
      "2" => sub {push @stack,2},
      "3" => sub {push @stack,3},
      "4" => sub {push @stack,4},
      "5" => sub {push @stack,5},
      "6" => sub {push @stack,6},
      "7" => sub {push @stack,7},
      "8" => sub {push @stack,8},
      "9" => sub {push @stack,9},

      );

my %stringmode_instructions = 
    ( '"' => sub { @op_tables[0,1] = @op_tables[1,0] },
      );

@op_tables = (\%instructions,\%stringmode_instructions);

#main loop
while( $d > -99) {
    my $c = $board[$row][$col];
#debugging code - important to debug BEFORE you obfuscate...
    print STDERR "row = $row, col = $col, c = $c, stack:@stack\n";
    
    #check for accessing undefined portions of the board.
    $c = " " unless defined $c;
    $c=~y/\s/ /;
    if( exists $op_tables[0]{$c} ) {
	$op_tables[0]{$c}->();
    } else {
	push @stack, ord($c);
    }

    move;
    
}







