Mercurial > repo

comparison shove @ 2021:909b62d951cb

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
<oerjan> fetch http://oerjan.nvg.org/esoteric/shove/shove
author HackBot
date Wed, 06 Feb 2013 23:57:49 +0000
parents
children
comparison
equal deleted inserted replaced
2020:37f8c80f6bf3 2021:909b62d951cb
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) ? @ARGV : <>;
22 chomp for @program;
23
24 my $x = 0;
25 my $y = 0;
26 my $width = 0; $width = ($width < length $_ ? length $_ : $width) for @program;
27 my $height = scalar @program;
28 my $totalrotation = 0;
29 my @stack = ();
30 # always going right, we rotate the program if necessary to ensure this
31
32 # Pads its argument to width $width.
33 sub widthpad {
34 my $s = shift;
35 return $s . (' ' x ($width - length $s));
36 }
37
38 # Rotates the program clockwise (arg = 1), 180 degrees (arg = 2),
39 # or anticlockwise (arg = 3)
40 sub rotateprogram {
41 my $amount = shift;
42 $amount or return;
43 $totalrotation += $amount;
44 $totalrotation %= 4;
45 if ($amount >= 2) {
46 @program = reverse @program;
47 $_ = reverse widthpad $_ for @program;
48 $x = $width - 1 - $x;
49 $y = $height - 1 - $y;
50 tr/<v>^AV()/>^<vVA)(/ for @program;
51 $amount == 2 and return;
52 } else {
53 $_ = widthpad $_ for @program;
54 }
55 my @newprog = ();
56 # We repeatedly move the leftmost column of @program to the top row
57 # of @newprog.
58 while (length $program[0]) {
59 my $build='';
60 $build = (substr $_, 0, 1, '') . $build for @program;
61 push @newprog, $build;
62 }
63 @program = @newprog;
64 tr/<^>v(A)V/^>v<A)V(/ for @program;
65 ($width, $height) = ($height, $width);
66 ($x, $y) = ($width - 1 - $y, $x);
67 }
68
69 sub shove {
70 my $sx = shift;
71 my $sy = shift;
72 if($sx < 0) {
73 $_ = ' '.$_ for @program;
74 $x++;
75 $sx++;
76 $width++;
77 }
78 if($sx >= $width) {
79 $width++;
80 }
81 if($sy < 0) {
82 unshift @program, "";
83 $y++;
84 $sy++;
85 $height++;
86 }
87 if($sy >= $height) {
88 push @program, "";
89 $height++;
90 }
91 scalar @stack or die "Empty stack when shoving.";
92 $program[$sy] = widthpad $program[$sy];
93 ($x > $sx && $y == $sy) and $x += length $stack[0];
94 substr $program[$sy], $sx, 0, shift @stack;
95 $program[$sy] =~ s/\ +$//;
96 $width < length $program[$sy] and $width = length $program[$sy];
97 }
98
99 sub showprogram {
100 my $tr = $totalrotation;
101 print "\nactual size: ($width, $height), pos: ($x, $y)\n";
102 rotateprogram ((4-$tr)%4);
103 $program[$y] = widthpad $program[$y];
104 my $c = substr $program[$y], $x, 1, '*';
105 print "rotated for viewing; pos: ($x, $y), dir: $tr\n";
106 print "stack: ";
107 print "{$_} " for @stack;
108 print "\n";
109 print "$_\n" for @program;
110 substr $program[$y], $x, 1, $c;
111 rotateprogram $tr;
112 scalar <>;
113 }
114
115 while ($x < $width && $y < $height && $x >= 0 && $y >= 0) {
116 showprogram if $debug;
117 my $cmd = substr $program[$y], $x, 1;
118 # $cmd eq '>' is a nop
119 $cmd eq '^' and rotateprogram 1;
120 $cmd eq '<' and rotateprogram 2;
121 $cmd eq 'v' and rotateprogram 3;
122 $cmd eq '(' and shove $x-1, $y;
123 $cmd eq ')' and shove $x+1, $y;
124 $cmd eq 'A' and shove $x, $y-1;
125 $cmd eq 'V' and shove $x, $y+1;
126 $cmd eq 'S' and print $stack[0];
127 $cmd eq 'n' and print '\n';
128 if ($cmd eq '!') {
129 substr $_, 0, $x, '' for @program;
130 $width -= $x;
131 $x = 0;
132 }
133 if ($cmd eq '"' || $cmd eq "'") {
134 my $quotecount = 1;
135 my $lws = $cmd eq "'";
136 my $newpush = "";
137 while($quotecount) {
138 $x++;
139 $x < $width or die "Unterminated string.";
140 $cmd = substr $program[$y], $x, 1;
141 $cmd eq "'" and ($quotecount += ($lws ? -1 : 1)), ($lws = !$lws);
142 $cmd eq '"' and ($quotecount += ($lws ? 1 : -1)), ($lws = !$lws);
143 $quotecount and $newpush .= $cmd;
144 }
145 unshift @stack, $newpush;
146 }
147 $x++; # move to next command
148 }