#!/usr/local/bin/perl

use strict;
use warnings;

use Config;
use FileHandle;
use Games::Sudoku::General;
use Pod::Usage;
use Term::ReadLine;
use Text::ParseWords;
use UNIVERSAL qw{can};

our $VERSION = '0.005';

my $rdln = Term::ReadLine->new ('Solve Sudoku and other set-allocation puzzles');
my $OUT = $rdln->OUT || \*STDOUT;

print $OUT <<eod;
sudokug version $VERSION
based on Games::Sudoku::General version @{[Games::Sudoku::General->VERSION]}
Perl $Config{version} under $Config{osname} $Config{osvers}

Solve Sudoku and other set-allocation puzzles.

Copyright 2005 Thomas R. Wyant, III. All rights reserved.

Enter 'help' for help, and terms of use.

eod

my $su = Games::Sudoku::General->new ();
my @handles;
my %synonym = (
    '.' => 'source',
    show => 'get',
    );

while (1) {
    defined ($_ = _acquire_line ()) or do {
	last unless @handles;
	shift @handles;
	redo;
	};

    s/^\s+//;
    s/\s+$//;
    next unless $_;
    next if m/^#/;
    my @args = parse_line ('\s+', 0, $_);
    my $verb = lc shift @args;
    $verb = $synonym{$verb} if $synonym{$verb};
    @args = map {m/^<<(.+)/ ? _here_document ($1) : $_} @args;
    last if $verb eq 'exit';
    eval {
	if ($verb =~ m/\W/ || $verb =~ m/^_/ || $verb eq 'new') {
	    die <<eod;
Warning - Verb '$verb' is not recognized. Enter 'help' for help.
eod
	    }
	  elsif (can (__PACKAGE__, $verb)) {
	    no strict qw{refs};
	    &$verb (@args);
	    use strict qw{refs};
	    }
	  elsif (can ($su, $verb)) {
	    my $rslt = $su->$verb (@args);
	    print "$rslt\n" if defined $rslt && !ref $rslt;
	    }
	  else {
	    die <<eod;
Warning - Verb '$verb' is not recognized. Enter 'help' for help.
eod
	    }
	};
    $@ and warn $@;
    }

sub dump {
use Data::Dumper;
local $Data::Dumper::Terse = 1;
print "Dump of the current Games::Sudoku::General object:\n", Dumper ($su);
}

sub get {
my @rslt = $su->get (@_);
for (my $inx = 0; $inx < @_; $inx++) {
    print $rslt[$inx] =~ m/\n/s ?
	"$_[$inx]:\n$rslt[$inx]\n" :
	"$_[$inx]: $rslt[$inx]\n\n";
    }
}

sub help {
my $os_specific = "_help_$^O";
__PACKAGE__->can ($os_specific) ? __PACKAGE__->$os_specific :
pod2usage (-verbose => 2, -exitval => 'NOEXIT',
    $_[0] && $_[0] eq 'lib' ? (-input => $INC{'Games/Sudoku/General.pm'}) : ());
}

sub _help_MacOS {
print <<eod;

Normally, we would display the documentation for the sudokug
script here. But unfortunately this depends on the ability to
spawn the perldoc command, and we don't have this ability under
Mac OS 9 and earlier. You can find the same thing online at
http://search.cpan.org/~wyant/Games-Sudoku-General-@{[
    Games::Sudoku::General->VERSION]}/bin/sudokug

eod
}

sub solution {
my $rslt = $su->solution () || ($su->get ('status_text'));
chomp $rslt;
print "$rslt\n";
}

sub source {
my $fn = shift;
my $fh = FileHandle->new ("<$fn") or die <<eod;
Error - Failed to open input file $fn.
        $!
eod
unshift @handles, $fh;
}

sub _acquire_line {
my $prompt = shift || 'sudokug> ';
my $rslt = @handles ? <$handles[0]> : $rdln->readline ($prompt);
defined $rslt and chomp $rslt;
$rslt;
}

sub _here_document {
my $tag = shift;
my $rslt = '';
while (defined (my $data = _acquire_line ("$tag: "))) {
    last if $data eq $tag;
    $rslt .= $data;
    $rslt .= "\n";
    }
$rslt;
}

__END__

=head1 NAME

sudokug - Script to solve sudoku-like puzzles.

=head1 SYNOPSIS

 $ sudokug
 sudokug> problem <<eod
 eod: . . . 4 . . 7 8 9
 eod: 4 . 6 . . . 1 . .
 eod: . 8 . . . . . 5 .
 eod: 2 . 4 . . 5 . . .
 eod: . 9 5 . . . . . .
 eod: . . . 9 . 2 3 4 5
 eod: . 3 . . 7 . 9 . 8
 eod: . 6 7 . . 1 . . .
 eod: 9 . . . . 8 . . 2
 eod: eod
 sudokug> solution
 1 2 3 4 5 6 7 8 9
 4 5 6 7 8 9 1 2 3
 7 8 9 1 2 3 4 5 6
 2 1 4 3 6 5 8 9 7
 3 9 5 8 4 7 2 6 1
 6 7 8 9 1 2 3 4 5
 5 3 2 6 7 4 9 1 8
 8 6 7 2 9 1 5 3 4
 9 4 1 5 3 8 6 7 2
 sudokug> solution
 No solution found
 sudokug> exit

=head1 DETAILS

This Perl script is based on the Games::Sudoku::General module. It is
capable of solving a variety of Sudoku and Sudoku-like puzzles. In
fact, it should be able to solve any puzzle that meets the following
criteria:

* The puzzle is based on allocating symbols among cells.

* Each cell contains exactly one symbol.

* A number of sets of cells are specified; each set must
contain each symbol exactly once.

* Optionally, some cells may contain initial values.

* Optionally, some cells may be restricted to a subset of
all possible symbols.

In theory, any size and topology is possible. What is B<not> possible
at the moment is the solution of puzzles requiring logic other than
that given above.

Basically, any exposed method in Games::Sudoku::General is a command
understood by this script. Arguments to the methods are parameters
to the script commands. A few commands have been added to make life
for the user of the script easier.

Commands are parsed by Text::ParseWords, so the command name and
parameters are whitespace-delimited. Any parameter that contains
whitespace must be quoted. Either single ("'") or double ('"') quotes
will work.

Because some of the parameters (e.g. specifying a problem) involve a
large number of bytes, pseudo-"here documents" are supported. To
specify a "here document" as a parameter, specify "<<string" in place
of the parameter. The script will prompt with the string, and anything
you enter is part of that parameter, until you enter a line consisting
solely of the given string. More than one "here document" can be
specified; you will be prompted for them in left-to-right order. There
is an example of a "here document" in the L</SYNOPSIS> section.

Below is a brief description of the commands. For the attributes that
may be set or retrieved, and a more thorough (and possibly more
current) discussion of the underlying methods, see
L<Games::Sudoku::General>, or (equivalently) use the command

 sudokug> help lib

=head2 Commands

=over

=item add_set

This command adds a set to an existing topology. The arguments are the
name of the new set, and the numbers of the existing cells that are to
be members of it.

Cells are numbered from 0 in the order in which they were defined by
the topology. Typically this is row order.

=item constraints_used

This command lists the constraints used to provide the most recent
solution.

=item exit

This command does not correspond to a Games::Sudoku::General method.
It causes this script to terminate. Entering end-of-file in response
to a prompt by this script also works.

=item generate min max constraints

This command attempts to generate a puzzle in the current topology.
All arguments may be defaulted, but the defaults may not be
appropriate for all topologies. See 'help lib' for details.

=item get name ...

This command displays the values of the named attributes. You can
specify the name of more than one attribute. See L</Attributes> below
for a brief discussion of each, and L<Games::Sudoku::General> for more
details.

=item help

This command does not correspond to a Games::Sudoku::General method.
Without an argument, it gets you this documentation. If given with
the argument 'lib', that is, as

 sudokug> help lib

it gets you the POD for Games::Sudoku::General.

=item new

This command instantiates a Games::Sudoku::General object. You get one
for free when you launch this script; this command is for those cases
when it's easier to start over with a new object than to reconfigure
the one you already have. Any arguments get passed to the set() method.

=item problem string

This command specifies the problem to be solved, in the order they were
defined by the topology (typically row order). The problem string must
be specified in terms of the currently-valid symbols. Whitespace
between the symbols is always allowed, but is required only if at least
one symbol consists of more than one character. Any invalid symbol is
taken to represent an unspecified cell.

Line breaks may be given (as in the L</SYNOPSIS>), but are treated
like any other whitespace.

=item set name value ...

This command sets each named attribute to its given value. You can
specify more than one name/value pair. See L</Attributes> below
for a brief discussion of each, and L<Games::Sudoku::General> for more
details.

=item show name ...

This command does not corespond to a Games::Sudoku::General method,
but is just a synonym for 'get'.

=item solution

This command causes an attempt to solve the currently-set-up problem.
If a solution is found, it will be displayed. Otherwise you will get
a brief message saying what happened.

If you issue this command more than once without an intervening
'problem' command, the solution will be attempted starting where the
previous solution left off. If there are multiple solutions to a
puzzle, each 'solution' command will get you one, until you run out.

=item source filename

This command does not correspond to a Games::Sudoku::General method.
It causes subsequent commands to be taken from the given file, until
the file is completely read, or until an 'exit' command is executed.
'source' commands may be nested to the limit allowed by your system.

'.' is accepted as a synonym for 'source', but the whitespace before
the file name is still required.


=item steps

This command displays the steps taken to obtain the most recent
solution. They will be displayed as follows:

F [cell value] - this represents a forced cell. That is, the given
value is the only allowed value for the cell. The given cell is
set to that value.

N [cell value] - this represents a "numeration". That is, the given
value can only be supplied by the given cell. The given cell is set
to that value.

B [[cell cell ...] value] - "box claim". The given value is not
possible in the given cells, because they lie outside a set
intersection that must contain that value. The given value is
eliminated as a possibility for the given cells.

T naked size [[cell cell ...] value] ... - "naked tuple". The given
value is not possible for the given cell because there exists a "tuple"
(pair, triple, ...) of cells of the given size which must contain this
value, and the given cells are not in the tuple. More than one value
can be given, with a list of cells for each. The given value is
eliminated as a possibility for the given cells.

T hidden size [[cell cell ...] value] ... - "hidden tuple". The given
cells are part of a "tuple" of cells of the given size that must
contain a same-sized "tuple" of values, but the given values are not
part of the "tuple" of values that must be contained in those cells.
The given value is eliminated as a possibility for the given cell.

? [cell value] - "backtrack". If derivation of the solution reaches
a point where none of the above rules can be applied, we simply take
a guess at a legal cell value. The cell with the smallest number of
possible values is chosen for the guess. If there are more than one
such cell, the one with the smallest cell number is chosen. If at any
point a solution becomes impossible, we backtrack to the point we
took the guess, and try the next possible value.

=back

=head2 Attributes

Any readable attribute may be displayed with the 'get' or 'show'
commands, and any writeable attribute may be set with the 'set'
command. For example:

 sudokug> set allowed_symbols <<eod
 eod: e=2,4,6,8
 eod: o=1,3,5,7,9
 eod: eod
 sudokug>

The following simply lists the attributes. Rather than repeat their
definitions, you are simply referred to L<Games::Sudoku::General>, or
(equivalently) to the

 sudokug> help lib

command.

=over

=item allowed_symbols (string)

This attribute is used to specify and name sets of allowed symbols. See
above for an example.

=item brick (string, write-only)

This pseudo-attribute sets the topology, symbols, and columns for a
Sudoku puzzle involving rectangular regions rather than square ones.
The value is a comma-delimited string of three numbers representing
the horizontal and vertical dimensions of the rectangular regions, and
the size of the enclosing square.

=item columns (number)

This attribute specifies the number of cells displayed on a line of
topology or solution output. It has nothing to do with the problem
itself, and no effect on problem input.

=item corresponding (number)

This pseudo-attribute sets the topology, symbols, and columns for a
Sudoku puzzle having the additional restriction that corresponding
cells in the small squares must contain different numbers. The value
is the size of the small square (i.e. the same as the value for
L</sudoku>. Also called "disjoint groups".

=item cube (string, write-only)

This pseudo-attribute sets the topology, symbols, and columns for a
Sudoko puzzle on the faces of a cube. There are three topologies
supported; two on the face of a 4 x 4 x 4 cube, plus the Dion cube.
Which one is actually generated is selected by the argument:

* a number generates a Dion cube, and specifies the size of the small
square. Specifying 3 generates a 9 x 9 x 9 Dion cube.

* 'full' generates a puzzle on all 6 faces of the cube. The sets are
the faces of the cube and the "stripes" of cells running around the
cube in all three directions. The problem is entered face-by-face;
if you imagine the cube unfolded into a Latin cross, work top-to-bottom
and left-to-right.

* 'half' generates a puzzle on the visible 3 faces of an isometric view
of a cube. The sets are halves of the face and the visible "stripes".
Imagine the visible part of the cube unfolded into the letter "L", with
the top and right faces divided horizontally, and the remaining face
divided vertically. Enter the problem working top-to-bottom and
left-to-right.

B<Caveat:> The symbols generated for a 'full' cube are 1 .. 16. The
example I have (from L<http://www.mathrec.org/sudoku/sudokucube.gif>)
uses 0 through F. If you have one of these, remember to 'set symbols'
after you 'set cube full'.

See L<Games::Sudoku::General> (or 'help lib') for a fuller discussion,
with cheesy typed diagrams.

=item debug (number)

This attribute displays debugging information. The only supported value
is 0.

=item generation_limit (number)

This attribute sets the number of times the L<generate|/item_generate>
command tries to generate a puzzle before it gives up.

=item iteration_limit (number)

This attribute sets the number of times the solution command is allowed
to use the backtrack constraint. If set to 0, there is no limit.

=item largest_set (number, read-only)

This attribute reports the size of the largest set in the current
topology.

=item latin (number, write-only)

This pseudo-attribute sets the topology to a Latin square, and the
symbol set to the requisite number of letters. The argument is the
size of the square.

=item max_tuple (number)

This attribute is the maximum tuple size considered when applying
the tuple constraint.

=item name (string)

This is just a convenient place to put an identifying string.

=item output_delimiter (string)

This attribute specifies the delimiter between cell values on output.
The default is a single space.

=item rows (number)

This attribute specifies the number of lines of topology or solution
output before a blank line is inserted for readability. It has nothing
to do with the problem itself, and no effect on problem input.

=item status_text (string, read-only)

This attribute reports the message generated by the last attempted
solution.

=item status_value (number)

This attribute is the status code generated by the last attempted
solution.

=item sudoku (number, write-only)

This pseudo-attribute sets the topology, symbols, and columns for
the usual Sudoku puzzle, The value is the 'order' of the puzzle,
that is, the size of the small square. To get the usual set-up,
use

 sudokug> set sudoku 3

=item sudokux (number, write-only)

This pseudo-attribute is similar to the 'sudoku' attribute, but
the main diagonals are included.

=item symbols 'string'

This attribute sets the symbols that are to be placed in the cells
of the puzzle. The individual symbols must be whitespace-delimited,
and the first symbol must be the 'canonical' representation of an
empty cell.

=item topology (string)

This attribute sets the current topology in terms of a list of the
sets to which each cell belongs.

=back

=head1 MODIFICATIONS

 0.001 T. R. Wyant
   Initial release
 0.003 T. R. Wyant
   Documented methods and attributes added
   since 0.001.
 0.004 T. R. Wyant - Documented new use of cube attribute.
 0.005 T. R. Wyant - Documented new mothods and attributes.

=head1 AUTHOR

Thomas R. Wyant, III (F<wyant at cpan dot org>)

=head1 COPYRIGHT

Copyright 2005 by Thomas R. Wyant, III
(F<wyant at cpan dot org>). All rights reserved.

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