#!/usr/bin/perl # $Id$ # this simple demo has been developped by C. Mertz use Tk; use Tk::Zinc; use strict; package icon_zoom__resize; # for avoiding symbol re-use between different demos 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 needs 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, ); $zinc->add('text', $earth_group, -connecteditem => $earth, -text => "try to zoom/resize the earth!", -color => "white", -composescale => 1, -composerotation => 1, ); $zinc->Tk::bind('', [\&press, \&zoom]); $zinc->Tk::bind('', [\&release]); $zinc->Tk::bind('', [\&press, \&rotate]); $zinc->Tk::bind('', [\&release]); $zinc->Tk::bind('', [\&press, \&motion]); $zinc->Tk::bind('', [\&release]); $zinc->Tk::bind('', [\&press, \&modifyAlpha]); $zinc->Tk::bind('', [\&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; $cur_angle = atan2($cur_y, $cur_x); $zinc->Tk::bind('', [$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('', ''); } Tk::MainLoop;