#!/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}{ $col } ); $tiles{'g'}{$row}{$col} = encode_base64( $tiles{'g'}{$row}{ $col } ); $tiles{'y'}{$row}{$col} = encode_base64( $tiles{'y'}{$row}{ $col } ); $tiles{'r'}{$row}{$col} = encode_base64( $tiles{'r'}{$row}{ $col } ); $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 versions ); $canvas->bind( $tiles{$row}{$col}, '', 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}, '', 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}, '', 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}, '', 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}, '', 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;