Games::Crossword::Puzzle - six letters for "reusable unit of code"

  $Id: /my/cs/projects/Games-Crossword-Puzzle/trunk/lib/Games/Crossword/Puzzle.pm 31483 2007-04-27T13:49:35.406241Z rjbs  $

  my $puzzle = Games::Crossword::Puzzle->from_file('nyt-sunday.puz');

  for my $row ($puzzle->rows) {
    for my $cell (@$row) {
      die "Nope, not completed properly"
        if $cell->value and (not $cell->guess) || $cell->guess ne $cell->value;
    }
  }

  my $puzzle = Games::Crossword::Puzzle->from_file($filename);

  my $cell = $puzzle->cell($number);

use strict;
use warnings;

package Games::Crossword::Puzzle;

our $VERSION = '0.001';

use Carp ();
use Games::Crossword::Puzzle::Cell;

sub from_file {
  my ($class, $filename) = @_;

  my $self = bless {} => $class;

  open my $fh, $filename or die "couldn't open file: $!";

  seek $fh, 2, 0;
  read $fh, (my $magic), 12;
  die "file is not a valid puzzle" unless $magic eq "ACROSS&DOWN\0";

  {
    seek $fh, 0x2C, 0;
    read $fh, (my $size), 2;
    $self->{width}  = ord substr $size, 0, 1;
    $self->{height} = ord substr $size, 1, 1;
  }

  seek $fh, 0x34, 0;
  read $fh, (my $solution), $self->height * $self->width;
  read $fh, (my $guess), $self->height * $self->width;

  seek $fh, 0x2E, 0;
  read $fh, (my $clues), 2;
  $clues = unpack 'v2', $clues;

  seek $fh, 0x34  +  2 * $self->height * $self->width, 0;
  $self->{title}     = $self->_read_nul_string($fh);
  $self->{author}    = $self->_read_nul_string($fh);
  $self->{copyright} = $self->_read_nul_string($fh);

  my @clues;
  for (1 .. $clues) {
    my $clue = $self->_read_nul_string($fh);
    push @clues, $clue;
  }

  $self->__build_grid(\$solution, \$guess, \@clues);

  return $self;
}

sub height { $_[0]->{height} }
sub width  { $_[0]->{width} }

sub rows {
  my ($self) = @_;
  
  return @{ $self->{grid} };
}

sub cell {
  my ($self, $number) = @_;

  Carp::croak "invalid cell ($number) requested"
    unless exists $self->{number}{$number};

  return $self->{number}{$number};
}

sub title     { $_[0]->{title} }
sub author    { $_[0]->{author} }
sub copyright { $_[0]->{copyright} }

# Iterate through the grid, building the Cell objects.
# Figure out which cells are going to have clues and assign the clues from the
# input stack to cells.
sub __build_grid {
  my ($self, $solution_ref, $guess_ref, $clues) = @_;
  my @grid;
  $#grid = $self->height - 1;

  my %number;

  my $current_number = 1;

  for my $row (0 .. $#grid) {
    my @row;
    $#row = $self->width - 1;

    for my $col (0 .. $#row) {
      my $byte = $row * $self->width  +  $col;
      my %square = (
        value  => $self->_grid_xy_char($solution_ref, $col, $row),
        guess  => $self->_grid_xy_char($guess_ref,    $col, $row),
      );

      delete $square{value} if $square{value} eq '.';
      delete $square{guess} if $square{guess} eq '.' or $square{guess} eq '-';

      my $across = $self->_has_across_clue(\%square, $solution_ref, $col, $row);
      my $down   = $self->_has_down_clue(\%square, $solution_ref, $col, $row);

      $square{number} = $current_number++ if $across or $down;

      if ($square{number}) {
        $number{ $square{number} } = \%square;

        $square{across} = shift @$clues if $across;
        $square{down} = shift @$clues if $down;
      }

      $row[ $col ] = Games::Crossword::Puzzle::Cell->new(\%square);
    }

    $grid[ $row ] = \@row;
  }

  $self->{grid}   = \@grid;
  $self->{number} = \%number;
}

# I'd worry more about the efficiency of doing this if it wasn't always for
# such short strings. -- rjbs, 2007-04-27
sub _read_nul_string {
  my ($self, $fh) = @_;

  my $string;
  while (read $fh, my $char, 1) {
    last if $char eq "\0";
    $string .= $char;
  }

  return $string;
}

sub _grid_xy_char {
  my ($self, $str_ref, $x, $y) = @_;

  return if $x >= $self->width or $y >= $self->height;

  my $index = $y * $self->width  +  $x;
  return substr $$str_ref, $index, 1;
}

sub _has_across_clue {
  my ($self, $square, $sol_ref, $x, $y) = @_;

  return unless defined $square->{value};
  return if $x >= $self->width - 1;
  return if $self->_grid_xy_char($sol_ref, $x+1, $y) eq '.';
  return 1 if $x == 0;
  return if $self->_grid_xy_char($sol_ref, $x-1, $y) ne '.';
  return 1;
}

sub _has_down_clue {
  my ($self, $square, $sol_ref, $x, $y) = @_;

  return unless defined $square->{value};
  return if $y >= $self->height - 1;
  return if $self->_grid_xy_char($sol_ref, $x, $y+1) eq '.';
  return 1 if $y == 0;
  return if $self->_grid_xy_char($sol_ref, $x, $y-1) ne '.';
  return 1;
}

1;