Ajout de l'impression par control-shift-Button2 Necessite ImageMagic

1 files 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('<Key-Escape>', [\&showhelp, $ekb, $okb]);
+    $zinc->toplevel->Tk::bind('<Key-Escape>', [\&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<n>.png ".
+			     "The ImageMagic package must be installed.\n\n".
 			     "Strike <Escape> 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 <currentdir>/basename<n>.png Defaulted to zincsnapshot.
+
 
 =back