"Jack D." <go*********@hotmail.com> writes:
"Eric McDaniel" <er**@mcdanielhome.com> wrote:
I am trying to read in a bunch of images and manipulate them using
Image::Magick, then display them using Tk::Photo. I would like to do this
without creating a temp file for each image, since there can be quite a few
of them.
However, I can't make Tk::Photo understand the data returned by
Image::Magick's ImageToBlob() function.
use Mime::Base64;
[...] my $photo = $main->Photo('img', -format=>'GIF', -data=>encode_base64($blob) );
[...] You have to convert the data to base64 format for Tk to recognize it.
Ah man, thanks much for the answer (not to mention the timely question
from Eric). I was just struggling with that issue myself. The
documentation for Tk::Photo leaves much to be desired.
Anyway, now I've got a "baby xv" script working, that re-scales large
images to fit the screen (something noticeably lacking in "ee" and
it's competitors in the free/open software world). It's a little
slow as written, but it least it works:
#!/usr/bin/perl -w
# tk_show_jpeg -
do**@kzsu.stanford.edu
# Fri Sep 19 01:10:21 2003
# Simple image viewer, using Perl/Tk and ImageMagick
# This is a baby "xv": an image viewer that re-scales to fit the screen.
use strict;
use Tk;
use Tk::JPEG;
use Image::Magick;
use MIME::Base64;
my ($image_file, $mw, $screen_width, $screen_height);
my ($image_mag, $image_tk, $r, $blob);
my ($tempfile);
my ($img_height, $img_width, $new_height, $new_width, $geom);
$image_file = shift;
$mw = MainWindow->new;
$mw->title($image_file);
# Get screen dimensions
$screen_width = $mw ->screenwidth(); # 1024
$screen_height = $mw ->screenheight(); # 768
$screen_height -= 30; # allow slack for title bars, etc.
# Bind q key to quit
$mw->bind("<Key-q>", [sub{$mw->destroy}, Ev('K')]);
# Read in file into imagemagick
$image_mag = Image::Magick->new;
$r = $image_mag->Read("$image_file");
warn "$r" if "$r";
# Scale down $image_mag if necessary
($img_height, $img_width) = $image_mag->Get('height', 'width');
$new_height = $img_height; # "New" sizes default to the old
$new_width = $img_width;
if ($img_height > $screen_height) {
$new_height = $screen_height;
}
if ($img_width > $screen_width) {
$new_width = $screen_width;
}
$geom = $new_width . 'x' . $new_height;
$r = $image_mag->Scale(geometry=>$geom);
warn "$r" if "$r";
# Transfer image from ImageMagick to Perl/Tk
$blob = ( $image_mag->ImageToBlob(magick=>'jpg') )[0];
$image_tk = $mw->Photo('img', -format=>'jpeg', -data=>encode_base64($blob) );
# (I *gather* that that first argument 'img' is an "imageName"
# mentioned in some places in the docs, but not explained well.)
$mw->Label(-image => $image_tk)->pack(-side=>'left');
$mw->update;
MainLoop;