From 7089c5829069f90418c008f10dfbae53193d59e5 Mon Sep 17 00:00:00 2001 From: mertz Date: Wed, 13 Mar 2002 16:32:52 +0000 Subject: - suppression/inhibition des timers utilis�es dans counter.pl simpleradar.pl et qui ne posent probleme que lorsque ces scripts sont appel�s depuis zinc-demos - modificiation des chemins de chargements des modules externes utilis�s par simpleradar.pl wheelOfFortune.pl --- Perl/demos/Tk/demos/zinc_lib/counter.pl | 12 +- Perl/demos/Tk/demos/zinc_lib/simpleradar.pl | 245 ++----------------------- Perl/demos/Tk/demos/zinc_lib/wheelOfFortune.pl | 2 +- 3 files changed, 23 insertions(+), 236 deletions(-) diff --git a/Perl/demos/Tk/demos/zinc_lib/counter.pl b/Perl/demos/Tk/demos/zinc_lib/counter.pl index a9bd20d..6907fab 100644 --- a/Perl/demos/Tk/demos/zinc_lib/counter.pl +++ b/Perl/demos/Tk/demos/zinc_lib/counter.pl @@ -291,7 +291,16 @@ my $nbtour_unit=2; #-------------------------------- # Timer #--------------------------------- -$zinc->repeat($repeat, [\&refresh]); +my $timer = $zinc->repeat($repeat, [\&refresh]); + +$mw->OnDestroy(\&destroyTimersub ); + +my $timerIsDead = 0; +sub destroyTimersub { + $timerIsDead = 1; + $mw->afterCancel($timer); + # the timer is not really cancelled when using zinc-demos! +} #-------------------------------- # Actions @@ -300,6 +309,7 @@ sub refresh { #-------------------------------- # Rotation de la fleche #--------------------------------- + return if $timerIsDead; # the timer is still running when using zinc-demos! $zinc->rotate("$fleche",$angle,$centre[0],$centre[1]); $nb+=1; if (($nb==$nb_tot)&&($angle==$PI/$pas)) diff --git a/Perl/demos/Tk/demos/zinc_lib/simpleradar.pl b/Perl/demos/Tk/demos/zinc_lib/simpleradar.pl index adc3a69..3ac1dfe 100644 --- a/Perl/demos/Tk/demos/zinc_lib/simpleradar.pl +++ b/Perl/demos/Tk/demos/zinc_lib/simpleradar.pl @@ -8,7 +8,7 @@ use Tk::Zinc; use strict; # to find the SimpleRadarControls module. Should be included in this source file! -use lib Tk->findINC('demos/zinc_lib'); +use lib Tk->findINC('demos/zinc_pm'); use SimpleRadarControls; # to find some maps needed by these demo @@ -447,12 +447,21 @@ new SimpleRadarControls($zinc); ################################################### # Rafraichissement des pistes ################################################### -$zinc->repeat($delay, [\&refresh, $zinc]); +my $timer = $zinc->repeat($delay, [\&refresh, $zinc]); +$mw->OnDestroy(\&destroyTimersub ); # this is + +my $timerIsDead = 0; +sub destroyTimersub { + $timerIsDead = 1; + $mw->afterCancel($timer); + # the timer is not really cancelled when using zinc-demos! +} sub refresh { my ($zinc) = @_; return if $pause; + return if $timerIsDead; foreach my $t (values(%tracks)) { $t->{'x'} += $t->{'vx'} * $rate; $t->{'y'} += $t->{'vy'} * $rate; @@ -473,235 +482,3 @@ sub borders { MainLoop(); -# $Id$ -# This simple radar has been initially developped by P. Lecoanet -# It has been adapted by C. Mertz for demo purpose. -# Thanks to Dunnigan,Jack [Edm]" for a bug correction. - -package SimpleRadarControls; - -$top = 1; - -sub new { - my $proto = shift; - my $type = ref($proto) || $proto; - my ($zinc) = @_; - my $self = {}; - - $self{'zinc'} = $zinc; - $self{'cur_x'} = 0; - $self{'cur_y'} = 0; - $self{'cur_angle'} = 0; - $self{'corner_x'} = 0; - $self{'corner_y'} = 0; - - $self{'tlbbox'} = $zinc->add('group', $top, - -sensitive => 0, -visible => 0, - -tags => 'currentbbox'); - $zinc->add('rectangle', $self{'tlbbox'}, [-3, -3, +3, +3]); - $self{'trbbox'} = $zinc->add('group', $top, - -sensitive => 0, -visible => 0, - -tags => 'currentbbox'); - $zinc->add('rectangle', $self{'trbbox'}, [-3, -3, +3, +3]); - $self{'blbbox'} = $zinc->add('group', $top, - -sensitive => 0, -visible => 0, - -tags => 'currentbbox'); - $zinc->add('rectangle', $self{'blbbox'}, [-3, -3, +3, +3]); - $self{'brbbox'} = $zinc->add('group', $top, - -sensitive => 0, -visible => 0, - -tags => 'currentbbox'); - $zinc->add('rectangle', $self{'brbbox'}, [-3, -3, +3, +3]); - $zinc->add('rectangle', $top, [0, 0, 1, 1], - -linecolor => 'red', -tags => 'lasso', - -visible => 0, -sensitive => 0); - - $zinc->Tk::bind('', [\&start_lasso, $self]); - $zinc->Tk::bind('', [\&fin_lasso, $self]); - - $zinc->Tk::bind('', sub { my $ev = $zinc->XEvent(); - my @closest = $zinc->find('closest', - $ev->x, $ev->y); - print "at point=$closest[0]\n" }); - - $zinc->Tk::bind('', [\&press, $self, \&motion]); - $zinc->Tk::bind('', [\&release, $self]); - - $zinc->Tk::bind('', [\&press, $self, \&zoom]); - $zinc->Tk::bind('', [\&release, $self]); - - $zinc->Tk::bind('', [\&press, $self, \&rotate]); - $zinc->Tk::bind('', [\&release, $self]); - - $zinc->Tk::bind('current', '', [\&showbox, $self]); - $zinc->Tk::bind('current', '', [\&hidebox, $self]); - - bless ($self, $type); - return $self; -} - -# -# Controls for the window transform. -# -sub press { - my ($zinc, $self, $action) = @_; - my $ev = $zinc->XEvent(); - my $lx = $ev->x; - my $ly = $ev->y; - - $self->{'cur_x'} = $lx; - $self->{'cur_y'} = $ly; - $self->{'cur_angle'} = atan2($ly, $lx); - $zinc->Tk::bind('', [$action, $self]); -} - -sub motion { - my ($zinc, $self) = @_; - my $ev = $zinc->XEvent(); - my $lx = $ev->x; - my $ly = $ev->y; - my @it; - my @res; - - @it = $zinc->find('withtag', 'controls'); - if (scalar(@it) == 0) { - return; - } - @res = $zinc->transform($it[0], [$lx, $ly, $self->{'cur_x'}, $self->{'cur_y'}]); - $zinc->translate('controls', $res[0] - $res[2], $res[1] - $res[3]); - $self->{'cur_x'} = $lx; - $self->{'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 > $self->{'cur_x'}) { - $maxx = $lx; - } else { - $maxx = $self->{'cur_x'}; - } - if ($ly > $self->{'cur_y'}) { - $maxy = $ly - } else { - $maxy = $self->{'cur_y'}; - } - #avoid illegal division by zero - return unless ($maxx && $maxy); - - $sx = 1.0 + ($lx - $self->{'cur_x'})/$maxx; - $sy = 1.0 + ($ly - $self->{'cur_y'})/$maxy; - $self->{'cur_x'} = $lx if ($lx>0); # avoid ZnTransfoDecompose :singular matrix - $self->{'cur_y'} = $ly if ($ly>0); # error messages - $zinc->scale('controls', $sx, $sy); -# $main::scale *= $sx; -# main::update_transform($zinc); -} - -sub rotate { - my ($zinc, $self) = @_; - my $ev = $zinc->XEvent(); - my $lx = $ev->x; - my $ly = $ev->y; - my $langle; - - $langle = atan2($ly, $lx); - $zinc->rotate('controls', -($langle - $self->{'cur_angle'})); - $self->{'cur_angle'} = $langle; -} - -sub release { - my ($zinc, $self) = @_; - $zinc->Tk::bind('', ''); -} - -sub start_lasso { - my ($zinc, $self) = @_; - my $ev = $zinc->XEvent(); - my $lx = $ev->x; - my $ly = $ev->y; - my @coords; - - $self->{'cur_x'} = $lx; - $self->{'cur_y'} = $ly; - $self->{'corner_x'} = $lx; - $self->{'corner_y'} = $ly; - @coords = $zinc->transform($top, [$lx, $ly]); - $zinc->coords('lasso', [$coords[0], $coords[1], $coords[0], $coords[1]]); - $zinc->itemconfigure('lasso', -visible => 1); - $zinc->raise('lasso'); - $zinc->Tk::bind('', [\&lasso, $self]); -} - -sub lasso { - my ($zinc, $self) = @_; - my $ev = $zinc->XEvent(); - my $lx = $ev->x; - my $ly = $ev->y; - my @coords; - - $self->{'corner_x'} = $lx; - $self->{'corner_y'} = $ly; - @coords = $zinc->transform($top, [$self->{'cur_x'}, $self->{'cur_y'}, $lx, $ly]); - $zinc->coords('lasso', [$coords[0], $coords[1], $coords[2], $coords[3]]); -} - -sub fin_lasso { - my ($zinc, $self) = @_; - my $enclosed; - my $overlapping; - - $zinc->Tk::bind('', ''); - $zinc->itemconfigure('lasso', -visible => 0); - $enclosed = join(', ', $zinc->find('enclosed', - $self->{'cur_x'}, $self->{'cur_y'}, - $self->{'corner_x'}, $self->{'corner_y'})); - $overlapping = join(', ', $zinc->find('overlapping', - $self->{'cur_x'}, $self->{'cur_y'}, - $self->{'corner_x'}, $self->{'corner_y'})); - print "enclosed=$enclosed, overlapping=$overlapping\n"; -} - -sub showbox { - my ($zinc, $self) = @_; - my @coords; - my @it; - - if (! $zinc->hastag('current', 'currentbbox')) { - @it = $zinc->find('withtag', 'current'); - if (scalar(@it) == 0) { - return; - } - @coords = $zinc->transform($top, $zinc->bbox('current')); - - $zinc->coords($self->{'tlbbox'}, [$coords[0], $coords[1]]); - $zinc->coords($self->{'trbbox'}, [$coords[2], $coords[1]]); - $zinc->coords($self->{'brbbox'}, [$coords[2], $coords[3]]); - $zinc->coords($self->{'blbbox'}, [$coords[0], $coords[3]]); - $zinc->itemconfigure('currentbbox', -visible => 1); - } -} - -sub hidebox { - my ($zinc, $self) = @_; - my $ev = $zinc->XEvent(); - my $lx = $ev->x; - my $ly = $ev->y; - my @next; - - @next = $zinc->find('closest', $lx, $ly); - if ((scalar(@next) == 0) || - ! $zinc->hastag($next[0], 'currentbbox') || - $zinc->hastag('current', 'currentbbox')) { - $zinc->itemconfigure('currentbbox', -visible => 0); - } -} - - - diff --git a/Perl/demos/Tk/demos/zinc_lib/wheelOfFortune.pl b/Perl/demos/Tk/demos/zinc_lib/wheelOfFortune.pl index 733f598..fd343bd 100644 --- a/Perl/demos/Tk/demos/zinc_lib/wheelOfFortune.pl +++ b/Perl/demos/Tk/demos/zinc_lib/wheelOfFortune.pl @@ -12,7 +12,7 @@ use Tk; use Tk::Zinc; # to find the Wheel class. Should be included in this source file! -use lib Tk->findINC('demos/widget_lib'); +use lib Tk->findINC('demos/zinc_pm'); # my Wheel object class too. See below... use Wheel; -- cgit v1.1