#!/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 () { chomp; print generate_map(generate_cube(translate_alg($_))), "\n"; }