Speffz BLD tools

A program to generate a BLD memo sequence in speffz from a standard WCA scramble.

A work-in-progress: needs scramble parser and performer

#!perl -w
use strict;
use Data::Dumper::Simple;

print "yo, let's speffz it up...\n";
my $scr = shift || "R U R' U'";
my $debug = 1;
my $cs = fresh_cube();
#~ print $cs;
#~ print "\n";
my $p = draw($cs);
print $p;
print "\n";

## Unscrambled 3x3 cube state in speffz format
sub fresh_cube {
    my $s = "";
    foreach('A'..'X') { $s .= $_ . lc($_); }
    return $s;	
}

## Split speffz cube state into 6 faces
sub faces {
    local $_ = shift;
    die unless /^(.{8})(.{8})(.{8})(.{8})(.{8})(.{8})$/;
    return ($1, $2, $3, $4, $5, $6); 
}
## Draw the given cube state as a human-friendly net
# here we can support different face orders
# ULFRBD is the speffz standard though
#
#     +-+
#     |U|
#   +-+-+-+-+
#   |L|F|R|B|
#   +-+-+-+-+
#     |D|
#     +-+
# 
#       AaB
#       d*b
#       DcC
#    EeFIiJMmNQqR
#    h*fl*jp*nt*r
#    HgGLkKPoOTsS
#       UuV
#       x*v
#       XwW
#   
#           +-+-+-+
#           |A|a|B|
#           +-+-+-+
#           |d|*|b|
#           +-+-+-+
#           |D|c|C|
#     +-+-+-+-+-+-+-+-+-+-+-+-+
#     |E|e|F|I|i|J|M|m|N|Q|q|R|
#     +-+-+-+-+-+-+-+-+-+-+-+-+
#     |h|*|f|l|*|j|p|*|n|t|*|r|
#     +-+-+-+-+-+-+-+-+-+-+-+-+
#     |H|g|G|L|k|K|P|o|O|T|s|S|
#     +-+-+-+-+-+-+-+-+-+-+-+-+
#           |U|u|V|
#           +-+-+-+
#           |x|*|v|
#           +-+-+-+
#           |X|w|W|
#           +-+-+-+
#     
sub draw {
    my $s = shift;
    my $boxes = 1;
    my @a = faces($s);
    #~ print Dumper(\@a);
    #~ print "\n";
    my @rd = map{ facerows($_) }@a;
    #~ print Dumper(\@rd);
    #~ print "\n";
    my @rows;
    # here we can set up the drawing style to use - raw or boxes
    my $dent = $boxes ? ' 'x6 : ' 'x3;
    my $v = $boxes ? "|" : "";
    # U
    my ($u, $l, $f, $r, $b, $d) = @rd;
    if($boxes) { push @rows, $dent."+-+-+-+"; }
    push @rows, $dent.$v.join($v, @{$u->[0]}).$v;
    if($boxes) { push @rows, $dent."+-+-+-+"; }
    push @rows, $dent.$v.join($v, @{$u->[1]}).$v;
    if($boxes) { push @rows, $dent."+-+-+-+"; }
    push @rows, $dent.$v.join($v, @{$u->[2]}).$v;
    if($boxes) { push @rows, "+-+-+-+-+-+-+-+-+-+-+-+-+"; }
    push @rows, $v.join($v, @{$l->[0]}).$v.join($v, @{$f->[0]}).$v.join($v, @{$r->[0]}).$v.join($v, @{$b->[0]}).$v;
    if($boxes) { push @rows, "+-+-+-+-+-+-+-+-+-+-+-+-+"; }
    push @rows, $v.join($v, @{$l->[1]}).$v.join($v, @{$f->[1]}).$v.join($v, @{$r->[1]}).$v.join($v, @{$b->[1]}).$v;
    if($boxes) { push @rows, "+-+-+-+-+-+-+-+-+-+-+-+-+"; }
    push @rows, $v.join($v, @{$l->[2]}).$v.join($v, @{$f->[2]}).$v.join($v, @{$r->[2]}).$v.join($v, @{$b->[2]}).$v;
    if($boxes) { push @rows, "+-+-+-+-+-+-+-+-+-+-+-+-+"; }
    push @rows, $dent.$v.join($v, @{$d->[0]}).$v;
    if($boxes) { push @rows, $dent."+-+-+-+"; }
    push @rows, $dent.$v.join($v, @{$d->[1]}).$v;
    if($boxes) { push @rows, $dent."+-+-+-+"; }
    push @rows, $dent.$v.join($v, @{$d->[2]}).$v;
    if($boxes) { push @rows, $dent."+-+-+-+"; }
    return join("\n", @rows);
}

sub facerows {
    local $_ = shift;
    my @c = split //;
    return [[$c[0], $c[1], $c[2]], [$c[7], '*', $c[3]], [$c[6], $c[5], $c[4]]];
}