Mercurial > repo
comparison bin/shove @ 2114:7914d7e0b500
<ais523> revert 87c64ef250a0
author | HackBot |
---|---|
date | Wed, 13 Feb 2013 00:17:51 +0000 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
2113:1c1429d055bc | 2114:7914d7e0b500 |
---|---|
1 #!/usr/bin/env perl | |
2 # -*- cperl -*- | |
3 # Shove interpreter. By Alex Smith. | |
4 | |
5 # Commands: | |
6 # ' " Quote a string ('' strings nest inside "" strings and vice versa) | |
7 # < v > ^ Change direction of execution | |
8 # A V ( ) Pop a string onto the playfield | |
9 # space NOP | |
10 | |
11 # ! NOP, but tells the compiler that everything behind the IP will | |
12 # never be used (a useful optimisation) | |
13 # S NOP, but outputs TOS (without popping) on systems with output | |
14 # n NOP, but outputs a newline on systems with output | |
15 | |
16 use strict; | |
17 | |
18 # Read in the program | |
19 | |
20 my $debug = ($#ARGV >= 0 and $ARGV[0] eq '-d' and shift and 1); | |
21 my @program = ($#ARGV >= 0 and ($ARGV[0] ne '-f' or (shift and 0))) | |
22 ? @ARGV : <>; | |
23 chomp for @program; | |
24 | |
25 my $x = 0; | |
26 my $y = 0; | |
27 my $width = 0; $width = ($width < length $_ ? length $_ : $width) for @program; | |
28 my $height = scalar @program; | |
29 my $totalrotation = 0; | |
30 my @stack = (); | |
31 # always going right, we rotate the program if necessary to ensure this | |
32 | |
33 # Pads its argument to width $width. | |
34 sub widthpad { | |
35 my $s = shift; | |
36 return $s . (' ' x ($width - length $s)); | |
37 } | |
38 | |
39 # Rotates the program clockwise (arg = 1), 180 degrees (arg = 2), | |
40 # or anticlockwise (arg = 3) | |
41 sub rotateprogram { | |
42 my $amount = shift; | |
43 $amount or return; | |
44 $totalrotation += $amount; | |
45 $totalrotation %= 4; | |
46 if ($amount >= 2) { | |
47 @program = reverse @program; | |
48 $_ = reverse widthpad $_ for @program; | |
49 $x = $width - 1 - $x; | |
50 $y = $height - 1 - $y; | |
51 tr/<v>^AV()/>^<vVA)(/ for @program; | |
52 $amount == 2 and return; | |
53 } else { | |
54 $_ = widthpad $_ for @program; | |
55 } | |
56 my @newprog = (); | |
57 # We repeatedly move the leftmost column of @program to the top row | |
58 # of @newprog. | |
59 while (length $program[0]) { | |
60 my $build=''; | |
61 $build = (substr $_, 0, 1, '') . $build for @program; | |
62 push @newprog, $build; | |
63 } | |
64 @program = @newprog; | |
65 tr/<^>v(A)V/^>v<A)V(/ for @program; | |
66 ($width, $height) = ($height, $width); | |
67 ($x, $y) = ($width - 1 - $y, $x); | |
68 } | |
69 | |
70 sub shove { | |
71 my $sx = shift; | |
72 my $sy = shift; | |
73 if($sx < 0) { | |
74 $_ = ' '.$_ for @program; | |
75 $x++; | |
76 $sx++; | |
77 $width++; | |
78 } | |
79 if($sx >= $width) { | |
80 $width++; | |
81 } | |
82 if($sy < 0) { | |
83 unshift @program, ""; | |
84 $y++; | |
85 $sy++; | |
86 $height++; | |
87 } | |
88 if($sy >= $height) { | |
89 push @program, ""; | |
90 $height++; | |
91 } | |
92 scalar @stack or die "Empty stack when shoving."; | |
93 $program[$sy] = widthpad $program[$sy]; | |
94 ($x > $sx && $y == $sy) and $x += length $stack[0]; | |
95 substr $program[$sy], $sx, 0, shift @stack; | |
96 $program[$sy] =~ s/\ +$//; | |
97 $width < length $program[$sy] and $width = length $program[$sy]; | |
98 } | |
99 | |
100 sub showprogram { | |
101 my $tr = $totalrotation; | |
102 print "\nactual size: ($width, $height), pos: ($x, $y)\n"; | |
103 rotateprogram ((4-$tr)%4); | |
104 $program[$y] = widthpad $program[$y]; | |
105 my $c = substr $program[$y], $x, 1, '*'; | |
106 print "rotated for viewing; pos: ($x, $y), dir: $tr\n"; | |
107 print "stack: "; | |
108 print "{$_} " for @stack; | |
109 print "\n"; | |
110 print "$_\n" for @program; | |
111 substr $program[$y], $x, 1, $c; | |
112 rotateprogram $tr; | |
113 scalar <STDIN>; | |
114 } | |
115 | |
116 while ($x < $width && $y < $height && $x >= 0 && $y >= 0) { | |
117 showprogram if $debug; | |
118 my $cmd = substr $program[$y], $x, 1; | |
119 # $cmd eq '>' is a nop | |
120 $cmd eq '^' and rotateprogram 1; | |
121 $cmd eq '<' and rotateprogram 2; | |
122 $cmd eq 'v' and rotateprogram 3; | |
123 $cmd eq '(' and shove $x-1, $y; | |
124 $cmd eq ')' and shove $x+1, $y; | |
125 $cmd eq 'A' and shove $x, $y-1; | |
126 $cmd eq 'V' and shove $x, $y+1; | |
127 $cmd eq 'S' and print $stack[0]; | |
128 $cmd eq 'n' and print '\n'; | |
129 if ($cmd eq '!') { | |
130 substr $_, 0, $x, '' for @program; | |
131 $width -= $x; | |
132 $x = 0; | |
133 } | |
134 if ($cmd eq '"' || $cmd eq "'") { | |
135 my $quotecount = 1; | |
136 my $lws = $cmd eq "'"; | |
137 my $newpush = ""; | |
138 while($quotecount) { | |
139 $x++; | |
140 $x < $width or die "Unterminated string."; | |
141 $cmd = substr $program[$y], $x, 1; | |
142 $cmd eq "'" and ($quotecount += ($lws ? -1 : 1)), ($lws = !$lws); | |
143 $cmd eq '"' and ($quotecount += ($lws ? 1 : -1)), ($lws = !$lws); | |
144 $quotecount and $newpush .= $cmd; | |
145 } | |
146 unshift @stack, $newpush; | |
147 } | |
148 $x++; # move to next command | |
149 } |