fix length for status, begin pango/cairo

5 files changed, 170 insertions, 19 deletions

diff --git a/lib/GridFiller.pm b/lib/GridFiller.pm
index 9644da3..f88d94f 100644
--- a/lib/GridFiller.pm
+++ b/lib/GridFiller.pm
@@ -96,7 +96,7 @@ sub fill {
         }
     }
 
-    return $result;
+    return;
 }
 
 1;
diff --git a/lib/GridFiller/Chooser.pm b/lib/GridFiller/Chooser.pm
index 6feb429..04e3cc9 100644
--- a/lib/GridFiller/Chooser.pm
+++ b/lib/GridFiller/Chooser.pm
@@ -3,7 +3,6 @@ use Moose;
 use namespace::autoclean;
 use GridFiller::Status;
 use GridFiller::Constants ':all';
-use MooseX::Types::Moose qw(CodeRef);
 use Carp;
 
 with 'MooseX::Log::Log4perl';
@@ -14,15 +13,10 @@ has status => (
     required => 1,
     handles => {
         grid => 'grid_status',
+        length => 'length',
     },
 );
 
-has length => (
-    isa => CodeRef,
-    is => 'rw',
-    default => sub { sub {length shift} },
-);
-
 sub find_place_for {
     croak "unimplemented";
 }
diff --git a/lib/GridFiller/Result/Pango.pm b/lib/GridFiller/Result/Pango.pm
new file mode 100644
index 0000000..504f2a7
--- /dev/null
+++ b/lib/GridFiller/Result/Pango.pm
@@ -0,0 +1,145 @@
+package GridFiller::Result::Pango;
+use Moose;
+use namespace::autoclean;
+use GridFiller::Constants ':directions';
+use MooseX::Types::Moose qw(Int);
+use Cairo;
+use Pango;
+use Carp;
+
+extends 'GridFiller::Result';
+
+with 'MooseX::Log::Log4perl';
+
+has cell_size => (
+    isa => Int,
+    is => 'rw',
+    default => 20,
+);
+
+has _width => (
+    isa => Int,
+    is => 'ro',
+    lazy_build => 1,
+    clearer => '_reset_w',
+);
+
+sub _build__width {
+    my ($self) = @_;
+
+    return $self->cell_size *  @{$self->source_grid->[0]};
+}
+
+has _height => (
+    isa => Int,
+    is => 'ro',
+    lazy_build => 1,
+    clearer => '_reset_h',
+);
+
+sub _build__height {
+    my ($self) = @_;
+
+    return $self->cell_size *  @{$self->source_grid};
+}
+
+has _cairo_s => (
+    is => 'ro',
+    lazy_build => 1,
+    clearer => '_reset_s',
+);
+
+sub _build__cairo_s {
+    my ($self) = @_;
+
+    my $cs = Cairo::ImageSurface->create(
+        'argb32',
+        $self->_width,
+        $self->_height,
+    );
+
+    return $cs;
+};
+
+has _cairo_c => (
+    is => 'ro',
+    lazy_build => 1,
+    clearer => '_reset_c',
+);
+
+sub _build__cairo_c {
+    my ($self) = @_;
+
+    my $cr = Cairo::Context->create($self->_cairo_s);
+    $self->_put_squares($cr);
+
+    return $cr;
+}
+
+sub _put_squares {
+    my ($self,$cr) = @_;
+
+    $self->log->debug(sprintf('putting squares (%dx%d)',$self->_width,$self->_height));
+
+    my $size = $self->cell_size;
+
+    $cr->rectangle(0,0,$self->_width,$self->_height);
+    $cr->set_source_rgb(1,1,1);
+    $cr->fill;
+
+    my $y=0;
+    for my $row (@{$self->source_grid}) {
+        my $x=0;
+        for my $cell (@$row) {
+            if ($cell eq '*') {
+                $cr->rectangle($x,$y,$size,$size);
+                $cr->set_source_rgb(0,0,0);
+                $cr->fill;
+            }
+            $x+=$size;
+        }
+        $y+=$size;
+    }
+
+    return;
+}
+
+sub place_word_at {
+    my ($self, $word, $x, $y, $dir) = @_;
+
+    $self->log->debug("Placing $word at ${x}:${y} ($dir)");
+
+    $self->_cairo_c;
+}
+
+sub as_png {
+    my ($self) = @_;
+
+    $self->_cairo_c->show_page;
+
+    my $buffer;
+    $self->_cairo_s->write_to_png_stream(sub{$buffer.=$_[1]});
+    return $buffer;
+}
+
+sub save_png {
+    my ($self,$filename) = @_;
+
+    $self->_cairo_c->show_page;
+
+    $self->_cairo_s->write_to_png($filename);
+    return;
+}
+
+sub to_string {}
+
+after reset => sub {
+    my ($self) = @_;
+    $self->_reset_w;
+    $self->_reset_h;
+    $self->_reset_c;
+    $self->_reset_s;
+};
+
+
+1;
diff --git a/lib/GridFiller/Status.pm b/lib/GridFiller/Status.pm
index 092f9a9..6e457b6 100644
--- a/lib/GridFiller/Status.pm
+++ b/lib/GridFiller/Status.pm
@@ -4,7 +4,7 @@ use namespace::autoclean;
 use List::Util qw(shuffle);
 use List::MoreUtils qw(uniq);
 use GridFiller::Types qw(WordListT GridStatusT GridT WordListT);
-use MooseX::Types::Moose qw(Str);
+use MooseX::Types::Moose qw(Str CodeRef);
 use GridFiller::Constants ':all';
 use Carp;
 use feature 'switch';
@@ -29,6 +29,12 @@ has mode => (
     default => 'given',
 );
 
+has length => (
+    isa => CodeRef,
+    is => 'rw',
+    default => sub { sub {length shift} },
+);
+
 has words_to_use => (
     isa => WordListT,
     traits => ['Array'],
@@ -51,12 +57,13 @@ sub _build_words_to_use {
     my ($self) = @_;
     my $words = $self->words;
     my $mode = $self->mode;
+    my $l = $self->length;
 
     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 ] }
+        when ('longest') { return [ sort {$l->($b) <=> $l->($a)} uniq @$words ] }
+        when ('shortest') { return [ sort {$l->($a) <=> $l->($b)} uniq @$words ] }
         default { croak "Unknown mode $mode" }
     }
 }
@@ -80,12 +87,12 @@ sub place_word_at {
     $self->log->debug("Marking <$word> occupied at ${x}:${y} ($dir)");
 
     if ($dir == $HORIZONTAL) {
-        for my $i (0..length($word)-1) {
+        for my $i (0..$self->length->($word)-1) {
             $self->_mark_occupied($x+$i,$y);
         }
     }
     elsif ($dir == $VERTICAL) {
-        for my $i (0..length($word)-1) {
+        for my $i (0..$self->length->($word)-1) {
             $self->_mark_occupied($x,$y+$i);
         }
     }
diff --git a/script/qr-color.pl b/script/qr-color.pl
index 268d4c9..2c7735f 100644
--- a/script/qr-color.pl
+++ b/script/qr-color.pl
@@ -3,16 +3,15 @@ use utf8;
 use strict;
 use warnings;
 use Text::QRCode;
-use TextPrinter::ColourGrid;
-use TextPrinter::StarGrid;
 use GridFiller;
-use GridFiller::Scaler;
-use GridFiller::Chooser::Smarter;
+use GridFiller::Result::Pango;
 use feature 'say';
 use open ':std',':locale';
 use Log::Log4perl qw(:easy);
 Log::Log4perl->easy_init($INFO);
 
+Log::Log4perl->get_logger('GridFiller::Result::Pango')->level($DEBUG);
+
 binmode DATA,':utf8';
 
 my $data = do { local $/="\n__WORDS__\n";my $x=<DATA>;chomp $x;$x };
@@ -27,15 +26,21 @@ my $arr=$qr->plot($data);
 
 my $filler=GridFiller->new({
     words=>\@words,
-    grid=> GridFiller::Scaler->scale($arr,2),
+    grid=> $arr,
 });
 
+$filler->result(
+    GridFiller::Result::Pango->new({
+        source_grid => $filler->grid,
+    })
+);
 $filler->status->mode('longest');
+$filler->status->length(sub { int(length(shift)/2) });
 $filler->fill();
 
 my $result=$filler->result;
 
-TextPrinter::ColourGrid->new->draw_whole($result->grid,1);
+$result->save_png('/tmp/qr.png');
 
 say '';
 say 'Leftovers:';