#!/usr/bin/perl

use strict;
use warnings 'all';

use Getopt::Long;

Getopt::Long::Configure ("bundling");
GetOptions ('p|print'    =>  \my $print,
            'P|Print'    =>  \my $Print,
            'n|number=i' => \(my $nr_of_queens = 8)
);
 
my @rows =               1 .. $nr_of_queens;
my @cols = ('a' .. 'z') [0 .. $nr_of_queens - 1];
    
sub a2i {ord ($_ [0]) - ord ('a') + 1}
sub i2a {chr ($_ [0] + ord ('a') - 1)}

# Given a square, return all non-attacked squares on columns to
# the *left* of the given square. (a1 is the lower left corner).
sub free {
    my ($C, $R) = $_ [0] =~ /(\D)(\d+)/;
    $C = a2i $C;
    map {join "" => i2a ($_ -> [0]), $_ -> [1]}
        grep {$_ -> [0] != $C &&
              $_ -> [1] != $R &&
              abs ($_ -> [0] - $C) != abs ($_ -> [1] - $R)}
        map {my $c = a2i $_; map {[$c, $_]} @rows} @cols [0 .. $C - 1]
}
 
my ($str, $re) = ("", "");
 
foreach my $c (@cols) {
    $str .= ";," . (join "," => map {"$c$_"} @rows) . ",\n";
    $re  .= ";.*,(\\w+),.*\n";

    next if $c eq 'a';

    map {$str .= "$_:," . join (",," => free ($_)) . ",\n"} map {"$c$_
+"} @rows;

    my $C = a2i $c;
            
    $re .= "[^;]*\\$C:" . join ("" => map {".*,\\$_,"} 1 .. $C - 1) . 
+"[^;]*\n";
}

if ($print || $Print) {
    print "'$str' =~ \n/^$re/\n";
    exit if $Print;
}

if (my @a = $str =~ /^$re/) {
    print "[@a]\n";
}
    
__END__
[download]

Abigail