scaler, and __DATA__

also, better validation

5 files changed, 165 insertions, 18 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,
diff --git a/script/qr-color.pl b/script/qr-color.pl
index 8d78a2f..5841e0f 100644
--- a/script/qr-color.pl
+++ b/script/qr-color.pl
@@ -1,15 +1,21 @@
 #!/usr/bin/perl
+use utf8;
 use strict;
 use warnings;
 use Text::QRCode;
 use TextPrinter::ColourGrid;
 use TextPrinter::StarGrid;
 use GridFiller;
-use Path::Class;
+use GridFiller::Scaler;
+use feature 'say';
+use open ':std',':locale';
 use Log::Log4perl qw(:easy);
-Log::Log4perl->easy_init($DEBUG);
+Log::Log4perl->easy_init($INFO);
 
-my $data='MECARD:N:Ceccarelli,Gianni;TEL:+447564023056;EMAIL:dakkar@thenautilus.net;URL:http://www.thenautilus.net/contacts/;NICKNAME:dakkar;;';
+binmode DATA,':utf8';
+
+my $data = do { local $/="\n__WORDS__\n";my $x=<DATA>;chomp $x;$x };
+my @words = <DATA>;chomp @words;
 
 my $qr=Text::QRCode->new(
     level=>'H',
@@ -18,15 +24,105 @@ my $qr=Text::QRCode->new(
 
 my $arr=$qr->plot($data);
 
-my @words = grep { length($_) > 2 }
-    file('/usr/share/dict/propernames')->slurp(chomp=>1);
-
-my $filler=GridFiller->new({words=>\@words,grid=>$arr});
+my $filler=GridFiller->new({
+    words=>\@words,
+    grid=> GridFiller::Scaler->scale($arr,2),
+});
 
-my $result = $filler->fill;
+my $result = $filler->fill({
+    mode => 'longest',
+    chooser => 'Smarter',
+});
 
 TextPrinter::ColourGrid->new->draw_whole($result->grid,1);
 
-print "\n\n";
+say '';
+say 'Leftovers:';
+say for @{$result->leftover_words};
 
-TextPrinter::StarGrid->new->draw_whole($arr,1);
+__DATA__
+MECARD:N:Ceccarelli,Gianni;TEL:+447564023056;EMAIL:dakkar@thenautilus.net;URL:http://www.thenautilus.net/contacts/;NICKNAME:dakkar;;
+__WORDS__
+Lois McMaster Bujold
+Kage Baker
+David Weber
+Robert Heinlein
+Douglas Adams
+Neal Stephenson
+Lewis Carrol
+Terry Pratchett
+Jorge Luis Borges
+Frank Herbert
+Alessandro Bergonzoni
+Stefano Benni
+Jules Verne
+Neil Gaiman
+H.G. Wells
+Isaac Asimov
+Arthur C. Clarke
+Philip K. Dick
+JRR Tolkien
+Ed Wood
+Tim Burton
+Monty Python
+Terry Gilliam
+Orson Welles
+Peter Greenaway
+David Cronenberg
+Stanley Kubrick
+Joss Whedon
+Quentin Tarantino
+Mel Brooks
+MIYAZAKI Hayao
+OSHII Mamoru
+ANNO Hideaki
+Alan Moore
+KITOH Mohiro
+TEZUKA Osamu
+YUKI Masami
+URASAWA Naoki
+YUKINOBU Hoshino
+yoshitoshi ABe
+SHIROW Masamune
+Amanda Palmer
+Marian Call
+Jonathan Coulton
+The Flaming Lips
+The Pillows
+Nightwish
+Stefano Nosei
+Jethro Tull
+KANNO Yoko
+Franco Battiato
+Enya
+Helloween
+Mike Oldfield
+Alan Parsons Project
+Emerson, Lake & Palmer
+Fabrizio De André
+Kenji Kawai
+David Bowie
+Girl Genius
+Gunnerkrigg Court
+Cyrano de Bergerac
+Watership Down
+RHPS
+Thunderbirds
+Doctor Who
+The Twilight Zone
+Blade Runner
+Forbidden Planet
+Cowboy Bebop
+FLCL
+Gundam
+Macross
+Fushigi no umi no Nadia
+SUZUMIYA Haruhi
+Cutey Honey
+Dennou Coil
+Haibane Renmei
+Star Trek
+D&D
+Go
+Shogi
+Perl