#!/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}, '', sub { $canvas->itemconfigure( $tiles{'r'}{$row}{$col}, -outline => "yellow", -width => 5 ); print "Entered $row $col\n"; } ); $canvas->bind( $tiles{$row}{$col}, '', sub { $canvas->itemconfigure( $tiles{'r'}{$row}{$col}, -outline => "grey", -state => 'disabled', -width => 0, ); } ); $canvas->update; } } MainLoop;