use warnings;
use strict;
use Tk;
use Tk::Table;
use Data::Dumper;

my $buttonsPerRow = 5;
$buttonsPerRow -= 1;
my $row       = 0;
my $col       = 1;
my $buttonNum = 0;
my @buttons;

my $mw          = tkinit();
my $menuFrame   = $mw->Frame()->pack( -expand => 1, -fill => 'both' );
my $buttonFrame = $mw->Frame()->pack( -expand => 1, -fill => 'both' );

my $table = $buttonFrame->Table(
    -columns    => 5,
    -scrollbars => 'se',
    -fixedrows  => 1,
)->pack( -expand => 1, -fill => 'both' );

my $addButton = $menuFrame->Button(
    -text    => 'Add Button',
    -command => sub {
        $buttons[$buttonNum] = $table->Button();
        print "Button $buttonNum->$row:$col\n";
        $buttons[$buttonNum]{'row'} = $row;
        $buttons[$buttonNum]{'col'} = $col;
        $table->put( $row, $col, $buttons[$buttonNum] );
        configureButton($buttonNum);
        $col > $buttonsPerRow ? $row++ : undef;
        $col > $buttonsPerRow ? $col = 1 : $col++;
        $buttonNum++;
    },
)->pack( -side => 'top' );

################################
my $isDragging     = 0;    #boolean -  mouse button pressed and dragging
my $selectedButton = 0;
my ( @original, @previous );
$mw->bind( '<Motion>', \&motion );
################################

$mw->MainLoop();

sub configureButton {
    my $btnNum = shift;
    $buttons[$btnNum]->bind(
        '<Enter>',
        sub {
            $selectedButton = $btnNum;
        }
    );
    $buttons[$btnNum]->configure(
        -text    => "Button $btnNum",
        -command => sub {
            print "Button $btnNum pressed\n";
        }
    );
    $buttons[$btnNum]->bind( '<ButtonPress-3>',   \&buttonPress );
    $buttons[$btnNum]->bind( '<ButtonRelease-3>', \&buttonRelease );
}

sub motion {
    slideTo( findCell( $_[0] ) ) if $isDragging;
}

sub buttonPress {
    $isDragging = 1;
    @original = @previous = findCell( $_[0] );
}

sub buttonRelease {
    $isDragging = 0;
}

sub findCell {
    my $e = $_[0]->XEvent;
    my ( $row, $col ) = $table->Posn( $table->containing( $e->X, $e->Y ) );
    return ( $row, $col );
}

sub slideTo {
    my @next = @_;
    if ( $previous[0] == $next[0] and $previous[1] == $next[1] ) {
        return;    # still in same cell
    }
    else {
        #swap( \@previous, \@next );
        # depending on desired behaviour, uncomment either the previous or the next two lines
        swap( \@previous, \@original );
        swap( \@original, \@next );
        @previous = @next;
    }
}

sub swap {
    my ( $this, $that ) = @_;
    my $s1 = $table->get(@$this);
    my $s2 = $table->get(@$that);
    $s2->UnmanageGeometry;
    $table->LostSlave($s2);
    $table->put( @$this, $s2 );
    $table->put( @$that, $s1 );
}