#!/usr/bin/perl

=head1 NAME

sudoku_maker - create Sudoku puzzles with PDF::API2

=head1 SYNOPSIS

    % perl sudoku_maker > 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.

=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

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

=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 WIDE_LINE_WIDTH =>   3;
use constant LINE_WIDTH      =>   2;
use constant THIN_LINE_WIDTH =>   1;

use constant SQUARE_SIDE     => 270;

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


my $pdf  = PDF::API2->new;
my $font = $pdf->corefont( 'Helvetica-Bold' );

run() unless caller;

sub run 
    {
    $pdf->mediabox( PAGE_WIDTH, PAGE_HEIGHT );
    
    my $gfx = $pdf->page->gfx;
    $gfx->strokecolor( '#000' );
    $gfx->linewidth( WIDE_LINE_WIDTH );

    make_grid( 
        $gfx,
        ( PAGE_WIDTH - SQUARE_SIDE ) / 2 ,  # x
        PAGE_HEIGHT - SQUARE_SIDE - MARGIN, # y
        );
        
    populate_puzzle( $gfx, get_puzzle() );
    
    print $pdf->stringify;
    }
    
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # 
+# #
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 = ( PAGE_WIDTH - SQUARE_SIDE ) / 2;
    my $y_start = PAGE_HEIGHT - SQUARE_SIDE - MARGIN;
    
    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 - 
[download]