#! /usr/local/bin/perl -w
use Tk; 
use Tk::Table; 
require Tk::DragDrop;
require Tk::DropSite;
use strict "refs";
use strict "subs";
use strict "vars";

my $cols = 10; 
my $rows = 8; 
my $display_cols = 7;
my $display_rows = 5;

my (@tmp, @dnd_tmp, @ds_tmp);

my $mw = new MainWindow(); 
my $frm_table = $mw->Frame( -borderwidth => 2, -relief => 'raised')->pack( -expand => 'yes', -fill => 'both'); 
my $table = $frm_table->Table( -columns => $display_cols, -rows => $display_rows, -fixedrows => 1, -scrollbars => 'se', -relief  => 'raised'); 

foreach my $c ( 1 .. $cols)
 { 
  my $tmp = $table->Label( -text => "H$c", -width => 6, -relief => 'raised'); 
  $table->put( 0, $c, $tmp ); 
 } 

foreach my $r ( 1 .. $rows )
 { 
  foreach my $c ( 1 .. $cols ) 
   {    
    $tmp[$r][$c] = $table->Label( -text => "$r:$c", -padx => 2, -anchor => 'w', -background => 'white', -relief => 'groove' ); 
    $dnd_tmp[$r][$c] = $tmp[$r][$c]->DragDrop( -event => '<B1-Motion>', 
                                               -sitetypes => [qw(Local)], 
                                               -startcommand =>  sub { print "Cell $r:$c Drag\n"; $dnd_tmp[$r][$c]->configure( -text => "$r:$c" ); return 0; } );
    $ds_tmp[$r][$c] = $tmp[$r][$c]->DropSite ( -droptypes     => ['Local'], 
                                               -dropcommand   => sub { print "Cell $r:$c Drop\n"; } ); 

    $table->put( $r, $c, $tmp[$r][$c] ); 
   }  
 } 
$table->pack( -expand => 'yes', fill => 'both'); 
my $frm_button = $mw->Frame( -borderwidth => 4 )->pack(-fill => 'y'); 
my $btn_exit = $frm_button->Button( -text => "Exit",  -width => 10, -command => sub { exit } )->pack(); 

MainLoop;