#!/usr/bin/perl -w
use strict;
use List::Util qw(max minstr);
use Getopt::Std;

# Global hash for Getopt::Std to put option flags in
my %options;

# According to the Getopt::Std documentation, this should be set
$Getopt::Std::STANDARD_HELP_VERSION = 1;

sub HELP_MESSAGE {
    my $OUT = shift;
    
    print $OUT <<"END_USAGE";
Usage: $0 [-n <number of blocks>] [-a] [-m] [-r]

Use `-n` to set the number of blocks in each of the pieces.
The default is 4 blocks.

Use `-a` to print all pieces of sizes 2 up to the number of
blocks. The default is to only print for the given size.

Use `-m` to only report how many pieces there are, and not
show the actual pieces.

Use `-r` to treat mirror-image pieces as distinct.
END_USAGE
}

sub VERSION_MESSAGE {
    my $OUT = shift;
    
    print $OUT "ntris version 1.0 (2005-10-28)\n";
}

# Given a piece, returnss the height and width of the piece as an array
sub dimensions {
    my $piece = shift;

    my @rows = split "\n", $piece;
    my $height = @rows;
    my $width = length $rows[0];

    return ($height, $width);
}

# Given a piece, returns the same piece but with space on all four sides
sub expand {
    my $piece = shift;

    my @rows = split "\n", $piece;
    my $width = length $rows[0];

    my @expanded_rows;
    push @expanded_rows, '.' x ($width + 2);
    for my $row (@rows) {
        push @expanded_rows, '.' . $row . '.';
    }
    push @expanded_rows, '.' x ($width + 2);

    return join "\n", @expanded_rows;
}

# Returns a boolean representing whether a given piece has a block on a
# given row and column
sub is_filled {
    my ($piece, $row, $col) = @_;

    my @rows = split "\n", $piece;
    my $char = substr($rows[$row], $col, 1);

    return $char eq '#';
}

# Returns a truth value representing whether a given piece has a naighbor
# (in any of the four directions) which contains a block
sub is_good_neighbour {
    my ($piece, $row, $col) = @_;

    return 1 if $row > 0 && is_filled($piece, $row-1, $col  );
    return 1 if $col > 0 && is_filled($piece, $row,   $col-1);

    my ($height, $width) = dimensions($piece);

    return 1 if $row < $height-1 && is_filled($piece, $row+1, $col  );
    return 1 if $col < $width-1  && is_filled($piece, $row,   $col+1);

    return '';
}

# Given a piece, returns the same piece but with a block at a given row
# and column
sub add_block {
    my ($piece, $row, $col) = @_;

    my @rows = split "\n", $piece;
    substr($rows[$row], $col, 1, '#');

    return join "\n", @rows;
}

# Given a piece, returns an array of all the possible pieces which can be
# generated by adding a block next to an already present block
sub extensions {
    my $piece = shift;

    my $expanded_piece = expand($piece);
    my @extensions;

    my ($height, $width) = dimensions($expanded_piece);
    for my $row (0..$height-1) {
        for my $col (0..$width-1) {
            if ( !is_filled($expanded_piece, $row, $col)
              && is_good_neighbour($expanded_piece, $row, $col)) {
                my $piece_w_new_block = add_block($expanded_piece, $row, $col);
                push @extensions, $piece_w_new_block;
            }
        }
    }

    return @extensions;
}

# Given a piece, returns the horizontal mirror image of that piece
sub flip_h { join "\n", map { scalar reverse } split "\n", shift }
# Given a piece, returns the vertical mirror image of that piece
sub flip_v { join "\n", reverse split "\n", shift                }
# Given a piece, returns the same piece rotated 90 degrees counterclockwise
sub rot_90 {
    my $piece = shift;

    my @rows = split "\n", $piece;
    my @new_rows;
    my $width = length $rows[0];

    for my $col (0..$width-1) {
        push @new_rows, join '', map { substr($_, $col, 1) } @rows;
    }
    
    return join "\n", reverse @new_rows;
}

# Given a piece, returns the same piece, but with possible extraneous space
# around it removed
sub clip {
    my $piece = shift;

    my @rows = split "\n", $piece;
    if ($rows[0] =~ /^ \.+ $/x) {
        shift @rows;
    }
    if ($rows[-1] =~ /^ \.+ $/x) {
        pop @rows;
    }
    my $tilted_piece = rot_90(join "\n", @rows);

    my @columns = split "\n", $tilted_piece;
    if ($columns[0] =~ /^ \.+ $/x) {
        shift @columns;
    }
    if ($columns[-1] =~ /^ \.+ $/x) {
        pop @columns;
    }
    my $new_piece = rot_90( rot_90( rot_90( join "\n", @columns )));

    return $new_piece;
}

# Given a piece, returns a representative piece which is guaranteed to also
# be a representative for all "equivalent" pieces
#
# For the purposes of this subroutine, two pieces are "equivalent" if one can
# be generated from the other by 90-degree rotations, or (if the -r flag is
# not used) by flipping either horizontally or vertically
sub canonize {
    my $piece = shift;

    my @symmetries = $piece;
    if (defined $options{r}) {
        push @symmetries, map { rot_90 $_ } @symmetries;
        push @symmetries, map { flip_v(flip_h($_)) } @symmetries;
    }
    else {
        push @symmetries, map { rot_90 $_ } @symmetries;
        push @symmetries, map { flip_h $_ } @symmetries;
        push @symmetries, map { flip_v $_ } @symmetries;
    }

    my $first = minstr(@symmetries);
    return $first;
}

# Utility subroutine used by &print_pieces. Prints a group of pieces next
# to each other, starting on the same line. Provided arguments determine
# where (in the array) to begin printing, the horizontal distance between
# (the left edges of) the pieces, the number of pieces on one row, and the
# array of pieces, respectively
sub print_row_of_pieces {
    my ($offset, $distance, $columns, @pieces) = @_;

    my $piecerow = 0;
    
    PIECE_ROW:
    while (1) {
        my $exists_more = '';
        PIECE:
        for my $column (0..$columns - 1) {
            last PIECE if $offset+$column >= @pieces;
            my @rows = split "\n", $pieces[$offset+$column];
            if ($piecerow < @rows - 1) {
                $exists_more = 1;
            }
            if ($piecerow < @rows) {
                print $rows[$piecerow];
                print ' ' x ($distance - length $rows[$piecerow]);
            }
            else {
                print ' ' x $distance;
            }
        }
        print "\n";
        $piecerow++;
        last PIECE_ROW if !$exists_more;
    }
}

# Prints the generated pieces in an array layout. Alternatively (if the -m
# flag is set), only prints the number of pieces generated
sub print_pieces {
    my ($size, @pieces) = @_;

    if (exists $options{m}) {
        print "Number of pieces of size $size: ", scalar @pieces, "\n";
    }
    else {
        print "Pieces of size $size:\n\n";

        my $maxwidth = 0;
        for my $piece (@pieces) {
            my (undef, $current_width) = dimensions($piece);
            $maxwidth = max($maxwidth, $current_width);
        }

        my $distance = $maxwidth + 3;
        my $columns = int( 78 / $distance );

        MAJOR_ROW:
        for my $offset (0..@pieces-1) {
            next MAJOR_ROW if ($offset % $columns != 0);

            print_row_of_pieces($offset, $distance, $columns, @pieces);
            print "\n";
        }
    }
}

getopts('amrn:', \%options);

# (Final) number of blocks in the pieces generated
my $blocks = $options{n} || 4;
# Initial value: a one-block piece
my @new_pieces = ("#\n");

for my $size (2..$blocks) {
    my @old_pieces = @new_pieces;
    my %new_pieces;
    
    for my $piece (@old_pieces) {
        # Add blocks in every place possible
        my @extensions = extensions($piece);
        # Calculate the clipped and canonized versions
        my @canonized = map { canonize $_ }
                        map { clip $_ }
                        @extensions;
        # Add to hash, eliminating duplicates
        $new_pieces{$_}++ for @canonized;
    }

    @new_pieces = sort keys %new_pieces;
    
    if (exists $options{a}) {
        print_pieces($size, @new_pieces);
    }
}
if (!exists $options{a}) {
    print_pieces($blocks, @new_pieces);
}
