From 7714f386b716a895cd612fb31100251df8ca6512 Mon Sep 17 00:00:00 2001 From: lecoanet Date: Wed, 14 Mar 2001 15:02:57 +0000 Subject: D�but de l'�criture de scripts de d�mo en perl. --- sandbox/Controls.pm | 223 ++++++++++++++++++++++++++++++---------------------- 1 file changed, 128 insertions(+), 95 deletions(-) (limited to 'sandbox/Controls.pm') diff --git a/sandbox/Controls.pm b/sandbox/Controls.pm index b432129..55f6b6a 100644 --- a/sandbox/Controls.pm +++ b/sandbox/Controls.pm @@ -1,186 +1,219 @@ -package controls; +package Controls; -$cur_x = 0; -$cur_y = 0; -$cur_angle = 0; -$corner_x = 0; -$corner_y = 0; $top = 1; sub new { - $tlbbox = $zinc->add('group', $top, - -sensitive => 0, -visible => 0, - -tags 'currentbbox'); - $zinc->add('rectangle', $tlbbox, [-3, -3, +3, +3]); - $trbbox = $zinc->add('group', $top, - -sensitive => 0, -visible => 0, - -tags => 'currentbbox'); - $zinc->add('rectangle', $trbbox, [-3, -3, +3, +3]); - $blbbox = $zinc->add('group', $top, - -sensitive => 0, -visible => 0, - -tags => 'currentbbox'); - $zinc->add('rectangle', $blbbox, [-3, -3, +3, +3]); - $brbbox = $zinc->add('group', $top, - -sensitive => 0, -visible => 0, - -tags 'currentbbox'); - $zinc->add('rectangle', $brbbox, [-3, -3, +3, +3]); + 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->bind('', \&start_lasso); - $zinc->bind('', \&fin_lasso); - $zinc->bind('', sub { my @closest = $zinc->find('closest', - $zinc->XEvent->x, - $zinc->XEvent->y); - print "at point=$closest[0]\n" }); - - $zinc->bind('', [\&press, \&motion]); - $zinc->bind('', \&release); + $zinc->Tk::bind('', [\&press, $self, \&motion]); + $zinc->Tk::bind('', [\&release, $self]); - $zinc->bind('', [\&press, \&zoom]); - $zinc->bind('', \&release); + $zinc->Tk::bind('', [\&press, $self, \&zoom]); + $zinc->Tk::bind('', [\&release, $self]); - $zinc->bind('', [\&press, \&rotate]); - $zinc->bind('', \&release); + $zinc->Tk::bind('', [\&press, $self, \&rotate]); + $zinc->Tk::bind('', [\&release, $self]); - $zinc->bind('current', '', \&showbox); - $zinc->bind('current', '', \&hidebox); + $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 ($action) = @_; - my $lx = $zinc->XEvent->x; - my $ly = $zinc->XEvent->y; - - $cur_x $lx; - $cur_y $ly; - $cur_angle = atan2($y, $x); - $zinc->bind('', $action); + 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 $lx = $zinc->XEvent->x; - my $ly = $zinc->XEvent->y; + my ($zinc, $self) = @_; + my $ev = $zinc->XEvent(); + my $lx = $ev->x; + my $ly = $ev->y; my @it; my @res; - @it = $zinc->find('withtag' 'controls'); + @it = $zinc->find('withtag', 'controls'); if (scalar(@it) == 0) { return; } - @res = $zinc->transform($it[0], [$lx, $ly, $cur_x, $cur_y]); + @res = $zinc->transform($it[0], [$lx, $ly, $self->{'cur_x'}, $self->{'cur_y'}]); $zinc->translate('controls', $res[0] - $res[2], $res[1] - $res[3]); - $cur_x = $lx; - $cur_y = $ly; + $self->{'cur_x'} = $lx; + $self->{'cur_y'} = $ly; } sub zoom { - my $lx = $zinc->XEvent->x; - my $ly = $zinc->XEvent->y; + 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) { + if ($lx > $self->{'cur_x'}) { $maxx = $lx; } else { - $maxx = $cur_x + $maxx = $self->{'cur_x'}; } - if ($ly > $cur_y) { + if ($ly > $self->{'cur_y'}) { $maxy = $ly } else { - $maxy = $cur_y + $maxy = $self->{'cur_y'}; } - $sx = 1.0 + ($lx - $cur_x)/$maxx; - $sy = 1.0 + ($ly - $cur_y)/$maxy; - $cur_x = $lx; - $cur_y = $ly; + $sx = 1.0 + ($lx - $self->{'cur_x'})/$maxx; + $sy = 1.0 + ($ly - $self->{'cur_y'})/$maxy; + $self->{'cur_x'} = $lx; + $self->{'cur_y'} = $ly; $zinc->scale('controls', $sx, $sy); +# $main::scale *= $sx; +# main::update_transform($zinc); } sub rotate { - my $lx = $zinc->XEvent->x; - my $ly = $zinc->XEvent->y; + 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 - $cur_angle)); - $cur_angle = $langle; + $zinc->rotate('controls', -($langle - $self->{'cur_angle'})); + $self->{'cur_angle'} = $langle; } sub release { - $zinc->bind('', ''); + my ($zinc, $self) = @_; + $zinc->Tk::bind('', ''); } sub start_lasso { - my $lx = $zinc->XEvent->x; - my $ly = $zinc->XEvent->y; + my ($zinc, $self) = @_; + my $ev = $zinc->XEvent(); + my $lx = $ev->x; + my $ly = $ev->y; my @coords; - $cur_x = $lx; - $cur_y = $ly; - $corner_x = $lx; - $corner_y = $ly; - @coords = $zinc->transform($top, [$x, $y]); + $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->itemconfigure('lasso', -visible => 1); $zinc->raise('lasso'); - $zinc->bind('', \&lasso); + $zinc->Tk::bind('', [\&lasso, $self]); } sub lasso { - my $lx = $zinc->XEvent->x; - my $ly = $zinc->XEvent->y; + my ($zinc, $self) = @_; + my $ev = $zinc->XEvent(); + my $lx = $ev->x; + my $ly = $ev->y; my @coords; - $corner_x = $lx; - $corner_y = $ly; - @coords = $zinc->transform($top [$cur_x, $cur_y, $lx, $ly]); - $zinc->coords('lasso', [$coords[0], $$coords[1], $coords[2], $coords[3]]); + $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 $enclosed = join(', ', - $zinc->find('enclosed', $cur_x, $cur_y, $corner_x, $corner_y)); - my $overlapping = join(', ', - $zinc->find('overlapping', $cur_x, $cur_y, $corner_x, $corner_y)); + my ($zinc, $self) = @_; + my $enclosed; + my $overlapping; - $zinc->bind('', ''); + $zinc->Tk::bind('', ''); $zinc->itemconfigure('lasso', -visible => 0); - print "enclosed=$enclosed, overlapping=$overlapping\n" + $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')) { + if (! $zinc->hastag('current', 'currentbbox')) { @it = $zinc->find('withtag', 'current'); if (scalar(@it) == 0) { return; } @coords = $zinc->transform($top, $zinc->bbox('current')); - $zinc->coords($tlbbox, [$coords[0], $coords[1]]); - $zinc->coords($trbbox, [$coords[2], $coords[1]]); - $zinc->coords($brbbox, [$coords[2], $coords[3]]); - $zinc->coords($blbbox, [$coords[0], $coords[3]]); + $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 $lx = $zinc->XEvent->x; - my $ly = $zinc->XEvent->y; + my ($zinc, $self) = @_; + my $ev = $zinc->XEvent(); + my $lx = $ev->x; + my $ly = $ev->y; my @next; - @next = $zinc->find('closest' $lx, $ly); + @next = $zinc->find('closest', $lx, $ly); if ((scalar(@next) == 0) || ! $zinc->hastag($next[0], 'currentbbox') || $zinc->hastag('current', 'currentbbox')) { -- cgit v1.1