package Imager::QRCode::Fancy;
use 5.010;
use strict;
use warnings;
use Data::QRCode;
use Carp;
use List::AllUtils qw(min);
use Imager;
use Types::Standard qw(Dict InstanceOf ArrayRef CodeRef Optional HashRef is_ArrayRef is_CodeRef);
use Types::Common::Numeric qw(PositiveNum);
use Types::Path::Tiny qw(Path);
use Type::Params qw(compile);
use Type::Utils qw(enum union);
use namespace::clean;
sub make {
state $check = compile(Dict[
qr_code => InstanceOf['Data::QRCode'],
image => Optional[union[
InstanceOf['Imager'],
ArrayRef[InstanceOf['Imager']],
]],
size => Optional[PositiveNum],
colormap => Optional[HashRef],
module => Optional[union[
enum[qw(box circle)],
CodeRef,
]],
dot_scale => Optional[PositiveNum],
]);
my ($arg) = $check->(@_);
my $qr = $arg->{qr_code};
my @images = is_ArrayRef($arg->{image}) ? @{$arg->{image}}
: defined($arg->{image}) ? $arg->{image}
: ();
if (not $arg->{size} and not @images) {
croak 'I need a target size, or some images to overlay';
}
my $size = $arg->{size} || min($images[0]->getwidth,$images[0]->getheight);
state $module_map = {
box => \&draw_box,
circle => \&draw_circle,
};
my $module = is_CodeRef($arg->{module}) ? $arg->{module}
: $module_map->{$arg->{module}||'box'};
my $colormap = {
empty => 'white',
data => 'black',
format => 'black',
version => 'black',
timing => 'black',
alignment => 'black',
finder => 'black',
misc => 'black',
%{ $arg->{colormap} || {} },
};
my $dot_scale = $arg->{dot_scale} || 1/3;
my $data_size = $qr->width;
$size -= ($size % $data_size);
my $scale = $size / $data_size;
my $back_image = qr_image($qr,$size,$module,$colormap);
return $back_image unless @images;
my $front_image = qr_dots_image($qr,$size,$dot_scale,$module,$colormap);
my @ret_images;
for my $image (@images) {
my $target = Imager->new(xsize=>$size,ysize=>$size);
$target->paste(src => $back_image);
$target->compose(src => $image);
$target->compose(src => $front_image);
push @ret_images, $target;
}
if (@ret_images > 1) {
return \@ret_images;
}
else {
return $ret_images[0];
}
}
sub qr_image {
my ($qr,$size,$module,$colormap) = @_;
my $data_size = $qr->width;
my $scale = $size / $data_size;
my $image = Imager->new(xsize=>$size,ysize=>$size);
$image->box(filled=>1,color=>'white');
for my $dx (0..$data_size-1) {
for my $dy (0..$data_size-1) {
my $dp = $qr->data_at($dx,$dy);
$module->(
image => $image,
bounding_box($dx,$dy,$scale),
color => Imager::Color->new(datapoint2color($dp,$colormap)),
);
}
}
return $image;
}
sub qr_dots_image {
my ($qr,$size,$dot_scale,$module,$colormap) = @_;
my $data_size = $qr->width;
my $scale = $size / $data_size;
my $image = Imager->new(xsize=>$size,ysize=>$size,model=>'rgba');
$image->box(filled=>1,color=>[0,0,0,0]);
for my $dx (0..$data_size-1) {
for my $dy (0..$data_size-1) {
my $dp = $qr->data_at($dx,$dy);
my @box = $dp->{in_data}
? dot_in_bounding_box($dx,$dy,$scale,$dot_scale)
: bounding_box($dx,$dy,$scale);
$module->(
image => $image,
@box,
color => Imager::Color->new(datapoint2color($dp,$colormap)),
);
}
}
return $image;
}
sub datapoint2color {
my ($dp,$colormap) = @_;
return $colormap->{empty} unless $dp->{color};
for my $k (qw(format version timing alignment finder misc data)) {
next unless $dp->{"in_$k"};
if (my $v = $colormap->{$k}) {
return $v;
}
}
return $colormap->{misc};
}
sub bounding_box {
my ($x,$y,$size) = @_;
return (
xmin => $x*$size, ymin => $y*$size,
xmax => $x*$size+$size-1, ymax => $y*$size+$size-1,
);
}
sub dot_in_bounding_box {
my ($x,$y,$size,$dot_scale) = @_;
my $dot_size = int($size*$dot_scale);
my $dot_offset = int(($size-$dot_size)/2);
return (
xmin => $x*$size+$dot_offset, ymin => $y*$size+$dot_offset,
xmax => $x*$size+$size-$dot_offset, ymax => $y*$size+$size-$dot_offset,
);
}
sub draw_box {
my (%args) = @_;
$args{image}->box(
%args,
filled => 1,
);
}
sub draw_circle {
my (%args) = @_;
my $cx = int($args{xmax}+$args{xmin})/2;
my $cy = int($args{ymax}+$args{ymin})/2;
my $radius = min(
$args{xmax}-$cx,
$args{ymax}-$cy,
$cx-$args{xmin},
$cy-$args{ymin},
);
$args{image}->circle(
x => $cx, y => $cy,
r => $radius,
color => $args{color},
filled => 1,
);
}
1;
