まあ、これは少し面倒であることが判明しましたが、私が望んでいたように動作する ImageMagick API を使用して Perl-Tk スクリプトをまとめることができました: imgckdis.pl (コードも下にあります)。スクリーンショットは次のとおりです。
ハードコードされた 400x400 ピクセルで画像を表示できることに注意してください (ただし、より大きな画像には拡張される可能性があります) - メニューもマウス操作 (スクロールホイールのズーム) もありません - ほとんど何もありません :) スクリプトは 1 つのコマンドラインしか受け入れません引数 - 開くファイル。ただし、「xc:white」などの ImageMagick スペシャルも理解できます (スクリーンショットに示すように、ImageMagick 部分は SVG ファイルを自動的にレンダリングします)。
しかし、できることの 1 つは、シングル インスタンス モードで動作することです。開始された最初のインスタンスが「マスター」になり、Tk ウィンドウを描画し、それぞれの端末をロックします。スクリプトの後続のインスタンスは、マスター インスタンスが既に開始されていることを認識すると、新しいイメージをロードするコマンドをマスターに発行するだけです。
この「'master' にコマンドを発行する」ことは、以下のリンク集 (およびオンラインvesrionのリビジョン ノート) が示すように、それほど簡単ではないことが判明しました。最初は、プロセス間通信共有変数を使用すると、マスターへの「参照によるポインター」を保存できると思いました。その後、後続のインスタンスがその関数を呼び出すことができるようにします。まあ、それはできないようです - 1つには、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__
関連リンク:
