#!/usr/bin/env perl # -*- cperl -*- # Shove interpreter. By Alex Smith. # Commands: # ' " Quote a string ('' strings nest inside "" strings and vice versa) # < v > ^ Change direction of execution # A V ( ) Pop a string onto the playfield # space NOP # ! NOP, but tells the compiler that everything behind the IP will # never be used (a useful optimisation) # S NOP, but outputs TOS (without popping) on systems with output # n NOP, but outputs a newline on systems with output use strict; # Read in the program my @program = <>; chomp for @program; my $x = 0; my $y = 0; my $width = 0; $width = ($width < length $_ ? length $_ : $width) for @program; my $height = scalar @program; my $totalrotation = 0; my @stack = (); # always going right, we rotate the program if necessary to ensure this # Pads its argument to width $width. sub widthpad { my $s = shift; return $s . (' ' x ($width - length $s)); } # Rotates the program clockwise (arg = 1), 180 degrees (arg = 2), # or anticlockwise (arg = 3) sub rotateprogram { my $amount = shift; $amount or return; $totalrotation += $amount; $totalrotation %= 4; if ($amount >= 2) { @program = reverse @program; $_ = reverse widthpad $_ for @program; $x = $width - 1 - $x; $y = $height - 1 - $y; tr/^AV()/>^v(A)V/^>v= $width) { $width++; } if($sy < 0) { unshift @program, ""; $y++; $sy++; $height++; } if($sy >= $height) { push @program, ""; $height++; } scalar @stack or die "Empty stack when shoving."; $program[$sy] = widthpad $program[$sy]; ($x > $sx && $y == $sy) and $x += length $stack[0]; substr $program[$sy], $sx, 0, shift @stack; $program[$sy] =~ s/\ +$//; $width < length $program[$sy] and $width = length $program[$sy]; } sub showprogram { my $tr = $totalrotation; print "\nactual size: ($width, $height), pos: ($x, $y)\n"; rotateprogram ((4-$tr)%4); $program[$y] = widthpad $program[$y]; my $c = substr $program[$y], $x, 1, '*'; print "rotated for viewing; pos: ($x, $y), dir: $tr\n"; print "stack: "; print "{$_} " for @stack; print "\n"; print "$_\n" for @program; substr $program[$y], $x, 1, $c; rotateprogram $tr; scalar <>; } while ($x < $width && $y < $height && $x >= 0 && $y >= 0) { showprogram; my $cmd = substr $program[$y], $x, 1; # $cmd eq '>' is a nop $cmd eq '^' and rotateprogram 1; $cmd eq '<' and rotateprogram 2; $cmd eq 'v' and rotateprogram 3; $cmd eq '(' and shove $x-1, $y; $cmd eq ')' and shove $x+1, $y; $cmd eq 'A' and shove $x, $y-1; $cmd eq 'V' and shove $x, $y+1; $cmd eq 'S' and print $stack[0]; $cmd eq 'n' and print '\n'; if ($cmd eq '!') { substr $_, 0, $x, '' for @program; $width -= $x; $x = 0; } if ($cmd eq '"' || $cmd eq "'") { my $quotecount = 1; my $lws = $cmd eq "'"; my $newpush = ""; while($quotecount) { $x++; $x < $width or die "Unterminated string."; $cmd = substr $program[$y], $x, 1; $cmd eq "'" and ($quotecount += ($lws ? -1 : 1)), ($lws = !$lws); $cmd eq '"' and ($quotecount += ($lws ? 1 : -1)), ($lws = !$lws); $quotecount and $newpush .= $cmd; } unshift @stack, $newpush; } $x++; # move to next command }