#!/usr/bin/perl
use warnings;
use strict;
use Imager;
use Tk;
use Tk::JPEG;
use MIME::Base64;

my %tiles;
my $file = shift || die "need filename\n"; 
my $tempname = $file;
$tempname =~ s/^(.+)(\.\w+)$/$1/;
print "$tempname\n";

#set tile size adjustment 
my $x = 50; #must be same 
my $y = 50;

my $image = Imager->new();
$image->open( file => $file, type => 'jpeg' ) or die $image->errstr();
my $width  = $image->getwidth() + 40;
my $height = $image->getheight() + 40;
print "width->$width   height->$height\n";

my $mw = MainWindow->new;
$mw->geometry( $width . 'x' . $height . '+100+100' );
my $canvas = $mw->Scrolled(
    'Canvas',
    -bg     => 'grey',
    -width  => $width,
    -height => $height
)->pack;

my $rows = int( $height / $y + 1 ) - 1;    #make it 0 based 
my $cols = int( $width / $x + 1 ) - 1;
print "rows->$rows  cols->$cols\n";

foreach my $row ( 0 .. $rows ) {
    foreach my $col ( 0 .. $cols ) {
        my $imageout =
          Imager->new( xsize => $x, ysize => $y, type => 'direct' );

        $imageout = $image->crop(
            left   => $col * $y,
            right  => $col * $y + $y,
            top    => $row * $x,
            bottom => $row * $x + $x
        );

        $imageout->write( type => 'jpeg', data => \$tiles{$row}{$col} 
+);

        #or warn $imageout->errstr; 

        $tiles{$row}{$col} = encode_base64( $tiles{$row}{$col} );

        my $image = $mw->Photo( -data => $tiles{$row}{$col} );
        $tiles{$row}{$col} = $canvas->createImage(
            $col * $x, $row * $y,
            -image  => $image,
            -anchor => 'nw',
        );

        $tiles{'r'}{$row}{$col} = $canvas->createRectangle(
            $col * $x, $row * $y, $col * $x + $x, $row * $y + $y,
            -width   => 0,
            -outline => 'grey',
        );

        $canvas->bind(
            $tiles{$row}{$col},
            '<Enter>',
            sub {
                $canvas->itemconfigure(
                    $tiles{'r'}{$row}{$col},
                    -outline => "yellow",
                    -width   => 5
                );
                print "Entered $row $col\n";
            }
        );

        $canvas->bind(
            $tiles{$row}{$col},
            '<Leave>',
            sub {
                $canvas->itemconfigure(
                    $tiles{'r'}{$row}{$col},
                    -outline => "grey",
                    -state   => 'disabled',
                    -width   => 0,
                );
            }
        );
        $canvas->update;
    }
}
MainLoop;
[download]