The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Games::Crosswords;
use 5.006;
use strict;
use warnings;
our $VERSION = '0.01';

sub isvalidtable($){
    caller eq __PACKAGE__ or die;
    my $len = 0;
    for my $l (grep {$_} split //, $_[0]){
	$len = length $l unless $len;
	return 0 unless $len == length $l;
    }
    $len;
}

sub new {
    isvalidtable $_[1]->{TABLE} or die "Table is not valid";
    bless{ _TABLE => $_[1]->{TABLE}, _LEXICON => $_[1]->{LEXICON} }, $_[0];
}

sub table {
    isvalidtable $_[1] or die "Table is not valid";
    $_[0]->{_TABLE} = $_[1];
}

sub lexicon { $_[0]->{_LEXICON} = $_[1] }

sub getdim($) {
    my @table = split /\n/, shift;
    my ($x) = length ($table[0]);
    my ($y) = scalar @table;
    return ($x, $y);
}

sub mklexarr {
    caller eq __PACKAGE__ or die;
    @{$_[0]->{_LEXICON_ARR}} = ();
    for my $o (qw/ACROSS DOWN/){
	for my $e (@{$_[0]->{_LEXICON}->{$o}}){
	    push @{$_[0]->{_LEXICON_ARR}}, [ $e->[0], $e->[1], $o, $e->[2], $e->[3] ];
	}
    }
}


sub genpuzzle   { _generate($_[0], 'puzzle', $_[1]) }
sub gensolution { _generate($_[0], 'solution', $_[1]) }

sub _generate {
    caller eq __PACKAGE__ or die;

    my $HEAD=<<HEAD;
\\documentclass[letterpaper]{article}
\\usepackage{texdraw}
\\begin{document}
\\begin{texdraw}
HEAD

    my $FOOT=<<FOOT;
\\end{texdraw}
\\end{document}
FOOT

    my %dim;
    @dim{qw/x y/} = getdim( $_[0]->{_TABLE});
    my $arr;
    my ($dx, $dy) = (0.9, 0.9);
    my $tex="\\drawdim{cm} \\linewd 0.03 ";

    my $i=0;
    for my $L (split /\n/, $_[0]->{_TABLE}){ @{$arr->[$i++]} = split //, $L }

    # draws the cells
    for(my $i=0; $i<$dim{y}; $i++){
	for(my $j=0; $j<$dim{x}; $j++){
	    $tex.="\\move(@{[$j*$dx]} -@{[$i*$dy]}) ";
	    $tex.="\\rlvec(0 -$dy) \\rlvec($dx 0) \\rlvec(0 $dy) \\rlvec(-$dx 0) ";
	    if( $arr->[$i]->[$j] eq '@' ){
		$tex.="\\lfill f:0.1 ";
	    }
	}
    }

    mklexarr($_[0]);

    if($_[1] eq 'puzzle'){
	$tex.="\\move(0 -@{[(1+$dim{y})*$dy ]}) \\htext{ACROSS} ";
	$tex.="\\move(7 -@{[(1+$dim{y})*$dy ]}) \\htext{DOWN} ";
	
	my $j=0;
	my $i=1;
	my %i;
	@i{qw/down across/} = qw/1 1/;
	my $sno=1;
	my %sno;
	
	for my $entry (
		       sort { $a->[0] <=> $b->[0] }
		       sort { $a->[1] <=> $b->[1] }
		       @{$_[0]->{_LEXICON_ARR}}
		       ){
	    
	    $sno = defined $sno{$entry->[0].q/./.$entry->[1]} ?
		$sno{$entry->[0].q/./.$entry->[1]} : $i;
	    
	    if($entry->[2] eq 'ACROSS'){
		$tex.="\\move(0 -@{[(1+($i{across})*0.5+$dim{y})*$dy]}) ";
		$tex.="\\small \\htext{$sno $entry->[3]} ";
		$i{across}++;
	    }
	    elsif($entry->[2] eq 'DOWN'){
		$tex.="\\move(7 -@{[(1+($i{down})*0.5+$dim{y})*$dy]}) ";
		$tex.="\\small \\htext{$sno $entry->[3]} ";
		$i{down}++;
	    }
	    
	    $tex.="\\move(@{[$entry->[1]*$dx + 0.1]} -@{[$entry->[0]*$dy + 0.4]}) ";
	    $tex.="\\htext{$sno} ";
	    
	    unless($sno{$entry->[0].q/./.$entry->[1]}){
		$sno{$entry->[0].q/./.$entry->[1]} = $i;
		$i++;
	    }
	}
	
    }
    elsif($_[1] eq 'solution'){
	for my$entry ( @{$_[0]->{_LEXICON_ARR}} ){
	    my $i=0;
	    for my $letter (split //, $entry->[4]){
		$tex .= $entry->[2] eq 'ACROSS' ?
		    "\\move(@{[($entry->[1]+$i++)*$dx + 0.2]} -@{[$entry->[0]*$dy + 0.65]}) " : "\\move(@{[$entry->[1]*$dx + 0.2]} -@{[($entry->[0]+$i++)*$dy + 0.65]}) " ;

		$tex.="\\LARGE \\htext{@{[uc$letter]}} ";
	    }

	}
    }

    if($_[2]){
	open F, '>', $_[2];
	print F $HEAD.$tex.$FOOT;
	close F;
    }
    else{
	$HEAD.$tex.$FOOT;
    }
}


1;
__END__
    
}

# Below is stub documentation for your module. You better edit it!

=head1 NAME

Games::Crosswords - Crosswords Game

=head1 SYNOPSIS

  use Games::Crosswords;
  $c = Games::Crosswords->new({TABLE => blah, LEXICON => blah blah});
  $c->genpuzzle();

=head1 DESCRIPTION

This module helps users create crosswords and print output to a TEX file. Users can convert the TEX ouput to a ps or pdf file.

=head1 METHODS

=head2 new({TABLE => blah, LEXICON => blah blah})

To illustrate the parameters, it is better to use an example.

  TABLE => <<BLAH;
  @@@@.@
  @@@@.@
  @@....
  @@@@.@
  BLAH,


@ is for a block cell, and . for a blank one.


  LEXICON =>
  {
     DOWN =>
 	[
 	 [ 0, 4, 'The camel language', 'Perl' ],
 	 ],
     ACROSS =>
 	[
 	 [ 2, 2, 'The cool author', 'xern' ],
 	 ]
  }


The first two indicate the B<y-th row> and B<the x-th> column. Both of them count from 0. Then, the B<hint> follows. The last one is the B<answer> which is not necessary unless users invoke B<gensolution>.

=head2 table

Users may redefine the crosswords table.

=head2 lexicon

Users may redefine the lexicon data.

=head2 genpuzzle

Generates the puzzle. It prints the result to STDOUT unless given the file's name

=head2 gensolution

Generates the solution. It prints the result to STDOUT unless given the file's name

=head1 SEE ALSO

eg/puzzle.pl, eg/solution.pl

=head1 AUTHOR

xern <xern@cpan.org>

=head1 LICENSE

Released under The Artistic License

=cut