#!/usr/bin/perl
use warnings;
use strict;
use Tk;
use Tk::DragDrop;
use Tk::DropSite;

my %tk;

my $font = '{Helvetica} 14';

$tk{mw} = MainWindow->new;

$tk{lbframe} = $tk{mw}->Frame->pack(
    -expand => 1,
    -fill   => 'both',
    -anchor => 'nw'
);

$tk{listbox} = $tk{lbframe}->Scrolled(
    'Listbox',
    -selectmode => 'single',
    -scrollbars => 'ose',
    -font       => $font,
  )->pack(
    -expand => 1,
    -fill   => 'both',
    -padx   => 5,
    -pady   => 5,
  );

$tk{listbox}->insert( 'end', $_) for qw/first second third fourth fifth etc./; 

my $dnd_token = $tk{listbox}->DragDrop(
    -event        => '<B1-Motion>',
    -sitetypes    => [qw/Local/],
    -startcommand => \&DragStart,
);

$tk{listbox}->DropSite(
    -droptypes   => [qw/Local/],
    -dropcommand => [ \&Drop, $tk{listbox}, $dnd_token ],
);

MainLoop;

sub DragStart {
    my ($token) = @_;
    my $site    = $token->parent;
    my $e       = $site->XEvent;
    my $idx     = $site->index( '@' . $e->x . ',' . $e->y );
    if ( defined $idx ) {
        $token->configure( -text => $site->get($idx), -font => $font );
        $site->delete($idx);
        my ( $X, $Y ) = ( $e->X, $e->Y );
        $token->MoveToplevelWindow( $X, $Y );
        $token->raise;
        $token->deiconify;
        $token->FindSite( $X, $Y, $e );
    }
}

sub Drop {
    my ( $site, $token ) = @_;
    my $text    = $token->cget('-text');
    my $y       = $site->pointery - $site->rooty;
    my $nearest = $site->nearest($y);
    if ( defined $nearest ) {
        my @xy = $site->bbox($nearest);
        if ( $xy[1] + $xy[3] > $y ) {
            $site->insert( $nearest, $text );
        }
        else {
            $site->insert( 'end', $text );
        }
    }
}