use strict;
use warnings;

package Games::Crossword::Puzzle;

=head1 NAME

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

=head1 VERSION

version 0.001

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

=cut

our $VERSION = '0.001';

=head1 SYNOPSIS

  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;
    }
  }

=head1 DESCRIPTION

The F<.PUZ> file format is used by many crossword programs and, more
importantly, is offered by many newspapers.  It servers as both a puzzle and a
"saved game," storing the grid, the answers, the clues, and guesses.

Games::Crossword::Puzzle reads F<.PUZ> files and produces
Games::Crossword::Puzzle objects.

A puzzle is a rectangular grid of L<Games::Crossword::Puzzle::Cell> objects.

=cut

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

=head1 METHODS

=head2 from_file

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

This method reads in a puzzle file and returns a puzzle object.  It will raise
an exception if the file does not appear to be a valid puzzle file.

=cut

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;
}

=head2 height

=head2 width

These method return the height and width of the puzzle grid.

=cut

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

=head2 rows

This method returns a list of arrayrefs, each representing one row of the grid.
Each arrayref is populated with Games::Crossword::Puzzle::Cell objects.

=cut

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

=head2 cell

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

This method returns the cell with the given number.  Not every cell is
numbered!  Only cells that have clues are numbered.

This method will raise an exception if an invalid cell is requested.

=cut

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

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

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

=head2 title

This method returns the puzzle's title.

=head2 author

This method returns the puzzle's author.

=head2 copyright

This method returns the puzzle's copyright information.

=cut

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;
}

=head1 AUTHOR

Ricardo SIGNES, C<< <rjbs at cpan.org> >>

=head1 COPYRIGHT & LICENSE

Copyright 2007 Ricardo SIGNES, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=head1 CAVEATS

While there is some basic checking that the input file really is a puzzle file,
the checksums aren't checked, which could lead to loading an invalid file.  I
may get around to fixing this in the future.

=head1 THANKS

Josh Myer is a nerd and reverse engineered the PUZ format enough for this
module to be written.  I used his notes, found here:
L<http://www.joshisanerd.com/puz/>

=head1 SECRET ORIGINS

Daniel Jalkut, an internet-famous blogger, hyped up a forthcoming product for a
while, finally revealing that it was Black Ink, a nice crossword program for OS
X.  I like crosswords, but I didn't want to spend $25 on it, so I had a look
into the weird "PUZ" format it used.  I wrote this module as phase one in
producing my own free crossword software, possibly a PUZ-to-DHTML sort of
thing.  (Warning: I have been known to quit after phase one.)

=head1 COPYRIGHT & LICENSE

Copyright 2007 Ricardo SIGNES, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

1;