From 86eeeb69d8755a23ebee9642db9e1e01457ef2d7 Mon Sep 17 00:00:00 2001 From: dakkar Date: Thu, 10 Nov 2016 13:52:10 +0000 Subject: move example script into examples/ otherwise it gets installed into lib/Data/ --- example/make-image.pl | 102 ++++++++++++++++++++++++++++++++++++++++++++++++++ make-image.pl | 102 -------------------------------------------------- 2 files changed, 102 insertions(+), 102 deletions(-) create mode 100644 example/make-image.pl delete mode 100644 make-image.pl diff --git a/example/make-image.pl b/example/make-image.pl new file mode 100644 index 0000000..659d6ef --- /dev/null +++ b/example/make-image.pl @@ -0,0 +1,102 @@ +#!/usr/bin/env perl +use strict; +use warnings; +use Data::QRCode; +use List::AllUtils qw(min); +use Imager; + +sub datapoint2color { + my ($dp) = @_; + + return 'white' if not $dp->{color}; + return 'black' if $dp->{in_data}; + return 'red' if $dp->{in_format}; + return 'green' if $dp->{in_version}; + return 'blue' if $dp->{in_timing}; + return 'navy' if $dp->{in_alignment}; + return 'web green' if $dp->{in_finder}; + return 'black' if $dp->{in_misc}; +} + +sub centered { + my ($x,$y,$scale) = @_; + my $center_size = int($scale/3); + my $center_min = int(($scale-$center_size)/2); + my $center_max = $scale-$center_min; + return 0 if $x < $center_min; + return 0 if $x > $center_max; + return 0 if $y < $center_min; + return 0 if $y > $center_max; + return 1; +} + +sub overlay_data_to_image { + my ($data,$src_image) = @_; + + $src_image = $src_image->convert(preset=>'addalpha'); + my $size = min($src_image->getwidth,$src_image->getheight); + my $data_size = $data->width; + $size -= ($size % $data_size); + + my $scale = $size / $data_size; + print "scale=$scale\n"; + + my $image = Imager->new(xsize=>$size,ysize=>$size); + + for my $dx (0..$data_size-1) { + for my $dy (0..$data_size-1) { + my $dp = $data->data_at($dx,$dy); + my @data_color = Imager::Color->new(datapoint2color($dp))->rgba; + + if (not $dp->{in_data}) { + $image->box( + xmin => $dx*$scale, ymin => $dy*$scale, + xmax => $dx*$scale+$scale-1, + ymax => $dy*$scale+$scale-1, + filled => 1, + color => \@data_color, + ); + } + else { + for my $x_off (0..$scale-1) { + for my $y_off (0..$scale-1) { + my $img_x = $dx*$scale+$x_off; + my $img_y = $dy*$scale+$y_off; + + my @src_color = $src_image->getpixel(x=>$img_x,y=>$img_y)->rgba; + my $alpha = $src_color[3]/255; + + for my $i (0..2) { + $src_color[$i] = int( + $src_color[$i]*$alpha + + $data_color[$i]*(1-$alpha) + ); + } + my $color = centered($x_off,$y_off,$scale) + ? \@data_color + : [@src_color[0..2]]; + $image->setpixel( + x => $img_x, + y => $img_y, + color => $color, + ); + } + } + } + } + } + + return $image; +} + +my $string = 'simple test string, but a bit long just in case we get a too-small QR code'; +my $data = Data::QRCode->new( + $string,'H', +); + +my $src_img = Imager->new( + file=>'/tmp/faccione.png', +)->scale(scalefactor=>2,qtype=>'mixing'); + +my $img = overlay_data_to_image($data,$src_img); +$img->write(file=>'/tmp/qr.png'); diff --git a/make-image.pl b/make-image.pl deleted file mode 100644 index 659d6ef..0000000 --- a/make-image.pl +++ /dev/null @@ -1,102 +0,0 @@ -#!/usr/bin/env perl -use strict; -use warnings; -use Data::QRCode; -use List::AllUtils qw(min); -use Imager; - -sub datapoint2color { - my ($dp) = @_; - - return 'white' if not $dp->{color}; - return 'black' if $dp->{in_data}; - return 'red' if $dp->{in_format}; - return 'green' if $dp->{in_version}; - return 'blue' if $dp->{in_timing}; - return 'navy' if $dp->{in_alignment}; - return 'web green' if $dp->{in_finder}; - return 'black' if $dp->{in_misc}; -} - -sub centered { - my ($x,$y,$scale) = @_; - my $center_size = int($scale/3); - my $center_min = int(($scale-$center_size)/2); - my $center_max = $scale-$center_min; - return 0 if $x < $center_min; - return 0 if $x > $center_max; - return 0 if $y < $center_min; - return 0 if $y > $center_max; - return 1; -} - -sub overlay_data_to_image { - my ($data,$src_image) = @_; - - $src_image = $src_image->convert(preset=>'addalpha'); - my $size = min($src_image->getwidth,$src_image->getheight); - my $data_size = $data->width; - $size -= ($size % $data_size); - - my $scale = $size / $data_size; - print "scale=$scale\n"; - - my $image = Imager->new(xsize=>$size,ysize=>$size); - - for my $dx (0..$data_size-1) { - for my $dy (0..$data_size-1) { - my $dp = $data->data_at($dx,$dy); - my @data_color = Imager::Color->new(datapoint2color($dp))->rgba; - - if (not $dp->{in_data}) { - $image->box( - xmin => $dx*$scale, ymin => $dy*$scale, - xmax => $dx*$scale+$scale-1, - ymax => $dy*$scale+$scale-1, - filled => 1, - color => \@data_color, - ); - } - else { - for my $x_off (0..$scale-1) { - for my $y_off (0..$scale-1) { - my $img_x = $dx*$scale+$x_off; - my $img_y = $dy*$scale+$y_off; - - my @src_color = $src_image->getpixel(x=>$img_x,y=>$img_y)->rgba; - my $alpha = $src_color[3]/255; - - for my $i (0..2) { - $src_color[$i] = int( - $src_color[$i]*$alpha - + $data_color[$i]*(1-$alpha) - ); - } - my $color = centered($x_off,$y_off,$scale) - ? \@data_color - : [@src_color[0..2]]; - $image->setpixel( - x => $img_x, - y => $img_y, - color => $color, - ); - } - } - } - } - } - - return $image; -} - -my $string = 'simple test string, but a bit long just in case we get a too-small QR code'; -my $data = Data::QRCode->new( - $string,'H', -); - -my $src_img = Imager->new( - file=>'/tmp/faccione.png', -)->scale(scalefactor=>2,qtype=>'mixing'); - -my $img = overlay_data_to_image($data,$src_img); -$img->write(file=>'/tmp/qr.png'); -- cgit v1.2.3