# HG changeset patch # User HackBot # Date 1360195879 0 # Node ID d0780f04e9c7a70f95e0fa6eeb6405c8e2fbc277 # Parent ed854c3bcf55cecaf18ef14f3601b605e8d9ef52 mv shove bin/shove diff -r ed854c3bcf55 -r d0780f04e9c7 bin/shove --- a/bin/shove Thu Feb 07 00:11:16 2013 +0000 +++ b/bin/shove Thu Feb 07 00:11:19 2013 +0000 @@ -18,7 +18,8 @@ # Read in the program my $debug = ($#ARGV >= 0 and $ARGV[0] eq '-d' and shift and 1); -my @program = ($#ARGV >= 0) ? @ARGV : <>; +my @program = ($#ARGV >= 0 and ($ARGV[0] ne '-f' or (shift and 0))) + ? @ARGV : <>; chomp for @program; my $x = 0; @@ -109,7 +110,7 @@ print "$_\n" for @program; substr $program[$y], $x, 1, $c; rotateprogram $tr; - scalar <>; + scalar ; } while ($x < $width && $y < $height && $x >= 0 && $y >= 0) { diff -r ed854c3bcf55 -r d0780f04e9c7 shove --- a/shove Thu Feb 07 00:11:16 2013 +0000 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,149 +0,0 @@ -#!/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 $debug = ($#ARGV >= 0 and $ARGV[0] eq '-d' and shift and 1); -my @program = ($#ARGV >= 0 and ($ARGV[0] ne '-f' or (shift and 0))) - ? @ARGV : <>; -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 if $debug; - 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 -}