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

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();
} ## end sub Main

sub drawGUI {
  our @wList;

#~ http://wiki.tcl.tk/16126# BWidget example: Drag and Drop Demo
#~     wm withdraw .
#~     Tkx::wm_withdraw('.');

#~     set t [toplevel .t]
#~     wm title $t "BWidgets Demo for Drag 'n Drop enabled buttons."
  our $t = Tkx::widget->new(".");
  $t = $t->new_toplevel( -name => ".t" );
  $t->g_wm_title("BWidgets Demo for Drag 'n Drop enabled buttons.")
    ;    ## wm title $t "BWidgets Demo for Drag 'n Drop enabled buttons."

#~ use DDS; Dump($t);
#~ #    $Tkx_widget1 = \do { my $v = '.t' };
#~ #    bless( $Tkx_widget1, 'Tkx::widget' );

#~ proc wrap {wtype wpath args} {
#~     if { [catch {uplevel "#0" package require tile}] == 0 } {
#~         return [eval ttk::${wtype} $wpath $args]
#~     } else {
#~         return [eval $wtype $wpath $args]
#~     }
#~ }
#~         sub wrap {
#~             my( $wtype ) = shift;
#~             $wtype = "Tkx::new_ttk__$wtype";
#~             return $wtype->(@_);
#~         }
#~     pack [set f [wrap frame $t.f]] -fill both -expand true
#~     pack [set f [ttk::frame $t.f]] -fill both -expand true
  $t = $t->new_ttk__frame( -name => '.t.f' );
  $t->g_pack(qw' -fill both -expand true ');

#~     pack [wrap button $f.b1 \
#~              -text "1.) Drag" -image [Bitmap::get new] -compound left \
#~              -command {tk_messageBox -message "Drag"}] -padx 5 -pady 5

#~     pack [wrap button $f.b2 \
#~              -text "2.) and"  -image [Bitmap::get file] -compound left \
#~              -command {tk_messageBox -message "and"}] -padx 5 -pady 5

#~     pack [wrap button $f.b3 \
#~              -text "3.) Drop" -image [Bitmap::get copy] -compound left \
#~              -command {tk_messageBox -message "Drop"}] -padx 5 -pady 5

#~     pack [wrap button $f.b4 \
#~              -text "4.) Demo" -image [Bitmap::get redo] -compound left \
#~              -command {tk_messageBox -message "Demo"}] -padx 5 -pady 5
  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;
  } ## end for my $i ( 1 .. 4 )

#~     enableDnD [list $f.b1 $f.b2 $f.b3 $f.b4]
  enableDnD( map { "$t.b$_" } 1 .. 4 );

#~     pack [wrap label $f.lbl -text ""] -padx 5 -pady 5
#~     pack [wrap button $f.b5 -text "Exit Demo." -command {exit 0}] -padx 5 -pady 5
  $t->new_ttk__label( -text => "" )->g_pack(qw' -padx 5 -pady 5 ');
  $t->new_ttk__button(
    -text => "Exit Demo",

#~         -command => sub { Tkx::destroy('.'); exit; },
    -command => [ \&Tkx::destroy, '.' ],
  )->g_pack(qw' -padx 5 -pady 5 ');

#~     Tkx::raise('.');
} ## end sub drawGUI

sub enableDnD {
  for my $w (@_) {

# Here we register the widget as a dropsite.

#~         Tkx::BWidget__DropSite__register(
#~         Tkx::DropSite__register(
    Tkx::DropSite__register(
      $w,

#~             -dropcmd => \&dropbuttonCmd,
      -dropcmd => sub { print "dropbuttonCmd\n" },

#~ http://docs.activestate.com/activetcl/8.6/bwidget/DropSite.html
#~             -droptypes => {
#~                 BUTTON_ITEM  => {copy => {}, move => {} , link => {}},
#~             },
    );

# Here we register the widget as a dragsite.
    Tkx::DragSite__register(
      $w,
      -dragevent => 1,

#~             -draginitcmd => \&dragbuttonCmd,
#~             -dragendcmd => \&droppedOntoButtonCmd,
      -draginitcmd => sub {
        print "dragbuttonCmd\n";
        print "\t $_\n" for @_;
        print "\t--\n";
      },
      -dragendcmd => sub {
        print "droppedOntoButtonCmd\n";
        print "\t $_\n" for @_;
        print "\t--\n";
      },
    );

# Here we have to bind the data type BUTTON_ITEM to the mouse.
#~     Tkx::DragSite__include(qw' Widget BUTTON_ITEM <B1-Motion> ');
  } ## end for my $w (@_)
} ## end sub enableDnD