#!/usr/local/bin/perl -w

use Tk;
use Tk::TableMatrix;
require Tk::JBrowseEntry;
require Tk::DragDrop;
require Tk::DropSite;
use strict;

my $tm_array = {};
my $t;
my @drag = ();
my @drop = ();

sub row_sub
 {
  my $row = shift;
  return "OddRow" if( $row > 0 && $row % 2) 
 }

sub col_sub
 {
  my $col = shift;
  return "OddCol" if( $col > 0 && $col % 2) 
 }

sub switch_cells
 {
  if ($drag[0] == $drop[0]) # Selbe Zeile
   {
    if ($drag[1] >= 0) # Kein Titel
     { 
      my $drag_coords = $drag[0].','.$drag[1];
      my $drop_coords = $drop[0].','.$drop[1];
      my $drag_val = $tm_array->{$drag_coords};
      my $drop_val = $tm_array->{$drop_coords};

      $t->set($drop_coords, $drag_val);
      $tm_array->{$drop_coords} = $drag_val;

      $t->set($drag_coords, $drop_val);
      $tm_array->{$drag_coords} = $drop_val;
     }
   }
 }

my $start_row = -3;
my $end_row = 7;
my $start_col = -2;
my $end_col = 6;
my $display_cols = 10;
my $display_rows = 10; 
my $nr_rows = $end_row - $start_row + 1;
my $nr_cols = $end_col - $start_col + 1;
my $title_rows = ($start_row < 0) ? (abs($start_row)) : (0);
my $title_cols = ($start_col < 0) ? (abs($start_col)) : (0);

foreach my $row  (($start_row - $title_rows)..$end_row)
 {
  foreach my $col (($start_col - $title_cols)..$end_col)
   {
    $tm_array->{"$row,$col"} = "$row:$col";
   }
 }

my $top = MainWindow->new;
$top->geometry('870x300');

$t = $top->Scrolled( 'TableMatrix', 
                     -titlerows => $title_rows,   -titlecols => $title_cols,
                     -rows =>      $nr_rows,      -cols =>      $nr_cols, 
                     -height =>    $display_rows, -width =>     $display_cols, 
                     -variable => $tm_array,
                     -roworigin => $start_row,
                     -colorigin => $start_col, 
                     -rowtagcommand => \&row_sub, 
                     -coltagcommand => \&col_sub, 
                     -colstretchmode => 'none',
                     -rowstretchmode => 'none',
                     -selectmode => 'single',
                     -drawmode => 'fast',
                     -maxwidth => 800,
                     -maxheight => 600,
                     -rowheight => -20,
                     -colwidth => -100,
                     -resizeborders => 'none',
                     -sparsearray => 0, 
                     -selecttitle => 0,
                     -state => 'disabled',
                     -font => ['Tahoma', 10],
                     -bg => '#D4D0C8',
                     -fg => '#000000' );

$t->tagConfigure('OddRow', -bg => '#999999', -fg => 'black');
$t->tagConfigure('OddCol', -bg => '#D4D0C8', -fg => 'black');

my $cb_use = $t->Checkbutton( -text => 'nutzen' ); 
my @test_arr = ( 'TEXT', 'ZAHL', '#.## ¤', '#.## ¤ / # ¤', 'PLZ', 'TT.MM.JJJJ', 'TT.MM.JJ' );
my $test_var = $test_arr[0];
my $be_format = $t->JBrowseEntry( -label => '', -variable => \$test_var, -choices => \@test_arr,
                                  -state => 'normal', -font => ['Tahoma', 8], -width => 10 );
my $lbl_hl = $top->Label(-text => "Headline");

$t->windowConfigure("-3,0", -window=>$cb_use); 
$t->windowConfigure("-2,0", -window=>$be_format); 
$t->windowConfigure("-1,0", -window=>$lbl_hl); 

my ($dnd_t, $ds_t);
$dnd_t = $t->DragDrop( -event => '<B1-Motion>', 
                       -sitetypes => [qw(Local)], 
                       -startcommand =>  sub {
                                              @drag = split(",", $t->index('@'.($t->pointerx - $t->rootx).','.($t->pointery - $t->rooty))); 
                                              $dnd_t->configure( -text => $tm_array->{$drag[0].','.$drag[1]} );
                                              return 0;
                                             } );
$ds_t = $t->DropSite ( -droptypes     => ['Local'], 
                       -dropcommand   => sub { 
                                              @drop = split(",", $t->index('@'.($t->pointerx - $t->rootx).','.($t->pointery - $t->rooty)));                                                 
                                              &switch_cells; 
                                              } );

$t->place( -x => 20, -y => 20 );

my $button = $top->Button( -text => "Exit", -width => 135, -command => sub{ $top->destroy } );  
$button->place( -x => 20, -y => 260 );

Tk::MainLoop;