# # $Id: Drag.pm,v 4.7 2002/07/21 06:49:52 kono Exp $ # package CardPlay::Drag; use strict; use vars qw($VERSION @ISA @EXPORT @EXPORT_OK ); require Exporter; require AutoLoader; @ISA = qw(Exporter AutoLoader ); @EXPORT = qw( ); $VERSION = "0.2"; use Tk; use Carp; # bounding box for dragging # # (x,y)-(x1,y1) / $object # class method sub new { my ($types) = shift; my $self; %$self = @_; $self->{'-drag_object'}=[]; bless $self; } # instance method sub add_drag { my $self = shift; my ($object) = @_; return if (!$object->can('bbox')); $self->delete_drag($object); push (@{$self->{'-drag_object'}},$object); } sub delete_drag { my $self = shift; my ($object) = @_; for( my $i=0;$i <= $#{$self->{'-drag_object'}};$i++ ) { next if ($self->{'-drag_object'}->[$i] ne $object); splice(@{$self->{'-drag_object'}},$i,1); } } sub check_drag { my $self = shift; my ($x,$y) = @_; my ($x0,$y0,$x1,$y1); my ($i); foreach $i ( @{$self->{'-drag_object'}} ) { ($x0,$y0,$x1,$y1) = $i->bbox(); next if ($x < $x0 || $x1 < $x); next if ($y < $y0 || $y1 < $y); return $i; } return undef; } 1; # end