Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | package Tk::DragDrop::Rect; |
2 | use Carp; | |
3 | ||
4 | # Proxy class which represents sites to the dropping side | |
5 | ||
6 | use vars qw($VERSION); | |
7 | $VERSION = '3.009'; # $Id: //depot/Tk8/DragDrop/DragDrop/Rect.pm#9 $ | |
8 | ||
9 | sub Over | |
10 | { | |
11 | my ($site,$X,$Y) = @_; | |
12 | my $x = $site->X; | |
13 | my $y = $site->Y; | |
14 | my $w = $site->width; | |
15 | my $h = $site->height; | |
16 | ||
17 | my $val = ($X >= $x && $X < ($x + $w) && $Y >= $y && $Y < ($y + $h)); | |
18 | # print "Over ",$site->Show," $X,$Y => $val\n"; | |
19 | return $val; | |
20 | } | |
21 | ||
22 | sub FindSite | |
23 | { | |
24 | my ($class,$widget,$X,$Y) = @_; | |
25 | foreach my $site ($class->SiteList($widget)) | |
26 | { | |
27 | return $site if ($site->Over($X,$Y)); | |
28 | } | |
29 | return undef; | |
30 | } | |
31 | ||
32 | sub NewDrag | |
33 | { | |
34 | my ($class,$widget) = @_; | |
35 | } | |
36 | ||
37 | sub Match | |
38 | { | |
39 | my ($site,$other) = @_; | |
40 | return 0 unless (defined $other); | |
41 | return 1 if ($site == $other); | |
42 | return 0 unless (ref($site) eq ref($other)); | |
43 | for ("$site") | |
44 | { | |
45 | if (/ARRAY/) | |
46 | { | |
47 | my $i; | |
48 | return 0 unless (@$site == @$other); | |
49 | for ($i = 0; $i < @$site; $i++) | |
50 | { | |
51 | return 0 unless ($site->[$i] == $other->[$i]); | |
52 | } | |
53 | return 1; | |
54 | } | |
55 | elsif (/SCALAR/) | |
56 | { | |
57 | return $site == $other; | |
58 | } | |
59 | elsif (/HASH/) | |
60 | { | |
61 | my $key; | |
62 | foreach $key (keys %$site) | |
63 | { | |
64 | return 0 unless ($other->{$key} == $site->{$key}); | |
65 | } | |
66 | foreach $key (keys %$other) | |
67 | { | |
68 | return 0 unless ($other->{$key} == $site->{$key}); | |
69 | } | |
70 | return 1; | |
71 | } | |
72 | return 0; | |
73 | } | |
74 | return 0; | |
75 | } | |
76 | ||
77 | ||
78 | 1; |