Tk-Zinc
view release on metacpan or search on metacpan
Zinc/Debug.pm view on Meta::CPAN
} else {
$status->configure(-text => "No such tagOrId ($searchEntryValue{$zinc})");
}
}]);
} # end searchentry
#---------------------------------------------------------------------------
#
# Functions related to transformations parameters
#
#---------------------------------------------------------------------------
sub showtransfoparams {
my ($label, $zinc, $item) = @_;
my @m = $zinc->tget($item);
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 $bgcolor = 'ivory';
my $fm1 = $transfo_tl{$item}->Frame()->pack(-side => 'top',
-padx => 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);
$balloonhelp->attach($btn,-balloonmsg =>
"Click and maintain to show the transformation \n".
"animation. Use btn1, btn2 or btn3 to select the\n".
"best background color for a good visibility. ");
$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);
$set_cb = sub {
$zinc->treset($item);
$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);
($m00, $m01, $m10, $m11, $m20, $m21) = $zinc->tget($item);
for ($m00, $m01, $m10, $m11, $m20, $m21) {
$_ = sprintf("%.2f", $_) if /^-?\d+\.\d/;
}
};
# translate params
$r = 0;
$c = 0;
$fm12->Label(-text => 'translate', -relief => 'ridge', -bg => $bgcolor)
->grid(-row => $r, -column => $c++,
-ipady => 5, -ipadx => 5, -sticky => 'nswe');
&entrytransfo($fm12, $item, $zinc, 'xt', $xt, \$e_xt, 4, $set_cb)
->grid(-row => $r, -column => $c++,
-ipady => 5, -ipadx => 5, -sticky => 'nswe');
&entrytransfo($fm12, $item, $zinc, 'yt', $yt, \$e_yt, 4, $set_cb)
->grid(-row => $r++, -column => $c++,
-ipady => 5, -ipadx => 5, -sticky => 'nswe');
# rotate params
$c = 0;
$fm12->Label(-text => 'rotate', -relief => 'ridge', -bg => $bgcolor)
->grid(-row => $r, -column => $c++,
-ipady => 5, -ipadx => 5, -sticky => 'nswe');
Zinc/Debug.pm view on Meta::CPAN
# scrolled pane creation
$result_fm = $result_tl{$label}->Scrolled('Pane',
-scrollbars => 'osoe',
-height => 200,
-width => 1024,
);
&wheelmousebindings($result_fm);
my $fm2 = $result_fm->Frame->pack;
# attributes display
&showattributes($zinc, $fm2, $label, \@items);
$result_fm->update;
$fm2->update;
my $width = $fm2->width + 10;
$width = $screenwidth if $width > $screenwidth;
$result_fm->configure(-width => $width);
$result_fm->pack(-padx => 10, -pady => 10,
-ipadx => 10,
-fill => 'both',
-expand => 1,
);
} # end showresult
# display table containing additionnal options/values
sub showalloptions {
my ($label, $zinc, $item, $fmp) = @_;
$alloptions_tl{$item}->destroy if Tk::Exists($alloptions_tl{$item});
$alloptions_tl{$item} = $control_tl->Toplevel();
$alloptions_tl{$item}->transient($result_tl{$label})
if Tk::Exists($result_tl{$label});
my $tl = $alloptions_tl{$item};
my $title = "All options of item $item";
$tl->title($title);
$tl->geometry('-10+0');
# footer
#----------------
$tl->Button(-text => 'Close',
-command => sub {
$alloptions_tl{$item}->destroy;
delete $alloptions_tl{$item};
})->pack(-side => 'bottom');
# option scrolled frame
#-----------------------
my $fm = $tl->Scrolled('Pane',
-scrollbars => 'oe',
-height => 500,
)->pack(-padx => 10, -pady => 10,
-ipadx => 10,
-expand => 1,
-fill => 'both');
my $bgcolor = 'ivory';
my $i = 1;
$fm->Label(-text => $title, -background => $bgcolor,
-fg => 'sienna', -relief => 'ridge')
->grid(-row => $i++, -column => 1, -ipady => 5, -ipadx => 5,
-columnspan => 2, -sticky => 'nswe') if $label;
$fm->Label(-text => 'Option', -background => $bgcolor, -relief => 'ridge')
->grid(-row => $i, -column => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
$fm->Label(-text => 'Value', -background => $bgcolor, -relief => 'ridge')
->grid(-row => $i++, -column => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
my @options = $zinc->itemconfigure($item);
for my $elem (@options) {
my ($option, $type, $value) = (@$elem)[0,1,4];
$fm->Label(-text => $option, -relief => 'ridge')
->grid(-row => $i, -column => 1,
-ipady => 5, -ipadx => 5, -sticky => 'nswe');
if ($option eq '-tags') {
&entryoption($fm, $item, $zinc, $option,
join("\n", @$value), 30, 30, scalar @$value)
->grid(-row => $i, -column => 2, -ipady => 5,
-ipadx => 5, -sticky => 'nswe');
} else {
&entryoption($fm, $item, $zinc, $option, undef, 50, 25)
->grid(-row => $i, -column => 2, -ipady => 5,
-ipadx => 5, -sticky => 'nswe');
}
$i++;
}
} # end showalloptions
# display device coords table
sub showdevicecoords {
my ($label, $zinc, $item) = @_;
&showcoords($label, $zinc, $item, 1);
} # end showdevicecoords
# display coords table
sub showcoords {
my ($label, $zinc, $item, $deviceflag) = @_;
my $bgcolor = 'ivory';
my $bgcolor2 = 'gray75';
$coords_tl{$item}->destroy if Tk::Exists($coords_tl{$item}) and not $deviceflag;
$coords_tl{$item} = $control_tl->Toplevel();
$coords_tl{$item}->transient($result_tl{$label}) if Tk::Exists($result_tl{$label});
my $title = "Zinc Debug";
if ($deviceflag) {
$title .= " - Coords of item $item";
} else {
$title .= " - Device coords of item $item";
}
$coords_tl{$item}->title($title);
$coords_tl{$item}->geometry('+10+20');
my $coords_fm0 = $coords_tl{$item}->Frame()->pack(-side => 'bottom');
$coords_fm0->Button(-text => 'Help',
-command => [\&showHelpAboutCoords, $zinc]
)->pack(-side => 'left', -padx => 40, -pady => 10);
$coords_fm0->Button(-text => 'Close',
-command => sub {
&hidecontour($zinc);
Zinc/Debug.pm view on Meta::CPAN
$lab1->bind('<3>', [\&showcontourpts, $zinc, 'red', $item, $contour[$i],
$deviceflag]);
$lab1->bind('<ButtonRelease-1>', sub { &hidecontour($zinc); });
$lab1->bind('<ButtonRelease-2>', sub { &hidecontour($zinc); });
$lab1->bind('<ButtonRelease-3>', sub { &hidecontour($zinc); });
$col++;
my @lab;
for my $coords (@{$contour[$i]}) {
if ($col > 10) {
$col = 2;
$row++;
}
$coords->[0] =~ s/\.(\d\d).*/\.$1/;
$coords->[1] =~ s/\.(\d\d).*/\.$1/;
my @opt;
if (defined $coords->[2]) {
@opt = (-text => sprintf('%s, %s, %s', @$coords),
-underline => length(join(',', @$coords)) + 1,
);
} else {
@opt = (-text => sprintf('%s, %s', @{$coords}[0,1]));
}
push (@lab, $coords_fm->Label(@opt,
-width => 15,
-relief => 'ridge')->grid(-row => $row,
-ipadx => 5,
-ipady => 5,
-column => $col++,
-sticky => 'nswe'));
}
$row++ if (@{$contour[$i]} < 10);
$row++;
my $j = 0;
for (@lab) {
$_->bind('<1>', [\&showcontourpt, $zinc, 'black',
$item, $j, $deviceflag, \@lab, @{$contour[$i]}]);
$_->bind('<2>', [\&showcontourpt, $zinc, 'white',
$item, $j, $deviceflag, \@lab, @{$contour[$i]}]);
$_->bind('<3>', [\&showcontourpt, $zinc, 'red',
$item, $j, $deviceflag, \@lab, @{$contour[$i]}]);
$j++;
}
}
} # end showcoords
# display in a grid the values of most important attributes
sub showattributes {
my ($zinc, $fm, $label, $items, $expandTagsFlag) = @_;
$expandTagsFlag = 1;
&getsize($zinc);
my $bgcolor = 'ivory';
my $i = 1;
$fm->Label(-text => $label, -background => $bgcolor,
-fg => 'sienna', -relief => 'ridge')
->grid(-row => $i++, -column => 0, -ipady => 0, -ipadx => 5,
-columnspan => 7, -sticky => 'nswe') if $label;
&showbanner($fm, $i++);
$i++;
for my $item (@$items) {
my $c = 0;
my $type = $zinc->type($item);
# id
my $idbtn =
$fm->Button(-text => $item,
-foreground => 'sienna'
)->grid(-row => $i, -column => $c++, -sticky => 'nswe',
-ipadx => 5);
$idbtn->bind('<1>', [\&highlightitem, $zinc, $item, 0]);
$idbtn->bind('<2>', [\&highlightitem, $zinc, $item, 1]);
$idbtn->bind('<3>', [\&highlightitem, $zinc, $item, 2]);
$balloonhelp->attach($idbtn,-balloonmsg =>
"Click and maintain to show the item. \n".
"Use btn1, btn2 or btn3 to select the best\n".
"background color for a good visibility. ");
# type
if ($type eq 'group') {
my $gbtn =
$fm->Button(-text => $type,
-command => sub {
my @items = $zinc->find('withtag', $item.".");
&showresult("Content of group $item", $zinc, @items);
});
$gbtn->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 5);
$balloonhelp->attach($gbtn,-balloonmsg =>
"Click to display the group's content.");
} else {
$fm->Label(-text => $type, -relief => 'ridge')
->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 5);
}
# parent group
my $group = $zinc->group($item);
my $pgbtn =
$fm->Button(-text => $group,
-command => [\&showresult,
"Attributes of group $group (parent of $item)",
$zinc, $group]);
$pgbtn->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 5);
$balloonhelp->attach($pgbtn,-balloonmsg =>
"Click to display the parent group's attributes.");
# priority
&entryoption($fm, $item, $zinc, -priority)
->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 2);
# sensitiveness
&entryoption($fm, $item, $zinc, -sensitive)
->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 2);
# visibility
&entryoption($fm, $item, $zinc, -visible)
->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 2);
# other options
$fm->Button(-text => 'show',
-command => [\&showalloptions, $label, $zinc, $item, $fm])
->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 5);
# transformations
my $tlabel = 'yes';
my ($xt, $yt, $xsc, $ysc, $a, $xsk) = $zinc->tget($item, 'all');
( run in 0.405 second using v1.01-cache-2.11-cpan-f56aa216473 )