package Games::Nonogram::Grid;
use strict;
use warnings;
use base qw( Games::Nonogram::Base );
use Games::Nonogram::Clue;
sub new {
my ($class, %options) = @_;
my $height = $options{height} || $options{size} or die "illegal height";
my $width = $options{width} || $options{size} or die "illegal width";
my @rows = map {
Games::Nonogram::Clue->new( id => "Row $_", size => $width )
} ( 1 .. $height );
my @cols = map {
Games::Nonogram::Clue->new( id => "Col $_", size => $height )
} ( 1 .. $width );
my $self = bless {
height => $height,
width => $width,
rows => \@rows,
cols => \@cols,
has_answers => 0,
is_dirty => 1,
}, $class;
}
sub new_from {
my ($class, $loader, @args) = @_;
$loader = ucfirst $loader;
my $pkg = "Games::Nonogram::Loader::$loader";
eval qq{ require $pkg };
die $@ if $@;
my ($height, $width, @lines) = $pkg->load( @args );
my $self = $class->new( height => $height, width => $width );
$self->load( @lines );
$self;
}
sub load {
my ($self, @lines) = @_;
my @clues = $self->clues;
foreach my $line ( @lines ) {
chomp $line;
next unless $line =~ /^[\d,]+$/;
my $clue = shift @clues;
die "clues mismatch" unless ref $clue;
$clue->set( split ',', $line );
}
die "clues mismatch" if @clues;
$self->clear_stash;
$self->is_dirty( 1 );
$self->{has_answers} = 0;
}
sub rows { @{ shift->{rows} } }
sub cols { @{ shift->{cols} } }
sub clues { my $self = shift; return ( $self->rows, $self->cols ) }
sub row { my ($self, $id) = @_; $self->{rows}->[$id - 1]; }
sub col { my ($self, $id) = @_; $self->{cols}->[$id - 1]; }
sub is_dirty {
my $self = shift;
@_ ? $self->{is_dirty} = shift : $self->{is_dirty};
}
sub as_string {
my $self = shift;
my $str = '';
foreach my $row ( $self->rows ) {
$str .= sprintf "%s\n", $row->as_string;
}
if ( $self->debug ) {
$str .= "\n";
foreach my $col ( $self->cols ) {
$str .= sprintf "%s\n", $col->as_string;
}
}
defined wantarray ? return $str : print $str;
}
sub update {
my ($self, $mode) = @_;
$self->log( 'updating' );
$self->is_dirty( 0 );
foreach my $row ( 1 .. $self->{height} ) {
my $clue = $self->row( $row );
next if $clue->is_done && !$clue->line->is_dirty;
$self->_update( $clue, $mode );
foreach my $col ( $clue->line->dirty_items ) {
$self->is_dirty( 1 );
$self->_update_dirty_item(
$self->col( $col ),
$row,
$clue->line->value( $col )
);
}
}
foreach my $col ( 1 .. $self->{width} ) {
my $clue = $self->col( $col );
next if $clue->is_done && !$clue->line->is_dirty;
$self->_update( $clue, $mode );
foreach my $row ( $clue->line->dirty_items ) {
$self->is_dirty( 1 );
$self->_update_dirty_item(
$self->row( $row ),
$col,
$clue->line->value( $row )
);
}
}
return if $self->is_dirty;
return if $self->is_done;
unless ( $mode ) {
$self->update( 'more' );
}
elsif ( $mode eq 'more' ) {
require Games::Nonogram::BruteForce;
Games::Nonogram::BruteForce->run( $self );
if ( $self->answers ) {
$self->{has_answers} = 1;
}
}
}
sub has_answers { shift->{has_answers} }
sub answers {
my $self = shift;
my %seen;
my @answers = grep { defined && !$seen{$_}++ }
@{ $self->stash->{answers} || [] };
}
sub is_done {
my $self = shift;
foreach my $clue ( $self->clues ) {
return unless $clue->is_done;
}
unless ( $self->{has_answers} ) {
$self->{has_answers} = 1;
push @{ $self->stash->{answers} ||= [] }, $self->as_string;
}
return 1;
}
sub _update {
my ($self, $clue, $mode) = @_;
my ($before, $after);
if ( $self->debug ) {
$before = $clue->dump_blocks;
$self->log( $before );
}
$clue->update( $mode );
if ( $self->debug ) {
$after = $clue->dump_blocks;
$self->log( "TO: \n$after" ) if $before ne $after;
}
}
sub _update_dirty_item {
my ($self, $clue, $id, $value) = @_;
return unless $clue->value( $id ) != $value;
$self->log( $clue->dump_blocks ) if $self->debug;
$clue->value( $id, $value );
$self->log( "TO:\n", $clue->dump_blocks ) if $self->debug;
}
1;
__END__
=head1 NAME
Games::Nonogram::Grid
=head1 SYNOPSIS
use Games::Nonogram::Grid;
my $grid = Games::Nonogram::Grid->new( height => 10, width => 10 );
or
my $grid = Games::Nonogram::Grid->new_from( file => 'puzzle.dat' );
=head1 DESCRIPTION
This is used internally to provide the puzzle grid.
=head1 METHODS
=head2 new
creates an object. You should provide height and width of the puzzle as shown above.
=head2 new_from
also creates an object but through a loader (in this case, ::Loader::File).
=head2 load
parses data from the loader and prepares clues.
=head2 as_string
returns (or dumps) the stringified form of the grid.
=head2 update
looks through the grid and takes a step forward to solve.
=head2 answers
returns all the answer(s) found.
=head1 ACCESSORS
=head2 rows
returns all the row clues for the grid.
=head2 cols
returns all the column clues for the grid.
=head2 clues
returns all the clues for the grid.
=head2 row
returns clues in the given row.
=head2 col
returns clues in the given column.
=head2 is_dirty
is a flag which should be true after something is changed.
=head2 has_answers
returns true if the grid has answer(s).
=head2 is_done
returns true if all the blocks are settled.
=head1 AUTHOR
Kenichi Ishigaki, E<lt>ishigaki at cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright 2007 by Kenichi Ishigaki
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut