Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | package Tk::DragDrop::Local; |
2 | use strict; | |
3 | use vars qw($VERSION); | |
4 | $VERSION = '3.005'; # $Id: //depot/Tk8/DragDrop/DragDrop/LocalDrop.pm#5 $ | |
5 | ||
6 | use base qw(Tk::DragDrop::Rect); | |
7 | require Tk::DragDrop; | |
8 | ||
9 | my @toplevels; | |
10 | ||
11 | Tk::DragDrop->Type('Local'); | |
12 | ||
13 | sub XY | |
14 | { | |
15 | my ($site,$event) = @_; | |
16 | return ($event->X - $site->X,$event->Y - $site->Y); | |
17 | } | |
18 | ||
19 | sub Apply | |
20 | { | |
21 | my $site = shift; | |
22 | my $name = shift; | |
23 | my $cb = $site->{$name}; | |
24 | if ($cb) | |
25 | { | |
26 | my $event = shift; | |
27 | $cb->Call(@_,$site->XY($event)); | |
28 | } | |
29 | } | |
30 | ||
31 | sub Drop | |
32 | { | |
33 | my ($site,$token,$seln,$event) = @_; | |
34 | $site->Apply(-dropcommand => $event, $seln); | |
35 | $site->Apply(-entercommand => $event, 0); | |
36 | $token->Done; | |
37 | } | |
38 | ||
39 | sub Enter | |
40 | { | |
41 | my ($site,$token,$event) = @_; | |
42 | $token->AcceptDrop; | |
43 | $site->Apply(-entercommand => $event, 1); | |
44 | } | |
45 | ||
46 | sub Leave | |
47 | { | |
48 | my ($site,$token,$event) = @_; | |
49 | $token->RejectDrop; | |
50 | $site->Apply(-entercommand => $event, 0); | |
51 | } | |
52 | ||
53 | sub Motion | |
54 | { | |
55 | my ($site,$token,$event) = @_; | |
56 | $site->Apply(-motioncommand => $event); | |
57 | } | |
58 | ||
59 | 1; | |
60 | ||
61 | __END__ |