From ef6fbe15b71f94951a9ccaca1900df78a34b93ec Mon Sep 17 00:00:00 2001 From: etienne Date: Mon, 11 Oct 2004 15:39:34 +0000 Subject: Added a representation of the transformations matrix. User can update transformations parameters. --- Perl/Zinc/Debug.pm | 206 ++++++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 174 insertions(+), 32 deletions(-) (limited to 'Perl') 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('', 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('', 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('', + 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('', sub {$w->yview('scroll', -1, 'page')}); $w->bind('', sub {$w->yview('scroll', -1, 'unit')}); $w->bind('', sub {$w->yview('scroll', -$count, 'unit')}); -- cgit v1.1