Well, this turned out to be a bit of a pain, but I managed to put together a Perl-Tk script with ImageMagick API, that behaves like what I wanted: imgckdis.pl (code also below). Here is a screenshot:
Note that it can pretty much just display an image in hardcoded 400x400 px (although it may extend for bigger images) - there is no menus, no mouse interaction (scrollwheel zoom) - pretty much nothing :) The script only accepts one command-line argument - a file to be opened; but it can also understand ImageMagick specials like "xc:white" (the ImageMagick portion will even automatically render SVG files, as shown on screenshot).
But one thing it is capable of, is working in single instance mode: the first instance started becomes a "master", and draws the Tk window, and locks the respective terminal. Subsequent instances of the script, realizing the master instance is already started, will simply issue a command to the master to load a new image.
This "issuing a command to 'master'" turned out to be not so easy, as the collection of links below shows (as well as the revision notes in the online vesrion). I thought at first, that using interprocess-communication shared variables would allow me to store a "pointer by reference" to the master; and then allow the subsequent instances to call functions on it. Well, it seems that cannot be done - for one, Perl may discourage that - but even if you hop over all those checks, in the end you get a memory address which is not seen as in shared space, and so one cannot retrieve anything from it. Furthermore, the IPC::Shareable Perl package is possibly "guaranteed" only for integers and strings ?!
Nevertheless, the approach that finally worked is, as hinted, to have the "master" poll for changes in changed variables; and non-master instances to simply change this variable when they are called - and this approach seems to work... However, for a "real" application, one would then have to think of organizing quite a few of these shared variables..
Well, maybe one cannot still zoom and reposition the image, and draw a geometry rectangle - but, at least it's an example that can be demonstrated to be working (at least on Ubuntu) :)...
Hope this helps someone,
Cheers!
The code:
#!/usr/bin/perl
# imgckdis.pl
# http://sdaaubckp.svn.sf.net/viewvc/sdaaubckp/single-scripts/imgckdis.pl
use warnings;
use strict;
use Image::Magick; # sudo apt-get install perlmagick # debian/ubuntu
use Tk;
use MIME::Base64;
use Carp;
use Fcntl ':flock';
use Data::Printer;
use Class::Inspector;
use IPC::Shareable;
my $amMaster = 1;
my $file_read;
open my $self, '<', $0 or die "Couldn't open self: $!";
flock $self, LOCK_EX | LOCK_NB or $amMaster = 0;
if ($amMaster == 1) {
print "We are master single instance as per flock\n";
IPC::Shareable->clean_up_all;
}
if (!$ARGV[0]) {
$file_read = "xc:white";
} else {
$file_read = $ARGV[0];
}
chomp $file_read;
my %options = (
create => 1,
exclusive => 0,
mode => 0644,
destroy => 0,
);
my $glue1 = 'dat1';
my $glue2 = 'dat2';
my $refcount;
my $reffname;
my $lastreffname;
my $refcount_handle = tie $refcount, 'IPC::Shareable', $glue1 , \%options ;
if ($amMaster == 1) {
$refcount = undef;
}
my $reffname_handle = tie $reffname, 'IPC::Shareable', $glue2 , \%options ;
if ($amMaster == 1) {
$reffname = undef;
}
my ($image, $blob, $content, $tkimage, $mw);
if ($amMaster == 1) { # if (not(defined($refcount))) {
# initialize the assigns
$lastreffname = "";
$reffname_handle->shlock(LOCK_SH|LOCK_NB);
$reffname = $file_read; #
$reffname_handle->shunlock();
$refcount_handle->shlock(LOCK_SH|LOCK_NB);
$refcount = 1; #
$refcount_handle->shunlock();
}
# mainly from http://objectmix.com/perl/771215-how-display-image-magick-image-tk-canvas.html
sub generateImageContent() {
#fake a PGM then convert it to gif
$image = Image::Magick->new(
size => "400x400",
);
$image->Read($file_read); #("xc:white");
$image->Draw(
primitive => 'line',
points => "300,100 300,500",
stroke => '#600',
);
# set it as PGM
$image->Set(magick=>'pgm');
#your pgm is loaded here, now change it to gif or whatever
$image->Set(magick=>'gif');
$blob = $image->ImageToBlob();
# Tk wants base64encoded images
$content = encode_base64( $blob ) or die $!;
}
sub loadImageContent() {
#fake a PGM then convert it to gif
$image = Image::Magick->new(
size => "400x400",
);
$image->Read($lastreffname); #("xc:red") for test
# set it as PGM
$image->Set(magick=>'pgm');
#your pgm is loaded here, now change it to gif or whatever
$image->Set(magick=>'gif');
$blob = $image->ImageToBlob();
# Tk wants base64encoded images
$content = encode_base64( $blob ) or die $!;
#~ $tkimage->read($content); # expects filename
$tkimage->put($content); # works!
}
sub CleanupExit() {
# only one remove() passes - the second fails: "Couldn't remove shared memory segment/semaphore set"
(tied $refcount)->remove();
IPC::Shareable->clean_up;
$mw->destroy();
print "Exiting appliction!\n";
exit;
}
sub updateVars() {
if ( not($reffname eq $lastreffname) ) {
print "Change: ", $lastreffname, " -> ", $reffname, "\n";
$lastreffname = $reffname;
loadImageContent();
}
}
if ( not($amMaster == 1) ) {
# simply set the shared variable to cmdarg variable
# (master's updateVars should take care of update)
$reffname_handle->shlock(LOCK_SH|LOCK_NB);
$reffname = $file_read;
$reffname_handle->shunlock();
# and exit now - we don't want a second instance
print "Main instance of this script is already running\n";
croak "Loading new file: $file_read";
}
$mw = MainWindow->new();
$mw->protocol(WM_DELETE_WINDOW => sub { CleanupExit(); } );
generateImageContent();
$tkimage = $mw->Photo(-data => $content);
$mw->Label(-image => $tkimage)->pack(-expand => 1, -fill => 'both');
$mw->Button(-text => 'Quit', -command => sub { CleanupExit(); } )->pack;
# polling function for sharable - 100 ms
$mw->repeat(100, \&updateVars);
MainLoop;
__END__
Relevant links:
