From 396d371b4c2798a1a7137274de68c271a7c86616 Mon Sep 17 00:00:00 2001 From: dakkar Date: Tue, 23 Nov 2010 22:52:49 +0000 Subject: the filler works, and we have two printers --- lib/GridFiller.pm | 118 ++++++++++++++++++++++++++---------------- lib/TextPrinter.pm | 35 ++++--------- lib/TextPrinter/ColourGrid.pm | 27 ++++++++++ lib/TextPrinter/StarGrid.pm | 19 +++++++ script/qr-color.pl | 16 ++++-- 5 files changed, 141 insertions(+), 74 deletions(-) create mode 100644 lib/TextPrinter/ColourGrid.pm create mode 100644 lib/TextPrinter/StarGrid.pm diff --git a/lib/GridFiller.pm b/lib/GridFiller.pm index d036094..ebeb933 100644 --- a/lib/GridFiller.pm +++ b/lib/GridFiller.pm @@ -3,33 +3,20 @@ use Moose; use namespace::autoclean; use List::Util qw(shuffle); use List::MoreUtils qw(uniq); -use TryCatch; use MooseX::Types -declare => [qw( GridT Char LetterCell )]; use MooseX::Types::Moose qw(Str ArrayRef Bool Int); use MooseX::Types::Structured qw(Tuple); use Carp; +with 'MooseX::Log::Log4perl'; + my $VERTICAL = 1; my $HORIZONTAL = 2; my $BLACK = 1; my $WHITE = 2; -subtype GridT, as ArrayRef[ArrayRef[Bool]]; - -coerce GridT, - from ArrayRef[ArrayRef[Str]], - via { - [ - map { - [ - map { - $_ eq '*' - } @$_ - ] - } @$_ - ] - }; +subtype GridT, as ArrayRef[ArrayRef[Str]]; has words => ( isa => ArrayRef[Str], @@ -82,7 +69,7 @@ sub _build__grid_status { map { [ map { - $_ ? $BLACK : $WHITE + $_ eq '*' ? $BLACK : $WHITE } @$_ ] } @{shift->grid} @@ -108,7 +95,7 @@ sub _build_result { map { [ map { - [0,' '], + [ ( $_ eq '*' ? 3 : 1 ), ' ' ], } @$_ ] } @{shift->grid} @@ -132,22 +119,30 @@ sub fill { while ($self->_unfilled() && $self->_has_next_word()) { my $word = $self->_get_next_word(); - my ($x,$y,$dir); + $self->log->debug("Placing $word"); - try { ($x,$y,$dir) = $self->_find_place_for($word) } - catch { + my ($x,$y,$dir) = $self->_find_place_for($word); + + if (! defined $x) { + $self->log->debug("No place for $word"); $self->_mark_leftover($word); next; }; $self->_place_word_at($word,$x,$y,$dir); + + if ($self->log->is_debug) { + $self->_log_status; + } } } sub _place_word_at { my ($self, $word, $x, $y, $dir) = @_; - my $colour = $self->_find_colour_for($x,$y); + my $colour = $self->_find_colour_for($x,$y,$dir); + + $self->log->debug("Placing $word at ${x}:${y} ($dir) in colour $colour"); if ($dir == $HORIZONTAL) { for my $i (0..length($word)-1) { @@ -177,6 +172,17 @@ sub _mark_occupied { return; } +sub _unfilled { + my ($self) = @_; + + for my $row (@{$self->_grid_status}) { + for my $cell (@$row) { + return 1 if $cell != 0; + } + } + return 0; +} + sub _put_letter_at { my ($self,$letter,$x,$y,$colour) = @_; @@ -189,17 +195,17 @@ sub _find_colour_for { # let's be easy if ($dir == $HORIZONTAL) { - return $self->grid->[$y][$x]==$WHITE ? 1 : 3; + return $self->grid->[$y][$x] eq '*' ? 3 : 1; } else { - return $self->grid->[$y][$x]==$WHITE ? 2 : 4; + return $self->grid->[$y][$x] eq '*' ? 4 : 2; } } sub _find_place_for { my ($self,$word) = @_; - my $dir = int(rand(2)) > 1 ? $HORIZONTAL : $VERTICAL; + my $dir = int(rand(2)) ? $HORIZONTAL : $VERTICAL; my $length = length $word; @@ -214,20 +220,18 @@ sub _find_place_for { @ret = $self->_find_place_horiz($length) unless @ret; } - die "No place for $word" unless @ret; - return @ret; } sub _find_place_horiz { my ($self,$length) = @_; - my $cols = scalar @{$self->grid->[0]}; + my $rows = scalar @{$self->grid}; my $col; - for my $row (0..$cols) { + for my $row (0..$rows-1) { $col = $self->_find_in_row($row,$length); - return ($row,$col,$HORIZONTAL) if defined $col; + return ($col,$row,$HORIZONTAL) if defined $col; } return; } @@ -235,47 +239,69 @@ sub _find_place_horiz { sub _find_place_vert { my ($self,$length) = @_; - my $rows = scalar @{$self->grid}; + my $cols = scalar @{$self->grid->[0]}; my $row; - for my $col (0..$rows) { + for my $col (0..$cols-1) { $row = $self->_find_in_col($col,$length); - return ($row,$col,$VERTICAL) if defined $row; + return ($col,$row,$VERTICAL) if defined $row; } return; } -sub _find_in_row { - my ($self,$row,$length) = @_; +{ +my @symbols=(' ','X','O'); + +sub _do_find { + my ($self,$str,$length) = @_; - my $str = join '',map { $_ ? '*' : ' ' } @{$self->_grid_status->[$row]}; + my ($skip) = ($str =~ m{^ (.*?) (?: X{$length} | O{$length} ) }x); - my ($skip) = ($str =~ m{^ (.*?) (?: \*{$length})}x); + $self->log->debug(defined $skip ? " skip <$skip>" : " nope"); return length($skip) if defined $skip; return; } +sub _find_in_row { + my ($self,$row,$length) = @_; + + my $str = join '',map { $symbols[$_] } @{$self->_grid_status->[$row]}; + + $self->log->debug("row $row = $str"); + + return $self->_do_find($str,$length); +} + sub _find_in_col { my ($self,$col,$length) = @_; - my $str = join '',map { $_->[$col] ? '*' : ' ' } @{$self->_grid_status}; + my $str = join '',map { $symbols[$_->[$col]] } @{$self->_grid_status}; - my ($skip) = ($str =~ m{^ (.*?) (?: \*{$length})}x); + $self->log->debug("col $col = $str"); - return length($skip) if defined $skip; - return; + return $self->_do_find($str,$length); } -sub _unfilled { +sub _log_status { my ($self) = @_; - for my $row (@{$self->_grid_status}) { - for my $cell (@$row) { - return 1 if $cell != 0; + my $str = "\n"; + + my $rows = scalar @{$self->grid}; + + for my $row (0..$rows-1) { + for my $cell (@{$self->_grid_status->[$row]}) { + $str .= $symbols[$cell]; } + $str .= ' '; + for my $cell (@{$self->result->[$row]}) { + $str .= $cell->[1] eq ' ' ? '.' : $cell->[1]; + } + $str .= "\n"; } - return 0; + $self->log->debug($str); +} } 1; diff --git a/lib/TextPrinter.pm b/lib/TextPrinter.pm index 7ef8572..1715959 100644 --- a/lib/TextPrinter.pm +++ b/lib/TextPrinter.pm @@ -1,42 +1,29 @@ package TextPrinter; -use strict; -use warnings; +use Moose; +use namespace::autoclean; use Term::ANSIColor; -my @colours = ( - color('reset'), # filler - ( - map { color($_,'on_white') } - 'blue', 'green', - ), - ( - map { color($_,'on_black') } - 'dark yellow','dark green', - ), -); - sub draw_cell { - my ($cell) = @_; + my ($self,$cell) = @_; - print $colours[$cell->[0]], - $cell->[1]; + die "unimplemented"; } { my $white = color('black','on_white'); my $reset = color('reset'); sub draw_row { - my ($row,$scale)=@_; + my ($self,$row,$scale)=@_; $scale||=1; print $white,' 'x(3*$scale); for my $cell (@$row) { - draw_cell($cell) for 1..$scale; + $self->draw_cell($cell) for 1..$scale; } print $white,' 'x(3*$scale); print $reset,"\n"; } sub draw_empty_row { - my ($row,$scale)=@_; + my ($self,$row,$scale)=@_; $scale||=1; print $white,' 'x((6+@$row)*$scale),$reset,"\n" for 1..(3*$scale); @@ -44,16 +31,16 @@ sub draw_empty_row { } sub draw_whole { - my ($arr,$scale)=@_; + my ($self,$arr,$scale)=@_; $scale||=1; - draw_empty_row($arr->[0],$scale); + $self->draw_empty_row($arr->[0],$scale); for my $row (@$arr) { - draw_row($row,$scale) for 1..$scale; + $self->draw_row($row,$scale) for 1..$scale; } - draw_empty_row($arr->[0],$scale); + $self->draw_empty_row($arr->[0],$scale); } 1; diff --git a/lib/TextPrinter/ColourGrid.pm b/lib/TextPrinter/ColourGrid.pm new file mode 100644 index 0000000..fdb9949 --- /dev/null +++ b/lib/TextPrinter/ColourGrid.pm @@ -0,0 +1,27 @@ +package TextPrinter::ColourGrid; +use Moose; +use namespace::autoclean; +use Term::ANSIColor; + +extends 'TextPrinter'; + +my @colours = ( + color('reset'), # filler + ( + map { color($_,'on_white') } + 'blue', 'green', + ), + ( + map { color($_,'on_black') } + 'dark yellow','dark green', + ), +); + +sub draw_cell { + my ($self,$cell) = @_; + + print $colours[$cell->[0]], + $cell->[1]; +} + +1; diff --git a/lib/TextPrinter/StarGrid.pm b/lib/TextPrinter/StarGrid.pm new file mode 100644 index 0000000..012cf07 --- /dev/null +++ b/lib/TextPrinter/StarGrid.pm @@ -0,0 +1,19 @@ +package TextPrinter::StarGrid; +use Moose; +use namespace::autoclean; +use Term::ANSIColor; + +extends 'TextPrinter'; + +my %colours = ( + '*' => color('white','on_black'), + ' ' => color('black','on_white'), +); + +sub draw_cell { + my ($self,$cell) = @_; + + print $colours{$cell},' '; +} + +1; diff --git a/script/qr-color.pl b/script/qr-color.pl index 45c47ee..0f779a9 100644 --- a/script/qr-color.pl +++ b/script/qr-color.pl @@ -2,24 +2,32 @@ use strict; use warnings; use Text::QRCode; -use TextPrinter; +use TextPrinter::ColourGrid; +use TextPrinter::StarGrid; use GridFiller; use Path::Class; +use Log::Log4perl qw(:easy); +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;;'; +$data = 'x'; my $qr=Text::QRCode->new( - level=>'H', + level=>'L', mode=>'8-bit', ); my $arr=$qr->plot($data); my @words = grep { length($_) > 2 } - file('/usr/share/dict/words')->slurp(chomp=>1); + file('/usr/share/dict/propernames')->slurp(chomp=>1); my $filler=GridFiller->new({words=>\@words,grid=>$arr}); $filler->fill; -TextPrinter::draw_whole($filler->result,1); +TextPrinter::ColourGrid->new->draw_whole($filler->result,1); + +print "\n\n"; + +TextPrinter::StarGrid->new->draw_whole($arr,1); -- cgit v1.2.3