File Coverage

lib/Games/Nonogram/Shell.pm

Criterion	Covered	Total	%
statement	9	78	11.5
branch	0	50	0.0
condition	0	21	0.0
subroutine	3	15	20.0
pod	9	9	100.0
total	21	173	12.1

package Games::Nonogram::Shell;

use strict;
use warnings;
use Games::Nonogram::Grid;

my @has_aliases = qw( auto load row col quit exit );

sub bootstrap {
  my $class = shift;
  my $self  = bless {}, $class;

  # set aliases
  my %alias;
  foreach my $cmd ( @has_aliases ) {
    $alias{ substr( $cmd, 0, 1 ) } = $cmd;
  }

  while ( print '> ' ) {
    my $input = ;
    $input = '' unless defined $input;
    chomp $input;

    my ($cmd, $args) = split /\s+/, $input, 2;

    $cmd = '_next' unless defined $cmd;

    $cmd = $alias{$cmd} if exists $alias{$cmd};

    last if $cmd eq 'quit' || $cmd eq 'exit';
    next if $cmd eq 'bootstrap';

    $self->$cmd( $args ) if $self->can( $cmd );
  }
  $self;
}

sub load {
  my ($self, $file) = @_;

  return unless $file && -f $file;

  my $grid = Games::Nonogram::Grid->new_from( file => $file );
     $grid->as_string;
     $grid->clear_stash;

  $self->{grid} = $grid;
}

sub logfile {
  my ($self, $file) = @_;

  my $grid = $self->{grid} or return;

  $grid->set_logfile( $file );
}

sub _next {
  my $self = shift;

  my $grid = $self->{grid} or return;

  if ( $grid->has_answers ) {
    print "\nAnswers\n", join "\n", $grid->answers, "\nOK\n";
  }
  elsif ( $grid->is_done ) {
    $grid->as_string;
    print "\nOK\n";
  }
  else {
    $grid->update;
    $grid->as_string;

    print "\nOK\n" if $grid->is_done;
  }
}

sub auto {
  my $self = shift;

  my $grid = $self->{grid} or return;

  while ( $grid->is_dirty ) {
    $grid->update;
    print $grid->as_string, "\n" if $grid->debug;
  }

  if ( $grid->is_done or $grid->has_answers ) {
    print "\nAnswers\n", join "\n", $grid->answers, "\nOK\n";
  }
  else {
    print $grid->as_string,"\n";
    print "\nAborted\n";
  }
}

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

  return unless $row && $row =~ /^\d+$/;

  my $grid = $self->{grid} or return;

  $grid->row( $row )->dump_blocks;
}

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

  return unless $col && $col =~ /^\d+$/;

  my $grid = $self->{grid} or return;

  $grid->col( $col )->dump_blocks;
}

sub on    { shift->_value(  1, @_ ) }
sub off   { shift->_value(  0, @_ ) }
sub clear { shift->_value( -1, @_ ) }

sub _value {
  my ($self, $value, $args) = @_;

  my ($row, $col) = split /,\s*/, $args;

  return unless $row && $row =~ /^\d+$/;
  return unless $col && $col =~ /^\d+$/;

  my $grid = $self->{grid} or return;

  eval {
    $grid->row( $row )->value( $col => $value );
    $grid->update;
    $grid->as_string;
  };
  if ( $@ ) {
    print "That would break the puzzle.";
  }
}

sub debug {
  my ($self, $value) = @_;

  my $grid = $self->{grid} or return;

  $value = 1 unless defined $value;

  $grid->debug( $value );
}

1;

__END__