#!/usr/bin/perl

=head1 NAME

sudoku_maker.pl - create Sudoku puzzles with PDF::API2

=head1 SYNOPSIS

    % <sudoku text> | perl sudoku_maker.pl sudoku.pdf
    - - 6   8 - 4   - - -
    - - -   - 9 -   7 - 8
    - - -   5 - -   - 9 -

    1 - -   - 4 -   - - 9
    - - -   - - -   5 - -
    4 6 -   - - 1   - 3 -

    8 7 -   - - -   4 - -
    - - -   - 5 -   2 - -
    - - -   - - 2   - 1 -

=head1 DESCRIPTION

This is a proof-of-concept script. Eric Maki created a Sudoku puzzle
generator, but he output the text you see in the SYNOPSIS. I wanted
to turn that into a nice puzzle so I started tinkering with PDF::API2.
Eric's source will be part of the Spring 2006 issue of The Perl Review.

If you want to change the input, change C<get_puzzle> to parse it
correctly.

UPDATE: Some additions by Michael S. Collins to make the PDF stuff more usable:
    Added cmd line arg: input/output PDF file name
    Changed program output to write directly to PDF file instead of STDOUT
    Added PDF-specific information:
        'Author' = 'sudoku_maker.pl'
        'Keywords' = 'puzzlecount=##' (where ## = number of puzzles in PDF doc)
    (To view this information in Adobe Reader, click File > Document Properties)
    Added quick & dirty validation routine:
        If supplied PDF file does not exist it is created
            ('.pdf' appended if nec)
        If supplied PDF file does exist, checks for 'Author' to be equal to
            'sudoku_maker.pl'; dies if not
        This prevents the script from putting sudoku puzzles on 'normal' PDFs!
        Looks for 'puzzlecount=##' in 'Keywords'; if not found, start at 0
    Added logic to put allow six puzzles per page
    After six puzzles, a new page is added and newest puzzle placed
    Repeated calls to sudoku_maker.pl with the same PDF file will result in
        many puzzles appended

=head1 TO DO

=over 4

=item * most things can be configurable, but I hardcoded them

=item * i'd like to generate several puzzles per page (see MC UPDATE above)

=item * the C<place_digit> routine is a bit of guess work for font centering.

=back

=head1 AUTHOR

brian d foy, C<< <bdfoy@cpan.org> >

=head1 COPYRIGHT and LICENSE

Copyright 2006, brian d foy, All rights reserved.

This software is available under the same terms as perl.

=cut

use strict;
use warnings;

use PDF::API2;

use constant PAGE_WIDTH      => 595;
use constant PAGE_HEIGHT     => 842;
use constant MARGIN          =>  25;
use constant GUTTER          =>  32;

use constant WIDE_LINE_WIDTH =>   3;
use constant LINE_WIDTH      =>   2;
use constant THIN_LINE_WIDTH =>   1;

use constant SQUARE_SIDE     => 243;  # changed from brian's 270

use constant FONT_SIZE       => int( 0.70 * SQUARE_SIDE / 9 );

use constant MAX_PUZZLES     => 6;  # max number puzzles per page

# Now we cheat a bit: there are only 6 possible starting x,y positions
# So we put them in a pair of arrays, one for x positions, the other for y
# Then when we call make_grid and place_digit we use these as our x,y
# coordinates: puzzle 1 = $xpos[1],$ypos[1], puzzle 2 = $xpos[2],$ypos[2]...
# NOTE: puzzle 6 = $xpos[0],$ypos[0] because we use modulus
# GUTTER = horizontal space between puzzles

my @xpos = (
    ( PAGE_WIDTH  + GUTTER) / 2,                          # xpos, puzzle 6
    ( PAGE_WIDTH - (SQUARE_SIDE * 2 + GUTTER) ) / 2,      # xpos, puzzle 1
    ( PAGE_WIDTH  + GUTTER) / 2,                          # xpos, puzzle 2
    ( PAGE_WIDTH - (SQUARE_SIDE * 2 + GUTTER) ) / 2,      # xpos, puzzle 3
    ( PAGE_WIDTH  + GUTTER) / 2,                          # xpos, puzzle 4
    ( PAGE_WIDTH - (SQUARE_SIDE * 2 + GUTTER) ) / 2,      # xpos, puzzle 5
);

my @ypos = (
    PAGE_HEIGHT - SQUARE_SIDE * 3 - GUTTER * 2 - MARGIN,  # ypos, puzzle 6
    PAGE_HEIGHT - SQUARE_SIDE - MARGIN,                   # ypos, puzzle 1
    PAGE_HEIGHT - SQUARE_SIDE - MARGIN,                   # ypos, puzzle 2
    PAGE_HEIGHT - SQUARE_SIDE * 2 - GUTTER - MARGIN,      # ypos, puzzle 3
    PAGE_HEIGHT - SQUARE_SIDE * 2 - GUTTER - MARGIN,      # ypos, puzzle 4
    PAGE_HEIGHT - SQUARE_SIDE * 3 - GUTTER * 2 - MARGIN,  # ypos, puzzle 6
);
    
my $pdf;
my $puzzle_count;     # how many puzzles in this PDF
my $page_count;       # how many pages in this PDF
my $puzzlenum;        # which puzzle on this page (1, 2, 3...)

# if have cmd line arg, assume it's a file name + path
# if file exists, assume it's a pdf, open it for appending puzzles
# if file does not exist, create it

my $infile = $ARGV[0];
print "Using $infile as pdf file...\n";

if ( -f $infile ) {
    $pdf = PDF::API2->open( $infile ) or
        die "Unable to open PDF file $infile \n";
    my %pdfinfo = $pdf->info;
    my $keywords = $pdfinfo{'Author'};
    if ( $keywords !~ m/sudoku_maker\.pl/ ) {
        die "This is not a PDF created by sudoku_maker.pl \n";
    }
    (undef,$puzzle_count) = split "=",$pdfinfo{'Keywords'};
    if ( ! $puzzle_count ) {
        # no puzzle count, setting it to 0
        $puzzle_count   = 0;
    }
    $page_count         = $pdf->pages;
} else {
   $pdf  = PDF::API2->new;
   $pdf->info( 'Author'   => 'sudoku_maker.pl' );
   $page_count            = 1;
   $puzzle_count          = 0;
   $pdf->mediabox( PAGE_WIDTH, PAGE_HEIGHT );
   if ( substr( $infile, -4 ) ne '.pdf' ) {
      $infile .= '.pdf';
   }
}

my $font = $pdf->corefont( 'Helvetica-Bold' );

run() unless caller;

sub run
    {
    my $page;         # it's generally easier to have a page object available
    $page = $pdf->openpage( $page_count );
    if ( ! $page ) {
        $page = $pdf->page;   # first page of brand new PDF doc
    }

    # check to see if we need to add a page
    if ( ++$puzzle_count / MAX_PUZZLES > $page_count ) {
        $page = $pdf->page;   # adds a new page, sets $page obj to new page
    }
    
    # determine which puzzle on page to use:
    # 1st puzzle = upper left, 2nd = upper right
    # 3rd puzzle = mid left, 4th = mid right
    # 5th puzzle = lower left, 6th = lower right
    
    $puzzlenum = $puzzle_count % MAX_PUZZLES;

    my $gfx = $page->gfx;
    $gfx->strokecolor( '#000' );
    $gfx->linewidth( WIDE_LINE_WIDTH );

    make_grid(
        $gfx,
        $xpos[ $puzzlenum ],    # x
        $ypos[ $puzzlenum ],    # y
        );

    populate_puzzle( $gfx, get_puzzle() );

    $pdf->info( 'Keywords' => "puzzlecount=$puzzle_count" );
    $pdf->saveas($infile);
    print "$infile now has $puzzle_count Sudoku puzzle";
    if ( $puzzle_count > 1 ) {
        print "s";
    } # if
    }
    print ".\n\n";

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
sub populate_puzzle
    {
    my( $gfx, $array ) = @_;

    foreach my $row ( 0 .. $#$array )
        {
        my $row_array = $array->[$row];

        foreach my $column ( 0 .. $#$row_array )
            {
            next unless defined $row_array->[$column];
            place_digit( $gfx, $row, $column, $row_array->[$column] )
            }
        }
    }

sub place_digit
    {
    my( $gfx, $row, $column, $digit ) = @_;

    my $x_start = $xpos[$puzzlenum];
    my $y_start = $ypos[$puzzlenum];

    my $x_offset = 0.30 * SQUARE_SIDE / 9; # empirically derived
    my $y_offset = 0.25 * SQUARE_SIDE / 9;

    my $x = $x_start + $column * SQUARE_SIDE / 9 + $x_offset;
    my $y = $y_start + $row * SQUARE_SIDE / 9 + $y_offset;

    $gfx->textlabel( $x, $y, $font, FONT_SIZE, $digit );

    }

sub get_puzzle
    {
    my @array;

    print STDERR "Waiting for puzzle input!\n";

    while( <STDIN> )
        {
        chomp;
        s/^\s|\s$//g;
        next unless length $_;
        push @array, [ map { $_ eq '-' ? undef : $_ } split ];
        }

    return \@array;
    }

sub make_grid
    {
    my( $gfx, $lower_left_x, $lower_left_y ) = @_;

    make_outline( $gfx, $lower_left_x, $lower_left_y );

    $gfx->linewidth( THIN_LINE_WIDTH );
    make_blocks(  $gfx, $lower_left_x, $lower_left_y, 9 );

    $gfx->linewidth( LINE_WIDTH );
    make_blocks(  $gfx, $lower_left_x, $lower_left_y, 3 );
    }

sub make_blocks
    {
    my( $gfx, $lower_left_x, $lower_left_y, $cells ) = @_;

    my( $xs, $ys ) =
        map {
            my $point = $_;
            [ map { $point + $_ * SQUARE_SIDE / $cells } 1 .. $cells - 1 ];
            } ( $lower_left_x, $lower_left_y );

    foreach my $x ( @$xs )
        {
        make_line( $gfx,
            $x, $lower_left_y,
            $x, $lower_left_y + SQUARE_SIDE,
            );
        }

    foreach my $y ( @$ys )
        {
        make_line( $gfx,
            $lower_left_x, $y,
            $lower_left_x + SQUARE_SIDE, $y,
            );
        }
    }

sub make_outline
    {
    my( $gfx, $lower_left_x, $lower_left_y ) = @_;

    my( $upper_right_x, $upper_right_y ) =
        map { $_ + SQUARE_SIDE } ( $lower_left_x, $lower_left_y );

    my @points = (
        [ $lower_left_x,   $lower_left_y - WIDE_LINE_WIDTH / 2,
          $lower_left_x,   $upper_right_y ],
        [ $lower_left_x, $upper_right_y - WIDE_LINE_WIDTH / 2,
          $upper_right_x, $upper_right_y ],
        [ $upper_right_x - WIDE_LINE_WIDTH / 2, $upper_right_y,
          $upper_right_x, $lower_left_y ],
        [ $upper_right_x, $lower_left_y + WIDE_LINE_WIDTH / 2,
          $lower_left_x, $lower_left_y ],
        );

    foreach my $tuple ( @points ) { make_line( $gfx, @$tuple ) }
    }

sub make_line
    {
    my( $gfx, $x, $y, $x2, $y2 ) = @_;

    $gfx->move( $x,  $y  );
    $gfx->line( $x2, $y2 );
    $gfx->fillstroke;
    }

__END__
- - 6   8 - 4   - - -
- - -   - 9 -   7 - 8
- - -   5 - -   - 9 -

1 - -   - 4 -   - - 9
- - -   - - -   5 - -
4 6 -   - - 1   - 3 -

8 7 -   - - -   4 - -
- - -   - 5 -   2 - -
- - -   - - 2   - 1 -