#!/usr/bin/perl
use Getopt::Std;
getopts('c:');

sub layout_crossword {
 my @puzzle = @_;
 do{foreach $r(@empty_square) { $r=~s/\#/$opt_c/eg }}  if $opt_c;
 do{foreach $r(@full_square)  { $r=~s/\#/$opt_c/eg }}  if $opt_c;
 my ($e, $row, $elem, $num);

#--- Analyze the input to produce intermediate result.
 my @interm = analyze_puzzle(@puzzle);

# $nw = numeric width (how many characters available for numbers?)
 my $nw = $empty_square[1] =~ tr|\.|\.|;
 my @diagram = ();
# Empty square with blanks rather than dots
 my @emptier = @empty_square;
 foreach $e (@emptier) { $e =~ tr|\.| |; }

 foreach $row (@interm) {
    my @temp = ();
    foreach $elem (@$row) {
       if ($elem == -1) {
          append_right(\@temp, \@full_square, '');
       } elsif ($elem == 0) {
          append_right(\@temp, \@emptier, '');
       } else {
          $num = sprintf("%d", $elem);
          die "I owe a cock to Asklepios" if length($num) > $nw;
          append_right(\@temp, \@emptier, $num);
       }
    }

    if (@diagram == 0) {  # Starting a new array
       push @diagram, @temp;
    } else {  # Continuing, so overlap
       push @diagram, splice(@temp, 1);
    }
 }

 return @diagram;
}

#--- Convert the input puzzle to an intermediate form, namely,
#--- a list of lists, one element per square.  Each element will be
#--- -1 (full square), 0 (empty square), or >0 (empty square with
#--- number).

sub analyze_puzzle {
 my @puzzle = @_;
 my ($row, $i, $j);
 my @lol = ();
 my $word = 1;  # My word!

 foreach $row (@puzzle) {
    #--- Distinguish full from empty.
    push @lol, [ map { ($_ eq '.') ? 0 : -1 } (split '', $row) ];
 }

#--- Find the squares that need numbers.  These are any on the
#--- left or top, or any that have a full square immediately
#--- to their left or above them.
 for ($i=0; $i < @lol; $i++) {
    for ($j=0; $j < @{$lol[$i]}; $j++) {
       next if $lol[$i][$j] == -1;
       if ($i==0 || $j==0 ||
           $lol[$i-1][$j] == -1 ||
           $lol[$i][$j-1] == -1 ) {
          $lol[$i][$j] = $word++;
       }
    }
 }

 return @lol;
}

#--- Append one diagram square to the right, overlapping the leftmost
#--- column.  The target array is changed.

sub append_right {
 my ($target_ref, $new_ref, $fnum) = @_;
 my $i;
 my @new = @$new_ref;

 if (length($fnum) > 0) {
    substr($new[1], 1, length($fnum)) = $fnum;
 }
 if (@$target_ref == 0) {  # Starting a new array
    @$target_ref = @new;
 } else {  # Continuing, so overlap
    for ($i=0; $i < @$target_ref; $i++) {
       $target_ref->[$i] .= substr($new[$i], 1);
    }
 }
 return;
}


my @sample_puzzle = qw(
....X.....X....
....X.....X....
....X.....X....
.......X.......
XXX......X.....
.....X......XXX
......X...X....
...X.......X...
....X...X......
XXX......X.....
.....X......XXX
.......X.......
....X.....X....
....X.....X....
....X.....X....
);
my @z = layout_crossword(@sample_puzzle);
print  join("\n", @z), "\n";


