From de02c4e87db0425e315bbdb010157941ec04e1c0 Mon Sep 17 00:00:00 2001 From: dakkar Date: Thu, 2 Dec 2010 21:41:58 +0000 Subject: fix length for status, begin pango/cairo --- lib/GridFiller.pm | 2 +- lib/GridFiller/Chooser.pm | 8 +-- lib/GridFiller/Result/Pango.pm | 145 +++++++++++++++++++++++++++++++++++++++++ lib/GridFiller/Status.pm | 17 +++-- script/qr-color.pl | 17 +++-- 5 files changed, 170 insertions(+), 19 deletions(-) create mode 100644 lib/GridFiller/Result/Pango.pm 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=;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:'; -- cgit v1.2.3