Re^4: Drag & Drop Problem

Haven't solved the resizeing problem yet, so if you feel up to it, you can check that out.

With the reference I meant that I was expecting the reference to $label created in the addCol to be send... but seems to be the one hovering over instead...

I changed to:

    my $drop = $hlist->DropSite(
        -droptypes    => [qw(Local)],
        -dropcommand  => sub { perform_drop($label, @_) }, # New!
        -entercommand => sub { hover_over_drop($label, @_) }, # New!
[download]

Just so I could see what was going on, and not possible loose the things send by the callback. But with this it still seems to be the label I was hoovering over... I wanted the label I was draging! Ofcource, there are other ways. Saveing the one dragged into some global variable... (easier and looks better in the module), but shouldn't passing the scalar to the sub work aswell? I mean, the $label is created in the same sub as that ->DropSite is mentioned. But it's still not the same label everytime, as it should be?

So, basicly, how can I pass the reference to the label I'm DRAGING? :)
Try this:

sub hover_over_drop {
    my ($label_obj, $b_entry, $x_pos) = @_;
    $label_obj->configure(-bg => $b_entry == 1 ? 'gray' : 'lightgray')
+;

    #use Data::Dumper;
    #print Dumper(@_);

    if ($b_entry) {
         #print $label_obj . "\n";
        print $label_obj->cget(-text) . "\n";
    }
}
[download]

And you see that the text is changing...
For instance, draging column #3 prints:

Test3 
Test3 
Test2 
Test1 
Test2 
Test3
[download]

But, I was hoping for only "Test3".

Comment on Re^4: Drag & Drop Problem Select or Download Code

Replies are listed 'Best First'.
Re^5: Drag & Drop Problem by liverpole (Monsignor) on May 23, 2006 at 11:51 UTC
So, basicly, how can I pass the reference to the label I'm DRAGING? :) I admit that this is confusing at first. But when you think about it, it makes perfect sense. What's happening is that you have 3 separate callbacks to hover_over_drop, so when you leave pane 1 to enter pane 2, you're now executing the callback on behalf of the second invokation of DropSite. To get around this, you'll need to do 2 things. First, create a global variable "$drag_obj" at the top of the program and assign it to zero. `my $drag_obj = 0;` [download] Next, in the subroutine hover_over_drop(), the very first time that the subroutine is called, you assign $drag_obj to the label being dragged: `sub hover_over_drop { my ($label_obj, $b_entry, $x_pos) = @_; + $label_obj->configure(-bg => $b_entry == 1 ? 'gray' : 'lightgray') +; + if ($b_entry) { if (!$drag_obj) { print "First time: "; $drag_obj = $label_obj; } else { print " Next time: "; } printf "Dragging(%s) Callback for(%s)\n", $drag_obj->cget(-text), $label_obj->cget(-text); } }` [download] Finally, you have to release the global variable $drag_obj when it's actually dropped. This you can do in perform_drop(): `sub perform_drop { my ($drop_site, $x_pos, $drop_obj) = @_; + $drag_obj or die "Whoops -- \$drag_obj undefined (shouldn't happen +!)\n"; printf "Drop label: %s\n", $drag_obj->cget(-text); $drag_obj = 0; }` [download] I did a small amount of testing to verify that I couldn't drag the label from one column and have hover_over_drop() pick up the wrong label. It seems to work reliably with my changes applied. As for the resize issue, see if you can make some progress on that yourself, and let me know if you need more help if you get stuck. It's not obvious to me why the resize anomaly is even occurring in the first place, but it clearly is. One final suggestion -- when I "googled" for "perl/tk dropsite documentation", I found one link which said: `More information can be found in the DragDrop directory in the source +distribution of Perl/Tk. There are some sample scripts: local_test, m +otion_test and site_test. And if there are still open questions: use +the force, read the source!` [download] If you haven't already done so, see if those sample scripts are helpful. Good luck! s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/	[reply] [d/l] [select]

Replies are listed 'Best First'.

Re^5: Drag & Drop Problem
by liverpole (Monsignor) on May 23, 2006 at 11:51 UTC

So, basicly, how can I pass the reference to the label I'm DRAGING? :)

I admit that this is confusing at first. But when you think about it, it makes perfect sense.

What's happening is that you have 3 separate callbacks to hover_over_drop, so when you leave pane 1 to enter pane 2, you're now executing the callback on behalf of the second invokation of DropSite.

To get around this, you'll need to do 2 things. First, create a global variable "$drag_obj" at the top of the program and assign it to zero.

my $drag_obj = 0;
[download]

hover_over_drop()

very first time

sub hover_over_drop {
    my ($label_obj, $b_entry, $x_pos) = @_;
                                                                      
+          
    $label_obj->configure(-bg => $b_entry == 1 ? 'gray' : 'lightgray')
+;
                                                                      
+          
    if ($b_entry) {
        if (!$drag_obj) {
            print "First time:  ";
            $drag_obj = $label_obj;
        } else {
            print " Next time:  ";
        }
        printf "Dragging(%s)  Callback for(%s)\n",
            $drag_obj->cget(-text),
            $label_obj->cget(-text);
    }
}
[download]

perform_drop()

sub perform_drop {
    my ($drop_site, $x_pos, $drop_obj) = @_;
                                                                      
+          
    $drag_obj or die "Whoops -- \$drag_obj undefined (shouldn't happen
+!)\n";
    printf "Drop label:  %s\n", $drag_obj->cget(-text);
    $drag_obj = 0;
}
[download]

I did a small amount of testing to verify that I couldn't drag the label from one column and have hover_over_drop() pick up the wrong label. It seems to work reliably with my changes applied.

As for the resize issue, see if you can make some progress on that yourself, and let me know if you need more help if you get stuck. It's not obvious to me why the resize anomaly is even occurring in the first place, but it clearly is.

One final suggestion -- when I "googled" for "perl/tk dropsite documentation", I found one link which said:

More information can be found in the DragDrop directory in the source 
+distribution of Perl/Tk. There are some sample scripts: local_test, m
+otion_test and site_test. And if there are still open questions: use 
+the force, read the source!
[download]

sample scripts

Good luck!

s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/

[reply]
[d/l]
[select]