Games::Crosswords - Crosswords Game

Games-Crosswords documentation Contained in the Games-Crosswords distribution.

Index

Code Index:

NAME

Top

Games::Crosswords - Crosswords Game

SYNOPSIS

Top

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

DESCRIPTION

Top

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.

METHODS

Top

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 y-th row and the x-th column. Both of them count from 0. Then, the hint follows. The last one is the answer which is not necessary unless users invoke gensolution.

table

Users may redefine the crosswords table.

lexicon

Users may redefine the lexicon data.

genpuzzle

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

gensolution

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

SEE ALSO

Top

eg/puzzle.pl, eg/solution.pl

AUTHOR

Top

xern <xern@cpan.org>

LICENSE

Top

Released under The Artistic License

Games-Crosswords documentation Contained in the Games-Crosswords distribution. 
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!