#!/usr/local/bin/perl -w
use Tk;
use strict;
use Tk::DragDrop;
use Tk::DropSite;

my $top = MainWindow->new();

my $lb = $top->Scrolled('Listbox',-width => 40);

my $thing = $top->Message('-text' => "Drag This with B1")->pack;

my $source = $thing->DragDrop(-event => '<B1-Motion>',
                              -sitetypes => [qw(Local)],
                              -handlers => [[\&send_string], [-type => 'FILE_NAME', \&send_file]]);

my $loc = $top->Message('-text' => "Local Drops here", '-relief' => 'ridge' )->pack(-side => 'right');
$loc->DropSite(-droptypes => [qw(Local)], -dropcommand => [\&ShowTargets,$lb]);

$lb->pack(-side => 'bottom');

$top->Button('-text' => "Sites", '-command' => [\&ShowSites,$top])->pack('-side'=>'left');
$top->Button('-text' => "Quit", '-command' => ['destroy',$top])->pack('-side'=>'right');

MainLoop;

sub send_string
{
 my ($offset,$max) = @_;
 return "These are dropped Data";
}

sub send_file
{
 my ($offset,$max) = @_;
 return __FILE__;
}

sub ShowIt
{
 my $w = shift;
 my ($id,$x,$y,$width,$height) = @_;
 my $t = $w->Toplevel;
 $t->Button('-text'=>$id,'-command'=>['destroy',$t])->pack('-anchor'=>'c','-fill'=>'both');
 $t->overrideredirect(1);
 $t->update('idletasks');
 $t->MoveResizeWindow($x,$y,$width,$height);
}

sub ShowTargets
{
 my $lb = shift;
 my $seln = shift;
 my @targ = $lb->SelectionGet('-selection'=>$seln,'TARGETS');
 $lb->delete(0,'end');
 $lb->insert('end',@targ);
}

sub ShowSites
{
 my $w = shift;
 my @dnd = $w->SelectionGet('-selection'=>"_SUN_DRAGDROP_DSDM",
                            "_SUN_DRAGDROP_SITE_RECTS");
 while (@dnd)
  {
   my $version = shift(@dnd);
   my $site    = shift(@dnd);
   my $win     = shift(@dnd);
   my $x       = shift(@dnd);
   my $y       = shift(@dnd);
   my $width   = shift(@dnd);
   my $height  = shift(@dnd);
   my $flags   = shift(@dnd);
   ShowIt($w,sprintf("%x:%d",$win,$site),$x,$y,$width,$height);
  }

}