The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!/usr/bin/env perl

use Test::Most;
use Test::Warnings;

use aliased 'Imager::Bing::MapLayer::Tile' => 'Tile';

use aliased 'Imager::Bing::MapLayer::Utils' => 'Utils',
    qw/ latlon_to_pixel /;

use File::Temp qw/ tempdir /;
use Imager::Fill;
use Const::Fast;

const my $key => '1202020200032213';

my $cleanup = $ENV{TMP_NO_CLEANUP} ? 0 : 1;

my $tile;

lives_ok {
    $tile = Tile->new(
      quad_key  => $key,
      base_dir  => tempdir( CLEANUP => $cleanup ),
      overwrite => 1,
    );
} "new";


note($tile->base_dir);

is($tile->level, length($key), "level");

is($tile->width, 256, "width");
is($tile->height, 256, "height");

is_deeply( $tile->pixel_origin,
           [
            8393472,
            5577984,
           ],
           "pixel_origin");


is($tile->left, 8393472, "left");
is($tile->top,  5577984, "top");

is($tile->right, 8393472 + $tile->width - 1, "right");
is($tile->bottom, 5577984 + $tile->height - 1, "bottom");

is_deeply( $tile->tile_coords,
           [
            32787,
            21789
           ],
           "tile_coords");


my @latlon = (51.5171, 0.1062); # London

ok(my @pixel = $tile->latlon_to_pixel(@latlon), "latlon_to_pixel");
note(explain \@pixel);

note(explain { map { $_ => $tile->$_ } qw/ top left bottom right / });

{

    # Because of a bug in Imager, we cannot distinguish between an
    # error and no pixels drawn.

    local $TODO = "bug in Imager::Draw->setpixel";

    dies_ok {
        $tile->setpixel( x => $pixel[0], 'y' => $pixel[1], color => 'invalid-color' );
    } "setpixel error";

}

lives_ok {
    $tile->setpixel( x => $pixel[0], 'y' => $pixel[1], color => 'blue' );
} "setpixel";

ok(my $color = $tile->getpixel( x => $pixel[0], 'y' => $pixel[1] ), "getpixel");

note(explain $color);

is_deeply([ $color->rgba ], [ 0, 0, 255, 255 ], "color");

ok(my @colors = $tile->getpixel( x   => [ $pixel[0], $tile->left ],
                                 'y' => [ $pixel[1], $tile->top  ] ), "getpixel (list context)");

note(explain \@colors);

is_deeply([ map { [ $_->rgba ] } @colors ], [ [ 0, 0, 255, 255 ], [ 0, 0, 0, 0 ] ], "colors");

lives_ok {
    $tile->setpixel( x => $tile->left, 'y' => $tile->top, color => 'green' );
} "setpixel top-left";

lives_ok {
    $tile->setpixel( x => $tile->right, 'y' => $tile->bottom, color => 'green' );
} "setpixel bottom-right";

lives_ok {
    $tile->setpixel( x => $tile->right + 1, 'y' => $tile->bottom + 1, color => 'red' );
} "setpixel (out of bounds)";

lives_ok {
    $tile->setpixel( x => $tile->left - 1, 'y' => $tile->top - 1, color => 'red' );
} "setpixel (out of bounds)";

# 51.5171, 0.1062

my @poly = (
    [ 51.48224, -0.03124 ],
    [ 51.52071,  0.123   ],
    [ 51.5143,   0.17931 ],
    [ 51.47582,  0.2026 ],
);

my @pixels = @{ $tile->latlons_to_pixels(\@poly) };
note(explain \@pixels);

lives_ok {
    $tile->polyline( points => \@pixels, color => 'black', aa => 1, );
} "polyline";

# Test for line pixel - this will eventually be overwritten

ok($color =
   $tile->getpixel(
       x   => $tile->left +  10,
       'y' => $tile->top  + 216,
   ), "getpixel");

note(explain $color);

is_deeply([ $color->rgba ], [   0,   0,   0, 255 ], "color");

lives_ok {
    $tile->line( x1 => $tile->left + 50, y1 => $tile->top - 50,
                 x2 => $tile->left + 40, y2 => $tile->bottom + 50,
                 color => 'darkgreen' );
} "line";


lives_ok {

    my $fill = Imager::Fill->new( solid => 'yellow', combine => 'normal' );

    $tile->polygon(
        x    => [ $tile->left, $tile->left, $tile->left + 100 ],
        'y'  => [ $tile->top,  $tile->top + 100, $tile->top + 100 ],
        fill => Imager::Fill->new(
            type    => "opacity",
            other   => $fill,
            opacity => 0.25,
        ),
    );

} "polygon";

ok($color =
   $tile->getpixel(
       x   => $tile->left + 5,
       'y' => $tile->top  + 10,
   ), "getpixel");

note(explain $color);

is_deeply([ $color->rgba ], [ 255, 255,   0,  64 ], "color");

my $crop;

lives_ok {

    $crop = $tile->crop(
        left   => $tile->left,
        top    => $tile->top,
        width  => 100,
        height => 100,
    );

} "crop";

ok($crop, "cropped image");
is($crop->getwidth, 100, "crop width");
is($crop->getheight, 100, "crop height");

lives_ok {

    $tile->compose(
      src  => $crop,
      left => $tile->left + 100,
      top  => $tile->top  + 100,
    );

} "compose";

ok($color =
   $tile->getpixel(
       x   => $tile->left + 105,
       'y' => $tile->top  + 110,
   ), "getpixel");

note(explain $color);

is_deeply([ $color->rgba ], [ 255, 255,   0,  64 ], "color");

# TODO - test that compose doesn't overwrite some of the content
# (e.g. black line)

lives_ok {

    $tile->paste(
      src  => $crop,
      left => $tile->left,
      top  => $tile->top  + 100,
    );

} "paste";

ok($color =
   $tile->getpixel(
       x   => $tile->left + 5,
       'y' => $tile->top  + 110,
   ), "getpixel");

note(explain $color);

is_deeply([ $color->rgba ], [ 255, 255,   0,  64 ], "color");

# Test that paste overwrites some of the content (e.g. black line)

ok($color =
   $tile->getpixel(
       x   => $tile->left +  62,
       'y' => $tile->top  + 195,
   ), "getpixel");

note(explain $color);

is_deeply([ $color->rgba ], [ 255, 255,   0,  64 ], "color");

lives_ok {

    my $fill = Imager::Fill->new( solid => 'blue', combine => 'normal' );

    $tile->box(
        box  => [ $tile->right - 50, $tile->top + 50,
                  $tile->right,      $tile->top + 80 ],
        fill => Imager::Fill->new(
            type    => "opacity",
            other   => $fill,
            opacity => 0.55,
        ),
        filled => 0,
        color  => 'blue',
    );

} "box";

ok($color =
   $tile->getpixel(
       x   => $tile->left + 210,
       'y' => $tile->top  +  60,
   ), "getpixel");

note(explain $color);

is_deeply([ $color->rgba ], [   0,   0, 255, 140 ], "color");

lives_ok {

    my $fill = Imager::Fill->new( solid => 'orange', combine => 'normal' );

    $tile->circle(
        x      => $tile->left + 128,
        'y'    => $tile->top  + 128,
        r      => 20,
        filled => 1,
        fill => Imager::Fill->new(
            type    => "opacity",
            other   => $fill,
            opacity => 0.60,
        ),

    );

} "circle";

note($tile->filename);

done_testing;