From 257d5834801afe7d9ddffa81f78d6b7f8d08822a Mon Sep 17 00:00:00 2001 From: dakkar Date: Thu, 25 Nov 2010 22:45:20 +0000 Subject: scaler, and __DATA__ also, better validation --- lib/GridFiller.pm | 15 ++++++++++++--- lib/GridFiller/Scaler.pm | 32 ++++++++++++++++++++++++++++++++ lib/GridFiller/Status.pm | 18 ++++++++++++++---- lib/GridFiller/Types.pm | 2 +- 4 files changed, 59 insertions(+), 8 deletions(-) create mode 100644 lib/GridFiller/Scaler.pm (limited to 'lib') diff --git a/lib/GridFiller.pm b/lib/GridFiller.pm index 2b92285..dbe7010 100644 --- a/lib/GridFiller.pm +++ b/lib/GridFiller.pm @@ -6,6 +6,7 @@ use GridFiller::Status; use GridFiller::Result; use GridFiller::Chooser::Smarter; use Carp; +use Class::MOP; with 'MooseX::Log::Log4perl'; @@ -22,11 +23,19 @@ has grid => ( ); sub fill { - my ($self) = @_; + my ($self,$args) = @_; + + my $status = GridFiller::Status->new({ + grid => $self->grid, + words => $self->words, + mode => $args->{mode} + }); + + my $chooser_class = 'GridFiller::Chooser::'.($args->{chooser} || 'Random'); + Class::MOP::load_class($chooser_class); - my $status = GridFiller::Status->new({grid => $self->grid, words => $self->words}); my $result = GridFiller::Result->new({source_grid => $self->grid}); - my $chooser = GridFiller::Chooser::Smarter->new({status => $status}); + my $chooser = $chooser_class->new({status => $status}); while ($status->unfilled() && $status->has_next_word()) { my $word = $status->get_next_word(); diff --git a/lib/GridFiller/Scaler.pm b/lib/GridFiller/Scaler.pm new file mode 100644 index 0000000..21d11c9 --- /dev/null +++ b/lib/GridFiller/Scaler.pm @@ -0,0 +1,32 @@ +package GridFiller::Scaler; +use Moose; +use namespace::autoclean; +use GridFiller::Types qw(GridT); +use MooseX::Types::Moose qw(Int); +use Carp; +use MooseX::Params::Validate 'pos_validated_list'; + +sub scale { + shift; # class + my ($input_grid,$scale) = pos_validated_list( + \@_, + { isa => GridT }, + { isa => Int }, + ); + + my @output_grid; + + for my $row (@$input_grid) { + my @out_row; + + for my $cell (@$row) { + push @out_row, $cell for 1..$scale; + } + + push @output_grid,[@out_row] for 1..$scale; + } + + return \@output_grid; +} + +1; diff --git a/lib/GridFiller/Status.pm b/lib/GridFiller/Status.pm index 4f55c6f..b14f870 100644 --- a/lib/GridFiller/Status.pm +++ b/lib/GridFiller/Status.pm @@ -6,6 +6,7 @@ use List::MoreUtils qw(uniq); use GridFiller::Types qw(WordListT GridStatusT); use GridFiller::Constants ':all'; use Carp; +use feature 'switch'; with 'MooseX::Log::Log4perl'; @@ -30,7 +31,7 @@ around BUILDARGS => sub { my ($orig, $class, $args, @rest) = @_; if (exists $args->{words} && exists $args->{grid}) { - $args->{words_to_use} = _munge_words_to_use(delete $args->{words}); + $args->{words_to_use} = _munge_words_to_use(delete $args->{words},$args); $args->{grid_status} = _munge_grid_status(delete $args->{grid}); } @@ -38,13 +39,22 @@ around BUILDARGS => sub { }; sub _munge_words_to_use { - my $words=shift; + my ($words,$args) = @_; # clone initial word list - return [ shuffle uniq @$words ]; + + my $mode = delete $args->{mode} || 'random'; + + given ($mode) { + when ('random') { return [ shuffle uniq @$words ] } + when ('given') { return [ uniq @$words ] } + when ('longest') { return [ sort {length($b) <=> length($a)} uniq @$words ] } + when ('shortest') { return [ sort {length($a) <=> length($b)} uniq @$words ] } + default { croak "Unknown mode $mode" } + } } sub _munge_grid_status { - my $grid=shift; + my ($grid) = @_; return [ map { [ diff --git a/lib/GridFiller/Types.pm b/lib/GridFiller/Types.pm index fb7fc9b..8beb715 100644 --- a/lib/GridFiller/Types.pm +++ b/lib/GridFiller/Types.pm @@ -5,7 +5,7 @@ use MooseX::Types -declare => CharT LetterCellT ResultT WordListT )]; -use MooseX::Types::Moose qw(Str ArrayRef Bool Int); +use MooseX::Types::Moose qw(Str ArrayRef Int); use MooseX::Types::Structured qw(Tuple); subtype CharT, -- cgit v1.2.3