summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authordakkar <dakkar@thenautilus.net>2010-11-25 22:45:20 +0000
committerdakkar <dakkar@thenautilus.net>2010-11-25 22:45:20 +0000
commit257d5834801afe7d9ddffa81f78d6b7f8d08822a (patch)
treee62760f971bd71d67fb130637f35c00971b76896 /lib
parentsmarter chooser (diff)
downloadqr-builder-257d5834801afe7d9ddffa81f78d6b7f8d08822a.tar.gz
qr-builder-257d5834801afe7d9ddffa81f78d6b7f8d08822a.tar.bz2
qr-builder-257d5834801afe7d9ddffa81f78d6b7f8d08822a.zip
scaler, and __DATA__
also, better validation
Diffstat (limited to 'lib')
-rw-r--r--lib/GridFiller.pm15
-rw-r--r--lib/GridFiller/Scaler.pm32
-rw-r--r--lib/GridFiller/Status.pm18
-rw-r--r--lib/GridFiller/Types.pm2
4 files changed, 59 insertions, 8 deletions
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,