#!/usr/bin/perl -w

# Copyright Martijn van Oosterhout <kleptog@svana.org> 2002
# All rights reserved.
# More information can be found here:
# http://svana.org/kleptog/puzzles/pentomino.html

use strict;

$|=1;

#                @           @
#  L  @@@@    Z  @@@     X  @@@
#        @         @         @
#
#       @         @           @
#  T  @@@     F  @@@     Y  @@@@
#       @          @
#
#     @ @        @@         @
#  U  @@@     P  @@      W  @@
#                @           @@
#
#                @
#  N  @@@     V  @       I  @@@@@
#       @@       @@@

# Describes the basic peices
# We start at a point, and use the L,R,U,D letters to move around.
# Each place touched is part of the piece.
my %Pieces = (

  L  => "RRRD",
  Z  => "DRRD",
  X  => "RUDDUR",
  T  => "RRUDD",
  F  => "RUDRD",
  Y  => "RRUDR",

  U  => "DRRU",
  P  => "RDLD",
  W  => "DRDR",
  N  => "RRDR",
  V  => "DDRR",
  I  => "RRRR",
);

my $BoardX = 12;  # 6x10 board with border
my $BoardY =  8;

# Step 1: Parse strings into list of coordinates. Make all possible
# orientations and reflections of these pieces, convert to numbers and
# remove duplicates and order them

my @PieceList = ParsePieces( %Pieces );

# Step 2: Make Board
my @Board = (' ') x ($BoardX * $BoardY);
for my $i (0..$BoardX-1)
{
  $Board[$i] = '#';                       # Top border
  $Board[$i + ($BoardY-1)*$BoardX] = '#'; # Bottom border
}
for my $i (0..$BoardY-1)
{
  $Board[$i*$BoardX] = '#';               # Left border
  $Board[$i*$BoardX + $BoardX-1] = '#';   # Right border
}

# Step 3: Find solutions
my @UsedPieces = (0) x 12;                # Everything initially unused
PlacePiece( 0, $BoardX+1 );

# All Done
exit 0;

sub ParsePieces
{
  my %pieces = @_;

  my $num = 0;

  my @result;
  my %tempresult;   # Hold results while removing duplicates

  # The moves available
  my %moves = ( L => [-1,0], R => [1,0], U => [0,-1], D => [0,1] );
  # The translations, which four rotations (0, 90, 180 and 270 degrees) and the flips
  my @translations = ( [ 1, 0, 0, 1], [ 0,-1, 1, 0], [-1, 0, 0,-1], [ 0, 1,-1, 0],
                       [ 0, 1, 1, 0], [-1, 0, 0, 1], [ 0,-1,-1, 0], [ 1, 0, 0,-1] );

  foreach my $letter ( keys %pieces )
  {
    $num++;                         # Count this piece

    my $str = $pieces{$letter};

    my @blocks;

    my $pos = [0,0];

    push @blocks, [ @$pos ];     # Take a copy of the position and store it

    # Use the string to build the list of blocks
    foreach my $dir ( split //, $str )
    {
      my $step = $moves{$dir};

      $pos->[0] += $step->[0];
      $pos->[1] += $step->[1];

      push @blocks, [ @$pos ];
    }

    # Apply each of the translations
    foreach my $xlate (@translations)
    {
      my %offsets;

      # Apply the translation to each block, convert to single number and
      # store in hash. The hash is for removing duplicates.
      foreach my $pos (@blocks)
      {
        my $x = $pos->[0] * $xlate->[0] + $pos->[1] * $xlate->[2];
        my $y = $pos->[0] * $xlate->[1] + $pos->[1] * $xlate->[3];

        my $off = $y * $BoardX + $x;

        $offsets{$off} = 1;
      } 

      # Sort the numbers
      my @list = sort { $a <=> $b } keys %offsets;

      # Get the smallest
      my $offset = $list[0];

      # Change the numbers so that they start at zero
      foreach (0..$#list)
      {
        $list[$_] -= $offset;
      }

#      print "$letter => ", join(", ", @list), "\n";

      my $tempstr = join(",", map { sprintf "%02d", $_ } @list );
      $tempresult{$tempstr} = [ $letter, $num ];
    }
  }

  # Map tempresult into the format we want to return
  @result = map { [ $tempresult{$_}->[1], 
                    [ map {$_+0} split /,/, $_ ],
                    $tempresult{$_}->[0] ] } sort keys %tempresult;

  print map { "[ $_->[0], [ ".join(",",@{$_->[1]})." ], $_->[2] ]\n" } @result;

  return @result;
}

# Recursive function that does the actual searching. This is the guts and
# where most of the time is spent. Writing this as C speeds the process up
# immensly.

sub PlacePiece($$)
{
  my ($PieceCount,$position) = @_;

  if( $PieceCount == 12 )  # We've placed them all! We have a solution
  {
    print "Solution: ", join(", ", map { $_->[0]."\@".$_->[1] } @UsedPieces[1..12]), "\n";
    DumpBoard();  
    print "\n";
    return;
  }

  $position++ while $position < $BoardX*$BoardY and $Board[ $position ] ne ' ';  # Find free spot

  if( $position == $BoardX*$BoardY )
  {
    print "ERROR:\n";
    DumpBoard();
    return;
  }

  PIECE: foreach my $piece (@PieceList)
  {
    next if $UsedPieces[ $piece->[0] ];     # Already used this piece?

    # Test if piece fits
    foreach my $offset ( @{ $piece->[1] } )
    {
      next PIECE if $Board[ $position + $offset ] ne ' ';  # Place used
    }

    # Place piece
    foreach my $offset ( @{ $piece->[1] } )
    {
      $Board[ $position + $offset ] = $piece->[2];
    }
    $UsedPieces[ $piece->[0] ] = [ $piece->[2], $position ];    # Mark used and remember position

#    DumpBoard();
    # Try other pieces
    PlacePiece( $PieceCount+1, $position+1 );

    # Remove piece again
    foreach my $offset ( @{ $piece->[1] } )
    {
      $Board[ $position + $offset ] = ' ';
    }
    $UsedPieces[ $piece->[0] ] = 0;
  }
}

# Displays the board
sub DumpBoard
{
  foreach my $i (0..$BoardY-1)
  {
    print @Board[ $i*$BoardX .. $i*$BoardX + $BoardX-1 ],"\n";
  }
}