my @squares =
  (["3", ["333", "333", "333"]],
   ["2", ["aa", "aa"]],
   ["2", ["bb", "bb"]],
   ["2", ["cc", "cc"]],
   ["1", ["p"]],
   ["1", ["q"]],
   ["1", ["r"]],
   ["x", ["x"]],
  );

my $board = [ (".....") x 5 ];

my $it = make_dfs_search([\@squares, $board, 25], \&children, \&winner);

while (my $sol = $it->()) {
  my $board = $sol->[1];
  print "SOLUTION: \n";
  print join "\n", @$board, "", "";
}

sub make_dfs_search {
  my ($root, $children, $good) = @_;
  my @todo = $root;
  return sub {
    while (@todo) {
      my $node = pop @todo;
      { my $board = $node->[1];
        my $boardstr = join "\n", map "  $_", @$board;
        print "Examining: \n$boardstr\n\n";
      }
      return $node if $good->($node);
      push @todo, reverse $children->($node);
    }
    return;
  };
}

# Nodes contain:
# Pool of available tile classes
# Current board configuration
# Count of unfilled squares

sub winner {
  my $node = shift;
  my ($pool, $board, $count) = @$node;
  $count == 0;
}

sub children {
  my $node = shift;
  my @C;
  my ($pool, $board, $count) = @$node;
  my $next_unfilled = next_unfilled($board);
  for my $i (0 .. $#$pool) {
    my $class = $pool->[$i];
    my ($name, @tiles) = @$class;
    my @newpool = @$pool;
    splice @newpool, $i, 1;
    for my $tile (@tiles) {
      for my $y_off (0 .. $#$tile) {
        for my $x_off (0 .. -1+length($tile->[$y_off])) {
          next if substr($tile->[$y_off], $x_off, 1) =~ /[. ]/;
          my $new_board = put_tile_at($name, $tile, [$x_off, $y_off],
                                      $next_unfilled, $board);
          if ($new_board) {
            push @C, [\@newpool, $new_board, $count - tile_size($tile)];
          }
        }
      }
    }
  }
  return @C;
}

sub next_unfilled {
  my $board = shift;
  for my $row (0.. $#$board) {
    next unless $board->[$row] =~ /[. ]/;
    for my $col (0 .. -1+length($board->[$row])) {
      if (substr($board->[$row], $col, 1) =~ /[. ]/) {
        return [$row, $col];
      }
    }
  }
  return;
}

my %tile_size;
sub tile_size {
  my $tile = shift;
  return $tile_size{$tile} if exists $tile_size{$tile};
  my $count = 0;
  for my $line (@$tile) {
    $count += $line =~ tr/ .//c;
  }
  warn "tile size of '$tile' is $count\n";
  return $tile_size{$tile} = $count;
}

sub put_tile_at {
  my ($tilename, $tile, $tile_offset, $nu, $board) = @_;
  my @newboard = @$board;
  my ($r, $c) = @$nu;
  my ($R, $C) = @$tile_offset;
  return if $c < $C || $r < $R;
  for my $row (0 .. $#$tile) {
    my $line = $tile->[$row];
    return if $r+$row-$R > $#newboard;
    for my $col (0 .. -1 + length($line)) {
      return if $c+$col-$C > length($newboard[$r+$row-$R]);
      next if substr($line, $col, 1) =~ /[. ]/;
      return unless substr($newboard[$r+$row-$R], $c+$col-$C, 1) 
        =~ s/[. ]/$tilename/;
    }
  }
  return \@newboard;
}