File Coverage

blib/lib/Games/Crosswords.pm

Criterion	Covered	Total	%
statement	9	104	8.6
branch	0	32	0.0
condition			n/a
subroutine	3	12	25.0
pod	5	8	62.5
total	17	156	10.9

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=<
\\documentclass[letterpaper]{article}
\\usepackage{texdraw}
\\begin{document}
\\begin{texdraw}
HEAD

    my $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__