summaryrefslogtreecommitdiff
path: root/make-image.pl
diff options
context:
space:
mode:
authordakkar <dakkar@thenautilus.net>2016-11-10 13:52:10 +0000
committerdakkar <dakkar@thenautilus.net>2016-11-10 13:52:10 +0000
commit86eeeb69d8755a23ebee9642db9e1e01457ef2d7 (patch)
treebacb3baf89bbfa596914650499f5f9e6b740a5be /make-image.pl
parentdon't critic generated files (diff)
downloadData-QRCode-86eeeb69d8755a23ebee9642db9e1e01457ef2d7.tar.gz
Data-QRCode-86eeeb69d8755a23ebee9642db9e1e01457ef2d7.tar.bz2
Data-QRCode-86eeeb69d8755a23ebee9642db9e1e01457ef2d7.zip
move example script into examples/
otherwise it gets installed into lib/Data/
Diffstat (limited to 'make-image.pl')
-rw-r--r--make-image.pl102
1 files changed, 0 insertions, 102 deletions
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');