rendered paste body#!/usr/bin/perl
use warnings;
use strict;
# The cube is treated as a list of facelets internally. Such that: (Yeah, it's messed up, but it makes the anonymous subs easier to handle)
#
# 363738
# 394041
# 424344
#
# 272829 000102 091011 454647
# 303132 030405 121314 484950
# 333435 060708 151617 515253
#
# 181920
# 212223
# 242526
my @DEFAULT_CUBE = split //, 'w' x 9 . 'r' x 9 . 'g' x 9 . 'o' x 9 . 'b' x 9 . 'y' x 9;
if ($ARGV[0]) {
if ($ARGV[0] eq '-h') {
print "Usage: perl cube.plx [INFILE] [OUTFILE]\n";
exit 0;
} else {
open STDIN, $ARGV[0] or die "Can't open: $!\n";
if ($ARGV[1]) { open STDOUT, ">$ARGV[1]" or die "Can't open: $!\n"; }
}
}
# Now to define the face turn manipulations. There'll be 18 (6 faces * 3 modifiers), in U U2 U' ... DFBLR. Algs will be remapped to this number order.
my @face_turns = (
# U
sub { (@_[ 6, 3, 0, 7, 4, 1, 8, 5, 2,
42, 10, 11, 43, 13, 14, 44, 16, 17,
15, 12, 9, 21 .. 26,
27, 28, 18, 30, 31, 19, 33, 34, 20,
36 .. 41, 35, 32, 29,
45 .. 53 ]) },
# U2
sub { (@_[ 8, 7, 6, 5, 4, 3, 2, 1, 0,
35, 10, 11, 32, 13, 14, 29, 16, 17,
44, 43, 42, 21 .. 26,
27, 28, 15, 30, 31, 12, 33, 34, 9,
36 .. 41, 20, 19, 18,
45 .. 53 ]) },
# U'
sub { (@_[ 2, 5, 8, 1, 4, 7, 0, 3, 6,
20, 10, 11, 19, 13, 14, 18, 16, 17,
29, 32, 35, 21 .. 26,
27, 28, 44, 30, 31, 43, 33, 34, 42,
36 .. 41, 9, 12, 15,
45 .. 53 ]) },
# D
sub { (@_[ 0 .. 8,
9, 10, 26, 12, 13, 25, 15, 16, 24,
18 .. 23, 27, 30, 33,
38, 28, 29, 37, 31, 32, 36, 34, 35,
11, 14, 17, 39 .. 44,
51, 48, 45, 52, 49, 46, 53, 50, 47 ]) },
# D2
sub { (@_[ 0 .. 8,
9, 10, 33, 12, 13, 30, 15, 16, 27,
18 .. 23, 38, 37, 36,
17, 28, 29, 14, 31, 32, 11, 34, 35,
26, 25, 24, 39 .. 44,
53, 52, 51, 50, 49, 48, 47, 46, 45 ]) },
# D'
sub { (@_[ 0 .. 8,
9, 10, 36, 12, 13, 37, 15, 16, 38,
18 .. 23, 17, 14, 11,
24, 28, 29, 25, 31, 32, 26, 34, 35,
33, 30, 27, 39 .. 44,
47, 50, 53, 46, 49, 52, 45, 48, 51 ]) },
# F
sub { (@_[ 0 .. 5, 33, 34, 35,
9 .. 14, 6, 7, 8,
24, 21, 18, 25, 22, 19, 26, 23, 20,
27 .. 32, 53, 52, 51,
36 .. 44,
45 .. 50, 15, 16, 17 ]) },
# F2
sub { (@_[ 0 .. 5, 51, 52, 53,
9 .. 14, 33, 34, 35,
26, 25, 24, 23, 22, 21, 20, 19, 18,
27 .. 32, 15, 16, 17,
36 .. 44,
45 .. 50, 6, 7, 8 ]) },
# F'
sub { (@_[ 0 .. 5, 15, 16, 17,
9 .. 14, 51, 52, 53,
20, 23, 26, 19, 22, 25, 18, 21, 24,
27 .. 32, 6, 7, 8,
36 .. 44,
45 .. 50, 33, 34, 35 ]) },
# B
sub { (@_[ 9, 10, 11, 3 .. 8,
45, 46, 47, 12 .. 17,
18 .. 26,
0, 1, 2, 30 .. 35,
42, 39, 36, 43, 40, 37, 44, 41, 38,
27, 28, 29, 48 .. 53 ]) },
# B2
sub { (@_[ 45, 46, 47, 3 .. 8,
27, 28, 29, 12 .. 17,
18 .. 26,
9, 10, 11, 30 .. 35,
44, 43, 42, 41, 40, 39, 38, 37, 36,
0, 1, 2, 48 .. 53 ]) },
# B'
sub { (@_[ 27, 28, 29, 3 .. 8,
0, 1, 2, 12 .. 17,
18 .. 26,
45, 46, 47, 30 .. 35,
38, 41, 44, 37, 40, 43, 36, 39, 42,
9, 10, 11, 48 .. 53 ]) },
# L
sub { (@_[ 36, 1, 2, 39, 4, 5, 42, 7, 8,
9 .. 17,
0, 19, 20, 3, 22, 23, 6, 25, 26,
33, 30, 27, 34, 31, 29, 35, 32, 29,
53, 37, 38, 50, 40, 41, 47, 43, 44,
45, 46, 24, 48, 49, 21, 51, 52, 18 ]) },
# L2
sub { (@_[ 53, 1, 2, 50, 4, 5, 47, 7, 8,
9 .. 17,
42, 19, 20, 39, 22, 23, 36, 25, 26,
35, 34, 33, 32, 31, 30, 29, 28, 27,
18, 37, 38, 21, 40, 41, 24, 43, 44,
45, 46, 2, 48, 49, 1, 51, 52, 0 ]) },
# L'
sub { (@_[ 18, 1, 2, 21, 4, 5, 24, 7, 8,
9 .. 17,
53, 19, 20, 50, 22, 23, 47, 25, 26,
29, 32, 35, 28, 31, 34, 27, 30, 33,
0, 37, 38, 3, 40, 41, 6, 43, 44,
45, 46, 36, 48, 49, 39, 51, 52, 42 ]) },
# R
sub { (@_[ 0, 1, 20, 3, 4, 23, 6, 7, 26,
15, 12, 9, 16, 13, 10, 17, 14, 11,
18, 19, 51, 21, 22, 48, 24, 25, 45,
27 .. 35,
36, 37, 2, 39, 40, 5, 42, 43, 8,
44, 46, 47, 41, 49, 50, 38, 52, 53 ]) },
# R2
sub { (@_[ 0, 1, 51, 3, 4, 48, 6, 7, 45,
17, 16, 15, 14, 13, 12, 11, 10, 9,
18, 19, 38, 21, 22, 41, 24, 25, 44,
27 .. 35,
36, 37, 20, 39, 40, 23, 42, 43, 26,
8, 46, 47, 5, 49, 50, 2, 52, 53 ]) },
# R'
sub { (@_[ 0, 1, 38, 3, 4, 41, 6, 7, 44,
11, 14, 17, 10, 13, 16, 9, 12, 15,
18, 19, 2, 21, 22, 5, 24, 25, 8,
27 .. 35,
36, 37, 51, 39, 40, 48, 42, 43, 45,
26, 46, 47, 23, 49, 50, 20, 52, 53 ]) },
);
sub translate_alg { # String -> List
# Prep the alg a bit.
my $alg = lc $_[0];
$alg =~ s/\s+//g;
$alg =~ s/'/x/g; #'
if ($alg =~ /[^udfblrx2]/) { die "Skipping $alg for invalid characters.\n" }
$alg =~ s/([udfblr])/ $1/g;
# Set up the translation hash.
my %turns = qw/u 0 u2 1 ux 2 d 3 d2 4 dx 5 f 6 f2 7 fx 8 b 9 b2 10 bx 11 l 12 l2 13 lx 14 r 15 r2 16 rx 17/;
# Translate to array/list
$alg =~ s/ ([udfblrx2]+)/ $turns{$1}/g;
$alg =~ s/^\s+//g;
return split / /, $alg;
}
sub generate_cube { # List -> List
my @cube = @DEFAULT_CUBE;
foreach (@_) {
@cube = $face_turns[$_](@cube);
}
return @cube;
}
sub generate_map { # List -> String
return " $_[36]$_[37]$_[38]\n" .
" $_[39]$_[40]$_[41]\n" .
" $_[42]$_[43]$_[44]\n" .
"\n" .
"$_[27]$_[28]$_[29] $_[0]$_[1]$_[2] $_[ 9]$_[10]$_[11] $_[45]$_[46]$_[47]\n" .
"$_[30]$_[31]$_[32] $_[3]$_[4]$_[5] $_[12]$_[13]$_[14] $_[48]$_[49]$_[50]\n" .
"$_[33]$_[34]$_[35] $_[6]$_[7]$_[8] $_[15]$_[16]$_[17] $_[51]$_[52]$_[53]\n" .
"\n" .
" $_[18]$_[19]$_[20]\n" .
" $_[21]$_[22]$_[23]\n" .
" $_[24]$_[25]$_[26]\n";
}
while (<STDIN>) {
chomp;
print generate_map(generate_cube(translate_alg($_))), "\n";
}