Added a representation of the transformations matrix.

User can update transformations parameters.

1 files changed, 174 insertions, 32 deletions

diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm
index 6cdd53d..204bb36 100644
--- a/Perl/Zinc/Debug.pm
+++ b/Perl/Zinc/Debug.pm
@@ -1112,72 +1112,167 @@ sub showtransfoparams {
 
     my ($label, $zinc, $item) = @_;
     my @m = $zinc->tget($item);
-    my ($xt, $yt, $xsc, $ysc, $a, $xsk) = $zinc->tget($item, 'all');
+    my ($m00, $m01, $m10, $m11, $m20, $m21) = @m; ;
+    my ($xt, $yt, $xsc, $ysc, $a, $xsk, $ysk) = $zinc->tget($item, 'all');
+    # bug zinc 
+    $ysk = 0 unless defined $ysk;
+    for ($m00, $m01, $m10, $m11, $m20, $m21, $xt, $yt, $xsc, $ysc, $a, $xsk, $ysk) {
+	$_ = sprintf("%.2f", $_) if /^-?\d+\.\d/;
+    }
     $transfo_tl{$item}->destroy if Tk::Exists($transfo_tl{$item});
     $transfo_tl{$item} = $control_tl->Toplevel();
     $transfo_tl{$item}->transient($result_tl{$label})
 	if Tk::Exists($result_tl{$label});
     my $title = "Transformations of item $item";
     $transfo_tl{$item}->title($title);
-    my $r = 0;
-    my $c = 0;
+    my $bgcolor = 'ivory';
     my $fm1 = $transfo_tl{$item}->Frame()->pack(-side => 'top',
 						-padx => 20,
-						-pady => 20,
-						);
-    my $fm2 = $transfo_tl{$item}->Frame()->pack(-side => 'top',
-						-padx => 20,
-						-pady => 20,
+						-pady => 10,
+						-expand => 1,
+						-fill => 'x',
 						);
+    # set transformation to ident
+    my $btn = $fm1->Button(-text => "Show item with transformation\nset to identity",
+			   -bg => $bgcolor,
+			   )->pack(-side => 'top', -padx => 5, -pady => 10);
+    $btn->bind('<1>', [\&showtransfo, $zinc, $item, 0]);
+    $btn->bind('<2>', [\&showtransfo, $zinc, $item, 1]);
+    $btn->bind('<3>', [\&showtransfo, $zinc, $item, 2]);
+    
+    my $fm11 = $fm1->Frame()->pack(-side => 'left',
+				   -padx => 20,
+				   );
+
+    my ($set_cb, $reset_cb, $upd_cb);
+    
+    # matrix
+    my $r = 0;
+    my $c = 0;
+    $fm11->Label(-text => 'matrix', -relief => 'ridge', -bg => $bgcolor)
+	->grid(-row => $r++, -columnspan => 2,
+	       -ipady => 5, -ipadx => 5, -sticky => 'nswe');
+    $fm11->Label(-textvariable => \$m00, -relief => 'ridge')
+	->grid(-row => $r, -column => $c,
+	       -ipady => 5, -ipadx => 5, -sticky => 'nswe');
+    $fm11->Label(-textvariable => \$m01, -relief => 'ridge')
+	->grid(-row => $r++, -column => $c+1,
+	       -ipady => 5, -ipadx => 5, -sticky => 'nswe');
+    $fm11->Label(-textvariable => \$m10, -relief => 'ridge')
+	->grid(-row => $r, -column => $c,
+	       -ipady => 5, -ipadx => 5, -sticky => 'nswe');
+    $fm11->Label(-textvariable => \$m11, -relief => 'ridge')
+	->grid(-row => $r++, -column => $c+1,
+	       -ipady => 5, -ipadx => 5, -sticky => 'nswe');
+    $fm11->Label(-textvariable => \$m20, -relief => 'ridge')
+	->grid(-row => $r, -column => $c,
+	       -ipady => 5, -ipadx => 5, -sticky => 'nswe');
+    $fm11->Label(-textvariable => \$m21, -relief => 'ridge')
+	->grid(-row => $r++, -column => $c+1,
+	       -ipady => 5, -ipadx => 5, -sticky => 'nswe');
+    
+
+
+    my $fm12 = $fm1->Frame()->pack(-side => 'left',
+				   -padx => 20,
+				   );
+    my ($e_xt, $e_yt, $e_xsc, $e_ysc, $e_a, $e_xsk, $e_ysk);
+
     # translate params
-    $fm1->Label(-text => 'translate', -relief => 'ridge')
+    $r = 0;
+    $c = 0;    
+    $fm12->Label(-text => 'translate', -relief => 'ridge', -bg => $bgcolor)
 	->grid(-row => $r, -column => $c++,
 	       -ipady => 5, -ipadx => 5, -sticky => 'nswe');
-    $fm1->Label(-text => $xt, -relief => 'ridge')
-	->grid(-row => $r, -column => $c++,
+
+    $upd_cb = sub {
+	($m00, $m01, $m10, $m11, $m20, $m21) = $zinc->tget($item);
+	for ($m00, $m01, $m10, $m11, $m20, $m21) {
+	    $_ = sprintf("%.2f", $_) if /^-?\d+\.\d/;
+	}
+    };
+    $reset_cb = sub {
+	$zinc->tset($item, @m);
+	$zinc->translate($item, $e_xt, $e_yt);
+	$zinc->rotate($item, $e_a);
+	$zinc->scale($item, $e_xsc, $e_ysc);
+	$zinc->skew($item, $e_xsk, $e_ysk);
+	&$upd_cb;
+    };
+    $set_cb = sub {
+	$zinc->tset($item, $m00, $m01, $m10, $m11, $m20, $m21);
+	$zinc->translate($item, $e_xt, $e_yt);
+	&$upd_cb;
+    };
+    &entrytransfo($fm12, $item, $zinc, 'xt', $xt, \$e_xt, 4, $set_cb, $reset_cb)
+    	->grid(-row => $r, -column => $c++,
 	       -ipady => 5, -ipadx => 5, -sticky => 'nswe');
-    $fm1->Label(-text => $yt, -relief => 'ridge')
+    
+    &entrytransfo($fm12, $item, $zinc, 'yt', $yt, \$e_yt, 4, $set_cb, $reset_cb)
 	->grid(-row => $r++, -column => $c++,
 	       -ipady => 5, -ipadx => 5, -sticky => 'nswe');
-    $c = 0;
+    
     # rotate params
-    $fm1->Label(-text => 'rotate', -relief => 'ridge')
+    $c = 0;
+    $fm12->Label(-text => 'rotate', -relief => 'ridge', -bg => $bgcolor)
 	->grid(-row => $r, -column => $c++,
 	       -ipady => 5, -ipadx => 5, -sticky => 'nswe');
-    $fm1->Label(-text => $a, -relief => 'ridge')
+
+    $set_cb = sub {
+	$zinc->tset($item, $m00, $m01, $m10, $m11, $m20, $m21);
+	$zinc->rotate($item, $e_a);
+	&$upd_cb;
+    };
+    &entrytransfo($fm12, $item, $zinc, 'a', $a, \$e_a, 4, $set_cb, $reset_cb)
 	->grid(-row => $r++, -column => $c++,
 	       -ipady => 5, -ipadx => 5, -sticky => 'nswe');
-    $c = 0;
+
     # scale params
-    $fm1->Label(-text => 'scale', -relief => 'ridge')
+    $c = 0;
+    $fm12->Label(-text => 'scale', -relief => 'ridge', -bg => $bgcolor)
 	->grid(-row => $r, -column => $c++,
 	       -ipady => 5, -ipadx => 5, -sticky => 'nswe');
-    $fm1->Label(-text => $xsc, -relief => 'ridge')
+    $set_cb = sub {
+	$zinc->tset($item, $m00, $m01, $m10, $m11, $m20, $m21);
+	$zinc->scale($item, $e_xsc, $e_ysc);
+	&$upd_cb;
+    };
+
+    &entrytransfo($fm12, $item, $zinc, 'xsc', $xsc, \$e_xsc, 4, $set_cb, $reset_cb)
 	->grid(-row => $r, -column => $c++,
 	       -ipady => 5, -ipadx => 5, -sticky => 'nswe');
-    $fm1->Label(-text => $ysc, -relief => 'ridge')
+    &entrytransfo($fm12, $item, $zinc, 'ysc', $ysc, \$e_ysc, 4, $set_cb, $reset_cb)
 	->grid(-row => $r++, -column => $c++,
 	       -ipady => 5, -ipadx => 5, -sticky => 'nswe');
-    $c = 0;
+    
     # skew params
-    $fm1->Label(-text => 'skew', -relief => 'ridge')
+    $c = 0;
+    $fm12->Label(-text => 'skew', -relief => 'ridge', -bg => $bgcolor)
 	->grid(-row => $r, -column => $c++,
 	       -ipady => 5, -ipadx => 5, -sticky => 'nswe');
-    $fm1->Label(-text => $xsk, -relief => 'ridge')
+    $set_cb = sub {
+	$zinc->tset($item, $m00, $m01, $m10, $m11, $m20, $m21);
+	$zinc->skew($item, $e_xsk, $e_ysk);
+	&$upd_cb;
+    };
+    
+    &entrytransfo($fm12, $item, $zinc, 'xsk', $xsk, \$e_xsk, 4, $set_cb, $reset_cb)
+	->grid(-row => $r, -column => $c++,
+	       -ipady => 5, -ipadx => 5, -sticky => 'nswe');
+    &entrytransfo($fm12, $item, $zinc, 'ysk', $ysk, \$e_ysk, 4, $set_cb, $reset_cb)
 	->grid(-row => $r++, -column => $c++,
 	       -ipady => 5, -ipadx => 5, -sticky => 'nswe');
 
-   
-    my $btn = $fm2->Button(-text => 'treset',
-		)->pack(-side => 'left', -padx => 40, -pady => 10);
-    $btn->bind('<1>', [\&showtransfo, $zinc, $item, 0]);
-    $btn->bind('<2>', [\&showtransfo, $zinc, $item, 1]);
-    $btn->bind('<3>', [\&showtransfo, $zinc, $item, 2]);
+
+    my $fm2 = $transfo_tl{$item}->Frame()->pack(-side => 'top',
+						-padx => 20,
+						-pady => 0,
+						);
     $fm2->Button(-text => 'Close',
 		-command => sub {
 		    $transfo_tl{$item}->destroy;
 		    delete $transfo_tl{$item};
-		})->pack(-side => 'left', -padx => 40, -pady => 10);
+		})->pack(-side => 'top', -padx => 40, -pady => 20);
     
     
     
@@ -1221,6 +1316,7 @@ sub showresult {
 					      -height => 200,
 					      -width => 1024,
 					      );
+    &wheelmousebindings($result_fm);
     my $fm2 = $result_fm->Frame->pack;
     # attributes display
     &showattributes($zinc, $fm2, $label, \@items);
@@ -2612,7 +2708,7 @@ sub entryoption {
     
     my ($fm, $item, $zinc, $option, $def, $widthmax, $widthmin, $height) = @_;
     my $arrayflag;
-    unless ($def) {
+    unless (defined $def) {
 	my @def = $zinc->itemcget($item, $option);
 	if (@def > 1) {
 	    $arrayflag = 1;
@@ -2643,7 +2739,7 @@ sub entryoption {
     
     $e->insert($i0, $def);
     $e->bind('<Control-z>', sub {
-	return unless $defaultoptions{$item}->{$option};
+	return unless defined $defaultoptions{$item}->{$option};
 	my $bg = $e->cget(-background);
 	$zinc->itemconfigure($item, $option => $defaultoptions{$item}->{$option});
 	$e->delete($i0, 'end');
@@ -2676,6 +2772,51 @@ sub entryoption {
 } # end entryoption
 
 
+sub entrytransfo {
+    
+    my ($fm, $item, $zinc, $attr, $def, $var, $width, $set_cb, $reset_cb) = @_;
+    my $i0;
+    my $e;
+    $e = $fm->Entry(-textvariable => $var);
+    $i0 = 0;
+    my $width = length($def);
+    $e->configure(-width => $width);
+    if ($defaultoptions{$item}->{$attr} and
+	$def ne $defaultoptions{$item}->{$attr}) {
+	$e->configure(-foreground => 'blue');
+    }
+    
+    $e->insert($i0, $def);
+    $e->bind('<Control-z>', sub {
+	return unless defined $defaultoptions{$item}->{$attr};
+	my $bg = $e->cget(-background);
+	$e->delete($i0, 'end');
+	$e->insert($i0, $defaultoptions{$item}->{$attr});
+	$e->configure(-background => 'ivory');
+	$e->after(80, sub {$e->configure(-background => $bg, -foreground => 'black')});
+	&$reset_cb;
+    });
+    $e->bind('<Key-Return>',
+	     sub {my $val = $e->get;
+		  my $bg = $e->cget(-background);
+		  $e->configure(-background => 'ivory');
+		  if ($def ne $val) {
+		      $defaultoptions{$item}->{$attr} = $def
+			  unless $defaultoptions{$item}->{$attr};
+		  }
+		  my $fg = ($val ne $defaultoptions{$item}->{$attr}) ?
+		      'blue' : 'black';
+		  $e->after(80, sub {
+		      $e->configure(-background => $bg, -foreground => $fg);
+		  });
+		  &$set_cb;
+	      });
+
+    return $e;
+
+} # end entrytransfo
+
+
 sub instances {
     
     return @instances;
@@ -2793,7 +2934,8 @@ sub iconify {
 sub wheelmousebindings {
     my $w = shift;
     my $count = shift;
-    my $count = 3 unless $count > 0;
+    $count = 3 unless $count > 0;
+
     $w->bind('<Control-ButtonPress-4>', sub {$w->yview('scroll', -1, 'page')});
     $w->bind('<Shift-ButtonPress-4>', sub {$w->yview('scroll', -1, 'unit')});
     $w->bind('<ButtonPress-4>', sub {$w->yview('scroll', -$count, 'unit')});