#!/usr/bin/perl

#PIECES:
# R (4 slots)
# W X Y Z (Vertical whites (2 slots))
# V (Horizontal white (2 slots))
# G H I J (Greens 1 slot)
# O O (open) 


# TRANSFORMATIONS
$start=";WRRX;WRRX;OVVO;YGHZ;YIJZ;";
$end=qr";....;....;....;.RR.;.RR.;";
# The transformations come in pairs, a compiled regexp and the resulting state.
@T=(
    # G
    qr/(.*)GO(.*)/,"\$1OG\$2", # Right
    qr/(.*)OG(.*)/,"\$1GO\$2", # Left
    qr/(.*)G(....)O(.*)/,"\$1O\$2G\$3", # Down
    qr/(.*)O(....)G(.*)/,"\$1G\$2O\$3",  # Up
    # H
    qr/(.*)HO(.*)/,"\$1OH\$2", # Right
    qr/(.*)OH(.*)/,"\$1HO\$2", # Left
    qr/(.*)H(....)O(.*)/,"\$1O\$2H\$3", # Down
    qr/(.*)O(....)H(.*)/,"\$1H\$2O\$3",  # Up
    # I
    qr/(.*)IO(.*)/,"\$1OI\$2", # Right
    qr/(.*)OI(.*)/,"\$1IO\$2", # Left
    qr/(.*)I(....)O(.*)/,"\$1O\$2I\$3", # Down
    qr/(.*)O(....)I(.*)/,"\$1I\$2O\$3",  # Up
    # J
    qr/(.*)JO(.*)/,"\$1OJ\$2", # Right
    qr/(.*)OJ(.*)/,"\$1JO\$2", # Left
    qr/(.*)J(....)O(.*)/,"\$1O\$2J\$3", # Down
    qr/(.*)O(....)J(.*)/,"\$1J\$2O\$3",  # Up
    # W
    qr"(.*)(W)O(...)\2O(.*)","\$1O\$2\$3O\$2\$4", # Shift right
    qr"(.*)O(W)(...)O\2(.*)","\$1\$2O\$3\$2O\$4", # Shift left
    qr"(.*)(W)(....)\2(....)O(.*)","\$1O\$3\$2\$4\$2\$5", # Shift down
    qr"(.*)O(....)(W)(....)\3(.*)","\$1\$3\$2\$3\$4O\$5", # Shift up
    # X
    qr"(.*)(X)O(...)\2O(.*)","\$1O\$2\$3O\$2\$4", # Shift right
    qr"(.*)O(X)(...)O\2(.*)","\$1\$2O\$3\$2O\$4", # Shift left
    qr"(.*)(X)(....)\2(....)O(.*)","\$1O\$3\$2\$4\$2\$5", # Shift down
    qr"(.*)O(....)(X)(....)\3(.*)","\$1\$3\$2\$3\$4O\$5", # Shift up
    # Y
    qr"(.*)(Y)O(...)\2O(.*)","\$1O\$2\$3O\$2\$4", # Shift right
    qr"(.*)O(Y)(...)O\2(.*)","\$1\$2O\$3\$2O\$4", # Shift left
    qr"(.*)(Y)(....)\2(....)O(.*)","\$1O\$3\$2\$4\$2\$5", # Shift down
    qr"(.*)O(....)(Y)(....)\3(.*)","\$1\$3\$2\$3\$4O\$5", # Shift up
    # Z
    qr"(.*)(Z)O(...)\2O(.*)","\$1O\$2\$3O\$2\$4", # Shift right
    qr"(.*)O(Z)(...)O\2(.*)","\$1\$2O\$3\$2O\$4", # Shift left
    qr"(.*)(Z)(....)\2(....)O(.*)","\$1O\$3\$2\$4\$2\$5", # Shift down
    qr"(.*)O(....)(Z)(....)\3(.*)","\$1\$3\$2\$3\$4O\$5", # Shift up
    # V
    qr/(.*)VVO(.*)/,"\$1OVV\$2", # Shift right
    qr/(.*)OVV(.*)/,"\$1VVO\$2", # Shift left
    qr/(.*)VV(...)OO(.*)/,"\$1OO\$2VV\$3", # Shift Down
    qr/(.*)OO(...)VV(.*)/,"\$1VV\$2OO\$3", # Shift Up   
    # R
    qr/(.*)RRO(..)RRO(.*)/,"\$1ORR\$2ORR\$3", # Shift right
    qr/(.*)ORR(..)ORR(.*)/,"\$1RRO\$2RRO\$3", # Shift left
    qr/(.*)RR(.*)RR(...)OO(.*)/,"\$1OO\$2RR\$3RR\$4", # Shift Down
    qr/(.*)OO(...)RR(.*)RR(.*)/,"\$1RR\$2RR\$3OO\$4" # Shift Up
  );

sub draw {
  $board=shift;
  $board=~s/O/ /g;
  join("\n", split(/;/, $board)), "\n\n";
}

print draw($start);
my %states;
addnewstate($start);
# The queue consists of pairs-- the current state and the sequence of states
# leading to the current state.
push @queue, $start;
push @queue, $start;
while ($state=shift @queue) {
  # $roll is the sequence leading to the current state.
  $roll=shift @queue;
  for ($i=0; $i<=$#T; $i+=2) {
    my $t=$T[$i];
    my $s=$T[$i+1];
    $newstate=$state;
    if (@subs=$newstate=~$t) {
#      print draw($state);
      $newstate=$s;
# ugly
      $newstate=~s/\$1/$subs[0]/g;
      $newstate=~s/\$2/$subs[1]/g;
      $newstate=~s/\$3/$subs[2]/g;
      $newstate=~s/\$4/$subs[3]/g;
      $newstate=~s/\$5/$subs[4]/g;
#      print "I: $i\n";
#      print draw($newstate);
      if ($newstate=~$end) {
	print "$roll $newstate\n";
	unroll($roll."|".$newstate);
	exit(1);
      }
# check for uniqueness and add to the queue.  This should result in 
# breadth-first search
      if (isunique($newstate)) {
	push @queue, $newstate;
	push @queue, $roll."|$newstate";
	addnewstate($newstate);
      }
    }
  }
  $m=$queue[1];
  $curcount=($m=~tr/|//);
  if ($count!=$curcount) {
    $count=$curcount;
    $width=($#queue+1)/2;
    print "Width: $width Depth: $count\n";
#    die if $count==2;
  }
}

sub unroll {
  $roll=shift;
  for $a (split /\|/, $roll) {
    print draw($a);
  }
}

sub addnewstate {
  my $state=shift;
  $state=~s/[WXYZ]/A/g;
  $state=~s/[GHIJ]/G/g;
  $states{$state}++;
}

sub isunique {
  my $state=shift;
  # The WXYZ pieces are interchangable. (They only have to be distinguished 
  # to determine valid moves)
  $state=~s/[WXYZ]/A/g;
  $state=~s/[GHIJ]/G/g;
  return !$states{$state};
}