diff options
Diffstat (limited to 'Perl/demos')
| -rw-r--r-- | Perl/demos/Tk/demos/zinc_lib/icon_zoom_resize.pl | 153 | ||||
| -rw-r--r-- | Perl/demos/zinc-demos | 3 |
2 files changed, 155 insertions, 1 deletions
diff --git a/Perl/demos/Tk/demos/zinc_lib/icon_zoom_resize.pl b/Perl/demos/Tk/demos/zinc_lib/icon_zoom_resize.pl new file mode 100644 index 0000000..15f2004 --- /dev/null +++ b/Perl/demos/Tk/demos/zinc_lib/icon_zoom_resize.pl @@ -0,0 +1,153 @@ +#!/usr/bin/perl +# $Id$ +# this simple demo has been developped by C. Mertz <mertz@cena.fr> + +use Tk; +use Tk::Zinc; +use strict; + + +my $defaultfont = '-adobe-helvetica-bold-r-normal-*-140-*-*-*-*-*-*'; +my $mw = MainWindow->new(); +my $text = $mw->Scrolled(qw/Text -relief sunken -borderwidth 2 -setgrid true + -height 7 -scrollbars ''/); +$text->pack(qw/-expand yes -fill both/); + +$text->insert('0.0', + 'This demo must used openGL for rescaling/rotating the icon + You can transform this earth gif image with your mouse: + Drag-Button 1 for zooming the earth, + Drag-Button 2 for rotating the earth, + Drag-Button 3 for moving the earth, + Shift-Drag-Button 1 for modifying the earth transparency' + ); + +my $zinc = $mw->Zinc(-width => 350, -height => 250, + -render => 1, + -font => "10x20", # usually fonts are sets in resources + # but for this example it is set in the code! + -borderwidth => 3, -relief => 'sunken', + )->pack; + +my $earth_group = $zinc->add('group', 1, ); + +my $image_path = Tk->findINC('demos/images'); +my $image_name = 'earth.gif'; +my $image = $zinc->Photo($image_name, -file => "$image_path/$image_name"); + +my $earth = $zinc->add('icon', $earth_group, + -image => $image, + -composescale => 1, + -composerotation => 1, + ); +my $text = $zinc->add('text', $earth_group, + -connecteditem => $earth, + -text => "try to zoom/resize the earth!", + -color => "white", + -composescale => 1, + -composerotation => 1, + ); + +$zinc->Tk::bind('<ButtonPress-1>', [\&press, \&zoom]); +$zinc->Tk::bind('<ButtonRelease-1>', [\&release]); + +$zinc->Tk::bind('<ButtonPress-2>', [\&press, \&rotate]); +$zinc->Tk::bind('<ButtonRelease-2>', [\&release]); + +$zinc->Tk::bind('<ButtonPress-3>', [\&press, \&motion]); +$zinc->Tk::bind('<ButtonRelease-3>', [\&release]); + + +$zinc->Tk::bind('<Shift-ButtonPress-1>', [\&press, \&modifyAlpha]); +$zinc->Tk::bind('<Shift-ButtonRelease-1>', [\&release]); + + + +# +# Controls for the window transform. +# +my ($cur_x, $cur_y, $cur_angle); +sub press { + my ($zinc, $action) = @_; + my $ev = $zinc->XEvent(); + $cur_x = $ev->x; + $cur_y = $ev->y; + print "$cur_x $cur_y\n"; + $cur_angle = atan2($cur_y, $cur_x); + $zinc->Tk::bind('<Motion>', [$action]); +} + +sub modifyAlpha { + my ($zinc) = @_; + my $ev = $zinc->XEvent(); + my $lx = $ev->x; + my $xrate = $lx / $zinc->cget(-width); + + $xrate = 0 if $xrate < 0; + $xrate = 1 if $xrate > 1; + + my $alpha = $xrate * 100; + + $zinc->itemconfigure($earth_group, -alpha => $alpha); +} + + +sub motion { + my ($zinc) = @_; + my $ev = $zinc->XEvent(); + my $lx = $ev->x; + my $ly = $ev->y; + my @res; + + @res = $zinc->transform($earth_group, [$lx, $ly, $cur_x, $cur_y]); + $zinc->translate($earth_group, $res[0] - $res[2], $res[1] - $res[3]); + $cur_x = $lx; + $cur_y = $ly; +} + +sub zoom { + my ($zinc, $self) = @_; + my $ev = $zinc->XEvent(); + my $lx = $ev->x; + my $ly = $ev->y; + my $maxx; + my $maxy; + my $sx; + my $sy; + + if ($lx > $cur_x) { + $maxx = $lx; + } else { + $maxx = $cur_x; + } + if ($ly > $cur_y) { + $maxy = $ly + } else { + $maxy = $cur_y; + } + return if ($maxx == 0 || $maxy == 0); + $sx = 1.0 + ($lx - $cur_x)/$maxx; + $sy = 1.0 + ($ly - $cur_y)/$maxy; + $cur_x = $lx; + $cur_y = $ly; + $zinc->scale($earth_group, $sx, $sy); +} + +sub rotate { + my ($zinc) = @_; + my $ev = $zinc->XEvent(); + my $lx = $ev->x; + my $ly = $ev->y; + my $langle; + + $langle = atan2($ly, $lx); + $zinc->rotate($earth_group, -($langle - $cur_angle)); + $cur_angle = $langle; +} + +sub release { + my ($zinc) = @_; + $zinc->Tk::bind('<Motion>', ''); +} + +MainLoop; diff --git a/Perl/demos/zinc-demos b/Perl/demos/zinc-demos index a86e323..8016bd6 100644 --- a/Perl/demos/zinc-demos +++ b/Perl/demos/zinc-demos @@ -173,7 +173,8 @@ $T->insert('end', "\n", '', "Transformation\n", 'title'); $T->insert('end', "1. Translating.\n", [qw/demo demo-translation/]); $T->insert('end', "2. Rotating.\n", [qw/demo demo-rotation/]); $T->insert('end', "3. Zooming.\n", [qw/demo demo-zoom/]); -$T->insert('end', "3. Transformation testbed.\n", [qw/demo demo-transforms/]); +$T->insert('end', "4. Transformation testbed.\n", [qw/demo demo-transforms/]); +$T->insert('end', "5. zooming/Rotating icons.\n", [qw/demo icon_zoom_resize/]); $T->insert('end', "\n", '', "Use of openGL\n", 'title'); $T->insert('end', "1. The TkZinc Logo (needs openGL).\n", [qw/demo demo-tkZincLogo/]); |