#!/usr/bin/perl --
use strict;
use warnings;
use Tkx;

my $text = "abc";

Main(@ARGV);
exit(0);

sub Main {
  local $Tkx::TRACE = 64;
  Tkx::package_require('tile');
  Tkx::package_require('BWidget');
  eval      { Tkx::tile__setTheme('xpnative'); 1 }
    || eval { Tkx::ttk__setTheme('xpnative');  1 };
  drawGUI();
  Tkx::MainLoop();
}

sub drawGUI
{
    our $t = Tkx::widget->new(".");
    $t->g_wm_title("BWidgets Demo for Drag 'n Drop enabled buttons.");

    $t = $t->new_ttk__frame( -name => '.f' );
    $t->g_pack(qw '-fill both -expand true');

    for my $i ( 1 .. 4 )
    {
        my $m  = (qw' 0 Drag and Drop Demo ')[$i];
        my $bb = $t->new_ttk__button(-name => "$t.b$i",    # auto-name is .b .b2 .b3...
                                     -image => Tkx::Bitmap__get( (qw'0 new file copy redo ')[$i] ),
                                     -text  => "$i.) $m",
                                     -command => sub { print "$m\n"; });
        $bb->g_pack;
    }

    enableDnD( map { "$t.b$_" } 1 .. 4 );

    $t->new_ttk__button(-text => "Exit Demo",
                        -command => [ \&Tkx::destroy, '.' ])->g_pack(qw '-padx 5 -pady 5');

    my $entry = $t->new_ttk__entry(-width => 20, -textvariable => \$text);
    Tkx::DropSite__register($entry,
                            -dropcmd => \&dropcmdEntry,
                            -dropovercmd => \&dropovercmdEntry,
                            -droptypes => {"text", {"copy", "none"}});
    $entry->g_pack(qw '-padx 5 -pady 5');
}

sub enableDnD
{
    for my $w (@_)
    {
        Tkx::DropSite__register($w,
                                -dropcmd => \&dropButtonCmd);
        Tkx::DragSite__register($w,
                                -dragevent => 1,
                                -draginitcmd => \&dragInitCmd,
                                -dragendcmd => \&dragEndCmd);
    }
}


sub dropButtonCmd
{
    my @args = (@_);

    print "in dropButtonCmd\n";
    for (my $i = 0; $i < scalar @args; $i++)
    {
        print "arg $i = '$args[$i]'\n"  if defined $args[$i];
    }
    return "abc";
}

sub dragInitCmd
{
    my @args = (@_);

    print "in dragInitCmd\n";
    for (my $i = 0; $i < scalar @args; $i++)
    {
        print "arg $i = '$args[$i]'\n"  if defined $args[$i];
    }
    my $data = "\"Button " . $args[3] . "\"";
    return ("text", ("copy"), $data);
}

sub dragEndCmd
{
    my @args = (@_);

    print "in dragEndCmd\n";
    for (my $i = 0; $i < scalar @args; $i++)
    {
        print "arg $i = '$args[$i]'\n"  if defined $args[$i];
    }
}

sub dropcmdEntry
{
    print "dropcmdEntry\n";
    return "entry";
}

sub dropovercmdEntry
{
    print "dropovercmdEntry\n";
}