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;

=head1 SEE ALSO

https://github.com/sylnsfar/qrcode

http://www.thonky.com/qr-code-tutorial/

=cut

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}; # just in case
}

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;