#
# $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