From d64478e530f58aa687c0b5302c9b3219a08881a2 Mon Sep 17 00:00:00 2001 From: mertz Date: Fri, 24 May 2002 12:12:34 +0000 Subject: Ajout de l'impression par control-shift-Button2 Necessite ImageMagic --- Perl/Zinc/Debug.pm | 93 ++++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 86 insertions(+), 7 deletions(-) diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm index 52e7cc2..0dc6ca0 100644 --- a/Perl/Zinc/Debug.pm +++ b/Perl/Zinc/Debug.pm @@ -25,6 +25,8 @@ use Tk::Dialog; my ($help_tl0, $help_tl, $result_tl, $result_fm, $showitemflag); my ($text_id, $rectangle_id); my ($x0, $y0); +my ($help_print, $imagecounter, $saving) = (0,0); + my $zinc; @@ -35,18 +37,29 @@ sub finditems { for my $opt (keys(%options)) { carp "in ZincDebug module, finditems function, unknown option $opt\n" unless ($opt eq '-color' or $opt eq '-enclosedModBtn' or - $opt eq '-overlapModBtn' ); + $opt eq '-overlapModBtn' or $opt eq '-snapshotModBtn' or + $opt eq '-snapshotVerbosity' or $opt eq '-snapshotBasename' ); } my $color = ($options{-color}) ? $options{-color} : 'sienna'; my $ekb = ($options{-enclosedModBtn}) ? $options{-enclosedModBtn} : ['Control', 3]; my $okb = ($options{-overlapModBtn}) ? $options{-overlapModBtn} : ['Shift', 3]; - carp "in ZincDebug module, finditems function, enclosed search won't work because ". - "both search process use the same sequence [$ekb->[0], $ekb->[1]]\n" if - $ekb->[0] eq $okb->[0] and $ekb->[1] eq $okb->[1]; + my $pkb = ($options{-printModBtn}) ? $options{-printModBtn} : ['Control-Shift', 2]; + my $snapshotVerbosity = (defined $options{-snapshotVerbosity}) ? $options{-snapshotVerbosity} : 1; + my $snapshotBasename = ($options{-snapshotBasename}) ? $options{-snapshotBasename} : "zincsnapshot"; + carp "in ZincDebug module, finditems function, enclosed search and zinc snapshot won't work because ". + "two of them use the same sequence.\n" . + "enclose : [$ekb->[0], $ekb->[1]]\n" . + "overlap [$okb->[0], $okb->[1]]\n" . + "snapshot [$pkb->[0], $pkb->[1]]\n" + + if + ($ekb->[0] eq $okb->[0] and $ekb->[1] eq $okb->[1]) or + ($pkb->[0] eq $okb->[0] and $pkb->[1] eq $okb->[1]) or + ($pkb->[0] eq $ekb->[0] and $pkb->[1] eq $ekb->[1]) ; # # binding for help screen # - $zinc->toplevel->Tk::bind('', [\&showhelp, $ekb, $okb]); + $zinc->toplevel->Tk::bind('', [\&showhelp, $ekb, $okb, $pkb]); # # bindings for Enclosed search # @@ -54,7 +67,7 @@ sub finditems { [\&startrectangle, 'simple', 'Enclosed', $color]); $zinc->Tk::bind("<".$ekb->[0]."-B".$ekb->[1]."-Motion>", \&resizerectangle); $zinc->Tk::bind("<".$ekb->[0]."-B".$ekb->[1]."-ButtonRelease>", - [\&stoprectangle, 'enclosed', 'Enclosed search']); + [\&stoprectangle, 'enclosed', 'Enclosed search']); # # bindings for Overlap search # @@ -63,6 +76,9 @@ sub finditems { $zinc->Tk::bind("<".$okb->[0]."-B".$okb->[1]."-Motion>", \&resizerectangle); $zinc->Tk::bind("<".$okb->[0]."-B".$okb->[1]."-ButtonRelease>", [\&stoprectangle, 'overlapping', 'Overlap search']); + # + # binding for printing a full zinc window + $zinc->Tk::bind("<".$pkb->[0]."-B".$pkb->[1]."-ButtonRelease>", [\&printWindow , $snapshotBasename, $snapshotVerbosity]); } #------------------------------------------------------------------------------------ @@ -274,12 +290,54 @@ sub undohighlightitem { $showitemflag = 0; } +# print a zinc window in png format +sub printWindow { + exit if $saving; + $saving = 1; + my ($zinc,$basename,$verbosity) = @_; + my $id = $zinc->id; + my $filename = $basename . $imagecounter . ".png"; + $imagecounter++; + my $original_cursor = ($zinc->configure(-cursor))[3]; + $zinc->configure(-cursor => 'watch'); + $zinc->update; + my $res = system("import", -window, $id, $filename); + $zinc->configure(-cursor => $original_cursor); + + $saving = 0; + if ($res) { + &showErrorWhilePrinting($res) + } + else { + my $dir = `pwd`; chomp ($dir); + print "ZincDebug: Zinc window snapshot saved in $dir". "/$filename\n" if $verbosity; + } +} + +# display complete help screen +sub showErrorWhilePrinting { + my ($res) = @_; + my $dir = `pwd`; chomp ($dir); + $help_print->destroy if $help_print and Tk::Exists($help_print); + $help_print = $zinc->Dialog(-title => 'Zinc Print info', + -text => + "To acquire a TkZinc window snapshot, you must " . + "have access to the import command, which is ". + "part of imageMagic package\n\n". + "You must also have the rights to write ". + "in the current dir : $dir", + -bitmap => 'warning', + ); + $help_print->after(300, sub {$help_print->grabRelease}); + $help_print->Show(); +} # display complete help screen sub showhelp { - my ($w, $ekb, $okb) = @_; + my ($w, $ekb, $okb, $pkb) = @_; my $eseq = $ekb->[0]."-Button".$ekb->[1]; my $oseq = $okb->[0]."-Button".$okb->[1]; + my $pseq = $pkb->[0]."-Button".$pkb->[1]; $help_tl->destroy if $help_tl and Tk::Exists($help_tl); $help_tl = $zinc->Dialog(-title => 'Zinc Debug info', -text => @@ -289,6 +347,11 @@ sub showhelp { "With <".$eseq."> sequence, create ". "a rectangular area to search items ". "which are enclosed in it.\n\n". + "With <".$pseq."> you can acquire a " . + "snapshot of the full zinc window. ". + "It will be saved in the current directory ". + "with the name zincsnapshot.png ". + "The ImageMagic package must be installed.\n\n". "Strike key to display this help ". "message again.", -bitmap => 'info', @@ -462,6 +525,8 @@ sub startrectangle { sub resizerectangle { my $ev = $zinc->XEvent; my ($x, $y) = ($ev->x, $ev->y); + return unless ($zinc->find('withtag', $rectangle_id)); + $zinc->coords($rectangle_id, 1, 1, [$x, $y]); if ($x < $x0) { if ($y < $y0) { @@ -483,6 +548,8 @@ sub resizerectangle { # stop drawing rectangular area for search sub stoprectangle { my ($widget, $searchtype, $text) = @_; + return unless ($zinc->find('withtag', $rectangle_id)); + my @coords = $zinc->coords($rectangle_id); my @items; for my $item ($zinc->find($searchtype, @coords)) { @@ -541,6 +608,18 @@ Defines input sequence used to process "enclosed" search. Default to ['Control', Defines input sequence used to process "overlap" search. Default to ['Shift', 3]. +=item E<32>E<32>E<32>B<-snapshotModBtn> => [Mod, Btn] + +Defines input sequence used to process a snapshot of the zinc window. Default to ['Control-Shift', 2]. + +=item E<32>E<32>E<32>B<-snapshotVerbosity> => boolean + +Defines if snapshot should print a message on the terminal. Default to true. + +=item E<32>E<32>E<32>B<-snapshotBasename> => "a_string" + +Defines the basename used for the file containing the snaphshot. The filename will be /basename.png Defaulted to zincsnapshot. + =back -- cgit v1.1