summaryrefslogtreecommitdiff
path: root/make-image.pl
blob: 659d6efbd93168c9a09c74edb1a8a734b70db491 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
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*$scaleymin => $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(
                            => $img_x,
                            => $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');