好吧，结果证明这有点痛苦，但我设法用 ImageMagick API 组合了一个 Perl-Tk 脚本，它的行为就像我想要的那样：imgckdis.pl（代码也在下面）。这是一个屏幕截图：
请注意，它几乎可以仅显示硬编码 400x400 像素的图像（尽管它可能会扩展到更大的图像） - 没有菜单，没有鼠标交互（滚轮缩放） - 几乎没有 :) 脚本只接受一个命令行参数 - 要打开的文件；但它也可以理解 ImageMagick 的特殊功能，例如“xc:white”（ImageMagick 部分甚至会自动渲染 SVG 文件，如屏幕截图所示）。
但它能够做的一件事是在单实例模式下工作：启动的第一个实例成为“主”，并绘制 Tk 窗口，并锁定相应的终端。脚本的后续实例，意识到主实例已经启动，将简单地向主实例发出命令以加载新图像。
正如下面的链接集合所示（以及在线版本中的修订说明），这种“向 'master' 发出命令”并不是那么容易。起初我想，使用进程间通信共享变量可以让我存储一个“引用指针”到主服务器；然后允许后续实例在其上调用函数。好吧，这似乎是做不到的——一方面，Perl 可能不鼓励这样做——但即使你跳过所有这些检查，最后你会得到一个在共享空间中看不到的内存地址，因此无法检索任何东西从中。此外，IPC::ShareablePerl 包可能只对整数和字符串“保证”？！
尽管如此，最终奏效的方法是，正如所暗示的那样，让“主”轮询改变变量的变化。和非主实例在它们被调用时简单地更改这个变量 - 这种方法似乎有效......但是，对于“真实”应用程序，然后必须考虑组织相当多的这些共享变量......
好吧，也许人们仍然无法缩放和重新定位图像，并绘制几何矩形 - 但是，至少这是一个可以证明可以正常工作的示例（至少在 Ubuntu 上）:)......
希望这对某人有帮助，
干杯！
编码：
#!/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__
相关链接：
