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

  1 #!perl -w
  2 use strict;
  3 use tmstub;
  4 =for docs
  5 
  6 This is in perl for brevity but could be any language - it's just a vehicle 
  7 for the programming concepts.
  8 
  9 https://www.speedsolving.com/wiki/index.php/Speffz
 10 
 11 TODO: -
 12 apply given scramble
 13 unit tests
 14 generic abstract canvas style GUI
 15 port it to various other languages
 16 Transforms for each face turn move
 17 Words for letter pairs!
 18 
 19 =cut
 20 t "Yo, let's speffz it up...";
 21 
 22 my $scr = shift || "R U R' U'";
 23 my $debug = 1;
 24 my $cs = fresh_cube();
 25 #~ print $cs;
 26 #~ print "\n";
 27 my $p = draw($cs, 1);
 28 t $p;
 29 $p = draw($cs, 0);
 30 t $p;
 31 
 32 ## Unscrambled 3x3 cube state in speffz format - clockwise lettering of stickers
 33 sub fresh_cube {
 34     my $s = "";
 35     foreach('A'..'X') { $s .= $_ . lc($_); }
 36     return $s;	
 37 }
 38 
 39 ## Split speffz cube state into 6 faces
 40 sub faces {
 41     local $_ = shift;
 42     die unless /^(.{8})(.{8})(.{8})(.{8})(.{8})(.{8})$/;
 43     return ($1, $2, $3, $4, $5, $6); 
 44 }
 45 
 46 ## Draw the given cube state as a human-friendly net
 47 # here we can support different face orders
 48 # ULFRBD is the speffz standard though
 49 #
 50 #     +-+
 51 #     |U|
 52 #   +-+-+-+-+
 53 #   |L|F|R|B|
 54 #   +-+-+-+-+
 55 #     |D|
 56 #     +-+
 57 # 
 58 #       AaB
 59 #       d*b
 60 #       DcC
 61 #    EeFIiJMmNQqR
 62 #    h*fl*jp*nt*r
 63 #    HgGLkKPoOTsS
 64 #       UuV
 65 #       x*v
 66 #       XwW
 67 #   
 68 #           +-+-+-+
 69 #           |A|a|B|
 70 #           +-+-+-+
 71 #           |d|*|b|
 72 #           +-+-+-+
 73 #           |D|c|C|
 74 #     +-+-+-+-+-+-+-+-+-+-+-+-+
 75 #     |E|e|F|I|i|J|M|m|N|Q|q|R|
 76 #     +-+-+-+-+-+-+-+-+-+-+-+-+
 77 #     |h|*|f|l|*|j|p|*|n|t|*|r|
 78 #     +-+-+-+-+-+-+-+-+-+-+-+-+
 79 #     |H|g|G|L|k|K|P|o|O|T|s|S|
 80 #     +-+-+-+-+-+-+-+-+-+-+-+-+
 81 #           |U|u|V|
 82 #           +-+-+-+
 83 #           |x|*|v|
 84 #           +-+-+-+
 85 #           |X|w|W|
 86 #           +-+-+-+
 87 #     
 88 sub draw {
 89     my $s = shift;
 90     my $boxes = shift;
 91     my @a = faces($s);
 92     #~ print Dumper(\@a);
 93     #~ print "\n";
 94     my @rd = map{ facerows($_) }@a;
 95     #~ print Dumper(\@rd);
 96     #~ print "\n";
 97     my @rows;
 98     # here we can set up the drawing style to use - raw or boxes
 99     my $dent = $boxes ? ' 'x6 : ' 'x3;
100     my $v = $boxes ? "|" : "";
101     # U
102     my ($u, $l, $f, $r, $b, $d) = @rd;
103     if($boxes) { push @rows, $dent."+-+-+-+"; }
104     push @rows, $dent.$v.join($v, @{$u->[0]}).$v;
105     if($boxes) { push @rows, $dent."+-+-+-+"; }
106     push @rows, $dent.$v.join($v, @{$u->[1]}).$v;
107     if($boxes) { push @rows, $dent."+-+-+-+"; }
108     push @rows, $dent.$v.join($v, @{$u->[2]}).$v;
109     if($boxes) { push @rows, "+-+-+-+-+-+-+-+-+-+-+-+-+"; }
110     push @rows, $v.join($v, @{$l->[0]}).$v.join($v, @{$f->[0]}).$v.join($v, @{$r->[0]}).$v.join($v, @{$b->[0]}).$v;
111     if($boxes) { push @rows, "+-+-+-+-+-+-+-+-+-+-+-+-+"; }
112     push @rows, $v.join($v, @{$l->[1]}).$v.join($v, @{$f->[1]}).$v.join($v, @{$r->[1]}).$v.join($v, @{$b->[1]}).$v;
113     if($boxes) { push @rows, "+-+-+-+-+-+-+-+-+-+-+-+-+"; }
114     push @rows, $v.join($v, @{$l->[2]}).$v.join($v, @{$f->[2]}).$v.join($v, @{$r->[2]}).$v.join($v, @{$b->[2]}).$v;
115     if($boxes) { push @rows, "+-+-+-+-+-+-+-+-+-+-+-+-+"; }
116     push @rows, $dent.$v.join($v, @{$d->[0]}).$v;
117     if($boxes) { push @rows, $dent."+-+-+-+"; }
118     push @rows, $dent.$v.join($v, @{$d->[1]}).$v;
119     if($boxes) { push @rows, $dent."+-+-+-+"; }
120     push @rows, $dent.$v.join($v, @{$d->[2]}).$v;
121     if($boxes) { push @rows, $dent."+-+-+-+"; }
122     return join("\n", @rows);
123 }
124 
125 ## Convert a face into 3 rows of 3 stickers - top to bottom, left to right
126 sub facerows {
127     local $_ = shift;
128     my @c = split //;
129     return [[$c[0], $c[1], $c[2]], [$c[7], '*', $c[3]], [$c[6], $c[5], $c[4]]];
130 }