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=<{_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 => < { DOWN => [ [ 0, 4, 'The camel language', 'Perl' ], ], ACROSS => [ [ 2, 2, 'The cool author', 'xern' ], ] } The first two indicate the B and B column. Both of them count from 0. Then, the B follows. The last one is the B which is not necessary unless users invoke B. =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 =head1 LICENSE Released under The Artistic License =cut