Crossword Puzzle

#!/usr/bin/perl use strict; my $psmode; if ($ARGV[0] eq '-P') { $psmode=1; shift; } # locate the .puz file die "USAGE: $0 > \n - or -\n$0 -P > " unless $ARGV[0]; my $file = $ARGV[0]; # make sure we can read the .puz file die "file $file does not exist\n" unless -e $file; die "file $file is not readable. Are you sure it's a .puz file?\n" unless -f _ and -r _; # read in the .puz file my $data; open (my $fh, $file); { local $/; $data = <$fh>; } close $fh; # get the size of the grid my ($w, $h) = unpack("CC", substr($data, 0x2C, 2)); # fill in data structures from the file # First, the answers (which may be scrambled). my $answerstring = substr($data, 0x34, $w*$h); my @answergrid; # 2d array for my $i (0..$h-1){ # $i = the number of this row $answergrid[$i] = [split(//, substr($answerstring, $i*$w, $w))]; } # Then, the black/white grid pattern. my $bwstring = substr($data, 0x34+$w*$h, $w*$h); my @bwgrid; # 2d array to store black vs white squares for my $i (0..$h-1){ # $i = the number of this row $bwgrid[$i] = [split(//, substr($bwstring, $i*$w, $w))]; } # Finally, the list of clues not yet numbered. my $cluestring = substr($data, 0x34+$w*$h+$w*$h); # the list of clues contains a few lines of footer material, to be # dealt with later. my @newclues = split(/\0/, $cluestring); # it also contains a few lines at the beginning. The last # uninteresting line starts with a copyright symbol. my @header_lines; for my $clue (@newclues){ push(@header_lines, shift(@newclues)); last if index($header_lines[-1], chr(0xA9)) == 0; } # Alright! Let's go! my @numgrid; # 2d array to store clue number positions # we are going to make sure we are copying the data! for my $i (0..$#bwgrid){ for my $j (0..$#{$bwgrid[$i]}){ $numgrid[$i]->[$j] = $bwgrid[$i]->[$j]; } } my @across; # list of across clues with numbers my @down; # list of down clues with numbers # The most pressing issue now is to figure out the numbers and assign # them to the grid and the clues. # Black squares will be filled with -1's. We'll have an extra row on # the top, and column on the left, filled with -1's. unshift (@bwgrid, [(-1) x $w]); unshift (@$_, -1) for @bwgrid; unshift (@numgrid, [(-1) x $w]); unshift (@$_, -1) for @numgrid; my $c; for my $i (1..$h) { for my $j (1..$w) { # this square is $bwgrid[$i]->[$j] # add any needed -1's for future iterations if ($bwgrid[$i]->[$j] eq '.'){ $bwgrid[$i]->[$j] = -1 ; $numgrid[$i]->[$j] = -1; } next if $bwgrid[$i]->[$j] == -1; # if a square has a -1 to its left or top, it's a clue. Let's # allocate a number for it. if ($bwgrid[$i]->[$j-1] == -1 or $bwgrid[$i-1]->[$j] == -1){ $c++; $numgrid[$i]->[$j] = $c; } # across clue (-1 to its left) if ($bwgrid[$i]->[$j-1] == -1){ push(@across, "$c. ".shift(@newclues)) } # down clue (-1 above it) if ($bwgrid[$i-1]->[$j] == -1){ push(@down, "$c. ".shift(@newclues)) } } } if ($psmode) { psify_puzzle(\@numgrid, \@across, \@down, \@header_lines, \@newclues); } else { my $header = join "
", @header_lines; my $footer = join "\n", @newclues; htmlify_puzzle(\@numgrid, \@across, \@down, $header, $footer); } # subs sub debug_grid { my $twod_array = shift; for my $i (0..$#$twod_array){ print STDERR ">"; for my $j (0..$#{$twod_array}){ print STDERR "$twod_array->[$i][$j] "; } print STDERR "\n"; } print STDERR "------------------------\n"; } sub htmlify_puzzle { my ($numgrid, $across, $down, $header, $footer) = @_; my $html = < Crossword Puzzle EIEIO # add header elements $html .= "$header
"; # here goes the grid! $html .= ''; for my $i (1..$h){ $html .= ''; for my $j (1..$w){ if ($numgrid->[$i][$j] == -1){ # black square $html .= '' } elsif ($numgrid->[$i][$j] > 0){ # white square with number $html .= qq{}; } else { # white square without number $html .= ''; } } $html .= "\n"; } $html .= '

$numgrid->[$i][$j]

'; # clues $html .= '

Across

'.join("
\n", @$across); $html .= '

Down

'.join("
\n", @$down); # add footer elements $html .= "

$footer"; # now finish $html .= ''; print $html; } sub psify_puzzle { my ($numgrid, $across, $down, $header, $footer) = @_; my $page_height = 11.0; my $page_width = 8.5; print <[$i][$j] == -1) { # black square printf " %d %d fill-cell\n", $i-1, $j-1; } elsif ($numgrid->[$i][$j] > 0) { # white square with number printf " (%d) %d %d number-cell\n", $numgrid->[$i][$j], $i-1, $j-1; } else { # white square without number, ignore } } } print <