package Controls; $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'}; } $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 ($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); } }