Updated jan 07,2007. I wrote this under an older version of Imager, but newer versions have "tightened up the ship", and this script failed because of cropping size problems. (I inadvertently tried to crop from where there was no image :-) )Anyways, some minor changes fixed this, and it has been tested with Perl5.8.8 and Imager-0.55
Hi, this snippet builds on my snippet at Tk ImageMap
This version adds "clickable color zones", done by shading the tiles with a red or green tint. screenshot
Left click=>green; Right click=>red; Both click=>clear.
It could be useful for identifying "hot spots" on map.
#!/usr/bin/perl
use warnings;
use strict;
use Imager;
use Tk;
use Tk::JPEG;
use MIME::Base64;
my %tiles;
my $file = shift || die "need jpg 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();
my $height = $image->getheight();
print "width->$width height->$height\n";
my $mw = MainWindow->new;
$mw->geometry('+100+100' );
my $canvas = $mw->Scrolled(
'Canvas',
-bg => 'grey',
-width => $width,
-height => $height,
)->pack(-expand=>1,-fill=>'both');
$mw->Button(
-text => 'Exit',
-command => sub {
Tk::exit;
}
)->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{'c'}{$row}{ $col }
);
my $imagered = $imageout->copy();
my $imageyel = $imageout->copy();
my @map = map { int( $_ / 2 ) } 0 .. 255;
$imageout->map( red => \@map ); #green tint
$imageout->write(
type => 'jpeg',
data => \$tiles{'g'}{$row}{ $col }
);
$imageyel->map( blue => \@map ); #yellow tint
$imageyel->write(
type => 'jpeg',
data => \$tiles{'y'}{$row}{ $col }
);
$imagered->map( green => \@map ); #red tint
$imagered->write(
type => 'jpeg',
data => \$tiles{'r'}{$row}{ $col }
);
#or warn $imageout->errstr;
$tiles{'c'}{$row}{$col} = encode_base64( $tiles{'c'}{$row}{ $c
+ol } );
$tiles{'g'}{$row}{$col} = encode_base64( $tiles{'g'}{$row}{ $c
+ol } );
$tiles{'y'}{$row}{$col} = encode_base64( $tiles{'y'}{$row}{ $c
+ol } );
$tiles{'r'}{$row}{$col} = encode_base64( $tiles{'r'}{$row}{ $c
+ol } );
$tiles{$row}{$col} = $canvas->createImage(
$col * $x, $row * $y,
-image => $mw->Photo( -data => $tiles{'c'}{$row}{$col} ),
-anchor => 'nw',
);
$tiles{'rect'}{$row}{$col} = $canvas->createRectangle(
$col * $x, $row * $y, $col * $x + $x, $row * $y + $y,
-width => 0,
-outline => 'black',
-state => 'disabled' #didn't need this in earlier versio
+ns
);
$canvas->bind(
$tiles{$row}{$col},
'<Enter>',
sub {
if ( defined $tiles{'set'}{$row}{$col} ) {
print "Entered $row $col\n";
return;
}
else {
$canvas->itemconfigure( $tiles{$row}{$col},
-image =>
$mw->Photo( -data => $tiles{'y'}{$row}{ $col
+ } ), );
$canvas->itemconfigure(
$tiles{'rect'}{$row}{$col},
-outline => "yellow",
-width => 2
);
print "Entered $row $col\n";
}
}
);
$canvas->bind(
$tiles{$row}{$col},
'<Button-1>',
sub {
$canvas->itemconfigure( $tiles{$row}{$col},
-image => $mw->Photo( -data => $tiles{'g'}{$row}{
+$col } ), );
$tiles{'set'}{$row}{$col} = 'g';
$canvas->itemconfigure(
$tiles{'rect'}{$row}{$col},
-outline => "green",
-width => 2
);
}
);
$canvas->bind(
$tiles{$row}{$col},
'<Button-3>',
sub {
$canvas->itemconfigure( $tiles{$row}{$col},
-image =>$mw->Photo( -data => $tiles{'r'}{$row}{ $
+col } ), );
$tiles{'set'}{$row}{$col} = 'r';
$canvas->itemconfigure(
$tiles{'rect'}{$row}{$col},
-outline => "red",
-width => 2
);
}
);
$canvas->bind(
$tiles{$row}{$col},
'<Button-2>',
sub {
$canvas->itemconfigure( $tiles{$row}{$col},
-image =>$mw->Photo( -data => $tiles{'c'}{$row}{ $
+col } ), );
$tiles{'set'}{$row}{$col} = undef;
$canvas->itemconfigure(
$tiles{'rect'}{$row}{$col},
-outline => "yellow",
-width => 2
);
}
);
$canvas->bind(
$tiles{$row}{$col},
'<Leave>',
sub {
if ( defined $tiles{'set'}{$row}{$col} ) { return }
else {
$canvas->itemconfigure( $tiles{$row}{$col},
-image =>$mw->Photo( -data => $tiles{'c'}{$row
+}{ $col } ), );
$canvas->itemconfigure(
$tiles{'rect'}{$row}{$col},
-outline => 'black',
-state => 'disabled',
-width => 0,
);
}
}
);
$canvas->update;
}
}
undef $image;
MainLoop;