From f36ec6adae6deb32336e5826f948433289542ba6 Mon Sep 17 00:00:00 2001 From: dakkar Date: Tue, 23 Nov 2010 22:06:51 +0000 Subject: filler! --- lib/GridFiller.pm | 281 +++++++++++++++++++++++++++++++++++++++++++++++++++++ lib/TextPrinter.pm | 46 +++------ script/qr-color.pl | 11 ++- 3 files changed, 304 insertions(+), 34 deletions(-) create mode 100644 lib/GridFiller.pm diff --git a/lib/GridFiller.pm b/lib/GridFiller.pm new file mode 100644 index 0000000..d036094 --- /dev/null +++ b/lib/GridFiller.pm @@ -0,0 +1,281 @@ +package GridFiller; +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; + +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 '*' + } @$_ + ] + } @$_ + ] + }; + +has words => ( + isa => ArrayRef[Str], + required => 1, + is => 'ro', +); + +has grid => ( + isa => GridT, + required => 1, + is => 'ro', +); + +has _words_to_use => ( + isa => ArrayRef[Str], + traits => ['Array'], + handles => { + _has_next_word => 'count', + _get_next_word => 'shift', + }, + is => 'rw', + lazy_build => 1, + clearer => '_reset_words_to_use', +); + +sub _build__words_to_use { + # clone initial word list + return [ shuffle uniq @{shift->words} ]; +} + +has leftover_words => ( + isa => ArrayRef[Str], + is => 'ro', + traits => ['Array'], + handles => { + _mark_leftover => 'push', + }, + clearer => '_reset_leftovers', +); + +has _grid_status => ( + isa => ArrayRef[ArrayRef[Int]], + is => 'rw', + lazy_build => 1, + clearer => '_reset_grid_status', +); + +sub _build__grid_status { + return [ + map { + [ + map { + $_ ? $BLACK : $WHITE + } @$_ + ] + } @{shift->grid} + ]; +} + +subtype Char, + as Str, + where { length($_) == 1 }; + +subtype LetterCell, + as Tuple[Int,Char]; + +has result => ( + isa => ArrayRef[ArrayRef[LetterCell]], + is => 'ro', + lazy_build => 1, + clearer => '_reset_result', +); + +sub _build_result { + return [ + map { + [ + map { + [0,' '], + } @$_ + ] + } @{shift->grid} + ]; +} + +sub _reset { + my ($self) = @_; + + $self->_reset_words_to_use(); + $self->_reset_grid_status(); + $self->_reset_leftovers(); + $self->_reset_result(); +} + +sub fill { + my ($self) = @_; + + $self->_reset(); + + while ($self->_unfilled() && $self->_has_next_word()) { + my $word = $self->_get_next_word(); + + my ($x,$y,$dir); + + try { ($x,$y,$dir) = $self->_find_place_for($word) } + catch { + $self->_mark_leftover($word); + next; + }; + + $self->_place_word_at($word,$x,$y,$dir); + } +} + +sub _place_word_at { + my ($self, $word, $x, $y, $dir) = @_; + + my $colour = $self->_find_colour_for($x,$y); + + if ($dir == $HORIZONTAL) { + for my $i (0..length($word)-1) { + $self->_mark_occupied($x+$i,$y); + $self->_put_letter_at(substr($word,$i,1), + $x+$i,$y, + $colour); + } + } + elsif ($dir == $VERTICAL) { + for my $i (0..length($word)-1) { + $self->_mark_occupied($x,$y+$i); + $self->_put_letter_at(substr($word,$i,1), + $x,$y+$i, + $colour); + } + } + else { + croak "What dir $dir?"; + } +} + +sub _mark_occupied { + my ($self,$x,$y) = @_; + + $self->_grid_status->[$y][$x]=0; + return; +} + +sub _put_letter_at { + my ($self,$letter,$x,$y,$colour) = @_; + + $self->result()->[$y][$x]=[$colour,$letter]; + return; +} + +sub _find_colour_for { + my ($self,$x,$y,$dir) = @_; + + # let's be easy + if ($dir == $HORIZONTAL) { + return $self->grid->[$y][$x]==$WHITE ? 1 : 3; + } + else { + return $self->grid->[$y][$x]==$WHITE ? 2 : 4; + } +} + +sub _find_place_for { + my ($self,$word) = @_; + + my $dir = int(rand(2)) > 1 ? $HORIZONTAL : $VERTICAL; + + my $length = length $word; + + my @ret; + + if ($dir == $HORIZONTAL) { + @ret = $self->_find_place_horiz($length); + @ret = $self->_find_place_vert($length) unless @ret; + } + else { + @ret = $self->_find_place_vert($length); + @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 $col; + + for my $row (0..$cols) { + $col = $self->_find_in_row($row,$length); + return ($row,$col,$HORIZONTAL) if defined $col; + } + return; +} + +sub _find_place_vert { + my ($self,$length) = @_; + + my $rows = scalar @{$self->grid}; + my $row; + + for my $col (0..$rows) { + $row = $self->_find_in_col($col,$length); + return ($row,$col,$VERTICAL) if defined $row; + } + return; +} + +sub _find_in_row { + my ($self,$row,$length) = @_; + + my $str = join '',map { $_ ? '*' : ' ' } @{$self->_grid_status->[$row]}; + + my ($skip) = ($str =~ m{^ (.*?) (?: \*{$length})}x); + + return length($skip) if defined $skip; + return; +} + +sub _find_in_col { + my ($self,$col,$length) = @_; + + my $str = join '',map { $_->[$col] ? '*' : ' ' } @{$self->_grid_status}; + + my ($skip) = ($str =~ m{^ (.*?) (?: \*{$length})}x); + + return length($skip) if defined $skip; + return; +} + +sub _unfilled { + my ($self) = @_; + + for my $row (@{$self->_grid_status}) { + for my $cell (@$row) { + return 1 if $cell != 0; + } + } + return 0; +} + +1; diff --git a/lib/TextPrinter.pm b/lib/TextPrinter.pm index d786b86..7ef8572 100644 --- a/lib/TextPrinter.pm +++ b/lib/TextPrinter.pm @@ -3,45 +3,25 @@ use strict; use warnings; use Term::ANSIColor; -{ -my %colours = ( - 'black' => [ - map { color($_,'on_black') } - 'dark yellow','dark green','dark blue' - ], - 'white' => [ +my @colours = ( + color('reset'), # filler + ( map { color($_,'on_white') } - 'green', 'blue', 'yellow' - ], + 'blue', 'green', + ), + ( + map { color($_,'on_black') } + 'dark yellow','dark green', + ), ); -my $strip_length = 0; - -sub rotate { - my ($arr) = @_; - - my $el = shift @$arr; - push @$arr, $el; - return; -} - -sub next_colour { - my ($which) = @_; +sub draw_cell { + my ($cell) = @_; - if ($strip_length < 1) { - $strip_length = 1+int(rand(7)); - rotate($colours{$which}); - } - --$strip_length; - return $colours{$which}->[0]; -} + print $colours[$cell->[0]], + $cell->[1]; } - -sub draw_cell { - print next_colour(shift eq '*' ? 'black' : 'white'), - chr(65+int(rand(26))); -} { my $white = color('black','on_white'); my $reset = color('reset'); diff --git a/script/qr-color.pl b/script/qr-color.pl index ecf7025..45c47ee 100644 --- a/script/qr-color.pl +++ b/script/qr-color.pl @@ -3,6 +3,8 @@ use strict; use warnings; use Text::QRCode; use TextPrinter; +use GridFiller; +use Path::Class; my $data='MECARD:N:Ceccarelli,Gianni;TEL:+447564023056;EMAIL:dakkar@thenautilus.net;URL:http://www.thenautilus.net/contacts/;NICKNAME:dakkar;;'; @@ -13,4 +15,11 @@ my $qr=Text::QRCode->new( my $arr=$qr->plot($data); -TextPrinter::draw_whole($arr,1); +my @words = grep { length($_) > 2 } + file('/usr/share/dict/words')->slurp(chomp=>1); + +my $filler=GridFiller->new({words=>\@words,grid=>$arr}); + +$filler->fill; + +TextPrinter::draw_whole($filler->result,1); -- cgit v1.2.3